gf (empty) → 3.10
raw patch · 880 files changed
+215465/−0 lines, 880 filesdep +Cabaldep +Win32dep +arraybuild-type:Customsetup-changedbinary-added
Dependencies added: Cabal, Win32, array, base, bytestring, cgi, containers, directory, exceptions, filepath, gf, haskeline, httpd-shed, json, lifted-base, mtl, network, network-uri, parallel, pretty, process, random, terminfo, time, time-compat, unix, utf8-string
Files
- .ghci +2/−0
- .gitignore +61/−0
- .travis.yml +14/−0
- LICENSE +557/−0
- Makefile +53/−0
- README.md +53/−0
- Setup.hs +77/−0
- WebSetup.hs +141/−0
- bin/build-binary-dist.sh +104/−0
- bin/clean_html +8/−0
- bin/gfmap +31/−0
- bin/template.html +135/−0
- bin/update_html +114/−0
- css/newstyle.css +65/−0
- css/notes.css +4/−0
- css/style.css +20/−0
- css/style0.css +45/−0
- debian/changelog +71/−0
- debian/compat +1/−0
- debian/control +16/−0
- debian/copyright +1/−0
- debian/rules +49/−0
- debian/source/format +1/−0
- debian/watch +2/−0
- demos/app.html +138/−0
- demos/images/app-disamb.png binary
- demos/images/app-table.png binary
- demos/images/app-trans.png binary
- demos/index-numbers.t2t +27/−0
- demos/index.html +89/−0
- demos/molto.html +49/−0
- demos/molto_grammars.js +19/−0
- demos/resource-api/code.js +947/−0
- demos/resource-api/editor.html +42/−0
- demos/resource-api/empty.png binary
- demos/resource-api/gflib.js +333/−0
- demos/resource-api/grammar.js too large to diff
- demos/resource-api/grammarReference.js +10/−0
- demos/resource-api/index.html +21/−0
- demos/resource-api/minus.png binary
- demos/resource-api/plus.png binary
- demos/resource-api/style.css +198/−0
- demos/resourcegrammars.t2t +19/−0
- demos/translation.t2t +100/−0
- doc/GF-0.1.tgz binary
- doc/Logos/gf-logo.gif binary
- doc/Logos/gf-logo.png binary
- doc/Logos/gf0.png binary
- doc/Logos/gf0.svg +1/−0
- doc/Logos/gf00.png binary
- doc/Logos/gf00.svg +1/−0
- doc/Logos/gf1.svg +14/−0
- doc/Makefile +12/−0
- doc/align6.png binary
- doc/darcs-cm +29/−0
- doc/gf-bib.bib +2749/−0
- doc/gf-bibliography.t2t +816/−0
- doc/gf-developers.t2t +518/−0
- doc/gf-editor-modes.t2t +72/−0
- doc/gf-help-full.txt +1319/−0
- doc/gf-people.md +63/−0
- doc/gf-refman.html +4622/−0
- doc/gf-shell-reference.t2t +106/−0
- doc/icfp-2012.t2t +67/−0
- doc/index.html +69/−0
- doc/nancy-slides.pdf binary
- doc/new-gf-bib.bib +3928/−0
- doc/runtime-api.html +1294/−0
- doc/tutorial/10lang-small.png binary
- doc/tutorial/align2.png binary
- doc/tutorial/categories.png binary
- doc/tutorial/food-js.png binary
- doc/tutorial/food-magnet.png binary
- doc/tutorial/foodmarket.png binary
- doc/tutorial/gf-tutorial.t2t +5039/−0
- doc/tutorial/iphone.jpg binary
- doc/tutorial/myparse.png binary
- doc/tutorial/mytree.png binary
- download/encoding-change.t2t +85/−0
- download/gfc +25/−0
- download/index-3.1.6.t2t +72/−0
- download/index-3.2.9.t2t +74/−0
- download/index-3.2.t2t +102/−0
- download/index-3.3.3.t2t +123/−0
- download/index-3.3.t2t +112/−0
- download/index-3.4.t2t +145/−0
- download/index-3.5.t2t +152/−0
- download/index-3.6.t2t +172/−0
- download/index-3.7.1.t2t +176/−0
- download/index-3.7.t2t +168/−0
- download/index-3.8.t2t +167/−0
- download/index-3.9.t2t +192/−0
- download/index.md +184/−0
- download/release-3.1.6.t2t +59/−0
- download/release-3.10.md +16/−0
- download/release-3.2.t2t +33/−0
- download/release-3.3.3.t2t +23/−0
- download/release-3.3.t2t +27/−0
- download/release-3.4.t2t +44/−0
- download/release-3.5.t2t +68/−0
- download/release-3.6.t2t +105/−0
- download/release-3.7.1.t2t +75/−0
- download/release-3.7.t2t +101/−0
- download/release-3.8.t2t +98/−0
- download/release-3.9.t2t +64/−0
- favicon.ico binary
- gf-book/examples/chapter2/Copy.gf +7/−0
- gf-book/examples/chapter2/CopyAbs.gf +6/−0
- gf-book/examples/chapter2/Food.gf +13/−0
- gf-book/examples/chapter2/Food.probs +4/−0
- gf-book/examples/chapter2/FoodEng.gf +19/−0
- gf-book/examples/chapter2/FoodHin.gf +24/−0
- gf-book/examples/chapter2/FoodIta.gf +19/−0
- gf-book/examples/chapter2/Letters.gf +8/−0
- gf-book/examples/chapter2/LettersCnc.gf +31/−0
- gf-book/examples/chapter2/Strings.gf +7/−0
- gf-book/examples/chapter2/StringsBW.gf +5/−0
- gf-book/examples/chapter2/StringsFW.gf +5/−0
- gf-book/examples/chapter2/Ticket.gf +10/−0
- gf-book/examples/chapter2/TicketEng.gf +19/−0
- gf-book/examples/chapter2/foodEng.cf +14/−0
- gf-book/examples/chapter2/foodIta.cf +14/−0
- gf-book/examples/chapter3/Arabic.gf +118/−0
- gf-book/examples/chapter3/Discont.gf +11/−0
- gf-book/examples/chapter3/DiscontEng.gf +21/−0
- gf-book/examples/chapter3/Foods.gf +13/−0
- gf-book/examples/chapter3/FoodsEng.gf +40/−0
- gf-book/examples/chapter3/FoodsIta.gf +32/−0
- gf-book/examples/chapter3/ResIta.gf +36/−0
- gf-book/examples/chapter4/Clothes.gf +5/−0
- gf-book/examples/chapter4/ClothesEng.gf +10/−0
- gf-book/examples/chapter4/ClothesIta.gf +8/−0
- gf-book/examples/chapter4/Comment.gf +13/−0
- gf-book/examples/chapter4/Comments.gf +10/−0
- gf-book/examples/chapter4/CommentsEng.gf +4/−0
- gf-book/examples/chapter4/CommentsI.gf +15/−0
- gf-book/examples/chapter4/CommentsIta.gf +4/−0
- gf-book/examples/chapter4/Computers.gf +5/−0
- gf-book/examples/chapter4/ComputersEng.gf +10/−0
- gf-book/examples/chapter4/ComputersIta.gf +9/−0
- gf-book/examples/chapter4/DefArtGer.gf +16/−0
- gf-book/examples/chapter4/Foods.gf +6/−0
- gf-book/examples/chapter4/FoodsEng.gf +16/−0
- gf-book/examples/chapter4/FoodsIta.gf +16/−0
- gf-book/examples/chapter4/Shopping.gf +2/−0
- gf-book/examples/chapter4/ShoppingEng.gf +4/−0
- gf-book/examples/chapter4/ShoppingIta.gf +4/−0
- gf-book/examples/chapter4/SmallShopping.gf +3/−0
- gf-book/examples/chapter5/Foods.gf +15/−0
- gf-book/examples/chapter5/FoodsCat.gf +7/−0
- gf-book/examples/chapter5/FoodsEng.gf +28/−0
- gf-book/examples/chapter5/FoodsFin.gf +7/−0
- gf-book/examples/chapter5/FoodsGer.gf +7/−0
- gf-book/examples/chapter5/FoodsI.gf +29/−0
- gf-book/examples/chapter5/FoodsIta.gf +8/−0
- gf-book/examples/chapter5/FoodsSwe.gf +7/−0
- gf-book/examples/chapter5/LexFoods.gf +15/−0
- gf-book/examples/chapter5/LexFoodsCat.gf +18/−0
- gf-book/examples/chapter5/LexFoodsEng.gf +20/−0
- gf-book/examples/chapter5/LexFoodsFin.gf +20/−0
- gf-book/examples/chapter5/LexFoodsGer.gf +16/−0
- gf-book/examples/chapter5/LexFoodsIta.gf +16/−0
- gf-book/examples/chapter5/LexFoodsSwe.gf +16/−0
- gf-book/examples/chapter6/Aggregation.gf +33/−0
- gf-book/examples/chapter6/AggregationEng.gf +17/−0
- gf-book/examples/chapter6/Arithm.gf +30/−0
- gf-book/examples/chapter6/Bin.gf +50/−0
- gf-book/examples/chapter6/Classes.gf +28/−0
- gf-book/examples/chapter6/ClassesEng.gf +29/−0
- gf-book/examples/chapter6/DShopping.gf +24/−0
- gf-book/examples/chapter6/DShoppingEng.gf +33/−0
- gf-book/examples/chapter6/Nat.gf +22/−0
- gf-book/examples/chapter6/Smart.gf +16/−0
- gf-book/examples/chapter6/Verbs.gf +22/−0
- gf-book/examples/chapter6/VerbsEng.gf +22/−0
- gf-book/examples/chapter7/Map.gf +10/−0
- gf-book/examples/chapter7/MapEng.gf +17/−0
- gf-book/examples/chapter7/Query.gf +12/−0
- gf-book/examples/chapter7/QueryEng.gf +13/−0
- gf-book/examples/chapter7/QueryFin.gf +13/−0
- gf-book/examples/chapter8/Calculator.gf +7/−0
- gf-book/examples/chapter8/CalculatorC.gf +10/−0
- gf-book/examples/chapter8/CalculatorJ.gf +13/−0
- gf-book/examples/chapter8/CalculatorP.gf +14/−0
- gf-book/examples/chapter8/CalculatorS.gf +11/−0
- gf-book/examples/chapter8/Geometry.gf +7/−0
- gf-book/examples/chapter8/GeometryEng.gf +13/−0
- gf-book/examples/chapter8/GeometryEngb.gf +11/−0
- gf-book/examples/chapter8/Geometryb.gf +7/−0
- gf-book/examples/chapter8/Graftal.gf +7/−0
- gf-book/examples/chapter8/Logic.gf +21/−0
- gf-book/examples/chapter8/LogicBEng.gf +38/−0
- gf-book/examples/chapter8/LogicEng.gf +39/−0
- gf-book/examples/chapter8/Logicb.gf +11/−0
- gf-book/examples/chapter8/Sierpinski.gf +16/−0
- gf-book/examples/chapter9/Anaphora.gf +17/−0
- gf-book/examples/chapter9/AnaphoraIta.gf +17/−0
- gf-book/examples/chapter9/Grammar.gf +39/−0
- gf-book/examples/chapter9/GrammarIta.gf +141/−0
- gf-book/examples/chapter9/Logic.gf +9/−0
- gf-book/examples/chapter9/LogicIta.gf +54/−0
- gf-book/examples/chapter9/LogicSymb.gf +13/−0
- gf-book/examples/chapter9/ParadigmsIta.gf +47/−0
- gf-book/examples/chapter9/ResIta.gf +178/−0
- gf-book/examples/chapter9/Semantics.gf +39/−0
- gf-book/examples/chapter9/SemanticsIta.gf +42/−0
- gf-book/examples/chapter9/Syntax.gf +47/−0
- gf-book/examples/chapter9/SyntaxIta.gf +3/−0
- gf-book/examples/chapter9/Test.gf +9/−0
- gf-book/examples/chapter9/TestIta.gf +17/−0
- gf-book/examples/chapter9/TestSemantics.gf +1/−0
- gf-book/examples/chapter9/TestSemanticsIta.gf +1/−0
- gf-book/examples/chapter9/hebrew/Grammar.gf +20/−0
- gf-book/examples/chapter9/hebrew/GrammarHeb.gf +97/−0
- gf-book/examples/chapter9/hebrew/PatternsHeb.gf +41/−0
- gf-book/examples/chapter9/hebrew/ResHeb.gf +351/−0
- gf-book/examples/chapter9/hebrew/Test.gf +11/−0
- gf-book/examples/chapter9/hebrew/TestHeb.gf +29/−0
- gf-book/gf-book-cover.png binary
- gf-book/index.t2t +139/−0
- gf-book/toc-gf-book.txt +263/−0
- gf.cabal +349/−0
- index.html +389/−0
- src/compiler/GF.hs +38/−0
- src/compiler/GF/Command/Abstract.hs +86/−0
- src/compiler/GF/Command/CommandInfo.hs +84/−0
- src/compiler/GF/Command/Commands.hs +1020/−0
- src/compiler/GF/Command/Commands2.hs +822/−0
- src/compiler/GF/Command/CommonCommands.hs +282/−0
- src/compiler/GF/Command/Help.hs +91/−0
- src/compiler/GF/Command/Importing.hs +62/−0
- src/compiler/GF/Command/Interpreter.hs +113/−0
- src/compiler/GF/Command/Messages.hs +83/−0
- src/compiler/GF/Command/Parse.hs +72/−0
- src/compiler/GF/Command/SourceCommands.hs +286/−0
- src/compiler/GF/Command/TreeOperations.hs +50/−0
- src/compiler/GF/Compile.hs +131/−0
- src/compiler/GF/Compile/CFGtoPGF.hs +134/−0
- src/compiler/GF/Compile/CheckGrammar.hs +325/−0
- src/compiler/GF/Compile/Coding.hs +64/−0
- src/compiler/GF/Compile/Compute/Abstract.hs +138/−0
- src/compiler/GF/Compile/Compute/AppPredefined.hs +143/−0
- src/compiler/GF/Compile/Compute/Concrete.hs +3/−0
- src/compiler/GF/Compile/Compute/ConcreteNew.hs +580/−0
- src/compiler/GF/Compile/Compute/Predef.hs +168/−0
- src/compiler/GF/Compile/Compute/Value.hs +56/−0
- src/compiler/GF/Compile/ConcreteToHaskell.hs +437/−0
- src/compiler/GF/Compile/ExampleBased.hs +83/−0
- src/compiler/GF/Compile/Export.hs +68/−0
- src/compiler/GF/Compile/GenerateBC.hs +306/−0
- src/compiler/GF/Compile/GeneratePMCFG.hs +619/−0
- src/compiler/GF/Compile/GetGrammar.hs +145/−0
- src/compiler/GF/Compile/GrammarToPGF.hs +308/−0
- src/compiler/GF/Compile/ModDeps.hs +143/−0
- src/compiler/GF/Compile/Multi.hs +165/−0
- src/compiler/GF/Compile/Optimize.hs +239/−0
- src/compiler/GF/Compile/PGFtoHaskell.hs +332/−0
- src/compiler/GF/Compile/PGFtoJS.hs +105/−0
- src/compiler/GF/Compile/PGFtoJava.hs +44/−0
- src/compiler/GF/Compile/PGFtoProlog.hs +262/−0
- src/compiler/GF/Compile/PGFtoPython.hs +122/−0
- src/compiler/GF/Compile/ReadFiles.hs +277/−0
- src/compiler/GF/Compile/Rename.hs +333/−0
- src/compiler/GF/Compile/SubExOpt.hs +141/−0
- src/compiler/GF/Compile/Tags.hs +89/−0
- src/compiler/GF/Compile/ToAPI.hs +214/−0
- src/compiler/GF/Compile/TypeCheck/Abstract.hs +82/−0
- src/compiler/GF/Compile/TypeCheck/Concrete.hs +721/−0
- src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +792/−0
- src/compiler/GF/Compile/TypeCheck/Primitives.hs +68/−0
- src/compiler/GF/Compile/TypeCheck/RConcrete.hs +761/−0
- src/compiler/GF/Compile/TypeCheck/TC.hs +324/−0
- src/compiler/GF/Compile/Update.hs +229/−0
- src/compiler/GF/CompileInParallel.hs +261/−0
- src/compiler/GF/CompileOne.hs +172/−0
- src/compiler/GF/Compiler.hs +171/−0
- src/compiler/GF/CompilerAPI.hs +109/−0
- src/compiler/GF/Data/BacktrackM.hs +95/−0
- src/compiler/GF/Data/ErrM.hs +57/−0
- src/compiler/GF/Data/Graph.hs +178/−0
- src/compiler/GF/Data/Graphviz.hs +116/−0
- src/compiler/GF/Data/Operations.hs +380/−0
- src/compiler/GF/Data/Relation.hs +193/−0
- src/compiler/GF/Data/SortedList.hs +127/−0
- src/compiler/GF/Data/Str.hs +134/−0
- src/compiler/GF/Data/Utilities.hs +207/−0
- src/compiler/GF/Data/XML.hs +57/−0
- src/compiler/GF/Data/Zipper.hs +257/−0
- src/compiler/GF/Grammar.hs +27/−0
- src/compiler/GF/Grammar/Analyse.hs +155/−0
- src/compiler/GF/Grammar/BNFC.hs +110/−0
- src/compiler/GF/Grammar/Binary.hs +349/−0
- src/compiler/GF/Grammar/CFG.hs +386/−0
- src/compiler/GF/Grammar/EBNF.hs +150/−0
- src/compiler/GF/Grammar/Grammar.hs +481/−0
- src/compiler/GF/Grammar/Lexer.x +320/−0
- src/compiler/GF/Grammar/Lockfield.hs +50/−0
- src/compiler/GF/Grammar/Lookup.hs +247/−0
- src/compiler/GF/Grammar/Macros.hs +647/−0
- src/compiler/GF/Grammar/Parser.y +828/−0
- src/compiler/GF/Grammar/PatternMatch.hs +212/−0
- src/compiler/GF/Grammar/Predef.hs +78/−0
- src/compiler/GF/Grammar/Printer.hs +365/−0
- src/compiler/GF/Grammar/ShowTerm.hs +44/−0
- src/compiler/GF/Grammar/Unify.hs +115/−0
- src/compiler/GF/Grammar/Values.hs +56/−0
- src/compiler/GF/Haskell.hs +147/−0
- src/compiler/GF/Infra/BuildInfo.hs +22/−0
- src/compiler/GF/Infra/CheckM.hs +167/−0
- src/compiler/GF/Infra/CompactPrint.hs +22/−0
- src/compiler/GF/Infra/Concurrency.hs +48/−0
- src/compiler/GF/Infra/Dependencies.hs +74/−0
- src/compiler/GF/Infra/GetOpt.hs +381/−0
- src/compiler/GF/Infra/Ident.hs +154/−0
- src/compiler/GF/Infra/Location.hs +41/−0
- src/compiler/GF/Infra/Option.hs +634/−0
- src/compiler/GF/Infra/SIO.hs +129/−0
- src/compiler/GF/Infra/UseIO.hs +256/−0
- src/compiler/GF/Interactive.hs +439/−0
- src/compiler/GF/Interactive2.hs +445/−0
- src/compiler/GF/JavaScript/AbsJS.hs +61/−0
- src/compiler/GF/JavaScript/JS.cf +55/−0
- src/compiler/GF/JavaScript/LexJS.x +132/−0
- src/compiler/GF/JavaScript/Makefile +14/−0
- src/compiler/GF/JavaScript/ParJS.y +225/−0
- src/compiler/GF/JavaScript/PrintJS.hs +167/−0
- src/compiler/GF/Main.hs +63/−0
- src/compiler/GF/Quiz.hs +104/−0
- src/compiler/GF/Server.hs +522/−0
- src/compiler/GF/Speech/CFGToFA.hs +243/−0
- src/compiler/GF/Speech/FiniteState.hs +329/−0
- src/compiler/GF/Speech/GSL.hs +95/−0
- src/compiler/GF/Speech/JSGF.hs +113/−0
- src/compiler/GF/Speech/PGFToCFG.hs +123/−0
- src/compiler/GF/Speech/PrRegExp.hs +27/−0
- src/compiler/GF/Speech/RegExp.hs +144/−0
- src/compiler/GF/Speech/SISR.hs +77/−0
- src/compiler/GF/Speech/SLF.hs +179/−0
- src/compiler/GF/Speech/SRG.hs +199/−0
- src/compiler/GF/Speech/SRGS_ABNF.hs +128/−0
- src/compiler/GF/Speech/SRGS_XML.hs +105/−0
- src/compiler/GF/Speech/VoiceXML.hs +238/−0
- src/compiler/GF/Support.hs +19/−0
- src/compiler/GF/System/Catch.hs +7/−0
- src/compiler/GF/System/Concurrency.hs +26/−0
- src/compiler/GF/System/Console.hs +71/−0
- src/compiler/GF/System/Directory.hs +25/−0
- src/compiler/GF/System/NoSignal.hs +29/−0
- src/compiler/GF/System/Process.hs +18/−0
- src/compiler/GF/System/Signal.hs +27/−0
- src/compiler/GF/System/UseSignal.hs +72/−0
- src/compiler/GF/Text/Clitics.hs +40/−0
- src/compiler/GF/Text/Coding.hs +75/−0
- src/compiler/GF/Text/Lexing.hs +449/−0
- src/compiler/GF/Text/Pretty.hs +47/−0
- src/compiler/GF/Text/Transliterations.hs +341/−0
- src/compiler/SimpleEditor/Convert.hs +161/−0
- src/compiler/SimpleEditor/JSON.hs +37/−0
- src/compiler/SimpleEditor/Syntax.hs +39/−0
- src/example-based/ExampleDemo.hs +553/−0
- src/example-based/ExampleService.hs +128/−0
- src/example-based/exb-fcgi.hs +15/−0
- src/example-based/gf-exb.cabal +25/−0
- src/example-based/todo.txt +20/−0
- src/programs/gf-main.hs +3/−0
- src/runtime/c/AUTHORS +9/−0
- src/runtime/c/CMakeLists.txt +91/−0
- src/runtime/c/COPYING.LESSER +165/−0
- src/runtime/c/INSTALL +60/−0
- src/runtime/c/Makefile.am +108/−0
- src/runtime/c/configure.ac +64/−0
- src/runtime/c/gu/assert.c +52/−0
- src/runtime/c/gu/assert.h +61/−0
- src/runtime/c/gu/bits.c +76/−0
- src/runtime/c/gu/bits.h +150/−0
- src/runtime/c/gu/choice.c +68/−0
- src/runtime/c/gu/choice.h +37/−0
- src/runtime/c/gu/defs.c +4/−0
- src/runtime/c/gu/defs.h +231/−0
- src/runtime/c/gu/enum.c +7/−0
- src/runtime/c/gu/enum.h +35/−0
- src/runtime/c/gu/exn.c +78/−0
- src/runtime/c/gu/exn.h +171/−0
- src/runtime/c/gu/file.c +77/−0
- src/runtime/c/gu/file.h +14/−0
- src/runtime/c/gu/fun.c +1/−0
- src/runtime/c/gu/fun.h +71/−0
- src/runtime/c/gu/hash.c +77/−0
- src/runtime/c/gu/hash.h +40/−0
- src/runtime/c/gu/in.c +378/−0
- src/runtime/c/gu/in.h +134/−0
- src/runtime/c/gu/map.c +393/−0
- src/runtime/c/gu/map.h +87/−0
- src/runtime/c/gu/mem.c +376/−0
- src/runtime/c/gu/mem.h +210/−0
- src/runtime/c/gu/out.c +303/−0
- src/runtime/c/gu/out.h +174/−0
- src/runtime/c/gu/prime.c +154/−0
- src/runtime/c/gu/prime.h +16/−0
- src/runtime/c/gu/seq.c +366/−0
- src/runtime/c/gu/seq.h +190/−0
- src/runtime/c/gu/string.c +313/−0
- src/runtime/c/gu/string.h +97/−0
- src/runtime/c/gu/sysdeps.h +27/−0
- src/runtime/c/gu/ucs.c +4818/−0
- src/runtime/c/gu/ucs.h +55/−0
- src/runtime/c/gu/utf8.c +176/−0
- src/runtime/c/gu/utf8.h +43/−0
- src/runtime/c/gu/variant.c +94/−0
- src/runtime/c/gu/variant.h +111/−0
- src/runtime/c/libgu.pc.in +10/−0
- src/runtime/c/libpgf.pc.in +11/−0
- src/runtime/c/libsg.pc.in +10/−0
- src/runtime/c/m4/ax_prog_doxygen.m4 +533/−0
- src/runtime/c/pgf/aligner.c +241/−0
- src/runtime/c/pgf/data.c +58/−0
- src/runtime/c/pgf/data.h +370/−0
- src/runtime/c/pgf/evaluator.c +513/−0
- src/runtime/c/pgf/expr.c +1796/−0
- src/runtime/c/pgf/expr.h +248/−0
- src/runtime/c/pgf/graphviz.c +415/−0
- src/runtime/c/pgf/graphviz.h +28/−0
- src/runtime/c/pgf/hopu.c +11/−0
- src/runtime/c/pgf/hopu.h +8/−0
- src/runtime/c/pgf/jit.c +1357/−0
- src/runtime/c/pgf/lightning.h +62/−0
- src/runtime/c/pgf/lightning/arm/asm.h +1801/−0
- src/runtime/c/pgf/lightning/arm/core.h +2163/−0
- src/runtime/c/pgf/lightning/arm/fp-swf.h +1253/−0
- src/runtime/c/pgf/lightning/arm/fp-vfp.h +1091/−0
- src/runtime/c/pgf/lightning/arm/fp.h +1104/−0
- src/runtime/c/pgf/lightning/arm/funcs.h +193/−0
- src/runtime/c/pgf/lightning/asm-common.h +207/−0
- src/runtime/c/pgf/lightning/core-common.h +638/−0
- src/runtime/c/pgf/lightning/fp-common.h +86/−0
- src/runtime/c/pgf/lightning/funcs-common.h +54/−0
- src/runtime/c/pgf/lightning/i386/asm-32.h +125/−0
- src/runtime/c/pgf/lightning/i386/asm-64.h +430/−0
- src/runtime/c/pgf/lightning/i386/asm.h +1606/−0
- src/runtime/c/pgf/lightning/i386/core-32.h +177/−0
- src/runtime/c/pgf/lightning/i386/core-64.h +499/−0
- src/runtime/c/pgf/lightning/i386/core.h +366/−0
- src/runtime/c/pgf/lightning/i386/fp-32.h +356/−0
- src/runtime/c/pgf/lightning/i386/fp-64.h +325/−0
- src/runtime/c/pgf/lightning/i386/fp.h +45/−0
- src/runtime/c/pgf/lightning/i386/funcs.h +92/−0
- src/runtime/c/pgf/lightning/ppc/asm.h +647/−0
- src/runtime/c/pgf/lightning/ppc/core.h +298/−0
- src/runtime/c/pgf/lightning/ppc/fp.h +211/−0
- src/runtime/c/pgf/lightning/ppc/funcs.h +164/−0
- src/runtime/c/pgf/lightning/sparc/asm.h +383/−0
- src/runtime/c/pgf/lightning/sparc/core.h +265/−0
- src/runtime/c/pgf/lightning/sparc/fp.h +222/−0
- src/runtime/c/pgf/lightning/sparc/funcs.h +65/−0
- src/runtime/c/pgf/linearizer.c +1224/−0
- src/runtime/c/pgf/linearizer.h +127/−0
- src/runtime/c/pgf/literals.c +489/−0
- src/runtime/c/pgf/literals.h +15/−0
- src/runtime/c/pgf/lookup.c +1064/−0
- src/runtime/c/pgf/parser.c +2611/−0
- src/runtime/c/pgf/parseval.c +220/−0
- src/runtime/c/pgf/pgf.c +267/−0
- src/runtime/c/pgf/pgf.h +270/−0
- src/runtime/c/pgf/printer.c +408/−0
- src/runtime/c/pgf/reader.c +1366/−0
- src/runtime/c/pgf/reader.h +73/−0
- src/runtime/c/pgf/reasoner.c +475/−0
- src/runtime/c/pgf/reasoner.h +174/−0
- src/runtime/c/pgf/typechecker.c +588/−0
- src/runtime/c/pgf/writer.c +922/−0
- src/runtime/c/pgf/writer.h +39/−0
- src/runtime/c/setup.sh +21/−0
- src/runtime/c/sg/sg.c +2403/−0
- src/runtime/c/sg/sg.h +94/−0
- src/runtime/c/sg/sqlite3Btree.c +48655/−0
- src/runtime/c/sg/sqlite3Btree.h +705/−0
- src/runtime/dotNet/Bracket.cs +128/−0
- src/runtime/dotNet/Concr.cs +173/−0
- src/runtime/dotNet/Exceptions.cs +46/−0
- src/runtime/dotNet/Expr.cs +136/−0
- src/runtime/dotNet/Expr/Abstraction.cs +15/−0
- src/runtime/dotNet/Expr/Application.cs +57/−0
- src/runtime/dotNet/Expr/Function.cs +18/−0
- src/runtime/dotNet/Expr/Literal.cs +127/−0
- src/runtime/dotNet/Expr/MetaVariable.cs +34/−0
- src/runtime/dotNet/Native.cs +312/−0
- src/runtime/dotNet/NativeGU.cs +127/−0
- src/runtime/dotNet/PGF.cs +211/−0
- src/runtime/dotNet/PGFSharp.csproj +71/−0
- src/runtime/dotNet/Properties/AssemblyInfo.cs +36/−0
- src/runtime/dotNet/Type.cs +92/−0
- src/runtime/haskell-bind/PGF.hs +3/−0
- src/runtime/haskell-bind/PGF/Internal.hs +1/−0
- src/runtime/haskell-bind/PGF2.hsc +1258/−0
- src/runtime/haskell-bind/PGF2/Expr.hsc +271/−0
- src/runtime/haskell-bind/PGF2/FFI.hsc +532/−0
- src/runtime/haskell-bind/PGF2/Internal.hsc +935/−0
- src/runtime/haskell-bind/PGF2/Type.hsc +141/−0
- src/runtime/haskell-bind/README +26/−0
- src/runtime/haskell-bind/SG.hsc +349/−0
- src/runtime/haskell-bind/SG/FFI.hs +84/−0
- src/runtime/haskell-bind/examples/pgf-shell.hs +87/−0
- src/runtime/haskell-bind/pgf2.cabal +37/−0
- src/runtime/haskell-bind/utils.c +160/−0
- src/runtime/haskell/Data/Binary.hs +814/−0
- src/runtime/haskell/Data/Binary/Builder.hs +434/−0
- src/runtime/haskell/Data/Binary/Get.hs +544/−0
- src/runtime/haskell/Data/Binary/IEEE754.lhs +402/−0
- src/runtime/haskell/Data/Binary/Put.hs +210/−0
- src/runtime/haskell/PGF.hs +425/−0
- src/runtime/haskell/PGF/Binary.hs +281/−0
- src/runtime/haskell/PGF/ByteCode.hs +89/−0
- src/runtime/haskell/PGF/CId.hs +95/−0
- src/runtime/haskell/PGF/Data.hs +135/−0
- src/runtime/haskell/PGF/Editor.hs +241/−0
- src/runtime/haskell/PGF/Expr.hs +406/−0
- src/runtime/haskell/PGF/Expr.hs-boot +28/−0
- src/runtime/haskell/PGF/Forest.hs +210/−0
- src/runtime/haskell/PGF/Generate.hs +216/−0
- src/runtime/haskell/PGF/Haskell.hs +78/−0
- src/runtime/haskell/PGF/Internal.hs +19/−0
- src/runtime/haskell/PGF/Linearize.hs +135/−0
- src/runtime/haskell/PGF/Macros.hs +243/−0
- src/runtime/haskell/PGF/Morphology.hs +66/−0
- src/runtime/haskell/PGF/OldBinary.hs +181/−0
- src/runtime/haskell/PGF/Optimize.hs +259/−0
- src/runtime/haskell/PGF/Paraphrase.hs +113/−0
- src/runtime/haskell/PGF/Parse.hs +532/−0
- src/runtime/haskell/PGF/Printer.hs +125/−0
- src/runtime/haskell/PGF/Probabilistic.hs +283/−0
- src/runtime/haskell/PGF/SortTop.hs +77/−0
- src/runtime/haskell/PGF/Tree.hs +72/−0
- src/runtime/haskell/PGF/TrieMap.hs +99/−0
- src/runtime/haskell/PGF/Type.hs +105/−0
- src/runtime/haskell/PGF/TypeCheck.hs +677/−0
- src/runtime/haskell/PGF/Utilities.hs +20/−0
- src/runtime/haskell/PGF/VisualizeTree.hs +811/−0
- src/runtime/haskell/pgf.cabal +70/−0
- src/runtime/java/INSTALL +15/−0
- src/runtime/java/LICENSE +27/−0
- src/runtime/java/Makefile +47/−0
- src/runtime/java/Test.java +34/−0
- src/runtime/java/jni_utils.c +151/−0
- src/runtime/java/jni_utils.h +50/−0
- src/runtime/java/jpgf.c +1860/−0
- src/runtime/java/jsg.c +339/−0
- src/runtime/java/org/grammaticalframework/pgf/BIND.java +8/−0
- src/runtime/java/org/grammaticalframework/pgf/Bracket.java +31/−0
- src/runtime/java/org/grammaticalframework/pgf/Completer.java +37/−0
- src/runtime/java/org/grammaticalframework/pgf/Concr.java +126/−0
- src/runtime/java/org/grammaticalframework/pgf/Expr.java +146/−0
- src/runtime/java/org/grammaticalframework/pgf/ExprApplication.java +19/−0
- src/runtime/java/org/grammaticalframework/pgf/ExprIterator.java +47/−0
- src/runtime/java/org/grammaticalframework/pgf/ExprProb.java +31/−0
- src/runtime/java/org/grammaticalframework/pgf/FullFormEntry.java +31/−0
- src/runtime/java/org/grammaticalframework/pgf/FullFormIterator.java +50/−0
- src/runtime/java/org/grammaticalframework/pgf/Generator.java +29/−0
- src/runtime/java/org/grammaticalframework/pgf/Hypo.java +22/−0
- src/runtime/java/org/grammaticalframework/pgf/Lexicon.java +29/−0
- src/runtime/java/org/grammaticalframework/pgf/LiteralCallback.java +27/−0
- src/runtime/java/org/grammaticalframework/pgf/MorphoAnalysis.java +35/−0
- src/runtime/java/org/grammaticalframework/pgf/NercLiteralCallback.java +89/−0
- src/runtime/java/org/grammaticalframework/pgf/PGF.java +90/−0
- src/runtime/java/org/grammaticalframework/pgf/PGFError.java +10/−0
- src/runtime/java/org/grammaticalframework/pgf/ParseError.java +29/−0
- src/runtime/java/org/grammaticalframework/pgf/Parser.java +57/−0
- src/runtime/java/org/grammaticalframework/pgf/Pool.java +20/−0
- src/runtime/java/org/grammaticalframework/pgf/SentenceExtractor.java +39/−0
- src/runtime/java/org/grammaticalframework/pgf/TokenIterator.java +44/−0
- src/runtime/java/org/grammaticalframework/pgf/TokenProb.java +36/−0
- src/runtime/java/org/grammaticalframework/pgf/Type.java +30/−0
- src/runtime/java/org/grammaticalframework/pgf/TypeError.java +7/−0
- src/runtime/java/org/grammaticalframework/pgf/TypedExpr.java +24/−0
- src/runtime/java/org/grammaticalframework/pgf/UnknownLiteralCallback.java +41/−0
- src/runtime/java/org/grammaticalframework/sg/SG.java +56/−0
- src/runtime/java/org/grammaticalframework/sg/SGError.java +11/−0
- src/runtime/java/org/grammaticalframework/sg/TripleResult.java +53/−0
- src/runtime/javascript/editor-grammar/Editor.gf +62/−0
- src/runtime/javascript/editor-grammar/EditorEng.gf +63/−0
- src/runtime/javascript/editor.html +17/−0
- src/runtime/javascript/editorGrammar.js +1/−0
- src/runtime/javascript/empty.png binary
- src/runtime/javascript/gfjseditor.js +1310/−0
- src/runtime/javascript/gflib-xhtml-voice.js +54/−0
- src/runtime/javascript/gflib.js +1148/−0
- src/runtime/javascript/grammar.js +1/−0
- src/runtime/javascript/minus.png binary
- src/runtime/javascript/plus.png binary
- src/runtime/javascript/style.css +252/−0
- src/runtime/javascript/translator.css +54/−0
- src/runtime/javascript/translator.html +48/−0
- src/runtime/javascript/translator.js +51/−0
- src/runtime/python/INSTALL +5/−0
- src/runtime/python/examples/README +167/−0
- src/runtime/python/examples/gf_utils.py +369/−0
- src/runtime/python/examples/translation_pipeline.py +421/−0
- src/runtime/python/pypgf.c +3457/−0
- src/runtime/python/setup.py +24/−0
- src/runtime/python/test.py +65/−0
- src/runtime/swipl/Makefile +2/−0
- src/runtime/swipl/pgf.pl +2/−0
- src/runtime/swipl/swipgf.c +82/−0
- src/runtime/typescript/gflib.d.ts +337/−0
- src/server/CGI.hs +11/−0
- src/server/CGIUtils.hs +105/−0
- src/server/Cache.hs +71/−0
- src/server/FastCGIUtils.hs +110/−0
- src/server/LICENSE +340/−0
- src/server/PGFService.hs +1049/−0
- src/server/RunHTTP.hs +51/−0
- src/server/ServeStaticFile.hs +26/−0
- src/server/Setup.hs +91/−0
- src/server/URLEncoding.hs +61/−0
- src/server/exec/ContentService.hs +357/−0
- src/server/exec/MorphoService.hs +88/−0
- src/server/exec/pgf-fcgi.hs +16/−0
- src/server/exec/pgf-http.hs +49/−0
- src/server/gf-server-jsapi.js +122/−0
- src/server/lighttpd.conf +99/−0
- src/server/simple-client.html +111/−0
- src/server/transfer/Fold.hs +26/−0
- src/server/translator.css +76/−0
- src/server/translator.js +51/−0
- src/tools/AlphaConvGF.hs +43/−0
- src/tools/GFDoc.hs +373/−0
- src/tools/MkHelpFile.hs +61/−0
- src/tools/WriteF.hs +70/−0
- src/tools/c++/README +21/−0
- src/tools/c++/exgf.gft +20/−0
- src/tools/c++/gfex.cpp +340/−0
- src/tools/c++/peace.gft +8021/−0
- src/tools/c/GFCC/Abs.hs +227/−0
- src/tools/c/GFCC/ComposOp.hs +30/−0
- src/tools/c/GFCC/ErrM.hs +16/−0
- src/tools/c/GFCC/Lex.hs +340/−0
- src/tools/c/GFCC/Lex.x +135/−0
- src/tools/c/GFCC/Par.hs +1096/−0
- src/tools/c/GFCC/Par.y +204/−0
- src/tools/c/GFCC/Print.hs +148/−0
- src/tools/c/GFCC/Test.hs +58/−0
- src/tools/c/Makefile +25/−0
- src/tools/c/examples/bronzeage/Makefile +47/−0
- src/tools/c/examples/bronzeage/bronzeage-test.c +31/−0
- src/tools/c/gfcc2c.hs +223/−0
- src/tools/dark-filetypes.GF.conf +37/−0
- src/tools/gf-tools.cabal +8/−0
- src/tools/gf.el +1/−0
- src/tools/gf.lang +211/−0
- src/tools/gftest/README.md +1/−0
- src/tools/light-filetypes.GF.conf +33/−0
- src/tools/mkHelpFile.perl +49/−0
- src/www/P/cloud.png binary
- src/www/P/gf-cloud.png binary
- src/www/TransQuiz/brushed-metal.png binary
- src/www/TransQuiz/minibar_quiz.css +95/−0
- src/www/TransQuiz/minibar_quiz.js +640/−0
- src/www/TransQuiz/pgf_online.js +56/−0
- src/www/TransQuiz/quiz_about.html +50/−0
- src/www/TransQuiz/quiz_help.html +46/−0
- src/www/TransQuiz/quiz_pre_start.js +64/−0
- src/www/TransQuiz/quiz_support.js +248/−0
- src/www/TransQuiz/support.js +285/−0
- src/www/TransQuiz/translation_quiz.html +165/−0
- src/www/TransQuiz/translation_quiz.js +766/−0
- src/www/cloud.css +20/−0
- src/www/gf-cloud-api.html +160/−0
- src/www/gf-web-api-examples.html +183/−0
- src/www/gf-web-api.t2t +358/−0
- src/www/gfmorpho/GFMorpho.hs +112/−0
- src/www/gfmorpho/README +23/−0
- src/www/gfmorpho/gfmorpho.cgi +7/−0
- src/www/gfmorpho/gfmorpho.html +112/−0
- src/www/gfse/Makefile +7/−0
- src/www/gfse/P/1306856253_weather_06.png binary
- src/www/gfse/P/1307545089_weather_04.png binary
- src/www/gfse/P/1343909216_weather_03.png binary
- src/www/gfse/P/w1s.jpg binary
- src/www/gfse/P/w2s.jpg binary
- src/www/gfse/P/w3s.jpg binary
- src/www/gfse/P/w4s.jpg binary
- src/www/gfse/TODO +44/−0
- src/www/gfse/about.html +309/−0
- src/www/gfse/cloud.js +148/−0
- src/www/gfse/cloud2.js +278/−0
- src/www/gfse/editor.css +152/−0
- src/www/gfse/editor.js +2042/−0
- src/www/gfse/example_based.js +190/−0
- src/www/gfse/gf_abs.js +345/−0
- src/www/gfse/gfse.manifest +4/−0
- src/www/gfse/index.html +64/−0
- src/www/gfse/localstorage.js +4/−0
- src/www/gfse/molto.css +105/−0
- src/www/gfse/share.html +28/−0
- src/www/gfse/slideshow.js +86/−0
- src/www/gfse/sort.js +157/−0
- src/www/index.html +41/−0
- src/www/js/d3Tree.js +314/−0
- src/www/js/gfrobust.js +43/−0
- src/www/js/gftranslate.js +167/−0
- src/www/js/grammar_manager.js +180/−0
- src/www/js/langcode.js +70/−0
- src/www/js/localstorage.js +60/−0
- src/www/js/pgf_online.js +80/−0
- src/www/js/support.js +424/−0
- src/www/js/wc.js +539/−0
- src/www/minibar/about.html +246/−0
- src/www/minibar/align-btn.png binary
- src/www/minibar/brushed-metal.png binary
- src/www/minibar/example.html +57/−0
- src/www/minibar/feedback.cgi +44/−0
- src/www/minibar/feedback.html +49/−0
- src/www/minibar/minibar-api.html +259/−0
- src/www/minibar/minibar.css +92/−0
- src/www/minibar/minibar.html +52/−0
- src/www/minibar/minibar.js +332/−0
- src/www/minibar/minibar_input.js +562/−0
- src/www/minibar/minibar_offline.html +67/−0
- src/www/minibar/minibar_offline.js +18/−0
- src/www/minibar/minibar_offline.manifest +4/−0
- src/www/minibar/minibar_online.js +37/−0
- src/www/minibar/minibar_support.js +117/−0
- src/www/minibar/minibar_translations.js +332/−0
- src/www/minibar/pgf_offline.js +117/−0
- src/www/minibar/phrasebook.html +59/−0
- src/www/minibar/saldotest.html +30/−0
- src/www/minibar/saldotest.js +340/−0
- src/www/minibar/tree-btn.png binary
- src/www/robots.txt +4/−0
- src/www/syntax-editor/Makefile +2/−0
- src/www/syntax-editor/README.md +76/−0
- src/www/syntax-editor/about.html +129/−0
- src/www/syntax-editor/ast.js +366/−0
- src/www/syntax-editor/editor.css +140/−0
- src/www/syntax-editor/editor.html +46/−0
- src/www/syntax-editor/editor.js +588/−0
- src/www/syntax-editor/editor_menu.js +197/−0
- src/www/syntax-editor/editor_online.js +65/−0
- src/www/translator/about.html +83/−0
- src/www/translator/index.html +110/−0
- src/www/translator/overlay.css +20/−0
- src/www/translator/translator.css +114/−0
- src/www/translator/translator.js +1321/−0
- src/www/wc.html +138/−0
- stack.yaml +16/−0
- testsuite/compiler/check/abstract-operations/Nat.gf +13/−0
- testsuite/compiler/check/abstract-operations/abstract-operations.gfs +5/−0
- testsuite/compiler/check/abstract-operations/abstract-operations.gfs.gold +14/−0
- testsuite/compiler/check/cyclic/abs-types/Test1Abs.gf +7/−0
- testsuite/compiler/check/cyclic/abs-types/Test2Abs.gf +10/−0
- testsuite/compiler/check/cyclic/abs-types/Test3Abs.gf +11/−0
- testsuite/compiler/check/cyclic/abs-types/test1.gfs +1/−0
- testsuite/compiler/check/cyclic/abs-types/test1.gfs.gold +4/−0
- testsuite/compiler/check/cyclic/abs-types/test2.gfs +1/−0
- testsuite/compiler/check/cyclic/abs-types/test2.gfs.gold +4/−0
- testsuite/compiler/check/cyclic/abs-types/test3.gfs +1/−0
- testsuite/compiler/check/cyclic/opers/TestOperTypes.gf +10/−0
- testsuite/compiler/check/cyclic/opers/TestOpers.gf +10/−0
- testsuite/compiler/check/cyclic/opers/test.gfs +2/−0
- testsuite/compiler/check/cyclic/opers/test.gfs.gold +8/−0
- testsuite/compiler/check/cyclic/params/TestParams.gf +7/−0
- testsuite/compiler/check/cyclic/params/test.gfs +1/−0
- testsuite/compiler/check/cyclic/params/test.gfs.gold +4/−0
- testsuite/compiler/check/lincat-types/Test.gf +5/−0
- testsuite/compiler/check/lincat-types/TestCnc.gf +5/−0
- testsuite/compiler/check/lincat-types/test.gfs +1/−0
- testsuite/compiler/check/lincat-types/test.gfs.gold +7/−0
- testsuite/compiler/check/lins/lins.gf +9/−0
- testsuite/compiler/check/lins/lins.gfs +2/−0
- testsuite/compiler/check/lins/lins.gfs.gold +39/−0
- testsuite/compiler/check/lins/linsCnc.gf +11/−0
- testsuite/compiler/check/oper-definition/Res.gf +5/−0
- testsuite/compiler/check/oper-definition/test.gfs +1/−0
- testsuite/compiler/check/oper-definition/test.gfs.gold +5/−0
- testsuite/compiler/check/params/Params.gf +5/−0
- testsuite/compiler/check/restricted-inheritance/A.gf +8/−0
- testsuite/compiler/check/restricted-inheritance/B.gf +3/−0
- testsuite/compiler/check/strMatch/strMatch.gf +5/−0
- testsuite/compiler/check/strMatch/strMatch.gfs +2/−0
- testsuite/compiler/check/strMatch/strMatchCnc.gf +8/−0
- testsuite/compiler/compute/Records.gf +12/−0
- testsuite/compiler/compute/Records.gfs +2/−0
- testsuite/compiler/compute/Records.gfs.gold +1/−0
- testsuite/compiler/compute/Variants.gf +7/−0
- testsuite/compiler/compute/Variants.gfs +2/−0
- testsuite/compiler/compute/Variants.gfs.gold +1/−0
- testsuite/compiler/params/params.gf +7/−0
- testsuite/compiler/params/params.gfs +1/−0
- testsuite/compiler/params/paramsCnc.gf +20/−0
- testsuite/compiler/renamer/funpatt.gf +14/−0
- testsuite/compiler/renamer/funpatt.gfs +1/−0
- testsuite/compiler/renamer/funpatt.gfs.gold +5/−0
- testsuite/compiler/renamer/varpatt.gf +13/−0
- testsuite/compiler/renamer/varpatt.gfs +4/−0
- testsuite/compiler/renamer/varpatt.gfs.gold +4/−0
- testsuite/compiler/typecheck/Check.gf +14/−0
- testsuite/compiler/typecheck/abstract/A.gf +6/−0
- testsuite/compiler/typecheck/abstract/B.gf +7/−0
- testsuite/compiler/typecheck/abstract/C.gf +8/−0
- testsuite/compiler/typecheck/abstract/LetInDefAbs.gf +7/−0
- testsuite/compiler/typecheck/abstract/LetInDefAbs.gfs +2/−0
- testsuite/compiler/typecheck/abstract/LetInTypesAbs.gf +6/−0
- testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs +2/−0
- testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs.gold +1/−0
- testsuite/compiler/typecheck/abstract/LitAbs.gf +15/−0
- testsuite/compiler/typecheck/abstract/LitAbs.gfs +6/−0
- testsuite/compiler/typecheck/abstract/LitAbs.gfs.gold +5/−0
- testsuite/compiler/typecheck/abstract/PolyTypes.gf +5/−0
- testsuite/compiler/typecheck/abstract/RecTypes.gf +5/−0
- testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs +2/−0
- testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs.gold +12/−0
- testsuite/compiler/typecheck/abstract/test_A.gfs +1/−0
- testsuite/compiler/typecheck/abstract/test_A.gfs.gold +5/−0
- testsuite/compiler/typecheck/abstract/test_B.gfs +1/−0
- testsuite/compiler/typecheck/abstract/test_B.gfs.gold +5/−0
- testsuite/compiler/typecheck/abstract/test_C.gfs +1/−0
- testsuite/compiler/typecheck/abstract/test_C.gfs.gold +5/−0
- testsuite/compiler/typecheck/concrete/A.gf +7/−0
- testsuite/compiler/typecheck/concrete/test_A.gfs +1/−0
- testsuite/compiler/typecheck/concrete/test_A.gfs.gold +5/−0
- testsuite/compiler/update/ArrityCheck.gf +5/−0
- testsuite/compiler/update/ArrityCheck.gfs +1/−0
- testsuite/compiler/update/ArrityCheck.gfs.gold +8/−0
- testsuite/libraries/exx-resource.gfs +226/−0
- testsuite/libraries/exx-resource.gfs.gold +1032/−0
- testsuite/run.hs +78/−0
- testsuite/runtime/eval/Test.gf +44/−0
- testsuite/runtime/eval/eval.gfs +34/−0
- testsuite/runtime/eval/eval.gfs.gold +64/−0
- testsuite/runtime/eval/lazy.gf +15/−0
- testsuite/runtime/eval/lazy.gfs +2/−0
- testsuite/runtime/eval/lazy.gfs.gold +2/−0
- testsuite/runtime/linearize/Test.gf +16/−0
- testsuite/runtime/linearize/TestCnc.gf +21/−0
- testsuite/runtime/linearize/brackets.gfs +12/−0
- testsuite/runtime/linearize/brackets.gfs.gold +28/−0
- testsuite/runtime/linearize/linearize.gfs +12/−0
- testsuite/runtime/linearize/linearize.gfs.gold +30/−0
- testsuite/runtime/paraphrase/City.gf +26/−0
- testsuite/runtime/paraphrase/CityEng.gf +16/−0
- testsuite/runtime/paraphrase/Nat.gf +34/−0
- testsuite/runtime/paraphrase/lambda.gf +17/−0
- testsuite/runtime/paraphrase/lambda.gfs +9/−0
- testsuite/runtime/paraphrase/lambda.gfs.gold +12/−0
- testsuite/runtime/paraphrase/test.gfs.gold +7/−0
- testsuite/runtime/parser/DummyNat.gf +8/−0
- testsuite/runtime/parser/DummyNatCnc.gf +8/−0
- testsuite/runtime/parser/Literals.gf +10/−0
- testsuite/runtime/parser/LiteralsCnc.gf +10/−0
- testsuite/runtime/parser/Parse.hs +46/−0
- testsuite/runtime/parser/parser.gfs +3/−0
- testsuite/runtime/parser/parser.gfs.gold +18/−0
- testsuite/runtime/typecheck/Graph.gf +21/−0
- testsuite/runtime/typecheck/Hard.gf +14/−0
- testsuite/runtime/typecheck/Test.gf +39/−0
- testsuite/runtime/typecheck/hard-unification.gfs +3/−0
- testsuite/runtime/typecheck/hard-unification.gfs.gold +6/−0
- testsuite/runtime/typecheck/implicit-arguments.gfs +11/−0
- testsuite/runtime/typecheck/implicit-arguments.gfs.gold +35/−0
- testsuite/runtime/typecheck/typecheck.gfs +31/−0
- testsuite/runtime/typecheck/typecheck.gfs.gold +86/−0
- treebanks/PennTreebank/Dependencies.hs +37/−0
- treebanks/PennTreebank/Idents.hs +115/−0
- treebanks/PennTreebank/Monad.hs +98/−0
- treebanks/PennTreebank/ParseEngAbs.heads +223/−0
- treebanks/PennTreebank/ParseEngAbs.probs too large to diff
- treebanks/PennTreebank/PennFormat.hs +38/−0
- treebanks/PennTreebank/coverage.hs +45/−0
- treebanks/PennTreebank/training.hs +100/−0
- treebanks/PennTreebank/translate.hs +809/−0
- treebanks/susanne/Idents.hs +149/−0
- treebanks/susanne/Parser.hs +103/−0
- treebanks/susanne/SusanneFormat.hs +143/−0
- treebanks/susanne/convert.hs +883/−0
- treebanks/talbanken/Format.hs +106/−0
- treebanks/talbanken/Idents.hs +182/−0
- treebanks/talbanken/MonadSP.hs +193/−0
- treebanks/talbanken/State.hs +40/−0
- treebanks/talbanken/Structure.hs +27/−0
- treebanks/talbanken/TBExtracted too large to diff
- treebanks/talbanken/Translate.hs +1798/−0
@@ -0,0 +1,2 @@+:set -isrc/compiler -isrc/binary -isrc/runtime/haskell -isrc/server -isrc/example-based -isrc/server/transfer -idist/build/autogen -idist/build+:set -fwarn-unused-imports -optP-DSERVER_MODE -optP-DUSE_INTERRUPT -optP-DCC_LAZY -optP-include -optPdist/build/autogen/cabal_macros.h -odir dist/build/gf/gf-tmp -hidir dist/build/gf/gf-tmp -stubdir dist/build/gf/gf-tmp
@@ -0,0 +1,61 @@+*.class+*.la+*.o+*.lo+*.jar+*.gfo+*.pgf+dist/+src/runtime/c/.libs/+src/runtime/c/Makefile+src/runtime/c/Makefile.in+src/runtime/c/aclocal.m4+src/runtime/c/autom4te.cache/+src/runtime/c/config.h+src/runtime/c/config.h.in+src/runtime/c/config.log+src/runtime/c/config.status+src/runtime/c/configure+src/runtime/c/gu/.deps/+src/runtime/c/gu/.dirstamp+src/runtime/c/libgu.pc+src/runtime/c/libpgf.pc+src/runtime/c/libsg.pc+src/runtime/c/libtool+src/runtime/c/m4/libtool.m4+src/runtime/c/m4/ltoptions.m4+src/runtime/c/m4/ltsugar.m4+src/runtime/c/m4/ltversion.m4+src/runtime/c/m4/lt~obsolete.m4+src/runtime/c/pgf/.deps/+src/runtime/c/pgf/.dirstamp+src/runtime/c/pgf/lightning/asm.h+src/runtime/c/pgf/lightning/core.h+src/runtime/c/pgf/lightning/fp.h+src/runtime/c/pgf/lightning/funcs.h+src/runtime/c/scripts/+src/runtime/c/sg/.deps/+src/runtime/c/sg/.dirstamp+src/runtime/c/stamp-h1+src/runtime/java/.libs/+src/runtime/python/build/+.cabal-sandbox+cabal.sandbox.config+.stack-work+DATA_DIR++# Generated documentation (not exhaustive)+demos/index-numbers.html+demos/resourcegrammars.html+demos/translation.html+doc/tutorial/gf-tutorial.html+doc/gf-bibliography.html+doc/gf-developers.html+doc/gf-editor-modes.html+doc/gf-people.html+doc/gf-reference.html+doc/gf-shell-reference.html+doc/icfp-2012.html+download/*.html+gf-book/index.html+src/www/gf-web-api.html
@@ -0,0 +1,14 @@+sudo: required++language: c++services:+ - docker++before_install:+ - docker pull odanoburu/gf-src:3.9++script:+ - |+ docker run --mount src="$(pwd)",target=/home/gfer,type=bind odanoburu/gf-src:3.9 /bin/bash -c "cd /home/gfer/src/runtime/c &&+ autoreconf -i && ./configure && make && make install ; cd /home/gfer ; cabal install -fserver -fc-runtime --extra-lib-dirs='/usr/local/lib'"
@@ -0,0 +1,557 @@+Grammatical Framework is a software package consisting of several different+components. The common wish of the GF development team is to provide software+that is easy to use for everyone with no restrictions. Still in some cases+we want to reserve some rights, in other cases the software that we provide+is derived from someone else's work and we have to respect the rights for the+other. For this reason the different components have different licenses.++In summary:++ - the GF compiler in the folder src/compiler and the PGF Web service in src/server+are under the GNU GENERAL PUBLIC LICENSE.++ - the GF runtime in src/runtime is under dual GNU LESSER GENERAL PUBLIC LICENSE and BSD LICENSE++The rest of this document contains copies of the GPL, LGPL and BSD licenses+which are applicable to the different components of Grammatical Framework+as it is described above.++++ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.++++ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions.++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version.++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.++++ BSD LICENSE++Copyright (c) 1998, Grammatical Framework+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,53 @@+.PHONY: all build install doc clean gf html deb pkg bintar sdist++# This gets the numeric part of the version from the cabal file+VERSION=$(shell sed -ne "s/^version: *\([0-9.]*\).*/\1/p" gf.cabal)++all: build++dist/setup-config: gf.cabal Setup.hs WebSetup.hs+ cabal configure++build: dist/setup-config+ cabal build++install:+ cabal copy+ cabal register++doc:+ cabal haddock++clean:+ cabal clean+ bash bin/clean_html++gf:+ cabal build rgl-none+ strip dist/build/gf/gf++html::+ bash bin/update_html++# Make a debian package. First add a suitable entry with the correct GF version+# number to the top of debian/changelog.+# (Tested on Ubuntu 15.04. You need to install dpkg-dev & debhelper.)+deb:+ dpkg-buildpackage -b -uc++# Make an OS X Installer package+pkg:+ FMT=pkg bash bin/build-binary-dist.sh++# Make a binary tar distribution+bintar:+ bash bin/build-binary-dist.sh++#sdist:+# cabal sdist++# Make a source tar.gz distribution using git to make sure that everything is included.+# We put the distribution in dist/ so it is removed on `make clean`+sdist:+ test -d dist || mkdir dist+ git archive --format=tar.gz --output=dist/gf-${VERSION}.tar.gz HEAD
@@ -0,0 +1,53 @@+++# Grammatical Framework (GF)++[](https://travis-ci.org/GrammaticalFramework/gf-core)++The Grammatical Framework is a grammar formalism based on type theory.+It consists of:++- a special-purpose programming language+- a compiler of the language+- a generic grammar processor++The compiler reads GF grammars from user-provided files, and the+generic grammar processor performs various tasks with the grammars:++- generation+- parsing+- translation+- type checking+- computation+- paraphrasing+- random generation+- syntax editing++GF particularly addresses four aspects of grammars:++- multilinguality (parallel grammars for different languages)+- semantics (semantic conditions of well-formedness, semantic properties of expressions)+- grammar engineering (modularity, abstractions, libraries)+- embeddability in programs written in other languages (C, C++, Haskell, Java, JavaScript)++## Compilation and installation++The simplest way of installing GF is with the command:+```+cabal install+```++For more details, see the [download page](http://www.grammaticalframework.org/download/index.html)+and [developers manual](http://www.grammaticalframework.org/doc/gf-developers.html).++## About this repository++On 2018-07-25, the monolithic [GF repository](https://github.com/GrammaticalFramework/GF)+was split in two:++1. [gf-core](https://github.com/GrammaticalFramework/gf-core) — the GF compiler, shell and runtimes+2. [gf-rgl](https://github.com/GrammaticalFramework/gf-rgl) — the resource grammar library++The former repository is now archived and no longer updated.+The split was performed using [this script](https://github.com/GrammaticalFramework/GF/blob/30ae1b5a5f73513ac5825ca6712186ef8afe9fd4/split/run.sh)+and the output of that script is [here](https://gist.github.com/johnjcamilleri/a6c43ff61f15a9657b457ac94ab7db61).
@@ -0,0 +1,77 @@+import Distribution.Simple(defaultMainWithHooks,UserHooks(..),simpleUserHooks)+import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),absoluteInstallDirs,datadir)+import Distribution.Simple.Setup(BuildFlags(..),Flag(..),InstallFlags(..),CopyDest(..),CopyFlags(..),SDistFlags(..))+import Distribution.PackageDescription(PackageDescription(..),emptyHookedBuildInfo)+import Distribution.Simple.BuildPaths(exeExtension)+import System.FilePath((</>),(<.>))++import WebSetup++-- | Notice about RGL not built anymore+noRGLmsg :: IO ()+noRGLmsg = putStrLn "Notice: the RGL is not built as part of GF anymore. See https://github.com/GrammaticalFramework/gf-rgl"++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { preBuild = gfPreBuild+ , postBuild = gfPostBuild+ , preInst = gfPreInst+ , postInst = gfPostInst+ , postCopy = gfPostCopy+ , sDistHook = gfSDist+ }+ where+ gfPreBuild args = gfPre args . buildDistPref+ gfPreInst args = gfPre args . installDistPref++ gfPre args distFlag = do+ return emptyHookedBuildInfo++ gfPostBuild args flags pkg lbi = do+ noRGLmsg+ let gf = default_gf lbi+ buildWeb gf flags (pkg,lbi)++ gfPostInst args flags pkg lbi = do+ noRGLmsg+ saveInstallPath args flags (pkg,lbi)+ installWeb (pkg,lbi)++ gfPostCopy args flags pkg lbi = do+ noRGLmsg+ saveCopyPath args flags (pkg,lbi)+ copyWeb flags (pkg,lbi)++ -- `cabal sdist` will not make a proper dist archive, for that see `make sdist`+ -- However this function should exit quietly to allow building gf in sandbox+ gfSDist pkg lbi hooks flags = do+ return ()++saveInstallPath :: [String] -> InstallFlags -> (PackageDescription, LocalBuildInfo) -> IO ()+saveInstallPath args flags bi = do+ let+ dest = NoCopyDest+ dir = datadir (uncurry absoluteInstallDirs bi dest)+ writeFile dataDirFile dir++saveCopyPath :: [String] -> CopyFlags -> (PackageDescription, LocalBuildInfo) -> IO ()+saveCopyPath args flags bi = do+ let+ dest = case copyDest flags of+ NoFlag -> NoCopyDest+ Flag d -> d+ dir = datadir (uncurry absoluteInstallDirs bi dest)+ writeFile dataDirFile dir++-- | Name of file where installation's data directory is recording+-- This is a last-resort way in which the seprate RGL build script+-- can determine where to put the compiled RGL files+dataDirFile :: String+dataDirFile = "DATA_DIR"++-- | Get path to locally-built gf+default_gf :: LocalBuildInfo -> FilePath+default_gf lbi = buildDir lbi </> exeName' </> exeNameReal+ where+ exeName' = "gf"+ exeNameReal = exeName' <.> exeExtension
@@ -0,0 +1,141 @@+module WebSetup(buildWeb,installWeb,copyWeb,numJobs,execute) where++import System.Directory(createDirectoryIfMissing,copyFile,doesDirectoryExist,doesFileExist)+import System.FilePath((</>),dropExtension)+import System.Process(rawSystem)+import System.Exit(ExitCode(..))+import Distribution.Simple.Setup(BuildFlags(..),Flag(..),CopyFlags(..),CopyDest(..),copyDest)+import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),datadir,buildDir,absoluteInstallDirs)+import Distribution.PackageDescription(PackageDescription(..))++{-+ To test the GF web services, the minibar and the grammar editor, use+ "cabal install" (or "runhaskell Setup.hs install") to install gf as usual.+ Then start the server with the command "gf -server" and open+ http://localhost:41296/ in your web browser (Firefox, Safari, Opera or+ Chrome). The example grammars listed below will be available in the minibar.+-}++{-+ Update 2018-07-04++ The example grammars have now been removed from the GF repository.+ This script will look for them in ../gf-contrib and build them from there if possible.+ If not, the user will be given a message and nothing is build or copied.+ (Unfortunately cabal install seems to hide all messages from stdout,+ so users won't see this message unless they check the log.)+-}++example_grammars :: [(String, String, [String])] -- [(pgf, subdir, source modules)]+example_grammars =+ [("Letter.pgf","letter",letterSrc)+ ,("Foods.pgf","foods",foodsSrc)+ ,("Phrasebook.pgf","phrasebook",phrasebookSrc)+ ]+ where+ foodsSrc = ["Foods"++lang++".gf"|lang<-foodsLangs]+ foodsLangs = words "Afr Amh Bul Cat Cze Dut Eng Epo Fin Fre Ger Gle Heb Hin Ice Ita Jpn Lav Mlt Mon Nep Pes Por Ron Spa Swe Tha Tsn Tur Urd"++ phrasebookSrc = ["Phrasebook"++lang++".gf"|lang<-phrasebookLangs]+ phrasebookLangs = words "Bul Cat Chi Dan Dut Eng Lav Hin Nor Spa Swe Tha" -- only fastish languages++ letterSrc = ["Letter"++lang++".gf"|lang<-letterLangs]+ letterLangs = words "Eng Fin Fre Heb Rus Swe"++contrib_dir :: FilePath+contrib_dir = ".."</>"gf-contrib"++buildWeb :: String -> BuildFlags -> (PackageDescription, LocalBuildInfo) -> IO ()+buildWeb gf flags (pkg,lbi) = do+ contrib_exists <- doesDirectoryExist contrib_dir+ if contrib_exists+ then mapM_ build_pgf example_grammars+ else putStr $ unlines+ [ "Example grammars are no longer included in the main GF repository, but have moved to gf-contrib."+ , "If you want these example grammars to be built, clone this repository in the same top-level directory as GF:"+ , "https://github.com/GrammaticalFramework/gf-contrib.git"+ ]+ where+ gfo_dir = buildDir lbi </> "examples"++ build_pgf :: (String, String, [String]) -> IO Bool+ build_pgf (pgf,subdir,src) =+ do createDirectoryIfMissing True tmp_dir+ putStrLn $ "Building "++pgf+ execute gf args+ where+ tmp_dir = gfo_dir</>subdir+ dir = contrib_dir</>subdir+ dest = NoCopyDest+ gf_lib_path = datadir (absoluteInstallDirs pkg lbi dest) </> "lib"+ args = numJobs flags++["-make","-s"] -- ,"-optimize-pgf"+ ++["--gfo-dir="++tmp_dir,+ --"--gf-lib-path="++gf_lib_path,+ "--name="++dropExtension pgf,+ "--output-dir="++gfo_dir]+ ++[dir</>file|file<-src]++installWeb :: (PackageDescription, LocalBuildInfo) -> IO ()+installWeb = setupWeb NoCopyDest++copyWeb :: CopyFlags -> (PackageDescription, LocalBuildInfo) -> IO ()+copyWeb flags = setupWeb dest+ where+ dest = case copyDest flags of+ NoFlag -> NoCopyDest+ Flag d -> d++setupWeb :: CopyDest -> (PackageDescription, LocalBuildInfo) -> IO ()+setupWeb dest (pkg,lbi) = do+ mapM_ (createDirectoryIfMissing True) [grammars_dir,cloud_dir]+ contrib_exists <- doesDirectoryExist contrib_dir+ if contrib_exists+ then mapM_ copy_pgf example_grammars+ else return () -- message already displayed from buildWeb+ copyGFLogo+ where+ grammars_dir = www_dir </> "grammars"+ cloud_dir = www_dir </> "tmp" -- hmm+ logo_dir = www_dir </> "Logos"+ www_dir = datadir (absoluteInstallDirs pkg lbi dest) </> "www"+ gfo_dir = buildDir lbi </> "examples"++ copy_pgf :: (String, String, [String]) -> IO ()+ copy_pgf (pgf,subdir,_) =+ do let src = gfo_dir </> pgf+ let dst = grammars_dir </> pgf+ ex <- doesFileExist src+ if ex then do putStrLn $ "Installing "++dst+ copyFile src dst+ else putStrLn $ "Not installing "++dst++ gf_logo = "gf0.png"++ copyGFLogo =+ do createDirectoryIfMissing True logo_dir+ copyFile ("doc"</>"Logos"</>gf_logo) (logo_dir</>gf_logo)++-- | Run an arbitrary system command, returning False on failure+execute :: String -> [String] -> IO Bool+execute command args =+ do let cmdline = command ++ " " ++ unwords (map showArg args)+ e <- rawSystem command args+ case e of+ ExitSuccess -> return True+ ExitFailure i -> do putStrLn $ "Ran: " ++ cmdline+ putStrLn $ command++" exited with exit code: " ++ show i+ return False+ where+ showArg arg = if ' ' `elem` arg then "'" ++ arg ++ "'" else arg++-- | This function is used to enable parallel compilation of the RGL and example grammars+numJobs :: BuildFlags -> [String]+numJobs flags =+ if null n+ then ["-j","+RTS","-A20M","-N","-RTS"]+ else ["-j="++n,"+RTS","-A20M","-N"++n,"-RTS"]+ where+ -- buildNumJobs is only available in Cabal>=1.20+ n = case buildNumJobs flags of+ Flag mn | mn/=Just 1-> maybe "" show mn+ _ -> ""
@@ -0,0 +1,104 @@+#! /bin/bash++### This script builds a binary distribution of GF from the source+### package that this script is a part of. It assumes that you have installed+### the Haskell Platform, version 2013.2.0.0 or 2012.4.0.0.+### Two binary package formats are supported: plain tar files (.tar.gz) and+### OS X Installer packages (.pkg).++os=$(uname) # Operating system name (e.g. Darwin or Linux)+hw=$(uname -m) # Hardware name (e.g. i686 or x86_64)++# GF version number:+ver=$(grep -i ^version: gf.cabal | sed -e 's/version://' -e 's/ //g')++name="gf-$ver"+destdir="$PWD/dist/$name" # assemble binary dist here+prefix=${PREFIX:-/usr/local} # where to install+fmt=${FMT:-tar.gz} # binary package format (tar.gz or pkg)+ghc=${GHC:-ghc} # which Haskell compiler to use++extralib="$destdir$prefix/lib"+extrainclude="$destdir$prefix/include"+extra="--extra-lib-dirs=$extralib --extra-include-dirs=$extrainclude"++set -e # Stop if an error occurs+set -x # print commands before executing them++## First configure & build the C run-time system+pushd src/runtime/c+bash setup.sh configure --prefix="$prefix"+bash setup.sh build+bash setup.sh install prefix="$destdir$prefix"+popd++## Build the python binding to the C run-time system+if which >/dev/null python; then+ pushd src/runtime/python+ EXTRA_INCLUDE_DIRS="$extrainclude" EXTRA_LIB_DIRS="$extralib" python setup.py build+ python setup.py install --prefix="$destdir$prefix"+ if [ "$fmt" == pkg ] ; then+ # A hack for Python on OS X to find the PGF modules+ pyver=$(ls "$destdir$prefix/lib" | sed -n 's/^python//p')+ pydest="$destdir/Library/Python/$pyver/site-packages"+ mkdir -p "$pydest"+ ln "$destdir$prefix/lib/python$pyver/site-packages"/pgf* "$pydest"+ fi+ popd+else+ echo "Python is not installed, so the Python binding will not be included"+fi++## Build the Java binding to the C run-time system+if which >/dev/null javac && which >/dev/null jar ; then+ pushd src/runtime/java+ rm -f libjpgf.la # In case it contains the wrong INSTALL_PATH+ if make CFLAGS="-I$extrainclude -L$extralib" INSTALL_PATH="$prefix/lib"+ then+ make INSTALL_PATH="$destdir$prefix/lib" install+ else+ echo "*** Skipping the Java binding because of errors"+ fi+ popd+else+ echo "Java SDK is not installed, so the Java binding will not be included"+fi++## Build GF, with C run-time support enabled+cabal install -w "$ghc" --only-dependencies -fserver -fc-runtime $extra+cabal configure -w "$ghc" --prefix="$prefix" -fserver -fc-runtime $extra+DYLD_LIBRARY_PATH="$extralib" LD_LIBRARY_PATH="$extralib" cabal build+ # Building the example grammars will fail, because the RGL is missing+cabal copy --destdir="$destdir" # create www directory++## Build the RGL and copy it to $destdir+PATH=$PWD/dist/build/gf:$PATH+export GF_LIB_PATH="$(dirname $(find "$destdir" -name www))/lib" # hmm+mkdir -p "$GF_LIB_PATH"+pushd ../gf-rgl+make build+make copy+popd++# Build GF again, including example grammars that need the RGL+DYLD_LIBRARY_PATH="$extralib" LD_LIBRARY_PATH="$extralib" cabal build++## Copy GF to $destdir+cabal copy --destdir="$destdir"+libdir=$(dirname $(find "$destdir" -name PGF.hi))+cabal register --gen-pkg-config=$libdir/gf-$ver.conf++## Create the binary distribution package+case $fmt in+ tar.gz)+ targz="$name-bin-$hw-$os.tar.gz" # the final tar file+ tar -C "$destdir/$prefix" -zcf "dist/$targz" .+ echo "Created $targz, consider renaming it to something more user friendly"+ ;;+ pkg)+ pkg=$name.pkg+ pkgbuild --identifier org.grammaticalframework.gf.pkg --version "$ver" --root "$destdir" --install-location / dist/$pkg+ echo "Created $pkg"+esac++rm -r "$destdir"
@@ -0,0 +1,8 @@+#!/bin/bash++### This script finds all .t2t (txt2tags) files and deletes the corresponding html file++find . -name '*.t2t' | while read t2t ; do+ html="${t2t%.t2t}.html"+ rm -f "$html"+done
@@ -0,0 +1,31 @@+#!/bin/sh++GF="gf"+DOT="dot" ++BASE=$1+shift++if [ -z "$BASE" ]; then+ echo "Usage: gfmap name module ..." 1>&2+ echo+ echo "Creates a clickable module dependency graph"+ exit 2+fi++DOT_FILE="$BASE.dot"+IMG_FILE="$BASE.gif"+MAP_FILE="$BASE.map"+HTML_FILE="$BASE.html"++$GF -s -src "$@" <<COMMANDS+sg | wf $DOT_FILE+COMMANDS++$DOT -Tgif -o $IMG_FILE $DOT_FILE+$DOT -Tcmapx -o $MAP_FILE $DOT_FILE++echo "<img src='$IMG_FILE' usemap='#_anonymous_0' />" > $HTML_FILE+cat $MAP_FILE >> $HTML_FILE++echo "Created $HTML_FILE and $IMG_FILE"
@@ -0,0 +1,135 @@+<!DOCTYPE html>+<html xmlns="http://www.w3.org/1999/xhtml" lang="$lang$" xml:lang="$lang$"$if(dir)$ dir="$dir$"$endif$>+<head>+ <meta charset="utf-8" />+ <meta name="viewport" content="width=device-width, initial-scale=1.0" />+$for(author-meta)$+ <meta name="author" content="$author-meta$" />+$endfor$+$if(date-meta)$+ <meta name="dcterms.date" content="$date-meta$" />+$endif$+$if(keywords)$+ <meta name="keywords" content="$for(keywords)$$keywords$$sep$, $endfor$" />+$endif$+ <title>$if(title-prefix)$$title-prefix$ – $endif$$pagetitle$</title>+ <link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">+ <link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.4.2/css/all.css" integrity="sha384-/rXc/GQVaYpyDdyxK+ecHPVYJSN9bmVFBvjA/9eOB+pb3F2w2N6fc5qB9Ew5yIns" crossorigin="anonymous">+$for(css)$+ <link rel="stylesheet" href="$css$" />+$endfor$+$if(math)$+ $math$+$endif$+ <!--[if lt IE 9]>+ <script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>+ <![endif]-->+$for(header-includes)$+ $header-includes$+$endfor$+</head>+<body>+$for(include-before)$+$include-before$+$endfor$+<div class="container-fluid my-5" style="max-width:1200px">++$if(title)$+<header id="title-block-header">+<a href="$rel-root$" title="Home">+ <img src="$rel-root$/doc/Logos/gf1.svg" height="200px" class="float-md-right mb-3 bg-white" alt="GF Logo">+</a>+<h1 class="title">$title$</h1>+$if(subtitle)$+<p class="subtitle">$subtitle$</p>+$endif$+$for(author)$+<p class="author">$author$</p>+$endfor$+$if(date)$+<p class="date">$date$</p>+$endif$+</header>+$endif$+$if(toc)$+<nav id="$idprefix$TOC">+$table-of-contents$+</nav>+$endif$+$body$+</div><!-- .container -->++<footer class="bg-light mt-5 py-5">+ <div class="container">+ <div class="row">++ <div class="col-6 col-sm-3">+ <a href="$rel-root$">+ <i class="fas fa-home"></i>+ Home+ </a>+ <h6 class="text-muted mt-3">Get started</h6>+ <ul class="list-unstyled">+ <li><a href="https://www.youtube.com/watch?v=x1LFbDQhbso">Google Tech Talk</a></li>+ <li><a href="http://cloud.grammaticalframework.org/">GF Cloud</a></li>+ <li><a href="$rel-root$/doc/tutorial/gf-tutorial.html">Tutorial</a></li>+ <li><a href="$rel-root$/download"><strong>Download GF</strong></a></li>+ </ul>+ </div>++ <div class="col-6 col-sm-3">+ <h6 class="text-muted">Learn more</h6>+ <ul class="list-unstyled">+ <li><a href="$rel-root$/gf-book">The GF Book</a></li>+ <li><a href="$rel-root$/doc/gf-refman.html">Reference Manual</a></li>+ <li><a href="$rel-root$/doc/gf-shell-reference.html">GF Shell Reference</a></li>+ <li><a href="http://www.molto-project.eu/sites/default/files/MOLTO_D2.3.pdf">Best Practices</a></li>+ <li><a href="$rel-root$/lib/doc/synopsis/index.html"><strong>RGL Synopsis</strong></a></li>+ </ul>+ </div>++ <div class="col-6 col-sm-3">+ <h6 class="text-muted">Develop</h6>+ <ul class="list-unstyled">+ <li><a href="$rel-root$/doc/gf-developers.html">Developers Guide</a></li>+ <li><a href="http://hackage.haskell.org/package/gf/docs/PGF.html">PGF library API (Haskell runtime)</a></li>+ <li><a href="$rel-root$/doc/runtime-api.html">PGF library API (C runtime)</a></li>+ <li><a href="http://hackage.haskell.org/package/gf/docs/GF.html">GF compiler API</a></li>+ <li><a href="$rel-root$/doc/gf-editor-modes.html">Text Editor Support</a></li>+ </ul>+ </div>++ <div class="col-6 col-sm-3">+ <h6 class="text-muted">Contribute</i>+ </h6>+ <ul class="list-unstyled">+ <li><a href="http://groups.google.com/group/gf-dev">Mailing List</a></li>+ <li><a href="https://github.com/GrammaticalFramework/gf-core/issues">Issue Tracker</a></li>+ <li><a href="$rel-root$/doc/gf-people.html">Authors</a></li>+ <li><a href="http://school.grammaticalframework.org/2018/">Summer School</a></li>+ </ul>+ <h6 class="text-muted">+ Repositories+ <i class="fab fa-github ml-1"></i>+ </h6>+ <a href="https://github.com/GrammaticalFramework/gf-core">GF</a> ·+ <a href="https://github.com/GrammaticalFramework/gf-rgl">RGL</a> ·+ <a href="https://github.com/GrammaticalFramework/gf-contrib">Contributions</a>+ </div>+ <div>+ <div>+</footer>+$for(include-after)$+$include-after$+$endfor$+<script type="text/javascript">+var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www.");+document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E"));+</script>+<script type="text/javascript">+try {+var pageTracker = _gat._getTracker("UA-7811807-3");+pageTracker._trackPageview();+} catch(err) {}</script>+</body>+</html>
@@ -0,0 +1,114 @@+#!/bin/bash++# Path to directory where this script is+# https://stackoverflow.com/a/246128/98600+DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null && pwd )"++# Render txt2tags into html file+# Arguments:+# 1. txt2tags source file, e.g. download/index.t2t+# 2. html target file, e.g. download/index.html+function render_t2t_html {+ t2t="$1"+ html="$2"+ tmp="$2.tmp"+ relroot="$( dirname $t2t | sed -E 's/^.\///' | sed -E 's/[^/]+/../g' )"++ # First render with txt2tags to handle pre/post processing+ txt2tags \+ --target=html \+ --no-headers \+ --quiet \+ --outfile="$tmp" \+ --infile="$t2t"++ # Capture first 3 lines of t2t file: title, author, date+ # Documentation here: https://txt2tags.org/userguide/headerarea+ l1=$(head -n 1 "$t2t")+ l2=$(tail -n+2 "$t2t" | head -n 1)+ l3=$(tail -n+3 "$t2t" | head -n 1)+ title=+ author=+ date=+ if [ -n "$l1" ] ; then+ title="$l1"+ if [ -n "$l2" ] ; then author="$l2" ; fi+ if [ -n "$l3" ] ; then date="$l3" ; fi+ fi++ # Run txt2tag's HTML through Pandoc for cleanup+ pandoc \+ --from=html \+ --to=html5 \+ --standalone \+ --template="$DIR/template.html" \+ --variable="rel-root:$relroot" \+ --metadata="title:$title" \+ --metadata="author:$author" \+ --metadata="date:$date" \+ "$tmp" \+ --output="$html"+ rm -f "$tmp"++ # Final post-processing+ if [ -f "$html" ] ; then+ sed -i.bak "s/<table/<table class=\"table\"/" "$html" && rm "$html.bak"+ echo "$html"+ fi+}++# Render markdown into html file+# Arguments:+# 1. markdown source file, e.g. download/index.md+# 2. html target filen, e.g. download/index.html+function render_md_html {+ md="$1"+ html="$2"+ relroot="$( dirname $md | sed -E 's/^.\///' | sed -E 's/[^/]+/../g' )"++ pandoc \+ --from=markdown \+ --to=html5 \+ --standalone \+ --template="$DIR/template.html" \+ --variable="rel-root:$relroot" \+ "$md" \+ --output="$html"++ # Final post-processing+ if [ -f "$html" ] ; then+ sed -i.bak "s/<table/<table class=\"table\"/" "$html" && rm "$html.bak"+ echo "$html"+ fi+}++if [ $# -gt 0 ] ; then+ # Render specific file(s) from args, ignoring dates+ for file in "$@" ; do+ ext="${file##*.}"+ html="${file%.$ext}.html"+ case $ext in+ "md")+ render_md_html "$file" "$html"+ ;;+ "t2t")+ render_t2t_html "$file" "$html"+ ;;+ esac+ done+else+ # Render all files found in cwd and deeper if source is newer+ find . -name '*.t2t' | while read file ; do+ html="${file%.t2t}.html"+ if [ "$file" -nt "$html" ] ; then+ render_t2t_html "$file" "$html"+ fi+ done+ find . -name '*.md' | while read file ; do+ if [[ "$file" == *"README.md" ]] ; then continue ; fi+ html="${file%.md}.html"+ if [ "$file" -nt "$html" ] ; then+ render_md_html "$file" "$html"+ fi+ done+fi
@@ -0,0 +1,65 @@+@import url(style.css);++body.new { margin: 0 8px; }++div.header { text-align: center; }++div.sky {+ margin: 0 -8px;+ background-image: -webkit-linear-gradient(top, #a8d8ff, #f6f6f6 70%);+ background-image: -moz-linear-gradient(top, #a8d8ff, #f6f6f6 70%);+}++div.header h1 {+ margin: 0;+ font-family: verdana, arial, sans-serif;+ font-weight: normal; font-size: 200%;+ /*text-decoration: underline;*/+ }++.tagline { font-family: sans-serif; }++h2.noclear { clear: none; }+++div.red h1 {+ color: #e80000;+ text-shadow: rgba(232,0,0,0.25) 2px 2px 5px;+}+div.red .tagline { color: #e00000; }++div.blue h1, div.blue .tagline { color: #06c; }++div.links {+ display: inline-block;+ vertical-align: top;+ margin-right: 1em;+}++.links h4 { margin: 0; }++.links ul {+ margin-top: 1ex;+ margin-left: 2ex;+ padding-left: 1ex;+ font-family: sans-serif;+}++.links li { margin-top: 0.5ex; margin-bottom: 0.5ex; }++div.menu {+ font-size: 80%;+ display: table;+ margin-top: 3ex;+ margin-right: auto;+ margin-left: auto;+ /*float: right;*/+ /*border-radius: 5px;+ margin-top: 1ex;+ background: inherit;+ border: 2px solid black;+ padding-left: 0.3em;+ box-shadow: 0px 0px 15px rgba(0,0,0,0.5);*/+}++.gflogo { width: 240px; }
@@ -0,0 +1,4 @@+@import url(style.css);++body { color: #333; }+li>code, p>code, pre { color: #730; }
@@ -0,0 +1,20 @@+@import url(style0.css);++table { border-collapse: collapse; }++table.news td {+ background: inherit;+ border: 0;+ vertical-align: baseline;+ padding: 0.25ex 0.5ex;+}++table.news td:nth-child(1) {+ /* Don't want the hyphens in dates (2012-06-29) to cause line breaks */+ white-space: nowrap;+}++th,td { border: 1px solid #333; }++td { background: white; }+th { background: #9df; }
@@ -0,0 +1,45 @@++body { background-color: #f6f6f6; }+++h1,h2,h3,h4 { font-family: sans-serif; color: #303030;+ text-shadow: rgba(0,0,0,0.25) 2px 2px 5px;+ }+h1 { text-align: center; }+h2 { border-bottom: 2px solid #303030; clear: right; }++div.mainlinks { font-size: 140%; }+div.center { text-align: center; }+div.news { font-size: small; }++h1 img { float: right; border: 0; }+h1 img.nofloat { float: none; }+img.right { float: right; }++ol.languages {+ column-width: 12em;+}++.grow {+ max-width: 75%;+ animation-name: grow;+ animation-duration: 2s;+ animation-timing-function: ease-in-out;++ -webkit-animation-name: grow;+ -webkit-animation-duration: 2s;+ -webkit-animation-timing-function: ease-in-out;++}++@keyframes grow {+ from,50% { opacity: 0; transform: scale(0.1,0.1); }+ 80% { opacity: 1; transform: scale(1.1,1.1); }+ to { transform: scale(1.0,1.0); }+}++@-webkit-keyframes grow {+ from,50% { opacity: 0; -webkit-transform: scale(0.1,0.1); }+ 80% { opacity: 1; -webkit-transform: scale(1.1,1.1); }+ to { -webkit-transform: scale(1.0,1.0); }+}
@@ -0,0 +1,71 @@+gf (3.10-1) xenial bionic cosmic; urgency=low++ * GF 3.10++ -- Thomas Hallgren <hallgren@chalmers.se> Fri, 30 Nov 2018 20:00:00 +0100++gf (3.9-1) vivid xenial zesty; urgency=low++ * GF 3.9++ -- Thomas Hallgren <hallgren@chalmers.se> Fri, 11 Aug 2017 20:00:00 +0200++gf (3.8-1) precise trusty vivid; urgency=low++ * GF 3.8++ -- Thomas Hallgren <hallgren@chalmers.se> Wed, 22 Jun 2016 14:00:00 +0200++gf (3.7.1-1) precise trusty vivid; urgency=low++ * GF 3.7.1++ -- Thomas Hallgren <hallgren@chalmers.se> Fri, 2 Oct 2015 14:00:00 +0200++gf (3.7-1) precise trusty vivid; urgency=low++ * GF 3.7++ -- Thomas Hallgren <hallgren@chalmers.se> Tue, 25 Jun 2015 14:00:00 +0200++gf (3.6-1) precise saucy trusty; urgency=low++ * GF 3.6++ -- Thomas Hallgren <hallgren@chalmers.se> Tue, 21 Jun 2014 20:00:00 +0200++gf (3.5-1) precise quantal; urgency=low++ * GF 3.5++ -- Thomas Hallgren <hallgren@chalmers.se> Tue, 6 Aug 2013 17:30:00 +0200++gf (3.4-1) precise quantal; urgency=low++ * GF 3.4++ -- Thomas Hallgren <hallgren@chalmers.se> Wed, 31 Dec 2012 00:00:00 +0200++gf (3.3.11-1) oneiric precise quantal; urgency=low++ * GF 3.3.11++ -- Thomas Hallgren <hallgren@chalmers.se> Wed, 7 Dec 2012 16:50:00 +0200++gf (3.3.3-1) oneiric precise; urgency=low++ * GF 3.3.3++ -- Thomas Hallgren <hallgren@chalmers.se> Wed, 22 Aug 2012 16:50:00 +0200++gf (3.3-1) natty; urgency=low++ * GF 3.3.++ -- Thomas Hallgren <th0907@altocumulus.org> Wed, 26 Oct 2011 22:10:42 +0200++gf (2.5-1) unstable; urgency=low++ * Initial packaging.++ -- Bjorn Bringert <bringert@cs.chalmers.se> Tue, 21 Mar 2006 11:12:25 +0100
@@ -0,0 +1,1 @@+7
@@ -0,0 +1,16 @@+Source: gf+Section: devel+Priority: optional+Maintainer: Thomas Hallgren <hallgren@chalmers.se>+Standards-Version: 3.9.2+Build-Depends: debhelper (>= 5), haskell-platform (>= 2011.2.0.1), libghc-haskeline-dev, libghc-mtl-dev, libghc-json-dev, autoconf, automake, libtool-bin, python-dev, java-sdk, txt2tags+Homepage: http://www.grammaticalframework.org/++Package: gf+Architecture: any+Depends: ${shlibs:Depends}+Description: Tools for GF, a grammar formalism based on type theory+ Grammatical Framework (GF) is a grammar formalism based on type theory. + It consists of a special-purpose programming language,+ a compiler of the language, and a generic grammar processor.+ .
@@ -0,0 +1,1 @@+/usr/share/common-licenses/GPL-2
@@ -0,0 +1,49 @@+#!/usr/bin/make -f++%: + +dh $@++#dh_shlibdeps has a problem finding which package some of the Haskell+#libraries come from, even though dpkg-query -S has no problem finding them.+#But the gf executable is statically linked against the Haskell libraries, so+#it will work even if these shared libraries aren't installed. But there will+#be a problem if other shared libraries are missing (.e.g. libtinfo, libgmp),+#so we need a better solution than simply ignoring all dependency problems...+#See also http://stackoverflow.com/questions/11238134/dpkg-shlibdeps-error-no-dependency-information-found-for+override_dh_shlibdeps:+ dh_shlibdeps --dpkg-shlibdeps-params=--ignore-missing-info++override_dh_auto_build:+ cd src/runtime/python && EXTRA_INCLUDE_DIRS=$(CURDIR)/src/runtime/c EXTRA_LIB_DIRS=$(CURDIR)/src/runtime/c/.libs python setup.py build+ cd src/runtime/java && make CFLAGS="-I$(CURDIR)/src/runtime/c -L$(CURDIR)/src/runtime/c/.libs" INSTALL_PATH=/usr/lib+ echo LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs+ LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs cabal build+ LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs cabal copy --destdir=$(CURDIR)/debian/gf # create www directory+ PATH=$(CURDIR)/dist/build/gf:$$PATH && export GF_LIB_PATH="$$(dirname $$(find "$(CURDIR)/debian/gf" -name www))/lib" && echo "GF_LIB_PATH=$$GF_LIB_PATH" && mkdir -p "$$GF_LIB_PATH" && ( cd ../gf-rgl && make build && make copy ) && LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs cabal build+ make html++override_dh_auto_clean:+ rm -fr dist/build+ -cd src/runtime/python && rm -fr build+ -cd src/runtime/java && make clean+ -cd src/runtime/c && make clean++override_dh_auto_configure:+ cd src/runtime/c && bash setup.sh configure --prefix=/usr+ cd src/runtime/c && bash setup.sh build+ cabal update+ cabal install --only-dependencies+ cabal configure --prefix=/usr -fserver -fc-runtime --extra-lib-dirs=$(CURDIR)/src/runtime/c/.libs --extra-include-dirs=$(CURDIR)/src/runtime/c++override_dh_auto_install:+ LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs cabal copy --destdir=$(CURDIR)/debian/gf+ cd src/runtime/c && bash setup.sh copy prefix=$(CURDIR)/debian/gf/usr+ cd src/runtime/python && python setup.py install --prefix=$(CURDIR)/debian/gf/usr+ cd src/runtime/java && make INSTALL_PATH=$(CURDIR)/debian/gf/usr/lib install+ D="`find debian/gf -name site-packages`" && [ -n "$$D" ] && cd $$D && cd .. && mv site-packages dist-packages++override_dh_auto_test:+ifneq (nocheck,$(filter nocheck,$(DEB_BUILD_OPTIONS)))+ true+# cabal test+endif
@@ -0,0 +1,1 @@+3.0 (native)
@@ -0,0 +1,2 @@+version=3+http://hackage.haskell.org/packages/archive/gf/([\d\.]+)/gf-([\d\.]+).tar.gz
@@ -0,0 +1,138 @@+<!DOCTPYE html>+<html>+<head>+<link rel=stylesheet href="../css/style0.css">+<meta name = "viewport" content = "width = device-width">+<link rel=top href="../" title="GF">+</head>+<body>++<h1>GF Offline Translator - a mobile speech and text translation app+for Android and iOS</h1>++<center>+<img src="images/app-trans.png" width=200>+</center>++<p>+Android: download for free from <a+href="https://play.google.com/store/apps/details?id=org.grammaticalframework.ui.android">Play+Store</a>!+Or take the <a+href="http://www.grammaticalframework.org/~aarne/App14.apk">current+development version</a>.+<br>+iOS (iPhone, iPad): coming in June 2015.+</p>++<p>+Or try first a+<a href="http://cloud.grammaticalframework.org/wc.html">web version of the translator</a>+</p>+++<p>+GF Offline Translator is based on grammar and semantics. It is compact in size+and gives control on quality. Its technology is inspired by compilers, which are+programs that translate computer languages.+Most other translators for human language are based on+statistics and have less control of quality and are much bigger, so that+they require either an internet connection or a huge storage on your phone.+</p>+The app indicates translation confidence with colours:+<ul>+ <li><b>Green</b>:+ semantic translation, should be correct.+ But not necessarily the only correct one.+ You can tap the output to see alternatives.+ </li>+ <li><b>Yellow</b>:+ syntactic translation, should be grammatically correct.+ But can be very strange in its interpretation and choice of words.+ </li>+ <li><b>Light red</b>:+ chunk translation, probably incorrect.+ Builds the translation from small pieces.+ </li>+ <li><b>Dark red</b>:+ word-by-word translation, almost certainly incorrect.+ Builds the translation word by word.+ </li>+</ul>+The green translations come from a tourist phrasebook, which allows+you to translate things like "hello" and "how far is the airport from+the hotel". +</p>++<p>+You can translate both speech and text, as selected in the menu in the+upper right corner. Both kinds of input can be edited with the+keyboard by first tapping at the input field. This is often needed +because of <b>speech recognition errors</b>. Changing words+from <b>upper to lower case</b> may also be needed.+At the moment, <b>Japanese</b> and <b>Thai</b> input must be separated+to words, whereas Chinese works without spaces.+</p>+<p>+Translation works between any of the 14 supported languages, which means 182+language pairs in the current development version (the official+Android version has 12 languages).+But different languages are on different levels of development.+The following table gives a rough idea of what to expect:+</p>++<p>+<center>+<table rules=all border=yes>+<tr> <th></th> <th>coverage</th> <th>quality</th> <th>speed</th> <th>speech</th> </tr>+<tr> <th>Bulgarian</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td><td bgcolor=palegreen></td> <td bgcolor=yellow>in only</td></tr>+<tr> <th>Catalan</th> <td bgcolor=pink></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=yellow>in only</td></tr>+<tr> <th>Chinese</th> <td bgcolor=pink></td> <td bgcolor=pink></td> <td bgcolor=palegreen></td> <td bgcolor=yellow></td> </tr>+<tr> <th>Dutch</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td> <td bgcolor=yellow></td> <td bgcolor=palegreen></td> </tr>+<tr> <th>English</th> <td bgcolor=palegreen></td> <td bgcolor=palegreen></td> <td bgcolor=palegreen></td> <td bgcolor=palegreen></td> </tr>+<tr> <th>Finnish</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=yellow>in only</td></tr>+<tr> <th>French</th> <td bgcolor=pink></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>German</th> <td bgcolor=pink></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>Hindi</th> <td bgcolor=pink></td> <td bgcolor=red></td> <td bgcolor=yellow></td> <td bgcolor=yellow>in only</td> </tr>+<tr> <th>Italian</th> <td bgcolor=pink></td> <td bgcolor=pink></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>Japanese</th> <td bgcolor=pink></td> <td bgcolor=pink></td><td bgcolor=yellow></td> <td bgcolor=palegreen></td></tr>+<tr> <th>Spanish</th> <td bgcolor=pink></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>Swedish</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td> <td bgcolor=palegreen></td> <td bgcolor=yellow>in only</td></tr>+<tr> <th>Thai</th> <td bgcolor=pink></td> <td bgcolor=pink></td><td bgcolor=yellow></td> <td bgcolor=palegreen></td></tr>+</table>+</center>+</p>+<p>+The speech input and output use Google's voice services. Their status+can hence change without notice. You can make it more stable by+installing third-party speech tools, such as SVOX, which provides+output for most of the listed languages.+</p>++<p>+When you tap on a translation you get a screen with <b>alternative translations</b>.+Tapping on each of the alternatives+gives you <b>grammatical information</b>:+an inflection table, if it is a single word,+and a syntax tree otherwise.+</p>++<p>+Powered by <a href="http://www.grammaticalframework.org/">GF</a>,+built by support from the GF community and from <a href="http://www.digitalgrammars.com/">Digital Grammars</a>.+</p>++<p>+Publication: <a+href="http://www.aclweb.org/anthology/E/E14/E14-2011.pdf">EACL 2014+demo paper</a>+</p>++<center>+<img src="images/app-table.png" width=160>+<img src="images/app-disamb.png" width=160>+</center>+++</body>+</html>
binary file changed (absent → 237790 bytes)
binary file changed (absent → 225338 bytes)
binary file changed (absent → 135365 bytes)
@@ -0,0 +1,27 @@+Portable Numeral Translator+15 August 2008++Here is the first GF application for the iPhone. It translates+numerals from digits into number words in 15 languages. It works for+numerals in the range 1-999,999. You can use the demo online in your iPhone's+browser, or download and install it by using FileMagnet (from AppStore).++The demo should work in any web browser supporting JavaScript, but it has been+specially dimensioned for the iPhone screen. It is an application of a general+technology, namely the compilation of GF grammars to JavaScript. Thus you can +easily build similar applications from your own grammars.++The +[full numeral translator http://www.cs.chalmers.se/~bringert/gf/translate/], which+works in 88 language and permits arbitrary cross translations, cannot yet be ported+to the iPhone because of memory problems.++The current version has some encoding/font issues in Hebrew and Hindi.++[Use the translator online numbers/numbers.html]++[Download the translator numbers.tgz]. To install: unpack the file and move+the directory ``numbers`` to your FileMagnet uploader.+++
@@ -0,0 +1,89 @@+<!DOCTYPE html>+<HTML>+<HEAD>+<TITLE>Grammatical Framework Demos</TITLE>+<link rel=stylesheet href="../css/style.css">+<meta name = "viewport" content = "width = device-width">+<link rel=top href="../" title="GF">+</HEAD>++<BODY>+<H1><a href="../"><IMG SRC="../doc/Logos/gf0.png" alt=""></a>Grammatical Framework Demos</H1>++<p><a href="translation.html">Wide coverage translation with GF</a>+<p><a href="app.html">The GF Offline Translation App</a>:+ a mobile speech and text translation app for Android and iOS.+<p><a href="http://www.grammaticalframework.org/demos/phrasebook/">Tourist+Phrasebook</a>++<p><a href="http://www.phrasomatic.net/">Phrasomatic</a> (conceptual authoring based on Phrasebook)++<p><a href="multilingual_headlines.html">Multilingual Headlines</a>++<p><a href="molto.html">MOLTO Application Grammars</a>++<p><a href="mathbar/">Mathbar</a>++<p><a href="http://cloud.grammaticalframework.org/gfse/">GF online editor for simple multilingual grammars</a>+<!--<br>(there is also an <a href="gfse/">older prototype</a>)-->++<p><a href="http://www.grammaticalframework.org:41297/syllogism/syllogism.html">Online syllogism solver</a>++<p><a href="../src/www/TransQuiz/translation_quiz.html">Translation Quiz</a>++<P><a href="http://cloud.grammaticalframework.org/minibar/minibar.html">Minibar</A>+<!-- | <small><a href="../src/www/minibar/minibar_offline.html">Minibar offline</a></small> -->+<!--(<small>Predecessors:+<a href="http://www.grammaticalframework.org:41296/fridge">Fridge poetry</A>+ | <a href="http://www.grammaticalframework.org:41296/translate">Word-completing translator</A></small>)-->++<p><a href="http://www.grammaticalframework.org/~hallgren/Talks/GF/Tutorial2012/Ex4/answer.html">Question answering demo</a> for simple math questions.+<P>+<A HREF="http://www.youtube.com/watch?v=1bfaYHWS6zU">Tramdemo on YouTube</A>: +find your way in Gothenburg public transport system, in six languages (film).++<P>+<A HREF="http://www.grammaticalframework.org/~meza/restWiki/wiki.cgi">Multilingual Wiki</A>.++<P>+<A HREF="index-numbers.html">Numeral translator for the iPhone</A>: number words in 15 languages.++<P>+<A HREF="http://www.cse.chalmers.se/alumni/bringert/gf/translate/">Numeral translator</A>:+number words in 88 languages. (Java applet)++<P>+<A HREF="http://www.cse.chalmers.se/alumni/markus/gramlets/letter-applet.html">Letter editor</A>: compose+a letter in a language you don't know. (Java applet)++<P>+<A HREF="http://www.cse.chalmers.se/alumni/bringert/xv/pizza/">Pizza</A>: order a pizza by speaking+to your web browser.++<P>+<A HREF="http://webalt.math.helsinki.fi/PublicFiles/CD/Screencast/TextMathEditor%20Demo.swf">WebALT Math Editor</A>:+create mathematical exercises in six languages simultaneously (film).+<!--+<P>+[Out of order, early May 2012]+<small>+<A HREF="http://www.jem-thematic.net/en/node/846#comment-209">WebALT Math translator</A>:+translate mathematical exercises in a web service using incremental parsing.+</small>+-->+<!--+<P>+ <A HREF="http://csmisc14.cs.chalmers.se/~bjorn/langtrain.cgi">GF Language Trainer</A>:+translation quizzes in Arabic, English, Russian, Swedish. -->++<P>+<A HREF="resource-api/editor.html">Library API browser-editor</A>: construct phrases in+the <A HREF="../lib/doc/synopsis.html">GF resource library</A>++<!--+<P>+<A HREF="../old-lib/resource/doc/resdemo.html">Random library examples</A>++-->+<hr>+<a href="http://www.grammaticalframework.org/">www.grammaticalframework.org</a>
@@ -0,0 +1,49 @@+<!DOCTYPE html>+<html>+<head>+<title>MOLTO Application Grammars</title>+<link rel=stylesheet type="text/css" href="../src/www/minibar/minibar.css">+<link rel=stylesheet type="text/css" href="../src/www/syntax-editor/editor.css">++<link rel=author href="http://www.cse.chalmers.se/~hallgren/" title="Thomas Hallgren">++<meta name = "viewport" content = "width = device-width">+<meta charset="UTF-8">++</head>++<body class=minibar>+<h2>MOLTO Application Grammars</h2>+<div id=minibar></div>+<div id=syntax_editor></div>++<noscript>This page doesn't works unless JavaScript is enabled.</noscript>++<hr>++<small>+[<a href="http://www.molto-project.eu/cloud/gf-application-grammars">GF+ Application Grammars on the MOLTO web site</a>]+</small>+<small class=modtime>+HTML <!-- hhmts start -->Last modified: Fri May 24, 2013 <!-- hhmts end -->+</small>++<div id="debug" class="hidden"></div>++<script type="text/JavaScript" src="../src/www/js/grammar_manager.js"></script>+<script type="text/JavaScript" src="../src/www/js/support.js"></script>+<script type="text/JavaScript" src="../src/www/js/localstorage.js"></script>+<script type="text/JavaScript" src="../src/www/minibar/minibar.js"></script>+<script type="text/JavaScript" src="../src/www/minibar/minibar_input.js"></script>+<script type="text/JavaScript" src="../src/www/minibar/minibar_translations.js"></script>+<script type="text/JavaScript" src="../src/www/minibar/minibar_support.js"></script>+<script type="text/JavaScript" src="../src/www/js/pgf_online.js"></script>+<script type="text/javascript" src="../src/www/syntax-editor/ast.js"></script>+<script type="text/javascript" src="../src/www/syntax-editor/editor_menu.js"></script>+<script type="text/javascript" src="../src/www/syntax-editor/editor.js"></script>+<script type="text/javascript" src="molto_grammars.js"></script>+<script type="text/javascript" src="../src/www/gfse/gf_abs.js"></script>++</body>+</html>
@@ -0,0 +1,19 @@+var online_options={+ grammars_url: "/grammars/molto/"+}++var minibar_options= {+ show_abstract: true,+ show_trees: true,+ tree_img_format: "svg", // or "png"+ show_grouped_translations: false,+ to_multiple: false,+ show_brackets: true,+ word_replacements: true,+ default_source_language: "Eng",+ feedback_url: "feedback.html",+ try_google: true+}++var server=pgf_online(online_options);+var minibar=new Minibar(server,minibar_options);
@@ -0,0 +1,947 @@+ +//Variable and Constant definitions + +var expColImg = new Array(2); +expColImg[0] = new Image(12,12); +expColImg[0].src = "minus.png"; +expColImg[1] = new Image(12,12); +expColImg[1].src = "plus.png"; + +var selectedNode = ""; +var collapseBuffer = new Array(); +var abstractTree = new Fun ("?"); + +var navigationControlString = new Array(); +var undoArray = new Array(); +var redoArray = new Array(); +var clipBoard; +var refPageCounter = 0; + +var stringAbstractTree = undefined; + +var myTree = treeFromAbstract(myAbstract.annotate(abstractTree, myAbstract.startcat), "0"); + +var keys = new Array(); +keys ["Z"] = function() { clickUndo('actUndo'); } +keys ["Y"] = function() { clickRedo('actRedo'); } +keys ["R"] = function() { clickRefine('actRefine'); }; +keys ["V"] = function() { clickPaste('actPaste'); }; +keys ["X"] = function() { clickCut('actCut'); }; +keys ["C"] = function() { clickCopy('actCopy'); }; +keys ["D"] = function() { clickDelete('actDelete'); }; +keys ["E"] = function() { clickReplace('actReplace'); }; +keys ["W"] = function() { clickWrap('actWrap'); }; +keys ["N"] = function() { clickRandomNode('actRandomNode'); }; +keys ["T"] = function() { clickRandomTree('actRandomTree'); }; +keys ["%"] = function() { leftArrowKey(); }; +keys ["&"] = function() { upDownArrowKey(-1); }; +keys ["'"] = function() { rightArrowKey(); }; +keys ["("] = function() { upDownArrowKey( 1); }; +keys ["27"] = function() { clickEsc(); }; + +function state(selectedNode, tree, collapseBuffer) { + this.selectedNode = selectedNode; + this.tree = myAbstract.copyTree(tree); + this.collapseBuffer = collapseBuffer; + return this; +} + +function treeNode(name, caption) { + this.name = name; + this.caption = caption; + this.cat = ""; + this.children = new Array(); + this.collapsed = false; + return this; +} + +treeNode.prototype.addChild = function (i, c) { + this.children[i] = c; +} + +treeNode.prototype.hasChildren = function() { + return this.children.length; +} + +// Generates a tree from the abstract tree contained in the element "stringTree" +function parseStringTree(elementToParse) { + stringAbstractTree = elementToParse; + abstractTree = myAbstract.parseTree(document.getElementById(elementToParse).value, myAbstract.startcat); + myTree = treeFromAbstract(myAbstract.annotate(abstractTree, myAbstract.startcat), "0"); + nodeClick("0"); +} + +// If a key is pressed and a function assigned to that key, calls the function +function hotKeys(event) { + event = (event) ? event : ((window.event) ? event : null); + if (event) { + var charCode = (event.charCode) ? event.charCode : ((event.which) ? event.which : event.keyCode); + if (keys[String.fromCharCode(charCode).toUpperCase()] && + !event.ctrlKey && !event.altKey && !event.shiftKey && !event.metaKey) { + keys[String.fromCharCode(charCode).toUpperCase()](); + } + else if (keys["" + charCode] && + !event.ctrlKey && !event.altKey && !event.shiftKey && !event.metaKey) { + keys["" + charCode](); + } + else if (charCode >= "96" && charCode <= "105" && + !event.ctrlKey && !event.altKey && !event.shiftKey && !event.metaKey) { + keys["" + (charCode - 96)](); + } + } +} + +// Clears "numeric" hotkeys +function clearHotKeys() { + for (var key in keys) { + if ((parseInt(key) + 1) && (key != "27")) { keys[key] = function() { }; } + } +} + +// Action to be performed when the up/down arrow key is pressed +function upDownArrowKey(pos) { + var nodePos = getNavPos(selectedNode); + if ((nodePos > 0 && pos < 0) || (nodePos < navigationControlString.length - 1 && pos > 0)) { + nodeClick(navigationControlString[nodePos + pos]); + } +} + +// Gets the position of a given node in the navigationControlString +function getNavPos(nodeName) { + for (var i = 0, j = navigationControlString.length; i < j; i++) { + if (navigationControlString[i] == nodeName) { return i; }; + } + return undefined; +} + +// Given a name and a tree, gets the node in the tree with that name +function getNode(nodeName, node) { + if (nodeName == node.name) { + return node; + } + else { + for (var i = 0, j = node.children.length; i < j; i++) { + var found = getNode(nodeName, node.children[i]); + if (found) { return found; } + } + } +} + +// Action to be performed when the left arrow key is pressed +function leftArrowKey() { + var node = getNode(selectedNode, myTree); + if (!node.collapsed && node.hasChildren()) { + signClick(node.name, node.caption); + } + else { + var parentNode = getParent(node.name, myTree); + if (parentNode) { nodeClick(parentNode.name); } + } +} + +// Gets the parent of the selected node +function getParent(nodeName, node) { + if (node.name == nodeName) { + return undefined; + } + else { + for (var i = 0, j = node.children.length; i < j; i++) { + if (node.children[i].name == nodeName) { return node; } + } + for (var i = 0, j = node.children.length; i < j; i++) { + var found = getParent(nodeName, node.children[i]); + if (found) { return found; } + } + } +} + +// Action to be performed when the right arrow key is pressed +function rightArrowKey() { + var node = getNode(selectedNode, myTree); + if (node.collapsed) { + signClick(node.name, node.caption); + } + else { + var firstDescendant = getfirstDescendant(node); + if (firstDescendant) { + nodeClick(firstDescendant.name); + } + } +} + +// Gets the first descendant child of a node +function getfirstDescendant(node) { + if (node.hasChildren() && !node.collapsed) { return node.children[0]; } + return undefined; +} + +// Produces and displays an HTML representation of the tree +function drawTree() { + var frame = document.getElementById("absFrame"); + navigationControlString = new Array(); + frame.innerHTML = "<ul id='tree'>" + getTree(myTree, 0) + "</ul>"; + document.getElementById("link" + selectedNode).scrollIntoView(false); +} + +// Produces an HTML representation of the tree +function getTree(tree, level) { + navigationControlString[navigationControlString.length] = tree.name; + var htmlTree = ""; + htmlTree += "<li>"; + if (tree.hasChildren()) { + htmlTree += "<img class='tree-menu'"; + if (tree.collapsed) { + htmlTree += " src='plus.png'"; + } + else { htmlTree += " src='minus.png'"; } + htmlTree += " onclick='signClick(\"" + tree.name + "\", \"" + tree.caption + "\")' />"; + } + else { + htmlTree += "<img class='tree-menu' src='empty.png' />"; + } + htmlTree += "<a id='link" + tree.name + "'"; + if (document.getElementById("actRefine").className == "selected" || + document.getElementById("actReplace").className == "selected" || + document.getElementById("actWrap").className == "selected") { + htmlTree += "class='treeGray' "; } + else if (selectedNode == tree.name) { htmlTree += "class='treeSelected' "; } + else { htmlTree += "class='tree' "; } + htmlTree += "href='' onclick='nodeClick(\"" + tree.name + "\"); return false'>" + overl(tree.caption) + + " : " + tree.cat + "</a></li><ul>"; + if (tree.hasChildren() && !tree.collapsed) { + for (var i = 0, j = tree.children.length; i < j; i++) { + htmlTree += getTree(tree.children[i], level + 1); + } + } + htmlTree += "</ul>"; + return htmlTree; +} + +// Linearizes and displays the abstract tree +function drawLinearizedFrame() { + var frame = document.getElementById("conFrame"); + frame.innerHTML = getLinearizedFrame(); +} + +// Linearizes the abstract tree and returns it in HTML form +function getLinearizedFrame() { + var linearizedFrame = ""; + for (var i = 0; i < myConcrete.length; i++) { + // linearizedFrame += "<h4>" + myConcrete[i].concreteSyntaxName + "</h4>"; + linearizedFrame += "<p id='line" + myConcrete[i].concreteSyntaxName +"'>"; + var tokens = myConcrete[i].concreteSyntax.tagAndLinearize(abstractTree); + for (var j = 0, k = tokens.length; j < k; j++) { + linearizedFrame += createLinearized(tokens[j]); + } + linearizedFrame += "</p>"; + } + linearizedFrame += abstractTree.printOverl(); + + return linearizedFrame; +} + +// Creates an HTML representation of a linearization of an abstract tree +function createLinearized(token) { + var node = getNode(token.tag, myTree); + var linearized = "<span id='" + token.tag + "' class="; + if (node.name.substr(0, selectedNode.length) == selectedNode) { + linearized += "'selected'"; + } + else { + linearized += "'normal'"; + } + if (token == "&-") { linearized += "<br />"; } + else { linearized += " onclick='nodeClick(\"" + node.name + "\");'> " + token + " </span>"; } + return linearized; +} + +// Expands/Collapses node +function signClick(name, caption) { + myTree = expandCollapse(myTree, name); + nodeClick(name); +} + +// Sets the "collapsed" property of a given node +function expandCollapse(node, name) { + if (node.name == name) { + if (wasCollapsed(node.name)) { removeFromCollapseBuffer(node.name); } + else { collapseBuffer[collapseBuffer.length] = node.name; } + node.collapsed ^= true; + } + else { + for (var i = 0, j = node.children.length; i < j; i++) { + expandCollapse(node.children[i], name); + } + } + return node; +} + +// Checks if a node was collapsed on the previous cycle +function wasCollapsed(nodeName) { + for (var i = 0, j = collapseBuffer.length; i < j; i++) { + if (nodeName == collapseBuffer[i]) { + return true; + } + } + return false; +} + +// Removes a node from the collapseBuffer array +function removeFromCollapseBuffer(nodeName) { + var newBuffer = new Array(); + for (var i = 0, j = collapseBuffer.length; i < j; i++) { + if (nodeName != collapseBuffer[i]) { + newBuffer[newBuffer.length] = collapseBuffer[i]; + } + } + collapseBuffer = newBuffer; +} + +// Selects a node +function nodeClick(name) { + if ((document.getElementById("actRefine") && document.getElementById("actRefine").className == "selected") || + (document.getElementById("actReplace") && document.getElementById("actReplace").className == "selected") || + (document.getElementById("actWrap") && document.getElementById("actWrap").className == "selected")) { + return; } + selectedNode = name; + if (stringAbstractTree) { + document.getElementById(stringAbstractTree).value = abstractTree.show(); + } + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + drawTree(); + drawLinearizedFrame(); +} + +// Shows the available actions for a node +function showActions(caption) { + var node = getNode(selectedNode, myTree); + var abstractNode = getNodeFromAbstract(abstractTree, node.name, "0"); + var actions = "<table class='action'>"; + if (undoArray.length) { + actions += createAction("Undo", "action", "Undo", "Z"); } + else { actions += createAction("Undo", "unavailable", "Undo", "Z"); }; + if (redoArray.length) { + actions += createAction("Redo", "action", "Redo", "Y"); } + else { actions += createAction("Redo", "unavailable", "Redo", "Y"); } + if (node.caption == "?") { + actions += createAction("Cut", "unavailable", "Cut", "X"); + actions += createAction("Copy", "unavailable", "Copy", "C"); + var AbsNodeType = abstractNode.type; + if (clipBoard && (AbsNodeType == myAbstract.getCat(clipBoard.name))) { + actions += createAction("Paste", "action", "Paste", "V"); + } + else { actions += createAction("Paste", "unavailable", "Paste", "V"); } + actions += createAction("Delete", "unavailable", "Delete", "D"); + actions += createAction("Refine", "action", "Refine", "R"); + actions += createAction("Replace", "unavailable", "Replace", "E"); + actions += createAction("Wrap", "unavailable", "Wrap", "W") + } + else if (node.caption) { + actions += createAction("Cut", "action", "Cut", "X"); + actions += createAction("Copy", "action", "Copy", "C"); + actions += createAction("Paste", "unavailable", "Paste", "V"); + actions += createAction("Delete", "action", "Delete", "D"); + actions += createAction("Refine", "unavailable", "Refine", "R"); + actions += createAction("Replace", "action", "Replace", "E"); + actions += createAction("Wrap", "action", "Wrap", "W") + } + if (node && !abstractNode.isComplete()) { + actions += createAction("RandomNode", "action", "Fill out the node at random", "N"); + } + else { + actions += createAction("RandomNode", "unavailable", "Fill out the node at random", "N"); + } + if (!abstractTree.isComplete()) { + actions += createAction("RandomTree", "action", "Fill out the tree at random", "T"); + } + else { + actions += createAction("RandomTree", "unavailable", "Fill out the tree at random", "T"); + } + actions += "</table>"; + return actions; +} + +// Gets a node from the abstract tree +function getNodeFromAbstract(absNode, route, currRoute) { + if (route == currRoute) { + return absNode; + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + var found = getNodeFromAbstract(absNode.args[i], route, currRoute + "-" + i); + if (found) { return found } + } + } +} + +// Creates an action +function createAction(actionName, className, caption, hotKey) { + return "<tr id='act" + actionName + "' class='" + className +"' onclick='click" + + actionName + "(\"act" + actionName + "\")'><td class='action'>" + caption + + "</td><td class='hotKey'>(" + hotKey + ")</td></tr>"; +} + +// When the "Refine" action is selected, gets the appropriate refinements for a node +function clickRefine(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + refPageCounter = 0; + var node = getNodeFromAbstract(abstractTree, selectedNode, "0"); + if (node.type == "String") { + var newType = prompt('Enter a String','String'); + if (!newType) { newType = "AutoString" } + myAbstract.addType(newType,[], "String"); + for (var i = 0, j = myConcrete.length; i < j; i++) { + myConcrete[i].concreteSyntax.addRule(newType, function(cs){ return new Arr(new Str(newType));}); + } + node.name = newType; + abstractTree = insertNode(abstractTree, selectedNode, "0", node); + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + clearHotKeys(); + concludeAction(); + } + else { + document.getElementById("refFrame").innerHTML = showRefinements(selectedNode); + } + } + } +} + +// Sets the className of actName to "selected" and grays out the other selections +function highlightSelectedAction(actName) { + graySelections(actName); + document.getElementById(actName).className = "selected"; + drawTree(); +} + +// Grays out all actions except one +function graySelections(except) { + var refs = document.getElementById("actFrame").getElementsByTagName("tr"); + for (var i = 0, j = refs.length; i < j; i++) { + if (refs[i].id != except) { refs[i].className = "closed"; } + } +} + +// Pushes the abstract tree into the undo array and clears the redo array +function pushUndoClearRedo() { + undoArray.push(new state(selectedNode, abstractTree, collapseBuffer)); + redoArray.length = 0; +} + +// Gets the refinements to display +function showRefinements(nodeName) { + var refs = getAvailableRefinements(nodeName); + var pages = 0; + if (refs.length > 9) { pages = Math.floor(refs.length / 9); } + var upperLimit; + if (pages != refPageCounter) { upperLimit = (9 * refPageCounter) + 9; } + else { upperLimit = refs.length; } + var refinements = "<table class='refinement'>"; + var keyPos = 0; + refinements += ref_wrapToHtml("ref", "genRefRandom", "refinement", "", keyPos, "Choose at random"); + keys["" + keyPos] = mkRefHotKey("genRefRandom"); + keyPos++; + for (var i = (9 * refPageCounter), j = upperLimit; i < j; i++) { + refinements += ref_wrapToHtml("ref", refs[i], "refinement", "", keyPos, ""); + keys["" + keyPos] = mkRefHotKey(refs[i]); + keyPos++; + } + if (pages > refPageCounter) { + refinements += ref_wrapNextRefsToHtml("nextRefs", "Next", "refinement", "+", "Next Refinements"); + keys["107"] = mkRefNextRefsHotKey("Next"); + } + if (0 < refPageCounter) { + refinements += ref_wrapNextRefsToHtml("nextRefs", "Previous", "refinement", "-", "Previous Refinements"); + keys["109"] = mkRefNextRefsHotKey("Previous"); + } + refinements += "</table>"; + return refinements; +} + +// Gets the available refinements for a node +function getAvailableRefinements(nodeName) { + var node = getNodeFromAbstract(abstractTree, nodeName, "0"); + var metaType = node.type; + var refinements = new Array(); + for (var fun in myAbstract.types) { + if (myAbstract.types[fun].cat == metaType) { + refinements[refinements.length] = fun; + } + } + return refinements; +} + +// Creates an HTML representation of a Refinement/Wrap +function ref_wrapToHtml(funct, name, className, arg, hotKeyPos, caption) { + var ref_wrapHtml = "<tr id='" + funct + name + "' class=" + className + " onclick='" + funct + + "Click(\"" + name + "\"" + arg + ")'><td class='" + className + "'>"; + if (caption) { ref_wrapHtml += caption; } + else { ref_wrapHtml += overl(name) + " : " + refArgsToHtml(name) + myAbstract.getCat(name); } + ref_wrapHtml += "</td><td class='hotKey'>(" + hotKeyPos + ")</td></tr>"; + return ref_wrapHtml +} + + +// Creates the function to be used by a "numeric" hot key +function mkRefHotKey(refName) { + return function() { if (document.getElementById("ref" + refName)) { refClick(refName); } } +} + +// Creates an HTML representation of a Refinement/Wrap +function ref_wrapNextRefsToHtml(funct, name, className, hotKeyPos, caption) { + var ref_wrapHtml = "<tr id='" + funct + name + "' class=" + className + " onclick='" + funct + + "Click(\"" + name + "\")'><td class='" + className + "'>"; + ref_wrapHtml += caption; + ref_wrapHtml += "</td><td class='hotKey'>(" + hotKeyPos + ")</td></tr>"; + return ref_wrapHtml +} + +// Creates the function to be used by a "+" hot key +function mkRefNextRefsHotKey(refName) { + return function() { if (document.getElementById("nextRefs" + refName)) { nextRefsClick(refName); } } +} + +// Creates a string representation of the arguments of a refinement +function refArgsToHtml(fun) { + var args = ""; + for (var i = 0, j = myAbstract.types[fun].args.length; i < j; i++) { + args += myAbstract.types[fun].args[i] + " -> "; + } + return args; +} + +// Gets the type of a meta variable +function getMetaType(absNode, route, currRoute) { + if (route == currRoute && absNode.isMeta()) { + return absNode.type; + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + var found = getMetaType(absNode.args[i], route, currRoute + "-" + i); + if (found) { return found }; + } + } +} + +// When the "Undo" action is selected, undoes the last action +function clickUndo(actName) { + if (document.getElementById(actName).className == "action" && undoArray.length) { + highlightSelectedAction(actName); + redoArray.push(new state(selectedNode, abstractTree, collapseBuffer)); + var prevState = undoArray.pop(); + selectedNode = prevState.selectedNode; + abstractTree = myAbstract.copyTree(prevState.tree); + collapseBuffer = prevState.collapseBuffer; + if (abstractTree.isComplete()) { selectedNode = "0"; } + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + nodeClick(selectedNode); + } +} + +// When the "Redo" action is selected, redoes the last action +function clickRedo(actName) { + if (document.getElementById(actName).className == "action" && redoArray.length) { + highlightSelectedAction(actName); + undoArray.push(new state(selectedNode, abstractTree, collapseBuffer)); + var nextState = redoArray.pop(); + selectedNode = nextState.selectedNode; + abstractTree = myAbstract.copyTree(nextState.tree); + collapseBuffer = nextState.collapseBuffer; + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + nodeClick(selectedNode); + } +} + +// When the "Copy" action is selected, copies the selected node to the clipboard +function clickCopy(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + if (selectedNode) { + clipBoard = myAbstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0")); + document.getElementById("clipboardFrame").innerHTML = clipBoard.name + " : " + + myAbstract.getCat(clipBoard.name); + nodeClick(selectedNode); + } + } +} + +// When the "Cut" action is selected, deletes the selected node and copies it to the clipboard +function clickCut(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + clipBoard = myAbstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0")); + document.getElementById("clipboardFrame").innerHTML = clipBoard.name + " : " + + myAbstract.getCat(clipBoard.name); + abstractTree = deleteNode(abstractTree, selectedNode, "0"); + concludeAction(); + } + } +} + +// Annotates the abstract tree, creates a tree from the abstract tree and selects the next meta variable +function concludeAction() { + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + selectNextMeta(); +} + +// Selects the next meta variable available +function selectNextMeta() { + nodeClick(selectedNode); + if (!abstractTree.isComplete()) { + var pathToNextMeta = ""; + var nodePos = getNavPos(selectedNode); + while (1) { + if (nodePos == navigationControlString.length) { nodePos = 0; } + var node = getNode(navigationControlString[nodePos], myTree); + if (node.caption == "?") { pathToNextMeta = node.name; break; } + nodePos++; + } + expandAscendants(pathToNextMeta); + nodeClick(pathToNextMeta); + } +} + +// Gets the first meta variable from an abstract tree +function getNextMetaFromAbstract(node, route) { + if (node.isMeta()) { return route; } + for (var i = 0, j = node.args.length; i < j; i++) { + var found = getNextMetaFromAbstract(node.args[i], route + "-" + i); + if (found) { return found; } + } +} + +// Expands the ascendants of a given node +function expandAscendants(nodeName) { + var nodePath = nodeName.split("-"); + var currAscendant = nodePath.shift(); + while (nodePath.length > 0) { + var node = getNode(currAscendant, myTree); + if (node.collapsed) { + myTree = expandCollapse(myTree, currAscendant); + } + currAscendant += "-" + nodePath.shift(); + } +} + +// When the "Paste" action is selected, pastes the contents of the clipboard into the selected node +function clickPaste(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + abstractTree = insertNode(abstractTree, selectedNode, "0", myAbstract.copyTree(clipBoard)); + concludeAction(); + } + } +} + +// Inserts a node into a tree +function insertNode(absNode, route, currRoute, node) { + if (route == currRoute) { + return node; + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + absNode.setArg(i, insertNode(absNode.args[i], route, currRoute + "-" + i, node)); + } + return absNode; + } +} + +// When the "Delete" action is selected, deletes the selected node +function clickDelete(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + abstractTree = deleteNode(abstractTree, selectedNode, "0"); + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + nodeClick(selectedNode); + } + } +} + +// Deletes a node from a tree +function deleteNode(absNode, route, currRoute) { + if (route == currRoute) { + return new Fun("?"); + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + absNode.setArg(i, deleteNode(absNode.args[i], route, currRoute + "-" + i)); + } + return absNode; + } +} + +// When the "Replace" action is selected, replaces the selected node with another refinement +function clickReplace(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + abstractTree = deleteNode(abstractTree, selectedNode, "0"); + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + drawTree(); + document.getElementById("refFrame").innerHTML = showRefinements(selectedNode); + } + } +} + +// When the "Wrap" action is selected, wraps around the selected node with another refinement +function clickWrap(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + var node = getNode(selectedNode, myTree); + if (selectedNode) { + refPageCounter = 0; + var wrappers = getWrappers(node.caption); + document.getElementById("refFrame").innerHTML = wrappers; + if (wrappers.length <= 31) { + alert("No wrappers available"); + document.getElementById("actFrame").innerHTML = showActions(); + nodeClick(selectedNode); + } + } + } +} + +// Gets the wrappers to display +function getWrappers(nodeCaption) { + var nodeType = myAbstract.types[nodeCaption].cat; + var availWrappers = getAvailableWrappers(nodeType); + var pages = Math.floor(availWrappers.length / 9); + var upperLimit; + if (pages != refPageCounter) { upperLimit = (9 * refPageCounter) + 9; } + else { upperLimit = availWrappers.length - (9 * refPageCounter); } + var wrappers = "<table class='wrapper'>"; + var keyPos = 0; + for (var i = (9 * refPageCounter), j = (9 * refPageCounter) + upperLimit; i < j; i++) { + wrappers += ref_wrapToHtml("wrap", availWrappers[i][0], "wrapper", ", " + availWrappers[i][1], keyPos, ""); + keys["" + keyPos] = mkWrapHotKey(availWrappers[i][0], availWrappers[i][1]); + keyPos++; + } + if (pages > (9 * refPageCounter)) { + refinements += ref_wrapNextRefsToHtml("nextWraps", "Next", "wrapper", "+", "Next Wrappers"); + keys["107"] = mkWrapNextRefsHotKey("Next"); + } + if (0 < (9 * refPageCounter)) { + refinements += ref_wrapNextRefsToHtml("nextWraps", "Previous", "wrapper", "-", "Previous Wrappers"); + keys["109"] = mkWrapNextRefsHotKey("Previous"); + } + wrappers += "</table>"; + return wrappers; +} + +// Gets the available wrappers for a node +function getAvailableWrappers(nodeType) { + var wrappers = new Array(); + for (var fun in myAbstract.types) { + for (var i = 0, j = myAbstract.types[fun].args.length; i < j; i++) { + if (myAbstract.types[fun].args[i] == nodeType && myAbstract.types[fun].cat == nodeType) { + wrappers[wrappers.length] = new Array(fun, i); + break; + } + } + } + return wrappers; +} + +// Creates the function to be used by a "numeric" hot key +function mkWrapHotKey(refName, argPos) { + return function() { if (document.getElementById("wrap" + refName)) { wrapClick(refName, argPos); } } +} + +// Creates the function to be used by a "-" hot key +function mkWrapNextRefsHotKey(refName) { + return function() { if (document.getElementById("nextWraps" + refName)) { nextRefsClick(refName); } } +} + +// When the "RandomNode" action is selected, refines the node at random +function clickRandomNode(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + var tempTree = myAbstract.copyTree(abstractTree); + abstractTree = myAbstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0")); + fillSubTree() + abstractTree = insertNode(tempTree, selectedNode, "0", myAbstract.copyTree(abstractTree)); + concludeAction(); + } + } +} + +// Refines the sub tree +function fillSubTree() { + while (!abstractTree.isComplete()) { + var nodeToRefine = getNextMetaFromAbstract(abstractTree, "0"); + if (nodeToRefine) { + var refs = getAvailableRefinements(nodeToRefine); +// FIX THIS ASAP!!!! + if (refs.length == 0) { + var node = getNodeFromAbstract(abstractTree, nodeToRefine, "0"); + if (node.type == "String") { + var newType = "AutoString"; + myAbstract.addType(newType,[], "String"); + for (var i = 0, j = myConcrete.length; i < j; i++) { + myConcrete[i].concreteSyntax.addRule(newType, function(cs){ return new Arr(new Str(newType));}); + } + node.name = newType; + abstractTree = insertNode(abstractTree, nodeToRefine, "0", node); + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + } + } + else { + var selectedRef = refs[Math.floor(refs.length * Math.random())]; + abstractTree = refineAbstractTree(abstractTree, nodeToRefine, "0", selectedRef); + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + } +/* + var selectedRef = refs[Math.floor(refs.length * Math.random())]; + abstractTree = refineAbstractTree(abstractTree, nodeToRefine, "0", selectedRef); + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); +*/ + } + } +} + +// When the "RandomTree" action is selected, refines the tree at random +function clickRandomTree(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + fillSubTree(); + concludeAction(); + } +} + +// If a node is selected and is of type meta, it refines the node with a type refName +function refClick(refName) { + if (selectedNode) { + if (refName == "genRefRandom") { + var refs = getAvailableRefinements(selectedNode); + refName = refs[Math.floor(refs.length * Math.random())]; + } + abstractTree = refineAbstractTree(abstractTree, selectedNode, "0", refName); + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + clearHotKeys(); + concludeAction(); + } +} + +// If a refinement is selected, a node has the property "selected" set and the node is a meta variable, +// it refines node. Returns the refined abstract tree +function refineAbstractTree(absNode, route, currRoute, refName) { + if (route == currRoute && absNode.isMeta()) { + return createRefinement(refName); + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + absNode.setArg(i, refineAbstractTree(absNode.args[i], route, currRoute + "-" + i, refName)); + } + return absNode; + } +} + +// Creates a Fun of type refName object with the appropriate number of meta arguments +function createRefinement(refName) { + var newRef = new Fun(refName); + for (var i = 0, j = myAbstract.types[refName].args.length; i < j; i++) { + newRef.setArg(i, new Fun("?")); + } + return newRef; +} + +// Creates a tree from an abstract tree +function treeFromAbstract(abstractNode, name) { + var node = new treeNode(name, abstractNode.name); + if (node.caption == "?") { + node.cat = abstractNode.type; } + else { node.cat = myAbstract.getCat(node.caption); } + if (wasCollapsed(node.name)) { node.collapsed = true; } + for (var i = 0, j = abstractNode.args.length; i < j; i++) { + node.addChild(i, treeFromAbstract(abstractNode.args[i], name + "-" + i)); + } + return node +} + +// Wraps a refinement around a node +function wrapClick(refName, argPos) { + if (selectedNode) { + var tempNode = createRefinement(refName); + tempNode.setArg(argPos, myAbstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0"))); + abstractTree = insertNode(abstractTree, selectedNode, "0", tempNode); + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + clearHotKeys(); + concludeAction(); + } +} + +// Handler for the escape key +function clickEsc() { + if ((document.getElementById("actRefine").className == "selected" || + document.getElementById("actReplace").className == "selected" || + document.getElementById("actWrap").className == "selected") && undoArray.length) { + var prevState = undoArray.pop(); + selectedNode = prevState.selectedNode; + abstractTree = myAbstract.copyTree(prevState.tree); + collapseBuffer = prevState.collapseBuffer; + abstractTree = myAbstract.annotate(abstractTree, myAbstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + document.getElementById("actFrame").innerHTML = showActions(); + if (selectedNode) { nodeClick(selectedNode) } + } +} + +// If there are over ten refinements available shows only the selected nine +function nextRefsClick(refName) { + if (refName == "Next") { refPageCounter++; } else { refPageCounter--; } + clearHotKeys(); + document.getElementById("refFrame").innerHTML = showRefinements(selectedNode); +} + + +// show overloaded name: ignore prefix ovr*_ +function overl(name){ + var nam = ""; + if (name[0] + name[1] + name[2]=="ovr") { + i = 5 ; + while (name[i] != '_') {++i} + for (j = i+1 ; j != name.length ; ++j){ nam += name[j] ;} + } + else nam = name ; + return nam; +} + +Fun.prototype.printOverl = function () { return this.showOverl(0); } ; +Fun.prototype.showOverl = function (prec) { + if (this.isMeta()) { + return '?'; + + } else { + var s = overl(this.name); + var cs = this.args; + for (var i in cs) { + s += " " + cs[i].showOverl(1); + } + if (prec > 0 && cs.length > 0) { + s = "(" + s + ")" ; + } + return s; + } +};
@@ -0,0 +1,42 @@+<!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>+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />+ <link rel="stylesheet" type="text/css" href="style.css" />+ <script type="text/javascript" src="gflib.js"></script>+ <script type="text/javascript" src="grammar.js"></script>+ <script type="text/javascript" src="grammarReference.js"></script> + <script type="text/javascript" src="code.js"></script>+ <title>Syntax Editor for GF Resource Grammar Library</title>+ </head>+ <body onload="nodeClick('0', '?')" onkeydown="hotKeys(event)">+ <h2>Syntax Editor for GF Resource Grammar Library</h2>+ <div id="wrapper">+ <div id="absFrame">+ </div>+ <div id="conFrame">+ </div>+ <div id="actFrame">+ </div>+ <div id="refFrame">+ </div>+ <div id="messageFrame">+ </div>+ <div id="clipboardFrame">+ </div>+ </div>+<p>++Languages shown: English, Russian, Swedish.++<p>++Example: <i>I love you</i> is obtained by <tt>r7 r3 r+7 r2 r+++3 r+7 r9</tt>++<p>++More information: <a href="../../lib/resource/doc/synopsis.html">resource synopsis</a>.++ </body>+</html>
binary file changed (absent → 161 bytes)
@@ -0,0 +1,333 @@++/* Extension to the String object */++String.prototype.tag = "";+String.prototype.setTag = function (tag) { this.tag = tag; };++/* 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 this.args) {+ if (!this.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()]; };+Arr.prototype.setTag = function(tag) {+ for (var i = 0, j = this.arr.length; i < j; i++) {+ this.arr[i].setTag(tag);+ }+};++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; +};+Seq.prototype.setTag = function(tag) {+ for (var i = 0, j = this.seq.length; i < j; i++) {+ this.seq[i].setTag(tag);+ }+};++function Variants() { this.variants = copy_arguments(arguments, 0); }+Variants.prototype.tokens = function() { return this.variants[0].tokens(); };+Variants.prototype.sel = function(i) { return this.variants[0].sel(i); };+Variants.prototype.toIndex = function() { return this.variants[0].toIndex(); };+Variants.prototype.setTag = function(tag) {+ for (var i = 0, j = this.variants.length; i < j; i++) {+ this.variants[i].setTag(tag);+ }+};++function Rp(index,value) { this.index = index; this.value = value; }+Rp.prototype.tokens = function() { return new Array(this.index.tokens()); };+Rp.prototype.sel = function(i) { return this.value.arr[i.toIndex()]; };+Rp.prototype.toIndex = function() { return this.index.toIndex(); };+Rp.prototype.setTag = function(tag) { this.index.setTag(tag) };++function Suffix(prefix,suffix) {+ this.prefix = new String(prefix);+ if (prefix.tag) { this.prefix.tag = prefix.tag; }+ this.suffix = suffix;+};+Suffix.prototype.tokens = function() {+ var xs = this.suffix.tokens();+ for (var i in xs) {+ xs[i] = new String(this.prefix + xs[i]);+ xs[i].setTag(this.prefix.tag);+ }+ return xs;+};+Suffix.prototype.sel = function(i) { return new Suffix(this.prefix, this.suffix.sel(i)); };+Suffix.prototype.setTag = function(tag) { if (!this.prefix.tag) { this.prefix.setTag(tag); } };++function Meta() { }+Meta.prototype.tokens = function() { + var newString = new String("?");+ newString.setTag(this.tag);+ return new Array(newString);+};+Meta.prototype.toIndex = function() { return 0; };+Meta.prototype.sel = function(i) { return this; };+Meta.prototype.setTag = function(tag) { if (!this.tag) { this.tag = tag; } };++function Str(value) { this.value = value; }+Str.prototype.tokens = function() {+ var newString = new String(this.value); + newString.setTag(this.tag);+ return new Array(newString);+};+Str.prototype.setTag = function(tag) { if (!this.tag) { this.tag = tag; } };++function Int(value) { this.value = value; }+Int.prototype.tokens = function() {+ var newString = new String(this.value.toString());+ newString.setTag(this.tag);+ return new Array(newString);+};+Int.prototype.toIndex = function() { return this.value; };+Int.prototype.setTag = function(tag) { if (!this.tag) { this.tag = tag; } };++/* Type annotation */++function Abstract(startcat) {+ this.types = new Array();+ this.startcat = startcat;+}+Abstract.prototype.addType = function(fun, args, cat) {+ this.types[fun] = new Type(args, cat);+} ;+Abstract.prototype.getArgs = function(fun) {+ return this.types[fun].args;+}+Abstract.prototype.getCat = function(fun) {+ return this.types[fun].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 == '?') {+ var tree = this.parseTree_(tokens, 0);+ 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[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]));+ }+ var newTerm = this.rule(tree.name, cs);+ return newTerm;+ }+};+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;+};+Concrete.prototype.tagAndLinearize = function (tree) {+// return this.tagAndLinearizeToTerm(tree, "0").tokens();+ var treeTerms = this.tagAndLinearizeToTerm(tree, "0");+ var treeTokens = treeTerms.tokens(); + return treeTokens;+};+Concrete.prototype.tagAndLinearizeToTerm = function (tree, route) {+ if (tree.isMeta()) {+ if (isUndefined(tree.type)) {+ var newMeta = new Meta();+ newMeta.setTag(route);+ return newMeta;+ } else {+ var newTerm = this.lindef(tree.type, tree.name);+ newTerm.setTag(route);+ return newTerm;+ }+ } else {+ var cs = new Array();+ for (var i in tree.args) {+ cs.push(this.tagAndLinearizeToTerm(tree.args[i], route + "-" + i));+ }+ var newTerm = this.rule(tree.name, cs);+ newTerm.setTag(route);+ return newTerm;+ }+};++/* 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;+}
file too large to diff
@@ -0,0 +1,10 @@+// Grammar Reference+function concreteReference(concreteSyntax, concreteSyntaxName) {+this.concreteSyntax = concreteSyntax;+this.concreteSyntaxName = concreteSyntaxName;+}+var myAbstract = OverLang ;+var myConcrete = new Array();+myConcrete.push(new concreteReference(OverLangEng,"OverLangEng"));+myConcrete.push(new concreteReference(OverLangRus,"OverLangRus"));+myConcrete.push(new concreteReference(OverLangSwe,"OverLangSwe"));
@@ -0,0 +1,21 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">+<HTML>+ <HEAD>+ <TITLE>Index of /~aarne/GF/demos/overl</TITLE>+ </HEAD>+ <BODY>+<H1>Index of /~aarne/GF/demos/overl</H1>+<PRE><IMG SRC="/icons/blank.gif" ALT=" "> <A HREF="?N=D">Name</A> <A HREF="?M=A">Last modified</A> <A HREF="?S=A">Size</A> <A HREF="?D=A">Description</A>+<HR>+<IMG SRC="/icons/back.gif" ALT="[DIR]"> <A HREF="/~aarne/GF/demos/">Parent Directory</A> 20-Dec-2007 23:44 - +<IMG SRC="/icons/unknown.gif" ALT="[ ]"> <A HREF="code.js">code.js</A> 20-Dec-2007 22:46 33k +<IMG SRC="/icons/text.gif" ALT="[TXT]"> <A HREF="editor.html">editor.html</A> 29-Oct-2007 09:58 1k +<IMG SRC="/icons/image2.gif" ALT="[IMG]"> <A HREF="empty.png">empty.png</A> 04-Oct-2007 10:45 1k +<IMG SRC="/icons/unknown.gif" ALT="[ ]"> <A HREF="gflib.js">gflib.js</A> 20-Dec-2007 22:40 9k +<IMG SRC="/icons/unknown.gif" ALT="[ ]"> <A HREF="grammar.js">grammar.js</A> 20-Dec-2007 23:16 3.4M +<IMG SRC="/icons/unknown.gif" ALT="[ ]"> <A HREF="grammarReference.js">grammarReference.js</A> 20-Dec-2007 23:16 1k +<IMG SRC="/icons/image2.gif" ALT="[IMG]"> <A HREF="minus.png">minus.png</A> 04-Oct-2007 10:46 1k +<IMG SRC="/icons/image2.gif" ALT="[IMG]"> <A HREF="plus.png">plus.png</A> 04-Oct-2007 10:46 1k +<IMG SRC="/icons/text.gif" ALT="[TXT]"> <A HREF="style.css">style.css</A> 29-Oct-2007 10:05 3k +</PRE><HR>+</BODY></HTML>
binary file changed (absent → 201 bytes)
binary file changed (absent → 229 bytes)
@@ -0,0 +1,198 @@+body {+ font-family:arial,helvetica,sans-serif;+ font-size:12px;+ background-color: white;+}++#wrapper {+ width:600px;+ height:520px;+ margin:auto 50px;+ border:1px solid gray;+ padding:10px;++}++#absFrame {+ width:180px;+ height:250px;+ padding:10px;+ border:1px solid gray;+ float:left;+ white-space: nowrap;+}++#conFrame {+ width:366px;+ height:250px;+ margin-left:10px;+ padding:10px;+ border:1px solid gray;+ float:left;+ white-space: normal;+ overflow:auto;+}++#actFrame {+ width:180px;+ height:170px;+ margin-top:10px;+ padding:10px;+ border:1px solid gray;+ float:left;+ overflow:auto;+}++#refFrame {+ width:366px;+ height:170px;+ margin-left:10px;+ margin-top:10px;+ padding:10px;+ border:1px solid gray;+ float:left;+ overflow:auto;+}++#messageFrame {+ width:366px;+ height:15px;+ margin-top:10px;+ margin-right:10px;+ padding:10px;+ border:1px solid gray;+ float:left;+ overflow:auto;+}++#clipboardFrame {+ width:180px;+ height:15px;+ margin-top:10px;+ padding:10px;+ border:1px solid gray;+ float:left;+ overflow:auto;+}++#tree {+ left: -10px;+ top: -10px; + width: 180px;+ height: 250px;+ margin: 0px;+ padding: 10px;+ overflow: auto;+}++ul {+ position: relative;+ list-style: none;+ margin-left: 20px;+ padding: 0px;+}++li {+ position: relative;+}++img.tree-menu {+ margin-right: 5px;+}++a.tree:link, a.tree:visited, a.tree:active {+ color: black;+ background-color: white;+ text-decoration: none;+ margin-right:10px;+}++a.tree:hover {+ color: blue;+ background-color: white;+ text-decoration: underline;+ margin-right:10px;+}++a.treeSelected:link, a.treeSelected:visited, a.treeSelected:active {+ color: white;+ background-color: #3366CC;+ text-decoration: none;+ margin-right:10px;+}++a.treeSelected:hover {+ color: white;+ background-color: #3366CC;+ text-decoration: underline;+ margin-right:10px;+}++table.action, table.refinement, table.wrapper {+ margin: 0px;+ padding: 0px;+ border-style: none;+ border-collapse: collapse;+ border-spacing: 0px;+}++tr.selected {+ color: white;+ background-color: #3366CC;+}++tr.unavailable, tr.closed {+ color: silver;+ background-color: white;+}++tr.unavailable:hover {+ color: silver;+ background-color: #3366CC;+}++tr.action, tr.refinement, tr.wrapper {+ color: black;+ background-color: white;+}++tr.action:hover, tr.refinement:hover, tr.wrapper:hover {+ color: white;+ background-color: #3366CC;+}++td.action {+ width: 220px;+ margin: 0px;+ padding: 0px;+}++td.refinement, td.wrapper {+ width: 515px;+ margin: 0px;+ padding: 0px;+}++td.hotKey {+ width: 30px;+ margin: 0px;+ padding: 0px;+ text-align: right;+}++p {+ margin-bottom: 40px;+ text-align: justify;+}++span.normal {+ color: black;+ background-color: white;+ text-decoration: none;+}++span.selected {+ color: white;+ background-color: #3366CC;+ text-decoration: none;+}
@@ -0,0 +1,19 @@+Computational Grammars for the World+The GF Resource Grammar Library++++Did you ever struggle with the inflection of French verbs? Or with getting the words in a German sentence into the right order? +Don't worry: these problems are as easy for a computer as to calculate 2+2. This page will give you access to computer programs that+- help you construct sentences and other expressions+- help you inflect words+- help you covert sentences to different tenses, and other similar operations+- help you compare languages by translating them and linking corresponding parts+- allow you to practice your language skills by automatically generated and graded exercises+- explain grammar rules in a mathematically precise and shortest possible manner+++//Coming soon!// for 29 languages.++Powered by [GF ..] and its [Resource Grammar Library ../lib/doc/synopsis.html]+
@@ -0,0 +1,100 @@+Translation with GF+Powered by multilingual grammars++%!style:../css/style0.css+%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.svg" alt=""></a>+%!postproc(html): #GFWCT <iframe style="border: 0; width: 100%; height: 50ex;" src="http://cloud.grammaticalframework.org/wc.html#embed"></iframe>++==Try it online==++%**Coming soon**:+%//Here you will be able to select your source and target language and translate% whatever you want.//+#GFWCT+++==Download the app==++[App description and download page ./app.html]+++==Colours==++- **Green: semantic translation**, should be correct.+ But not necessarily the only correct one. +- **Yellow: syntactic translation**, should be grammatically correct.+ But can be very strange in its interpretation and choice of words.+- **Light red: chunk translation**, probably incorrect.+ Builds the translation from small pieces.+- **Dark red: word-by-word translation**, almost certainly incorrect.+ Builds the translation word by word and returns unknown words verbatim.+++The green translations currently come from a tourist phrasebook, which allows+you to translate things like "hello" and "how far is the airport from+the hotel". But this part can be easily adapted to other uses, such as+technical language.+++==What you can expect==++The program is designed to translate anything, just like Google translate and Bing. It has some advantages over them:+- It uses **grammars** (as opposed to statistics), which makes it more correct in many cases.+- It is **open source**, which means you can inspect, copy, and modify it in what ever way you want.+- It is **light weight**, so that you can run it on your own computer and even on a smartphone.+- It gives you **linguistic information**, such as word inflections.+- It gives you **confidence information**, warning about translations that it is not so sure about.+++However, this is not a mature product but a research prototype. It therefore has some shortcomings:+- It has **limited coverage**, which means that it misses many words and syntactic constructions.+- It can be **clumsy**, for instance when it doesn't detect an idiom but translates too literally.+- It can be **slow**, in particular with long sentences and with some input languages.+++Here are some hints to use it in a satisfactory way:+- Start with short sentences (less than ten words), preferably from English or Swedish, to get an idea of the best performance.+- Take a look at the alternative translations, in particular for sentences with low confidence level.+- Send us feedback, and consider contributing to the improvement of the system!++++The following table gives a rough idea of what to expect for each+language (the speech column refers to the Android app):+'''+<center>+<table rules=all border=yes>+<tr> <th></th> <th>coverage</th> <th>quality</th> <th>speed</th> <th>speech</th> </tr>+<tr> <th>Bulgarian</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td><td bgcolor=palegreen></td> <td bgcolor=yellow>in only</td></tr>+<tr> <th>Chinese</th> <td bgcolor=pink></td> <td bgcolor=pink></td> <td bgcolor=palegreen></td> <td bgcolor=yellow>diff in/out</td> </tr>+<tr> <th>Dutch</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td> <td bgcolor=yellow></td> <td bgcolor=palegreen></td> </tr>+<tr> <th>English</th> <td bgcolor=palegreen></td> <td bgcolor=palegreen></td> <td bgcolor=palegreen></td> <td bgcolor=palegreen></td> </tr>+<tr> <th>Finnish</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>French</th> <td bgcolor=pink></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>German</th> <td bgcolor=pink></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>Hindi</th> <td bgcolor=pink></td> <td bgcolor=pink></td> <td bgcolor=yellow></td> <td bgcolor=yellow>out only</td> </tr>+<tr> <th>Italian</th> <td bgcolor=pink></td> <td bgcolor=pink></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>Spanish</th> <td bgcolor=pink></td> <td bgcolor=yellow></td><td bgcolor=pink></td> <td bgcolor=palegreen></td></tr>+<tr> <th>Swedish</th> <td bgcolor=yellow></td> <td bgcolor=yellow></td> <td bgcolor=palegreen></td> <td bgcolor=palegreen></td> </tr>+</table>+</center>+'''+++==How it works==++Powered by [Grammatical Framework ../]++[Slides https://docs.google.com/presentation/d/1545yYmTlWgzyV1uwUwuvAsOCzdD1AIUdV_NZbZ1qMEo/edit?usp=sharing]+explaining the translation method:+++==Get the sources==++Download from [here ../download/]+++==Send us feedback==++++
binary file changed (absent → 38600 bytes)
binary file changed (absent → 1369 bytes)
binary file changed (absent → 940 bytes)
binary file changed (absent → 6442 bytes)
@@ -0,0 +1,1 @@+<?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> <svg width="320" height="240" version="1.1" xmlns="http://www.w3.org/2000/svg"> <desc>Grammatical Framework Logo</desc> <path d="M157.5,225.5 v-51 h59 m-59,0 v-53 h114 a110.5,105 0 1,1 -24,-66" fill="none" stroke="red" stroke-width="4" stroke-linejoin="round" stroke-linecap="round"/> </svg>
binary file changed (absent → 6125 bytes)
@@ -0,0 +1,1 @@+<?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> <svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg"> <desc>Grammatical Framework Logo</desc> <path d="M200,25 a120,100 0 1,0 51,81 h-120 v100 m0,-50 h50" fill="none" stroke="red" stroke-width="4" stroke-linejoin="round" stroke-linecap="round"/> </svg>
@@ -0,0 +1,14 @@+<?xml version="1.0" standalone="no"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">++<svg width="240" height="240" version="1.1" xmlns="http://www.w3.org/2000/svg">+ <filter id="A"><feGaussianBlur stdDeviation="2"/></filter> + <path filter="url(#A)"+ d="M120,227.5 v-51 h59 m-59,0 v-53 h114 a110.5,105 0 1,1 -24,-66"+ fill="none" stroke="black" stroke-width="4" opacity="0.25"+ stroke-linejoin="round" stroke-linecap="round"/>+ <path d="M120,225.5 v-51 h59 m-59,0 v-53 h114 a110.5,105 0 1,1 -24,-66"+ fill="none" stroke="red" stroke-width="4"+ stroke-linejoin="round" stroke-linecap="round"/>+</svg>
@@ -0,0 +1,12 @@+gf-help-full.txt::+ { echo ; echo ; echo ; } > $@+ echo help -full -t2t | gf -run >> $@++### Converting SVG logos to PNG, using convert from ImageMagick+logos:: Logos/gf00.png Logos/gf0.png++Logos/gf00.png: Logos/gf00.svg Makefile+ convert -background 'rgba(255,255,255,0)' -size 264x216 -depth 8 $< $@++Logos/gf0.png: Logos/gf0.svg Makefile+ convert -background 'rgba(255,255,255,0)' -size 320x240 -depth 8 $< $@
binary file changed (absent → 84251 bytes)
@@ -0,0 +1,29 @@+#!/bin/bash++DARCS=`which darcs`+SSH=`which ssh`+REPOSERVER=gfreposerver++if [ ! -x "$SSH" ]; then+ echo "ssh ($SSH): command not found" 1>&2+ exit 1+fi++if [ "$1" = "--stop" ]; then+ $SSH -O exit "$REPOSERVER"+ exit $?+fi++if [ ! -x "$DARCS" ]; then+ echo "darcs ($DARCS): command not found" 1>&2+ exit 1+fi++if ! $SSH -O check "$REPOSERVER" >& /dev/null; then+ echo "Connection to $REPOSERVER is down, connecting..."+ $SSH -f -M "$REPOSERVER" \+ "bash -c 'while true; do echo -n .; sleep 30; done'" > /dev/null+ sleep 1+fi++exec $DARCS "$@"
@@ -0,0 +1,2749 @@+@STRING{fac = "Formal Aspects of Computing"}+@STRING{amai = "Annals of Mathematics and Artificial Intelligence"}+@STRING{jsl = "Journal of Symbolic Logic"}+@STRING{jsc = "Journal of Symbolic Computation"}+@STRING{jlc = "Journal of Logic and Computation"}+@STRING{jlp = "Journal of Logic Programming"}+@STRING{JFP = "Journal of {F}unctional {P}rogramming"}+@STRING{jar = "Journal of Automated Reasoning"}+@STRING{sl = "Studia Logica"}+@STRING{ipl = "Information Processing Letters"}+@STRING{tcs = "Theoretical Computer Science"}+@STRING{lnm = "Lecture Notes in Mathematics"}+@STRING{lncs = "LNCS"}+@STRING{lnai = "LNCS"}+@STRING{spv = "Springer-Verlag"}+@STRING{cacm = "Communications of the {ACM}"}+@STRING{jacm = "Journal of the {ACM}"}+@STRING{sc = "Soft Computing---A Fusion of Foundations, Methodologies+ and Applications"}++@article{goldsmith,+ author = {John Goldsmith},+ title = {{An Algorithm for the Unsupervised Learning of Morphology}},+ journal = {{Nat. Lang. Eng.}},+ volume = {12},+ number = {4},+ year = {2006},+ issn = {1351-3249},+ pages = {353--371},+ doi = {http://dx.doi.org/10.1017/S1351324905004055},+ publisher = {Cambridge University Press},+ address = {New York, NY, USA},+ }++@article{creutz,+ author = {Mathias Creutz and Krista Lagus},+ title = {{Unsupervised Models for Morpheme Segmentation and Morphology Learning}},+ journal = {{ACM Trans. Speech Lang. Process.}},+ volume = {4},+ number = {1},+ year = {2007},+ issn = {1550-4875},+ pages = {3},+ doi = {http://doi.acm.org/10.1145/1187415.1187418},+ publisher = {ACM},+ address = {New York, NY, USA},+ }++@article{swadesh,+ author = {Morris Swadesh},+ title = {{Towards Greater Accuracy in Lexicostatistic Dating}},+ journal = {{International Journal of American Linguistics}},+ volume = {21},+ year = {1955},+ pages = {121--137}+ }++@INPROCEEDINGS{isar,+ AUTHOR = {M. Wenzel},+ TITLE = {{Isar - a Generic Interpretative Approach to Readable Formal Proof Documents}},+ BOOKTITLE = {{Theorem Proving in Higher Order Logics, TPHOLs'99}},+ YEAR = {1999},+ series = lncs,+ volume = {1690},+ EDITOR = {Y. Bertot and G. Dowek and A. Hirschowitz and C. Paulin and L. Th\'{e}ry}+}++@INPROCEEDINGS{pollard-hog,+ AUTHOR = {C. Pollard},+ TITLE = {{Higher-Order Categorial Grammar}},+ BOOKTITLE = {{Proceedings of the + Conference on Categorial Grammars (CG2004), Montpellier, France}},+ PAGES = {340--361},+ YEAR = {2004},+ EDITOR = {M. Moortgat}+}++@INPROCEEDINGS{muskens-lg,+ AUTHOR = {R. Muskens},+ TITLE = {Lambda {G}rammars and the {S}yntax-{S}emantics+ {I}nterface},+ BOOKTITLE = {Proceedings of the Thirteenth Amsterdam Colloquium},+ PAGES = {150--155},+ YEAR = {2001},+ EDITOR = {van Rooy, R. and Stokhof, M.},+ PS = {amscoll.ps},+ PDF = {amscoll.pdf},+ ADDRESS = {Amsterdam}+}++@inproceedings{degroote-acg,+ title = {{Towards Abstract Categorial Grammars}},+ author = {Ph. de Groote},+ booktitle = {{Association for Computational Linguistics, + 39th Annual Meeting and 10th Conference of the European Chapter, Toulouse, France}},+ pages = {148--155},+ year = {2001}+}++@misc{talk-deliv,+ author = {P. Ljungl\"of and G. Amores and R. Cooper and D. Hjelm and O. Lemon and P. Manchón+ and G. Pérez and A. Ranta},+ year = 2006,+ title = {{Multimodal Grammar Library}},+ note = {{TALK. Talk and Look: + Tools for Ambient Linguistic Knowledge. IST-507802. Deliverable 1.2b}}+ }++@INCOLLECTION{mar82,+ AUTHOR = "{Martin-L\"{o}f}, Per",+ TITLE = "Constructive mathematics and computer programming",+ EDITOR = "Cohen and Los and Pfeiffer and Podewski",+ BOOKTITLE = "Logic, Methodology and Philosophy of Science VI",+ PUBLISHER = {North-Holland},+ ADDRESS = {Amsterdam},+ YEAR = {1982},+ PAGES = {153-175}}+++@inproceedings{wiedijk,+ AUTHOR = {F. Wiedijk},+ BOOKTITLE = {{Types for Proofs and Programs}},+ PUBLISHER = {Springer},+ SERIES = {LNCS 3085},+ editors = {S. Berardi and M. Coppo and F. Damiani},+ PAGES = {378--393},+ TITLE = {{Formal Proof Sketches}}, + YEAR = {2004}+ }++@inproceedings{bender,+ author = {Bender, Emily M. and Flickinger, Dan},+ title = {Rapid Prototyping of Scalable Grammars: + Towards Modularity in Extensions to a Language-Independent Core},+ booktitle = {Proceedings of the 2nd International Joint Conference on + Natural Language Processing IJCNLP-05 (Posters/Demos)},+ address = {Jeju Island, Korea},+ year = 2005+}++@book{keybook,+ AUTHOR = {B. Beckert and R. Hähnle and P. Schmitt},+ TITLE = {{Verification of Object-Oriented Software: The KeY Approach}},+ YEAR = {2006},+ series = lncs,+ volume = {4334}, + PUBLISHER = {{Springer-Verlag}}+}++@book{CopestakeLKB,+ AUTHOR = {A. Copestake},+ TITLE = {{Implementing Typed Feature Structure Grammars}},+ YEAR = {2002},+ PUBLISHER = {{CSLI Publications}}+}++@book{stroustrup,+ AUTHOR = {B. Stroustrup},+ TITLE = {{The C++ Programming Language, Third Edition}},+ YEAR = {1998},+ PUBLISHER = {{Addison-Wesley}}+}+++@techreport{bringert,+ author = {B. Bringert},+ title = {{Embedded Grammars}},+ institution = {Department of Computing Science, Chalmers University+ of Technology},+ type = {{MSc Thesis}},+ year = {2004}+}++@techreport{humayoun,+ author = {M. Humayoun},+ title = {{Urdu Morphology, Orthography and Lexicon Extraction}},+ institution = {Department of Computing Science, Chalmers University+ of Technology},+ type = {{MSc Thesis}},+ year = {2006}+}+++@inproceedings{khegai-acl,+ title = {{GF Parallel Resource Grammars and Russian}},+ author = {J. Khegai},+ booktitle = {{Coling/ACL 2006}},+ pages = {475--482},+ year = {2006}+}++@inproceedings{bos-steedman,+ title = {{Wide-Coverage Semantic Representations from a CCG Parser}},+ author = {J. Bos and S. Clark and M. Steedman and J. Curran and J. Hockenmaier},+ booktitle = {{Coling 2004}},+ year = {2004}+}++@inproceedings{FM,+ title = {{Functional Morphology}},+ author = {M. Forsberg and A. Ranta},+ booktitle = {{ICFP 2004, Showbird, Utah}},+ pages = {213-223},+ year = {2004}+}++@inproceedings{ranta-features,+ title = {{Features in Abstract and Concrete Syntax}},+ author = {A. Ranta},+ booktitle = {{NODALIDA Workshop on Typed Feature Structure Grammars, Tartu, 24 May 2007}},+ year = {2007}+}+++@inproceedings{eldada,+ title = {{Implementing an Open Source Arabic Resource Grammar in GF}},+ author = {A. El Dada and A. Ranta},+ booktitle = {{20th Arabic Linguistics Symposium. Western Michigan University March 3-5 2006}},+ year = {2006}++}++@incollection{eldada-book,+ title = {{Implementing an Open Source Arabic Resource Grammar in GF}},+ author = {A. El Dada and A. Ranta},+ booktitle = {{Perspectives on Arabic Linguistics XX}},+ editor = {M.A. Mughazy},+ publisher = {{John Benjamin's}},+ pages = {209--232},+ year = {2007}++}++@inproceedings{nganga-africa,+ title = {{Multilingual content development for eLearning in Africa}},+ author = {W. Ng'ang'a},+ booktitle = {{1st Pan-African Conference on ICT for Development, Education and Training. + 24-26 May 2006, Addis Ababa, Ethiopia}},+ year = {2006}++}++@inproceedings{bringert-speechgram,+ title = {{Speech Recognition Grammar Compilation in Grammatical Framework}},+ author = {B. Bringert},+ booktitle = {{SPEECHGRAM 2007: ACL Workshop on Grammar-Based Approaches to Spoken + Language Processing, June 29, 2007, Prague}},+ year = {2007}+}++@inproceedings{perera-ranta,+ title = {{Dialogue System Localization with the GF Resource Grammar Library}},+ author = {N. Perera and A. Ranta},+ booktitle = {{SPEECHGRAM 2007: ACL Workshop on Grammar-Based Approaches to Spoken + Language Processing, June 29, 2007, Prague}},+ year = {2007}+}++++@inproceedings{caprotti,+ title = {{WebALT! Deliver Mathematics Everywhere}},+ author = {O. Caprotti},+ booktitle = {{Proceedings of SITE 2006. Orlando March 20-24}},+ year = {2006}+}++@inproceedings{ranta-kahn,+ title = {{Grammars as Software Libraries}},+ author = {A. Ranta},+ booktitle = {{From Semantics to Computer Science}},+ editor = {Y. Bertot and G. Huet and J-J. L\'evy and G. Plotkin},+ publisher = {{Cambridge University Press}},+ year = {2008}+}++++@ARTICLE{landin,+ AUTHOR = "P. Landin",+ TITLE = "The Next 700 Programming Languages",+ JOURNAL = {{Communications of the ACM}},+ VOLUME = {9},+ PAGES = {157--166},+ YEAR = {1966} +}++@techreport{KeY2003,+ author = {Wolfgang Ahrendt and Thomas Baar and + Bernhard Beckert and Richard Bubel and+ Martin Giese and Reiner H\"ahnle and+ Wolfram Menzel and Wojciech Mostowski and+ Andreas Roth and Steffen Schlager and+ Peter H. Schmitt},+ title = {The KeY Tool},+ institution = {Department of Computing Science, Chalmers University+ and G\"oteborg University, G\"oteborg, Sweden},+ type = {Technical Report in Computing Science No.\ 2003-5},+ month = feb, + year = {2003}+}++++@PHDTHESIS{muskens-diss,+ AUTHOR = {Muskens, R.},+ YEAR = 1989,+ TITLE = {Meaning and {P}artiality},+ SCHOOL = {University of Amsterdam}+}++@ARTICLE{copestake,+ AUTHOR = "A. Copestake and D. Flickinger",+ TITLE = {{An open-source grammar development environment and broad-coverage English grammar using HPSG}},+ JOURNAL = {{Proceedings of the Second conference on Language Resources and Evaluation (LREC-2000)}},+ YEAR = {2000} +}++@ARTICLE{multieng,+ AUTHOR = "A. Ranta",+ TITLE = {{Modular Grammar Engineering in GF}},+ JOURNAL = {{Research on Language and Computation}},+ volume = {5},+ pages = {133--158},+ YEAR = {2007} +}+++@book{pereira-shieber,+ AUTHOR = {F. Pereira and S. Shieber},+ TITLE = {{Prolog and Natural-Language Analysis}},+ ADDRESS = {Stanford},+ YEAR = {1987},+ PUBLISHER = {{CSLI}}+}++@book{aho-ullman,+ AUTHOR = {A. Aho and R. Sethi and J. Ullman},+ TITLE = {{Compilers: Principles, Techniques, and Tools}},+ YEAR = {1988},+ PUBLISHER = {{Addison-Wesley}}+}++@book{aho-lam-ullman,+ AUTHOR = {A. Aho and M. Lam and R. Sethi and J. Ullman},+ TITLE = {{Compilers: Principles, Techniques, and Tools. Second Edition}},+ YEAR = {2006},+ PUBLISHER = {{Addison-Wesley}}+}++@book{karttunen-beesley,+ AUTHOR = {K. Beesley and L. Karttunen},+ TITLE = {{Finite State Morphology}},+ YEAR = {2003},+ PUBLISHER = {{CSLI Publications}}+}++@InProceedings{degroote02,+ author = {Ph. de Groote},+ title = {{Tree-Adjoining Grammars as Abstract Categorial Grammars}},+ booktitle = {{TAG+6, Proceedings of the sixth International Workshop+ on Tree Adjoining Grammars and Related Frameworks}},+ pages = {145--150},+ publisher = {Universit\`a di Venezia},+ year = {2002}+}++@InProceedings{saghein-1978,+ author = "Anna {S\aa gvall Hein}",+ title = {{Finnish Morphological Analysis in the Reversible Grammar System}},+ booktitle = {{COLING 78, Information Abstracts}},+ year = {1978}+}++@ARTICLE{saghein-1980,+ AUTHOR = "Anna {S\aa gvall Hein}",+ TITLE = "An Outline of a Computer Model of Finnish Word Recognition",+ JOURNAL = {{Fenno-Ugrica Suecana}},+ VOLUME = {3},+ PAGES = {7--26},+ YEAR = {1980} }++@ARTICLE{koskenniemi-1980,+ AUTHOR = "Kimmo Koskenniemi",+ TITLE = "On Automatic Lemmatization of Finnish",+ JOURNAL = {{Fenno-Ugrica Suecana}},+ VOLUME = {3},+ PAGES = {27--44},+ YEAR = {1980} }+++@book{martin-lof,+ AUTHOR = {P. Martin-L\"{o}f},+ TITLE = {{Intuitionistic Type Theory}},+ ADDRESS = {Napoli},+ YEAR = {1984},+ PUBLISHER = {Bibliopolis}+}+@BOOK{curryfeys,+ AUTHOR = "Curry, H. B. and R. Feys",+ TITLE = "Combinatory Logic, Vol. 1",+ PUBLISHER = {North-Holland},+ ADDRESS = {Amsterdam},+ YEAR = {1958} }++@ARTICLE{scott-str,+ AUTHOR = "D. S. Scott and C. Strachey",+ TITLE = "Toward a mathematical semantics for computer languages",+ JOURNAL = {Microwave Research Institute Symposia Series},+ VOLUME = {21},+ PAGES = {19--46},+ YEAR = {1970} }++@ARTICLE{partee,+ AUTHOR = {B. Partee},+ TITLE = {Montague grammar and transformational grammar},+ JOURNAL = {{Linguistic Inquiry}},+ VOLUME = {6},+ PAGES = {203--300},+ YEAR = {1975} }++@Book{ttg,+ author = {A. Ranta},+ title = {{Type Theoretical Grammar}},+ publisher = {{Oxford University Press}},+ year = {1994}+}++@Book{lyons,+ author = {J. Lyons},+ title = {{Introduction to Theoretical Linguistics}},+ publisher = {{Cambridge University Press}},+ year = {1968}+}++@Book{b-b,+ author = {P. Blackburn and J. Bos},+ title = {Representation and Inference for Natural Language},+ publisher = {Studies in Logic, Language, and Information, CSLI Press},+ year = {to appear}+}++@Book{cooper,+ author = {R. Cooper},+ title = {Quantification and Syntactic Theory},+ publisher = {D. Reidel},+ year = {1981}+}++@Book{jasmin,+ author = {J. Meyer and T. Downing},+ title = {{Java Virtual Machine}},+ publisher = {O'Reilly},+ year = {1997}+}++@Misc{gf,+ author = {A. Ranta},+ title = {{\mbox{Grammatical Framework Homepage}}},+ howpublished = {\verb!http://www.cs.chalmers.se/~aarne/GF/!},+ documentURL = {"http://www.cs.chalmers.se/~aarne/GF/"},+ year = {2000--2003}+}++@Misc{bnfc,+ author = {M. Forsberg and A. Ranta},+ title = {{\mbox{BNF Converter Homepage}}},+ howpublished = {\verb!http://www.cs.chalmers.se/~markus/BNFC/!},+ documentURL = {"http://www.cs.chalmers.se/~markus/BNFC/"},+ year = {2002--2004}+}++@Misc{twelf,+ author = {F. Pfenning},+ title = {{The Twelf Project}},+ howpublished = {\verb!http://www-2.cs.cmu.edu/~twelf!},+ documentURL = {"http://www-2.cs.cmu.edu/~twelf"},+ year = {2002}+}++@INCOLLECTION{scott,+ AUTHOR = "D. S. Scott",+ TITLE = "Advice on modal logic",+ booktitle = {Philosophical Problems in Logic},+ EDITOR = {K.\ Lambert},+ publisher = {D. Reidel},+ YEAR = {1970} }++@BOOK{nordstrom,+ AUTHOR = "{Nordstr\"{o}m}, B. and K. Petersson and J. Smith",+ TITLE = "Programming in {Martin-L\"{o}f}'s Type Theory. An Introduction",+ PUBLISHER = {Clarendon Press},+ ADDRESS = {Oxford},+ YEAR = {1990} }++@BOOK{grevisse,+ AUTHOR = "Grevisse, Maurice",+ TITLE = "Le bon usage, 13me edition",+ PUBLISHER = {Duculot},+ ADDRESS = {Paris},+ YEAR = {1993} }++@BOOK{diderichsen,+ AUTHOR = "Diderichsen, Paul",+ TITLE = "Elementaer dansk grammatik",+ ADDRESS = {Kobenhavn},+ YEAR = {1962} }++@BOOK{regulus,+ AUTHOR = {Rayner, M. and Hockey, B. A. and Bouillon, P.},+ TITLE = "Putting Linguistics into Speech Recognition: The Regulus Grammar Compiler",+ publisher = {{CSLI Publications}},+ YEAR = {2006} }++@INCOLLECTION{steedman,+ AUTHOR = "Steedman, M.",+ TITLE = "Combinators and grammars",+ EDITOR = "R. Oehrle and E. Bach and D. Wheeler",+ BOOKTITLE = "Categorial Grammars and Natural Language Structures",+ PUBLISHER = {D. Reidel},+ ADDRESS = {Dordrecht},+ YEAR = {1988}, + PAGES = {417-442}}++@INCOLLECTION{friedman,+ AUTHOR = "Friedman, J.",+ TITLE = "Expressing logical formulas in natural language",+ EDITOR = "J. Groenendijk and T. Janssen and M. Stokhof",+ BOOKTITLE = "Formal Methods in the Study of Language, Part 1",+ PUBLISHER = {Mathematisch Centrum},+ ADDRESS = {Amsterdam},+ YEAR = {1981}, + PAGES = {113-130}}++@ARTICLE{fri-war,+ AUTHOR = "Friedman, J. and D. Warren",+ TITLE = "A parsing method for {Montague} grammar",+ JOURNAL = {Linguistics and Philosophy},+ VOLUME = {2},+ PAGES = {347-372},+ YEAR = {1978} }++@BOOK{montague,+ AUTHOR = "Montague, R.",+ TITLE = "Formal Philosophy",+ NOTE = {Collected papers edited by Richmond Thomason},+ PUBLISHER = {Yale University Press},+ ADDRESS = {New Haven},+ YEAR = {1974} }++@BOOK{gazdar,+ AUTHOR = "Gazdar, G. and E. Klein and G. Pullum and I. Sag",+ TITLE = "Generalized Phrase Structure Grammar",+ PUBLISHER = {Basil Blackwell},+ ADDRESS = {Oxford},+ YEAR = {1985} }++@BOOK{chomsky,+ AUTHOR = "Chomsky, N.",+ TITLE = "Syntactic Structures",+ PUBLISHER = {Mouton},+ ADDRESS = {The Hague},+ YEAR = {1957} }++++++@Misc{nuance,+ author = {{Nuance Communications}},+ title = {{Nuance}},+ note = {\verb6http://www.nuance.com6},+ year = 2002+}++@Article{godis,+ author = "S. Larsson and D. Traum",+ title = {{Information state and dialogue management in the + TRINDI Dialogue Move Engine Toolkit}},+ journal = {{Natural Language Engineering}},+ year = 2000,+ volume = 0,+ pages = 0+}++++@BOOK{CLE,+ AUTHOR = "Alshawi, H",+ TITLE = {{The Core Language Engine}},+ PUBLISHER = {{MIT Press}},+ ADDRESS = {Cambridge, Ma},+ YEAR = {1992} }++@BOOK{cle2,+ AUTHOR = {M. Rayner and D. Carter and P. Bouillon and V. Digalakis and + M. Wirén},+ TITLE = {{The Spoken Language Translator}},+ PUBLISHER = {{Cambridge University Press}},+ ADDRESS = {Cambridge},+ YEAR = {2000} }+++@Article{kaplan-kay,+ author = "R. Kaplan and M. Kay",+ title = {{Regular Models of Phonological Rule Systems}},+ journal = {{Computational Linguistics}},+ year = 1994,+ volume = 20,+ pages = {{331--380}}+}+++@inproceedings{Dow:Hoc:Gaw:01,+ title = {{Practical Issues in Compiling Typed Unification Grammars + for Speech Recognition}},+ author = {J. Dowding and B. A. Hockey and J. M. Gawron+ and C. Culy},+ booktitle = {{ACL 2001}},+ address = {{Toulouse, France}},+ year = 2001+}++@inproceedings{carlson-2005,+ title = {{Inducing a Morphological Transducer from Inflectional Paradigms}},+ author = {Lauri Carlson},+ booktitle = {{Inquiries into Words, Constraints and Contexts.+ Festschrift for Kimmo Koskenniemi on his 60th Birthday}},+ publisher = {{CSLI}},+ year = 2005+}++@BOOK{dowty,+ AUTHOR = "Dowty, D",+ TITLE = "Word Meaning and Montague Grammar",+ PUBLISHER = {D. Reidel},+ ADDRESS = {Dordrecht},+ YEAR = {1979} }+++@Article{metal,+ author = "G. Kahn and B. Lang and B. Mélèse and E. Morcos",+ title = "Metal: a formalism to specify formalisms",+ journal = {Science of {C}omputer {P}rogramming},+ year = 1983,+ volume = 3,+ pages = {151--188}+}++@InCollection{pentus,+ author = "M. Pentus",+ title = "Lambek grammars are context-free",+ booktitle = {{LICS}, {Utrecht}, {The} {Netherlands}},+ year = 1993,+ pages = {35--42}+}+++@ARTICLE{lambek,+ AUTHOR = "J. Lambek",+ TITLE = "The mathematics of sentence structure",+ JOURNAL = {{American Mathematical Monthly}},+ VOLUME = {65},+ PAGES = {154-170},+ YEAR = {1958} +}++@ARTICLE{bringert-srg,+ AUTHOR = {Bj\"orn Bringert},+ TITLE = "Speech Recognition Grammar Compilation in Grammatical Framework",+ YEAR = {2007},+ NOTE = {Submitted for publication} +}++@Article{bar-hillel,+ author = "Y. Bar-Hillel",+ title = "A quasi-arithmetical notation for syntactic description",+ journal = {Language},+ year = 1953,+ volume = 29,+ pages = {27-58}+}+++@Book{rosetta,+ author = {M.~T. Rosetta},+ title = {Compositional Translation},+ publisher = "Kluwer",+ address = "Dordrecht",+ year = 1994+}++@Book{hopcroft,+ author = {J. Hopcroft and J. Ullman},+ title = {{Introduction to Automata Theory, Languages, and Computation}},+ publisher = {Addison-Wesley},+ year = 1979+}++@Book{jones-partial,+ author = {N.D. Jones and C.K. Gomard and P. Sestoft},+ title = {{Partial Evaluation and Automatic Program Generation}},+ publisher = {Prentice-Hall},+ year = 1993+}+++@Article{frost,+ author = "R. Frost and J. Launchbury",+ title = "Constructing natural language interpreters + in a lazy functional language",+ journal = {The {Computer} {Journal}},+ year = 1989,+ volume = 32,+ number = 2,+ pages = {108--121}+}++++@Article{pereira,+ author = {H.~D. Warren and F. Pereira},+ title = {An Efficient Easily Adaptable System for Interpreting Natural + Language Queries},+ year = {1982},+ journal = {{Computational Linguistics}},+ volume = 8,+ pages = {110-122}+}++++@Misc{huet-sanskrit,+ author = "G. Huet",+ title = "Sanskrit site",+ howpublished = "Program and documentation, + \verb6http://pauillac.inria.fr/~huet/SKT/6", + documentURL = "\verb6http://pauillac.inria.fr/~huet/SKT/index.html6",+ year = 2000+}++@Misc{huet-sanskrit-short,+ author = "G. Huet",+ title = "Sanskrit site",+ howpublished = {\verb6http://pauillac.inria.fr/~huet/SKT/6}, + year = 2000+}+++@Misc{italiano,+ author = "A. Ranta",+ title = {1+n representations of {Italian} morphology},+ howpublished = {Essays dedicated to {Jan von Plato} + on the occasion of his 50th birthday,+ \verb6http://www.valt.helsinki.fi/kfil/jvp50.htm6}, + documentURL = "\verb6http://www.valt.helsinki.fi/kfil/jvp50.htm6",+ year = 2001+}+++@Article{hudak,+ author = "P. Hudak",+ title = "Building domain-specific embedded languages",+ journal = "{ACM} {Computing} {Surveys}",+ year = 1996,+ volume = 28,+ number = 4+}++@Book{bescherelle,+ author = "Bescherelle",+ title = "La conjugaison pour tous",+ publisher = "Hatier",+ year = 1997+}+++@Book{shieber,+ author = "S. Shieber",+ title = {{An Introduction to Unification-Based Approaches to Grammars}},+ publisher = "University of Chicago Press",+ year = 1986+}++@BOOK{prawitz,+ AUTHOR = "D. Prawitz",+ TITLE = {{Natural Deduction}},+ PUBLISHER = {Almqvist \& Wiksell},+ ADDRESS = {Stockholm},+ YEAR = {1965} }++@BOOK{CAML,+ AUTHOR = "P. Weis and X. Leroy",+ TITLE = {{Le langage Caml}},+ PUBLISHER = {Dunod},+ ADDRESS = "Paris",+ YEAR = {1999} + }++@BOOK{sml,+ AUTHOR = "R. Milner and M. Tofte and R. Harper",+ TITLE = {{Definition of Standard ML}},+ PUBLISHER = {MIT Press},+ YEAR = {1990} + }++@BOOK{ML-wik,+ AUTHOR = "{Wikstr\"{o}m}, {\AA ke}",+ TITLE = "Functional Programming Using Standard ML",+ PUBLISHER = {Prentice-Hall},+ ADDRESS = {London},+ YEAR = {1987} }++@Article{coquand-typecheck,+ author = "T. Coquand",+ title = "An Algorithm for Type Checking Dependent Types",+ journal = "Science of {Computer} {Programming}",+ year = 1996,+ volume = 26,+ pages = {167-177}+}++@Article{boehm-p,+ author = {C. B\"{o}hm},+ title = {{On a family of Turing machines and the related programming language}},+ journal = {{ICC Bulletine}},+ year = 1964,+ volume = 3,+ pages = {185-194}+}++@Book{boehm,+ author = "H. Barendregt",+ title = {{The Lambda Calculus. Its Syntax and Semantics}},+ publisher = "North-Holland",+ year = 1981+}+++@Article{hutton,+ author = "G. Hutton",+ title = "Higher-order functions for parsing",+ journal = {J. Functional Programming},+ year = 1992,+ volume = 2,+ number = 3,+ pages = {323--343}+}++@Article{abrusci,+ author = "M. Abrusci",+ title = {{Noncommutative Intuitionistic Linear Propositional Logic}},+ journal = {{Zeitschrift für Mathematische Logik und Grundlagen der Mathematik}},+ year = 1990,+ volume = 36,+ pages = {297--398}+}+++@InProceedings{wadler,+ author = "P. Wadler",+ title = "How to replace failure by a list of successes",+ booktitle = {{Second International Conference on Functional + Programming Languages and Computer Architectures}},+ series = lncs,+ year = 1985,+ address = spv+}++@InProceedings{jones-hudak,+ author = "M. Jones and P. Hudak",+ title = "Using Types to Parse Natural Language",+ booktitle = {{Proceedings of the Glasgow Workshop on Functional Programming}},+ series = {{LNCS}},+ year = 1995,+ address = spv+}++@Article{earley,+ author = "J. Earley",+ title = "An efficient context-free parsing algorithm",+ journal = {Communications of the {ACM}},+ year = 1970,+ volume = 13,+ number = 2,+ pages = {94--102}+}++@InCollection{joshi,+ author = "A. Joshi",+ title = {Tree-Adjoining Grammars: How much context-sensitivity is required + to provide reasonable structural descriptions}, + booktitle = {{Natural Language Parsing}},+ year = 1985,+ editor = "D. Dowty and L. Karttunen and A. Zwicky",+ publisher = {Cambridge University Press},+ pages = {206--250}+}++@Book{appel,+ author = {A. Appel},+ title = {{Modern Compiler Implementation in ML}},+ publisher = {Cambridge University Press},+ year = {1998}+}++@Book{appel-java,+ author = {A. Appel},+ title = {{Modern Compiler Implementation in Java}},+ publisher = {Cambridge University Press},+ year = {1998}+}++@Book{prolog,+ author = {W. F. Clocksin and C. S. Mellish},+ title = {{Programming in Prolog}},+ publisher = {Springer},+ year = {1984}+}++@Article{hockett,+ author = {C. F. Hockett},+ title = "Two Models of Grammatical Description", + journal = "Word",+ year = 1954,+ volume = 10,+ pages = {210--233}+}++@Article{Wirth,+ author = "N. Wirth",+ title = "Program Development by Stepwise Refinement", + journal = "Communications of the ACM",+ year = 1971,+ volume = 14,+ pages = {221--227}+}+++@Article{huet-zipper,+ author = "G. Huet",+ title = {The {Zipper}}, + journal = JFP,+ year = 1997,+ volume = 7,+ number = 5,+ pages = {549--554}+}++@Article{huet-lang,+ author = {G. Huet and B. Lang},+ title = {Proving and applying program transformations expressed + with second-order patterns}, + journal = {{Acta Informatica}},+ year = 1978,+ volume = 11+}++@Article{knuth-attr,+ author = "D. Knuth",+ title = "Semantics of Context-Free Languages", + journal = {Mathematical {Systems} {Theory}},+ year = 1968,+ volume = 2,+ pages = {127--145}+}++@Article{LR,+ author = {D. Knuth},+ title = {On the translation of languages from left to right}, + journal = {Information and {Control}},+ year = 1965,+ volume = 8,+ pages = {607--639}+}++@inproceedings{TomitaCarbobell,+ author = {Masaru Tomita and+ Jaime G. Carbonell},+ title = {The Universal Parser Architecture for Knowledge-based Machine+ Translation},+ booktitle = {IJCAI},+ year = {1987},+ pages = {718-721},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}+++@InProceedings{luocall,+ author = {Z. Luo and P. Callaghan},+ title = {Mathematical Vernacular and Conceptual Well-Formedness in Mathematical+ Language},+ booktitle = {{Logical Aspects of Computational Linguistics (LACL)}} ,+ year = 1999,+ editor = {A. Lecomte and F. Lamarche and G. Perrier},+ series = {{LNCS/LNAI}},+ volume = 1582,+ pages = {231--250}+}++@Book{hpsg,+ author = "C. Pollard and I. Sag",+ title = {{Head-Driven Phrase Structure Grammar}}, + publisher = {{University of Chicago Press}},+ year = 1994+}++@Book{lfg,+ editor = "J. Bresnan",+ title = {{The Mental Representation of Grammatical Relations}}, + publisher = {{MIT Press}},+ year = 1982+}+++@ARTICLE{dcg,+ AUTHOR = "F. Pereira and D. Warren",+ TITLE = "Definite clause grammars+ for language analysis---a survey of the formalism and a+ comparison with augmented transition networks",+ JOURNAL = {{Artificial Intelligence}},+ VOLUME = {13},+ PAGES = {231--278},+ YEAR = {1980} }+++@ARTICLE{mcfg,+ author= {H. Seki and T. Matsumura and M. Fujii and T. Kasami},+ title = "On Multiple Context-Free Grammars", + journal = {{Theoretical Computer Science}}, + volume = 88, + pages = {191--229}, + year = 1991+}++++++@inproceedings{cayenne,+ AUTHOR = {L. Augustsson},+ TITLE = {{Cayenne---a language with dependent types}},+ BOOKTITLE = {Proc. of {ICFP'98}},+ PUBLISHER = {ACM Press},+ MONTH = {September},+ YEAR = {1998}+ }+++@book{morrill,+ AUTHOR = {G. Morrill},+ TITLE = {{Type Logical Grammar}},+ YEAR = {1994},+ PUBLISHER = {Kluwer}+}++@book{nordstrom:book,+ AUTHOR = {B. Nordstr{\"{o}}m and K. Petersson and J. M. Smith},+ TITLE = {{Programming in Martin-Löf's Type Theory. An Introduction}},+ YEAR = {1990},+ PUBLISHER = {Oxford University Press}+}++@book{constable,+ AUTHOR = {R. L. Constable},+ TITLE = {{Implementing Mathematics with the NuPRL Proof Development System}},+ YEAR = {1986},+ PUBLISHER = {Prentice-Hall}+}+++@InProceedings{dymetman,+ author = {M.\ Dymetman and V.\ Lux and A.\ Ranta},+ title = {{XML} and Multilingual Document Authoring: Convergent Trends},+ booktitle = {{COLING}, {Saarbr\"ucken}, {Germany}},+ pages = {243--249},+ year = {2000}+}++@InProceedings{butt,+ author = {M. Butt and H. Dyvik and T. Holloway King and H. Masuichi + and C. Rohrer},+ title = {{The Parallel Grammar Project}},+ booktitle = {{COLING 2002, Workshop on Grammar Engineering and Evaluation}},+ pages = {1--7},+ year = {2002}+}++@InProceedings{GF-Alfa,+ author = {T.\ Hallgren and A.\ Ranta},+ title = {An Extensible Proof Text Editor},+ editor = {M. Parigot and A. Voronkov},+ booktitle = {{LPAR-2000}},+ year = {2000},+ series = {{LNCS/LNAI}},+ volume = {1955},+ publisher = {Springer},+ pages = {70--84}+}++@InProceedings{burke-johannisson,+ author = {D. A. Burke and K. Johannisson},+ title = {{Translating Formal Software Specifications to Natural + Language / A Grammar-Based Approach}},+ booktitle = {{Logical Aspects of Computational Linguistics (LACL 2005)}},+ editor = {{P. Blache and E. Stabler and J. Busquets and R. Moot}},+ year = {2005},+ series = {{LNCS/LNAI}},+ volume = {3402},+ pages = {51--66},+ publisher = {Springer}+}++@InProceedings{FASE,+ author = {R.\ Hähnle and K.\ Johannisson and A.\ Ranta},+ title = {{An Authoring Tool for Informal and Formal Requirements Specifications}},+ booktitle = {{Fundamental Approaches to Software Engineering}},+ editor = {R.-D. Kutsche and H. Weber},+ year = {2002},+ series = {LNCS},+ volume = {2306},+ pages = {233--248},+ publisher = {Springer}+}++@InProceedings{khegai,+ author = {J.\ Khegai and B.\ Nordström and A.\ Ranta},+ title = {{Multilingual Syntax Editing in GF}},+ booktitle = {{Intelligent Text Processing and Computational Linguistics+ (CICLing-2003), Mexico City, February 2003}},+ year = {{2003}},+ series = {LNCS},+ volume = {2588},+ editor = {A. Gelbukh},+ pages = {453--464},+ publisher = {Springer-Verlag}+}++@ARTICLE{gf-jfp,+ AUTHOR = "A. Ranta",+ TITLE = {{Grammatical Framework: A Type-Theoretical Grammar Formalism}},+ JOURNAL = {{The Journal of Functional Programming}},+ pages={145--189},+ volume={14(2)},+ YEAR = {2004} }++@ARTICLE{huet-2005,+ AUTHOR = "Gerard Huet",+ TITLE = {{A Functional Toolkit for Morphological and Phonological Processing, Application to a Sanskrit Tagger}},+ JOURNAL = {{The Journal of Functional Programming}},+ pages={573--614},+ volume={15(4)},+ YEAR = {2005} }++@InProceedings{extract-2006,+ AUTHOR = {M. Forsberg and H. Hammarstr\"{o}m and A. Ranta},+ TITLE = {{Morphological Lexicon Extraction from Raw Text Data}},+ booktitle = {{FinTAL 2006}},+ year = {{2006}},+ series = {{LNCS/LNAI}},+ volume = {4139},+ editor = {T. Salakoski}+ }++@InProceedings{numerals,+ AUTHOR = {H. Hammarstr\"{o}m and A. Ranta},+ TITLE = {{Cardinal Numerals Revisited in GF}}, + booktitle = {{Workshop on Numerals in the World's Languages, + Dept. of Linguistics, Max Planck Institute for Evolutionary Anthropology, + Leipzig}},+ year = {{2004}}+ }++@misc{minnen95offline,+ author = "G. Minnen and D. Gerdemann and T. Gotz",+ title = "Off-line optimization for Earleystyle hpsg processing",+ text = "G. Minnen, D. Gerdemann, and T. Gotz. Off-line optimization for Earleystyle+ hpsg processing. In Proc. of the 7th Conference of the eacl, Dublin, 1995.",+ year = "1995",+ url = "citeseer.ist.psu.edu/article/minnen95offline.html" }++@Misc{Happy-GLR,+ author = {P. Callaghan and B. Medlock},+ title = {{Happy-GLR}},+ note = {\verb6http://www.dur.ac.uk/p.c.callaghan/happy-glr/6},+ year = 2004+}++@Misc{XLE-homepage,+ author = {R. Kaplan and J. Maxwell},+ title = {{XLE Project Homepage}},+ note = {\verb6http://www2.parc.com/isl/groups/nltt/xle/6},+ year = 2007+}++++@Misc{GF-homepage,+ author = {A. Ranta},+ title = {{Grammatical Framework Homepage}},+ note = {\verb6digitalgrammars.com/gf6},+ url = "digitalgrammars.com/gf",+ year = 2008+}++@Misc{kotus-wordlist,+ author = "{Kotimaisten Kielten Tutkimuskeskus}",+ title = {{KOTUS Wordlist}},+ note = {\verb6kaino.kotus.fi/sanat/nykysuomi6},+ year = 2006+}++@Misc{happy,+ author = {S. Marlow},+ title = {{Happy, The Parser Generator for Haskell}},+ note = {\verb6http://www.haskell.org/happy/6},+ year = 2001+}++@inproceedings{magnusson-nordstr,+ AUTHOR = {L. Magnusson and B. Nordstr\"{o}m},+ BOOKTITLE = {{Types for Proofs and Programs}},+ PUBLISHER = {Springer},+ SERIES = {LNCS 806},+ PAGES = {213--237},+ TITLE = {The {ALF} proof editor and its proof engine}, + YEAR = {1994}+ }++@Book{nssk,+ editor = {M. Sadeniemi},+ title = {{Nykysuomen sanakirja}},+ publisher = {{WSOY}},+ year = {1961}+}++@Book{hellberg,+ author = {S. Hellberg},+ title = {{The Morphology of Present-Day Swedish}},+ publisher = {{Almqvist \& Wiksell}},+ year = {1978}+}++@Book{karlsson-1977,+ author = {F. Karlsson},+ title = {{Finsk grammatik}},+ publisher = {{Suomalaisen Kirjallisuuden Seura}},+ year = {1977}+}++@Book{Ranta94,+ author = {A. Ranta},+ title = {{Type Theoretical Grammar}},+ publisher = {Oxford University Press},+ year = {1994}+}++@Misc{coq,+ author = {{The Coq Development Team}},+ title = {{The Coq Proof Assistant Reference Manual}},+ howpublished = {\verb6pauillac.inria.fr/coq/6},+ documentURL = "http://pauillac.inria.fr/coq/",+ year = 1999+}++@InProceedings{wysiwym,+ author = {R. Power and D. Scott},+ title = {Multilingual authoring using feedback texts},+ booktitle = {{COLING}-{ACL}},+ year = 1998+}++@InProceedings{brodda-karlsson,+ author = {B. Brodda and F. Karlsson},+ title = {{An Experiment with Automatic Morphological Analysis of Finnish}},+ series = {{Papers from the Institute of Linguistics, University of Stockholm}},+ volume = 40,+ year = 1978+}++++@PhdThesis{fiedler,+ author = {A. Fiedler},+ title = {{User-Adaptive Proof Explanation}},+ school = {{Universität des Saarlandes}},+ year = 2001+}++@PhdThesis{koskenniemi-1983,+ author = {Kimmo Koskenniemi},+ title = {{Two-Level Morphology: A General Computational Model for + Word-Form Recognition and Production}},+ school = {{University of Helsinki}},+ year = 1983+}++@PhdThesis{peb,+ author = {P. Ljungl\"of},+ title = {{The Expressivity and Complexity of Grammatical Framework}},+ school = {{Dept.\ of Computing Science,+ Chalmers University of Technology and + Gothenburg University}},+ year = {2004}+}++@PhdThesis{forsberg-2007,+ author = {Markus Forsberg},+ title = {{Three Tools for Language Processing: BNF Converter, + Functional Morphology, and Extract}},+ school = {{Dept.\ of Computer Science and Engineering,+ Chalmers University of Technology and + Gothenburg University}},+ year = {2007}+}++@InProceedings{peb-parsing,+ author = {P. Ljungl\"of},+ title = {{Grammatical Framework and Multiple Context-Free Grammars}},+ booktitle = {{Proceedings of Formal Grammar, Nancy, August 2004}},+ editor = {G. Jaeger and P. Monachesi and G. Penn and S. Wintner},+ pages = {77--90},+ year = {2004}+}++@PhdThesis{fudgets,+ author = {M. Carlsson and T. Hallgren},+ title = {{Fudgets---Purely Functional Processes with+ applications to Graphical User Interfaces}},+ school = {{Department of Computing Science, Chalmers University+ of Technology}},+ year = 1998,+ documentURL = "http://www.cs.chalmers.se/~hallgren/Thesis/"+}++@article{harper-honsell,+ AUTHOR = {R. Harper and F. Honsell and G. Plotkin},+ TITLE = {{A Framework for Defining Logics}},+ JOURNAL = {{JACM}},+ VOLUME = {40},+ NUMBER = {1},+ YEAR = {1993},+ PAGES = {143--184}+}++@InProceedings{CKT95,+ author = "Y. Coscoy and G. Kahn and L. Thery",+ title = "Extracting text from proofs",+ series = lncs,+ volume = "902",+ pages = {109--123},+ year = "1995",+ booktitle = "Proc.\ {Second} {Int.} {Conf.} on + {Typed} {Lambda} {Calculi} and {Applications}",+ editor = "M. Dezani-Ciancaglini and G. Plotkin"+}++@Book{WarmerKleppe99,+ author = "J. Warmer and A. Kleppe",+ title = {{The Object Constraint Language: Precise Modelling with UML}},+ publisher = {{Addison-Wesley}},+ year = "1999"+}+++@InProceedings{HoltEwan99,+ author = {Alexander Holt and Ewan Klein},+ title = {A semantically-derived subset of {E}nglish for + hardware verification},+ booktitle = {Proc.\ Ann.\ Meeting Ass.\ for + Comp.\ Ling.},+ pages = {451--456},+ year = {1999},+ url = {http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-sds/ps/}+}++@misc{bohlin-trindi,+ author = {P. Bohlin and J. Bos and S. Larsson and + I. Lewin and C. Matheson and D. Milward}, + year = 1999,+ title = {Survey of Existing Interactive Systems},+ note = {Trindi deliverable D1.3, Gothenburg University}+ }++@misc{cooper-anna,+ author = {R. Cooper},+ year = 2008,+ title = "The Abstract-Concrete Syncat Distinction and Unification in Multilingual Grammar",+ note = {to appear}+ }++@misc{fracas,+ author = {H. Kamp and R. Crouch and J. van Genabith and R. Cooper and M. Poesio + and J. van Eijck and J. Jaspars and M. Pinkal and E. Vestre and S. Pulman}, + year = 1994,+ title = "Specification of Linguistic Coverage",+ note = {{FRACAS Deliverable D2}} + }++++@Article{teitelbaum,+ author = "T. Teitelbaum and T. Reps",+ title = {The {Cornell} {Program} {Synthesizer}: a syntax-directed+ programming environment},+ journal = {Commun. {ACM}},+ year = "1981",+ volume = "24",+ number = "9",+ pages = {563-573}+}+++@misc{haskell98,+ author= {S. {Peyton Jones} and J. Hughes},+ title={{Report on the Programming Language Haskell 98, a + Non-strict, Purely Functional Language}},+ year=1999, + month={February},+ howpublished={Available from \verb!http://www.haskell.org!}+}++@Manual{UML1.3-specification,+ key = {UML 1.3},+ title = {Unified Modelling Language Specification, version 1.3},+ organization = {Object Modeling Group},+ month = mar,+ year = 2000,+ url = {http://cgi.omg.org/cgi-bin/doc?formal/00-03-01.ps.gz},+ note = {OMG document formal/00-03-01. {URL:} + \texttt{http://cgi.omg.org/cgi-bin/doc?formal/00-03-01.ps.gz}}+}++@TechReport{LBR00,+ author = "G. T. Leavens and A. L. Baker and C. Ruby",+ title = "Preliminary Design of {JML}: A Behavioral Interface+ Specification Language for {Java}",+ institution = "Iowa State University, Department of Computer+ Science",+ year = "2000",+ number = "98-06i",+ month = feb,+ note = "URL: \texttt{ftp://ftp.cs.iastate.edu/pub/techreports/TR98-06/TR.ps.gz}",+ url = "ftp://ftp.cs.iastate.edu/pub/techreports/TR98-06/TR.ps.gz"+}++@inproceedings{nlyacc,+ author = {Masayuki Ishii and Kazuhisa Ohta and Hiroaki Saito},+ title = {An efficient parser generator for natural language},+ booktitle = {Proceedings of the 15th conference on Computational linguistics},+ year = {1994},+ pages = {417--420},+ location = {Kyoto, Japan},+ doi = {http://dx.doi.org/10.3115/991886.991959},+ publisher = {Association for Computational Linguistics},+ address = {Morristown, NJ, USA},+ }++@TechReport{johnson-yacc,+ author = {S. C. Johnson},+ title = {{Yacc --- yet another compiler compiler}},+ institution = {{AT \& T Bell Laboratories, Murray Hill, NJ}},+ year = {1975},+ number = {{CSTR-32}}+}++@TechReport{hallgren-2000,+ author = {T. Hallgren},+ title = {The Correctness of Insertion Sort},+ institution = {Chalmers University of Technology, + Department of Computer Science},+ year = {2000},+ note = {URL: \verb!http://www.cs.chalmers.se/~hallgren/Papers/insertion_sort.ps!}+}+++@InProceedings{power-scott-1998,+ author = {R. Power and D. Scott},+ title = {Multilingual authoring using feedback texts},+ booktitle = {COLING-ACL 98},+ year = 1998,+ address = {Montreal, Canada}+}++@InProceedings{coquand1999,+ author = {C. Coquand and T. Coquand},+ title = {Structured Type Theory},+ booktitle = {Workshop on Logical Frameworkds and Meta-languages},+ year = 1999,+ address = {Paris, France}+}++@book{mueller,+ author = {Stefan Müller},+ title = {{Deutsche Syntax Deklarativ}},+ year = 1999,+ publisher = {{Max Niemeyer Verlag}}+}++@article{ranta-cooper,+ author = {A. Ranta and R. Cooper},+ title = {{Dialogue Systems as Proof Editors}},+ journal = {{Journal of Logic, Language and Information}},+ year = 2004+}++@InProceedings{ranta-cooper-icos,+ author = {A. Ranta and R. Cooper},+ title = {Dialogue Systems as Proof Editors},+ booktitle = {{IJCAR}/{ICoS-3}},+ year = 2001,+ address = {{Siena}, {Italy}}+}+++@inproceedings{gf-srg,+ author = {Bj\"orn Bringert},+ title = {{Speech Recognition Grammar Compilation in Grammatical Framework}},+ booktitle = {{Proceedings of the Workshop on Grammar-Based Approaches to Spoken Language Processing}},+ month = jun,+ year = {2007},+ pages = {1--8},+ location = {{Prague, Czech Republic}},+ publisher = {{Association for Computational Linguistics}}+}++@inproceedings{mm-grammars-dialor05,+ author = {Bj\"orn Bringert and Robin Cooper + and Peter Ljungl\"of and Aarne Ranta},+ title = {Multimodal Dialogue System Grammars},+ booktitle = {Proceedings of DIALOR'05, Ninth Workshop on + the Semantics and Pragmatics of Dialogue},+ month = {June},+ year = {2005},+ pages = {53--60},+ location = {Nancy, France},+ url = {http://www.cs.chalmers.se/~bringert/publ/mm-grammars-dialor/mm-grammars-dialor.pdf}+}+++@InProceedings{ranta-nancy,+ author = {A. Ranta},+ title = {Resource Grammars for Dialogue Systems and Grammar Writing by Examples},+ booktitle = {{TALK Meeting}},+ year = 2005,+ address = {{Nancy}}+}++@InProceedings{curry,+ AUTHOR = "H. B. Curry",+ TITLE = "Some logical aspects of grammatical structure",+ EDITOR = "Jakobson, Roman",+ BOOKTITLE = {{Structure of Language and its+ Mathematical Aspects: Proceedings of the Twelfth Symposium+ in Applied Mathematics}},+ PUBLISHER = {American Mathematical Society},+ YEAR = {1963}, + PAGES = {56-68}+}++@inproceedings{bengt-lena1995,+ AUTHOR = {L. Magnusson and B. Nordstr\"{o}m},+ BOOKTITLE = {{ Types for Proofs and Programs}},+ PUBLISHER = {Springer-Verlag},+ SERIES = {LNCS},+ VOL = {806},+ PAGES = {213-237},+ TITLE = {{The ALF proof editor and its proof engine}}, + ADDRESS = {Nijmegen},+ YEAR = {1994}+ }++@article{kay1997,+ AUTHOR = {M. Kay},+ TITLE = {{The Proper Place of Men and Machines in Language Translation}},+ JOURNAL = {{Machine Translation}},+ YEAR = {1997},+ NUMBER = {1--2},+ VOLUME = {12},+ PAGES = {3--23}+ }+++@unpublished{together,+ title = {{Together}},+ author = {{Borland Software Corporation}},+ howpublished = {Online document},+ year = {2004},+ note = {\verb!http://www.borland.com/together/!}+ }++@unpublished{lkb,+ title = {{The LKB System}},+ author = {Ann Copestake},+ howpublished = {Online document},+ year = {2002},+ note = {Available on-line in \verb!http://www-csli.stanford.edu/~aac/lkb.html!}+ }++@unpublished{eclipse,+ title = {{Eclipse Homepage}},+ author = {{Eclipse.org}},+ howpublished = {Online document},+ year = {2004},+ note = {\verb!http://www.eclipse.org/!}+ }++@unpublished{boeing,+ title = {{Boeing Simplified English Checker}},+ author = {{The Boeing Company}},+ howpublished = {Online document},+ year = {2001},+ note = {\verb!http://www.boeing.com/assocproducts/sechecker/!}+ }++@unpublished{XML,+ title = {{Extensible Markup Language (XML)}},+ author = {{The World Wide Web Consortium}},+ howpublished = {Online document},+ year = {2000},+ note = {\verb!http://www.w3.org/XML/!}+ }++@unpublished{huet-trie,+ author = {G. Huet},+ title = {{The Zen Computational Linguistics Toolkit}}, + howpublished = {{ESSLLI Summer School, Trento}},+ note = {\verb!http://pauillac.inria.fr/~huet/!},+ year = 2002+}++@unpublished{agda-homepage,+ author = "C. Coquand",+ title = "{{AGDA Homepage}}",+ year = 1998,+ howpublished = {Online document},+ note = {\verb!http://www.cs.chalmers.se/~catarina/agda/!} ,+ documenturl = "http://www.cs.chalmers.se/~catarina/agda/"+ }++@InProceedings{coquand:stt-lfm99,+ author = {C. Coquand and T. Coquand},+ title = {Structured Type Theory},+ booktitle = {Workshop on Logical Frameworkds and Meta-languages},+ year = 1999,+ address = {Paris, France},+ month = {Sep}+}++@inproceedings{augustsson:cayenne,+ AUTHOR = {L. Augustsson},+ TITLE = {{Cayenne --- a language with dependent types}},+ BOOKTITLE = {Proc. of the International Conference on Functional Programming (ICFP'98)},+ PUBLISHER = {ACM Press},+ MONTH = {September},+ YEAR = {1998}+ }++@PhdThesis{carlsson98:fudgets_thesis,+ author = {M. Carlsson and T. Hallgren},+ title = {{Fudgets --- Purely Functional Processes with+ applications to Graphical User Interfaces}},+ booktitle = {{Fudgets --- Purely Functional Processes with+ applications to Graphical User Interfaces}},+ school = {Department of Computing Science, Chalmers University+ of Technology},+ year = 1998,+ address = {S-412 96 Göteborg, Sweden},+ month = {March},+ documentURL = "http://www.cs.chalmers.se/~hallgren/Thesis/"+}++@book{martin-lof:padova,+ AUTHOR = {P. Martin-L\"{o}f},+ TITLE = {{Intuitionistic Type Theory}},+ ADDRESS = {Napoli},+ YEAR = {1984},+ PUBLISHER = {Bibliopolis}+}+++@misc{alfa-homepage,+ author = {T. Hallgren},+ year = {2000},+ title = {{Home Page of the Proof Editor Alfa}},+ howpublished = {\verb!http://www.cs.chalmers.se/~hallgren/Alfa/!},+ documentURL = {http://www.cs.chalmers.se/~hallgren/Alfa/}+ }++@InProceedings{ranta98:regexp,+ author = {A. Ranta},+ title = {A Multilingual Natural-Language Interface to Regular Expressions},+ booktitle = {Proceedings of the International Workshop on Finite State+ Methods in Natural Language Processing},+ pages = {79--90},+ year = 1998,+ editor = {L. Karttunen and K. Oflazer},+ address = {Ankara},+ organization = {Bilkent University}+}++@Misc{maple-homepage,+ author = {Waterloo Maple Inc.},+ title = {{Maple Homepage}},+ howpublished = {\verb!http://www.maplesof.com/!},+ documentURL = "http://www.maplesof.com/",+ year = 2000+}++@Misc{mathematica-homepage,+ author = {Wolfram Research, Inc.},+ title = {{Mathematica Homepage}},+ howpublished = {\verb!http://www.wolfram.com/products/mathematica/!},+ documentURL = "http://www.wolfram.com/products/mathematica/",+ year = 2000+}++@Misc{coq-homepage,+ author = {Coq Development Team},+ title = {{Coq Homepage}},+ howpublished = {\verb!http://pauillac.inria.fr/coq/!},+ documentURL = "http://pauillac.inria.fr/coq/",+ year = 1999+}++@TechReport{LEGO-homepage,+ author = {Z. Luo and R. Pollack},+ title = {{LEGO Proof Development System}},+ institution = {University of {Edinburgh}},+ year = 1992+}++@Misc{LEGO-new-homepage,+ author = {D. Aspinall},+ title = {{The LEGO Proof Assistant}},+ howpublished = {\verb!http://www.dcs.ed.ac.uk/home/lego/!},+ documentURL = "http://www.dcs.ed.ac.uk/home/lego/",+ year = 1999+}++@Misc{Isabelle-homepage,+ author = {Isabelle},+ title = {{Isabelle Homepage}},+ howpublished = {\verb!http://www.cl.cam.ac.uk/Research/HVG/Isabelle/!},+ documentURL = "http://www.cl.cam.ac.uk/Research/HVG/Isabelle/index.html",+ year = 2000+}++@Misc{Isabelle-Paulson,+ author = "L. Paulson",+ title = {{The Isabelle Reference Manual}},+ note = {{With contributions by T. Nipkow and M. Wenzel}},+ howpublished = {Available at the Isabelle homepage \verb!http://www.cl.cam.ac.uk/Research/HVG/Isabelle/!},+ documentURL = "http://www.cl.cam.ac.uk/Research/HVG/Isabelle/dist/Isabelle2002/doc/ref.pdf",+ year = 2002+}++@Misc{Mizar-homepage,+ author = {A. Trybulec},+ title = {{The Mizar Homepage}},+ howpublished = {\verb!http://mizar.org/!},+ documentURL = "http://mizar.org/",+ year = {2006}+}++@Misc{ALF-family-homepage,+ author = {},+ title = {{Implementation of Proof Editors}},+ howpublished = + {\verb!http://www.cs.chalmers.se/ComputingScience/Research/Logic/!},+ documentURL = "http://www.cs.chalmers.se/ComputingScience/Research/Logic/",+ year = 1999+}++@incollection{deBruijn:MV,+ TITLE = {{Mathematical Vernacular: + a Language for Mathematics with Typed Sets}},+ AUTHOR = {N. G. de Bruijn},+ EDITOR = {R. Nederpelt},+ BOOKTITLE = {{Selected Papers on Automath}},+ PUBLISHER = {{North-Holland Publishing Company}},+ PAGES = {865--935},+ YEAR = {1994}+ }++@article{pereira-warren,+ AUTHOR = "F. Pereira and D. Warren",+ TITLE = "Definite Clause Grammars for Language Analysis",+ JOURNAL = {Artificial {Intelligence}},+ YEAR = {1980},+ NUMBER = {13},+ PAGES = {231--278}+ }++@PhdThesis{coscoy:thesis,+ author = {Y.\ Coscoy},+ title = {Explication textuelle de preuves pour le calcul des+ constructions inductives},+ school = {{Universit\'e de Nice-Sophia-Antipolis}},+ year = 2000+}+++@InProceedings{coscoy:textproofs,+ AUTHOR = {Y. Coscoy and G. Kahn and L. Th\'ery},+ TITLE = {Extracting Text from Proof}, + BOOKTITLE = {{Proceedings of the International Conference on Typed Lambda+ Calculus and Applications (TLCA), Edinburgh}},+ EDITOR = {M. Dezani and G. Plotkin},+ SERIES = {Lecture Notes in Computer Science},+ NUMBER = {902},+ PUBLISHER = {Springer-Verlag},+ YEAR = {1996}+ }++@InProceedings{coscoy:explanation,+ author = {Y. Coscoy},+ title = {A natural language explanation of formal proofs},+ booktitle = {Logical Aspects of Computational Linguistics},+ pages = {149--167},+ year = 1997,+ editor = {C. {Retor\'e}},+ address = {Heidelberg},+ publisher = {Springer},+ series = {Lecture Notes in Artificial Intelligence},+ number= 1328+}++@inproceedings{ranta:torino,+ AUTHOR = {A. Ranta},+ TITLE = {Context-Relative Syntactic Categories + and the Formalization of Mathematical Text}, + BOOKTITLE = {{Types For Proofs and Programs}},+ EDITOR = {S. Berardi and M. Coppo},+ SERIES = {Lecture Notes in Computer Science},+ NUMBER = {1158},+ PAGES = {231--248},+ PUBLISHER = {Springer-Verlag},+ YEAR = {1996}+ }++@article{ranta:paris,+ AUTHOR = {A. Ranta},+ TITLE = {{Structures grammaticales dans le fran\c{c}ais math\'ematique}},+ JOURNAL = {{Math\'ematiques, informatique et Sciences Humaines}},+ YEAR = {1997},+ NUMBER = {138, 139},+ PAGES = {5--56, 5--36}+ }++@article{kamp:drt,+ AUTHOR = {H. Kamp},+ TITLE = {{ A theory of truth and semantic representation}},+ EDITOR = {{J. Groenendijk, T. Janssen, and M. Stokhof}},+ BOOKTITLE = {{Formal Methods in the Study of Language, Part 1}},+ YEAR = {1981},+ PUBLISHER = {{Mathematisch Centrum, Amsterdam}},+ PAGES = {277--322}+ }+++@PhdThesis{magnusson:phd,+ author = {L. Magnusson},+ title = {The Implementation of ALF - a Proof Editor based on + Martin-L\"of's Monomorphic Type Theory with Explicit+ Substitution},+ school = {Department of Computing Science, Chalmers University of+ Technology and University of G\"oteborg},+ year = {1994}+}++@InProceedings{krijo-aarne,+ author = "K. Johannisson and A. Ranta",+ title = "Formal Verification of Multilingual Instructions",+ booktitle = "The Joint Winter Meeting of Computing Science and+ Computer Engineering",+ publisher = "Chalmers University of Technology",+ year = "2001"+}++++++++++++++++++++@Manual{JavaCollection,+ title = {The Java Collection Framework}, + year = {1995--1999},+ author = {{Sun Microsystems Inc.}},+ note = {\texttt{http://java.sun.com/j2se/1.3/docs/guide/collections/}}+ }++@Book{BarstowSandewall,+ author = {Barstow, D.~R., Shrobe, H.~E., and Sandewall, E.},+ title = {Interactive Programming Environments},+ publisher = {McGraw Hill},+ year = 1984+}+++@inproceedings{HuetKahn1975,+ author = "V. Donzeau-Gouge and G. Huet and G. Kahn and B. Lang and J.~J. Levy",+ title = {A structure-oriented program editor: + a first step towards computer assisted programming},+ booktitle = {{International Computing Symposium ({ICS'75})}},+ year = {1975}+}+++++@Book{Sommerville01,+ author = "Ian Sommerville",+ title = "Software Engineering",+ publisher = "Addison-Wesley",+ year = "2001",+ edition = "6th"+}+++@InProceedings{HoltEwan99,+ author = {Alexander Holt and Ewan Klein},+ title = {A semantically-derived subset of {E}nglish for + hardware verification},+ booktitle = {Proc.\ 37th Annual Meeting of the Association for + Computational Linguistics: Maryland, USA},+ pages = {451-456},+ year = {1999},+ publisher = {Association for Computational Linguistics},+ url = {\texttt{http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-sds/ps/}}+}++@InProceedings{HKG99,+ author = {Alexander Holt and Ewan Klein and Claire Grover},+ title = {Natural language for hardware verification: + semantic interpretation and model checking},+ booktitle = {Proc.\ ICoS-1: Inference in Computational Semantics, Amsterdam},+ pages = {133-137},+ year = {1999},+ publisher = {Institute for Logic, Language and Computation, + University of Amsterdam},+ url = {http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-nlh/ps/}+}++@Article{Holt99,+ author = {Alexander Holt},+ title = {Formal verification with natural language specifications: + guidelines, experiments and lessons so far},+ journal = {South African Computer Journal},+ year = {1999},+ volume = {24},+ pages = {253-257},+ month = nov,+ url = {http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-fvn/ps/},+}++@InProceedings{HaehnleRanta01a,+ author = {R.\ H\"{a}hnle and A.\ Ranta},+ title = {Connecting {OCL} with the Rest of the World},+ booktitle = {{ETAPS}/{WTUML},+ {Genova}, {Italy}},+ year = {2001},+ editor = {J. Whittle},+ url = {http://www.cs.chalmers.se/~reiner/papers/wtuml.ps.gz}+}++@Article{BBEHO99,+ author = "Michael Baentsch and Peter Buhler and Thomas Eirich+ and Frank H{\"o}ring and Marcus Oestreicher",+ title = "{JavaCard} --- From Hype to Reality",+ journal = "IEEE Concurrency",+ volume = "7",+ number = "4",+ pages = "36--43",+ month = oct # "\slash " # dec,+ year = "1999",+ url = "http://www.zurich.ibm.com/technologies/jetz/p4baenCPYRT.lo.pdf"+}++@InProceedings{GogollaRichters98a,+ author = "Martin Gogolla and Mark Richters",+ title = "On Constraints and Queries in {UML}",+ pages = "109--121",+ booktitle = "The Unified Modeling Language -- Technical Aspects and+ Applications",+ editor = "Martin Schader and Axel Korthaus",+ publisher = "Physica-Verlag, Heidelberg",+ year = "1998"+}++@InProceedings{HHK98,+ author = "Ali Hamie and John Howse and Stuart Kent",+ title = "Interpreting the {Object Constraint Language}",+ booktitle = "Proceedings 5th Asia Pacific Software Engineering+ Conference (APSEC '98), Taipei,+ Taiwan",+ year = "1998",+ publisher = "IEEE Computer Society"+}++@Book{HKT00,+ author = {David Harel and Dexter Kozen and Jerzy Tiuryn},+ title = {Dynamic Logic},+ publisher = {MIT Press},+ year = 2000,+ series = {Foundations of Computing},+ month = oct,+ isbn_issn = {0-262-08289-6}+}++@Book{KRC,+ author = {Brian Kernighan and Dennis Ritchie},+ title = {{The C Programming Language}},+ publisher = {{Prentice Hall}},+ year = 1988,+ note = {Second Edition}+}++@Book{MichalewiczFogel00,+ author = {Z. Michalewicz and B. F. Fogel},+ title = {How to solve it: modern heuristics},+ publisher = spv,+ year = {2000},+ isbn_issn = {3-540-66061-5}+}++@Book{Schumann00,+ author = {Johann M. P. Schumann},+ title = {Automated Theorem Proving in Software Engineering},+ publisher = spv,+ year = {2000},+ isbn_issn = {3-540-67989-8}+}++@Book{HMNS00,+ author = {U. Hansmann and L. Merk and M. S. Nicklous and T. Stober},+ title = {Pervasive Computing Handbook},+ publisher = spv,+ year = {2000},+ isbn_issn = {3-540-67122-6}+}++@Book{Newborn00,+ author = {M. Newborn},+ title = {Automated Theorem Proving: Theory and Practice},+ publisher = spv,+ year = {2000},+ isbn_issn = {3-387-95075-3}+}++@Book{TymoczkoHenle00,+ author = {T. Tymoczko and J. Henle},+ title = {Sweet Reason: A Field Guide to Modern Logic},+ publisher = spv,+ year = {2000},+ isbn_issn = {3-387-98930-7}+}++@Book{HMT99,+ editor = {Hatcliff, J. and Mogensen, T. and Thiemann, P.},+ title = {Partial Evaluation. Practice and Theory. + DIKU 1998 International Summer School, Copenhagen, Denmark},+ publisher = spv,+ year = {1999},+ volume = {1706},+ series = lncs,+ isbn_issn = {3-540-66710-5}+}++@inproceedings{Giese00,+ author = {Martin Giese},+ title = {Proof Search without Backtracking using Instance Streams, Position Paper},+ booktitle = {Proc.\ Int.\ Workshop on First-Order Theorem Proving, St.\ Andrews, Scotland},+ year = {2000},+ pages = {227--228},+ editor = {Peter Baumgartner and Hantao Zhang},+ series = {Fachberichte Informatik 5/2000},+ publisher = {University of Koblenz, Institute for Computer Science},+ note = {\href{http://i12www.ira.uka.de/~key/doc/2000/giese00.ps.gz}{\texttt{http://i12www.ira.uka.de/\~{}key/doc/2000/giese00.ps.gz}}}+}++@article{Smullyan63,+ AUTHOR = {Smullyan, Raymond M.},+ TITLE = {A unifying principle in quantification theory},+ JOURNAL = {Proceedings of the National Academy of Sciences of the U.S.A.},+ VOLUME = {49},+ number = {6},+ YEAR = {1963},+ PAGES = {828--832}+}++@BOOK{rei48,+ AUTHOR = "Reichenbach, Hans",+ TITLE = "Elements of Symbolic Logic",+ PUBLISHER = {The MacMillan Company},+ ADDRESS = {New York},+ YEAR = {1948} }+++@InProceedings{BaarHaehnle00a,+ author = {Thomas Baar and Reiner H\"ahnle},+ title = {An Integrated Metamodel for {OCL} Types},+ booktitle = {Proc.\ OOPSLA 2000 Workshop Refactoring the UML: + In Search of the Core, Minneapolis/MI, USA},+ year = {2000},+ editor = {Robert France and Bernhard Rumpe and Jonathan Whittle},+ month = oct+}++@InCollection{RSBMZ98,+ author = {Dirk Riehle and Wolf Siberski and Dirk B\"{a}umer and+ Daniel Megert and Heinz Z\"{u}llighoven.},+ title = {Serializer},+ booktitle = {Pattern Languages of Program Design 3},+ pages = {293--312},+ publisher = {Addison-Wesley},+ year = {1998},+ editor = {Robert Martin and Dirk Riehle and and Frank Buschmann},+ chapter = {17},+ url = {http://www.riehle.org/papers/1996/plop-1996-serializer.pdf}+}++@InProceedings{CIOH00,+ author = {Cristiano Calcagno and Samin Ishtiaq and Peter W. O'Hearn},+ title = {Semantic Analysis of Pointer Aliasing, Allocation and + Disposal in {H}oare Logic},+ booktitle = {Proc.\ 2nd International Conference on Principles+ and Practice of Declarative Programming, Montral, Canada},+ year = {2000},+ editor = {Maurizio Gabbrielli and Frank Pfenning},+ series = lncs,+ publisher = spv,+ url = {http://www.dcs.qmw.ac.uk/~ccris/ftp/ppdp00.ps}+}++@Book{PalanquePaterno98,+ editor = {P. Palanque and F. Patern\`{o}},+ title = {{Formal Methods in Human-Computer Interaction}},+ publisher = spv,+ series = {{FACIT}},+ year = {{1998}}+}++@Book{LindholmYellinJVM,+ editor = {T. Lindholm and F. Yellin},+ title = {{The Java Virtual Machine Specification Second Edition}},+ publisher = {{Addison-Wesley}},+ year = {{1999}}+}++@Book{VanDerLinden99a,+ author = "Peter {van der Linden}",+ title = "Just {Java} 1.2",+ publisher = "Prentice-Hall",+ edition = "Fourth",+ month = mar,+ year = "1999",+ ISBN_ISSN = "0-13-010534-1",+ series = "SunSoft Press Java series"+}++@Book{VanDerLinden99b,+ author = "Peter {van der Linden}",+ title = "Not Just {Java}: a technology briefing",+ publisher = "Prentice-Hall",+ edition = "Second",+ year = "1999",+ ISBN_ISSN = "0-13-079660-3",+ series = "SunSoft Press Java series"+}++Book{GoldbergRubin95,+ author = "Adele Goldberg and Kenneth S. Rubin",+ title = "Succeeding With Objects: Decision Frameworks for+ Project Management",+ publisher = "Addison-Wesley",+ year = "1995",+ ISBN_ISSN = "0-201-62878-3"+}++@Book{Goldberg84,+ author = "Adele Goldberg",+ title = "Smalltalk-80: the Interactive Programming+ Environment",+ publisher = "Addison-Wesley",+ year = "1984",+ ISBN_ISSN = "0-201-11372-4"+}++@Book{GoldbergRobson83,+ author = "Adele Goldberg and David Robson",+ title = "Smalltalk-80: The Language and its Implementation",+ publisher = "Addison-Wesley",+ year = "1983"+} ++@Book{Ranta01a,+ author = {Sara Negri and Jan von Plato},+ title = {Structural Proof Theory},+ publisher = {Cambridge University Press},+ year = {2001, to appear},+ note = {Appendix C ``PESCA---A Proof Editor for Sequent Calculus'' + by Aarne Ranta}+}++@Manual{Ranta00a,+ title = {PESCA---A Proof Editor for Sequent Calculus},+ author = {Aarne Ranta},+ organization = {Department of Computing Science, + Chalmers University of Technology and University of Gothenburg},+ address = {Gothenburg},+ month = mar,+ year = {2000},+ note = {Program and documentation.+ URL: \texttt{www.cs.chalmers.se\~{}aarne/pesca/}}+}++@InProceedings{MaenpaaRanta99,+ author = {P. Mäenpää and A. Ranta},+ title = {The type theory and type checker of {GF}},+ booktitle = {{PLI-1999: + Workshop on Logical Frameworks and Meta-languages, + Paris, France}},+ year = {1999}+}+++@Article{Ranta88,+ author = "Aarne Ranta",+ title = {Propositions as games as types},+ journal = {Synthese},+ year = {1988},+ volume = {76},+ pages = {377--395}+}++@Article{Ranta91b,+ author = "Aarne Ranta",+ title = {Intuitionistic categorial grammar},+ journal = {Linguistics and Philosophy},+ year = {1991},+ volume = {14},+ pages = {203--239}+}++@Article{Ranta95c,+ author = "Aarne Ranta",+ title = {Type-theoretical interpretation and generalization + of phrase structure grammar},+ journal = {{Bulletin of the IGPL}},+ year = {1995},+ volume = {3},+ pages = {319--342}+}++@Article{Ranta97a,+ author = "Aarne Ranta",+ title = {Structures grammaticales dans le fran\c{c}ais math\'{e}matique},+ journal = {Math\'{e}matiques, informatique et Sciences Humaines},+ year = {1997},+ volume = {138/139},+ pages = {5--56/5--36}+}++@InProceedings{Ranta94a,+ author = "Aarne Ranta",+ title = "Type Theory and the Informal Language of Mathematics",+ booktitle = "Selected papers from TYPES'93: + Int.\ Workshop on Types, Nijmegen, The Netherlands",+ series = lncs,+ publisher = spv,+ volume = "806",+ pages = "352--365",+ year = "1994",+ editor = "Hendrik Barendregt and Tobias Nipkow"+}++@InProceedings{Ranta96a,+ author = "A. Ranta",+ title = "Context-Relative Syntactic Categories and the+ Formalization of Mathematical Text",+ booktitle = "Selected papers from TYPES'95: Int.\ Workshop on Types for+ Proofs and Programs, Trento, Italy",+ publisher = spv,+ editor = "S. Berardi and M. Coppo",+ series = lncs,+ volume = 1158,+ pages = "231--248",+ year = "1996"+}++@InProceedings{Ranta95a,+ author = "Aarne Ranta",+ title = "Syntactic Categories in the Language of Mathematics",+ series = lncs,+ volume = "996",+ pages = "162--182",+ year = "1995",+ publisher = spv,+ booktitle = "Selected papers from TYPES'94: + Int.\ Workshop on Types for+ Proofs and Programs, Bastad, Sweden",+ editor = {Peter Dybjer and Bengt Nordstr\"{o}m and Jan Smith}+}++@Article{Ranta98a,+ author = "Aarne Ranta",+ title = "Syntactic Calculus with Dependent Types",+ journal = "Journal of Logic, Language, and Information",+ year = "1998",+ volume = "7",+ number = "4",+ pages = "413--431"+}++@InCollection{Ranta98b,+ author = "Aarne Ranta",+ title = "A Multilingual Natural Language Interface to Regular+ Expressions",+ booktitle = "{FSMNLP'98}: International Workshop on Finite State+ Methods in Natural Language Processing",+ publisher = "Bilkent University, Ankara",+ year = "1998",+ editor = "Lauri Karttunen and K. Oflazer",+ pages = "79--90"+}++@Article{Ranta91a,+ author = "Aarne Ranta",+ title = "Constructing Possible Worlds",+ journal = "Theoria",+ volume = "57",+ number = "1--2",+ pages = "77--100",+ year = "1991"+}++@InProceedings{semBNF,+ author = {{P. M\"aenp\"a\"a}},+ title = {{Semantic BNF}},+ booktitle = "Types for Proofs and Programs, TYPES'96", + series = lncs,+ publisher = spv,+ volume = "1512",+ pages = "196--215",+ year = "1998",+ editor = "E. Gimenez and C. Paulin-Mohring"+}+++@MastersThesis{Schneider97,+ author = {J\"{o}rg Schneider},+ title = "{Formale Spezifikation eines+ Autorisierungskonzepts am Beispiel des+ Berechtigungswesens im SAP R/3-System}",+ school = "Department of Computer Science, University of Karlsruhe",+ year = "1997",+ type = {Diplomarbeit} +}++@InProceedings{MandelCengarle99,+ author = "Luis Mandel and Mar{\'\i}a Victoria Cengarle",+ title = "On the Expressive Power of {OCL}",+ booktitle = "Proc.\ FM'99 -- Formal Methods, World Congress on Formal+ Methods in the Development of Computing Systems,+ Toulouse, France",+ year = "1999",+ volume = "1708",+ series = lncs,+ pages = "854--874",+ publisher = spv+}++@InProceedings{DLR00,+ author = {M.\ Dymetman and V.\ Lux and A.\ Ranta},+ title = {{XML} and Multilingual Document Authoring: Convergent Trends},+ booktitle = {Proc.\ Computational Linguistics COLING, Saarbr\"{u}cken, Germany},+ pages = {243-249},+ year = {2000},+ publisher = {International Committee on Computational Linguistics}+}++@InProceedings{HallgrenRanta000,+ author = {T. Hallgren and A. Ranta},+ title = {Grammatical Annotations: a Method of Program Documentation},+ booktitle = {Proc.\ International Conference on Functional Programming ICFP},+ year = {submitted, 2000},+ note = {URL: \texttt{http://www.cs.chalmers.se/\~{}aarne/hallgren-ranta-2000.ps.gz}}+}+++@inproceedings{mccarthy62towards,+ author = "J.\ McCarthy",+ title = "Towards a mathematical science of computation",+ booktitle = "Proceedings of the Information Processing Cong. 62",+ month = "August",+ publisher = "North-Holland",+ address = "Munich, West Germany",+ pages = "21--28",+ year = "1962"+}++@InProceedings{hallgren-ranta:lpar2000,+ author = {T.\ Hallgren and A.\ Ranta},+ title = {An Extensible Proof Text Editor},+ editor = {M. Parigot \& A. Voronkov},+ booktitle = {Logic for Programming and Automated Reasoning (LPAR'2000)},+ year = {2000},+ series = {LNCS/LNAI 1955},+ pages = {70--84}+}+++@InProceedings{DahnWolf96,+ author = "Bernd I. Dahn and Andreas Wolf",+ title = "Natural Language Representation and Combination of+ Automatically Generated Proofs",+ editor = "Franz Baader and Klaus U.~Schulz",+ booktitle = "Frontiers of Combining Systems: Proc.\ 1st+ International Workshop, Munich, Germany",+ publisher = "Kluwer Academic Publishers",+ series = "Applied Logic",+ month = mar,+ year = "1996",+ pages = "175--192"+}+++@Manual{Ranta99,+ title = {Grammatical Framework Homepage},+ author = {Aarne Ranta},+ organization = {Chalmers University of Technology},+ address = {Gothenburg},+ year = {2001},+ note = {URL: \texttt{www.cs.chalmers.se/~aarne/GF}}+}++@Manual{Ranta99a,+ title = {Grammatical Framework Syntax and Semantic},+ author = {Aarne Ranta},+ organization = {Xerox Research Centre Europe},+ address = {Grenoble},+ month = feb,+ year = {1999},+ note = {URL: \texttt{www.xrce.xerox.com/research/mltt/gf/doc/gf-language/index.html}}+}++@Manual{Ranta99c,+ title = {Grammatical Framework Implementation and Interfaces. + {R}evised for {GF} Version 0.5},+ author = {Aarne Ranta},+ organization = {Department of Computing Science,+ Chalmers University of Technology},+ month = jun,+ year = {1999},+ note = {URL: \texttt{www.cs.chalmers.se/\~{}aarne/GF/pub/doc/gf-implementation/index.html}}}++@Manual{Ranta99b,+ title = {Grammatical Framework Tutorial},+ author = {A. Ranta},+ organization = {Xerox Research Centre Europe},+ address = {Grenoble},+ month = feb,+ year = 1999,+ note = {URL: \texttt{www.xrce.xerox.com/research/mltt/gf/doc/gf-tutorial/index.html}}+}++@TechReport{KeY00,+ author = {Wolfgang Ahrendt and Thomas Baar and Bernhard Beckert+ and Martin Giese and Elmar Habermalz and Reiner+ H\"ahnle and Wolfram Menzel and Peter H. Schmitt},+ title = {The {KeY} Approach: {I}ntegrating Object Oriented+ Design and Formal Verification},+ institution = {University of Karlsruhe, Department of Computer Science},+ type = {Technical Report},+ number = {2000/4},+ month = jan,+ year = {2000},+ note = {URL: \texttt{i12www.ira.uka.de/\~{}key/doc/2000/techRep.ps.gz}}+}++@InProceedings{KeY00a,+ author = {Wolfgang Ahrendt and Thomas Baar and Bernhard Beckert+ and Martin Giese and Elmar Habermalz and Reiner+ H\"ahnle and Wolfram Menzel and Peter H. Schmitt},+ booktitle = {In Proc.\ Java Card Workshop, Cannes, France},+ title = {The {KeY} Approach: {I}ntegrating Object Oriented+ Design and Formal Verification},+ month = sep,+ year = {2000},+ publisher = {{INRIA} technical report}+}+++@article{Hughes89,+ AUTHOR = {John Hughes},+ TITLE = {Why Functional Programming Matters},+ JOURNAL = {Computer Journal},+ VOLUME = {32},+ NUMBER = {2},+ PAGES = {98--107},+ YEAR = {1989}+}+ +@Book{RussellNorvig95,+ author = "Stuart J. Russell and Peter Norvig",+ title = "Artificial Intelligence. {A} Modern Approach",+ publisher = "Prentice-Hall",+ address = "Englewood Cliffs",+ year = "1995",+ url = "http://www.cs.berkeley.edu/~russell/aima.html"+}+ +@inproceedings{Thompson97a,+ author = {Simon Thompson},+ title = {{\em Where do I begin?} + {A} problem solving approach to teaching + functional programming},+ month = sep,+ year = {1997},+ pages = {},+ url = {http://www.cs.ukc.ac.uk/pubs/1997/208},+ booktitle = {First International Conference on Declarative Programming Languages in Education},+ editor = {Krzysztof Apt and Pieter Hartel and Paul Klint},+ publisher = spv,+ volume = "1292",+ pages = "323--337",+ series = lncs+ } + +@InProceedings{DAC98a,+ author = "Matthew B. Dwyer and George S. Avrunin and James C.+ Corbett",+ title = "Property Specification Patterns for Finite-State+ Verification",+ pages = "7--15",+ ISBN_ISSN = "0-89791-954-8",+ editor = "Mark Ardis",+ booktitle = "Proc.\ 2nd Workshop on Formal Methods in+ Software Practice ({FMSP}-98)",+ month = mar,+ publisher = "ACM Press",+ address = "New York",+ year = "1998"+}++@InProceedings{DAC99a,+ author = "Matthew B. Dwyer and George S. Avrunin and James C.+ Corbett",+ title = "Patterns in Property Specifications for Finite-State+ Verification",+ booktitle = "Proc.\ 21st International Conference on+ Software Engineering",+ year = "1999",+ publisher = "IEEE Computer Society Press, ACM Press",+ ISBN_ISSN = "1-58113-074-0",+ pages = "411--420"+}+ +@Article{Fitting98a,+ author = "Fitting",+ title = "lean{TAP} Revisited",+ journal = "jlc",+ volume = "8",+ number = "1",+ pages = "33--47",+ year = "1998"+}++@TechReport{NeculaLee96,+ author = "G. C. Necula and P. Lee",+ title = "Proof-Carrying Code",+ institution = "School of Computer Science, Carnegie Mellon+ University, Pittsburgh, USA",+ year = "1996",+ number = "CMU-CS-96-165",+ month = nov,+ url = "http://www.cs.cmu.edu/~necula/tr96-165.ps.gz"+}++@InProceedings{NeculaLee98,+ author = "George C. Necula and Peter Lee",+ title = "Safe, Untrusted Agents using Proof-Carrying Code",+ booktitle = "Mobile Agents and Security",+ volume = "1419",+ year = "1998",+ publisher = spv,+ series = lncs,+ editor = "Giovanni Vigna",+ pages = "61--91",+ url = "http://www.cs.cmu.edu/~necula/lncs98.ps.gz",+ ISBN_ISSN = "0302-9743"+}++@InProceedings{Necula97,+ author = "G. C. Necula",+ title = {{Proof-Carrying Code}},+ booktitle = {{Proc.\ 24th {A}{C}{M} Symposium on Principles of+ Programming Languages, {Paris}, {France}}},+ year = "1997",+ url = "http://www.cs.cmu.edu/~necula/popl97.ps.gz",+ pages = "106--119",+ publisher = "ACM Press"+}++@Article{patr,+ author = {L. Karttunen},+ title = {PATR}, + journal = ???,+ year = 1981,+ volume = 0,+ pages = 0+}++@Misc{hallgren-sort,+ author = "T. Hallgren",+ title = "The correctness of insertion sort",+ howpublished = www,+ documentURL = cs.chalmers,+ year = 2000+}++@Article{discont,+ author = "H. Uszkoreit",+ title = "German word order", + journal = ???,+ year = 1988,+ volume = ???,+ pages = ???+}++@Article{hoas,+ author = "J. Despeyroux",+ title = "Higher-Order Abstract Syntax", + journal = ???,+ year = 1995,+ volume = ???,+ pages = ???+}++++@inproceedings{airline,+ AUTHOR = {L. Augustsson},+ TITLE = {{Partial Evaluation in Airline Crew Scheduling}},+ BOOKTITLE = {???},+ PUBLISHER = {???},+ YEAR = {???}+ }++@Article{Parnas,+ author = {D. Parnas},+ title = {{On the Criteria To Be Used in Decomposing Systems into Modules}},+ journal = {{Communications of the ACM}},+ volume = {15},+ pages = {1053--1058},+ year = {1972}+}++@Article{ranta:compsem,+ author = {A. Ranta},+ title = {{Computational Semantics in Type Theory}},+ journal = {{Mathematics and Social Sciences}},+ volume = {165},+ pages = {31--57},+ year = {2004}+}+++@inproceedings{jonson-2006,+ AUTHOR = {Rebecca Jonson},+ TITLE = {{Generating statistical language models from interpretation grammars in dialogue system}},+ BOOKTITLE = {{Proceedings of EACL'06, Trento, Italy}},+ YEAR = {2006}+ }++@inproceedings{gf-esslli,+ AUTHOR = {A. Ranta},+ TITLE = {{Grammatical Framework Tutorial}},+ BOOKTITLE = {{ESSLLI 2003 Course Material I}},+ PUBLISHER = {{Kurt G\"odel Society}},+ pages = {1--86},+ YEAR = {2004}+ }++@Article{mccarthy,+ author = {J. McCarthy},+ title = {{Recursive Functions of Symbolic Expressions and their+ Computation by Machine, part I}},+ journal = {{Communications of the ACM}},+ volume = {3},+ pages = {184--195},+ year = {1960}+}++++@InProceedings{bringert-angelov-ranta:2009:EACL-DEMOS,+ author = {Bringert, Bj\"{o}rn and Angelov, Krasimir and Ranta, Aarne},+ title = {Grammatical Framework Web Service},+ booktitle = {Proceedings of the Demonstrations Session at EACL 2009},+ month = {April},+ year = 2009,+ address = {Athens, Greece},+ publisher = {Association for Computational Linguistics},+ pages = {9--12},+ url = {http://www.aclweb.org/anthology-new/E09-2003},+ annote = "An overview of how to build web services on top of PGF using the Google Web Toolkit."+}++@InProceedings{ranta-angelov-bringert:2009:EACL-DEMOS,+ author = {Ranta, Aarne and Angelov, Krasimir and Bringert, Bj\"{o}rn},+ title = {Grammar Development in {GF}},+ booktitle = {Proceedings of the Demonstrations Session at EACL 2009},+ month = {April},+ year = 2009,+ address = {Athens, Greece},+ publisher = {Association for Computational Linguistics},+ pages = {57--60},+ url = {http://www.aclweb.org/anthology/E09-2015},+ annote = "An overview of GF from the grammarian's point of view."+}++@InProceedings{ranta-angelov-hallgren:2010:Demos,+ author = {Ranta, Aarne and Angelov, Krasimir and Hallgren, Thomas},+ title = {Tools for Multilingual Grammar-Based Translation on the Web},+ booktitle = {Proceedings of the ACL 2010 System Demonstrations},+ month = {July},+ year = 2010,+ address = {Uppsala, Sweden},+ publisher = {Association for Computational Linguistics},+ pages = {66--71},+ url = {http://www.aclweb.org/anthology/P10-4012},+ annote = "An overview of GF for developers and users of translation systems."+}+
@@ -0,0 +1,816 @@+Grammatical Framework Bibliography+Aarne Ranta+%%date(%c)++% NOTE: this is a txt2tags file.+% Create an html file from this file using:+% txt2tags gf-bibliography.t2t++%!style:../css/style.css+%!target:html+%!options(html): --toc+%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>+%!postproc(html): #BR <br>+%!encoding:utf-8+%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>++==Publications on GF==++In reverse temporal order:++H. Burden and R. Heldal.+Natural Language Generation from Class Diagrams.+//Proceedings of the 8th International Workshop on Model-Driven Engineering, Verification and Validation (MoDeVVa 2011)//,+Wellington, New Zealand,+ACM,+2011.+[Draft PDF http://www.grammaticalframework.org/doc/archive/a9-burden.pdf]+#BR+//Using GF to verbalize platform-independent requirement specifications as a part of a software engineering tool chain.//++C. España-Bonet, R. Enache, A. Slaski, A. Ranta, L. Màrquez, and M. Gonzàlez.+Patent translation within the MOLTO project.+Proceedings of the 4th Workshop on Patent Translation, +MT Summit XIII, Xiamen, China, September 23, 2011.+[PDF http://www.lsi.upc.edu/~cristinae/CV/docs/MTS11PatEspanaetal.pdf]+#BR+//First steps to a hybrid GF-SMT system.//++Seyed M. Montazeri, Nivir Roy, and Gerardo Schneider. +From Contracts in Structured English to CL Specifications. +//5th International Workshop on Formal Languages and Analysis of Contract-Oriented Software (FLACOS'11)//, +volume 68 of EPTCS, pages 55-69, +Málaga, Spain, 22-23 September 2011.+[PDF/DOI http://dx.doi.org/10.4204/EPTCS.68.6]+#BR+//Formal analysis of contracts written in controlled English.//++S. Virk, M. Humayoun, and A. Ranta.+An Open-Source Punjabi Resource Grammar.+Proceedings of RANLP-2011, Recent Advances in Natural Language Processing,+Hissar, Bulgaria, 12-14 September, 2011.+pp. 70-76.+[PDF http://lml.bas.bg/~iva/ranlp2011/RANLR2011_Proceedings.PDF]+#BR+//Punjabi syntax, building on Humayoun and Ranta 2010.//++D. Dannélls, M. Damova, R.Enache, M. Chechev.+A Framework for Improved Access to Museum Databases in the Semantic Web.+Proceedings of the Workshop on Language Technologies for Digital Humanities and Cultural Heritage,+RANLP-2011, Recent Advances in Natural Language Processing, +Hissar, Bulgaria, 12-14 September, 2011,+pp 8-15+[PDF http://publications.lib.chalmers.se/cpl/record/index.xsql?pubid=145395]+#BR+//Representing and verbalizing in GF of an Cultural Heritage ontology.// ++A. Ranta.+Translating between Language and Logic: What Is Easy and What is Difficult?+In N. Bjørner and V. Sofronie-Stokkermans (eds.),+//CADE-23. Automated Deduction//,+LNCS/LNAI 6803,+pp. 5-25,+2011.+[PDF at Springer http://www.springerlink.com/content/42n685777k846810/]+[Draft PDF http://www.cse.chalmers.se/~aarne/articles/cade2011.pdf]+#BR+//Invited talk at the CADE conference, showing how GF can help writing natural language interfaces// +//to proof systems, and also exploring how to make the language richer, e.g. how to get from//+//"for all numbers x, x is even or x is odd" to "every number is even or odd".//++A. Ranta. +//Grammatical Framework: Programming with Multilingual Grammars//, + CSLI Publications, Stanford, 2011.+ [Book web page http://www.grammaticalframework.org/gf-book/] +#BR+//Meant as the standard reference and textbook on GF.//++O. Caprotti, K. Angelov, R. Enache, T. Hallgren, A. Ranta.+The MOLTO Phrasebook.+Swedish Language Technology Conference SLTC 2010.+[PDF http://publications.lib.chalmers.se/cpl/record/index.xsql?pubid=131251]+#BR+//Tourist Phrasebook grammar, available in 14 European languages.//+++G. Détrez and R. Enache.+A Framework for Multilingual Applications on the Android Platform+Swedish Language Technology Conference SLTC 2010.+[PDF http://www.grammaticalframework.org/doc/archive/sltc10_submission_24.pdf]+#BR+//A description of the Java implementation of the GF runtime system, which makes it possible//+to create grammar-based applications running on an Android phone.//++Normunds Gruzitis and Guntis Barzdins.+Towards a More Natural Multilingual Controlled Language Interface to OWL,+//9th International Conference on Computational Semantics (IWCS)//,+pp. 335-339,+2011.+[PDF http://www.aclweb.org/anthology/W/W11/W11-0138.pdf]+#BR+//Access to ontologies in English and Latvian.//++M. Humayoun and A. Ranta. +Developing Punjabi Morphology, Corpus and Lexicon. +//The 24th Pacific Asia conference on Language, Information and Computation (PACLIC24)//,+2010.+#BR+//Yet another South-East Asian language, spoken by 88 million people.//++J. Camilleri, Gordon J. Pace, and Mike Rosner.+Playing Nomic using a Controlled Natural Language.+//CNL 2010, Controlled Natural Language//,+Marettimo,+2010.+#BR+//Using GF for defining the rules of a game.//++R. Enache and K. Angelov+Typeful Ontologies with Direct Multilingual Verbalization.+//CNL 2010, Controlled Natural Language//,+Marettimo, +2010.+#BR+//Investigating the benefits of using GF as a language for representing ontologies.//+[PDF http://www.grammaticalframework.org/doc/archive/cnl2010_submission_2.pdf]++S. Virk, M. Humayoun, and A. Ranta. +An Open Source Urdu Resource Grammar. +//Proceedings of the 8th Workshop on Asian Language Resources (Coling 2010 workshop)//,+2010.+#BR+//The national language of Pakistan, spoken by 60 million people; almost the same as Hindi.//++A. Ranta, K. Angelov, and T. Hallgren.+Tools for multilingual grammar-based translation on the web.+//Proceedings of the ACL 2010 System Demonstrations//,+ACM Digital Library,+2010.+[PDF http://www.aclweb.org/anthology-new/P/P10/P10-4012.pdf]+#BR+//An overview of GF for developers and users of translation systems.//++D. Dannélls and J. Camilleri. +Verb Morphology of Hebrew and Maltese - Towards an Open Source Type Theoretical Resource Grammar in GF.+//Proceedings of the Language Resources (LRs) and Human Language Technologies (HLT) for Semitic Languages Status, Updates, and Prospects, LREC-2010 Workshop//,+Malta, pp. 57-61.+2010.+[PDF http://spraakdata.gu.se/svedd/pub/lrec10.pdf]+#BR+//A study of Semitic non-concatenative morphology from the GF point of view.//++M. Humayoun and C. Raffalli.+MathNat - Mathematical Text in a Controlled Natural Language. +//Special issue: Natural Language Processing and its Applications. Journal on Research in Computing Science//, Volume 46. +2010.+#BR+//Natural language interface to a proof system, implemented in GF.//++D. Dannélls.+Discourse Generation from Formal Specifications Using the Grammatical Framework, GF. +//Special issue: Natural Language Processing and its Applications. Journal on Research in Computing Science (RCS)//, +volume 46. pp. 167-178,+2010.+#BR+//Interfacing GF with ontology, with a natural language generation perspective.//++R. Enache, A. Ranta, and K. Angelov.+An Open-Source Computational Grammar of Romanian.+A. Gelbukh (ed.), //CiCLING-2010//,+LNCS 6008,+2010.+#BR+//A Romance language different enough not to follow the Romance functor.//++K. Angelov and A. Ranta.+Implementing Controlled Languages in GF.+N. Fuchs (ed.), //CNL-2009 Controlled Natural Languages//,+LNCS/LNAI 5972,+2010.++K. Angelov, B. Bringert and A. Ranta.+PGF: A Portable Run-time Format for Type-theoretical Grammars,+//Journal of Logic, Language and Information//,+19(2),+pp. 201-228,+2009.+[SpringerLink http://www.springerlink.com/content/y32q021028747k70/]++A. Ranta.+The GF Resource Grammar Library.+//Linguistic Issues in Language Technology//, +2 (2),+2009.+[PDF http://elanguage.net/journals/index.php/lilt/article/viewFile/214/158]+#BR+//A systematic presentation of the library from the linguistic point of view.//++A. Ranta.+Grammatical Framework: A Multilingual Grammar Formalism, +//Language and Linguistics Compass//, +Vol. 3, [on-line http://www.blackwell-compass.com/subject/linguistics/article_view?parent=section&last_results=section%3Dlnco-computational&sortby=date§ion=lnco-computational&browse_id=lnco_articles_bpl155&article_id=lnco_articles_bpl155]+2009.+#BR+//An overview of GF for readers with a general academic brackground.//++A. Ranta and K. Angelov.+Implementing Controlled Languages in GF.+//CNL-2009//,+//CEUR Workshop Proceedings//,+vol. 448,+[on-line http://sunsite.informatik.rwth-aachen.de/Publications/CEUR-WS/Vol-448/],+2009.+#BR+//Makes a case for using GF in controlled language implementation, illustrated by Attempto Controlled English ported to French, German, and Swedish; longer version in 2010.//++A. Ranta. Grammars as Software Libraries.+In Y. Bertot, G. Huet, J-J. Lévy, and G. Plotkin (eds.),+//From Semantics to Computer Science//,+Cambridge University Press, Cambridge, +pp. 281-308,+2009.+[pdf (preliminary version) http://www.cse.chalmers.se/~aarne/articles/libraries-kahn.pdf]+#BR+//Grammar-libraries from the software engineering point of view, with an example application to mathematical language.//++K. Angelov.+Incremental Parsing in Parallel Multiple Context-Free Grammars.+EACL 2009.+#BR+//Describes the algorithm used in parsing with GF.//++A. Ranta, B. Bringert, and K. Angelov. +The GF Grammar Development Environment. +System demo. Proceedings of //EACL-2009//,+2009.+[PDF http://www.aclweb.org/anthology-new/E/E09/E09-2015.pdf]+#BR+//An overview of GF from the grammarian's point of view.//+ +B. Bringert, K. Angelov, and A. Ranta. +Grammatical Framework Web Service,+System demo. Proceedings of //EACL-2009//,+2009.+[PDF http://www.aclweb.org/anthology-new/E/E09/E09-2003.pdf]+#BR+//An overview of how to build web services on top of PGF using the Google Web Toolkit.//+++A. Ranta and K. Angelov. +Implementing Controlled Languages in GF,+To appear in the proceedings of //CNL-2009//, LNCS, Springer,+2009.+#BR+//On the use of GF for controlled languages, exemplified by an implementation of Attempto Controlled English then ported to three other language.//++R. Cooper and A. Ranta. +Natural Languages as Collections of Resources. +In //Language in Flux: Dialogue Coordination, Language Variation, Change//, +ed. by R. Cooper and R. Kempson, pp. 109-120. London: College Publications,+2008.+#BR+//The resource grammar idea applied to language learning and evolution.//++Moisés Salvador Meza Moreno and B. Bringert.+Interactive Multilingual Web Applications with Grammatical Framework.+In B. Nordström and A. Ranta (eds), +//Advances in Natural Language Processing (GoTAL 2008)//, +LNCS/LNAI 5221, Springer,+2008.+#BR+//Shows how GF compiled to JavaScript is used in dynamic multilingual web pages.//++Peter Ljunglöf and Staffan Larsson. +A grammar formalism for specifying ISU-based dialogue systems.+In B. Nordström and A. Ranta (eds), +//Advances in Natural Language Processing (GoTAL 2008)//, +LNCS/LNAI 5221, Springer,+2008.+[pdf http://www.ling.gu.se/~peb/pubs/LjunglofLarsson-2008a.pdf]+#BR+//Explains how GoDiS dialogue systems are specified by GF grammars.//++K. Angelov.+Type-Theoretical Bulgarian Grammar.+In B. Nordström and A. Ranta (eds), +//Advances in Natural Language Processing (GoTAL 2008)//, +LNCS/LNAI 5221, Springer,+2008.+#BR+//Explains the implementation of a Bulgarian resource grammar in GF.//++B. Bringert.+High-precision Domain-specific Interlingua-based Speech Translation+with Grammatical Framework.+//Coling 2008 Workshop on Speech Translation for Medical and Other Safety-Critical Applications//, +Manchester, UK, August 23, +2008.+#BR+//Shows how to build spoken language translators based on GF grammars and their compilation to Nuance.//++A. Ranta.+How predictable is Finnish morphology? An experiment on lexicon construction.+In J. Nivre, M. Dahllöf and B. Megyesi (eds),+//Resourceful Language Technology: Festschrift in Honor of Anna Sågvall Hein//,+University of Uppsala,+2008.+Available from [series homepage http://publications.uu.se/abstract.xsql?dbid=8933]+#BR+//Presents an experiment on smart paradigms in Finnish.//++A. Ranta.+Example-based grammar writing.+To appear in L. Borin and S. Larsson (eds),+Festschrift for Robin Cooper,+2007.+#BR+//Presents and discusses the ideas of grammar composition and example-based grammar writing.//++B. Bringert.+Rapid Development of Dialogue Systems by Grammar Compilation.+//8th SIGdial Workshop on Discourse and Dialogue//, +Antwerp, Belgium, September 1-2, +2007.+[pdf http://www.cse.chalmers.se/~bringert/publ/gf-voicexml/gf-voicexml.pdf]+#BR+//Shows how to build a web-based spoken dialogue system by generating VoiceXML and JavaScript.//++A. El Dada and A. Ranta.+Implementing an Open Source Arabic Resource Grammar in GF.+In M. Mughazy (ed),+//Perspectives on Arabic Linguistics XX. Papers from the Twentieth Annual Symposium on Arabic Linguistics, Kalamazoo, March 26//+John Benjamins Publishing Company.+2007.+#BR+//An outline of the Arabic resource grammar project, focusing on linguistic aspects.//++A. El Dada.+Implementation of the Arabic Numerals and their Syntax in GF.+Computational Approaches to Semitic Languages: Common Issues and Resources, + ACL-2007 Workshop,+June 28, 2007, Prague.+2007.+#BR+//A case study with the resource grammar, focusing on the morphosyntax//+//and agreement of constructions with numerals.//++A. Ranta.+Modular Grammar Engineering in GF.+//Research on Language and Computation//, +5:133-158, 2007.+Draft available as [pdf http://www.cse.chalmers.se/~aarne/articles/multieng3.pdf].+#BR+//Adapts library-based software engineering methods to grammar writing// +//and introduces the module system of GF.//++A. Ranta.+The GF Grammar Compiler.+//Workshop on New Directions in Type-theoretic Grammars//,+Dublin, August 2007 (ESSLLI workshop).+2007.+[pdf http://www.cse.chalmers.se/~aarne/articles/ar-compiler.pdf]+#BR+//Describes the compilation of GF source code to lower-level run-time formats.//++M. Humayoun, H. Hammarström, and A. Ranta.+Urdu Morphology, Orthography and Lexicon Extraction.+//CAASL-2: The Second Workshop on Computational Approaches to Arabic Script-based Languages//,+July 21-22, 2007, LSA 2007 Linguistic Institute, Stanford University.+2007.+#BR+//Fairly complete open-source Urdu morphology and elemenraty syntax in GF.//++N. Perera and A. Ranta.+Dialogue System Localization with the GF Resource Grammar Library.+//SPEECHGRAM 2007: ACL Workshop on Grammar-Based Approaches to Spoken Language Processing//,+June 29, 2007, Prague.+2007.+[pdf http://www.cse.chalmers.se/~aarne/articles/perera-ranta.pdf]+#BR+//An experiment in porting an in-car dialogue system from two to six languages.// +++B. Bringert.+Speech Recognition Grammar Compilation in Grammatical Framework+//SPEECHGRAM 2007: ACL Workshop on Grammar-Based Approaches to Spoken Language Processing//,+June 29, 2007, Prague.+2007.+#BR+//Generation of speech recognition language models from GF in several formats:// +//GSL (Nuance), SRGS, JSGF, and HTK SLF, with embedded semantic interpretation.//++A. Ranta.+Features in Abstract and Concrete Syntax.+//The 2nd International Workshop on Typed Feature Structure Grammars//,+Tartu, 24 May 2007 (NODALIDA workshop).+2007.+[pdf http://www.cse.chalmers.se/~aarne/articles/ranta-tfsg2007.pdf]+#BR+//Explores the design choices of incorporating features in a GF-like grammar,//+//with comparisons to feature-based unification grammars.//+++O. Caprotti and M. Seppälä.+Multilingual Delivery of Online Tests in mathematics.+Proceedings of Online Educa Berlin 2006. 29 November - 1 December 2006. + Berlin, Germany.+2006.+[pdf http://webalt.math.helsinki.fi/content/e16/e301/e785/MultilingualDeliveryofOnlineTestsinMathematics_eng.pdf]+#BR+//This papers shows screenshots of multilingual generation in the//+//WebALT project, using GF and the resource grammar library.//++J. Khegai. +Language engineering in Grammatical Framework (GF).+Phd thesis, Computer Science, Chalmers University of Technology,+2006.+[pdf http://www.cse.chalmers.se/~janna/Janna_Khegai_phd.pdf]+#BR+//Collection of articles and technical reports on multilingual authoring//+//and the Russian resource grammar.//++B. Bringert and A. Ranta.+A Pattern for Almost Compositional Functions.+//ICFP 2006, The 11th ACM SIGPLAN International Conference on Functional Programming, Portland, Oregon, September 18-20, 2006//,+2006.+[pdf http://www.cse.chalmers.se/~bringert/publ/composOp/composOp.pdf].+#BR+//A method of generic programming useful for compiler construction//+//and transfer-based translation.//++M. Forsberg, H. Hammarstrom, and A. Ranta.+Morphological Lexicon Extraction from Raw Text Data. +//FinTAL 2006//, +Turku, August 23-25, 2006.+Springer LNCS/LNAI 4139,+pp. 488-499,+2006.+#BR+//A method for automatical production of morphological lexica based//+//on inflection engines such as those of GF resource grammar library.//++A. Ranta.+Type Theory and Universal Grammar.+//Philosophia Scientiae, Constructivism: Mathematics, Logic, Philosophy and Linguistics//,+cahier spécial 6,+pp. 115-131,+2006.+#BR+//A philosophical study of the medieval thesis that//+//grammar is the same in all languages and the difference is only in words.//++J. Khegai. +GF parallel resource grammars and Russian.+In proceedings of ACL2006 + (The joint conference of the International Committee on Computational + Linguistics and the Association for Computational Linguistics) (pp. 475-482),+ Sydney, Australia, July 2006.+#BR+//Gives an outline of the Russian resource grammar project.//++J. Khegai. +Grammatical Framework (GF) for MT in sublanguage domains. +Proceedings of 11th Annual conference of the European Association for + Machine Translation, , Oslo.+pp. 95-104,+2005.+#BR+//Shows how GF is used in controlled language translation.//++++W. Ng'ang'a. +Multilingual content development for eLearning in Africa. +eLearning Africa: 1st Pan-African Conference on ICT for Development, + Education and Training. 24-26 May 2006, Addis Ababa, Ethiopia.+2006.+[pdf http://webalt.math.helsinki.fi/content/e16/e301/e583/MultilingualContentDevelopmentforeLearninginAfrica-final1_eng.pdf]+#BR+//Presents a programme for producing educational material in African languages//+//via multilingual generation in GF.//++R. Jonson. +Generating statistical language models from interpretation grammars in dialogue system. +In Proceedings of EACL'06, Trento, Italy.+2006.+#BR+//Uses GF grammars to generate statistical language models for speech recognition.//++A. El Dada and A. Ranta.+Arabic Resource Grammar.+//Arabic Language Processing (JETALA)//, +5-6 June 2006, IERA, Rabat, Morocco,+2006.+#BR+//An outline of the Arabic resource grammar project, focusing on software aspects.//++D. A. Burke and K. Johannisson.+Translating Formal Software Specifications to Natural Language. A Grammar-Based Approach.+In P. Blache, E. Stabler, J. Busquets and R. Moot (eds),+Logical Aspects of Computational Linguistics (LACL 2005), +Springer LNAI 3402, +pp. 51-66, +2005.+#BR+//A paper explaining how a multilingual GF grammar is completed with//+//Natural Language Generation techniques to improve text quality.//+++B. Bringert, R. Cooper, P. Ljunglöf, A. Ranta, +Multimodal Dialogue System Grammars.+//Proceedings of DIALOR'05, Ninth Workshop on the Semantics and Pragmatics of Dialogue, Nancy, France, June 9-11, 2005//,+2005.+[pdf http://www.cse.chalmers.se/~bringert/publ/mm-grammars-dialor/mm-grammars-dialor.pdf].+#BR+//Shows how mouse clicks can be integrated in GF grammars//+//alongside with speech input.//++++K. Johannisson,+Formal and Informal Software Specifications.+PhD thesis,+Computer Science, Göteborg University, +2005.+[http://www.cse.chalmers.se/~krijo/thesis/thesisA4.pdf]+#BR+//Collection of articles in the GF-KeY project, with an introduction.//++P. Ljunglöf.+Expressivity and Complexity of the Grammatical Framework.+PhD thesis, Computer Science, +Göteborg University, +2004.+[pdf http://www.cse.chalmers.se/~peb/pubs/Ljunglof-2004a.pdf]+#BR+//Language-theoretical study of GF and its parsing problem.//++A. Ranta.+Grammatical Framework: A Type-Theoretical Grammar Formalism.+//Journal of Functional Programming//, 14(2),+pp. 145-189, +2004.+Draft available as [ps.gz http://www.cse.chalmers.se/~aarne/articles/gf-jfp.ps.gz].+#BR+//Theoretical paper explaining the GF formalism and its implementation.//+//The standard reference on GF, but doesn't cover the module system.//+++A. Ranta.+Computational semantics in type theory.+//Mathematics and Social Sciences//, 165,+pp. 31-57, +2004.+Draft available as [pdf http://www.cse.chalmers.se/~aarne/articles/3formsem.pdf].+#BR+// Shows how Montague-style grammars are implemented in GF and extends//+//this to type-theoretical grammars for anaphoric expressions.//++H. Hammarström and A. Ranta.+Cardinal Numerals Revisited in GF.+//Workshop on Numerals in the World's Languages//. +Dept. of Linguistics Max Planck Institute for Evolutionary Anthropology, Leipzig,+2004.+#BR+//An overview of the numeral grammar project, covering 88 languages.//+++A. Ranta.+Grammatical Framework Tutorial.+In A. Beckmann and N. Preining, editors, +//ESSLLI 2003 Course Material I//, +//Collegium Logicum//, +volume V,+pp. 1-86. +Kurt Gödel Society, +Vienna,+2004.+#BR+//A revised version of the on-line GF tutorial, v1.0.//+++J. Khegai and A. Ranta.+Building and Using a Russian Resource Grammar in GF.+In A. Gelbukh (ed), +//Intelligent Text Processing and Computational Linguistics (CICLing-2004)//, +Seoul, Korea, February 2003,+Springer LNCS 945, +pp. 38-41,+2004.+[ps.gz http://www.cse.chalmers.se/~aarne/articles/mexico.ps.gz].+#BR+//An introduction to the GF resource grammar project, with Russian as prime example.//+++A. Ranta and R. Cooper.+Dialogue Systems as Proof Editors.+ //Journal of Logic, Language and Information//, 13,+pp. 225-240, +2004.+Conference version (IJCAR/ICoS-3, Siena, June 2001) available as+ [ps.gz http://www.cse.chalmers.se/~aarne/articles/dialogue3.ps.gz].+//Shows a close analogy between task-oriented dialogue systems//+//and metavariable-based proof editors.//+++J. Khegai and A. Ranta.+Building and Using a Russian Resource Grammar in GF.+In A. Gelbukh (ed), +//Intelligent Text Processing and Computational Linguistics (CICLing-2004)//, +Seoul, Korea, February 2003,+Springer LNCS 945, +pp. 38-41,+2004.+[ps.gz http://www.cse.chalmers.se/~aarne/articles/mexico.ps.gz].+#BR+//Explains how the GF GUI is used in syntax editing and discusses//+//how new grammars are created.//+++R. Hähnle, K. Johannisson, and A. Ranta.+An Authoring Tool for Informal and Formal Requirements Specifications.+In R. D. Kutsche and H. Weber (eds),+//ETAPS/FASE-2002: Fundamental Approaches to Software Engineering//,+Springer LNCS, +vol. 2306,+pp. 233--248, +2002.+[pdf http://www.cse.chalmers.se/~krijo/GF/FASE.pdf]+#BR+//Describes a GF-based authoring tool for object-oriented//+//specifications in OCL and English. Carries out in full//+//the work proposed in the position paper (Hähnle & Ranta 2001).//++++K. Johannisson and A.Ranta,+Formal Verification of Multilingual Instructions.+//Proceedings of the Joint Winter Meeting 2001//.+Departments of Computer Science and Computer Engineering,+Chalmers University of Technology and Göteborg University.+2001.+[ps.gz http://www.cse.chalmers.se/~aarne/articles/aarne+krijo.ps.gz].+#BR+//Instructions for an alarm system in four languages, verified in the proof editor Alfa.//+++R. Hähnle and A. Ranta,+Connecting OCL with the Rest of the World.+//ETAPS 2001 Workshop on Transformations in UML (WTUML)//, +Genova, +2001.+[ps.gz http://www.cse.chalmers.se/~reiner/papers/wtuml.ps.gz].+#BR+//A position paper explaining how GF can be used to help in object-oriented//+//modelling, with some examples on natural-language interaction with//+//OCL (Object Constraint Language)//.++++T. Hallgren, "The Correctness of Insertion Sort",+Manuscript, Chalmers University, Göteborg, 2001.+Available in+[ps http://www.cse.chalmers.se/~hallgren/Papers/insertion_sort.ps]+#BR+//A seven-page text generated by GF-Alfa//.+++A. Ranta. "Bescherelle bricolé",+[ps.gz ../../GF2.0/doc/BeschBric.ps.gz], +2001.+#BR+//A machine-generated book on French conjugation implemented in GF.//+++T. Hallgren and A. Ranta,+An Extensible Proof Text Editor.+In M. Parigot and A. Voronkov (eds),+//Logic for Programming and Automated Reasoning (LPAR'2000)//,+LNCS/LNAI 1955, +pp. 70-84,+Springer Verlag, Heidelberg, +2000.+[ps.gz http://www.cse.chalmers.se/~aarne/articles/lpar2000.ps.gz].+#BR+//Describes an interface to the proof editor Alfa written in GF//.+++M. Dymetman, V. Lux, and A. Ranta,+XML and multilingual document authoring: converging trends.+//Proceedings of the The 18th International Conference on Computational Linguistics (COLING 2000)//,+pp. 243-249,+Saarbruecken, +2000.+[ps.gz http://www.cse.chalmers.se/~aarne/articles/coling2000.ps.gz].+#BR+//Relates GF not only with XML but also with definite clause grammars//.++++P. Mäenpää and A. Ranta.+The type theory and type checker of GF.+//Colloquium on Principles, Logics, and Implementations of High-Level Programming Languages, Workshop on Logical Frameworks and Meta-languages, Paris, 28 September 1999//.+1999. +[ps.gz href=http://www.cse.chalmers.se/~aarne/papers/lfm1999.ps.gz].+#BR+//Concise theoretical presentation of GF, using the old notation prior to v0.9//.+++++++++==Background for GF==++In alphabetical order:++++L. Magnusson.+//The Implementation of ALF - a Proof Editor based on Martin-Löf's//+//Monomorphic Type Theory with Explicit Substitutions//.+PhD Thesis, Department of Computing Science,+Chalmers University of Technology and Göteborg University,+1994.+#BR+//Back in 1992 the most wonderful program in the world, ALF is//+//a model that GF directly follows: GF is Yet ALF.//++++P. Martin-Löf.+//Intuitionistic Type Theory//.+Bibliopolis, Naples, 1984.+#BR+//A very accessible book (if you have access to it!) on type theory directly from the source.//++++B. Nordström, K. Petersson, and J. Smith.+//Programming in Martin-Löf's Type Theory: an Introduction//.+Oxford University Press, 1990.+ The book is out of print, but a free version can be picked up from+[www.cse.chalmers.se/Cs/Research/Logic/book/ http://www.cse.chalmers.se/Cs/Research/Logic/book/]+#BR+//Standard reference on the subject//.+++A. Ranta.+//Type Theoretical Grammar//.+Oxford University Press, Oxford, +1994.+#BR+//Monograph on type theory in linguistics. Includes an introduction//+//to type theory. Focused on semantics, in particular anaphora. A first,// +//very rudimentary implementation of linearization in the proof system ALF.//+++A. Ranta.+Syntactic categories in the language of mathematics.+In P. Dybjer, B. Nordström, and J. Smith, eds.,+//Types for Proofs and Programs//, +pp. 162-182,+Lecture Notes in Computer Science+996, +Springer-Verlag, +Heidelberg, +1995.+[ps.gz http://www.cse.chalmers.se/~aarne/articles/baastad.ps.gz]+#BR+//Predecessor of GF: grammar defined in type theory and implemented in ALF//. ++A. Ranta.+Context-relative syntactic categories and the formalization of mathematical text.+In S. Berardi and M. Coppo, eds.,+//Types for Proofs and Programs//, +pp. 231-248,+Lecture Notes in Computer Science +1158, +Springer-Verlag, +Heidelberg, +1996.+[ps.gz http://www.cse.chalmers.se/~aarne/articles/torino.ps.gz].+#BR+//Extending the theory of the previous paper. The implementation in ALF// +//eventually became so heavy that the need arose for GF.//+++A. Ranta.+Structures grammaticales dans le français mathématique. +//Mathématiques, informatique et Sciences Humaines.//,+vol. 138 pp. 5-56 and 139 pp. 5-36, +1997.+#BR+//A rather comprehensive French grammar presented in a type-theoretical style.//+++A. Ranta.+ Syntactic calculus with dependent types.+ //Journal of Logic, Language and Information//, vol. 4,+ pp. 413-431, 1998.+#BR+//Interprets Lambek Calculus in type theory and defines some extensions//.++
@@ -0,0 +1,518 @@+GF Developers Guide++2018-07-26++%!options(html): --toc++== Before you start ==++This guide is intended for people who want to contribute to+the development of the GF compiler or the Resource Grammar Library. If+you are a GF user who just wants to download and install GF+(e.g to develop your own grammars), the simpler guide on+[the GF download page ../download/index.html] should be sufficient.++== Setting up your system for building GF ==++To build GF from source you need to install some tools on your+system: the //Haskell Platform//, //Git// and the //Haskeline library//.++**On Linux** the best option is to install the tools via the standard+software distribution channels, i.e. by using the //Software Center//+in Ubuntu or the corresponding tool in other popular Linux distributions.+Or, from a Terminal window, the following command should be enough:++- On Ubuntu: ``sudo apt-get install haskell-platform git libghc6-haskeline-dev``+- On Fedora: ``sudo dnf install haskell-platform git ghc-haskeline-devel``+++**On Mac OS and Windows**, the tools can be downloaded from their respective+web sites, as described below.++=== The Haskell Platform ===++GF is written in Haskell, so first of all you need+the //Haskell Platform//, e.g. version 8.0.2 or 7.10.3. Downloads+and installation instructions are available from here:++ http://hackage.haskell.org/platform/++Once you have installed the Haskell Platform, open a terminal+(Command Prompt on Windows) and try to execute the following command:+```+$ ghc --version+```+This command should show you which version of GHC you have. If the installation+of the Haskell Platform was successful you should see a message like:++```+The Glorious Glasgow Haskell Compilation System, version 8.0.2+```++Other required tools included in the Haskell Platform are+[Cabal http://www.haskell.org/cabal/],+[Alex http://www.haskell.org/alex/]+and+[Happy http://www.haskell.org/happy/].++=== Git ===++To get the GF source code, you also need //Git//.+//Git// is a distributed version control system, see+https://git-scm.com/downloads for more information.++=== The haskeline library ===++GF uses //haskeline// to enable command line editing in the GF shell.+This should work automatically on Mac OS and Windows, but on Linux one+extra step is needed to make sure the C libraries (terminfo)+required by //haskeline// are installed. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``+- On Fedora: ``sudo dnf install ghc-haskeline-devel``+++== Getting the source ==++Once you have all tools in place you can get the GF source code. If you+just want to compile and use GF then it is enough to have read-only+access. It is also possible to make changes in the source code but if you+want these changes to be applied back to the main source repository you will+have to send the changes to us. If you plan to work continuously on+GF then you should consider getting read-write access.++=== Read-only access ===++==== Getting a fresh copy for read-only access ====++Anyone can get the latest development version of GF by running:++```+$ git clone https://github.com/GrammaticalFramework/gf-core.git+$ git clone https://github.com/GrammaticalFramework/gf-rgl.git+```++This will create directories ``gf-core`` and ``gf-rgl`` in the current directory.+++==== Updating your copy ====++To get all new patches from each repo:+```+$ git pull+```+This can be done anywhere in your local repository.+++==== Recording local changes ====[record]++Since every copy is a repository, you can have local version control+of your changes.++If you have added files, you first need to tell your local repository to+keep them under revision control:++```+$ git add file1 file2 ...+```++To record changes, use:++```+$ git commit file1 file2 ...+```++This creates a patch against the previous version and stores it in your+local repository. You can record any number of changes before+pushing them to the main repo. In fact, you don't have to push them at+all if you want to keep the changes only in your local repo.++Instead of enumerating all modified files on the command line,+you can use the flag ``-a`` to automatically record //all// modified+files. You still need to use ``git add`` to add new files.+++=== Read-write access ===++If you are a member of the GF project on GitHub, you can push your+changes directly to the GF git repository on GitHub.++```+$ git push+```++It is also possible for anyone else to contribute by++- creating a fork of the GF repository on GitHub,+- working with local clone of the fork (obtained with ``git clone``),+- pushing changes to the fork,+- and finally sending a pull request.++++== Compilation from source with Cabal ==++The build system of GF is based on //Cabal//, which is part of the+Haskell Platform, so no extra steps are needed to install it. In the simplest+case, all you need to do to compile and install GF, after downloading the+source code as described above, is++```+$ cabal install+```++This will automatically download any additional Haskell libraries needed to+build GF. If this is the first time you use Cabal, you might need to run+``cabal update`` first, to update the list of available libraries.++If you want more control, the process can also be split up into the usual+//configure//, //build// and //install// steps.++=== Configure ===++During the configuration phase Cabal will check that you have all+necessary tools and libraries needed for GF. The configuration is+started by the command:++```+$ cabal configure+```++If you don't see any error message from the above command then you+have everything that is needed for GF. You can also add the option+``-v`` to see more details about the configuration.++You can use ``cabal configure --help`` to get a list of configuration options.++=== Build ===++The build phase does two things. First it builds the GF compiler from+the Haskell source code and after that it builds the GF Resource Grammar+Library using the already build compiler. The simplest command is:++```+$ cabal build+```++Again you can add the option ``-v`` if you want to see more details.++==== Parallel builds ====++If you have Cabal>=1.20 you can enable parallel compilation by using++```+$ cabal build -j+```++or by putting a line+```+jobs: $ncpus+```+in your ``.cabal/config`` file. Cabal+will pass this option to GHC when building the GF compiler, if you+have GHC>=7.8.++Cabal also passes ``-j`` to GF to enable parallel compilation of the+Resource Grammar Library. This is done unconditionally to avoid+causing problems for developers with Cabal<1.20. You can disable this+by editing the last few lines in ``WebSetup.hs``.+++==== Partial builds ====++**NOTE**: The following doesn't work with recent versions of ``cabal``.+%% // TH 2015-06-22++Sometimes you just want to work on the GF compiler and don't want to+recompile the resource library after each change. In this case use+this extended command:++```+$ cabal build rgl-none+```++The resource library could also be compiled in two modes: with present+tense only and with all tenses. By default it is compiled with all+tenses. If you want to use the library with only present tense you can+compile it in this special mode with the command:++```+$ cabal build present+```++You could also control which languages you want to be recompiled by+adding the option ``langs=list``. For example the following command+will compile only the English and the Swedish language:++```+$ cabal build langs=Eng,Swe+```++=== Install ===++After you have compiled GF you need to install the executable and libraries+to make the system usable.++```+$ cabal copy+$ cabal register+```++This command installs the GF compiler for a single user, in the standard+place used by Cabal.+On Linux and Mac this could be ``$HOME/.cabal/bin``.+On Mac it could also be ``$HOME/Library/Haskell/bin``.+On Windows this is ``C:\Program Files\Haskell\bin``.++The compiled GF Resource Grammar Library will be installed+under the same prefix, e.g. in+``$HOME/.cabal/share/gf-3.3.3/lib`` on Linux and+in ``C:\Program Files\Haskell\gf-3.3.3\lib`` on Windows.++If you want to install in some other place then use the ``--prefix``+option during the configuration phase.++=== Clean ===++Sometimes you want to clean up the compilation and start again from clean+sources. Use the clean command for this purpose:++```+$ cabal clean+```+++%=== SDist ===+%+%You can use the command:+%+%% This does *NOT* include everything that is needed // TH 2012-08-06+%```+%$ cabal sdist+%```+%+%to prepare archive with all source codes needed to compile GF.++=== Known problems with Cabal ===++Some versions of Cabal (at least version 1.16) seem to have a bug that can+cause the following error:++```+Configuring gf-3.x...+setup: Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+```++The exact cause of this problem is unclear, but it seems to happen+during the configure phase if the same version of GF is already installed,+so a workaround is to remove the existing installation with++```+ghc-pkg unregister gf+```++You can check with ``ghc-pkg list gf`` that it is gone.++== Compilation with make ==++If you feel more comfortable with Makefiles then there is a thin Makefile+wrapper arround Cabal for you. If you just type:+```+$ make+```+the configuration phase will be run automatically if needed and after that+the sources will be compiled.++%% cabal build rgl-none does not work with recent versions of Cabal+%If you don't want to compile the resource library+%every time then you can use:+%```+%$ make gf+%```++For installation use:+```+$ make install+```+For cleaning:+```+$ make clean+```+%and to build source distribution archive run:+%```+%$ make sdist+%```++== Compiling GF with C run-time system support ==++The C run-time system is a separate implementation of the PGF run-time services.+It makes it possible to work with very large, ambiguous grammars, using+probabilistic models to obtain probable parses. The C run-time system might+also be easier to use than the Haskell run-time system on certain platforms,+e.g. Android and iOS.++To install the C run-time system, go to the ``src/runtime/c`` directory+%and follow the instructions in the ``INSTALL`` file.+and use the ``install.sh`` script:+```+bash setup.sh configure+bash setup.sh build+bash setup.sh install+```+This will install+the C header files and libraries need to write C programs that use PGF grammars.+Some example C programs are included in the ``utils`` subdirectory, e.g.+``pgf-translate.c``.++When the C run-time system is installed, you can install GF with C run-time+support by doing++```+cabal install -fserver -fc-runtime+```+from the top directory. This give you three new things:++- ``PGF2``: a module to import in Haskell programs, providing a binding to+ the C run-time system.++- The GF shell can be started with ``gf -cshell`` or ``gf -crun`` to use+ the C run-time system instead of the Haskell run-time system.+ Only limited functionality is available when running the shell in these+ modes (use the ``help`` command in the shell for details).++- ``gf -server`` mode is extended with new requests to call the C run-time+ system, e.g. ``c-parse``, ``c-linearize`` and ``c-translate``.+++=== Python and Java bindings ===++The C run-time system can also be used from Python and Java. Python and Java+bindings are found in the ``src/runtime/python`` and ``src/runtime/java``+directories, respecively. Compile them by following the instructions in+the ``INSTALL`` files in those directories.++== Compilation of RGL ==++As of 2018-07-26, the RGL is distributed separately from the GF compiler and runtimes.++=== Simple ===+To install the RGL, you can use the following commands from within the ``gf-rgl`` repository:+```+$ make install+```+There is also ``make build``, ``make copy`` and ``make clean`` which do what you might expect.++=== Advanced ===+For advanced build options, call the Haskell build script directly:+```+$ runghc Make.hs ...+```+For more details see the [README https://github.com/GrammaticalFramework/gf-rgl/blob/master/README.md].++=== Haskell-free ===+If you do not have Haskell installed, you can use the simple build script ``Make.sh``+(or ``Make.bat`` for Windows).+++== Creating binary distribution packages ==++=== Creating .deb packages for Ubuntu ===++This was tested on Ubuntu 14.04 for the release of GF 3.6, and the+resulting ``.deb`` packages appears to work on Ubuntu 12.04, 13.10 and 14.04.+For the release of GF 3.7, we generated ``.deb`` packages on Ubuntu 15.04 and+tested them on Ubuntu 12.04 and 14.04.++Under Ubuntu, Haskell executables are statically linked against other Haskell+libraries, so the .deb packages are fairly self-contained.++==== Preparations ====++```+sudo apt-get install dpkg-dev debhelper+```++==== Creating the package ====++Make sure the ``debian/changelog`` starts with an entry that describes the+version you are building. Then run++```+make deb+```++If get error messages about missing dependencies+(e.g. ``autoconf``, ``automake``, ``libtool-bin``, ``python-dev``,+``java-sdk``, ``txt2tags``)+use ``apt-get intall`` to install them, then try again.+++=== Creating OS X Installer packages ===++Run++```+make pkg+```++=== Creating binary tar distributions ===++Run++```+make bintar+```++=== Creating .rpm packages for Fedora ===++This is possible, but the procedure has not been automated.+It involves using the cabal-rpm tool,++```+sudo dnf install cabal-rpm+```++and following the Fedora guide+[How to create an RPM package http://fedoraproject.org/wiki/How_to_create_an_RPM_package].++Under Fedora, Haskell executables are dynamically linked against other Haskell+libraries, so ``.rpm`` packages for all Haskell libraries that GF depends on+are required. Most of them are already available in the Fedora distribution,+but a few of them might have to be built and distributed along with+the GF ``.rpm`` package.+When building ``.rpm`` packages for GF 3.4, we also had to build ``.rpm``s for+``fst`` and ``httpd-shed``.++== Running the testsuite ==++**NOTE:** The test suite has not been maintained recently, so expect many+tests to fail.+%% // TH 2012-08-06++GF has testsuite. It is run with the following command:+```+$ cabal test+```+The testsuite architecture for GF is very simple but still very flexible.+GF by itself is an interpreter and could execute commands in batch mode.+This is everything that we need to organize a testsuite. The root of the+testsuite is the testsuite/ directory. It contains subdirectories which+themself contain GF batch files (with extension .gfs). The above command+searches the subdirectories of the testsuite/ directory for files with extension+.gfs and when it finds one it is executed with the GF interpreter.+The output of the script is stored in file with extension .out and is compared+with the content of the corresponding file with extension .gold, if there is one.+If the contents are identical the command reports that the test was passed successfully.+Otherwise the test had failed.++Every time when you make some changes to GF that have to be tested, instead of+writing the commands by hand in the GF shell, add them to one .gfs file in the testsuite+and run the test. In this way you can use the same test later and we will be sure+that we will not incidentaly break your code later.++If you don't want to run the whole testsuite you can write the path to the subdirectory+in which you are interested. For example:+```+$ cabal test testsuite/compiler+```+will run only the testsuite for the compiler.
@@ -0,0 +1,72 @@+Editor modes & IDE integration for GF+++We collect GF modes for various editors on this page. Contributions are+welcome!+++==Emacs==++[gf.el https://github.com/GrammaticalFramework/gf-emacs-mode] by Johan+Bockgård provides syntax highlighting and automatic indentation and+lets you run the GF Shell in an emacs buffer. See installation+instructions inside.++==Atom==+[language-gf https://atom.io/packages/language-gf], by John J. Camilleri++==Eclipse==++[GF Eclipse Plugin https://github.com/GrammaticalFramework/gf-eclipse-plugin/], by John J. Camilleri++==Gedit==++By John J. Camilleri++Copy the file below to+``~/.local/share/gtksourceview-3.0/language-specs/gf.lang`` (under Ubuntu).++- [gf.lang ../src/tools/gf.lang]+++Some helpful notes/links:++- The code is based heavily on the ``haskell.lang`` file which I found in+ ``/usr/share/gtksourceview-2.0/language-specs/haskell.lang``.+- Ruslan Osmanov recommends+ [registering your file extension as its own MIME type http://osmanov-dev-notes.blogspot.com/2011/04/how-to-add-new-highlight-mode-in-gedit.html]+ (see also [here https://help.ubuntu.com/community/AddingMimeTypes]),+ however on my system the ``.gf`` extension was already registered+ as a generic font (``application/x-tex-gf``) and I didn't want to risk+ messing any of that up.+- This is a quick 5-minute job and might require some tweaking.+ [The GtkSourceView language definition tutorial http://developer.gnome.org/gtksourceview/stable/lang-tutorial.html]+ is the place to start looking.+- Contributions are welcome!+++==Geany==++By John J. Camilleri++[Custom filetype http://www.geany.org/manual/dev/index.html#custom-filetypes]+config files for syntax highlighting in [Geany http://www.geany.org/].++Copy one of the files below to ``/usr/share/geany/filetypes.GF.conf``+(under Ubuntu). You will need to manually create the file.++- [light-filetypes.GF.conf ../src/tools/light-filetypes.GF.conf]+- [dark-filetypes.GF.conf ../src/tools/dark-filetypes.GF.conf]+++You will also need to edit the ``filetype_extensions.conf`` file and add the+following line somewhere:++```+GF=*.gf+```+++==Vim==++[vim-gf https://github.com/gdetrez/vim-gf]
@@ -0,0 +1,1319 @@++++#VSPACE++====!====+#NOINDENT+``!``: //system command: escape to system shell.//++#TINY++- Syntax: ``! SYSTEMCOMMAND``++- Examples:++ | ``! ls *.gf`` | list all GF files in the working directory+++#NORMAL+++#VSPACE++====?====+#NOINDENT+``?``: //system pipe: send value from previous command to a system command.//++#TINY++- Syntax: ``? SYSTEMCOMMAND``++- Examples:++ | ``gt | l | ? wc`` | generate, linearize, word-count+++#NORMAL+++#VSPACE++====ai = abstract_info====+#NOINDENT+``ai`` = ``abstract_info``: //Provides an information about a function, an expression or a category from the abstract syntax.//++#TINY++The command has one argument which is either function, expression or+a category defined in the abstract syntax of the current grammar. +If the argument is a function then ?its type is printed out.+If it is a category then the category definition is printed.+If a whole expression is given it prints the expression with refined+metavariables and the type of the expression.++- Syntax: ``ai IDENTIFIER or ai EXPR``++#NORMAL+++#VSPACE++====aw = align_words====+#NOINDENT+``aw`` = ``align_words``: //show word alignments between languages graphically.//++#TINY++Prints a set of strings in the .dot format (the graphviz format).+The graph can be saved in a file by the wf command as usual.+If the -view flag is defined, the graph is saved in a temporary file+which is processed by 'dot' (graphviz) and displayed by the program indicated+by the view flag. The target format is png, unless overridden by the+flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).+++- Options:++ | ``-giza`` | show alignments in the Giza format; the first two languages++- Flags:++ | ``-format`` | format of the visualization file (default "png")+ | ``-lang`` | alignments for this list of languages (default: all)+ | ``-view`` | program to open the resulting file++- Examples:++ | ``gr | aw`` | generate a tree and show word alignment as graph script+ | ``gr | aw -view="open"`` | generate a tree and display alignment on Mac+ | ``gr | aw -view="eog"`` | generate a tree and display alignment on Ubuntu+ | ``gt | aw -giza | wf -file=aligns`` | generate trees, send giza alignments to file+++#NORMAL+++#VSPACE++====ca = clitic_analyse====+#NOINDENT+``ca`` = ``clitic_analyse``: //print the analyses of all words into stems and clitics.//++#TINY++Analyses all words into all possible combinations of stem + clitics.+The analysis is returned in the format stem &+ clitic1 &+ clitic2 ...+which is hence the inverse of 'pt -bind'. The list of clitics is give+by the flag '-clitics'. The list of stems is given as the list of words+of the language given by the '-lang' flag.+++- Options:++ | ``-raw`` | analyse each word separately (not suitable input for parser)++- Flags:++ | ``-clitics`` | the list of possible clitics (comma-separated, no spaces)+ | ``-lang`` | the language of analysis++- Examples:++ | ``ca -lang=Fin -clitics=ko,ni "nukkuuko minun vaimoni" | p`` | to parse Finnish+++#NORMAL+++#VSPACE++====cc = compute_concrete====+#NOINDENT+``cc`` = ``compute_concrete``: //computes concrete syntax term using a source grammar.//++#TINY++Compute TERM by concrete syntax definitions. Uses the topmost+module (the last one imported) to resolve constant names.+N.B.1 You need the flag -retain when importing the grammar, if you want+the definitions to be retained after compilation.+N.B.2 The resulting term is not a tree in the sense of abstract syntax+and hence not a valid input to a Tree-expecting command.+This command must be a line of its own, and thus cannot be a part+of a pipe.++- Syntax: ``cc (-all | -table | -unqual)? TERM``+- Options:++ | ``-all`` | pick all strings (forms and variants) from records and tables+ | ``-list`` | all strings, comma-separated on one line+ | ``-one`` | pick the first strings, if there is any, from records and tables+ | ``-table`` | show all strings labelled by parameters+ | ``-unqual`` | hide qualifying module names+ | ``-trace`` | trace computations+++#NORMAL+++#VSPACE++====dc = define_command====+#NOINDENT+``dc`` = ``define_command``: //define a command macro.//++#TINY++Defines IDENT as macro for COMMANDLINE, until IDENT gets redefined.+A call of the command has the form %IDENT. The command may take an+argument, which in COMMANDLINE is marked as ?0. Both strings and+trees can be arguments. Currently at most one argument is possible.+This command must be a line of its own, and thus cannot be a part+of a pipe.++- Syntax: ``dc IDENT COMMANDLINE``++#NORMAL+++#VSPACE++====dg = dependency_graph====+#NOINDENT+``dg`` = ``dependency_graph``: //print module dependency graph.//++#TINY++Prints the dependency graph of source modules.+Requires that import has been done with the -retain flag.+The graph is written in the file _gfdepgraph.dot+which can be further processed by Graphviz (the system command 'dot').+By default, all modules are shown, but the -only flag restricts them+by a comma-separated list of patterns, where 'name*' matches modules+whose name has prefix 'name', and other patterns match modules with+exactly the same name. The graphical conventions are:+ solid box = abstract, solid ellipse = concrete, dashed ellipse = other+ solid arrow empty head = of, solid arrow = **, dashed arrow = open+ dotted arrow = other dependency++- Syntax: ``dg (-only=MODULES)?``++- Flags:++ | ``-only`` | list of modules included (default: all), literally or by prefix*++- Examples:++ | ``dg -only=SyntaxEng,Food*`` | shows only SyntaxEng, and those with prefix Food+++#NORMAL+++#VSPACE++====dt = define_tree====+#NOINDENT+``dt`` = ``define_tree``: //define a tree or string macro.//++#TINY++Defines IDENT as macro for TREE or STRING, until IDENT gets redefined.+The defining value can also come from a command, preceded by "<".+If the command gives many values, the first one is selected.+A use of the macro has the form %IDENT. Currently this use cannot be+a subtree of another tree. This command must be a line of its own+and thus cannot be a part of a pipe.++- Syntax: ``dt IDENT (TREE | STRING | "<" COMMANDLINE)``++- Examples:++ | ``dt ex "hello world"`` | define ex as string+ | ``dt ex UseN man_N`` | define ex as string+ | ``dt ex < p -cat=NP "the man in the car"`` | define ex as parse result+ | ``l -lang=LangSwe %ex | ps -to_utf8`` | linearize the tree ex+++#NORMAL+++#VSPACE++====e = empty====+#NOINDENT+``e`` = ``empty``: //empty the environment (except the command history).//++#TINY++#NORMAL+++#VSPACE++====eb = example_based====+#NOINDENT+``eb`` = ``example_based``: //converts .gfe files to .gf files by parsing examples to trees.//++#TINY++Reads FILE.gfe and writes FILE.gf. Each expression of form+'%ex CAT QUOTEDSTRING' in FILE.gfe is replaced by a syntax tree.+This tree is the first one returned by the parser; a biased ranking+can be used to regulate the order. If there are more than one parses+the rest are shown in comments, with probabilities if the order is biased.+The probabilities flag and configuration file is similar to the commands+gr and rt. Notice that the command doesn't change the environment,+but the resulting .gf file must be imported separately.++- Syntax: ``eb (-probs=FILE | -lang=LANG)* -file=FILE.gfe``+- Options:++ | ``-api`` | convert trees to overloaded API expressions (using Syntax not Lang)++- Flags:++ | ``-file`` | the file to be converted (suffix .gfe must be given)+ | ``-lang`` | the language in which to parse+ | ``-probs`` | file with probabilities to rank the parses+++#NORMAL+++#VSPACE++====eh = execute_history====+#NOINDENT+``eh`` = ``execute_history``: //read commands from a file and execute them.//++#TINY++- Syntax: ``eh FILE``++#NORMAL+++#VSPACE++====gr = generate_random====+#NOINDENT+``gr`` = ``generate_random``: //generate random trees in the current abstract syntax.//++#TINY++Generates a list of random trees, by default one tree.+If a tree argument is given, the command completes the Tree with values to+all metavariables in the tree. The generation can be biased by probabilities,+given in a file in the -probs flag.++- Syntax: ``gr [-cat=CAT] [-number=INT]``++- Flags:++ | ``-cat`` | generation category+ | ``-lang`` | uses only functions that have linearizations in all these languages+ | ``-number`` | number of trees generated+ | ``-depth`` | the maximum generation depth+ | ``-probs`` | file with biased probabilities (format 'f 0.4' one by line)++- Examples:++ | ``gr`` | one tree in the startcat of the current grammar+ | ``gr -cat=NP -number=16`` | 16 trees in the category NP+ | ``gr -lang=LangHin,LangTha -cat=Cl`` | Cl, both in LangHin and LangTha+ | ``gr -probs=FILE`` | generate with bias+ | ``gr (AdjCN ? (UseN ?))`` | generate trees of form (AdjCN ? (UseN ?))+++#NORMAL+++#VSPACE++====gt = generate_trees====+#NOINDENT+``gt`` = ``generate_trees``: //generates a list of trees, by default exhaustive.//++#TINY++Generates all trees of a given category. By default, +the depth is limited to 4, but this can be changed by a flag.+If a Tree argument is given, the command completes the Tree with values+to all metavariables in the tree.+++- Flags:++ | ``-cat`` | the generation category+ | ``-depth`` | the maximum generation depth+ | ``-lang`` | excludes functions that have no linearization in this language+ | ``-number`` | the number of trees generated++- Examples:++ | ``gt`` | all trees in the startcat, to depth 4+ | ``gt -cat=NP -number=16`` | 16 trees in the category NP+ | ``gt -cat=NP -depth=2`` | trees in the category NP to depth 2+ | ``gt (AdjCN ? (UseN ?))`` | trees of form (AdjCN ? (UseN ?))+++#NORMAL+++#VSPACE++====h = help====+#NOINDENT+``h`` = ``help``: //get description of a command, or a the full list of commands.//++#TINY++Displays information concerning the COMMAND.+Without argument, shows the synopsis of all commands.++- Syntax: ``h (-full)? COMMAND?``+- Options:++ | ``-changes`` | give a summary of changes from GF 2.9+ | ``-coding`` | give advice on character encoding+ | ``-full`` | give full information of the commands+ | ``-license`` | show copyright and license information+ | ``-t2t`` | output help in txt2tags format+++#NORMAL+++#VSPACE++====i = import====+#NOINDENT+``i`` = ``import``: //import a grammar from source code or compiled .pgf file.//++#TINY++Reads a grammar from File and compiles it into a GF runtime grammar.+If its abstract is different from current state, old modules are discarded.+If its abstract is the same and a concrete with the same name is already in the state+it is overwritten - but only if compilation succeeds.+The grammar parser depends on the file name suffix:+ .cf context-free (labelled BNF) source+ .ebnf extended BNF source+ .gfm multi-module GF source+ .gf normal GF source+ .gfo compiled GF source+ .pgf precompiled grammar in Portable Grammar Format+++- Options:++ | ``-retain`` | retain operations (used for cc command)+ | ``-src`` | force compilation from source+ | ``-v`` | be verbose - show intermediate status information++- Flags:++ | ``-probs`` | file with biased probabilities for generation+++#NORMAL+++#VSPACE++====l = linearize====+#NOINDENT+``l`` = ``linearize``: //convert an abstract syntax expression to string.//++#TINY++Shows the linearization of a Tree by the grammars in scope.+The -lang flag can be used to restrict this to fewer languages.+A sequence of string operations (see command ps) can be given+as options, and works then like a pipe to the ps command, except+that it only affect the strings, not e.g. the table labels.+These can be given separately to each language with the unlexer flag+whose results are prepended to the other lexer flags. The value of the+unlexer flag is a space-separated list of comma-separated string operation+sequences; see example.+++- Options:++ | ``-all`` | show all forms and variants, one by line (cf. l -list)+ | ``-bracket`` | show tree structure with brackets and paths to nodes+ | ``-groups`` | all languages, grouped by lang, remove duplicate strings+ | ``-list`` | show all forms and variants, comma-separated on one line (cf. l -all)+ | ``-multi`` | linearize to all languages (default)+ | ``-table`` | show all forms labelled by parameters+ | ``-tabtreebank`` | show the tree and its linearizations on a tab-separated line+ | ``-treebank`` | show the tree and tag linearizations with language names+ | ``-bind`` | bind tokens separated by Prelude.BIND, i.e. &++ | ``-chars`` | lexer that makes every non-space character a token+ | ``-from_amharic`` | from unicode to GF Amharic transliteration+ | ``-from_ancientgreek`` | from unicode to GF ancient Greek transliteration+ | ``-from_arabic`` | from unicode to GF Arabic transliteration+ | ``-from_arabic_unvocalized`` | from unicode to GF unvocalized Arabic transliteration+ | ``-from_cp1251`` | decode from cp1251 (Cyrillic used in Bulgarian resource)+ | ``-from_devanagari`` | from unicode to GF Devanagari transliteration+ | ``-from_greek`` | from unicode to GF modern Greek transliteration+ | ``-from_hebrew`` | from unicode to GF unvocalized Hebrew transliteration+ | ``-from_nepali`` | from unicode to GF Nepali transliteration+ | ``-from_persian`` | from unicode to GF Persian/Farsi transliteration+ | ``-from_sanskrit`` | from unicode to GF Sanskrit transliteration+ | ``-from_sindhi`` | from unicode to GF Sindhi transliteration+ | ``-from_telugu`` | from unicode to GF Telugu transliteration+ | ``-from_thai`` | from unicode to GF Thai transliteration+ | ``-from_urdu`` | from unicode to GF Urdu transliteration+ | ``-from_utf8`` | decode from utf8 (default)+ | ``-lexcode`` | code-like lexer+ | ``-lexgreek`` | lexer normalizing ancient Greek accentuation+ | ``-lexgreek2`` | lexer normalizing ancient Greek accentuation for text with vowel length annotations+ | ``-lexmixed`` | mixture of text and code, as in LaTeX (code between $...$, \(...)\, \[...\])+ | ``-lextext`` | text-like lexer+ | ``-to_amharic`` | from GF Amharic transliteration to unicode+ | ``-to_ancientgreek`` | from GF ancient Greek transliteration to unicode+ | ``-to_arabic`` | from GF Arabic transliteration to unicode+ | ``-to_arabic_unvocalized`` | from GF unvocalized Arabic transliteration to unicode+ | ``-to_cp1251`` | encode to cp1251 (Cyrillic used in Bulgarian resource)+ | ``-to_devanagari`` | from GF Devanagari transliteration to unicode+ | ``-to_greek`` | from GF modern Greek transliteration to unicode+ | ``-to_hebrew`` | from GF unvocalized Hebrew transliteration to unicode+ | ``-to_html`` | wrap in a html file with linebreaks+ | ``-to_nepali`` | from GF Nepali transliteration to unicode+ | ``-to_persian`` | from GF Persian/Farsi transliteration to unicode+ | ``-to_sanskrit`` | from GF Sanskrit transliteration to unicode+ | ``-to_sindhi`` | from GF Sindhi transliteration to unicode+ | ``-to_telugu`` | from GF Telugu transliteration to unicode+ | ``-to_thai`` | from GF Thai transliteration to unicode+ | ``-to_urdu`` | from GF Urdu transliteration to unicode+ | ``-to_utf8`` | encode to utf8 (default)+ | ``-unchars`` | unlexer that puts no spaces between tokens+ | ``-unlexcode`` | code-like unlexer+ | ``-unlexgreek`` | unlexer de-normalizing ancient Greek accentuation+ | ``-unlexmixed`` | mixture of text and code (code between $...$, \(...)\, \[...\])+ | ``-unlextext`` | text-like unlexer+ | ``-unwords`` | unlexer that puts a single space between tokens (default)+ | ``-words`` | lexer that assumes tokens separated by spaces (default)++- Flags:++ | ``-lang`` | the languages of linearization (comma-separated, no spaces)+ | ``-unlexer`` | set unlexers separately to each language (space-separated)++- Examples:++ | ``l -lang=LangSwe,LangNor no_Utt`` | linearize tree to LangSwe and LangNor+ | ``gr -lang=LangHin -cat=Cl | l -table -to_devanagari`` | hindi table+ | ``l -unlexer="LangAra=to_arabic LangHin=to_devanagari"`` | different unlexers+++#NORMAL+++#VSPACE++====lc = linearize_chunks====+#NOINDENT+``lc`` = ``linearize_chunks``: //linearize a tree that has metavariables in maximal chunks without them.//++#TINY++A hopefully temporary command, intended to work around the type checker that fails+trees where a function node is a metavariable.+++- Options:++ | ``-treebank`` | show the tree and tag linearizations with language names+ | ``-bind`` | bind tokens separated by Prelude.BIND, i.e. &++ | ``-chars`` | lexer that makes every non-space character a token+ | ``-from_amharic`` | from unicode to GF Amharic transliteration+ | ``-from_ancientgreek`` | from unicode to GF ancient Greek transliteration+ | ``-from_arabic`` | from unicode to GF Arabic transliteration+ | ``-from_arabic_unvocalized`` | from unicode to GF unvocalized Arabic transliteration+ | ``-from_cp1251`` | decode from cp1251 (Cyrillic used in Bulgarian resource)+ | ``-from_devanagari`` | from unicode to GF Devanagari transliteration+ | ``-from_greek`` | from unicode to GF modern Greek transliteration+ | ``-from_hebrew`` | from unicode to GF unvocalized Hebrew transliteration+ | ``-from_nepali`` | from unicode to GF Nepali transliteration+ | ``-from_persian`` | from unicode to GF Persian/Farsi transliteration+ | ``-from_sanskrit`` | from unicode to GF Sanskrit transliteration+ | ``-from_sindhi`` | from unicode to GF Sindhi transliteration+ | ``-from_telugu`` | from unicode to GF Telugu transliteration+ | ``-from_thai`` | from unicode to GF Thai transliteration+ | ``-from_urdu`` | from unicode to GF Urdu transliteration+ | ``-from_utf8`` | decode from utf8 (default)+ | ``-lexcode`` | code-like lexer+ | ``-lexgreek`` | lexer normalizing ancient Greek accentuation+ | ``-lexgreek2`` | lexer normalizing ancient Greek accentuation for text with vowel length annotations+ | ``-lexmixed`` | mixture of text and code, as in LaTeX (code between $...$, \(...)\, \[...\])+ | ``-lextext`` | text-like lexer+ | ``-to_amharic`` | from GF Amharic transliteration to unicode+ | ``-to_ancientgreek`` | from GF ancient Greek transliteration to unicode+ | ``-to_arabic`` | from GF Arabic transliteration to unicode+ | ``-to_arabic_unvocalized`` | from GF unvocalized Arabic transliteration to unicode+ | ``-to_cp1251`` | encode to cp1251 (Cyrillic used in Bulgarian resource)+ | ``-to_devanagari`` | from GF Devanagari transliteration to unicode+ | ``-to_greek`` | from GF modern Greek transliteration to unicode+ | ``-to_hebrew`` | from GF unvocalized Hebrew transliteration to unicode+ | ``-to_html`` | wrap in a html file with linebreaks+ | ``-to_nepali`` | from GF Nepali transliteration to unicode+ | ``-to_persian`` | from GF Persian/Farsi transliteration to unicode+ | ``-to_sanskrit`` | from GF Sanskrit transliteration to unicode+ | ``-to_sindhi`` | from GF Sindhi transliteration to unicode+ | ``-to_telugu`` | from GF Telugu transliteration to unicode+ | ``-to_thai`` | from GF Thai transliteration to unicode+ | ``-to_urdu`` | from GF Urdu transliteration to unicode+ | ``-to_utf8`` | encode to utf8 (default)+ | ``-unchars`` | unlexer that puts no spaces between tokens+ | ``-unlexcode`` | code-like unlexer+ | ``-unlexgreek`` | unlexer de-normalizing ancient Greek accentuation+ | ``-unlexmixed`` | mixture of text and code (code between $...$, \(...)\, \[...\])+ | ``-unlextext`` | text-like unlexer+ | ``-unwords`` | unlexer that puts a single space between tokens (default)+ | ``-words`` | lexer that assumes tokens separated by spaces (default)++- Flags:++ | ``-lang`` | the languages of linearization (comma-separated, no spaces)++- Examples:++ | ``l -lang=LangSwe,LangNor -chunks ? a b (? c d)`` | +++#NORMAL+++#VSPACE++====ma = morpho_analyse====+#NOINDENT+``ma`` = ``morpho_analyse``: //print the morphological analyses of all words in the string.//++#TINY++Prints all the analyses of space-separated words in the input string,+using the morphological analyser of the actual grammar (see command pg)+++- Options:++ | ``-known`` | return only the known words, in order of appearance+ | ``-missing`` | show the list of unknown words, in order of appearance++- Flags:++ | ``-lang`` | the languages of analysis (comma-separated, no spaces)+++#NORMAL+++#VSPACE++====mq = morpho_quiz====+#NOINDENT+``mq`` = ``morpho_quiz``: //start a morphology quiz.//++#TINY++- Syntax: ``mq (-cat=CAT)? (-probs=FILE)? TREE?``++- Flags:++ | ``-lang`` | language of the quiz+ | ``-cat`` | category of the quiz+ | ``-number`` | maximum number of questions+ | ``-probs`` | file with biased probabilities for generation+++#NORMAL+++#VSPACE++====p = parse====+#NOINDENT+``p`` = ``parse``: //parse a string to abstract syntax expression.//++#TINY++Shows all trees returned by parsing a string in the grammars in scope.+The -lang flag can be used to restrict this to fewer languages.+The default start category can be overridden by the -cat flag.+See also the ps command for lexing and character encoding.++The -openclass flag is experimental and allows some robustness in +the parser. For example if -openclass="A,N,V" is given, the parser+will accept unknown adjectives, nouns and verbs with the resource grammar.+++- Options:++ | ``-bracket`` | prints the bracketed string from the parser++- Flags:++ | ``-cat`` | target category of parsing+ | ``-lang`` | the languages of parsing (comma-separated, no spaces)+ | ``-openclass`` | list of open-class categories for robust parsing+ | ``-depth`` | maximal depth for proof search if the abstract syntax tree has meta variables+++#NORMAL+++#VSPACE++====pg = print_grammar====+#NOINDENT+``pg`` = ``print_grammar``: //print the actual grammar with the given printer.//++#TINY++Prints the actual grammar, with all involved languages.+In some printers, this can be restricted to a subset of languages+with the -lang=X,Y flag (comma-separated, no spaces).+The -printer=P flag sets the format in which the grammar is printed.+N.B.1 Since grammars are compiled when imported, this command+generally shows a grammar that looks rather different from the source.+N.B.2 Another way to produce different formats is to use 'gf -make',+the batch compiler. The following values are available both for+the batch compiler (flag -output-format) and the print_grammar+command (flag -printer):++ bnf BNF (context-free grammar)+ ebnf Extended BNF+ fa finite automaton in graphviz format+ gsl Nuance speech recognition format+ haskell Haskell (abstract syntax)+ java Java (abstract syntax)+ js JavaScript (whole grammar)+ jsgf JSGF speech recognition format+ pgf_pretty human-readable pgf+ prolog Prolog (whole grammar)+ python Python (whole grammar)+ regexp regular expression+ slf SLF speech recognition format+ srgs_abnf SRGS speech recognition format in ABNF+ srgs_abnf_nonrec SRGS ABNF, recursion eliminated+ srgs_xml SRGS speech recognition format in XML+ srgs_xml_nonrec SRGS XML, recursion eliminated+ vxml Voice XML based on abstract syntax+++- Options:++ | ``-cats`` | show just the names of abstract syntax categories+ | ``-fullform`` | print the fullform lexicon+ | ``-funs`` | show just the names and types of abstract syntax functions+ | ``-langs`` | show just the names of top concrete syntax modules+ | ``-lexc`` | print the lexicon in Xerox LEXC format+ | ``-missing`` | show just the names of functions that have no linearization+ | ``-opt`` | optimize the generated pgf+ | ``-pgf`` | write current pgf image in file+ | ``-words`` | print the list of words++- Flags:++ | ``-file`` | set the file name when printing with -pgf option+ | ``-lang`` | select languages for the some options (default all languages)+ | ``-printer`` | select the printing format (see flag values above)++- Examples:++ | ``pg -funs | ? grep " S ;"`` | show functions with value cat S+++#NORMAL+++#VSPACE++====ph = print_history====+#NOINDENT+``ph`` = ``print_history``: //print command history.//++#TINY++Prints the commands issued during the GF session.+The result is readable by the eh command.+The result can be used as a script when starting GF.+++- Examples:++ | ``ph | wf -file=foo.gfs`` | save the history into a file+++#NORMAL+++#VSPACE++====ps = put_string====+#NOINDENT+``ps`` = ``put_string``: //return a string, possibly processed with a function.//++#TINY++Returns a string obtained from its argument string by applying+string processing functions in the order given in the command line+option list. Thus 'ps -f -g s' returns g (f s). Typical string processors+are lexers and unlexers, but also character encoding conversions are possible.+The unlexers preserve the division of their input to lines.+To see transliteration tables, use command ut.++- Syntax: ``ps OPT? STRING``+- Options:++ | ``-lines`` | apply the operation separately to each input line, returning a list of lines+ | ``-bind`` | bind tokens separated by Prelude.BIND, i.e. &++ | ``-chars`` | lexer that makes every non-space character a token+ | ``-from_amharic`` | from unicode to GF Amharic transliteration+ | ``-from_ancientgreek`` | from unicode to GF ancient Greek transliteration+ | ``-from_arabic`` | from unicode to GF Arabic transliteration+ | ``-from_arabic_unvocalized`` | from unicode to GF unvocalized Arabic transliteration+ | ``-from_cp1251`` | decode from cp1251 (Cyrillic used in Bulgarian resource)+ | ``-from_devanagari`` | from unicode to GF Devanagari transliteration+ | ``-from_greek`` | from unicode to GF modern Greek transliteration+ | ``-from_hebrew`` | from unicode to GF unvocalized Hebrew transliteration+ | ``-from_nepali`` | from unicode to GF Nepali transliteration+ | ``-from_persian`` | from unicode to GF Persian/Farsi transliteration+ | ``-from_sanskrit`` | from unicode to GF Sanskrit transliteration+ | ``-from_sindhi`` | from unicode to GF Sindhi transliteration+ | ``-from_telugu`` | from unicode to GF Telugu transliteration+ | ``-from_thai`` | from unicode to GF Thai transliteration+ | ``-from_urdu`` | from unicode to GF Urdu transliteration+ | ``-from_utf8`` | decode from utf8 (default)+ | ``-lexcode`` | code-like lexer+ | ``-lexgreek`` | lexer normalizing ancient Greek accentuation+ | ``-lexgreek2`` | lexer normalizing ancient Greek accentuation for text with vowel length annotations+ | ``-lexmixed`` | mixture of text and code, as in LaTeX (code between $...$, \(...)\, \[...\])+ | ``-lextext`` | text-like lexer+ | ``-to_amharic`` | from GF Amharic transliteration to unicode+ | ``-to_ancientgreek`` | from GF ancient Greek transliteration to unicode+ | ``-to_arabic`` | from GF Arabic transliteration to unicode+ | ``-to_arabic_unvocalized`` | from GF unvocalized Arabic transliteration to unicode+ | ``-to_cp1251`` | encode to cp1251 (Cyrillic used in Bulgarian resource)+ | ``-to_devanagari`` | from GF Devanagari transliteration to unicode+ | ``-to_greek`` | from GF modern Greek transliteration to unicode+ | ``-to_hebrew`` | from GF unvocalized Hebrew transliteration to unicode+ | ``-to_html`` | wrap in a html file with linebreaks+ | ``-to_nepali`` | from GF Nepali transliteration to unicode+ | ``-to_persian`` | from GF Persian/Farsi transliteration to unicode+ | ``-to_sanskrit`` | from GF Sanskrit transliteration to unicode+ | ``-to_sindhi`` | from GF Sindhi transliteration to unicode+ | ``-to_telugu`` | from GF Telugu transliteration to unicode+ | ``-to_thai`` | from GF Thai transliteration to unicode+ | ``-to_urdu`` | from GF Urdu transliteration to unicode+ | ``-to_utf8`` | encode to utf8 (default)+ | ``-unchars`` | unlexer that puts no spaces between tokens+ | ``-unlexcode`` | code-like unlexer+ | ``-unlexgreek`` | unlexer de-normalizing ancient Greek accentuation+ | ``-unlexmixed`` | mixture of text and code (code between $...$, \(...)\, \[...\])+ | ``-unlextext`` | text-like unlexer+ | ``-unwords`` | unlexer that puts a single space between tokens (default)+ | ``-words`` | lexer that assumes tokens separated by spaces (default)++- Flags:++ | ``-env`` | apply in this environment only+ | ``-from`` | backward-apply transliteration defined in this file (format 'unicode translit' per line)+ | ``-to`` | forward-apply transliteration defined in this file++- Examples:++ | ``l (EAdd 3 4) | ps -unlexcode`` | linearize code-like output+ | ``ps -lexcode | p -cat=Exp`` | parse code-like input+ | ``gr -cat=QCl | l | ps -bind`` | linearization output from LangFin+ | ``ps -to_devanagari "A-p"`` | show Devanagari in UTF8 terminal+ | ``rf -file=Hin.gf | ps -env=quotes -to_devanagari`` | convert translit to UTF8+ | ``rf -file=Ara.gf | ps -from_utf8 -env=quotes -from_arabic`` | convert UTF8 to transliteration+ | ``ps -to=chinese.trans "abc"`` | apply transliteration defined in file chinese.trans+ | ``ps -lexgreek "a)gavoi` a)'nvrwpoi' tines*"`` | normalize ancient greek accentuation+++#NORMAL+++#VSPACE++====pt = put_tree====+#NOINDENT+``pt`` = ``put_tree``: //return a tree, possibly processed with a function.//++#TINY++Returns a tree obtained from its argument tree by applying+tree processing functions in the order given in the command line+option list. Thus 'pt -f -g s' returns g (f s). Typical tree processors+are type checking and semantic computation.++- Syntax: ``pt OPT? TREE``+- Options:++ | ``-compute`` | compute by using semantic definitions (def)+ | ``-largest`` | sort trees from largest to smallest, in number of nodes+ | ``-nub`` | remove duplicate trees+ | ``-smallest`` | sort trees from smallest to largest, in number of nodes+ | ``-subtrees`` | return all fully applied subtrees (stopping at abstractions), by default sorted from the largest+ | ``-funs`` | return all fun functions appearing in the tree, with duplications++- Flags:++ | ``-number`` | take at most this many trees++- Examples:++ | ``pt -compute (plus one two)`` | compute value+++#NORMAL+++#VSPACE++====q = quit====+#NOINDENT+``q`` = ``quit``: //exit GF interpreter.//++#TINY++#NORMAL+++#VSPACE++====r = reload====+#NOINDENT+``r`` = ``reload``: //repeat the latest import command.//++#TINY++#NORMAL+++#VSPACE++====rf = read_file====+#NOINDENT+``rf`` = ``read_file``: //read string or tree input from a file.//++#TINY++Reads input from file. The filename must be in double quotes.+The input is interpreted as a string by default, and can hence be+piped e.g. to the parse command. The option -tree interprets the+input as a tree, which can be given e.g. to the linearize command.+The option -lines will result in a list of strings or trees, one by line.+++- Options:++ | ``-lines`` | return the list of lines, instead of the singleton of all contents+ | ``-tree`` | convert strings into trees++- Flags:++ | ``-file`` | the input file name+++#NORMAL+++#VSPACE++====rt = rank_trees====+#NOINDENT+``rt`` = ``rank_trees``: //show trees in an order of decreasing probability.//++#TINY++Order trees from the most to the least probable, using either+even distribution in each category (default) or biased as specified+by the file given by flag -probs=FILE, where each line has the form+'function probability', e.g. 'youPol_Pron 0.01'.+++- Options:++ | ``-v`` | show all trees with their probability scores++- Flags:++ | ``-probs`` | probabilities from this file (format 'f 0.6' per line)++- Examples:++ | ``p "you are here" | rt -probs=probs | pt -number=1`` | most probable result+++#NORMAL+++#VSPACE++====sd = show_dependencies====+#NOINDENT+``sd`` = ``show_dependencies``: //show all constants that the given constants depend on.//++#TINY++Show recursively all qualified constant names, by tracing back the types and definitions+of each constant encountered, but just listing every name once.+This command requires a source grammar to be in scope, imported with 'import -retain'.+Notice that the accuracy is better if the modules are compiled with the flag -optimize=noexpand.+This command must be a line of its own, and thus cannot be a part of a pipe.++- Syntax: ``sd QUALIFIED_CONSTANT+``+- Options:++ | ``-size`` | show the size of the source code for each constants (number of constructors)+++- Examples:++ | ``sd ParadigmsEng.mkV ParadigmsEng.mkN`` | show all constants on which mkV and mkN depend+ | ``sd -size ParadigmsEng.mkV`` | show all constants on which mkV depends, together with size+++#NORMAL+++#VSPACE++====se = set_encoding====+#NOINDENT+``se`` = ``set_encoding``: //set the encoding used in current terminal.//++#TINY++- Syntax: ``se ID``++- Examples:++ | ``se cp1251`` | set encoding to cp1521+ | ``se utf8`` | set encoding to utf8 (default)+++#NORMAL+++#VSPACE++====so = show_operations====+#NOINDENT+``so`` = ``show_operations``: //show all operations in scope, possibly restricted to a value type.//++#TINY++Show the names and type signatures of all operations available in the current resource.+This command requires a source grammar to be in scope, imported with 'import -retain'.+The operations include the parameter constructors that are in scope.+The optional TYPE filters according to the value type.+The grep STRINGs filter according to other substrings of the type signatures.++- Syntax: ``so (-grep=STRING)* TYPE?``+- Options:++ | ``-raw`` | show the types in computed forms (instead of category names)++- Flags:++ | ``-grep`` | substring used for filtering (the command can have many of these)++- Examples:++ | ``so Det`` | show all opers that create a Det+ | ``so -grep=Prep`` | find opers relating to Prep+ | ``so | wf -file=/tmp/opers`` | write the list of opers to a file+++#NORMAL+++#VSPACE++====sp = system_pipe====+#NOINDENT+``sp`` = ``system_pipe``: //send argument to a system command.//++#TINY++- Syntax: ``sp -command="SYSTEMCOMMAND", alt. ? SYSTEMCOMMAND``++- Flags:++ | ``-command`` | the system command applied to the argument++- Examples:++ | ``gt | l | ? wc`` | generate trees, linearize, and count words+++#NORMAL+++#VSPACE++====ss = show_source====+#NOINDENT+``ss`` = ``show_source``: //show the source code of modules in scope, possibly just headers.//++#TINY++Show compiled source code, i.e. as it is included in GF object files.+This command requires a source grammar to be in scope, imported with 'import -retain'.+The optional MODULE arguments cause just these modules to be shown.+The -size and -detailedsize options show code size as the number of constructor nodes.+This command must be a line of its own, and thus cannot be a part of a pipe.++- Syntax: ``ss (-strip)? (-save)? MODULE*``+- Options:++ | ``-detailedsize`` | instead of code, show the sizes of all judgements and modules+ | ``-save`` | save each MODULE in file MODULE.gfh instead of printing it on terminal+ | ``-size`` | instead of code, show the sizes of all modules+ | ``-strip`` | show only type signatures of oper's and lin's, not their definitions+++- Examples:++ | ``ss`` | print complete current source grammar on terminal+ | ``ss -strip -save MorphoFin`` | print the headers in file MorphoFin.gfh+++#NORMAL+++#VSPACE++====tq = translation_quiz====+#NOINDENT+``tq`` = ``translation_quiz``: //start a translation quiz.//++#TINY++- Syntax: ``tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?``++- Flags:++ | ``-from`` | translate from this language+ | ``-to`` | translate to this language+ | ``-cat`` | translate in this category+ | ``-number`` | the maximum number of questions+ | ``-probs`` | file with biased probabilities for generation++- Examples:++ | ``tq -from=Eng -to=Swe`` | any trees in startcat+ | ``tq -from=Eng -to=Swe (AdjCN (PositA ?2) (UseN ?))`` | only trees of this form+++#NORMAL+++#VSPACE++====tt = to_trie====+#NOINDENT+``tt`` = ``to_trie``: //combine a list of trees into a trie.//++#TINY++- Syntax: ``to_trie``++#NORMAL+++#VSPACE++====ut = unicode_table====+#NOINDENT+``ut`` = ``unicode_table``: //show a transliteration table for a unicode character set.//++#TINY++- Options:++ | ``-amharic`` | Amharic+ | ``-ancientgreek`` | ancient Greek+ | ``-arabic`` | Arabic+ | ``-arabic_unvocalized`` | unvocalized Arabic+ | ``-devanagari`` | Devanagari+ | ``-greek`` | modern Greek+ | ``-hebrew`` | unvocalized Hebrew+ | ``-nepali`` | Nepali+ | ``-persian`` | Persian/Farsi+ | ``-sanskrit`` | Sanskrit+ | ``-sindhi`` | Sindhi+ | ``-telugu`` | Telugu+ | ``-thai`` | Thai+ | ``-urdu`` | Urdu+++#NORMAL+++#VSPACE++====vd = visualize_dependency====+#NOINDENT+``vd`` = ``visualize_dependency``: //show word dependency tree graphically.//++#TINY++Prints a dependency tree in the .dot format (the graphviz format, default)+or LaTeX (flag -output=latex)+or the CoNLL/MaltParser format (flag -output=conll for training, malt_input+for unanalysed input).+By default, the last argument is the head of every abstract syntax+function; moreover, the head depends on the head of the function above.+The graph can be saved in a file by the wf command as usual.+If the -view flag is defined, the graph is saved in a temporary file+which is processed by dot (graphviz) and displayed by the program indicated+by the view flag. The target format is png, unless overridden by the+flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).+See also 'vp -showdep' for another visualization of dependencies.+++- Options:++ | ``-v`` | show extra information+ | ``-conll2latex`` | convert conll to latex++- Flags:++ | ``-abslabels`` | abstract configuration file for labels, format per line 'fun label*'+ | ``-cnclabels`` | concrete configuration file for labels, format per line 'fun {words|*} pos label head'+ | ``-file`` | same as abslabels (abstract configuration file)+ | ``-format`` | format of the visualization file using dot (default "png")+ | ``-output`` | output format of graph source (latex, conll, dot (default but deprecated))+ | ``-view`` | program to open the resulting graph file (default "open")+ | ``-lang`` | the language of analysis++- Examples:++ | ``gr | vd`` | generate a tree and show dependency tree in .dot+ | ``gr | vd -view=open`` | generate a tree and display dependency tree on with Mac's 'open'+ | ``gr | vd -view=open -output=latex`` | generate a tree and display latex dependency tree with Mac's 'open'+ | ``gr -number=1000 | vd -abslabels=Lang.labels -cnclabels=LangSwe.labels -output=conll`` | generate a random treebank+ | ``rf -file=ex.conll | vd -conll2latex | wf -file=ex.tex`` | convert conll file to latex+++#NORMAL+++#VSPACE++====vp = visualize_parse====+#NOINDENT+``vp`` = ``visualize_parse``: //show parse tree graphically.//++#TINY++Prints a parse tree in the .dot format (the graphviz format).+The graph can be saved in a file by the wf command as usual.+If the -view flag is defined, the graph is saved in a temporary file+which is processed by dot (graphviz) and displayed by the program indicated+by the view flag. The target format is png, unless overridden by the+flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).+++- Options:++ | ``-showcat`` | show categories in the tree nodes (default)+ | ``-nocat`` | don't show categories+ | ``-showdep`` | show dependency labels+ | ``-showfun`` | show function names in the tree nodes+ | ``-nofun`` | don't show function names (default)+ | ``-showleaves`` | show the leaves of the tree (default)+ | ``-noleaves`` | don't show the leaves of the tree (i.e., only the abstract tree)++- Flags:++ | ``-lang`` | the language to visualize+ | ``-file`` | configuration file for dependency labels with -deps, format per line 'fun label*'+ | ``-format`` | format of the visualization file (default "png")+ | ``-view`` | program to open the resulting file (default "open")+ | ``-nodefont`` | font for tree nodes (default: Times -- graphviz standard font)+ | ``-leaffont`` | font for tree leaves (default: nodefont)+ | ``-nodecolor`` | color for tree nodes (default: black -- graphviz standard color)+ | ``-leafcolor`` | color for tree leaves (default: nodecolor)+ | ``-nodeedgestyle`` | edge style between tree nodes (solid/dashed/dotted/bold, default: solid)+ | ``-leafedgestyle`` | edge style for links to leaves (solid/dashed/dotted/bold, default: dashed)++- Examples:++ | ``p "John walks" | vp`` | generate a tree and show parse tree as .dot script+ | ``gr | vp -view=open`` | generate a tree and display parse tree on a Mac+ | ``p "she loves us" | vp -view=open -showdep -file=uddeps.labels -nocat`` | show a visual variant of a dependency tree+++#NORMAL+++#VSPACE++====vt = visualize_tree====+#NOINDENT+``vt`` = ``visualize_tree``: //show a set of trees graphically.//++#TINY++Prints a set of trees in the .dot format (the graphviz format).+The graph can be saved in a file by the wf command as usual.+If the -view flag is defined, the graph is saved in a temporary file+which is processed by dot (graphviz) and displayed by the command indicated+by the view flag. The target format is postscript, unless overridden by the+flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).+With option -mk, use for showing library style function names of form 'mkC'.+++- Options:++ | ``-api`` | show the tree with function names converted to 'mkC' with value cats C+ | ``-mk`` | similar to -api, deprecated+ | ``-nofun`` | don't show functions but only categories+ | ``-nocat`` | don't show categories but only functions++- Flags:++ | ``-format`` | format of the visualization file (default "png")+ | ``-view`` | program to open the resulting file (default "open")++- Examples:++ | ``p "hello" | vt`` | parse a string and show trees as graph script+ | ``p "hello" | vt -view="open"`` | parse a string and display trees on a Mac+++#NORMAL+++#VSPACE++====wf = write_file====+#NOINDENT+``wf`` = ``write_file``: //send string or tree to a file.//++#TINY++- Options:++ | ``-append`` | append to file, instead of overwriting it++- Flags:++ | ``-file`` | the output filename+++#NORMAL+++
@@ -0,0 +1,63 @@+---+title: "Grammatical Framework: Authors and Acknowledgements"+---++## Current maintainers++The current maintainers of GF are++[Krasimir Angelov](http://www.chalmers.se/cse/EN/organization/divisions/computing-science/people/angelov-krasimir),+[Thomas Hallgren](http://www.cse.chalmers.se/~hallgren/),+[Aarne Ranta](http://www.cse.chalmers.se/~aarne/),+[John J. Camilleri](http://johnjcamilleri.com), and+[Inari Listenmaa](https://inariksit.github.io/).++This page is otherwise not up to date.+For detailed data about contributors to the code repositories since 2007, see+[here (gf-core)](https://github.com/GrammaticalFramework/gf-core/graphs/contributors)+and+[here (gf-rgl)](https://github.com/GrammaticalFramework/gf-rgl/graphs/contributors).++## Previous contributors++The following people have contributed code to some of the versions:++- Grégoire Détrez (University of Gothenburg)+- Ramona Enache (University of Gothenburg)+- [Björn Bringert](http://www.cse.chalmers.se/alumni/bringert) (University of Gothenburg)+- Håkan Burden (University of Gothenburg)+- Hans-Joachim Daniels (Karlsruhe)+- [Markus Forsberg](http://www.cs.chalmers.se/~markus) (Chalmers)+- [Kristofer Johannisson](http://www.cs.chalmers.se/~krijo) (University of Gothenburg)+- [Janna Khegai](http://www.cs.chalmers.se/~janna) (Chalmers)+- [Peter Ljunglöf](http://www.cse.chalmers.se/~peb) (University of Gothenburg)+- Petri Mäenpää (Nokia)++At least the following colleagues are thanked for suggestions, bug+reports, and other indirect contributions to the code.++- [Stefano Berardi](http://www.di.unito.it/~stefano/) (Torino)+- Pascal Boldini (Paris)+- [Paul Callaghan](http://www.dur.ac.uk/~dcs0pcc/) (Durham)+- Lauri Carlson (Helsinki)+- [Koen Claessen](http://www.cse.chalmers.se/~koen) (Chalmers)+- [Robin Cooper](http://www.cling.gu.se/~cooper) (Gothenburg)+- [Thierry Coquand](http://www.cse.chalmers.se/~coquand) (Chalmers)+- [Marc Dymetman](http://www.xrce.xerox.com/people/dymetman/dymetman.html) (XRCE)+- Bertrand Grégoire (Tudor Institute, Luxembourg)+- [Reiner Hähnle](http://www.cse.chalmers.se/~reiner) (Chalmers)+- [Gérard Huet](http://pauillac.inria.fr/~huet/) (INRIA)+- [Patrik Jansson](http://www.cse.chalmers.se/~patrikj) (Chalmers)+- Bernard Jaulin (Paris)+- [Lauri Karttunen](http://www.xrce.xerox.com/people/karttunen/karttunen.html) (PARC)+- Matti Kinnunen (Nokia)+- [Veronika Lux](http://www.xrce.xerox.com/people/lux/) (XRCE)+- Per Martin-Löf (Stockholm)+- [Bengt Nordström](http://www.cse.chalmers.se/~bengt) (Chalmers)+- [Martin Okrslar](http://www.cis.uni-muenchen.de/studenten/stud_homepages/okrslar/reklame.html) (CIS)+- Jianmin Pang (Durham)+- [Sylvain Pogodalla](http://www.xrce.xerox.com/people/pogodalla/index.fr.html) (XRCE)+- [Loïc Pottier](http://www.inria.fr/Loic.Pottier) (INRIA)+- [Annie Zaenen](http://www2.parc.com/istl/members/zaenen/) (PARC)++The GF logo was designed by Uula Ranta.
@@ -0,0 +1,4622 @@+<!DOCTYPE html>+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">+<HEAD>+ <TITLE>GF Language Reference Manual</TITLE>+ <meta charset="utf-8" />+ <meta name="viewport" content="width=device-width, initial-scale=1.0" />+ <link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">+ <style>+ code {+ color: inherit;+ }+ center {+ margin-bottom: 1rem;+ }+ </style>+</HEAD>+<BODY>+<div class="container-fluid my-5" style="max-width:1200px">++<P ALIGN="center">+ <CENTER>+ <a href="..">+ <img src="Logos/gf1.svg" height="200px" class="mb-3" alt="GF Logo">+ </a>+ <H1>GF Language Reference Manual</H1>+<FONT SIZE="4">+<I>Aarne Ranta</I>, <I>Krasimir Angelov</I><BR>June 2014, GF 3.6+</FONT></CENTER>++<P></P>+ <UL>+ <LI><A HREF="#toc1">Overview of GF</A>+ <LI><A HREF="#toc2">The module system</A>+ <UL>+ <LI><A HREF="#toc3">Top-level and supplementary module structure</A>+ <LI><A HREF="#toc4">Compilation units</A>+ <LI><A HREF="#toc5">Names</A>+ <LI><A HREF="#toc6">The structure of a module</A>+ <LI><A HREF="#toc7">Module types, headers, and bodies</A>+ <LI><A HREF="#toc8">Digression: the logic of module types</A>+ <LI><A HREF="#toc9">Inheritance</A>+ <LI><A HREF="#toc10">Opening</A>+ <LI><A HREF="#toc11">Name resolution</A>+ <LI><A HREF="#toc12">Functor instantiations</A>+ <LI><A HREF="#toc13">Completeness</A>+ </UL>+ <LI><A HREF="#toc14">Judgements</A>+ <UL>+ <LI><A HREF="#toc15">Overview of the forms of judgement</A>+ <LI><A HREF="#toc16">Category declarations, cat</A>+ <LI><A HREF="#toc17">Hypotheses and contexts</A>+ <LI><A HREF="#toc18">Function declarations, fun</A>+ <LI><A HREF="#toc19">Function definitions, def</A>+ <LI><A HREF="#toc20">Data constructor definitions, data</A>+ <LI><A HREF="#toc21">The semantic status of an abstract syntax function</A>+ <LI><A HREF="#toc22">Linearization type definitions, lincat</A>+ <LI><A HREF="#toc23">Linearization definitions, lin</A>+ <LI><A HREF="#toc24">Linearization default definitions, lindef</A>+ <LI><A HREF="#toc24_r">Linearization reference definitions, linref</A>+ <LI><A HREF="#toc25">Printname definitions, printname cat and printname fun</A>+ <LI><A HREF="#toc26">Parameter type definitions, param</A>+ <LI><A HREF="#toc27">Parameter values</A>+ <LI><A HREF="#toc28">Operation definitions, oper</A>+ <LI><A HREF="#toc29">Operation overloading</A>+ <LI><A HREF="#toc30">Flag definitions, flags</A>+ </UL>+ <LI><A HREF="#toc31">Types and expressions</A>+ <UL>+ <LI><A HREF="#toc32">Overview of expression forms</A>+ <LI><A HREF="#toc33">The functional fragment: expressions in abstract syntax</A>+ <LI><A HREF="#toc34">Conversions</A>+ <LI><A HREF="#toc35">Syntax trees</A>+ <LI><A HREF="#toc36">Predefined types in abstract syntax</A>+ <LI><A HREF="#toc37">Overview of expressions in concrete syntax</A>+ <LI><A HREF="#toc38">Values, canonical forms, and run-time variables</A>+ <LI><A HREF="#toc39">Token lists, tokens, and strings</A>+ <LI><A HREF="#toc40">Records and record types</A>+ <LI><A HREF="#toc41">Subtyping</A>+ <LI><A HREF="#toc42">Tables and table types</A>+ <LI><A HREF="#toc43">Pattern matching</A>+ <LI><A HREF="#toc44">Free variation</A>+ <LI><A HREF="#toc45">Local definitions</A>+ <LI><A HREF="#toc46">Function applications in concrete syntax</A>+ <LI><A HREF="#toc47">Reusing top-level grammars as resources</A>+ <LI><A HREF="#toc48">Predefined concrete syntax types</A>+ <LI><A HREF="#toc49">Predefined concrete syntax operations</A>+ </UL>+ <LI><A HREF="#toc50">Flags and pragmas</A>+ <UL>+ <LI><A HREF="#toc51">Some flags and their values</A>+ <LI><A HREF="#toc52">Compiler pragmas</A>+ </UL>+ <LI><A HREF="#toc53">Alternative grammar input formats</A>+ <UL>+ <LI><A HREF="#toc54">Old GF without modules</A>+ <LI><A HREF="#toc55">Context-free grammars</A>+ <LI><A HREF="#toc56">Extended BNF grammars</A>+ <LI><A HREF="#toc57">Example-based grammars</A>+ </UL>+ <LI><A HREF="#toc58">The grammar of GF</A>+ <LI><A HREF="#toc59">The lexical structure of GF</A>+ <UL>+ <LI><A HREF="#toc60">Identifiers</A>+ <LI><A HREF="#toc61">Literals</A>+ <LI><A HREF="#toc62">Reserved words and symbols</A>+ <LI><A HREF="#toc63">Comments</A>+ </UL>+ <LI><A HREF="#toc64">The syntactic structure of GF</A>+ </UL>++<P></P>+<HR>+<P></P>+<P>++</P>+<P>+This document is a reference manual to the GF programming language.+GF, Grammatical Framework, is a special-purpose programming language,+designed to support definitions of grammars.+</P>+<P>+This document is not an introduction to GF; such introduction can be+found in the GF tutorial available on line on the GF web page,+</P>+<P>+<A HREF="http://grammaticalframework.org"><CODE>grammaticalframework.org</CODE></A>+</P>+<P>+This manual covers only the language, not the GF compiler or+interactive system. We will however make some references to different+compiler versions, if they involve changes of behaviour having to+do with the language specification.+</P>+<P>+This manual is meant to be fully compatible with GF version 3.0.+Main discrepancies with version 2.8 are indicated,+as well as with the reference article on GF,+</P>+<P>+A. Ranta, "Grammatical Framework. A Type Theoretical Grammar Formalism",+<I>The Journal of Functional Programming</I> 14(2), 2004, pp. 145-189.+</P>+<P>+This article will referred to as "the JFP article".+</P>+<P>+As metalinguistic notation, we will use the symbols+</P>+<UL>+<LI><I>a</I> === <I>b</I> to say that <I>a</I> is syntactic sugar for <I>b</I>+<LI><I>a</I> ==> <I>b</I> to say that <I>a</I> is computed (or compiled) to <I>b</I>+</UL>++<A NAME="toc1"></A>+<H2>Overview of GF</H2>+<P>+GF is a typed functional language,+borrowing many of its constructs from ML and Haskell: algebraic datatypes,+higher-order functions, pattern matching. The module system bears resemblance+to ML (functors) but also to object-oriented languages (inheritance).+The type theory used in the abstract syntax part of GF is inherited from+logical frameworks, in particular ALF ("Another Logical Framework"; in a+sense, GF is Yet Another ALF). From ALF comes also the use of dependent+types, including the use of explicit type variables instead of+Hindley-Milner polymorphism.+</P>+<P>+The look and feel of GF is close to Java and+C, due to the use of curly brackets and semicolons in structuring the code;+the expression syntax, however, follows Haskell in using juxtaposition for+function application and parentheses only for grouping.+</P>+<P>+To understand the constructs of GF, and especially their limitations in comparison+to general-purpose programming languages, it is essential to keep in mind that+GF is a special-purpose and non-turing-complete language. Every GF program is+ultimately compiled to a <B>multilingual grammar</B>, which consists of an+<B>abstract syntax</B> and a set of <B>concrete syntaxes</B>. The abstract syntax+defines a system of <B>syntax trees</B>, and each concrete syntax defines a+mapping from those syntax trees to <B>nested tuples</B> of strings and integers.+This mapping is <B>compositional</B>, i.e. <B>homomorphic</B>, and moreover+<B>reversible</B>: given a nested tuple, there exists an effective way of finding+the set of syntax trees that map to this tuple. The procedure of applying the+mapping to a tree to produce a tuple is called <B>linearization</B>, and the+reverse search procedure is called <B>parsing</B>. It is ultimately the requirement+of reversibility that restricts GF to be less than turing-complete. This is+reflected in restrictions to recursion in concrete syntax. Tree formation in+abstract syntax, however, is fully recursive.+</P>+<P>+Even though run-time GF grammars manipulate just nested tuples, at compile+time these are represented by by the more fine-grained labelled records+and finite functions over algebraic datatypes. This enables the programmer+to write on a higher abstraction level, and also adds type distinctions+and hence raises the level of checking of programs.+</P>+<A NAME="toc2"></A>+<H2>The module system</H2>+<A NAME="toc3"></A>+<H3>Top-level and supplementary module structure</H3>+<P>+The big picture of GF as a programming language for multilingual grammars+explains its principal module structure. Any GF grammar must have an+abstract syntax module; it can in addition have any number of concrete+syntax modules matching that abstract syntax. Before going to details,+we give a simple example: a module defining the <B>category</B> <CODE>A</CODE>+of adjectives and one adjective-forming <B>function</B>, the zero-place function+<CODE>Even</CODE>. We give the module the name <CODE>Adj</CODE>. The GF code for the+module looks as follows:+</P>+<PRE>+ abstract Adj = {+ cat A ;+ fun Even : A ;+ }+</PRE>+<P>+Here are two concrete syntax modules, one intended for mapping the trees+to English, the other to Swedish. The mappling is defined by+<CODE>lincat</CODE> definitions assigning a <B>linearization type</B> to each category,+and <CODE>lin</CODE> definitions assigning a <B>linearization</B> to each function.+</P>+<PRE>+ concrete AdjEng of Adj = {+ lincat A = {s : Str} ;+ lin Even = {s = "even"} ;+ }++ concrete AdjSwe of Adj = {+ lincat A = {s : AForm => Str} ;+ lin Even = {s = table {+ ASg Utr => "jämn" ;+ ASg Neutr => "jämnt" ;+ APl => "jämna"+ }+ } ;+ param AForm = ASg Gender | APl ;+ param Gender = Utr | Neutr ;+ }+</PRE>+<P>+These examples illustrate the main ideas of multilingual grammars:+</P>+<UL>+<LI>the concrete syntax must match the abstract syntax:+ <UL>+ <LI>every <CODE>cat</CODE> is given a <CODE>lincat</CODE>+ <LI>every <CODE>fun</CODE> is given a <CODE>lin</CODE>+ </UL>+</UL>++<UL>+<LI>the concrete syntax is internally coherent:+ <UL>+ <LI>the <CODE>lin</CODE> rules respect the types defined by <CODE>lincat</CODE> rules+ </UL>+</UL>++<UL>+<LI>concrete syntaxes are independent of each other+ <UL>+ <LI>they can use different <CODE>lincat</CODE> and <CODE>lin</CODE> definitions+ <LI>they can define their own <B>parameter types</B> (<CODE>param</CODE>)+ </UL>+</UL>++<P>+The first two ideas form the core of the <B>static checking</B> of GF+grammars, eliminating the possibility of run-time errors in+linearization and parsing. The third idea gives GF the expressive+power needed to map abstract syntax to vastly different languages.+</P>+<P>+Abstract and concrete modules are called <B>top-level grammar modules</B>,+since they are the ones that remain in grammar systems at run time.+However, in order to support <B>modular grammar engineering</B>, GF provides+much more module structure than strictly required in top-level grammars.+</P>+<P>+<B>Inheritance</B>, also known as <B>extension</B>, means that a module can inherit the+contents of one or more other modules to which new judgements are added,+e.g.+</P>+<PRE>+ abstract MoreAdj = Adj ** {+ fun Odd : A ;+ }+</PRE>+<P>+<B>Resource modules</B> define parameter types and <B>operations</B> usable+in several concrete syntaxes,+</P>+<PRE>+ resource MorphoFre = {+ param Number = Sg | Pl ;+ param Gender = Masc | Fem ;+ oper regA : Str -> {s : Gender => Number => Str} =+ \fin -> {+ s = table {+ Masc => table {Sg => fin ; Pl => fin + "s"} ;+ Fem => table {Sg => fin + "e" ; Pl => fin + "es"}+ }+ } ;+ }+</PRE>+<P>+By <B>opening</B>, a module can use the contents of a resource module+without inheriting them, e.g.+</P>+<PRE>+ concrete AdjFre of Adj = open MorphoFre in {+ lincat A = {s : Gender => Number => Str} ;+ lin Even = regA "pair" ;+ }+</PRE>+<P>+<B>Interfaces</B> and <B>instances</B> separate the contents of a resource module+to type signatures and definitions, in a way analogous to abstract vs. concrete+modules, e.g.+</P>+<PRE>+ interface Lexicon = {+ oper Adjective : Type ;+ oper even_A : Adjective ;+ }++ instance LexiconEng of Lexicon = {+ oper Adjective = {s : Str} ;+ oper even_A = {s = "even"} ;+ }+</PRE>+<P>+<B>Functors</B> i.e. <B>parametrized modules</B> i.e. <B>incomplete modules</B>, defining+a concrete syntax in terms of an interface.+</P>+<PRE>+ incomplete concrete AdjI of Adj = open Lexicon in {+ lincat A = Adjective ;+ lin Even = even_A ;+ }+</PRE>+<P>+A functor can be <B>instantiated</B> by providing instances of its open interfaces.+</P>+<PRE>+ concrete AdjEng of Adj = AdjI with (Lexicon = LexiconEng) ;+</PRE>+<P></P>+<A NAME="toc4"></A>+<H3>Compilation units</H3>+<P>+The compilation unit of GF source code is a file that contains a module.+Judgements outside modules are supported only for backward compatibility,+as explained <a href="#oldgf">here</a>.+Every source file, suffixed <CODE>.gf</CODE>, is compiled to a "GF object file",+suffixed <CODE>.gfo</CODE> (as of GF Version 3.0 and later). For runtime grammar objects+used for parsing and linearization, a set of <CODE>.gfo</CODE> files is linked to+a single file suffixed <CODE>.pgf</CODE>. While <CODE>.gf</CODE> and <CODE>.gfo</CODE> files may contain+modules of any kinds, a <CODE>.pgf</CODE> file always contains a multilingual grammar+with one abstract and a set of concrete syntaxes.+</P>+<P>+The following diagram summarizes the files involved in the compilation process.+<center>+<CODE>module1.gf module2.gf ... modulen.gf</CODE>+</P>+<P>+==>+</P>+<P>+<CODE>module1.gfo module2.gfo ... modulen.gfo</CODE>+</P>+<P>+==>+</P>+<P>+grammar.pgf+</center>+Both <CODE>.gf</CODE> and <CODE>.gfo</CODE> files are written in the GF source language;+<CODE>.pgf</CODE> files are written in a lower-level format. The process of translating+<CODE>.gf</CODE> to <CODE>.gfo</CODE> consists of <B>name resolution</B>, <B>type annotation</B>,+<B>partial evaluation</B>, and <B>optimization</B>.+There is a great advantage in the possibility to do this+separately for GF modules and saving the result in <CODE>.gfo</CODE> files. The partial+evaluation phase, in particular, is time and memory consuming, and GF libraries+are therefore distributed in <CODE>.gfo</CODE> to make their use less arduous.+</P>+<P>+<I>In GF before version 3.0, the object files are in a format called <CODE>.gfc</CODE>,</I>+<I>and the multilingual runtime grammar is in a format called <CODE>.gfcm</CODE>.</I>+</P>+<P>+The standard compiler has a built-in <B>make facility</B>, which finds out what+other modules are needed when compiling an explicitly given module.+This facility builds a dependency graph and decides which of the involved+modules need recompilation (from <CODE>.gf</CODE> to <CODE>.gfo</CODE>), and for which the+GF object can be used directly.+</P>+<A NAME="toc5"></A>+<H3>Names</H3>+<P>+Each module <I>M</I> defines a set of <B>names</B>, which are visible in <I>M</I>+itself, in all modules extending <I>M</I> (unless excluded, as explained+<a href="#restrictedinheritance">here</a>), and+all modules opening <I>M</I>. These names can stand for abstract syntax+categories and functions, parameter types and parameter constructors,+and operations. All these names live in the same <B>name space</B>, which+means that a name entering a module more than once due to inheritance or+opening can lead to a <B>conflict</B>. It is specified+<a href="#renaming">here</a> how these+conflicts are resolved.+</P>+<P>+The names of modules live in a name space separate from the other names.+Even here, all names must be distinct in a set of files compiled to a+multilingual grammar. In particular, even files residing in different directories+must have different names, since GF has no notion of hierarchic+module names.+</P>+<P>+Lexically, names belong to the class of <B>identifiers</B>. An idenfifier is+a letter followed by any number of letters, digits, undercores (<CODE>_</CODE>) and+primes (<CODE>'</CODE>). Upper- and lower-case letters are treated as distinct.+Nothing dictates the choice of upper or lower-case initials, but+the standard libraries follow conventions similar to Haskell:+</P>+<UL>+<LI>upper case is used for modules, abstract syntax categories and functions,+ parameter types and constructors, and type synonyms+<LI>lower case is used for non-type-valued operations and for variables+</UL>++<P>+<a name="identifiers"></a>+</P>+<P>+"Letters" as mentioned in the identifier syntax include all 7-bit ASCII+letters. Iso-latin-1 and Unicode letters are supported in varying degrees+by different tools and platforms, and are hence not recommended in identifiers.+</P>+<A NAME="toc6"></A>+<H3>The structure of a module</H3>+<P>+Modules of all types have the following structure:+<center>+<I>moduletype</I> <I>name</I> <CODE>=</CODE> <I>extends</I> <I>opens</I> <I>body</I>+</center>+The part of the module preceding the body is its <B>header</B>. The header+defines the type of the module and tells what other modules it inherits+and opens. The body consists of the judgements that introduce all the new+names defined by the module.+</P>+<P>+Any of the parts <I>extends</I>, <I>opens</I>, and <I>body</I> may be empty.+If they are all filled, delimiters and keywords separate the parts in the+following way:+<center>+<I>moduletype</I> <I>name</I> <CODE>=</CODE>+ <I>extends</I> <CODE>**</CODE> <CODE>open</CODE> <I>opens</I> <CODE>in</CODE> <CODE>{</CODE> <I>body</I> <CODE>}</CODE>+</center>+The part <I>moduletype</I> <I>name</I> looks slightly different if the+type is <CODE>concrete</CODE> or <CODE>instance</CODE>: the <I>name</I> intrudes between+the type keyword and the name of the module being implemented and which+really belongs to the type of the module:+<center>+ <CODE>concrete</CODE> <I>name</I> <CODE>of</CODE> <I>abstractname</I>+</center>+The only exception to the schema of functor syntax+is functor instantiations: the instantiation+list is given in a special way between <I>extends</I> and <I>opens</I>:+<center>+<CODE>incomplete concrete</CODE> <I>name</I> <CODE>of</CODE> <I>abstractname</I> <CODE>=</CODE>+ <I>extends</I> <CODE>**</CODE> <I>functorname</I> <CODE>with</CODE> <I>instantiations</I> <CODE>**</CODE>+ <CODE>open</CODE> <I>opens</I> <CODE>in</CODE> <CODE>{</CODE> <I>body</I> <CODE>}</CODE>+</center>+Logically, the part "<I>functorname</I> <CODE>with</CODE> <I>instantiations</I>" should+really be one of the <I>extends</I>. This is also shown by the fact that+it can have restricted inheritance (concept defined <a href="#restrictedinheritance">here</a>).+</P>+<A NAME="toc7"></A>+<H3>Module types, headers, and bodies</H3>+<P>+The <I>extends</I> and <I>opens</I> parts of a module header are lists of+module names (with possible qualifications, as defined below <a href="#qualifiednames">here</a>).+The first step of type checking a module consists of verifying that+these names stand for modules of approptiate module types. As a rule+of thumb,+</P>+<UL>+<LI>the <I>extends</I> of a module must have the same <I>moduletype</I>+<LI>the <I>opens</I> of a module must be of type <CODE>resource</CODE>+</UL>++<P>+However, the precise rules are a little more fine-grained, because+of the presence of interfaces and their instances, and the possibility+to reuse abstract and concrete modules as resources. The following table+gives, for all module types, the possible module types of their <I>extends</I>+and <I>opens</I>, as well as the forms of judgement legal in that module type.+</P>+<TABLE class="table">+<TR>+<TH>module type</TH>+<TH>extends</TH>+<TH>opens</TH>+<TH COLSPAN="2">body</TH>+</TR>+<TR>+<TD><CODE>abstract</CODE></TD>+<TD>abstract</TD>+<TD>-</TD>+<TD><CODE>cat, fun, def, data</CODE></TD>+</TR>+<TR>+<TD><CODE>concrete of</CODE> <I>abstract</I></TD>+<TD>concrete</TD>+<TD>resource*</TD>+<TD><CODE>lincat, cat, oper, param</CODE></TD>+</TR>+<TR>+<TD><CODE>resource</CODE></TD>+<TD>resource*</TD>+<TD>resource*</TD>+<TD><CODE>oper, param</CODE></TD>+</TR>+<TR>+<TD><CODE>interface</CODE></TD>+<TD>resource+</TD>+<TD>resource*</TD>+<TD><CODE>oper, param</CODE></TD>+</TR>+<TR>+<TD><CODE>instance of</CODE> <I>interface</I></TD>+<TD>resource*</TD>+<TD>resource*</TD>+<TD><CODE>oper, param</CODE></TD>+</TR>+<TR>+<TD><CODE>incomplete</CODE> concrete</TD>+<TD>concrete+</TD>+<TD>resource+</TD>+<TD><CODE>lincat, cat, oper, param</CODE></TD>+</TR>+</TABLE>++<P></P>+<P>+The table uses the following shorthands for lists of module types:+</P>+<UL>+<LI>resource*: resource, instance, concrete+<LI>resource+: resource*, interface, abstract+<LI>concrete+: concrete, incomplete concrete+</UL>++<P>+The legality of judgements in the body is checked before the judgements+themselves are checked.+</P>+<P>+The forms of judgement are explained <a href="#judgementforms">here</a>.+</P>+<A NAME="toc8"></A>+<H3>Digression: the logic of module types</H3>+<P>+Why are the legality conditions of opens and extends so complicated? The best way+to grasp them is probably to consider a simplified logical model of the module+system, replacing modules by types and functions. This model could actually+be developed towards treating modules in GF as first-class objects; so far,+however, this step has not been motivated by any practical needs.+</P>+<TABLE class="table">+<TR>+<TH>module</TH>+<TH COLSPAN="2">object and type</TH>+</TR>+<TR>+<TD>abstract A = B</TD>+<TD>A = B : type</TD>+</TR>+<TR>+<TD>concrete C of A = B</TD>+<TD>C = B : A -> S</TD>+</TR>+<TR>+<TD>interface I = B</TD>+<TD>I = B : type</TD>+</TR>+<TR>+<TD>instance J of I = B</TD>+<TD>J = B : I</TD>+</TR>+<TR>+<TD>incomplete concrete C of A = open I in B</TD>+<TD>C = B : I -> A -> S</TD>+</TR>+<TR>+<TD>concrete K of A = C with (I=J)</TD>+<TD>K = B(J) : A -> S</TD>+</TR>+<TR>+<TD>resource R = B</TD>+<TD>R = B : I</TD>+</TR>+<TR>+<TD>concrete C of A = open R in B</TD>+<TD>C = B(R) : A -> S</TD>+</TR>+</TABLE>++<P></P>+<P>+A further step of defining modules as first-class objects would use+GADTs and record types:+</P>+<UL>+<LI>an abstract syntax is a Generalized Algebraic Datatype (GADT)+<LI>the target type <CODE>S</CODE> of concrete syntax is the type of nested+ tuples over strings and integers+<LI>an interface is a labelled record type+<LI>an instance is a record of the type defined by the interface+<LI>a functor, with a module body opening an interface, is a function+ on its instances+<LI>the instantiation of a functor is an application of the function to+ some instance+<LI>a resource is a typed labelled record, putting together an interface and+ an instance of it+<LI>the body of a module opening a resource is as a function on the interface+ implicit in the resource; this function is immediately applied to the instance+ defined in the resource+</UL>++<P>+Slightly unexpectedly, interfaces and instances are easier to understand+in this way than resources - a resource is, indeed, more complex, since+it fuses together an interface and an instance.+</P>+<P>+<a name="openabstract"></a>+</P>+<P>+When an abstract is used as an interface and a concrete as its instance, they+are actually reinterpreted so that they match the model. Then the abstract is+no longer a GADT, but a system of <I>abstract</I> datatypes, with a record field+of type <CODE>Type</CODE> for each category, and a function among these types for each+abstract syntax function. A concrete syntax instantiates this record with+linearization types and linearizations.+</P>+<A NAME="toc9"></A>+<H3>Inheritance</H3>+<P>+After checking that the <I>extends</I> of a module are of appropriate+module types, the compiler adds the inherited judgements to the+judgements included in the body. The inherited judgements are+not copied entirely, but their names with links to the inherited module.+Conflicts may arise in this process: a name can have two definitions in the combined+pool of inherited and added judgements. Such a conflict is always an+error: GF provides no way to redefine an inherited constant.+</P>+<P>+Simple as the definition of a conflict may sound, it has to take care of the+inheritance hierarchy. A very common pattern of inheritance is the+<B>diamond</B>: inheritance from two modules which themselves inherit a common+base module. Assume that the base module defines a name <CODE>f</CODE>:+</P>+<PRE>+ N+ / \+ M1 M2+ \ /+ Base {f}+</PRE>+<P>+Now, <CODE>N</CODE> inherits <CODE>f</CODE> from both <CODE>M1</CODE> and <CODE>M2</CODE>, so is there a+conflict? The answer in GF is <I>no</I>, because the "two" <CODE>f</CODE>'s are in the+end the same: the one defined in <CODE>Base</CODE>. The situation is thus simpler+than in <B>multiple inheritance</B> in languages like C++, because definitions in+GF are <B>immutable</B>: neither <CODE>M1</CODE> nor <CODE>M2</CODE> can possibly have changed+the definition of <CODE>f</CODE> given in <CODE>Base</CODE>. In practice, the compiler manages+inheritance through hierarchy in a very simple way, by just always creating+a link not to the immediate parent, but the original ancestor; this ancestor+can be read from the link provided by the immediate parent. Here is how+links are created from source modules by the compiler:+</P>+<PRE>+ Base {f}+ M1 {m1} ===> M1 {Base.f, m1}+ M2 {m2} ===> M2 {Base.f, m2}+ N {n} ===> N {Base.f, M1.m1, M2.m2, n}+</PRE>+<P></P>+<P>+<a name="restrictedinheritance"></a>+</P>+<P>+Inheritance can be <B>restricted</B>. This means that a module can be specified+as inheriting <I>only</I> explicitly listed constants, or all constants+<I>except</I> ones explicitly listed. The syntax uses constant names in brackets,+prefixed by a minus sign in the case of an exclusion list. In the following+configuration, N inherits <CODE>a,b,c</CODE> from <CODE>M1</CODE>, and all names but <CODE>d</CODE>+from <CODE>M2</CODE>+</P>+<PRE>+ N = M1 {a,b,c}, M2-{d}+</PRE>+<P>+Restrictions are performed as a part of inheritance linking, module by module:+the link is created for a constant if and only if it is both+included in the module and compatible with the restriction. Thus,+for instance, an inadvertent usage can exclude a constant from one module+but inherit it from another one. In the following+configuration, <CODE>f</CODE> is inherited via <CODE>M1</CODE>, if <CODE>M1</CODE> inherits it.+</P>+<PRE>+ N = M1 [a,b,c], M2-[f]+</PRE>+<P>+Unintended inheritance may cause problems later in compilation, in the+judgement-level dependency analysis phase. For instance, suppose a function+<CODE>f</CODE> has category <CODE>C</CODE> as its type in <CODE>M</CODE>, and we only include <CODE>f</CODE>. The+exclusion has the effect of creating an ill-formed module:+</P>+<PRE>+ abstract M = {cat C ; fun f : C ;}+ M [f] ===> {fun f : C ;}+</PRE>+<P>+One might expect inheritance restriction to be transitive: if an included+constant <I>b</I> depends on some other constant <I>a</I>, then <I>a</I> should be+included automatically. However, this rule would leave to hard-to-detect+inheritances. And it could only be applied later in the compilation phase,+when the compiler has not only collected the names defined, but also+resolved the names used in definitions.+</P>+<P>+Yet another pitfall with restricted inheritance is that it must be stated+for each module separately. For instance, a concrete syntax of an abstract+must exclude all those names that the abstract does, and a functor instantiation+must replicate all restrictions of the functor.+</P>+<A NAME="toc10"></A>+<H3>Opening</H3>+<P>+Opening makes constants from other modules usable in judgements, without+inheriting them. This means that, unlike inheritance, opening is not+transitive.+</P>+<P>+<a name="qualifiednames"></a>+</P>+<P>+Opening cannot be restricted as inheritance can, but it can be <B>qualified</B>.+This means that the names from the opened modules cannot be used as such, but+only as prefixed by a qualifier and a dot (<CODE>.</CODE>). The qualifier can be any+identifier, including the name of the module. Here is an example of+an <I>opens</I> list:+</P>+<PRE>+ open A, (X = XSLTS), (Y = XSLTS), B+</PRE>+<P>+If <CODE>A</CODE> defines the constant <CODE>a</CODE>, it can be accessed by the names+</P>+<PRE>+ a A.a+</PRE>+<P>+If <CODE>XSLTS</CODE> defines the constant <CODE>x</CODE>, it can be accessed by the names+</P>+<PRE>+ X.x Y.x XSLTS.x+</PRE>+<P>+Thus qualification by real module name is always possible, and one and the same+module can be qualified in different ways at the same time (the latter can+be useful if you want to be able to change the implementations of some+constants to a different resource later). Since the qualification with real+module name is always possible, it is not possible to "swap" the names of+modules locally:+</P>+<PRE>+ open (A=B), (B=A) -- NOT POSSIBLE!+</PRE>+<P>+The list of qualifiers names and module names in a module header may+thus not contain any duplicates.+</P>+<A NAME="toc11"></A>+<H3>Name resolution</H3>+<P>+<a name="renaming"></a>+</P>+<P>+<B>Name resolution</B> is the compiler phase taking place after inheritance+linking. It qualifies all names occurring in the definition parts of judgements+(that is, just excluding the defined names themselves) with the names of+the modules they come from. If a name can come from different modules (that is,+not from their common ancestor), a conflict is reported; this decision is+hence not dependent on e.g. types, which are known only at a later phase.+</P>+<P>+Qualification of names is the main device for avoiding conflicts in+name resolution. No other information is used, such as priorities between+modules. However, if a name is defined in different opened modules+but never used in the module body,+a conflict does not arise: conflicts arise only+when names are used. Also in this respect, opening is thus different from+inheritance, where conflicts are checked independently of use.+</P>+<P>+As usual, inner scope has priority in name resolution. This means that+if an identifier is in scope as a bound variable, it will not be+interpreted as a constant, unless qualified by a module name+(variable bindings are explained <a href="#variablebinding">here</a>).+</P>+<A NAME="toc12"></A>+<H3>Functor instantiations</H3>+<P>+We have dealt with the principles of module headers, inheritance, and+names in a general way that applies to all module types. The exception+is functor instantiations, that have an extra part of the instantiating+equations, assigning an instance to every interface. Here is a typical+example, displaying the full generality:+</P>+<PRE>+ concrete FoodsEng of Foods = PhrasesEng **+ FoodsI-[Pizza] with+ (Syntax = SyntaxEng),+ (LexFoods = LexFoodsEng) **+ open SyntaxEng, ParadigmsEng in {+ lin Pizza = mkCN (mkA "Italian") (mkN "pie") ;+ }+</PRE>+<P>+(The example is modified from Section 5.9 in the GF Tutorial.)+</P>+<P>+The instantiation syntax is similar to qualified <I>opens</I>. The left-hand-side+names must be interfaces, the right-hand-side names their instances. (Recall+that <CODE>abstract</CODE> can be use as <CODE>interface</CODE> and <CODE>concrete</CODE> as its+<CODE>instance</CODE>.) Inheritance from the functor can be restricted, typically+in the purpose of defining some excluded functions in language-specific+ways in the module body.+</P>+<A NAME="toc13"></A>+<H3>Completeness</H3>+<P>+<a name="completeness"></a>+</P>+<P>+(This section refers to the forms of judgement introduced <a href="#judgementforms">here</a>.)+</P>+<P>+A <CODE>concrete</CODE> is complete with respect to an <CODE>abstract</CODE>, if it+contains a <CODE>lincat</CODE> definition for every <CODE>cat</CODE> declaration, and+a <CODE>lin</CODE> definition for every <CODE>fun</CODE> declaration.+</P>+<P>+The same completeness criterion applies to functor instantiations.+It is not possible to use a partial functor instantiation, leading+to another functor.+</P>+<P>+Functors do not need to be complete in the sense concrete modules need.+The missing definitions can then be provided in the body of each+functor instantiation.+</P>+<P>+A <CODE>resource</CODE> is complete, if all its <CODE>oper</CODE> and <CODE>param</CODE> judgements+have a definition part. While a <CODE>resource</CODE> must be complete, an+<CODE>interface</CODE> need not. For an <CODE>interface</CODE>, it is the definition+parts of judgements are optional.+</P>+<P>+An <CODE>instance</CODE> is complete with respect to an <CODE>interface</CODE>, if it+gives the definition parts of all <CODE>oper</CODE> and <CODE>param</CODE> judgements+that are omitted in the <CODE>interface</CODE>. Giving definitions to judgements+that have already been defined in the <CODE>interface</CODE> is illegal.+Type signatures, on the other hand, can be repeated if the same types+are used.+</P>+<P>+In addition to completing the definitions in an <CODE>interface</CODE>,+its instance may contain other judgements, but these must all+be complete with definitions.+</P>+<P>+Here is an example of an instance and its interface showing the+above variations:+</P>+<PRE>+ interface Pos = {+ param Case ; -- no definition+ param Number = Sg | Pl ; -- definition given+ oper Noun : Type = { -- relative definition given+ s : Number => Case => Str+ } ;+ oper regNoun : Str -> Noun ; -- no definition+ }++ instance PosEng of Pos = {+ param Case = Nom | Gen ; -- definition of Case+ -- Number and Noun inherited+ oper regNoun = \dog -> { -- type of regNoun inherited+ s = table { -- definition of regNoun+ Sg => table {+ Nom => dog+ -- etc+ }+ } ;+ oper house_N : Noun = -- new definition+ regNoun "house" ;+ }+</PRE>+<P></P>+<A NAME="toc14"></A>+<H2>Judgements</H2>+<A NAME="toc15"></A>+<H3>Overview of the forms of judgement</H3>+<P>+<a name="judgementforms"></a>+</P>+<P>+A module body in GF is a set of <B>judgements</B>. Judgements are+definitions or declarations, sometimes combinations of the two; the+common feature is that every judgement introduces a name, which is+available in the module and whenever the module is extended or opened.+</P>+<P>+There are several different <B>forms of judgement</B>, identified by different+<B>judgement keywords</B>. Here is a list of all these forms, together+with syntax descriptions and the types of modules in which each form can occur.+The table moreover indicates whether the judgement has a default value, and+whether it contributes to the <B>name base</B>, i.e. introduces a new+name to the scope.+</P>+<TABLE class="table">+<TR>+<TH>judgement</TH>+<TH>where</TH>+<TH>module</TH>+<TH>default</TH>+<TH COLSPAN="2">base</TH>+</TR>+<TR>+<TD><CODE>cat</CODE> C G</TD>+<TD>G context</TD>+<TD>abstract</TD>+<TD>N/A</TD>+<TD>yes</TD>+</TR>+<TR>+<TD><CODE>fun</CODE> f : A</TD>+<TD>A type</TD>+<TD>abstract</TD>+<TD>N/A</TD>+<TD>yes</TD>+</TR>+<TR>+<TD><CODE>def</CODE> f ps = t</TD>+<TD>f fun, ps patterns, t term</TD>+<TD>abstract</TD>+<TD>yes</TD>+<TD>no</TD>+</TR>+<TR>+<TD><CODE>data</CODE> C = f <CODE>|</CODE> ... <CODE>|</CODE> g</TD>+<TD>C cat, f...g fun</TD>+<TD>abstract</TD>+<TD>yes</TD>+<TD>no</TD>+</TR>+<TR>+<TD><CODE>lincat</CODE> C = T</TD>+<TD>C cat, T type</TD>+<TD>concrete*</TD>+<TD>yes</TD>+<TD>yes</TD>+</TR>+<TR>+<TD><CODE>lin</CODE> f = t</TD>+<TD>f fun, t term</TD>+<TD>concrete*</TD>+<TD>no</TD>+<TD>yes</TD>+</TR>+<TR>+<TD><CODE>lindef</CODE> C = t</TD>+<TD>C cat, t term</TD>+<TD>concrete*</TD>+<TD>yes</TD>+<TD>no</TD>+</TR>+<TR>+<TD><CODE>linref</CODE> C = t</TD>+<TD>C cat, t term</TD>+<TD>concrete*</TD>+<TD>yes</TD>+<TD>no</TD>+</TR>+<TR>+<TD><CODE>printname cat</CODE> C = t</TD>+<TD>C cat, t term</TD>+<TD>concrete*</TD>+<TD>yes</TD>+<TD>no</TD>+</TR>+<TR>+<TD><CODE>printname fun</CODE> f = t</TD>+<TD>f fun, t term</TD>+<TD>concrete*</TD>+<TD>yes</TD>+<TD>no</TD>+</TR>+<TR>+<TD><CODE>param</CODE> P = C<CODE>|</CODE> ... <CODE>|</CODE> D</TD>+<TD>C...D constructors</TD>+<TD>resource*</TD>+<TD>N/A</TD>+<TD>yes</TD>+</TR>+<TR>+<TD><CODE>oper</CODE> f : T = t</TD>+<TD>T type, t term</TD>+<TD>resource*</TD>+<TD>N/A</TD>+<TD>yes</TD>+</TR>+<TR>+<TD><CODE>flags</CODE> o = v</TD>+<TD>o flag, v value</TD>+<TD>all</TD>+<TD>yes</TD>+<TD>N/A</TD>+</TR>+</TABLE>++<P></P>+<P>+Judgements that have default values are rarely used, except <CODE>lincat</CODE> and+<CODE>flags</CODE>, which often need values different from the defaults.+</P>+<P>+Introducing a name twice in the same module is an error. In other words,+all judgements that have a "yes" in the name base column, must+have distinct identifiers on their left-hand sides.+</P>+<P>+All judgement end with semicolons (<CODE>;</CODE>).+</P>+<P>+In addition to the syntax given in the table, many of the forms have+syntactic sugar. This sugar will be explained below in connection to+each form. There are moreover two kinds of syntactic sugar common to all forms:+</P>+<UL>+<LI>the judgement keyword is shared between consecutive judgements+ until a new keyword appears:+<center>+<CODE>keyw J ; K ;</CODE> === <CODE>keyw J ; keyw K ;</CODE>+</center>+<LI>the right-hand sides of colon (<CODE>:</CODE>) and equality (<CODE>=</CODE>)+ can be shared, by using comma (<CODE>,</CODE>) as separator of left-hand sides, which+ must consist of identifiers+<center>+<CODE>c,d : T</CODE> === <CODE>c : T ; d : T ;</CODE>+<P></P>+<CODE>c,d = t</CODE> === <CODE>c = t ; d = t ;</CODE>+</center>+</UL>++<P>+These conventions, like all syntactic sugar, are performed at an+early compilation phase, directly after parsing. This means that e.g.+</P>+<PRE>+ lin f,g = \x -> x ;+</PRE>+<P>+can be correct even though <CODE>f</CODE> and <CODE>g</CODE> required different+function types.+</P>+<P>+Within a module, judgements can occur in any order. In particular,+a name can be used before it is introduced.+</P>+<P>+The explanations of judgement forms refer to the notions+of <B>type</B> and <B>term</B> (the latter also called <B>expression</B>).+These notions will be explained in detail <a href="#expressions">here</a>.+</P>+<A NAME="toc16"></A>+<H3>Category declarations, cat</H3>+<P>+<a name="catjudgements"></a>+</P>+<P>+Category declarations+<center>+<CODE>cat</CODE> <I>C</I> <I>G</I>+</center>+define the <B>basic types</B> of abstract syntax.+A basic type is formed from a category by giving values to all variables+in the <B>context</B> <I>G</I>. If the context is empty, the+basic type looks the same as the category itself. Otherwise, application+syntax is used:+<center>+<I>C</I> <i>a</i><sub>1</sub>...<i>a</i><sub>n</sub>+</center>+</P>+<A NAME="toc17"></A>+<H3>Hypotheses and contexts</H3>+<P>+<a name="contexts"></a>+</P>+<P>+A context is a sequence of <B>hypotheses</B>, i.e. variable-type pairs.+A hypothesis is written+<center>+<CODE>(</CODE> <I>x</I> <CODE>:</CODE> <I>T</I> <CODE>)</CODE>+</center>+and a sequence does not have any separator symbols. As syntactic sugar,+</P>+<UL>+<LI>variables can share a type,+<center>+<CODE>(</CODE> <I>x,y</I> <CODE>:</CODE> <I>T</I> <CODE>)</CODE> === <CODE>(</CODE> <I>x</I> <CODE>:</CODE> <I>T</I> <CODE>)</CODE> <CODE>(</CODE> <I>y</I> <CODE>:</CODE> <I>T</I> <CODE>)</CODE>+</center>+<LI>a <B>wildcard</B> can be used for a variable not occurring in types+ later in the context,+<center>+<CODE>(</CODE> <CODE>_</CODE> <CODE>:</CODE> <I>T</I> <CODE>)</CODE> === <CODE>(</CODE> <I>x</I> <CODE>:</CODE> <I>T</I> <CODE>)</CODE>+</center>+<LI>if the variable does not occur later, it can be omitted altogether, and+ parentheses are not used,+<center>+ <I>T</I> === <CODE>(</CODE> <I>x</I> <CODE>:</CODE> <I>T</I> <CODE>)</CODE>+</center>+ But if <I>T</I> is more complex than an identifier, it needs parentheses to+ be separated from the rest of the context.+</UL>++<P>+An abstract syntax has <B>dependent types</B>, if any of its categories has+a non-empty context.+</P>+<A NAME="toc18"></A>+<H3>Function declarations, fun</H3>+<P>+Function declarations,+<center>+ <CODE>fun</CODE> <I>f</I> <CODE>:</CODE> <I>T</I>+</center>+define the <B>syntactic constructors</B> of abstract+syntax. The type <I>T</I> of <I>f</I>+is built built from basic types (formed from categories) by using+the function type constructor <CODE>-></CODE>. Thus its form is+<center>+ (<i>x</i><sub>1</sub> <CODE>:</CODE> <i>A</i><sub>1</sub>) <CODE>-></CODE> ... <CODE>-></CODE> (<i>x</i><sub>n</sub> <CODE>:</CODE> <i>A</i><sub>n</sub>) <CODE>-></CODE> <I>B</I>+</center>+where <I>Ai</I> are types, called the <B>argument types</B>, and <I>B</I> is a+basic type, called the <B>value type</B> of <I>f</I>. The <B>value category</B> of+<I>f</I> is the category that forms the type <I>B</I>.+</P>+<P>+A <B>syntax tree</B> is formed from <I>f</I> by applying it to a full list of+arguments, so that the result is of a basic type.+</P>+<P>+A <B>higher-order function</B> is one that has a function type as an+argument. The concrete syntax of GF does not support displaying the+bound variables of functions of higher than second order, but they are+legal in abstract syntax.+</P>+<P>+An abstract syntax is <B>context-free</B>, if it has neither dependent+types nor higher-order functions. Grammars with context-free abstract+syntax are an important subclass of GF, with more limited complexity+than full GF. Whether the <I>concrete</I> syntax is context-free in the sense+of the Chomsky hierarchy is independent of the context-freeness of+the abstract syntax.+</P>+<A NAME="toc19"></A>+<H3>Function definitions, def</H3>+<P>+Function definitions,+<center>+ <CODE>def</CODE> <I>f</I> <i>p</i><sub>1</sub> ... <i>p</i><sub>n</sub> <CODE>=</CODE> <I>t</I>+</center>+where <I>f</I> is a <CODE>fun</CODE> function and <i>p</i><sub>i</sub># are patterns,+impose a relation of <B>definitional equality</B> on abstract syntax+trees. They form the basis of <B>computation</B>, which is used+when comparing whether two types are equal; this notion is relevant+only if the types are dependent. Computation can also be used for+the <B>normalization</B> of syntax trees, which applies even in+context-free abstract syntax.+</P>+<P>+The set of <CODE>def</CODE> definitions for <I>f</I> can be scattered around+the module in which <I>f</I> is introduced as a function. The compiler+builds the set of pattern equations in the order in which the+equations appear; this order is significant in the case of+overlapping patterns. All equations must appear in the same module in+which <I>f</I> itself declared.+</P>+<P>+The syntax of patterns will be specified <a href="#patternmatching">here</a>, commonly for+abstract and concrete syntax. In abstract+syntax, <B>constructor patterns</B> are those of the form+<center>+ <I>C</I> <i>p</i><sub>1</sub> ... <i>p</i><sub>n</sub>+</center>+where <I>C</I> is declared as <CODE>data</CODE> for some abstract syntax category+(see next section). A <B>variable pattern</B> is either an identifier or+a wildcard.+</P>+<P>+A common pitfall is to forget to declare a constructor as data, which+causes it to be interpreted as a variable pattern in definitions.+</P>+<P>+Computation is performed by applying definitions and beta conversions,+and in general by using <B>pattern matching</B>. Computation and pattern matching+are explained commonly for abstract and concrete syntax <a href="#patternmatching">here</a>.+</P>+<P>+In contrast to concrete syntax, abstract syntax computation is+completely <B>symbolic</B>: it does not produce a value, but just another+term. Hence it is not an error to have incomplete systems of+pattern equations for a function. In addition, the definitions+can be <B>recursive</B>, which means that computation can fail to terminate;+this can never happen in concrete syntax.+</P>+<A NAME="toc20"></A>+<H3>Data constructor definitions, data</H3>+<P>+A data constructor definition,+<center>+ <CODE>data</CODE> <I>C</I> <CODE>=</CODE> <i>f</i><sub>1</sub> <CODE>|</CODE> ... <CODE>|</CODE> <i>f</i><sub>n</sub>+</center>+defines the functions <I>f1</I>...<I>fn</I> to be <B>constructors</B>+of the category <I>C</I>. This means that they are recognized as constructor+patterns when used in function definitions.+</P>+<P>+In order for the data constructor definition to be correct,+<i>f</i><sub>1</sub>...<i>f</i><sub>n</sub> must be functions with <I>C</I> as their value category.+</P>+<P>+The complete set of constructors for a category <I>C</I> is the union of+all its data constructor definitions. Thus a category can be "extended"+by new constructors afterwards. However, all these constructor definitions+must appear in the same module in which the category is itself defined.+</P>+<P>+There is syntactic sugar for declaring a function as a constructor at+the same time as introducing it:+<center>+<CODE>data</CODE> <I>f</I> : <i>A</i><sub>1</sub> <CODE>-></CODE> ... <CODE>-></CODE> <i>A</i><sub>n</sub> <CODE>-></CODE> <I>C</I> <i>t</i><sub>1</sub> ... <i>t</i><sub>m</sub>+</P>+<P>+ ===+</P>+<P>+<CODE>fun</CODE> <I>f</I> : <i>A</i><sub>1</sub> <CODE>-></CODE> ... <CODE>-></CODE> <i>A</i><sub>n</sub> <CODE>-></CODE> <I>C</I> <i>t</i><sub>1</sub> ... <i>t</i><sub>m</sub> ;+ <CODE>data</CODE> <I>C</I> = <I>f</I>+</center>+</P>+<A NAME="toc21"></A>+<H3>The semantic status of an abstract syntax function</H3>+<P>+There are three possible statuses for a function declared in a <CODE>fun</CODE> judgement:+</P>+<UL>+<LI>primitive notion: the default status+<LI>constructor: the function appears on the right-hand side in <CODE>data</CODE> judgement+<LI>defined: the function has a <CODE>def</CODE> definition+</UL>++<P>+The "constructor" and "defined" statuses are in contradiction with each other,+whereas the primitive notion status is overridden by any of the two others.+</P>+<P>+This distinction is relevant for the semantics of abstract syntax, not+for concrete syntax. It shows in the way patterns are treated in+equations in <CODE>def</CODE> definitions: a constructor+in a pattern matches only itself, whereas+any other name is treated as a variable pattern, which matches+anything.+</P>+<A NAME="toc22"></A>+<H3>Linearization type definitions, lincat</H3>+<P>+A linearization type definition,+<center>+ <CODE>lincat</CODE> <I>C</I> <CODE>=</CODE> <I>T</I>+</center>+defines the type of linearizations of trees whose type has category <I>C</I>.+Type dependences have no effect on the linearization type.+</P>+<P>+The type <I>T</I> must be a <B>legal linearization type</B>, which means that it+is a <I>record type</I> whose fields have either parameter types, the type Str+of strings, or table or record types of these. In particular, function types+may not appear in <I>T</I>. A detailed explanation of types in concrete syntax+will be given <a href="#cnctypes">here</a>.+</P>+<P>+If <I>K</I> is the concrete syntax of an abstract syntax <I>A</I>, then <I>K</I> must+define the linearization type of all categories declared in <I>A</I>. However,+the definition can be omitted from the source code, in which case the default+type <CODE>{s : Str}</CODE> is used.+</P>+<A NAME="toc23"></A>+<H3>Linearization definitions, lin</H3>+<P>+A linearization definition,+<center>+ <CODE>lin</CODE> <I>f</I> <CODE>=</CODE> <I>t</I>+</center>+defines the linearizations function of function <I>f</I>, i.e. the function+used for linearizing trees formed by <I>f</I>.+</P>+<P>+The type of <I>t</I> must be the homomorphic image of the type of <I>f</I>.+In other words, if+<center>+ <CODE>fun</CODE> <I>f</I> <CODE>:</CODE> <i>A</i><sub>1</sub> <CODE>-></CODE> ... <CODE>-></CODE> <i>A</i><sub>n</sub> <CODE>-></CODE> <I>A</I>+</center>+then+<center>+ <CODE>lin</CODE> <I>f</I> <CODE>:</CODE> <i>A</i><sub>1</sub>* <CODE>-></CODE> ... <CODE>-></CODE> <i>A</i><sub>n</sub>* <CODE>-></CODE> <I>A</I>*+</center>+where the type <I>T</I>* is defined as follows depending on <I>T</I>:+</P>+<UL>+<LI>(<I>C</I> <i>t</i><sub>1</sub> ... <i>t</i><sub>n</sub>)* = <I>T</I>, if <CODE>lincat</CODE> <I>C</I> <CODE>=</CODE> <I>T</I>+<LI>(<i>B</i><sub>1</sub> <CODE>-></CODE> ... <CODE>-></CODE> <i>B</i><sub>m</sub> <CODE>-></CODE> <I>B</I>)* = <I>B</I>* <CODE>** {$0,...,$m : Str}</CODE>+</UL>++<P>+The second case is relevant for higher-order functions only. It says that+the linearization type of the value type is extended by adding a string field+for each argument types; these fields store the variable symbol used for+the binding of each variable.+</P>+<P>+<a name="HOAS"></a>+</P>+<P>+Since the arguments of a function argument are treated as bare strings,+orders higher than the second are irrelevant for concrete syntax.+</P>+<P>+There is syntactic sugar for binding the variables of the linearization+of a function on the left-hand side:+<center>+ <CODE>lin</CODE> <I>f</I> <I>p</I> <CODE>=</CODE> <I>t</I> === <CODE>lin</CODE> <I>f</I> <CODE>= \</CODE><I>p</I> <CODE>-></CODE> <I>t</I>+</center>+The pattern <I>p</I> must be either a variable or a wildcard (<CODE>_</CODE>); this is+what the syntax of lambda abstracts (<CODE>\p -> t</CODE>) requires.+</P>+<A NAME="toc24"></A>+<H3>Linearization default definitions, lindef</H3>+<P>+<a name="lindefjudgements"></a>+</P>+<P>+A linearization default definition,+<center>+ <CODE>lindef</CODE> <I>C</I> <CODE>=</CODE> <I>t</I>+</center>+defines the default linearization of category <I>C</I>, i.e. the function+applicable to a string to make it into an object of the linearization+type of <I>C</I>.+</P>+<P>+Linearization defaults are invoked when linearizing variable bindings+in higher-order abstract syntax. A variable symbol is then presented+as a string, which must be converted to correct type in order for+the linearization not to fail with an error.+</P>+<P>+The other use of the defaults is for linearizing metavariables+and abstract functions without linearization in the concrete syntax.+In the first case the default linearization is applied to+the string <CODE>"?X"</CODE> where <CODE>X</CODE> is the unique index+of the metavariable, and in the second case the string is+<CODE>"[f]"</CODE> where <CODE>f</CODE> is the name of the abstract+function with missing linearization.++</P>+<P>+Usually, linearization defaults are generated by using the default+rule that "uses the symbol itself for every string, and the+first value of the parameter type for every parameter". The precise+definition is by structural recursion on the type:+</P>+<UL>+<LI>default(Str,s) = s+<LI>default(P,s) = #1(P)+<LI>default(P => T,s) = <CODE>\\_ =></CODE> default(T,s)+<LI>default(<CODE>{</CODE>... ; r : R ; ...<CODE>}</CODE>,s) = <CODE>{</CODE>... ; r : default(R,s) ; ...<CODE>}</CODE>+</UL>++<P>+The notion of the first value of a parameter type (#1(P)) is defined+<a href="#paramvalues">below</a>.+</P>+<A NAME="toc24_r"></A>+<H3>Linearization reference definitions, linref</H3>+<P>+<a name="linrefjudgements"></a>+</P>+<P>+A linearization reference definition,+<center>+ <CODE>linref</CODE> <I>C</I> <CODE>=</CODE> <I>t</I>+</center>+defines the reference linearization of category <I>C</I>, i.e. the function+applicable to an object of the linearization type of <I>C</I> to make it into a string.+</P>+<P>+The reference linearization is always applied to the top-level node+of the abstract syntax tree. For example when we linearize the+tree <CODE>f x1 x2 .. xn</CODE>, then we first apply <CODE>f</CODE>+to its arguments which gives us an object of the linearization type of+its category. After that we apply the reference linearization+for the same category to get a string out of the object. This+is particularly useful when the linearization type of <I>C</I>+contains discontious constituents. In this case usually the reference+linearization glues the constituents together to produce an+intuitive linearization string.+</P>+<P>+The reference linearization is also used for linearizing metavariables+which stand in function position. For example the tree+<CODE>f (? x1 x2 .. xn)</CODE> is linearized as follows. Each+of the arguments <CODE>x1 x2 .. xn</CODE> is linearized, and after that+the reference linearization of the its category is applied+to the output of the linearization. The result is a sequence of <CODE>n</CODE>+strings which are concatenated into a single string. The final string+is the input to the default linearization of the category+for the argument of <CODE>f</CODE>. After applying the default linearization+we get an object that we could safely pass to <CODE>f</CODE>.+</P>+<P>+Usually, linearization references are generated by using the+rule that "picks the first string in the linearization type". The precise+definition is by structural recursion on the type:+</P>+<UL>+<LI>reference(Str,o) = Just o+<LI>reference(P,s) = Nothing+<LI>reference(P => T,o) = reference(T,o ! #1(P)) || reference(T,o ! #2(P)) || ... || reference(T,o ! #n(P))+<LI>reference({r1 : R1; ... rn : Rn},o) = reference(R1, o.r1) || reference(R2, o.r2) || ... || reference(Rn, o.rn)+</UL>+Here each call to reference returns either <CODE>(Just o)</CODE> or <CODE>Nothing</CODE>.+When we compute the reference for a table or a record then we pick+the reference for the first expression for which the recursive call+gives us <CODE>Just</CODE>. If we get <CODE>Nothing</CODE> for+all of them then the final result is <CODE>Nothing</CODE> too.++<A NAME="toc25"></A>+<H3>Printname definitions, printname cat and printname fun</H3>+<P>+A category printname definition,+<center>+ <CODE>printname cat</CODE> <I>C</I> <CODE>=</CODE> <I>s</I>+</center>+defines the printname of category <I>C</I>, i.e. the name used+in some abstract syntax information shown to the user.+</P>+<P>+Likewise, a function printname definition,+<center>+ <CODE>printname fun</CODE> <I>f</I> <CODE>=</CODE> <I>s</I>+</center>+defines the printname of function <I>f</I>, i.e. the name used+in some abstract syntax information shown to the user.+</P>+<P>+The most common use of printnames is in the interactive syntax+editor, where printnames are displayed in menus. It is possible+e.g. to adapt them to each language, or to embed HTML tooltips+in them (as is used in some HTML-based editor GUIs).+</P>+<P>+Usually, printnames are generated automatically from the symbol+and/or concrete syntax information.+</P>+<A NAME="toc26"></A>+<H3>Parameter type definitions, param</H3>+<P>+<a name="paramjudgements"></a>+</P>+<P>+A parameter type definition,+<center>+ <CODE>param</CODE> <I>P</I> <CODE>=</CODE> <i>C</i><sub>1</sub> <i>G</i><sub>1</sub> <CODE>|</CODE> ... <CODE>|</CODE> <i>C</i><sub>n</sub> <i>G</i><sub>n</sub>+</center>+defines a parameter type <I>P</I> with the <B>parameter constructors</B>+<i>C</i><sub>1</sub>...<i>C</i><sub>n</sub>, with their respective contexts <i>G</i><sub>1</sub>...<i>G</i><sub>n</sub>.+</P>+<P>+<a name="paramtypes"></a>+</P>+<P>+Contexts have the same syntax as in <CODE>cat</CODE> judgements, explained+<a href="#catjudgements">here</a>. Since dependent types are not available in+parameter type definitions, the use of variables is never+necessary. The types in the context must themselves be <B>parameter types</B>,+which are defined as follows:+</P>+<UL>+<LI>Given the judgement <CODE>param</CODE> <I>P</I> ..., <I>P</I> is a parameter type.+<LI>A record type of parameter types is a parameter type.+<LI><CODE>Ints</CODE> <I>n</I> (an initial segment of integers) is a parameter type.+</UL>++<P>+The names defined by a parameter type definition include both the+type name <I>P</I> and the constructor names <i>C</i><sub>i</sub>. Therefore all these+names must be distinct in a module.+</P>+<P>+A parameter type may not be recursive, i.e. <I>P</I> itself may not occur in+the contexts of its constructors. This restriction extends to mutual+recursion: we say that <I>P</I> <B>depends</B> on the types that occur+in the contexts of its constructors and on all types that those types+depend on, and state that <I>P</I> may not depend on itself.+</P>+<P>+In an <CODE>interface module</CODE>, it is possible to declare a parameter type+without defining it,+<center>+ <CODE>param</CODE> <I>P</I> <CODE>;</CODE>+</center>+</P>+<A NAME="toc27"></A>+<H3>Parameter values</H3>+<P>+<a name="paramvalues"></a>+</P>+<P>+All parameter types are finite, and the GF compiler will internally+compute them to <B>lists of parameter values</B>. These lists are formed by+traversing the <CODE>param</CODE> definitions, usually respecting the+order of constructors in the source code. For records, bibliographical+sorting is applied. However, both the order of traversal of <CODE>param</CODE>+definitions and the order of fields in a record are specified+in a compiler-internal way, which means that the programmer should not+rely on any particular order.+</P>+<P>+The order of the list of parameter values can affect the program in two+cases:+</P>+<UL>+<LI>in the default <CODE>lindef</CODE> definition (<a href="#lindefjudgements">here</a>),+ the first value is chosen+<LI>in course-of-value tables (<a href="#tables">here</a>), the compiler-internal order is+ followed+</UL>++<P>+The first usage implies that, if <CODE>lindef</CODE> definitions are essential for+the application, they should be given manually. The second usage implies that+course-of-value tables should be avoided in hand-written GF code.+</P>+<P>+In run-time grammar generation, all parameter values are translated to+integers denotions positions in these parameter lists.+</P>+<A NAME="toc28"></A>+<H3>Operation definitions, oper</H3>+<P>+An operation definition,+<center>+ <CODE>oper</CODE> <I>h</I> <CODE>:</CODE> <I>T</I> <CODE>=</CODE> <I>t</I>+</center>+defines an <B>operation</B> <I>h</I> of type <I>T</I>, with the computation rule+<center>+ <I>h</I> ==> <I>t</I>+</center>+The type <I>T</I> can be any concrete syntax type, including function+types of any order. The term <I>t</I> must have the type <I>T</I>, as+defined <a href="#expressions">here</a>.+</P>+<P>+As syntactic sugar, the type can be omitted,+<center>+ <CODE>oper</CODE> <I>h</I> <CODE>=</CODE> <I>t</I>+</center>+which works in two cases+</P>+<UL>+<LI>the type can be inferred from <I>t</I> (compiler-dependent)+<LI>the definition occurs in an <CODE>instance</CODE> and the type is given in+ the <CODE>interface</CODE>+</UL>++<P>+It is also possible to give the type and the definition separately:+<center>+<CODE>oper</CODE> <I>h</I> <CODE>:</CODE> <I>T</I> ; <CODE>oper</CODE> <I>h</I> <CODE>=</CODE> <I>t</I> ===+ <CODE>oper</CODE> <I>h</I> <CODE>:</CODE> <I>T</I> <CODE>=</CODE> <I>t</I>+</center>+The order of the type part and the definition part is free, and there+can be other judgements in between. However, they must occur in the+same <CODE>resource</CODE> module for it to be complete (as defined <a href="#completeness">here</a>).+In an <CODE>interface</CODE> module, it is enough to give the type.+</P>+<P>+When only the definition is given, it is possible to use a shorthand+similar to <CODE>lin</CODE> judgements:+<center>+<CODE>oper</CODE> <I>h</I> <I>p</I> <CODE>=</CODE> <I>t</I> === <CODE>oper</CODE> <I>h</I> <CODE>=</CODE> <CODE>\</CODE><I>p</I> <CODE>-></CODE> <I>t</I>+</center>+The pattern <I>p</I> is either a variable or a wildcard (<CODE>_</CODE>).+</P>+<P>+Operation definitions may not be recursive, not even mutually recursive.+This condition ensures that functions can in the end be eliminated from+concrete syntax code (as explained <a href="#functionelimination">here</a>).+</P>+<A NAME="toc29"></A>+<H3>Operation overloading</H3>+<P>+<a name="overloading"></a>+</P>+<P>+One and the same operation name <I>h</I> can be used for different operations,+which have to have different types. For each call of <I>h</I>, the type checker+selects one of these operations depending on what type is expected in the+context of the call. The syntax of overloaded operation definitions is+<center>+<CODE>oper</CODE> <I>h</I>+ <CODE>= overload {</CODE><I>h</I> : <i>T</i><sub>1</sub> = <i>t</i><sub>1</sub> ; ... ; <I>h</I> : <i>T</i><sub>n</sub> = <i>t</i><sub>n</sub><CODE>}</CODE>+</center>+Notice that <I>h</I> must be the same in all cases.+This format can be used to give the complete implementation; to give just+the types, e.g. in an interface, one can use the form+<center>+<CODE>oper</CODE> <I>h</I>+ <CODE>: overload {</CODE><I>h</I> : <i>T</i><sub>1</sub> ; ... ; <I>h</I> : <i>T</i><sub>n</sub><CODE>}</CODE>+</center>+The implementation of this operation typing is given by a judgement of+the first form. The order of branches need not be the same.+</P>+<A NAME="toc30"></A>+<H3>Flag definitions, flags</H3>+<P>+A flag definition,+<center>+ <CODE>flags</CODE> <I>o</I> <CODE>=</CODE> <I>v</I>+</center>+sets the value of the flag <I>o</I>, to be used when compiling or using+the module.+</P>+<P>+The flag <I>o</I> is an identifier, and the value <I>v</I> is either an identifier+or a quoted string.+</P>+<P>+Flags are a kind of metadata, which do not strictly belong to the GF+language. For instance, compilers do not necessarily check the+consistency of flags, or the meaningfulness of their values.+The inheritance of flags is not well-defined; the only certain rule+is that flags set in the module body override the settings from+inherited modules.+</P>+<P>+Here are some flags commonly included in grammars.+</P>+<TABLE class="table">+<TR>+<TH>flag</TH>+<TH>value</TH>+<TH>description</TH>+<TH COLSPAN="2">module</TH>+</TR>+<TR>+<TD><CODE>coding</CODE></TD>+<TD>character encoding</TD>+<TD>encoding used in string literals</TD>+<TD>concrete</TD>+</TR>+<TR>+<TD><CODE>startcat</CODE></TD>+<TD>category</TD>+<TD>default target of parsing</TD>+<TD>abstract</TD>+</TR>+</TABLE>++<P></P>+<P>+The possible values of these flags are+specified <a href="#flagvalues">here</a>. Note that+the <code>lexer</code> and <code>unlexer</code> flags are+deprecated. If you need their functionality, you should use supply+them to GF shell commands like so:++<center><pre><code>put_string -lextext "страви, напої" | parse</code></pre></center>++A summary of their possible values can be found at the <a href="http://www.grammaticalframework.org/doc/gf-shell-reference.html">GF shell+ reference</a>.+</p>+</P>+<A NAME="toc31"></A>+<H2>Types and expressions</H2>+<A NAME="toc32"></A>+<H3>Overview of expression forms</H3>+<P>+<a name="expressions"></a>+</P>+<P>+Like many dependently typed languages, GF makes no syntactic distinction+between expressions and types. An illegal use of a type as an expression or+vice versa comes out as a type error. Whether a variable, for instance,+stands for a type or an expression value, can only be resolved from its+context of use.+</P>+<P>+One practical consequence of the common syntax is that global and local definitions+(<CODE>oper</CODE> judgements and <CODE>let</CODE> expressions, respectively) work in the same way+for types and expressions. Thus it is possible to abbreviate a type+occurring in a type expression:+</P>+<PRE>+ let A = {s : Str ; b : Bool} in A -> A -> A+</PRE>+<P>+Type and other expressions have a system of <B>precedences</B>. The following table+summarizes all expression forms, from the highest to the lowest precedence.+Some expressions are moreover left- or right-associative.+</P>+<TABLE class="table">+<TR>+<TH>prec</TH>+<TH>expression example</TH>+<TH COLSPAN="2">explanation</TH>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>c</CODE></TD>+<TD>constant or variable</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>Type</CODE></TD>+<TD>the type of types</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>PType</CODE></TD>+<TD>the type of parameter types</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>Str</CODE></TD>+<TD>the type of strings/token lists</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>"foo"</CODE></TD>+<TD>string literal</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>123</CODE></TD>+<TD>integer literal</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>0.123</CODE></TD>+<TD>floating point literal</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>?</CODE></TD>+<TD>metavariable</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>[]</CODE></TD>+<TD>empty token list</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>[C a b]</CODE></TD>+<TD>list category</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>["foo bar"]</CODE></TD>+<TD>token list</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>{"s : Str ; n : Num}</CODE></TD>+<TD>record type</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE>{"s = "foo" ; n = Sg}</CODE></TD>+<TD>record</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE><Sg,Fem,Gen></CODE></TD>+<TD>tuple</TD>+</TR>+<TR>+<TD>7</TD>+<TD><CODE><n : Num></CODE></TD>+<TD>type-annotated expression</TD>+</TR>+<TR>+<TD>6 left</TD>+<TD><CODE>t.r</CODE></TD>+<TD>projection or qualification</TD>+</TR>+<TR>+<TD>5 left</TD>+<TD><CODE>f a</CODE></TD>+<TD>function application</TD>+</TR>+<TR>+<TD>5</TD>+<TD><CODE>table {Sg => [] ; _ => "xs"}</CODE></TD>+<TD>table</TD>+</TR>+<TR>+<TD>5</TD>+<TD><CODE>table P [a ; b ; c]</CODE></TD>+<TD>course-of-values table</TD>+</TR>+<TR>+<TD>5</TD>+<TD><CODE>case n of {Sg => [] ; _ => "xs"}</CODE></TD>+<TD>case expression</TD>+</TR>+<TR>+<TD>5</TD>+<TD><CODE>variants {"color" ; "colour"}</CODE></TD>+<TD>free variation</TD>+</TR>+<TR>+<TD>5</TD>+<TD><CODE>pre {vowel => "an" ; _ => "a"}</CODE></TD>+<TD>prefix-dependent choice</TD>+</TR>+<TR>+<TD>4 left</TD>+<TD><CODE>t ! v</CODE></TD>+<TD>table selection</TD>+</TR>+<TR>+<TD>4 left</TD>+<TD><CODE>A * B</CODE></TD>+<TD>tuple type</TD>+</TR>+<TR>+<TD>4 left</TD>+<TD><CODE>R ** {b : Bool}</CODE></TD>+<TD>record (type) extension</TD>+</TR>+<TR>+<TD>3 left</TD>+<TD><CODE>t + s</CODE></TD>+<TD>token gluing</TD>+</TR>+<TR>+<TD>2 left</TD>+<TD><CODE>t ++ s</CODE></TD>+<TD>token list concatenation</TD>+</TR>+<TR>+<TD>1 right</TD>+<TD><CODE>\x,y -> t</CODE></TD>+<TD>function abstraction ("lambda")</TD>+</TR>+<TR>+<TD>1 right</TD>+<TD><CODE>\\x,y => t</CODE></TD>+<TD>table abstraction</TD>+</TR>+<TR>+<TD>1 right</TD>+<TD><CODE>(x : A) -> B</CODE></TD>+<TD>dependent function type</TD>+</TR>+<TR>+<TD>1 right</TD>+<TD><CODE>A -> B</CODE></TD>+<TD>function type</TD>+</TR>+<TR>+<TD>1 right</TD>+<TD><CODE>P => T</CODE></TD>+<TD>table type</TD>+</TR>+<TR>+<TD>1 right</TD>+<TD><CODE>let x = v in t</CODE></TD>+<TD>local definition</TD>+</TR>+<TR>+<TD>1</TD>+<TD><CODE>t where {x = v}</CODE></TD>+<TD>local definition</TD>+</TR>+<TR>+<TD>1</TD>+<TD><CODE>in M.C "foo"</CODE></TD>+<TD>rule by example</TD>+</TR>+</TABLE>++<P></P>+<P>+Any expression in parentheses (<CODE>(</CODE><I>exp</I><CODE>)</CODE>) is in the highest+precedence class.+</P>+<A NAME="toc33"></A>+<H3>The functional fragment: expressions in abstract syntax</H3>+<P>+<a name="functiontype"></a>+</P>+<P>+The expression syntax is the same in abstract and concrete syntax, although+only a part of the syntax is actually usable in well-typed expressions in+abstract syntax. An abstract syntax is essentially used for defining a set+of types and a set of functions between those types. Therefore it needs+essentially the <B>functional fragment</B>+of the syntax. This fragment comprises two kinds of types:+</P>+<UL>+<LI><B>basic types</B>, of form <I>C a1...an</I> where+ <UL>+ <LI><CODE>cat</CODE> <I>C</I> (<i>x</i><sub>1</sub> : <i>A</i><sub>1</sub>)...(<i>x</i><sub>n</sub> : <i>A</i><sub>n</sub>), including the predefined+ categories <CODE>Int</CODE>, <CODE>Float</CODE>, and <CODE>String</CODE> explained <a href="#predefabs">here</a>+ <LI><i>a</i><sub>1</sub> : <i>A</i><sub>1</sub>,...,<i>a</i><sub>n</sub> : <i>A</i><sub>n</sub>{<i>x</i><sub>1</sub> = <i>a</i><sub>1</sub>,...,<i>x</i><sub>n-1</sub>=<i>a</i><sub>n-1</sub>}+ </UL>+</UL>++<UL>+<LI><B>function types</B>, of form (<I>x</I> : <I>A</I>) <CODE>-></CODE> <I>B</I>, where+ <UL>+ <LI><I>A</I> is a type+ <LI><I>B</I> is a type possibly depending on <I>x</I> : <I>A</I>+ </UL>+</UL>++<P>+When defining basic types, we used the notation+<I>t</I>{<i>x</i><sub>1</sub> = <i>t</i><sub>1</sub>,...,<i>x</i><sub>n</sub>=<i>t</i><sub>n</sub>}+for the <B>substitution</B> of values to variables. This is a metalevel notation,+which denotes a term that is formed by replacing the free occurrences of+each variable <i>x</i><sub>i</sub> by <i>t</i><sub>i</sub>.+</P>+<P>+These types have six kinds of expressions:+</P>+<UL>+<LI><B>constants</B>, <I>f</I> : <I>A</I> where+ <UL>+ <LI><CODE>fun</CODE> <I>f</I> : <I>A</I>+ </UL>+</UL>++<UL>+<LI><B>literals</B> for integers, floats, and strings (defined in <a href="#predefabs">here</a>)+</UL>++<UL>+<LI><B>variables</B>, <I>x</I> : <I>A</I> where+ <UL>+ <LI><I>x</I> has been introduced by a binding+ </UL>+</UL>++<UL>+<LI><B>applications</B>, <I>f a</I> : <I>B</I>{<I>x</I>=<I>a</I>}, where+ <UL>+ <LI><I>f</I> : (<I>x</I> : <I>A</I>) <CODE>-></CODE> <I>B</I>+ <LI><I>a</I> : <I>A</I>+ </UL>+</UL>++<UL>+<LI><B>abstractions</B>, <CODE>\</CODE><I>x</I> <CODE>-></CODE> <I>b</I> : (<I>x</I> : <I>A</I>) <CODE>-></CODE> <I>B</I>, where+ <UL>+ <LI><I>b</I> : <I>B</I> possibly depending on <I>x</I> : <I>A</I>+ </UL>+</UL>++<UL>+<LI><B>metavariables</B>, <CODE>?</CODE>, as introduced in intermediate phases of+ incremental type checking; metavariables are not permitted+ in GF source code+</UL>++<P>+<a name="variablebinding"></a>+</P>+<P>+The notion of <B>binding</B> is defined for occurrences of variables in+subexpressions as follows:+</P>+<UL>+<LI>in (<I>x</I> : <I>A</I>) <CODE>-></CODE> <I>B</I>, <I>x</I> is bound in <I>B</I>+<LI>in <CODE>\</CODE><I>x</I> <CODE>-></CODE> <I>b</I>, <I>x</I> is bound in <I>b</I>+<LI>in <CODE>def</CODE> <I>f</I> <i>p</i><sub>1</sub> ... <i>p</i><sub>n</sub> = <I>t</I>, any pattern variable introduced in+ any <I>pi</I> is bound in <I>t</I> (as defined <a href="#patternmatching">here</a>)+</UL>++<P>+As syntactic sugar, function types have sharing of types and+suppression of variables, in the same way as contexts+(defined <a href="#contexts">here</a>):+</P>+<UL>+<LI>variables can share a type,+<center>+<CODE>(</CODE> <I>x,y</I> <CODE>:</CODE> <I>A</I> <CODE>)</CODE> <CODE>-></CODE> <I>B</I> ===+ <CODE>(</CODE> <I>x</I> <CODE>:</CODE> <I>A</I> <CODE>) -> (</CODE> <I>y</I> <CODE>:</CODE> <I>A</I> <CODE>) -></CODE> <I>B</I>+</center>+<LI>a <B>wildcard</B> can be used for a variable not occurring later in the type,+<center>+<CODE>(</CODE> <CODE>_</CODE> <CODE>:</CODE> <I>A</I> <CODE>) -></CODE> <I>B</I> ===+ <CODE>(</CODE> <I>x</I> <CODE>:</CODE> <I>T</I> <CODE>) -></CODE> <I>B</I>+</center>+<LI>if the variable does not occur later, it can be omitted altogether, and+ parentheses are not used,+<center>+ <I>A</I> <CODE>-></CODE> <I>B</I> === <CODE>(</CODE> <I>_</I> <CODE>:</CODE> <I>A</I> <CODE>) -></CODE> <I>B</I>+</center>+</UL>++<P>+There is analogous syntactic sugar for constant functions,+<center>+<CODE>\</CODE><I>_</I> <CODE>-></CODE> <I>t</I> === <CODE>\</CODE><I>x</I> <CODE>-></CODE> <I>t</I>+</center>+where <I>x</I> does not occur in <I>t</I>, and for multiple lambda abstractions:+<center>+<CODE>\</CODE><I>p,q</I> <CODE>-></CODE> <I>t</I> === <CODE>\</CODE><I>p</I> <CODE>-></CODE> <CODE>\</CODE><I>q</I> <CODE>-></CODE> <I>t</I>+</center>+where <I>p</I> and <I>q</I> are variables or wild cards (<CODE>_</CODE>).+</P>+<A NAME="toc34"></A>+<H3>Conversions</H3>+<P>+<a name="conversions"></a>+</P>+<P>+Among expressions, there is a relation of <B>definitional equality</B> defined+by four <B>conversion rules</B>:+</P>+<UL>+<LI><B>alpha conversion</B>:+ <CODE>\</CODE><I>x</I> <CODE>-></CODE> <I>b</I> = <CODE>\</CODE><I>y</I> <CODE>-></CODE> <I>b</I>{<I>x</I>=<I>y</I>}+</UL>++<UL>+<LI><B>beta conversion</B>: (<CODE>\</CODE><I>x</I> <CODE>-></CODE> <I>b</I>) <I>a</I> = <I>b</I>{<I>x</I>=<I>a</I>}+</UL>++<UL>+<LI><B>delta conversion</B>: <I>f</I> <i>a</i><sub>1</sub> ... <i>a</i><sub>n</sub> = <I>tg</I>, if+ <UL>+ <LI>there is a definition <CODE>def</CODE> <I>f</I> <i>p</i><sub>1</sub> ... <i>p</i><sub>n</sub> = <I>t</I>+ <LI>this definition is the first for <I>f</I> that matches the sequence+ <i>a</i><sub>1</sub> .... <i>a</i><sub>n</sub>, with the substitution <I>g</I>+ </UL>+</UL>++<UL>+<LI><B>eta conversion</B>: <I>c</I> = <CODE>\</CODE><I>x</I> <CODE>-></CODE> <I>c x</I>,+ if <I>c</I> : (<I>x</I> : <I>A</I>) <CODE>-></CODE> <I>B</I>+</UL>++<P>+Pattern matching substitution used in delta conversion+is defined <a href="#patternmatching">here</a>.+</P>+<P>+An expression is in <B>beta-eta-normal form</B> if+</P>+<UL>+<LI>it has no subexpressions to which beta conversion applies (beta normality)+<LI>each constant or variable whose type is a function type must be+ <B>eta-expanded</B>, i.e. made into an abstract equal to it by eta conversion+ (eta normality)+</UL>++<P>+Notice that the iteration of eta expansion would lead to an expression not+in beta-normal form.+</P>+<A NAME="toc35"></A>+<H3>Syntax trees</H3>+<P>+<a name="syntaxtrees"></a>+</P>+<P>+The <B>syntax trees</B> defined by an abstract syntax are well-typed+expressions of basic types in beta-eta normal form.+Linearization defined in concrete+syntax applies to all and only these expressions.+</P>+<P>+There is also a direct definition of syntax trees, which does not+refer to beta and eta conversions: keeping in mind that a type always has+the form+<center>+(<i>x</i><sub>1</sub> : <i>A</i><sub>1</sub>) <CODE>-></CODE> ... <CODE>-></CODE> (<i>x</i><sub>n</sub> : <i>A</i><sub>n</sub>) <CODE>-></CODE> <I>B</I>+</center>+where <I>Ai</I> are types and <I>B</I> is a basic type, a syntax tree is an expression+<center>+<I>b</I> <i>t</i><sub>1</sub> ... <i>t</i><sub>n</sub> : <I>B'</I>+</center>+where+</P>+<UL>+<LI><I>B'</I> is the basic type <I>B</I>{<i>x</i><sub>1</sub> = <i>t</i><sub>1</sub>,...,<i>x</i><sub>n</sub> = <i>t</i><sub>n</sub>}+<LI><CODE>fun</CODE> <I>b</I> : (<i>x</i><sub>1</sub> : <i>A</i><sub>1</sub>) <CODE>-></CODE> ... <CODE>-></CODE> (<i>x</i><sub>n</sub> : <i>A</i><sub>n</sub>) <CODE>-></CODE> <I>B</I>+<LI>each <i>t</i><sub>i</sub> has the form <CODE>\</CODE><i>z</i><sub>1</sub>,...,<i>z</i><sub>m</sub> <CODE>-></CODE> <I>c</I> where <i>A</i><sub>i</sub> is+<center>+(<i>y</i><sub>1</sub> : <i>B</i><sub>1</sub>) <CODE>-></CODE> ... <CODE>-></CODE> (<i>y</i><sub>m</sub> : <i>B</i><sub>m</sub>) <CODE>-></CODE> <I>B</I>+</center>+</UL>++<A NAME="toc36"></A>+<H3>Predefined types in abstract syntax</H3>+<P>+<a name="predefabs"></a>+</P>+<P>+GF provides three predefined categories for abstract syntax, with predefined+expressions:+</P>+<TABLE class="table">+<TR>+<TH>category</TH>+<TH COLSPAN="2">expressions</TH>+</TR>+<TR>+<TD ALIGN="center"><CODE>Int</CODE></TD>+<TD>integer literals, e.g. <CODE>123</CODE></TD>+</TR>+<TR>+<TD ALIGN="center"><CODE>Float</CODE></TD>+<TD>floating point literals, e.g. <CODE>12.34</CODE></TD>+</TR>+<TR>+<TD ALIGN="center"><CODE>String</CODE></TD>+<TD>string literals, e.g. <CODE>"foo"</CODE></TD>+</TR>+</TABLE>++<P></P>+<P>+These categories take no arguments, and they can be used as basic+types in the same way as if they were introduced in <CODE>cat</CODE> judgements.+However, it is not legal to define <CODE>fun</CODE> functions that have any+of these types as value type: their only well-typed expressions are+literals as defined in the above table.+</P>+<A NAME="toc37"></A>+<H3>Overview of expressions in concrete syntax</H3>+<P>+<a name="cnctypes"></a>+</P>+<P>+Concrete syntax is about defining mappings from abstract syntax trees+to <B>concrete syntax objects</B>. These objects comprise+</P>+<UL>+<LI>records+<LI>tables+<LI>strings+<LI>parameter values+</UL>++<P>+Thus functions are not concrete syntax objects; however, the+mappings themselves are expressed as functions, and the source code+of a concrete syntax can use functions under the condition that+they can be eliminated from the final compiled grammar (which they+can; this is one of the fundamental properties of compilation, as+explained in more detail in the <I>JFP</I> article).+</P>+<P>+Concrete syntax thus has the same function types and expression forms as+abstract syntax, specified <a href="#functiontype">here</a>. The basic types defined+by categories (<CODE>cat</CODE> judgements) are available via grammar reuse+explained <a href="#reuse">here</a>; this also comprises the+predefined categories <CODE>Float</CODE> and <CODE>String</CODE>.+</P>+<A NAME="toc38"></A>+<H3>Values, canonical forms, and run-time variables</H3>+<P>+In abstract syntax, the conversion rules fiven <a href="#conversions">here</a>+define a computational relation+among expressions, but there is no separate notion of a <B>value</B> of+computation: the value (the end point) of a computation chain is+simply an expression to which no more conversions apply. In general,+we are interested in expressions that satisfy the conditions of being+syntax trees (as defined <a href="#syntaxtrees">here</a>), but there can be many computationally+equivalent syntax trees which nonetheless are distinct syntax trees+and hence have different linearizations. The main use of computation+in abstract syntax is to compare types in dependent type checking.+</P>+<P>+In concrete syntax, the notion of values is central. At run time,+we want to compute the values of linearizations; at compile time, we want+to perform <B>partial evaluation</B>, which computes expressions as far as+possible.+To specify what happens+in computation we therefore have to distinguish between <B>canonical forms</B>+and other forms of expressions. The canonical forms are defined separately+for each form of type, whereas the other forms may usually produce expressions+of any type.+</P>+<P>+<a name="linexpansion"></a>+<a name="runtimevariables"></a>+</P>+<P>+What is done at compile time is the elimination of any noncanonical forms,+except for those depending on <B>run-time variables</B>. Run-time variables are+the same as the <B>argument variables</B> of linearization rules, i.e. the+variables <i>x</i><sub>1</sub>,...,<i>x</i><sub>n</sub> in+<center>+<CODE>lin</CODE> <I>f</I> <CODE>= \</CODE> <i>x</i><sub>1</sub>,...,<i>x</i><sub>n</sub> <CODE>-></CODE> <I>t</I>+</center>+where+<center>+<CODE>fun</CODE> <I>f</I> <CODE>:</CODE>+(<i>x</i><sub>1</sub> : <i>A</i><sub>1</sub>) <CODE>-></CODE> ... <CODE>-></CODE> (<i>x</i><sub>n</sub> : <i>A</i><sub>n</sub>) <CODE>-></CODE> <I>B</I>+</center>+Notice that this definition refers to the <B>eta-expanded</B> linearization term,+which has one abstracted variable for each argument type of <I>f</I>. These variables+are not necessarily explicit in GF source code, but introduced by the compiler.+</P>+<P>+Since certain expression forms should be eliminated in compilation but+cannot be eliminated if run-time variables appear in them, errors can+appear late in compilation. This is an issue with the following+expression forms:+</P>+<UL>+<LI>gluing (<CODE>s + t</CODE>), defined <a href="#gluing">here</a>+<LI>pattern matching on strings, defined <a href="#patternmatching">here</a>+<LI>predefined string operations, defined <a href="#predefcnc">here</a> (those taking+ <CODE>Str</CODE> arguments)+</UL>++<A NAME="toc39"></A>+<H3>Token lists, tokens, and strings</H3>+<P>+<a name="strtype"></a>+</P>+<P>+The most prominent basic type is <CODE>Str</CODE>, the type of <B>token lists</B>.+This type is often sloppily referred to as the type of <B>strings</B>;+but it should be kept in mind that the objects of <CODE>Str</CODE> are+<I>lists</I> of strings rather than single strings.+</P>+<P>+Expressions of type <CODE>Str</CODE> have the following canonical forms:+</P>+<UL>+<LI><B>tokens</B>, i.e. <B>string literals</B>, in double quotes, e.g. <CODE>"foo"</CODE>+<LI><B>the empty token list</B>, <CODE>[]</CODE>+<LI><B>concatenation</B>, <I>s</I> <CODE>++</CODE> <I>t</I>, where <I>s,t</I> : <CODE>Str</CODE>+<LI><B>prefix-dependent choice</B>,+ <CODE>pre {p<sub>1</sub> => s<sub>1</sub> ; ... ; p<sub>n</sub> => s<sub>n</sub> ; _ => s }</CODE>, where+ <UL>+ <LI><I>s</I>, <i>s</i><sub>1</sub>,...,<i>s</i><sub>n</sub>, <i>p</i><sub>1</sub>,...,<i>p</i><sub>n</sub> : <CODE>Str</CODE>+ </UL>+</UL>++<P>+For convenience, the notation is overloaded so that tokens are identified+with singleton token lists, and there is no separate type of tokens+(this is a change from the <I>JFP</I> article).+The notion of a token+is still important for compilation: all tokens introduced by+the grammar must be known at compile time. This, in turn, is+required by the parsing algorithms used for parsing with GF grammars.+</P>+<P>+In addition to string literals, tokens can be formed by a specific+non-canonical operator:+</P>+<UL>+<LI><B>gluing</B>, <I>s</I> <CODE>+</CODE> <I>t</I>, where <I>s,t</I> : <CODE>Str</CODE>+</UL>++<P>+<a name="gluing"></a>+</P>+<P>+Being noncanonical, gluing is equipped with a computation rule:+string literals are glued by forming a new string literal, and+empty token lists can be ignored:+</P>+<UL>+<LI><CODE>"foo" + "bar"</CODE> ==> <CODE>"foobar"</CODE>+<LI><I>t</I> <CODE>+ []</CODE> ==> <I>t</I>+<LI><CODE>[] +</CODE> <I>t</I> ==> <I>t</I>+</UL>++<P>+Since tokens must be known at compile time,+the operands of gluing may not depend on run-time variables,+as defined <a href="#runtimevariables">here</a>.+</P>+<P>+As syntactic sugar, token lists can be given as bracketed string literals, where+spaces separate tokens:+</P>+<UL>+<LI><B>token lists</B>, <CODE>["one two three"]</CODE> === <CODE>"one" ++ "two" ++ "three"</CODE>+</UL>++<P>+Notice that there are no empty tokens, but the expression <CODE>[]</CODE>+can be used in a context requiring a token, in particular in gluing expression+below. Since <CODE>[]</CODE> denotes an empty token list, the following computation laws+are valid:+</P>+<UL>+<LI><I>t</I> <CODE>++ []</CODE> ==> <I>t</I>+<LI><CODE>[] ++</CODE> <I>t</I> ==> <I>t</I>+</UL>++<P>+Moreover, concatenation and gluing are associative:+</P>+<UL>+<LI>s <CODE>+</CODE> (t <CODE>+</CODE> u) ==> s <CODE>+</CODE> t <CODE>+</CODE> u+<LI>s <CODE>++</CODE> (t <CODE>++</CODE> u) ==> s <CODE>++</CODE> t <CODE>++</CODE> u+</UL>++<P>+For the programmer, associativity and the empty token laws mean+that the compiler can use them to simplify string expressions.+It also means that these laws are respected in pattern matching+on strings.+</P>+<P>+A prime example of prefix-dependent choice operation is the following+approximative expression for the English indefinite article:+</P>+<PRE>+ pre {+ ("a" | "e" | "i" | "o") => "an" ;+ _ => "a"+ } ;+</PRE>+<P>+This expression can be computed in the context of a subsequent token:+</P>+<UL>+<LI><CODE>pre {p<sub>1</sub> => s<sub>1</sub> ; ... ; p<sub>n</sub> => s<sub>n</sub> ; _ => s } ++ t</CODE>+ ==>+ <UL>+ <LI><i>s</i><sub>i</sub> for the first <I>i</I> such that the prefix <i>p</i><sub>i</sub>+ matches <I>t</I>, if it exists+ <LI><I>s</I> otherwise+ </UL>+</UL>++<P>+The <B>matching prefix</B> is defined by comparing the string with the prefix of+the token. If the prefix is a variant list of strings, then it matches+the token if any of the strings in the list matches it.+</P>+<P>+The computation rule can sometimes be applied at compile time, but it general,+prefix-dependent choices need to be passed to the run-time grammar, because+they are not given a subsequent token to compare with, or because the+subsequent token depends on a run-time variable.+</P>+<P>+The prefix-dependent choice expression itself may not depend on run-time+variables.+</P>+<P>+ <I>There is an older syntax for prefix-dependent choice,+ namely: <code>pre { s ; s1 / p1 ; ... ; sn / pn}</code>. This syntax+ will not accept strings as patterns.</I>+</P>+<P>+<I>In GF prior to 3.0, a specific type</I> <CODE>Strs</CODE>+<I>is used for defining prefixes,</I>+<I>instead of just</I> <CODE>variants</CODE> <I>of</I> <CODE>Str</CODE>.+</P>+<A NAME="toc40"></A>+<H3>Records and record types</H3>+<P>+A <B>record</B> is a collection of objects of possibly different types,+accessible by <B>projections</B> from the record with <B>labels</B> pointing+to these objects. A record is also itself an object, whose type is+a <B>record type</B>. Record types have the form+<center>+ <CODE>{</CODE> <i>r</i><sub>1</sub> : <i>A</i><sub>1</sub> <CODE>;</CODE> ... <CODE>;</CODE> <i>r</i><sub>n</sub> : <i>A</i><sub>n</sub> <CODE>}</CODE>+</center>+where <I>n</I> >= 0, each <i>A</i><sub>i</sub> is a type, and the labels <i>r</i><sub>i</sub> are+distinct. A record of this type has the form+<center>+ <CODE>{</CODE> <i>r</i><sub>1</sub> = <i>a</i><sub>1</sub> <CODE>;</CODE> ... <CODE>;</CODE> <i>r</i><sub>n</sub> = <i>a</i><sub>n</sub> <CODE>}</CODE>+</center>+where each #aii : "Aii. A limiting case is the <B>empty record type</B>+<CODE>{}</CODE>, which has the object <CODE>{}</CODE>, the <B>empty record</B>.+</P>+<P>+The <B>fields</B> of a record type are its parts of the form <I>r</I> : <I>A</I>,+also called <B>typings</B>. The <B>fields</B> of a record are of the form+<I>r</I> = <I>a</I>, also called <B>value assignments</B>. Value assignments+may optionally indicate the type, as in <I>r</I> : <I>A</I> = <I>a</I>.+</P>+<P>+The order of fields in record types and records is insignificant: two record+types (or records) are equal if they have the same fields, in any order, and a+record is an object of a record type, if it has type-correct value assignments+for all fields of the record type.+The latter definition implies the even stronger+principle of <B>record subtyping</B>: a record can have any type that has some+subset of its fields. This principle is explained further+<a href="#subtyping">here</a>.+</P>+<P>+All fields in a record must have distinct labels. Thus it is not possible+e.g. to "redefine" a field "later" in a record.+</P>+<P>+Lexically, labels are identifiers (defined <a href="#identifiers">here</a>).+This is with the exception+of the labels selecting bound variables in the linearization of higher-order+abstract syntax, which have the form <CODE>$</CODE><I>i</I> for an integer <I>i</I>,+as specified <a href="#HOAS">here</a>.+In source code, these labels should not appear in records fields,+but only in selections.+</P>+<P>+Labels occur only in syntactic positions where they cannot be confused with+constants or variables. Therefore it is safe to write, as in <CODE>Prelude</CODE>,+</P>+<PRE>+ ss : Str -> {s : Str} = \s -> {s = s} ;+</PRE>+<P>+A <B>projection</B> is an expression of the form+<center>+ <I>t</I>.<I>r</I>+</center>+where <I>t</I> must be a record and <I>r</I> must be a label defined in it.+The type of the projection is the type of that field.+The computation rule for projection returns the value assigned to that field:+<center>+<CODE>{</CODE> ... <CODE>;</CODE> <I>r</I> = <I>a</I> <CODE>;</CODE> ... <CODE>}.</CODE><I>r</I> ==> <I>a</I>+</center>+Notice that the dot notation <I>t</I>.<I>r</I> is also used for qualified names+as specified <a href="#qualifiednames">here</a>.+This ambiguity follows tradition and convenience. It is+resolved by the following rules (before type checking):+</P>+<OL>+<LI>if <I>t</I> is a bound variable or a constant in scope,+ <I>t</I>.<I>r</I> is type-checked as a projection+<LI>otherwise, <I>t</I>.<I>r</I> is type-checked as a qualified name+</OL>++<P>+As syntactic sugar, types and values can be shared:+</P>+<UL>+<LI><CODE>{</CODE> ... <CODE>;</CODE> <I>r,s</I> : <I>A</I> <CODE>;</CODE> ... <CODE>}</CODE> ===+ <CODE>{</CODE> ... <CODE>;</CODE> <I>r</I> : <I>A</I> <CODE>;</CODE> <I>s</I> : <I>A</I> <CODE>;</CODE> ... <CODE>}</CODE>+<LI><CODE>{</CODE> ... <CODE>;</CODE> <I>r,s</I> = <I>a</I> <CODE>;</CODE> ... <CODE>}</CODE> ===+ <CODE>{</CODE> ... <CODE>;</CODE> <I>r</I> = <I>a</I> <CODE>;</CODE> <I>s</I> = <I>a</I> <CODE>;</CODE> ... <CODE>}</CODE>+</UL>++<P>+Another syntactic sugar are <B>tuple types</B> and <B>tuples</B>, which are translated+by endowing their unlabelled fields by the labels <CODE>p1</CODE>, <CODE>p2</CODE>,... in the+order of appearance of the fields:+</P>+<UL>+<LI><i>A</i><sub>1</sub> <CODE>*</CODE> ... <CODE>*</CODE> <i>A</i><sub>n</sub> ===+ <CODE>{</CODE> <CODE>p1</CODE> : <i>A</i><sub>1</sub> <CODE>;</CODE> ... <CODE>;</CODE> <CODE>pn</CODE> : <i>A</i><sub>n</sub> <CODE>}</CODE>+<LI><CODE><</CODE><i>a</i><sub>1</sub> <CODE>,</CODE> ... <CODE>,</CODE> <i>a</i><sub>n</sub> <CODE>></CODE> ===+ <CODE>{</CODE> <CODE>p1</CODE> = <i>a</i><sub>1</sub><CODE>;</CODE> ... <CODE>;</CODE> <CODE>pn</CODE> = <i>a</i><sub>n</sub> <CODE>}</CODE>+</UL>++<P>+A <B>record extension</B> is formed by adding fields to a record or a record type.+The general syntax involves two expressions,+<center>+ <I>R</I> <CODE>**</CODE> <I>S</I>+</center>+The result is a record type or a record with a union of the fields of <I>R</I> and+<I>S</I>. It is therefore well-formed if+</P>+<UL>+<LI>both <I>R</I> and <I>S</I> are either records or record types+<LI>the labels in <I>R</I> and <I>S</I> are disjoint, if <I>R</I> and <I>S</I> are record types+</UL>+(Since GF version 3.6) If <I>R</I> and <I>S</I> are record objects,+then the labels in them need not be disjoint. Labels defined in+<I>S</I> are then given priority, so that record extensions in fact+works as <B>record update</B>. A common pattern of using this feature+is+<pre>+ lin F x ... = x ** {r = ... x.r ...}+</pre>+where <tt>x</tt> is a record with many fields, just one of which is+updated. Following the normal binding conditions, <tt>x.r</tt> on the+right hand side still refers to the old value of the <tt>r</tt> field.+++<A NAME="toc41"></A>+<H3>Subtyping</H3>+<P>+<a name="subtyping"></a>+</P>+<P>+The possibility of having superfluous fields in a record forms the basis of+the <B>subtyping</B> relation.+That <I>A</I> is a subtype of <I>B</I> means that <I>a : A</I> implies <I>a : B</I>.+This is clearly satisfied for records with superfluous fields:+</P>+<UL>+<LI>if <I>R</I> is a record type without the label <I>r</I>,+ then <I>R</I> <CODE>** {</CODE> <I>r</I> : <I>A</I> <CODE>}</CODE> is a subtype of <I>R</I>+</UL>++<P>+The GF grammar compiler extends subtyping to function types by <B>covariance</B>+and <B>contravariance</B>:+</P>+<UL>+<LI>covariance: if <I>A</I> is a subtype of <I>B</I>,+ then <I>C</I> <CODE>-></CODE> <I>A</I> is a subtype of <I>C</I> <CODE>-></CODE> <I>B</I>+<LI>contravariance: if <I>A</I> is a subtype of <I>B</I>,+ then <I>B</I> <CODE>-></CODE> <I>C</I> is a subtype of <I>A</I> <CODE>-></CODE> <I>C</I>+</UL>++<P>+The logic of these rules is natural: if a function is returns a value+in a subtype, then this value is <I>a fortiori</I> in the supertype.+If a function is defined for some type, then it is <I>a fortiori</I> defined+for any subtype.+</P>+<P>+In addition to the well-known principles of record subtyping and co- and+contravariance, GF implements subtyping for initial segments of integers:+</P>+<UL>+<LI>if <I>m</I> < <I>n</I>, then <CODE>Ints</CODE> <I>m</I> is a subtype of <CODE>Ints</CODE> <I>n</I>+<LI><CODE>Ints</CODE> <I>n</I> is a subtype of <CODE>Integer</CODE>+</UL>++<P>+As the last rule, subtyping is transitive:+</P>+<UL>+<LI>if <I>A</I> is a subtype of <I>B</I> and <I>B</I> is a subtype of <I>C</I>, then+ <I>A</I> is a subtype of <I>C</I>.+</UL>++<A NAME="toc42"></A>+<H3>Tables and table types</H3>+<P>+<a name="tables"></a>+</P>+<P>+One of the most characteristic constructs of GF is <B>tables</B>, also called+<B>finite functions</B>. That these functions are finite means that it+is possible to finitely enumerate all argument-value pairs; this, in+turn, is possible because the argument types are finite.+</P>+<P>+A <B>table type</B> has the form+<center>+<I>P</I> <CODE>=></CODE> <I>T</I>+</center>+where <I>P</I> must be a parameter type in the sense defined <a href="#paramtypes">here</a>, whereas+<I>T</I> can be any type.+</P>+<P>+Canonical expressions of table types are <B>tables</B>, of the form+<center>+<CODE>table</CODE> <CODE>{</CODE> <i>V</i><sub>1</sub> <CODE>=></CODE> <i>t</i><sub>1</sub> ; ... ; <i>V</i><sub>n</sub> <CODE>=></CODE> <i>t</i><sub>n</sub> <CODE>}</CODE>+</center>+where <i>V</i><sub>1</sub>,...,<i>V</i><sub>n</sub> is the complete list of the parameter values of+the argument type <I>P</I> (defined <a href="#paramvalues">here</a>), and each <i>t</i><sub>i</sub> is+an expression of the value type <I>T</I>.+</P>+<P>+In addition to explicit enumerations,+tables can be given by <B>pattern matching</B>,+<center>+<CODE>table</CODE> <CODE>{</CODE><i>p</i><sub>1</sub> <CODE>=></CODE> <i>t</i><sub>1</sub> ; ... ; <i>p</i><sub>m</sub> <CODE>=></CODE> <i>t</i><sub>m</sub><CODE>}</CODE>+</center>+where <i>p</i><sub>1</sub>,....,<i>p</i><sub>m</sub> is a list of patterns that covers all values of type <I>P</I>.+Each pattern <i>p</i><sub>i</sub> may bind some variables, on which the expression <i>t</i><sub>i</sub>+may depend. A complete account of patterns and pattern matching is given+<a href="#patternmatching">here</a>.+</P>+<P>+A <B>course-of-values table</B> omits the patterns and just lists all+values. It uses the enumeration of all values of the argument type <I>P</I>+to pair the values with arguments:+<center>+<CODE>table</CODE> <I>P</I> <CODE>[</CODE><i>t</i><sub>1</sub> ; ... ; <i>t</i><sub>n</sub><CODE>]</CODE>+</center>+This format is not recommended for GF source code, since the+ordering of parameter values is not specified and therefore a+compiler-internal decision.+</P>+<P>+The argument type can be indicated in ordinary tables as well, which is+sometimes helpful for type inference:+<center>+<CODE>table</CODE> <I>P</I> <CODE>{</CODE> ... <CODE>}</CODE>+</center>+</P>+<P>+The <B>selection</B> operator <CODE>!</CODE>, applied to a table <I>t</I> and to an expression+<I>v</I> of its argument type+<center>+<I>t</I> <CODE>!</CODE> <I>v</I>+</center>+returns the first pattern matching result from <I>t</I> with <I>v</I>, as defined+<a href="#patternmatching">here</a>. The order of patterns is thus significant as long as the+patterns contain variables or wildcards. When the compiler reorders the+patterns following the enumeration of all values of the argument type,+this order no longer matters, because no overlap remains between patterns.+</P>+<P>+The GF compiler performs <B>table expansion</B>, i.e. an analogue of+eta expansion defined <a href="#conversions">here</a>, where a table is applied to all+values to its argument type:+<center>+<I>t</I> : <I>P</I> <CODE>=></CODE> <I>T</I> ==>+<CODE>table</CODE> <I>P</I> <CODE>[</CODE><I>t</I> <CODE>!</CODE> <i>V</i><sub>1</sub> ; ... ; <I>t</I> <CODE>!</CODE> <i>V</i><sub>n</sub><CODE>]</CODE>+</center>+As syntactic sugar, one-branch tables can be written in a way similar to+lambda abstractions:+<center>+<CODE>\\</CODE><I>p</I> <CODE>=></CODE> <I>t</I> === <CODE>table {</CODE><I>p</I> <CODE>=></CODE> <I>t</I> <CODE>}</CODE>+</center>+where <I>p</I> is either a variable or a wildcard (<CODE>_</CODE>). Multiple bindings+can be abbreviated:+<center>+<CODE>\\</CODE><I>p,q</I> <CODE>=></CODE> <I>t</I> === <CODE>\\</CODE><I>p</I> <CODE>=></CODE> <CODE>\\</CODE><I>q</I> <CODE>=></CODE> <I>t</I>+</center>+<B>Case expressions</B> are syntactic sugar for selections:+<center>+<CODE>case</CODE> <I>e</I> <CODE>of {</CODE>...<CODE>}</CODE> === <CODE>table {</CODE>...<CODE>} !</CODE> <I>e</I>+</center>+</P>+<A NAME="toc43"></A>+<H3>Pattern matching</H3>+<P>+<a name="patternmatching"></a>+</P>+<P>+We will list all forms of patterns that can be used in table branches.+We define their <B>variable bindings</B> and <B>matching substitutions</B>.+</P>+<P>+We start with the patterns available for all parameter types, as well+as for the types <CODE>Integer</CODE> and <CODE>Str</CODE>.+</P>+<UL>+<LI>A constructor pattern <I>C</I> <i>p</i><sub>1</sub>...<i>p</i><sub>n</sub>+ binds the union of all variables bound in the subpatterns+ <i>p</i><sub>1</sub>,...,<i>p</i><sub>n</sub>.+ It matches any value+ <I>C</I> <i>V</i><sub>1</sub>...<i>V</i><sub>n</sub> where each <i>p</i><sub>i</sub># matches <i>V</i><sub>i</sub>,+ and the matching substitution is the union of these substitutions.+<LI>A record pattern+ <CODE>{</CODE> <i>r</i><sub>1</sub> <CODE>=</CODE> <i>p</i><sub>1</sub> <CODE>;</CODE> ... <CODE>;</CODE> <i>r</i><sub>n</sub> <CODE>=</CODE> <i>p</i><sub>n</sub> <CODE>}</CODE>+ binds the union of all variables bound in the subpatterns+ <i>p</i><sub>1</sub>,...,<i>p</i><sub>n</sub>.+ It matches any value+ <CODE>{</CODE> <i>r</i><sub>1</sub> <CODE>=</CODE> <i>V</i><sub>1</sub> <CODE>;</CODE> ... <CODE>;</CODE> <i>r</i><sub>n</sub> <CODE>=</CODE> <i>V</i><sub>n</sub> <CODE>;</CODE> ...<CODE>}</CODE>+ where each <i>p</i><sub>i</sub># matches <i>V</i><sub>i</sub>,+ and the matching substitution is the union of these substitutions.+<LI>A variable pattern <I>x</I>+ (identifier other than parameter constructor)+ binds the variable <I>x</I>.+ It matches any value <I>V</I>, with the substitution {<I>x</I> = <I>V</I>}.+<LI>The wild card <CODE>_</CODE> binds no variables.+ It matches any value, with the empty substitution.+<LI>A disjunctive pattern <I>p</I> <CODE>|</CODE> <I>q</I> binds the intersection of+ the variables bound by <I>p</I> and <I>q</I>.+ It matches anything that+ either <I>p</I> or <I>q</I> matches, with the first substitution starting+ with <I>p</I> matches, from which those+ variables that are not bound by both patterns are removed.+<LI>A negative pattern <CODE>-</CODE> <I>p</I> binds no variables.+ It matches anything that <I>p</I> does <I>not</I> match, with the empty+ substitution.+<LI>An alias pattern <I>x</I> <CODE>@</CODE> <I>p</I> binds <I>x</I> and all the variables+ bound by <I>p</I>. It matches any value <I>V</I> that <I>p</I> matches, with+ the same substition extended by {<I>x</I> = <I>V</I>}.+</UL>++<P>+The following patterns are only available for the type <CODE>Str</CODE>:+</P>+<UL>+<LI>A string literal pattern, e.g. <CODE>"s"</CODE>, binds no variables.+ It matches the same string, with the empty substitution.+<LI>A concatenation pattern, <I>p</I> <CODE>+</CODE> <I>q</I>,+ binds the union of variables bound by <I>p</I> and <I>q</I>.+ It matches any string that consists+ of a prefix matching <I>p</I> and a suffix matching <I>q</I>,+ with the union of substitutions corresponding to the first match (see below).+<LI>A repetition pattern <I>p</I><CODE>*</CODE> binds no variables.+ It matches any string that can be decomposed+ into strings that match <I>p</I>, with the empty substitution.+</UL>++<P>+The following pattern is only available for the types <CODE>Integer</CODE>+and <CODE>Ints</CODE> <I>n</I>:+</P>+<UL>+<LI>An integer literal pattern, e.g. <CODE>214</CODE>, binds no variables.+ It matches the same integer, with+ the empty substitution.+</UL>++<P>+All patterns must be <B>linear</B>: the same pattern variable may occur+only once in them. This is what makes it straightforward to speak+about unions of binding sets and substitutions.+</P>+<P>+Pattern matching is performed in the order in which the branches+appear in the source code: the branch of the first matching pattern is followed.+In concrete syntax, the type checker reject sets of patterns that are+not exhaustive, and warns for completely overshadowed patterns.+It also checks the type correctness of patterns with respect to the+argument type. In abstract syntax, only type correctness is checked,+no exhaustiveness or overshadowing.+</P>+<P>+It follows from the definition of record pattern matching+that it can utilize partial records: the branch+</P>+<PRE>+ {g = Fem} => t+</PRE>+<P>+in a table of type <CODE>{g : Gender ; n : Number} => T</CODE> means the same as+</P>+<PRE>+ {g = Fem ; n = _} => t+</PRE>+<P>+Variables in regular expression patterns+are always bound to the <B>first match</B>, which is the first+in the sequence of binding lists. For example:+</P>+<UL>+<LI><CODE>x + "e" + y</CODE> matches <CODE>"peter"</CODE> with <CODE>x = "p", y = "ter"</CODE>+<LI><CODE>x + "er"*</CODE> matches <CODE>"burgerer"</CODE> with <CODE>x = "burg"</CODE>+</UL>++<A NAME="toc44"></A>+<H3>Free variation</H3>+<P>+An expressions of the form+<center>+<CODE>variants</CODE> <CODE>{</CODE><i>t</i><sub>1</sub> ; ... ; <i>t</i><sub>n</sub><CODE>}</CODE>+</center>+where all <i>t</i><sub>i</sub> are of the same type <I>T</I>, has itseld type <I>T</I>.+This expression presents <i>t</i><sub>i</sub>,...,<i>t</i><sub>n</sub> as being in <B>free variation</B>:+the choice between them is not determined by semantics or parameters.+A limiting case is+<center>+<CODE>variants {}</CODE>+</center>+which encodes a rule saying that there is no way to express a certain+thing, e.g. that a certain inflectional form does not exist.+</P>+<P>+A common wisdom in linguistics is that "there is no free variation", which+refers to the situation where <I>all</I> aspects are taken into account. For+instance, the English negation contraction could be expressed as free variation,+</P>+<PRE>+ variants {"don't" ; "do" ++ "not"}+</PRE>+<P>+if only semantics is taken into account, but if stylistic aspects are included,+then the proper formulation might be with a parameter distinguishing between+informal and formal style:+</P>+<PRE>+ case style of {Informal => "don't" ; Formal => "do" ++ "not"}+</PRE>+<P>+Since there is not way to choose a particular element from a ``variants` list,+free variants is normally not adequate in libraries, nor in grammars meant for+natural language generation. In application grammars+meant to parse user input, free variation is a way to avoid cluttering the+abstract syntax with semantically insignificant distinctions and even to+tolerate some grammatical errors.+</P>+<P>+Permitting <CODE>variants</CODE> in all types involves a major modification of the+semantics of GF expressions. All computation rules have to be lifted to+deal with lists of expressions and values. For instance,+<center>+<I>t</I> <CODE>!</CODE> <CODE>variants</CODE> <CODE>{</CODE><i>t</i><sub>1</sub> ; ... ; <i>t</i><sub>n</sub><CODE>}</CODE> ==>+<CODE>variants</CODE> <CODE>{</CODE><I>t</I> <CODE>!</CODE> <i>t</i><sub>1</sub> ; ... ; <I>t</I> <CODE>!</CODE> <i>t</i><sub>n</sub><CODE>}</CODE>+</center>+This is done in such a way that+variation does not distribute to records (or other product-like structures).+For instance, variants of records,+</P>+<PRE>+ variants {{s = "Auto" ; g = Neutr} ; {s = "Wagen" ; g = Masc}}+</PRE>+<P>+is <I>not</I> the same as a record of variants,+</P>+<PRE>+ {s = variants {"Auto" ; "Wagen"} ; g = variants {Neutr ; Masc}}+</PRE>+<P>+Variants of variants are flattened,+<center>+<CODE>variants</CODE> <CODE>{</CODE>...; <CODE>variants</CODE> <CODE>{</CODE><i>t</i><sub>1</sub> ;...; <i>t</i><sub>n</sub><CODE>}</CODE> ;...<CODE>}</CODE>+==>+<CODE>variants</CODE> <CODE>{</CODE>...; <i>t</i><sub>1</sub> ;...; <i>t</i><sub>n</sub> ;...<CODE>}</CODE>+</center>+and singleton variants are eliminated,+<center>+<CODE>variants</CODE> <CODE>{</CODE><I>t</I><CODE>}</CODE> ==> <I>t</I>+</center>+</P>+<A NAME="toc45"></A>+<H3>Local definitions</H3>+<P>+A <B>local definition</B>, i.e. a <B>let expression</B> has the form+<center>+<CODE>let</CODE> <I>x</I> : <I>T</I> = <I>t</I> <CODE>in</CODE> <I>e</I>+</center>+The type of <I>x</I> must be <I>T</I>, which also has to be the type of <I>t</I>.+Computation is performed by substituting <I>t</I> for <I>x</I> in <I>e</I>:+<center>+<CODE>let</CODE> <I>x</I> : <I>T</I> = <I>t</I> <CODE>in</CODE> <I>e</I> ==> <I>e</I> {<I>x</I> = <I>t</I>}+</center>+As syntactic sugar, the type can be omitted if the type checker is+able to infer it:+<center>+<CODE>let</CODE> <I>x</I> = <I>t</I> <CODE>in</CODE> <I>e</I>+</center>+It is possible to compress several local definitions into one block:+<center>+<CODE>let</CODE> <I>x</I> : <I>T</I> = <I>t</I> <CODE>;</CODE> <I>y</I> : <I>U</I> = <I>u</I> <CODE>in</CODE> <I>e</I>+===+<CODE>let</CODE> <I>x</I> : <I>T</I> = <I>t</I> <CODE>in</CODE> <CODE>let</CODE> <I>y</I> : <I>U</I> = <I>u</I> <CODE>in</CODE> <I>e</I>+</center>+Another notational variant is a definition block appearing after the main+expression:+<center>+<I>e</I> <CODE>where</CODE> <CODE>{</CODE>...<CODE>}</CODE> === <CODE>let</CODE> <CODE>{</CODE>...<CODE>}</CODE> <CODE>in</CODE> <I>e</I>+</center>+Curly brackets are obligatory in the <CODE>where</CODE> form, and can+also be optionally used in the <CODE>let</CODE> form.+</P>+<P>+Since a block of definitions is treated as syntactic sugar+for a nested <CODE>let</CODE> expression, a constant must be defined before it+is used: the scope is not mutual, as in a module body.+Furthermore, unlike in <CODE>lin</CODE> and <CODE>oper</CODE> definitions, it is <I>not</I> possible+to bind variables on the left of the equality sign.+</P>+<A NAME="toc46"></A>+<H3>Function applications in concrete syntax</H3>+<P>+<a name="functionelimination"></a>+</P>+<P>+Fully compiled concrete syntax may not include expressions of function types+except on the outermost level of <CODE>lin</CODE> rules, as defined <a href="#linexpansion">here</a>.+However,+in the source code, and especially in <CODE>oper</CODE> definitions, functions+are the main vehicle of code reuse and abstraction. Thus function types and+functions follow the same rules as in abstract syntax, as specified+<a href="#functiontype">here</a>. In+particular, the application of a lambda abstract is computed by beta conversion.+</P>+<P>+To ensure the elimination of functions, GF uses a special computation rule+for pushing function applications inside tables, since otherwise run-time+variables could block their applications:+<center>+(<CODE>table</CODE> <CODE>{</CODE><i>p</i><sub>1</sub> <CODE>=></CODE> <i>f</i><sub>1</sub> ; ... ;+ <i>p</i><sub>n</sub> <CODE>=></CODE> <i>f</i><sub>n</sub> <CODE>}</CODE> <CODE>!</CODE> <I>e</I>) <I>a</I>+ ==>+ <CODE>table</CODE> <CODE>{</CODE><i>p</i><sub>1</sub> <CODE>=></CODE> <i>f</i><sub>1</sub> <I>a</I> ; ... ;+ <i>p</i><sub>n</sub> <CODE>=></CODE> <i>f</i><sub>n</sub> <I>a</I><CODE>}</CODE> <CODE>!</CODE> <I>e</I>+</center>+Also parameter constructors with non-empty contexts, as defined+<a href="#paramjudgements">here</a>,+result in expressions in application form. These expressions are never+a problem if their arguments are just constructors, because they can then+be translated to integers corresponding to the position of the expression+in the enumaration of the values of its type.+However, a constructor+applied to a run-time variable may need to be converted as follows:+<center>+<I>C</I>...<I>x</I>... ==> <CODE>case</CODE> <I>x</I> of <CODE>{_ =></CODE> <I>C</I>...<I>x</I><CODE>}</CODE>+</center>+The resulting expression, when processed by table expansion as explained+<a href="#tables">here</a>,+results in <I>C</I> being applied to just values of the type of <I>x</I>, and the+application thereby disappears.+</P>+<A NAME="toc47"></A>+<H3>Reusing top-level grammars as resources</H3>+<P>+<a name="reuse"></a>+</P>+<P>+<I>This section is valid for GF 3.0, which abandons the "lock field"</I>+<I>discipline of GF 2.8.</I>+</P>+<P>+As explained <a href="#openabstract">here</a>,+abstract syntax modules can be opened as interfaces+and concrete syntaxes as their instances. This means that judgements are,+as it were, translated in the following way:+</P>+<UL>+<LI><CODE>cat</CODE> <I>C</I> <I>G</I> ===> <CODE>oper</CODE> <I>C</I> : <CODE>Type</CODE>+<LI><CODE>fun</CODE> <I>f</I> : <I>T</I> ===> <CODE>oper</CODE> <I>f</I> : <I>T</I>+<LI><CODE>lincat</CODE> <I>C</I> = <I>T</I> ===> <CODE>oper</CODE> <I>C</I> : <CODE>Type</CODE> = <I>C</I>+<LI><CODE>lin</CODE> <I>f</I> = <I>t</I> ===> <CODE>oper</CODE> <I>f</I> = <I>t</I>+</UL>++<P>+Notice that the value <I>T</I> of <CODE>lincat</CODE> definitions is not disclosed+in the translation. This means that the type <I>C</I> remains abstract: the+only ways of building an object of type <I>C</I> are the operations <I>f</I>+obtained from <I>fun</I> and <I>lin</I> rules.+</P>+<P>+The purpose of keeping linearization types abstract is to enforce+<B>grammar checking via type checking</B>. This means that any well-typed+operation application is also well-typed in the sense of the original+grammar. If the types were disclosed, then we could for instance easily+confuse all categories that have the linearization+type <CODE>{s : Str}</CODE>. Yet another reason is that revealing the types+makes it impossible for the library programmers to change their type+definitions afterwards.+</P>+<P>+Library writers may occasionally want to have access to the values of+linearization types. The way to make it possible is to add an extra+construction operation to a module in which the linearization type+is available:+</P>+<PRE>+ oper MkC : T -> C = \x -> x+</PRE>+<P>+In object-oriented terms, the type <I>C</I> itself is <B>protected</B>, whereas+<I>MkC</I> is a <B>public constructor</B> of <I>C</I>. Of course, it is possible to+make these constructors overloaded (concept explained <a href="#overloading">here</a>),+to enable easy access to special cases.+</P>+<A NAME="toc48"></A>+<H3>Predefined concrete syntax types</H3>+<P>+<a name="predefcnc"></a>+</P>+<P>+The following concrete syntax types are predefined:+</P>+<UL>+<LI><CODE>Str</CODE>, the type of tokens and token lists (defined <a href="#strtype">here</a>)+<LI><CODE>Integer</CODE>, the type of nonnegative integers+<LI><CODE>Ints</CODE> <I>n</I>, the type of integers from <I>0</I> to <I>n</I>+<LI><CODE>Type</CODE>, the type of (concrete syntax) types+<LI><CODE>PType</CODE>, the type of parameter types+</UL>++<P>+The last two types are, in a way, extended by user-written grammars,+since new parameter types can be defined in the way shown <a href="#paramjudgements">here</a>,+and every paramater type is also a type. From the point of view of the values+of expressions, however, a <CODE>param</CODE> declaration does not extend+<CODE>PType</CODE>, since all parameter types get compiled to initial+segments of integers.+</P>+<P>+Notice the difference between the concrete syntax types+<CODE>Str</CODE> and <CODE>Integer</CODE> on the one hand, and the abstract+syntax categories <CODE>String</CODE> and <CODE>Int</CODE>, on the other.+As <I>concrete syntax</I> types, the latter are treated in+the same way as any reused categories: their objects+can be formed by using syntax trees (string and integer+literals).+</P>+<P>+<I>The type name</I> <CODE>Integer</CODE> <I>replaces in GF 3.0 the name</I> <CODE>Int</CODE>,+<I>to avoid confusion with the abstract syntax type and to be analogous</I>+<I>with the</I> <CODE>Str</CODE> <I>vs.</I> <CODE>String</CODE> <I>distinction.</I>+</P>+<A NAME="toc49"></A>+<H3>Predefined concrete syntax operations</H3>+<P>+The following predefined operations are defined in the resource module+<CODE>prelude/Predef.gf</CODE>. Their implementations are defined as+a part of the GF grammar compiler.+</P>+<TABLE class="table">+<TR>+<TH>operation</TH>+<TH>type</TH>+<TH COLSPAN="2">explanation</TH>+</TR>+<TR>+<TD><CODE>PBool</CODE></TD>+<TD><CODE>PType</CODE></TD>+<TD><CODE>PTrue | PFalse</CODE></TD>+</TR>+<TR>+<TD><CODE>Error</CODE></TD>+<TD><CODE>Type</CODE></TD>+<TD>the empty type</TD>+</TR>+<TR>+<TD><CODE>Int</CODE></TD>+<TD><CODE>Type</CODE></TD>+<TD>the type of integers</TD>+</TR>+<TR>+<TD><CODE>Ints</CODE></TD>+<TD><CODE>Integer -> Type</CODE></TD>+<TD>the type of integers from 0 to n</TD>+</TR>+<TR>+<TD><CODE>error</CODE></TD>+<TD><CODE>Str -> Error</CODE></TD>+<TD>forms error message</TD>+</TR>+<TR>+<TD><CODE>length</CODE></TD>+<TD><CODE>Str -> Int</CODE></TD>+<TD>length of string</TD>+</TR>+<TR>+<TD><CODE>drop</CODE></TD>+<TD><CODE>Integer -> Str -> Str</CODE></TD>+<TD>drop prefix of length</TD>+</TR>+<TR>+<TD><CODE>take</CODE></TD>+<TD><CODE>Integer -> Str -> Str</CODE></TD>+<TD>take prefix of length</TD>+</TR>+<TR>+<TD><CODE>tk</CODE></TD>+<TD><CODE>Integer -> Str -> Str</CODE></TD>+<TD>drop suffix of length</TD>+</TR>+<TR>+<TD><CODE>dp</CODE></TD>+<TD><CODE>Integer -> Str -> Str</CODE></TD>+<TD>take suffix of length</TD>+</TR>+<TR>+<TD><CODE>eqInt</CODE></TD>+<TD><CODE>Integer -> Integer -> PBool</CODE></TD>+<TD>test if equal integers</TD>+</TR>+<TR>+<TD><CODE>lessInt</CODE></TD>+<TD><CODE>Integer -> Integer -> PBool</CODE></TD>+<TD>test order of integers</TD>+</TR>+<TR>+<TD><CODE>plus</CODE></TD>+<TD><CODE>Integer -> Integer -> Integer</CODE></TD>+<TD>add integers</TD>+</TR>+<TR>+<TD><CODE>eqStr</CODE></TD>+<TD><CODE>Str -> Str -> PBool</CODE></TD>+<TD>test if equal strings</TD>+</TR>+<TR>+<TD><CODE>occur</CODE></TD>+<TD><CODE>Str -> Str -> PBool</CODE></TD>+<TD>test if occurs as substring</TD>+</TR>+<TR>+<TD><CODE>occurs</CODE></TD>+<TD><CODE>Str -> Str -> PBool</CODE></TD>+<TD>test if any char occurs</TD>+</TR>+<TR>+<TD><CODE>show</CODE></TD>+<TD><CODE>(P : Type) -> P -> Str</CODE></TD>+<TD>convert param to string</TD>+</TR>+<TR>+<TD><CODE>read</CODE></TD>+<TD><CODE>(P : Type) -> Str -> P</CODE></TD>+<TD>convert string to param</TD>+</TR>+<TR>+<TD><CODE>toStr</CODE></TD>+<TD><CODE>(L : Type) -> L -> Str</CODE></TD>+<TD>find the "first" string</TD>+</TR>+<TR>+<TD><CODE>nonExist</CODE></TD>+<TD><CODE>Str</CODE></TD>+<TD>a special token marking<BR/>+non-existing morphological forms</TD>+</TR>+<TR>+<TD><CODE>BIND</CODE></TD>+<TD><CODE>Str</CODE></TD>+<TD>a special token marking<BR/>+that the surrounding tokens should not<BR/>+be separated by space</TD>+</TR>+<TR>+<TD><CODE>SOFT_BIND</CODE></TD>+<TD><CODE>Str</CODE></TD>+<TD>a special token marking<BR/>+that the surrounding tokens may not<BR/>+be separated by space</TD>+</TR>+<TR>+<TD><CODE>SOFT_SPACE</CODE></TD>+<TD><CODE>Str</CODE></TD>+<TD>a special token marking<BR/>+that the space between the surrounding tokens<BR/>+is optional</TD>+</TR>+<TR>+<TD><CODE>CAPIT</CODE></TD>+<TD><CODE>Str</CODE></TD>+<TD>a special token marking<BR/>+that the first character in the next token<BR/>+should be capitalized</TD>+</TR>+<TR>+<TD><CODE>ALL_CAPIT</CODE></TD>+<TD><CODE>Str</CODE></TD>+<TD>a special token marking<BR/>+that the next word should be<BR/>+in all capital letters</TD>+</TR>+</TABLE>++<P></P>+<P>+Compilation eliminates these operations, and they may therefore not+take arguments that depend on run-time variables.+</P>+<P>+The module <CODE>Predef</CODE> is included in the <I>opens</I> list of all+modules, and therefore does not need to be opened explicitly.+</P>+<A NAME="toc50"></A>+<H2>Flags and pragmas</H2>+<A NAME="toc51"></A>+<H3>Some flags and their values</H3>+<P>+<a name="flagvalues"></a>+</P>+<P>+The flag <CODE>coding</CODE> in concrete syntax sets the <B>character encoding</B>+used in the grammar. Internally, GF uses unicode, and <CODE>.pgf</CODE> files+are always written in UTF8 encoding. The presence of the flag+<CODE>coding=utf8</CODE> prevents GF from encoding an already encoded+file.+</P>+<P>++<P></P>+<P>+The flag <CODE>startcat</CODE> in abstract syntax sets the default start category for+parsing, random generation, and any other grammar operation that depends+on category. Its legal values are the categories defined or inherited in+the abstract syntax.+</P>+<P>+++<P></P>+<A NAME="toc52"></A>+<H3>Compiler pragmas</H3>+<P>+<B>Compiler pragmas</B> are a special form of comments prefixed with <CODE>--#</CODE>.+Currently GF interprets the following pragmas.+</P>+<TABLE class="table">+<TR>+<TH>pragma</TH>+<TH COLSPAN="2">explanation</TH>+</TR>+<TR>+<TD><CODE>-path=</CODE>PATH</TD>+<TD>path list for searching modules</TD>+</TR>+</TABLE>++<P></P>+<P>+For instance, the line+</P>+<PRE>+ --# -path=.:present:prelude:/home/aarne/GF/tmp+</PRE>+<P>+in the top of <CODE>FILE.gf</CODE> causes the GF compiler, when invoked on <CODE>FILE.gf</CODE>,+to search through the current directory (<CODE>.</CODE>) and the directories+<CODE>present</CODE>, <CODE>prelude</CODE>, and <CODE>/home/aarne/GF/tmp</CODE>, in this order.+If a directory <CODE>DIR</CODE> is not found relative to the working directory,+<CODE>$(GF_LIB_PATH)/DIR</CODE> is searched. <CODE>$GF_LIB_PATH</CODE>+can be a colon-separated list of directories, in which case each directory+in the list contributes to the search path expansion.++</P>+<A NAME="toc53"></A>+<H2>Alternative grammar input formats</H2>+<P>+While the GF language as specified in this document is the most versatile+and powerful way of writing GF grammars, there are several other formats+that a GF compiler may make available for users, either to get started+with small grammars or to semiautomatically convert grammars from other+formats to GF. Here are the ones supported by GF 2.8 and 3.0.+</P>+<A NAME="toc54"></A>+<H3>Old GF without modules</H3>+<P>+<a name="oldgf"></a>+</P>+<P>+Before GF compiler version 2.0, there was no module system, and+all kinds of judgement could be written in all files, without+any headers. This format is still available, and the compiler+(version 2.8) detects automatically if a file is in the current+or the old format. However, the old format is not recommended+because of pure modularity and missing separate compilation,+and also because libraries are not available, since the old+and the new format cannot be mixed. With version 2.8, grammars+in the old format can be converted to modular grammar with the+command+</P>+<PRE>+ > import -o FILE.gf+</PRE>+<P>+which rewrites the grammar divided into three files:+an abstract, a concrete, and a resource module.+</P>+<A NAME="toc55"></A>+<H3>Context-free grammars</H3>+<P>+A quick way to write a GF grammar is to use the context-free format,+also known as BNF. Files of this form are recognized by the suffix+<CODE>.cf</CODE>. Rules in these files have the form+<center>+<I>Label</I> <CODE>.</CODE> <I>Cat</I> <CODE>::=</CODE> (<I>String</I> | <I>Cat</I>)* <CODE>;</CODE>+</center>+where <I>Label</I> and <I>Cat</I> are identifiers and <I>String</I> quoted strings.+</P>+<P>+There is a shortcut form generating labels automatically,+<center>+<I>Cat</I> <CODE>::=</CODE> (<I>String</I> | <I>Cat</I>)* <CODE>;</CODE>+</center>+In the shortcut form, vertical bars (<CODE>|</CODE>) can be used to give+several right-hand-sides at a time. An empty right-hand side+means the singleton of an empty sequence, and not an empty union.+</P>+<P>+Just like old-style GF files (previous section), contex-free grammar+files can be converted to modular GF by using the <CODE>-o</CODE> option to+the compiler in GF 2.8.+</P>+<A NAME="toc56"></A>+<H3>Extended BNF grammars</H3>+<P>+Extended BNF (<CODE>FILE.ebnf</CODE>)+goes one step further from the shortcut notation of previous section.+The rules have the form+<center>+<I>Cat</I> <CODE>::=</CODE> <I>RHS</I> <CODE>;</CODE>+</center>+where an <I>RHS</I> can be any regular expression+built from quoted strings and category symbols, in the following ways:+</P>+<TABLE class="table">+<TR>+<TH>RHS item</TH>+<TH COLSPAN="2">explanation</TH>+</TR>+<TR>+<TD><I>Cat</I></TD>+<TD>nonterminal</TD>+</TR>+<TR>+<TD><I>String</I></TD>+<TD>terminal</TD>+</TR>+<TR>+<TD><I>RHS</I> <I>RHS</I></TD>+<TD>sequence</TD>+</TR>+<TR>+<TD><I>RHS</I> <CODE>|</CODE> <I>RHS</I></TD>+<TD>alternatives</TD>+</TR>+<TR>+<TD><I>RHS</I> <CODE>?</CODE></TD>+<TD>optional</TD>+</TR>+<TR>+<TD><I>RHS</I> <CODE>*</CODE></TD>+<TD>repetition</TD>+</TR>+<TR>+<TD><I>RHS</I> <CODE>+</CODE></TD>+<TD>non-empty repetition|</TD>+</TR>+</TABLE>++<P></P>+<P>+Parentheses are used to override standard precedences, where+<CODE>|</CODE> binds weaker than sequencing, which binds weaker than the unary operations.+</P>+<P>+The compiler generates not only labels, but also new categories corresponding+to the regular expression combinations actually in use.+</P>+<P>+Just like <CODE>.cf</CODE> files (previous section), <CODE>.ebnf</CODE>+files can be converted to modular GF by using the <CODE>-o</CODE> option to+the compiler in GF 2.8.+</P>+<A NAME="toc57"></A>+<H3>Example-based grammars</H3>+<P>+<B>Example-based grammars</B> (<CODE>.gfe</CODE>) provide a way to use+resource grammar libraries without having to know the names+of functions in them. The compiler works as a preprocessor,+saving the result in a (<CODE>.gf</CODE>) file, which can be compiled+as usual.+</P>+<P>+If a library is implemented as an abstract and concrete syntax,+it can be used for parsing. Calls of library functions can therefore+be formed by parsing strings in the library. GF has an expression+format for this,+<center>+<CODE>in</CODE> <I>C</I> <I>String</I>+</center>+where <I>C</I> is the category in which to parse (it can be qualified by+the module name) and the string is the input to parser. Expressions+of this form are replaced by the syntax trees that result. These+trees are always type-correct. If several parses are found, all but+the first one are given in comments.+</P>+<P>+Here is an example, from <CODE>GF/examples/animal/</CODE>:+</P>+<PRE>+ --# -resource=../../lib/present/LangEng.gfc+ --# -path=.:present:prelude++ incomplete concrete QuestionsI of Questions = open Lang in {+ lincat+ Phrase = Phr ;+ Entity = N ;+ Action = V2 ;+ lin+ Who love_V2 man_N = in Phr "who loves men" ;+ Whom man_N love_V2 = in Phr "whom does the man love" ;+ Answer woman_N love_V2 man_N = in Phr "the woman loves men" ;+ }+</PRE>+<P>+The <CODE>resource</CODE> pragma shows the grammar that is used for parsing+the examples.+</P>+<P>+Notice that the variables <CODE>love_V2</CODE>, <CODE>man_N</CODE>, etc, are+actually constants in the library. In the resulting rules, such as+</P>+<PRE>+ lin Whom = \man_N -> \love_V2 ->+ PhrUtt NoPConj (UttQS (UseQCl TPres ASimul PPos+ (QuestSlash whoPl_IP (SlashV2 (DetCN (DetSg (SgQuant+ DefArt)NoOrd)(UseN man_N)) love_V2)))) NoVoc ;+</PRE>+<P>+those constants are nonetheless treated as variables, following+the normal binding conventions, as stated <a href="#renaming">here</a>.+</P>+<A NAME="toc58"></A>+<H2>The grammar of GF</H2>+<P>+The following grammar is actually used in the parser of GF, although we have+omitted+some obsolete rules still included in the parser for backward compatibility+reasons.+</P>+<P>+This document was automatically generated by the <I>BNF-Converter</I>. It was generated together with the lexer, the parser, and the abstract syntax module, which guarantees that the document matches with the implementation of the language (provided no hand-hacking has taken place).+</P>+<A NAME="toc59"></A>+<H2>The lexical structure of GF</H2>+<A NAME="toc60"></A>+<H3>Identifiers</H3>+<P>+Identifiers <I>Ident</I> are unquoted strings beginning with a letter,+followed by any combination of letters, digits, and the characters <CODE>_ '</CODE>+reserved words excluded.+</P>+<A NAME="toc61"></A>+<H3>Literals</H3>+<P>+Integer literals <I>Integer</I> are nonempty sequences of digits.+</P>+<P>+String literals <I>String</I> have the form+<CODE>"</CODE><I>x</I><CODE>"</CODE>}, where <I>x</I> is any sequence of any characters+except <CODE>"</CODE> unless preceded by <CODE>\</CODE>.+</P>+<P>+Double-precision float literals <I>Double</I> have the structure+indicated by the regular expression <CODE>digit+ '.' digit+ ('e' ('-')? digit+)?</CODE> i.e.\+two sequences of digits separated by a decimal point, optionally+followed by an unsigned or negative exponent.+</P>+<A NAME="toc62"></A>+<H3>Reserved words and symbols</H3>+<P>+The set of reserved words is the set of terminals appearing in the grammar. Those reserved words that consist of non-letter characters are called symbols, and they are treated in a different way from those that are similar to identifiers. The lexer follows rules familiar from languages like Haskell, C, and Java, including longest match and spacing conventions.+</P>+<P>+The reserved words used in GF are the following:+</P>+<TABLE ALIGN="center" CELLPADDING="4">+<TR>+<TD><CODE>PType</CODE></TD>+<TD><CODE>Str</CODE></TD>+<TD><CODE>Strs</CODE></TD>+<TD><CODE>Type</CODE></TD>+</TR>+<TR>+<TD><CODE>abstract</CODE></TD>+<TD><CODE>case</CODE></TD>+<TD><CODE>cat</CODE></TD>+<TD><CODE>concrete</CODE></TD>+</TR>+<TR>+<TD><CODE>data</CODE></TD>+<TD><CODE>def</CODE></TD>+<TD><CODE>flags</CODE></TD>+<TD><CODE>fun</CODE></TD>+</TR>+<TR>+<TD><CODE>in</CODE></TD>+<TD><CODE>incomplete</CODE></TD>+<TD><CODE>instance</CODE></TD>+<TD><CODE>interface</CODE></TD>+</TR>+<TR>+<TD><CODE>let</CODE></TD>+<TD><CODE>lin</CODE></TD>+<TD><CODE>lincat</CODE></TD>+<TD><CODE>lindef</CODE></TD>+</TR>+<TR>+<TD><CODE>linref</CODE></TD>+<TD><CODE>of</CODE></TD>+<TD><CODE>open</CODE></TD>+<TD><CODE>oper</CODE></TD>+</TR>+<TR>+<TD><CODE>param</CODE></TD>+<TD><CODE>pre</CODE></TD>+<TD><CODE>printname</CODE></TD>+<TD><CODE>resource</CODE></TD>+</TR>+<TR>+<TD><CODE>strs</CODE></TD>+<TD><CODE>table</CODE></TD>+<TD><CODE>transfer</CODE></TD>+<TD><CODE>variants</CODE></TD>+</TR>+<TR>+<TD><CODE>where</CODE></TD>+<TD><CODE>with</CODE></TD>+<TD></TD>+<TD></TD>+</TR>+</TABLE>++<P></P>+<P>+The symbols used in GF are the following:+</P>+<TABLE ALIGN="center" CELLPADDING="4">+<TR>+<TD>;</TD>+<TD>=</TD>+<TD>:</TD>+<TD>-></TD>+</TR>+<TR>+<TD>{</TD>+<TD>}</TD>+<TD>**</TD>+<TD>,</TD>+</TR>+<TR>+<TD>(</TD>+<TD>)</TD>+<TD>[</TD>+<TD>]</TD>+</TR>+<TR>+<TD>-</TD>+<TD>.</TD>+<TD>|</TD>+<TD>?</TD>+</TR>+<TR>+<TD><</TD>+<TD>></TD>+<TD>@</TD>+<TD>!</TD>+</TR>+<TR>+<TD>*</TD>+<TD>+</TD>+<TD>++</TD>+<TD>\</TD>+</TR>+<TR>+<TD>=></TD>+<TD>_</TD>+<TD>$</TD>+<TD>/</TD>+</TR>+</TABLE>++<P></P>+<A NAME="toc63"></A>+<H3>Comments</H3>+<P>+Single-line comments begin with --.Multiple-line comments are enclosed with {- and -}.+</P>+<A NAME="toc64"></A>+<H2>The syntactic structure of GF</H2>+<P>+Non-terminals are enclosed between < and >.+The symbols -> (production), <B>|</B> (union)+and <B>eps</B> (empty rule) belong to the BNF notation.+All other symbols are terminals.+</P>+<TABLE ALIGN="center" CELLPADDING="4">+<TR>+<TD><I>Grammar</I></TD>+<TD>-></TD>+<TD><I>[ModDef]</I></TD>+</TR>+<TR>+<TD><I>[ModDef]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>ModDef</I> <I>[ModDef]</I></TD>+</TR>+<TR>+<TD><I>ModDef</I></TD>+<TD>-></TD>+<TD><I>ModDef</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>ComplMod</I> <I>ModType</I> <CODE>=</CODE> <I>ModBody</I></TD>+</TR>+<TR>+<TD><I>ModType</I></TD>+<TD>-></TD>+<TD><CODE>abstract</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>resource</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>interface</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>concrete</CODE> <I>Ident</I> <CODE>of</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>instance</CODE> <I>Ident</I> <CODE>of</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>transfer</CODE> <I>Ident</I> <CODE>:</CODE> <I>Open</I> <CODE>-></CODE> <I>Open</I></TD>+</TR>+<TR>+<TD><I>ModBody</I></TD>+<TD>-></TD>+<TD><I>Extend</I> <I>Opens</I> <CODE>{</CODE> <I>[TopDef]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>[Included]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Included</I> <CODE>with</CODE> <I>[Open]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Included</I> <CODE>with</CODE> <I>[Open]</I> <CODE>**</CODE> <I>Opens</I> <CODE>{</CODE> <I>[TopDef]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>[Included]</I> <CODE>**</CODE> <I>Included</I> <CODE>with</CODE> <I>[Open]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>[Included]</I> <CODE>**</CODE> <I>Included</I> <CODE>with</CODE> <I>[Open]</I> <CODE>**</CODE> <I>Opens</I> <CODE>{</CODE> <I>[TopDef]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD><I>[TopDef]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>TopDef</I> <I>[TopDef]</I></TD>+</TR>+<TR>+<TD><I>Extend</I></TD>+<TD>-></TD>+<TD><I>[Included]</I> <CODE>**</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD><I>[Open]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Open</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Open</I> <CODE>,</CODE> <I>[Open]</I></TD>+</TR>+<TR>+<TD><I>Opens</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>open</CODE> <I>[Open]</I> <CODE>in</CODE></TD>+</TR>+<TR>+<TD><I>Open</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>(</CODE> <I>QualOpen</I> <I>Ident</I> <CODE>)</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>(</CODE> <I>QualOpen</I> <I>Ident</I> <CODE>=</CODE> <I>Ident</I> <CODE>)</CODE></TD>+</TR>+<TR>+<TD><I>ComplMod</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>incomplete</CODE></TD>+</TR>+<TR>+<TD><I>QualOpen</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD><I>[Included]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Included</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Included</I> <CODE>,</CODE> <I>[Included]</I></TD>+</TR>+<TR>+<TD><I>Included</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>[</CODE> <I>[Ident]</I> <CODE>]</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>-</CODE> <CODE>[</CODE> <I>[Ident]</I> <CODE>]</CODE></TD>+</TR>+<TR>+<TD><I>Def</I></TD>+<TD>-></TD>+<TD><I>[Name]</I> <CODE>:</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>[Name]</I> <CODE>=</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Name</I> <I>[Patt]</I> <CODE>=</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>[Name]</I> <CODE>:</CODE> <I>Exp</I> <CODE>=</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD><I>TopDef</I></TD>+<TD>-></TD>+<TD><CODE>cat</CODE> <I>[CatDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>fun</CODE> <I>[FunDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>data</CODE> <I>[FunDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>def</CODE> <I>[Def]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>data</CODE> <I>[DataDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>param</CODE> <I>[ParDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>oper</CODE> <I>[Def]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>lincat</CODE> <I>[PrintDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>lindef</CODE> <I>[Def]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>linref</CODE> <I>[Def]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>lin</CODE> <I>[Def]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>printname</CODE> <CODE>cat</CODE> <I>[PrintDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>printname</CODE> <CODE>fun</CODE> <I>[PrintDef]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>flags</CODE> <I>[FlagDef]</I></TD>+</TR>+<TR>+<TD><I>CatDef</I></TD>+<TD>-></TD>+<TD><I>Ident</I> <I>[DDecl]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>[</CODE> <I>Ident</I> <I>[DDecl]</I> <CODE>]</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>[</CODE> <I>Ident</I> <I>[DDecl]</I> <CODE>]</CODE> <CODE>{</CODE> <I>Integer</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD><I>FunDef</I></TD>+<TD>-></TD>+<TD><I>[Ident]</I> <CODE>:</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD><I>DataDef</I></TD>+<TD>-></TD>+<TD><I>Ident</I> <CODE>=</CODE> <I>[DataConstr]</I></TD>+</TR>+<TR>+<TD><I>DataConstr</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>.</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD><I>[DataConstr]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>DataConstr</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>DataConstr</I> <CODE>|</CODE> <I>[DataConstr]</I></TD>+</TR>+<TR>+<TD><I>ParDef</I></TD>+<TD>-></TD>+<TD><I>Ident</I> <CODE>=</CODE> <I>[ParConstr]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>=</CODE> <CODE>(</CODE> <CODE>in</CODE> <I>Ident</I> <CODE>)</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD><I>ParConstr</I></TD>+<TD>-></TD>+<TD><I>Ident</I> <I>[DDecl]</I></TD>+</TR>+<TR>+<TD><I>PrintDef</I></TD>+<TD>-></TD>+<TD><I>[Name]</I> <CODE>=</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD><I>FlagDef</I></TD>+<TD>-></TD>+<TD><I>Ident</I> <CODE>=</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD><I>[Def]</I></TD>+<TD>-></TD>+<TD><I>Def</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Def</I> <CODE>;</CODE> <I>[Def]</I></TD>+</TR>+<TR>+<TD><I>[CatDef]</I></TD>+<TD>-></TD>+<TD><I>CatDef</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>CatDef</I> <CODE>;</CODE> <I>[CatDef]</I></TD>+</TR>+<TR>+<TD><I>[FunDef]</I></TD>+<TD>-></TD>+<TD><I>FunDef</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>FunDef</I> <CODE>;</CODE> <I>[FunDef]</I></TD>+</TR>+<TR>+<TD><I>[DataDef]</I></TD>+<TD>-></TD>+<TD><I>DataDef</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>DataDef</I> <CODE>;</CODE> <I>[DataDef]</I></TD>+</TR>+<TR>+<TD><I>[ParDef]</I></TD>+<TD>-></TD>+<TD><I>ParDef</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>ParDef</I> <CODE>;</CODE> <I>[ParDef]</I></TD>+</TR>+<TR>+<TD><I>[PrintDef]</I></TD>+<TD>-></TD>+<TD><I>PrintDef</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>PrintDef</I> <CODE>;</CODE> <I>[PrintDef]</I></TD>+</TR>+<TR>+<TD><I>[FlagDef]</I></TD>+<TD>-></TD>+<TD><I>FlagDef</I> <CODE>;</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>FlagDef</I> <CODE>;</CODE> <I>[FlagDef]</I></TD>+</TR>+<TR>+<TD><I>[ParConstr]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>ParConstr</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>ParConstr</I> <CODE>|</CODE> <I>[ParConstr]</I></TD>+</TR>+<TR>+<TD><I>[Ident]</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>,</CODE> <I>[Ident]</I></TD>+</TR>+<TR>+<TD><I>Name</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>[</CODE> <I>Ident</I> <CODE>]</CODE></TD>+</TR>+<TR>+<TD><I>[Name]</I></TD>+<TD>-></TD>+<TD><I>Name</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Name</I> <CODE>,</CODE> <I>[Name]</I></TD>+</TR>+<TR>+<TD><I>LocDef</I></TD>+<TD>-></TD>+<TD><I>[Ident]</I> <CODE>:</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>[Ident]</I> <CODE>=</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>[Ident]</I> <CODE>:</CODE> <I>Exp</I> <CODE>=</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD><I>[LocDef]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>LocDef</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>LocDef</I> <CODE>;</CODE> <I>[LocDef]</I></TD>+</TR>+<TR>+<TD><I>Exp6</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Sort</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>String</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Integer</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Double</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>?</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>[</CODE> <CODE>]</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>data</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>[</CODE> <I>Ident</I> <I>Exps</I> <CODE>]</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>[</CODE> <I>String</I> <CODE>]</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>{</CODE> <I>[LocDef]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE><</CODE> <I>[TupleComp]</I> <CODE>></CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE><</CODE> <I>Exp</I> <CODE>:</CODE> <I>Exp</I> <CODE>></CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>(</CODE> <I>Exp</I> <CODE>)</CODE></TD>+</TR>+<TR>+<TD><I>Exp5</I></TD>+<TD>-></TD>+<TD><I>Exp5</I> <CODE>.</CODE> <I>Label</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp6</I></TD>+</TR>+<TR>+<TD><I>Exp4</I></TD>+<TD>-></TD>+<TD><I>Exp4</I> <I>Exp5</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>table</CODE> <CODE>{</CODE> <I>[Case]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>table</CODE> <I>Exp6</I> <CODE>{</CODE> <I>[Case]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>table</CODE> <I>Exp6</I> <CODE>[</CODE> <I>[Exp]</I> <CODE>]</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>case</CODE> <I>Exp</I> <CODE>of</CODE> <CODE>{</CODE> <I>[Case]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>variants</CODE> <CODE>{</CODE> <I>[Exp]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>pre</CODE> <CODE>{</CODE> <I>Exp</I> <CODE>;</CODE> <I>[Altern]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>strs</CODE> <CODE>{</CODE> <I>[Exp]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>@</CODE> <I>Exp6</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp5</I></TD>+</TR>+<TR>+<TD><I>Exp3</I></TD>+<TD>-></TD>+<TD><I>Exp3</I> <CODE>!</CODE> <I>Exp4</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp3</I> <CODE>*</CODE> <I>Exp4</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp3</I> <CODE>**</CODE> <I>Exp4</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp4</I></TD>+</TR>+<TR>+<TD><I>Exp1</I></TD>+<TD>-></TD>+<TD><I>Exp2</I> <CODE>+</CODE> <I>Exp1</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp2</I></TD>+</TR>+<TR>+<TD><I>Exp</I></TD>+<TD>-></TD>+<TD><I>Exp1</I> <CODE>++</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>\</CODE> <I>[Bind]</I> <CODE>-></CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>\</CODE> <CODE>\</CODE> <I>[Bind]</I> <CODE>=></CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Decl</I> <CODE>-></CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp3</I> <CODE>=></CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>let</CODE> <CODE>{</CODE> <I>[LocDef]</I> <CODE>}</CODE> <CODE>in</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>let</CODE> <I>[LocDef]</I> <CODE>in</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp3</I> <CODE>where</CODE> <CODE>{</CODE> <I>[LocDef]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>in</CODE> <I>Exp5</I> <I>String</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp1</I></TD>+</TR>+<TR>+<TD><I>Exp2</I></TD>+<TD>-></TD>+<TD><I>Exp3</I></TD>+</TR>+<TR>+<TD><I>[Exp]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp</I> <CODE>;</CODE> <I>[Exp]</I></TD>+</TR>+<TR>+<TD><I>Exps</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp6</I> <I>Exps</I></TD>+</TR>+<TR>+<TD><I>Patt2</I></TD>+<TD>-></TD>+<TD><CODE>_</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>.</CODE> <I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Integer</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Double</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>String</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>{</CODE> <I>[PattAss]</I> <CODE>}</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE><</CODE> <I>[PattTupleComp]</I> <CODE>></CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>(</CODE> <I>Patt</I> <CODE>)</CODE></TD>+</TR>+<TR>+<TD><I>Patt1</I></TD>+<TD>-></TD>+<TD><I>Ident</I> <I>[Patt]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>.</CODE> <I>Ident</I> <I>[Patt]</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Patt2</I> <CODE>*</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Ident</I> <CODE>@</CODE> <I>Patt2</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>-</CODE> <I>Patt2</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Patt2</I></TD>+</TR>+<TR>+<TD><I>Patt</I></TD>+<TD>-></TD>+<TD><I>Patt</I> <CODE>|</CODE> <I>Patt1</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Patt</I> <CODE>+</CODE> <I>Patt1</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Patt1</I></TD>+</TR>+<TR>+<TD><I>PattAss</I></TD>+<TD>-></TD>+<TD><I>[Ident]</I> <CODE>=</CODE> <I>Patt</I></TD>+</TR>+<TR>+<TD><I>Label</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>$</CODE> <I>Integer</I></TD>+</TR>+<TR>+<TD><I>Sort</I></TD>+<TD>-></TD>+<TD><CODE>Type</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>PType</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>Str</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>Strs</CODE></TD>+</TR>+<TR>+<TD><I>[PattAss]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>PattAss</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>PattAss</I> <CODE>;</CODE> <I>[PattAss]</I></TD>+</TR>+<TR>+<TD><I>[Patt]</I></TD>+<TD>-></TD>+<TD><I>Patt2</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Patt2</I> <I>[Patt]</I></TD>+</TR>+<TR>+<TD><I>Bind</I></TD>+<TD>-></TD>+<TD><I>Ident</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><CODE>_</CODE></TD>+</TR>+<TR>+<TD><I>[Bind]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Bind</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Bind</I> <CODE>,</CODE> <I>[Bind]</I></TD>+</TR>+<TR>+<TD><I>Decl</I></TD>+<TD>-></TD>+<TD><CODE>(</CODE> <I>[Bind]</I> <CODE>:</CODE> <I>Exp</I> <CODE>)</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp4</I></TD>+</TR>+<TR>+<TD><I>TupleComp</I></TD>+<TD>-></TD>+<TD><I>Exp</I></TD>+</TR>+<TR>+<TD><I>PattTupleComp</I></TD>+<TD>-></TD>+<TD><I>Patt</I></TD>+</TR>+<TR>+<TD><I>[TupleComp]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>TupleComp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>TupleComp</I> <CODE>,</CODE> <I>[TupleComp]</I></TD>+</TR>+<TR>+<TD><I>[PattTupleComp]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>PattTupleComp</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>PattTupleComp</I> <CODE>,</CODE> <I>[PattTupleComp]</I></TD>+</TR>+<TR>+<TD><I>Case</I></TD>+<TD>-></TD>+<TD><I>Patt</I> <CODE>=></CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD><I>[Case]</I></TD>+<TD>-></TD>+<TD><I>Case</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Case</I> <CODE>;</CODE> <I>[Case]</I></TD>+</TR>+<TR>+<TD><I>Altern</I></TD>+<TD>-></TD>+<TD><I>Exp</I> <CODE>/</CODE> <I>Exp</I></TD>+</TR>+<TR>+<TD><I>[Altern]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Altern</I></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Altern</I> <CODE>;</CODE> <I>[Altern]</I></TD>+</TR>+<TR>+<TD><I>DDecl</I></TD>+<TD>-></TD>+<TD><CODE>(</CODE> <I>[Bind]</I> <CODE>:</CODE> <I>Exp</I> <CODE>)</CODE></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>Exp6</I></TD>+</TR>+<TR>+<TD><I>[DDecl]</I></TD>+<TD>-></TD>+<TD><B>eps</B></TD>+</TR>+<TR>+<TD></TD>+<TD ALIGN="center"><B>|</B></TD>+<TD><I>DDecl</I> <I>[DDecl]</I></TD>+</TR>+</TABLE>++</div>+</BODY>+</HTML>
@@ -0,0 +1,106 @@+The GF Software System+++%!options(html): --toc+%!options(html): --toc-level=4+%!postproc(html): "#VSPACE" "<hr>"+%!postproc(html): "#NORMAL" ""+%!postproc(html): "#TINY" ""+%!postproc(html): "#NOINDENT" ""++The GF software system implements the GF programming language. Its+components are+- the //compiler//,+translating ``.gf`` source files to ``.gfo`` object files, to+``.pgf`` run-time grammars, and to various other formats+- the //run-time system//,+performing parsing, generation, translation and other functions with+``.pgf`` grammars+- the //command interpreter//, also known as the //GF shell//,+executing user commands by calling the compiler and the run-time system+++This page describes the commands of the GF shell,+as well as the use of the compiler in batch mode.++%%toc++==The GF shell==++The GF shell is invoked by the command ``gf``, which takes arguments and+options according to the following syntax:+```+ gf (OPTION | FLAG)* FILE*+```+The shell maintains a //state//, to which belong+- a multilingual PGF grammar+- optionally, a set of compiled GF modules (retaining ``oper`` definitions)+- a history of previous commands+- a set of string, tree, and command macros+++Unless file arguments are provided to the ``gf`` command, the shell starts in an+empty state, with no grammars and no history.++In the shell, a set of commands+is available. Some of these commands may change the grammars in the state. The general+syntax of commands is given by the following BNF grammar:+```+ COMMAND_LINE ::= COMMAND_PIPE+ COMMAND_LINE ::= COMMAND_PIPE ";" COMMAND_LINE+ COMMAND_PIPE ::= COMMAND+ COMMAND_PIPE ::= COMMAND "|" COMMAND_PIPE+ COMMAND ::= COMMAND_ID (OPTION | FLAG)* ARGUMENT?+ OPTION ::= "-"OPTION_ID+ FLAG ::= "-"OPTION_ID "=" VALUE+ ARGUMENT ::= QUOTED_STRING | TREE+ VALUE ::= IDENT | QUOTED_STRING+```+A command pipe is a sequence of commands interpreted in such a way+that the output of each command+is send as input to the next. The option ``-tr`` causes GF to show a trace,+i.e. the intermediate result of the command to which it is attached.++A command line is a sequence of pipes separated by ``;``. These pipes are+executed one by one, in the order of appearance.++===GF shell commands===++The full set of GF shell commands is listed below with explanations.+This list can also be obtained in the GF shell by the command ``help -full``.++%!include: gf-help-full.txt++==The GF batch compiler==++With the option ``-batch``, GF can be invoked in batch mode, i.e.+without opening the shell, to compile files from ``.gf`` to ``.gfo``.+The ``-s`` option ("silent") eliminates all messages except errors.+```+ $ gf -batch -s LangIta.gf+```+With the option ``-make``, and as a set of+top-level grammar files (with the same abstract syntax) as arguments,+GF produces a ``.pgf`` file. The flag ``-optimize-pgf`` minimizes+the size of the ``.pgf`` file, and is recommended for grammars to be shipped.+```+ $ gf -make -optimize-pgf LangIta.gf LangEng.gf LangGer.gf+```+The flag ``-output-format`` changes the output format from ``.pgf`` to+some other format. For instance+```+ $ gf -make -output-format=js LangEng.pgf LangGer.pgf+```+Notice that the arguments can be ``.pgf`` files, which in this case+are merged and written into a JavaScript grammar file.++More options and instructions are obtained with+```+ $ gf -help+```+To run GF from a //script//, redirection of standard input can be used:+```+ $ gf <script.gfs+```+The file ``script.gfs`` should then contain a sequence of GF commands, one per line.+Unrecognized command lines are skipped without terminating GF.
@@ -0,0 +1,67 @@+Grammatical Framework Tutorial+ICFP 2012, Copenhagen 9-15 September 2012++%!style:../css/style.css+%!postproc(html): <TD><B> <TH>+%!postproc(html): </B></TD> </TH>+%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>+%!postproc(html): 'ICFP 2012' '<a href="http://icfpconference.org/icfp2012/">ICFP 2012</a>'+++==Goals==++This tutorial gives a hands-on introduction to GF (Grammatical Framework), +a special-purpose functional language +for writing grammars (http://grammaticalframework.org).++We will show how techniques from compiler construction and functional +programming can be used in the processing of natural languages, +but also for formal languages and interfacing +the two. An emerging use is DSL's, where GF provides high expressive +power in terms of both+linguistic expressivity (beyond context-free) and semantics (dependent types).++GF activities are rapidly growing: there is an on-going EU project +MOLTO (molto-project.eu), as well as a new textbook +(Aarne Ranta, Grammatical Framework: Programming with Multilingual Grammars, +CSLI Publications, Stanford, 2011). +GF also has users in companies (Galois, Ontotext, BeInformed, Google).+Interestingly, GF has been the first functional language for many people, +in particular those with a linguistic background. It has a unique +combination of advanced features such as parametrized modules, regular +expression pattern matching, and dependent types - all of which are +amply motivated by practical applications.++The [GF Resource Grammar Library http://www.grammaticalframework.org/lib/doc/synopsis.html]+is an open-source international project +now comprising 24 languages, with 5 to 10 more under construction.+It makes it possible to develop grammar applications without linguistic knowledge.++At the same time, it is an experiment on using a common abstract syntax for+the languages of the world. We don't claim it to be a universal grammar+with no exceptions, but so far we haven't met any unsurmountable problems.+If you want to contribute a new language, let us know! It is a job of+2 to 6 months.+++==Structure of the tutorial==++Hour 1. Writing multilingual grammars in GF (Aarne Ranta)+[Slides http://www.cse.chalmers.se/~aarne/talks/gf-icfp-2012-1.pdf]++Hour 2. Applications for the web, mobile phones, and as embedded Haskell programs +(Thomas Hallgren)+[Slides /~hallgren/Talks/GF/Tutorial2012/tutorial2012.html]++Hour 3. Internals of GF, theoretical aspects, and future trends (Krasimir Angelov)+++==Organizers==+++[Krasimir Angelov http://www.chalmers.se/cse/EN/organization/divisions/computing-science/people/angelov-krasimir]++[Thomas Hallgren http://www.cse.chalmers.se/~hallgren/]++[Aarne Ranta http://www.cse.chalmers.se/~aarne/]+
@@ -0,0 +1,69 @@+<!DOCTYPE html>+<html>+<head>+<title>GF Documentation</title>+<link rel=stylesheet href="../css/style.css">+</head>+ ++<body>++<div class=center>+<a href="../"><img src="Logos/gf0.png"></a>+++++<h1>Grammatical Framework Documents</h1>+</div>+++<b>Top-5 documents</b>:++<a href="gf-quickstart.html">Quick start instruction</a>.+++<a href="tutorial/gf-tutorial.html">Old Tutorial</a>, application-oriented.++<a href="gf-lrec-2010.pdf">New Tutorial</a>, linguistics-oriented.++<a href="gf-refman.html">ReferenceManual</a>.++<a href="../lib/resource/doc/synopsis.html">LibrarySynopsis</a>.+++++<h2>Language and system documentation</h2>++<ul>++ <li>+ <a href="gf-reference.html">GF Quick Reference</a>. Also available in+ <a href="gf-reference.pdf">pdf</a>. Covers all features of GF language+ in a summary format.++ <li>+ <a href="gf-refman.html">GF Reference Manual</a>. A full-scale reference+ manual of the GF language.+ + <li>+ <a href="gf-shell-reference.html">GF Shell Reference</a>.+ Describes the commands available in the interactive GF shell. Also+ summarizes how to run GF as a batch compiler.++ <li>+ <a href="gf-editor-modes.html">Editor modes for GF</a>.+ Editor modes for GF provides syntax highligting, automatic indentation and+ other features that makes editing GF grammar files easier.+ +</ul>+++<h2>Publications</h2>++<a href="gf-bibliography.html">+Bibliography</a>: more publications on GF, as well as background literature.+++</body></html>
binary file changed (absent → 114561 bytes)
@@ -0,0 +1,3928 @@+@STRING{fac = "Formal Aspects of Computing"}+@STRING{amai = "Annals of Mathematics and Artificial Intelligence"}+@STRING{jsl = "Journal of Symbolic Logic"}+@STRING{jsc = "Journal of Symbolic Computation"}+@STRING{jlc = "Journal of Logic and Computation"}+@STRING{jlp = "Journal of Logic Programming"}+@STRING{JFP = "Journal of {F}unctional {P}rogramming"}+@STRING{jar = "Journal of Automated Reasoning"}+@STRING{sl = "Studia Logica"}+@STRING{ipl = "Information Processing Letters"}+@STRING{tcs = "Theoretical Computer Science"}+@STRING{lnm = "Lecture Notes in Mathematics"}+@STRING{lncs = "LNCS"}+@STRING{lnai = "LNCS"}+@STRING{spv = "Springer-Verlag"}+@STRING{cacm = "Communications of the {ACM}"}+@STRING{jacm = "Journal of the {ACM}"}+@STRING{sc = "Soft Computing---A Fusion of Foundations, Methodologies+ and Applications"}+++%%%%%%% GF-related papers++@INCOLLECTION{ranta-finnish,+ AUTHOR = "A. Ranta",+ TITLE = {How predictable is {Finnish} morphology? An experiment on lexicon construction},+ EDITOR = {{J. Nivre and M. Dahll\"of and B. Megyesi}},+ BOOKTITLE = "Resourceful Language Technology: Festschrift in Honor of Anna Sågvall Hein",+ PUBLISHER = {{University of Uppsala}},+ note = {\url{http://publications.uu.se/abstract.xsql?dbid=8933}},+ YEAR = {2008},+ PAGES = {130-148}+ }++@Article{Ranta91b,+ author = "Aarne Ranta",+ title = {Intuitionistic categorial grammar},+ journal = {{Linguistics and Philosophy}},+ year = {1991},+ volume = {14},+ pages = {203--239}+}++@Book{Ranta94,+ author = {A. Ranta},+ title = {{Type Theoretical Grammar}},+ publisher = {Oxford University Press},+ year = {1994}+}++@Book{ranta-1994,+ author = {A. Ranta},+ title = {{Type Theoretical Grammar}},+ publisher = {{Oxford University Press}},+ year = {1994}+}++@InProceedings{Ranta94a,+ author = "Aarne Ranta",+ title = "Type Theory and the Informal Language of Mathematics",+ booktitle = "Selected papers from TYPES'93: + Int.\ Workshop on Types, Nijmegen, The Netherlands",+ series = lncs,+ publisher = spv,+ volume = "806",+ pages = "352--365",+ year = "1994",+ editor = "Hendrik Barendregt and Tobias Nipkow"+}++@Article{Ranta95c,+ author = "Aarne Ranta",+ title = {Type-theoretical interpretation and generalization + of phrase structure grammar},+ journal = {{Bulletin of the IGPL}},+ year = {1995},+ volume = {3},+ pages = {319--342}+}++@InProceedings{Ranta95a,+ author = "Aarne Ranta",+ title = "Syntactic Categories in the Language of Mathematics",+ series = lncs,+ volume = "996",+ pages = "162--182",+ year = "1995",+ publisher = spv,+ booktitle = "Selected papers from TYPES'94: + Int.\ Workshop on Types for+ Proofs and Programs, Bastad, Sweden",+ editor = {Peter Dybjer and Bengt Nordstr\"{o}m and Jan Smith}+}++@InProceedings{ranta-1996,+ author = "A. Ranta",+ title = "Context-Relative Syntactic Categories and the+ Formalization of Mathematical Text",+ booktitle = "Selected papers from TYPES'95: Int.\ Workshop on Types for+ Proofs and Programs, Trento, Italy",+ publisher = spv,+ editor = "S. Berardi and M. Coppo",+ series = lncs,+ volume = 1158,+ pages = "231--248",+ year = "1996"+}++@inproceedings{ranta:torino,+ AUTHOR = {A. Ranta},+ TITLE = {Context-Relative Syntactic Categories + and the Formalization of Mathematical Text}, + BOOKTITLE = {{Types For Proofs and Programs}},+ EDITOR = {S. Berardi and M. Coppo},+ SERIES = {LNCS},+ NUMBER = {1158},+ PAGES = {231--248},+ PUBLISHER = {Springer-Verlag},+ YEAR = {1996}+ }++@Article{ranta-1997,+ author = "Aarne Ranta",+ title = {Structures grammaticales dans le fran\c{c}ais math\'{e}matique},+ journal = {Math\'{e}matiques, informatique et Sciences Humaines},+ year = {1997},+ volume = {138/139},+ pages = {5--56/5--36}+}++@article{ranta:paris,+ AUTHOR = {A. Ranta},+ TITLE = {{Structures grammaticales dans le fran\c{c}ais math\'ematique}},+ JOURNAL = {{Math\'ematiques, informatique et Sciences Humaines}},+ YEAR = {1997},+ NUMBER = {138, 139},+ PAGES = {5--56, 5--36}+ }++@Article{ranta-1998,+ author = "Aarne Ranta",+ title = "Syntactic Calculus with Dependent Types",+ journal = "Journal of Logic, Language, and Information",+ year = "1998",+ volume = "7",+ number = "4",+ pages = "413--431"+}++@InCollection{ranta-1998-regex,+ author = "Aarne Ranta",+ title = "A Multilingual Natural Language Interface to Regular+ Expressions",+ booktitle = "{FSMNLP'98}: International Workshop on Finite State+ Methods in Natural Language Processing",+ publisher = "Bilkent University, Ankara",+ year = "1998",+ editor = "Lauri Karttunen and K. Oflazer",+ pages = "79--90"+}++@InProceedings{DAC98a,+ author = "Matthew B. Dwyer and George S. Avrunin and James C.+ Corbett",+ title = "Property Specification Patterns for Finite-State+ Verification",+ pages = "7--15",+ ISBN_ISSN = "0-89791-954-8",+ editor = "Mark Ardis",+ booktitle = "Proc.\ 2nd Workshop on Formal Methods in+ Software Practice ({FMSP}-98)",+ month = mar,+ publisher = "ACM Press",+ address = "New York",+ year = "1998"+}++@InProceedings{ranta98:regexp,+ author = {A. Ranta},+ title = {A Multilingual Natural-Language Interface to Regular Expressions},+ booktitle = {Proceedings of the International Workshop on Finite State+ Methods in Natural Language Processing},+ pages = {79--90},+ year = 1998,+ editor = {L. Karttunen and K. Oflazer},+ address = {Ankara},+ organization = {Bilkent University}+}++@InProceedings{MaenpaaRanta99,+ author = {P. Mäenpää and A. Ranta},+ title = {The type theory and type checker of {GF}},+ booktitle = {{PLI-1999: + Workshop on Logical Frameworks and Meta-languages, + Paris, France}},+ year = {1999}+}++@Manual{Ranta99a,+ title = {Grammatical Framework Syntax and Semantic},+ author = {Aarne Ranta},+ organization = {Xerox Research Centre Europe},+ address = {Grenoble},+ month = feb,+ year = {1999},+ note = {URL: \texttt{www.xrce.xerox.com/research/mltt/gf/doc/gf-language/index.html}}+}++@Manual{Ranta99b,+ title = {Grammatical Framework Tutorial},+ author = {A. Ranta},+ organization = {Xerox Research Centre Europe},+ address = {Grenoble},+ month = feb,+ year = 1999,+ note = {URL: \texttt{www.xrce.xerox.com/research/mltt/gf/doc/gf-tutorial/index.html}}+}++@Manual{Ranta99c,+ title = {Grammatical Framework Implementation and Interfaces. + {R}evised for {GF} Version 0.5},+ author = {Aarne Ranta},+ organization = {Department of Computing Science,+ Chalmers University of Technology},+ month = jun,+ year = {1999},+ note = {URL: \texttt{www.cs.chalmers.se/\~{}aarne/GF/pub/doc/gf-implementation/index.html}}}++@InProceedings{dymetman-al-2000,+ author = {M.\ Dymetman and V.\ Lux and A.\ Ranta},+ title = {{XML} and Multilingual Document Authoring: Convergent Trends},+ booktitle = {Proc.\ Computational Linguistics COLING, Saarbr\"{u}cken, Germany},+ pages = {243-249},+ year = {2000},+ publisher = {International Committee on Computational Linguistics}+}++@InProceedings{hallgren-ranta-2000,+ author = {T.\ Hallgren and A.\ Ranta},+ title = {{An Extensible Proof Text Editor}},+ editor = {M. Parigot and A. Voronkov},+ booktitle = {{LPAR-2000}},+ year = {2000},+ series = {{LNCS/LNAI}},+ volume = {1955},+ publisher = {Springer},+ note = {\url{http://www.cse.chalmers.se/~aarne/articles/lpar2000.pdf}},+ pages = {70--84}+}+++@TechReport{hallgren-2000,+ author = {T. Hallgren},+ title = {The Correctness of Insertion Sort},+ institution = {Chalmers University of Technology, + Department of Computer Science},+ year = {2000},+ note = {URL: \verb!http://www.cse.chalmers.se/~hallgren/Papers/insertion_sort.ps!}+}++@Misc{gf-homepage,+ author = {A. Ranta and K. Angelov and T. Hallgren},+ title = {{\mbox{Grammatical Framework Homepage}}},+ howpublished = {\verb!http://grammaticalframework.org!},+ documentURL = {"http://www.cs.chalmers.se/~aarne/GF/"},+ year = {2000--2009}+}++@InProceedings{HaehnleRanta01a,+ author = {R.\ H\"{a}hnle and A.\ Ranta},+ title = {Connecting {OCL} with the Rest of the World},+ booktitle = {{ETAPS}/{WTUML},+ {Genova}, {Italy}},+ year = {2001},+ editor = {J. Whittle},+ url = {http://www.cs.chalmers.se/~reiner/papers/wtuml.ps.gz}+}++@InProceedings{krijo-aarne,+ author = "K. Johannisson and A. Ranta",+ title = "Formal Verification of Multilingual Instructions",+ booktitle = "The Joint Winter Meeting of Computing Science and+ Computer Engineering",+ publisher = "Chalmers University of Technology",+ year = "2001"+}++@InProceedings{ranta-cooper-icos,+ author = {A. Ranta and R. Cooper},+ title = {Dialogue Systems as Proof Editors},+ booktitle = {{IJCAR}/{ICoS-3}},+ year = 2001,+ address = {{Siena}, {Italy}}+}++@Misc{italiano,+ author = "A. Ranta",+ title = {1+n representations of {Italian} morphology},+ howpublished = {Essays dedicated to {Jan von Plato} + on the occasion of his 50th birthday,+ \verb6http://www.valt.helsinki.fi/kfil/jvp50.htm6}, + documentURL = "\verb6http://www.valt.helsinki.fi/kfil/jvp50.htm6",+ year = 2001+}++@InProceedings{hahnle-al-2002,+ author = {R.\ Hähnle and K.\ Johannisson and A.\ Ranta},+ title = {{An Authoring Tool for Informal and Formal Requirements Specifications}},+ booktitle = {{Fundamental Approaches to Software Engineering}},+ editor = {R.-D. Kutsche and H. Weber},+ year = {2002},+ series = {LNCS},+ volume = {2306},+ pages = {233--248},+ publisher = {Springer}+}++@Misc{bnfc,+ author = {M. Forsberg and A. Ranta},+ title = {{\mbox{BNF Converter Homepage}}},+ howpublished = {\verb!http://www.cs.chalmers.se/~markus/BNFC/!},+ documentURL = {"http://www.cs.chalmers.se/~markus/BNFC/"},+ year = {2002--2004}+}++@InProceedings{khegai-al-2003,+ author = {J.\ Khegai and B.\ Nordström and A.\ Ranta},+ title = {{Multilingual Syntax Editing in GF}},+ booktitle = {{Intelligent Text Processing and Computational Linguistics+ (CICLing-2003), Mexico City, February 2003}},+ year = {{2003}},+ series = {LNCS},+ volume = {2588},+ editor = {A. Gelbukh},+ note = {\url{http://www.cs.chalmers.se/~aarne/articles/mexico.ps.gz}},+ pages = {453--464},+ publisher = {Springer-Verlag}+}++@ARTICLE{ranta-2004,+ AUTHOR = "A. Ranta",+ TITLE = {{Grammatical Framework: A Type-Theoretical Grammar Formalism}},+ JOURNAL = {{The Journal of Functional Programming}},+ pages={145--189},+ volume={14(2)},+ note = {\url{http://www.cse.chalmers.se/~aarne/articles/gf-jfp.pdf}},+ YEAR = {2004}+ }++@Article{ranta:compsem,+ author = {A. Ranta},+ title = {{Computational Semantics in Type Theory}},+ journal = {{Mathematics and Social Sciences}},+ volume = {165},+ pages = {31--57},+ year = {2004}+}++@InProceedings{numerals,+ AUTHOR = {H. Hammarstr\"{o}m and A. Ranta},+ TITLE = {{Cardinal Numerals Revisited in GF}}, + booktitle = {{Workshop on Numerals in the World's Languages, + Dept. of Linguistics, Max Planck Institute for Evolutionary Anthropology, + Leipzig}},+ note = {\url{http://www.cs.chalmers.se/%7Eharald2/numabstract.pdf}},+ year = {{2004}}+ }++@InProceedings{peb-parsing,+ author = {P. Ljungl\"of},+ title = {{Grammatical Framework and Multiple Context-Free Grammars}},+ booktitle = {{Proceedings of Formal Grammar, Nancy, August 2004}},+ editor = {G. Jaeger and P. Monachesi and G. Penn and S. Wintner},+ pages = {77--90},+ year = {2004}+}++@PhdThesis{ljunglof-2004,+ author = {P. Ljungl\"of},+ title = {{The Expressivity and Complexity of Grammatical Framework}},+ school = {{Dept.\ of Computing Science,+ Chalmers University of Technology and + Gothenburg University}},+ note = {\url{http://www.cs.chalmers.se/~peb/pubs/p04-PhD-thesis.pdf}},+ year = {2004}+}++@article{ranta-cooper,+ author = {A. Ranta and R. Cooper},+ title = {{Dialogue Systems as Proof Editors}},+ journal = {{Journal of Logic, Language and Information}},+ year = 2004+}++@inproceedings{FM,+ title = {{Functional Morphology}},+ author = {M. Forsberg and A. Ranta},+ booktitle = {{ICFP 2004, Showbird, Utah}},+ pages = {213-223},+ note = {\url{http://www.cs.chalmers.se/~markus/FM/FM_ICFP2004.pdf}},+ year = {2004}+}++@inproceedings{gf-esslli,+ AUTHOR = {A. Ranta},+ TITLE = {{Grammatical Framework Tutorial}},+ BOOKTITLE = {{ESSLLI 2003 Course Material I}},+ PUBLISHER = {{Kurt G\"odel Society}},+ pages = {1--86},+ YEAR = {2004}+ }++@techreport{bringert,+ author = {B. Bringert},+ title = {{Embedded Grammars}},+ institution = {Department of Computing Science, Chalmers University+ of Technology},+ type = {{MSc Thesis}},+ year = {2004}+}++@InProceedings{burke-johannisson-2005,+ author = {D. A. Burke and K. Johannisson},+ title = {{Translating Formal Software Specifications to Natural + Language / A Grammar-Based Approach}},+ booktitle = {{Logical Aspects of Computational Linguistics (LACL 2005)}},+ editor = {{P. Blache and E. Stabler and J. Busquets and R. Moot}},+ year = {2005},+ series = {{LNCS/LNAI}},+ volume = {3492},+ note = {\url{http://www.springerlink.com/content/?k=LNCS+3492}},+ pages = {51--66},+ publisher = {Springer}+}++@InProceedings{ranta-nancy,+ author = {A. Ranta},+ title = {Resource Grammars for Dialogue Systems and Grammar Writing by Examples},+ booktitle = {{TALK Meeting}},+ year = 2005,+ address = {{Nancy}}+}++@inproceedings{burden05:lcfrs,+ address = {Vancouver, British Columbia},+ author = {Burden, H\r{a}kan and Ljungl\"{o}f, Peter },+ booktitle = {{P}roceedings of the {N}inth {I}nternational {W}orkshop on {P}arsing {T}echnology},+ citeulike-article-id = {2349372},+ keywords = {grammars},+ pages = {11--17},+ posted-at = {2008-02-07 15:00:18},+ priority = {0},+ publisher = {Association for Computational Linguistics},+ title = {{P}arsing {L}inear {C}ontext-{F}ree {R}ewriting {S}ystems},+ url = {http://www.aclweb.org/anthology/W/W05/W05-1502},+ year = {2005}+}++@PhdThesis{johannisson-2005,+ author = {K. Johannisson},+ title = {{Formal and Informal Software Specifications}},+ school = {{Dept.\ of Computing Science,+ Chalmers University of Technology and + Gothenburg University}},+ year = {2005}+}++@inproceedings{bringert-al-2005,+ author = {Bj\"orn Bringert and Robin Cooper + and Peter Ljungl\"of and Aarne Ranta},+ title = {Multimodal Dialogue System Grammars},+ booktitle = {Proceedings of DIALOR'05, Ninth Workshop on + the Semantics and Pragmatics of Dialogue},+ month = {June},+ year = {2005},+ pages = {53--60},+ location = {Nancy, France},+ url = {http://www.cs.chalmers.se/~bringert/publ/mm-grammars-dialor/mm-grammars-dialor.pdf}+}++@InProceedings{forsberg-al-2006,+ AUTHOR = {M. Forsberg and H. Hammarstr\"{o}m and A. Ranta},+ TITLE = {{Morphological Lexicon Extraction from Raw Text Data}},+ booktitle = {{FinTAL 2006}},+ year = {{2006}},+ series = {{LNCS/LNAI}},+ volume = {4139},+ editor = {T. Salakoski}+ }++@Misc{webalt,+ author = {{WebALT Consortium}},+ title = {{WebALT Online Manual: How-to guide for creating+multilingual mathematical exercises}},+ howpublished = {WebALT Deliverable 7.4, \url{http://webalt.math.helsinki.fi/content/e16/e301/e846/Deliverable7.4_eng.pdf}},+ year = {2006}+}++@book{beckert-al-2006,+ AUTHOR = {B. Beckert and R. Hähnle and P. Schmitt},+ TITLE = {{Verification of Object-Oriented Software: The KeY Approach}},+ YEAR = {2006},+ series = lncs,+ volume = {4334}, + PUBLISHER = {{Springer-Verlag}}+}++@inproceedings{caprotti-2006,+ title = {{WebALT! Deliver Mathematics Everywhere}},+ author = {O. Caprotti},+ note = {\url{http://webalt.math.helsinki.fi/content/e16/e301/e512/PosterDemoWebALT_eng.pdf}},+ booktitle = {{Proceedings of SITE 2006. Orlando March 20-24}},+ year = {2006}+}++@inproceedings{eldada,+ title = {{Implementing an Open Source Arabic Resource Grammar in GF}},+ author = {A. El Dada and A. Ranta},+ booktitle = {{20th Arabic Linguistics Symposium. Western Michigan University March 3-5 2006}},+ year = {2006}+}++@inproceedings{jonson-2006,+ AUTHOR = {Rebecca Jonson},+ TITLE = {{Generating statistical language models from interpretation grammars in dialogue system}},+ BOOKTITLE = {{Proceedings of EACL06, Trento, Italy}},+ YEAR = {2006}+ }++@inproceedings{khegai-acl,+ title = {{GF Parallel Resource Grammars and Russian}},+ author = {J. Khegai},+ booktitle = {{Coling/ACL 2006}},+ pages = {475--482},+ year = {2006}+}++@inproceedings{lemon06:dude,+ author = {Lemon, Oliver and Liu, Xingkun },+ booktitle = {{E}{A}{C}{L} 2006, 11st {C}onference of the {E}uropean {C}hapter of the {A}ssociation for {C}omputational {L}inguistics},+ citeulike-article-id = {1167605},+ keywords = {dialogue, gf},+ posted-at = {2007-03-16 13:30:21},+ priority = {2},+ title = {{D}{U}{D}{E}: a {D}ialogue and {U}nderstanding {D}evelopment {E}nvironment, mapping {B}usiness {P}rocess {M}odels to {I}nformation {S}tate {U}pdate dialogue systems},+ url = {http://homepages.inf.ed.ac.uk/olemon/dude-final.pdf},+ year = {2006}+}++@inproceedings{nganga-africa,+ title = {{Multilingual content development for eLearning in Africa}},+ author = {W. Ng'ang'a},+ booktitle = {{1st Pan-African Conference on ICT for Development, Education and Training. + 24-26 May 2006, Addis Ababa, Ethiopia}},+ year = {2006}+}++@misc{ljunglof-al-2006,+ author = {P. Ljungl\"of and G. Amores and R. Cooper and D. Hjelm and O. Lemon and P. Manch\'on+ and G. P\'erez and A. Ranta},+ year = 2006,+ title = {{Multimodal Grammar Library}},+ note = {{TALK. Talk and Look: + Tools for Ambient Linguistic Knowledge. IST-507802. Deliverable 1.2b}.+ \url{http://www.talk-project.org/fileadmin/talk/publications_public/deliverables_public/TK_D1-2-2.pdf}}+ }++@techreport{humayoun,+ author = {M. Humayoun},+ title = {{Urdu Morphology, Orthography and Lexicon Extraction}},+ institution = {Department of Computing Science, Chalmers University+ of Technology},+ type = {{MSc Thesis}},+ year = {2006}+}++@inproceedings{khegai-mt,+ title = {{Grammatical Framework (GF) for MT in sublanguage domains}},+ author = {J. Khegai},+ booktitle = {{Proceedings of EAMT-2006 (11th Annual conference of the European Association for Machine Translation, Oslo, Norway}},+ pages = {95--104},+ year = {2006}+}++@PhdThesis{khegai-phd,+ author = {J. Khegai},+ title = {{Language Engineering in Grammatical Framework (GF)}},+ school = {{Dept.\ of Computing Science,+ Chalmers University of Technology and + University of Gothenburg}},+ note = {\url{http://www.cs.chalmers.se/~janna/Janna_Khegai_phd.pdf}},+ year = {2006}+}++@inproceedings{humayoun-caasl,+ title = {{Urdu Morphology, Orthography and Lexicon Extraction}},+ author = {M. Humayoun and H. Hammarström and A. Ranta},+ booktitle = {{CAASL-2: The Second Workshop on Computational Approaches to Arabic Script-based Languages, LSA 2007 Linguistic Institute, Stanford University, July 21-22, 2007}},+ year = {2007}+}++@ARTICLE{ranta-2007,+ AUTHOR = "A. Ranta",+ TITLE = {{Modular Grammar Engineering in GF}},+ JOURNAL = {{Research on Language and Computation}},+ volume = {5},+ pages = {133--158},+ note = {\url{http://www.cs.chalmers.se/~aarne/articles/multieng3.pdf}},+ YEAR = {2007} +}++@Book{KeYBook2007,+ editor = {Bernhard Beckert and Reiner H\"ahnle and Peter H. Schmitt},+ title = {Verification of Object-Oriented Software: The {KeY} Approach},+ series = {LNCS 4334},+ publisher = {Springer-Verlag},+ year = {2007}+}++@InProceedings{bringert-sigdial,+ author = {B. Bringert},+ title = {{Rapid Development of Dialogue Systems by Grammar Compilation}},+ booktitle = {{8th SIGdial Workshop on Discourse and Dialogue, Antwerp, Belgium, September 1--2, 2007}} ,+ year = 2007+}++@PhdThesis{forsberg-2007,+ author = {Markus Forsberg},+ title = {{Three Tools for Language Processing: BNF Converter, + Functional Morphology, and Extract}},+ school = {{Dept.\ of Computer Science and Engineering,+ Chalmers University of Technology and + Gothenburg University}},+ year = {2007}+}++@incollection{eldada-book,+ title = {{Implementing an Open Source Arabic Resource Grammar in GF}},+ author = {A. El Dada and A. Ranta},+ booktitle = {{Perspectives on Arabic Linguistics XX}},+ editor = {M.A. Mughazy},+ publisher = {{John Benjamin's}},+ pages = {209--232},+ year = {2007}+}++@inproceedings{bringert-speechgram,+ title = {{Speech Recognition Grammar Compilation in Grammatical Framework}},+ author = {B. Bringert},+ booktitle = {{SPEECHGRAM 2007: ACL Workshop on Grammar-Based Approaches to Spoken + Language Processing, June 29, 2007, Prague}},+ note = {\url{http://www.cs.chalmers.se/~bringert/publ/gf-srg/gf-srg.pdf}},+ year = {2007}+}++@inproceedings{gf-srg,+ author = {Bj\"orn Bringert},+ title = {{Speech Recognition Grammar Compilation in Grammatical Framework}},+ booktitle = {{Proceedings of the Workshop on Grammar-Based Approaches to Spoken Language Processing}},+ month = jun,+ year = {2007},+ pages = {1--8},+ location = {{Prague, Czech Republic}},+ publisher = {{Association for Computational Linguistics}}+}++@inproceedings{perera-ranta-2007,+ title = {{Dialogue System Localization with the GF Resource Grammar Library}},+ author = {N. Perera and A. Ranta},+ booktitle = {{SPEECHGRAM 2007: ACL Workshop on Grammar-Based Approaches to Spoken + Language Processing, June 29, 2007, Prague}},+ note = {\url{http://www.cs.chalmers.se/~aarne/articles/perera-ranta.pdf}},+ year = {2007}+}++@inproceedings{ranta-features,+ title = {{Features in Abstract and Concrete Syntax}},+ author = {A. Ranta},+ booktitle = {{NODALIDA Workshop on Typed Feature Structure Grammars, Tartu, 24 May 2007}},+ note = {\url{http://www.cs.chalmers.se/~aarne/articles/ranta-tfsg2007.pdf}},+ year = {2007}+}+++@INPROCEEDINGS{dannells,+ AUTHOR = {Dana Dann\'{e}lls},+ TITLE = {{Generating Tailored Texts for Museum Exhibits}},+ BOOKTITLE = {{Proceedings of the 6th edition of LREC. + The 2nd Workshop on Language Technology for Cultural Heritage (LaTeCH 2008), + Marrakech, Morocco}},+ PAGES = {17--20},+ YEAR = {2008},+ note = {\url{http://spraakdata.gu.se/svedd/pub/latech08.pdf}}+}++@InProceedings{angelov-gotal,+ author = {K. Angelov},+ title = {{Type-Theoretical Bulgarian Grammar}},+ booktitle = {{Advances in Natural Language Processing (GoTAL 2008)}} ,+ year = 2008,+ editor = {B. Nordstr\"om and A. Ranta},+ series = {{LNCS/LNAI}},+ note = {\url{http://www.springerlink.com/content/978-3-540-85286-5/}},+ volume = 5221,+ pages = {52--64}+}++@InProceedings{larsson-gotal,+ author = {S. Larsson and P. Ljungl\"of},+ title = {{A grammar formalism for specifying ISU-based dialogue systems}},+ booktitle = {{Advances in Natural Language Processing (GoTAL 2008)}} ,+ year = 2008,+ editor = {B. Nordstr\"om and A. Ranta},+ series = {{LNCS/LNAI}},+ note = {\url{http://www.springerlink.com/content/978-3-540-85286-5/}},+ volume = 5221,+ pages = {303--314}+}++@InProceedings{moises-gotal,+ title = {{Interactive Multilingual Web Applications with Grammarical Framework}},+ author = {M. S. {Meza Moreno} and B. Bringert},+ booktitle = {{Advances in Natural Language Processing (GoTAL 2008)}} ,+ year = 2008,+ editor = {B. Nordstr\"om and A. Ranta},+ series = {{LNCS/LNAI}},+ note = {\url{http://www.springerlink.com/content/978-3-540-85286-5/}},+ volume = 5221,+ pages = {336--347}+}++@Misc{bringert-2008c,+ author = {B. Bringert},+ title = {{Semantics of the GF Resource Grammar Library}},+ howpublished = {{Report, Chalmers University}},+ note = {\url{http://www.cse.chalmers.se/alumni/bringert/darcs/mosg/}},+ year = {2008}+}++@misc{cooper-anna,+ author = {R. Cooper},+ year = 2008,+ title = "The Abstract-Concrete Syntax Distinction and Unification in Multilingual Grammar",+ note = {\url{http://publications.uu.se/abstract.xsql?dbid=8933}}+ }++@Misc{bringert-continuations,+ author = {B. Bringert},+ title = {{Delimited Continuations, Applicative Functors and Natural Language Semantics}},+ howpublished = {{Technical Report, Chalmers University of Technology}},+ year = {2009},+ note = {\url{http://digitalgrammars.com/gf/demos/mosg/}}+}+++@article{pgf,+ author = {K. Angelov and B. Bringert and A. Ranta},+ title = {{PGF: A Portable Run-Time Format for Type-Theoretical Grammars}},+ year = 2009,+ journal = {{Journal of Logic, Language and Information}},+ note = {To appear}+}++@inproceedings{angelov-2009,+ AUTHOR = {Krasimir Angelov},+ TITLE = {{Incremental Parsing with Parallel Multiple Context-Free Grammars}},+ BOOKTITLE = {{Proceedings of EACL'09, Athens}},+ YEAR = {2009}+ }++@inproceedings{gf-attempto,+ AUTHOR = {K. Angelov and A. Ranta},+ TITLE = {{Implementing Controlled Languages in GF}},+ BOOKTITLE = {{CNL-2009, + Controlled Natural Language Workshop, Marettimo, Sicily, 2009}},+ YEAR = {2009}+ }++@inproceedings{ranta-2009a,+ title = {{Grammars as Software Libraries}},+ author = {A. Ranta},+ booktitle = {{From Semantics to Computer Science. Essays in Honour of Gilles Kahn}},+ editor = {Y. Bertot and G. Huet and J-J. L\'evy and G. Plotkin},+ publisher = {{Cambridge University Press}},+ note = {\url{http://www.cse.chalmers.se/~aarne/articles/libraries-kahn.pdf}},+ pages = {281--308},+ year = {2009}+}++@article{ranta-2009,+ author = {A. Ranta},+ title = {{The GF Resource Grammar Library}},+ year = 2009,+ journal = {{Linguistics in Language Technology}},+ volume = {2},+ note = {\url{http://elanguage.net/journals/index.php/lilt/article/viewFile/214/158}},+}+++@misc{saldo,+ author = {L. Borin and M. Forsberg and L. L\"onngren},+ year = 2009,+ title = {{SALDO 1.0 (Svenskt associationslexikon version 2)}},+ note = {{Spr\aa kbanken, G\"oteborgs universitet.+ \url{http://spraakbanken.gu.se/personal/markus/publications/saldo_1.0.pdf}}}+ }++@inproceedings{angelov-enache-2010,+ title = {{Typeful Ontologies with Direct Multilingual Verbalization.}},+ author = {K. Angelov and R. Enache},+ booktitle = {{CNL 2010, Controlled Natural Language}},+ editor = {N. Fuchs and M. Rosner},+ year = {2010}+}++@Book{ranta-2010,+ author = {Aarne Ranta},+ title = {{Grammatical Framework:+ Programming with Multilingual Grammars}},+ publisher = {{CSLI Publications}},+ year = {2010},+ note = "to appear"+}++@Book{ranta-2011,+ author = {Aarne Ranta},+ title = {{Grammatical Framework:+ Programming with Multilingual Grammars}},+ publisher = {{CSLI Publications}},+ year = {2011},+ address = "Stanford",+ note = {{ISBN-10: 1-57586-626-9 (Paper), 1-57586-627-7 (Cloth)}}+}+++++%%%%%%%%%%%%% other papers++@inproceedings{mccarthy62towards,+ author = "J.\ McCarthy",+ title = "Towards a mathematical science of computation",+ booktitle = "Proceedings of the Information Processing Cong. 62",+ month = "August",+ publisher = "North-Holland",+ address = "Munich, West Germany",+ pages = "21--28",+ year = "1962"+}++@BOOK{rei48,+ AUTHOR = "Reichenbach, Hans",+ TITLE = "Elements of Symbolic Logic",+ PUBLISHER = {The MacMillan Company},+ ADDRESS = {New York},+ YEAR = {1948} }++@Article{bar-hillel-1953,+ author = "Y. Bar-Hillel",+ title = "A quasi-arithmetical notation for syntactic description",+ journal = {Language},+ year = 1953,+ volume = 29,+ pages = {27-58}+}++@Article{hockett,+ author = {C. F. Hockett},+ title = "Two Models of Grammatical Description", + journal = "Word",+ year = 1954,+ volume = 10,+ pages = {210--233}+}++@article{swadesh,+ author = {Morris Swadesh},+ title = {{Towards Greater Accuracy in Lexicostatistic Dating}},+ journal = {{International Journal of American Linguistics}},+ volume = {21},+ year = {1955},+ pages = {121--137}+ }++@BOOK{chomsky,+ AUTHOR = "Chomsky, N.",+ TITLE = "Syntactic Structures",+ PUBLISHER = {Mouton},+ ADDRESS = {The Hague},+ YEAR = {1957} }++@ARTICLE{lambek,+ AUTHOR = "J. Lambek",+ TITLE = "The mathematics of sentence structure",+ JOURNAL = {{American Mathematical Monthly}},+ VOLUME = {65},+ PAGES = {154-170},+ YEAR = {1958} +}++@Article{mccarthy,+ author = {J. McCarthy},+ title = {{Recursive Functions of Symbolic Expressions and their+ Computation by Machine, part I}},+ journal = {{Communications of the ACM}},+ volume = {3},+ pages = {184--195},+ year = {1960}+}++@Book{nssk,+ editor = {M. Sadeniemi},+ title = {{Nykysuomen sanakirja}},+ publisher = {{WSOY}},+ year = {1961}+}++@InProceedings{curry-1961,+ AUTHOR = "H. B. Curry",+ TITLE = "Some logical aspects of grammatical structure",+ EDITOR = "Jakobson, Roman",+ BOOKTITLE = {{Structure of Language and its+ Mathematical Aspects: Proceedings of the Twelfth Symposium+ in Applied Mathematics}},+ PUBLISHER = {American Mathematical Society},+ YEAR = {1961}, + PAGES = {56--68}+}++@BOOK{diderichsen-1962,+ AUTHOR = "Diderichsen, Paul",+ TITLE = "Elementaer dansk grammatik",+ ADDRESS = {Kobenhavn},+ YEAR = {1962} }++@Article{boehm-p,+ author = {C. B\"{o}hm},+ title = {{On a family of Turing machines and the related programming language}},+ journal = {{ICC Bulletine}},+ year = 1964,+ volume = 3,+ pages = {185-194}+}++@Article{LR,+ author = {D. Knuth},+ title = {On the translation of languages from left to right}, + journal = {Information and {Control}},+ year = 1965,+ volume = 8,+ pages = {607--639}+}++@BOOK{prawitz,+ AUTHOR = "D. Prawitz",+ TITLE = {{Natural Deduction}},+ PUBLISHER = {Almqvist \& Wiksell},+ ADDRESS = {Stockholm},+ YEAR = {1965} }++@ARTICLE{landin,+ AUTHOR = "P. Landin",+ TITLE = "The Next 700 Programming Languages",+ JOURNAL = {{Communications of the ACM}},+ VOLUME = {9},+ PAGES = {157--166},+ YEAR = {1966} +}++@PHDTHESIS{ross-1967,+ AUTHOR = {J. Ross},+ YEAR = 1967,+ TITLE = {{Constraints on Variables in Syntax}},+ SCHOOL = {{Massachusetts Institute of Technology}}+}++@Article{knuth-1968, + author = "D. Knuth",+ title = "Semantics of Context-Free Languages", + journal = {Mathematical {Systems} {Theory}},+ year = 1968,+ volume = 2,+ pages = {127--145}+}++@Book{lyons-1968,+ author = {J. Lyons},+ title = {{Introduction to Theoretical Linguistics}},+ publisher = {{Cambridge University Press}},+ year = {1968}+}++@ARTICLE{scott-str,+ AUTHOR = "D. S. Scott and C. Strachey",+ TITLE = "Toward a mathematical semantics for computer languages",+ JOURNAL = {Microwave Research Institute Symposia Series},+ VOLUME = {21},+ PAGES = {19--46},+ YEAR = {1970} }++@Article{earley,+ author = "J. Earley",+ title = "An efficient context-free parsing algorithm",+ journal = {Communications of the {ACM}},+ year = 1970,+ volume = 13,+ number = 2,+ pages = {94--102}+}++@INCOLLECTION{scott,+ AUTHOR = "D. S. Scott",+ TITLE = "Advice on modal logic",+ booktitle = {Philosophical Problems in Logic},+ EDITOR = {K.\ Lambert},+ publisher = {D. Reidel},+ YEAR = {1970} }++@Article{Wirth,+ author = "N. Wirth",+ title = "Program Development by Stepwise Refinement", + journal = "Communications of the ACM",+ year = 1971,+ volume = 14,+ pages = {221--227}+}++@Article{Parnas,+ author = {D. Parnas},+ title = {{On the Criteria To Be Used in Decomposing Systems into Modules}},+ journal = {{Communications of the ACM}},+ volume = {15},+ pages = {1053--1058},+ year = {1972}+}++@BOOK{montague-1974,+ AUTHOR = "Montague, R.",+ TITLE = "Formal Philosophy",+ NOTE = {Collected papers edited by Richmond Thomason},+ PUBLISHER = {Yale University Press},+ ADDRESS = {New Haven},+ YEAR = {1974} }++@ARTICLE{partee,+ AUTHOR = {B. Partee},+ TITLE = {Montague grammar and transformational grammar},+ JOURNAL = {{Linguistic Inquiry}},+ VOLUME = {6},+ PAGES = {203--300},+ YEAR = {1975} }++@TechReport{johnson-yacc,+ author = {S. C. Johnson},+ title = {{Yacc --- yet another compiler compiler}},+ institution = {{AT \& T Bell Laboratories, Murray Hill, NJ}},+ year = {1975},+ number = {{CSTR-32}}+}++@inproceedings{donzeau-gouge-al-1975,+ author = "V. Donzeau-Gouge and G. Huet and G. Kahn and B. Lang and J.~J. Levy",+ title = {A structure-oriented program editor: + a first step towards computer assisted programming},+ booktitle = {{International Computing Symposium ({ICS'75})}},+ year = {1975}+}++@Book{karlsson-1977,+ author = {F. Karlsson},+ title = {{Finsk grammatik}},+ publisher = {{Suomalaisen Kirjallisuuden Seura}},+ year = {1977}+}++@INCOLLECTION{seelybrown,+ AUTHOR = "R. R. Burton and J. S. Brown",+ TITLE = "Semantic Grammar: A technique for constructing natural language interface to instructional systems",+ BOOKTITLE = "BBN Report 3587",+ PUBLISHER = {{Bolt, Beranek, and Newman, Inc.}},+ ADDRESS = {{Cambridge, Ma.}},+ YEAR = {1977}+}++@book{jackendoff,+ AUTHOR = {R. Jackendoff},+ TITLE = {{X-Bar Syntax: A Study of Phrase Structure}},+ YEAR = {1977},+ PUBLISHER = {{MIT Press}}+}++@ARTICLE{Milner78atheory,+ author = {Robin Milner},+ title = {A theory of type polymorphism in programming},+ journal = {Journal of Computer and System Sciences},+ year = {1978},+ volume = {17},+ pages = {348--375}+}++@ARTICLE{fri-war,+ AUTHOR = "Friedman, J. and D. Warren",+ TITLE = "A parsing method for {Montague} grammar",+ JOURNAL = {Linguistics and Philosophy},+ VOLUME = {2},+ PAGES = {347-372},+ YEAR = {1978} }++@Article{huet-lang,+ author = {G. Huet and B. Lang},+ title = {Proving and applying program transformations expressed + with second-order patterns}, + journal = {{Acta Informatica}},+ year = 1978,+ volume = 11+}++@Book{hellberg,+ author = {S. Hellberg},+ title = {{The Morphology of Present-Day Swedish}},+ publisher = {{Almqvist \& Wiksell}},+ year = {1978}+}++@InProceedings{brodda-karlsson,+ author = {B. Brodda and F. Karlsson},+ title = {{An Experiment with Automatic Morphological Analysis of Finnish}},+ series = {{Papers from the Institute of Linguistics, University of Stockholm}},+ volume = 40,+ year = 1978+}++@InProceedings{saghein-1978,+ author = "Anna {S\aa gvall Hein}",+ title = {{Finnish Morphological Analysis in the Reversible Grammar System}},+ booktitle = {{COLING 78, Information Abstracts}},+ year = {1978}+}++@BOOK{dowty-1979,+ AUTHOR = "Dowty, D",+ TITLE = "Word Meaning and Montague Grammar",+ PUBLISHER = {D. Reidel},+ ADDRESS = {Dordrecht},+ YEAR = {1979} }++@Book{hopcroft,+ author = {J. Hopcroft and J. Ullman},+ title = {{Introduction to Automata Theory, Languages, and Computation}},+ publisher = {Addison-Wesley},+ year = 1979+}++@ARTICLE{dcg,+ AUTHOR = "F. Pereira and D. Warren",+ TITLE = "Definite clause grammars+ for language analysis---a survey of the formalism and a+ comparison with augmented transition networks",+ JOURNAL = {{Artificial Intelligence}},+ VOLUME = {13},+ PAGES = {231--278},+ YEAR = {1980} }++@ARTICLE{koskenniemi-1980,+ AUTHOR = "Kimmo Koskenniemi",+ TITLE = "On Automatic Lemmatization of Finnish",+ JOURNAL = {{Fenno-Ugrica Suecana}},+ VOLUME = {3},+ PAGES = {27--44},+ YEAR = {1980} }++@ARTICLE{saghein-1980,+ AUTHOR = "Anna {S\aa gvall Hein}",+ TITLE = "An Outline of a Computer Model of Finnish Word Recognition",+ JOURNAL = {{Fenno-Ugrica Suecana}},+ VOLUME = {3},+ PAGES = {7--26},+ YEAR = {1980} }++@article{pereira-warren,+ AUTHOR = "F. Pereira and D. Warren",+ TITLE = "Definite Clause Grammars for Language Analysis",+ JOURNAL = {Artificial {Intelligence}},+ YEAR = {1980},+ NUMBER = {13},+ PAGES = {231--278}+ }++@Article{patr,+ author = {L. Karttunen},+ title = {PATR}, + journal = ???,+ year = 1981,+ volume = 0,+ pages = 0+}++@Article{teitelbaum-reps-1981,+ author = "T. Teitelbaum and T. Reps",+ title = {The {Cornell} {Program} {Synthesizer}: a syntax-directed+ programming environment},+ journal = {Commun. {ACM}},+ year = "1981",+ volume = "24",+ number = "9",+ pages = {563-573}+}++@Book{barendregt-1981,+ author = "H. Barendregt",+ title = {{The Lambda Calculus. Its Syntax and Semantics}},+ publisher = "North-Holland",+ year = 1981+}++@Book{cooper,+ author = {R. Cooper},+ title = {Quantification and Syntactic Theory},+ publisher = {D. Reidel},+ year = {1981}+}++@INCOLLECTION{friedman,+ AUTHOR = "Friedman, J.",+ TITLE = "Expressing logical formulas in natural language",+ EDITOR = "J. Groenendijk and T. Janssen and M. Stokhof",+ BOOKTITLE = "Formal Methods in the Study of Language, Part 1",+ PUBLISHER = {Mathematisch Centrum},+ ADDRESS = {Amsterdam},+ YEAR = {1981}, + PAGES = {113-130}}++@article{kamp:drt,+ AUTHOR = {H. Kamp},+ TITLE = {{ A theory of truth and semantic representation}},+ EDITOR = {{J. Groenendijk, T. Janssen, and M. Stokhof}},+ BOOKTITLE = {{Formal Methods in the Study of Language, Part 1}},+ YEAR = {1981},+ PUBLISHER = {{Mathematisch Centrum, Amsterdam}},+ PAGES = {277--322}+ }++@Article{pereira,+ author = {H.~D. Warren and F. Pereira},+ title = {An Efficient Easily Adaptable System for Interpreting Natural + Language Queries},+ year = {1982},+ journal = {{Computational Linguistics}},+ volume = 8,+ pages = {110-122}+}++@Book{lfg,+ editor = "J. Bresnan",+ title = {{The Mental Representation of Grammatical Relations}}, + publisher = {{MIT Press}},+ year = 1982+}++@INCOLLECTION{mar82,+ AUTHOR = "{Martin-L\"{o}f}, Per",+ TITLE = "Constructive mathematics and computer programming",+ EDITOR = "Cohen and Los and Pfeiffer and Podewski",+ BOOKTITLE = "Logic, Methodology and Philosophy of Science VI",+ PUBLISHER = {North-Holland},+ ADDRESS = {Amsterdam},+ YEAR = {1982},+ PAGES = {153-175}}++@Article{metal,+ author = "G. Kahn and B. Lang and B. Mélèse and E. Morcos",+ title = "Metal: a formalism to specify formalisms",+ journal = {Science of {C}omputer {P}rogramming},+ year = 1983,+ volume = 3,+ pages = {151--188}+}++@PhdThesis{koskenniemi-1983,+ author = {Kimmo Koskenniemi},+ title = {{Two-Level Morphology: A General Computational Model for + Word-Form Recognition and Production}},+ school = {{University of Helsinki}},+ year = 1983+}++@Book{BarstowSandewall,+ author = {Barstow, D.~R., Shrobe, H.~E., and Sandewall, E.},+ title = {Interactive Programming Environments},+ publisher = {McGraw Hill},+ year = 1984+}++@Book{prolog,+ author = {W. F. Clocksin and C. S. Mellish},+ title = {{Programming in Prolog}},+ publisher = {Springer},+ year = {1984}+}++@book{martin-lof-1984,+ AUTHOR = {P. Martin-L\"{o}f},+ TITLE = {{Intuitionistic Type Theory}},+ ADDRESS = {Napoli},+ YEAR = {1984},+ PUBLISHER = {Bibliopolis}+}+@BOOK{curryfeys,+ AUTHOR = "Curry, H. B. and R. Feys",+ TITLE = "Combinatory Logic, Vol. 1",+ PUBLISHER = {North-Holland},+ ADDRESS = {Amsterdam},+ YEAR = {1958} }++@book{martin-lof:padova,+ AUTHOR = {P. Martin-L\"{o}f},+ TITLE = {{Intuitionistic Type Theory}},+ ADDRESS = {Napoli},+ YEAR = {1984},+ PUBLISHER = {Bibliopolis}+}++@BOOK{gazdar-1985,+ AUTHOR = "Gazdar, G. and E. Klein and G. Pullum and I. Sag",+ TITLE = "Generalized Phrase Structure Grammar",+ PUBLISHER = {Basil Blackwell},+ ADDRESS = {Oxford},+ YEAR = {1985} }++@InCollection{joshi,+ author = "A. Joshi",+ title = {Tree-Adjoining Grammars: How much context-sensitivity is required + to provide reasonable structural descriptions}, + booktitle = {{Natural Language Parsing}},+ year = 1985,+ editor = "D. Dowty and L. Karttunen and A. Zwicky",+ publisher = {Cambridge University Press},+ pages = {206--250}+}++@InProceedings{wadler,+ author = "P. Wadler",+ title = "How to replace failure by a list of successes",+ booktitle = {{Second International Conference on Functional + Programming Languages and Computer Architectures}},+ series = lncs,+ year = 1985,+ address = spv+}++@Book{shieber,+ author = "S. Shieber",+ title = {{An Introduction to Unification-Based Approaches to Grammars}},+ publisher = "University of Chicago Press",+ year = 1986+}++@book{constable,+ AUTHOR = {R. L. Constable},+ TITLE = {{Implementing Mathematics with the NuPRL Proof Development System}},+ YEAR = {1986},+ PUBLISHER = {Prentice-Hall}+}++@BOOK{ML-wik,+ AUTHOR = "{Wikstr\"{o}m}, {\AA ke}",+ TITLE = "Functional Programming Using Standard ML",+ PUBLISHER = {Prentice-Hall},+ ADDRESS = {London},+ YEAR = {1987} }++@book{pereira-shieber,+ AUTHOR = {F. Pereira and S. Shieber},+ TITLE = {{Prolog and Natural-Language Analysis}},+ ADDRESS = {Stanford},+ YEAR = {1987},+ PUBLISHER = {{CSLI}}+}++@inproceedings{TomitaCarbobell,+ author = {Masaru Tomita and+ Jaime G. Carbonell},+ title = {The Universal Parser Architecture for Knowledge-based Machine+ Translation},+ booktitle = {IJCAI},+ year = {1987},+ pages = {718-721},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@Article{Ranta88,+ author = "Aarne Ranta",+ title = {Propositions as games as types},+ journal = {Synthese},+ year = {1988},+ volume = {76},+ pages = {377--395}+}++@Article{discont,+ author = "H. Uszkoreit",+ title = "German word order", + journal = ???,+ year = 1988,+ volume = ???,+ pages = ???+}++@Book{KRC,+ author = {Brian Kernighan and Dennis Ritchie},+ title = {{The C Programming Language}},+ publisher = {{Prentice Hall}},+ year = 1988,+ note = {Second Edition}+}++@INCOLLECTION{steedman,+ AUTHOR = "Steedman, M.",+ TITLE = "Combinators and grammars",+ EDITOR = "R. Oehrle and E. Bach and D. Wheeler",+ BOOKTITLE = "Categorial Grammars and Natural Language Structures",+ PUBLISHER = {D. Reidel},+ ADDRESS = {Dordrecht},+ YEAR = {1988}, + PAGES = {417-442}}++@book{aho-ullman,+ AUTHOR = {A. Aho and R. Sethi and J. Ullman},+ TITLE = {{Compilers: Principles, Techniques, and Tools}},+ YEAR = {1988},+ PUBLISHER = {{Addison-Wesley}}+}++@Article{frost,+ author = "R. Frost and J. Launchbury",+ title = "Constructing natural language interpreters + in a lazy functional language",+ journal = {The {Computer} {Journal}},+ year = 1989,+ volume = 32,+ number = 2,+ pages = {108--121}+}++@PHDTHESIS{muskens-diss,+ AUTHOR = {Muskens, R.},+ YEAR = 1989,+ TITLE = {Meaning and {P}artiality},+ SCHOOL = {University of Amsterdam}+}++@article{Hughes89,+ AUTHOR = {John Hughes},+ TITLE = {Why Functional Programming Matters},+ JOURNAL = {Computer Journal},+ VOLUME = {32},+ NUMBER = {2},+ PAGES = {98--107},+ YEAR = {1989}+}++@Article{abrusci,+ author = "M. Abrusci",+ title = {{Noncommutative Intuitionistic Linear Propositional Logic}},+ journal = {{Zeitschrift für Mathematische Logik und Grundlagen der Mathematik}},+ year = 1990,+ volume = 36,+ pages = {297--398}+}++@BOOK{nordstrom-al-1990,+ AUTHOR = "{Nordstr\"{o}m}, B. and K. Petersson and J. Smith",+ TITLE = "Programming in {Martin-L\"{o}f}'s Type Theory. An Introduction",+ PUBLISHER = {Clarendon Press},+ ADDRESS = {Oxford},+ YEAR = {1990} }++@BOOK{sml,+ AUTHOR = "R. Milner and M. Tofte and R. Harper",+ TITLE = {{Definition of Standard ML}},+ PUBLISHER = {MIT Press},+ YEAR = {1990} + }++@book{nordstrom:book,+ AUTHOR = {B. Nordstr{\"{o}}m and K. Petersson and J. M. Smith},+ TITLE = {{Programming in Martin-Löf's Type Theory. An Introduction}},+ YEAR = {1990},+ PUBLISHER = {Oxford University Press}+}++@inproceedings{abeille-joshi,+ author = {Abeill\'{e},, Anne and Schabes,, Yves and Joshi,, Aravind K.},+ title = {Using lexicalized tags for machine translation},+ booktitle = {Proceedings of the 13th conference on Computational linguistics},+ year = {1990},+ isbn = {952-90-2028-7},+ pages = {1--6},+ location = {Helsinki, Finland},+ doi = {http://dx.doi.org/10.3115/991146.991147},+ publisher = {Association for Computational Linguistics},+ address = {Morristown, NJ, USA},+ }++@inproceedings{shieber-schabes,+ author = {Stuart M. Shieber and+ Yves Schabes},+ title = {Synchronous Tree-Adjoining Grammars},+ booktitle = {COLING},+ year = {1990},+ pages = {253-258},+ ee = {http://acl.ldc.upenn.edu/C/C90/C90-3045.pdf},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}+@article{chomsky-1956,+ author = {Noam Chomsky},+ title = {{Three models for the description of language}},+ journal = {{IRE Transactions on Information Theory}},+ volume = {2},+ year = {1956},+ pages = {113--124},+ note = {\url{http://www.chomsky.info/articles/195609--.pdf}},+ }++@ARTICLE{seki-al-1991,+ author= {H. Seki and T. Matsumura and M. Fujii and T. Kasami},+ title = "On Multiple Context-Free Grammars", + journal = {{Theoretical Computer Science}}, + volume = 88, + pages = {191--229}, + year = 1991+}++@Article{Ranta91a,+ author = "Aarne Ranta",+ title = "Constructing Possible Worlds",+ journal = "Theoria",+ volume = "57",+ number = "1--2",+ pages = "77--100",+ year = "1991"+}++@Article{hutton,+ author = "G. Hutton",+ title = "Higher-order functions for parsing",+ journal = {J. Functional Programming},+ year = 1992,+ volume = 2,+ number = 3,+ pages = {323--343}+}++@BOOK{alshawi-1992,+ AUTHOR = "Alshawi, H",+ TITLE = {{The Core Language Engine}},+ PUBLISHER = {{MIT Press}},+ ADDRESS = {Cambridge, Ma},+ YEAR = {1992} }++@TechReport{luo-pollack-1992,+ author = {Z. Luo and R. Pollack},+ title = {{LEGO Proof Development System}},+ institution = {University of {Edinburgh}},+ year = 1992+}++@BOOK{grevisse,+ AUTHOR = "Grevisse, Maurice",+ TITLE = "Le bon usage, 13me edition",+ PUBLISHER = {Duculot},+ ADDRESS = {Paris},+ YEAR = {1993} }++@Book{jones-partial,+ author = {N.D. Jones and C.K. Gomard and P. Sestoft},+ title = {{Partial Evaluation and Automatic Program Generation}},+ publisher = {Prentice-Hall},+ year = 1993+}++@InCollection{pentus,+ author = "M. Pentus",+ title = "Lambek grammars are context-free",+ booktitle = {{LICS}, {Utrecht}, {The} {Netherlands}},+ year = 1993,+ pages = {35--42}+}++@article{harper-al-1993,+ AUTHOR = {R. Harper and F. Honsell and G. Plotkin},+ TITLE = {{A Framework for Defining Logics}},+ JOURNAL = {{JACM}},+ VOLUME = {40},+ NUMBER = {1},+ YEAR = {1993},+ PAGES = {143--184}+}++@INPROCEEDINGS{Tapanainen94taggingaccurately,+ author = {Pasi Tapanainen and Atro Voutilainen},+ title = {Tagging accurately - Don't guess if you know},+ booktitle = {In Proceedings of ANLP '94},+ year = {1994},+ pages = {47--52}+}++@Article{kaplan-kay,+ author = "R. Kaplan and M. Kay",+ title = {{Regular Models of Phonological Rule Systems}},+ journal = {{Computational Linguistics}},+ year = 1994,+ volume = 20,+ pages = {{331--380}}+}++@Book{hpsg,+ author = "C. Pollard and I. Sag",+ title = {{Head-Driven Phrase Structure Grammar}}, + publisher = {{University of Chicago Press}},+ year = 1994+}++@Book{rosetta-1994,+ author = {M.~T. Rosetta},+ title = {Compositional Translation},+ publisher = "Kluwer",+ address = "Dordrecht",+ year = 1994+}++@PhdThesis{magnusson-1994,+ author = {L. Magnusson},+ title = {The Implementation of ALF - a Proof Editor based on + Martin-L\"of's Monomorphic Type Theory with Explicit+ Substitution},+ school = {Department of Computing Science, Chalmers University of+ Technology and University of G\"oteborg},+ year = {1994}+}++@book{morrill,+ AUTHOR = {G. Morrill},+ TITLE = {{Type Logical Grammar}},+ YEAR = {1994},+ PUBLISHER = {Kluwer}+}++@incollection{debruijn-1994,+ TITLE = {{Mathematical Vernacular: + a Language for Mathematics with Typed Sets}},+ AUTHOR = {N. G. de Bruijn},+ EDITOR = {R. Nederpelt},+ BOOKTITLE = {{Selected Papers on Automath}},+ PUBLISHER = {{North-Holland Publishing Company}},+ PAGES = {865--935},+ YEAR = {1994}+ }++@inproceedings{magnusson-nordstrom-1994,+ AUTHOR = {L. Magnusson and B. Nordstr\"{o}m},+ BOOKTITLE = {{ Types for Proofs and Programs}},+ PUBLISHER = {Springer-Verlag},+ SERIES = LNCS,+ VOL = {806},+ PAGES = {213-237},+ TITLE = {{The ALF proof editor and its proof engine}}, + ADDRESS = {Nijmegen},+ YEAR = {1994}+ }++@inproceedings{magnusson-nordstr,+ AUTHOR = {L. Magnusson and B. Nordstr\"{o}m},+ BOOKTITLE = {{Types for Proofs and Programs}},+ PUBLISHER = {Springer},+ SERIES = {LNCS 806},+ PAGES = {213--237},+ TITLE = {The {ALF} proof editor and its proof engine}, + YEAR = {1994}+ }++@inproceedings{nlyacc,+ author = {Masayuki Ishii and Kazuhisa Ohta and Hiroaki Saito},+ title = {An efficient parser generator for natural language},+ booktitle = {Proceedings of the 15th conference on Computational linguistics},+ year = {1994},+ pages = {417--420},+ location = {Kyoto, Japan},+ doi = {http://dx.doi.org/10.3115/991886.991959},+ publisher = {Association for Computational Linguistics},+ address = {Morristown, NJ, USA},+ }++@misc{kamp-al-1994,+ author = {H. Kamp and R. Crouch and J. van Genabith and R. Cooper and M. Poesio + and J. van Eijck and J. Jaspars and M. Pinkal and E. Vestre and S. Pulman}, + year = 1994,+ title = "Specification of Linguistic Coverage",+ note = {{FRACAS Deliverable D2}} + }++@Article{hoas,+ author = "J. Despeyroux",+ title = "Higher-Order Abstract Syntax", + journal = ???,+ year = 1995,+ volume = ???,+ pages = ???+}++@Book{RussellNorvig95,+ author = "Stuart J. Russell and Peter Norvig",+ title = "Artificial Intelligence. {A} Modern Approach",+ publisher = "Prentice-Hall",+ address = "Englewood Cliffs",+ year = "1995",+ url = "http://www.cs.berkeley.edu/~russell/aima.html"+}++@InProceedings{coscoy-al-1995,+ author = "Y. Coscoy and G. Kahn and L. Thery",+ title = "Extracting text from proofs",+ series = lncs,+ volume = "902",+ pages = {109--123},+ year = "1995",+ booktitle = "Proc.\ {Second} {Int.} {Conf.} on + {Typed} {Lambda} {Calculi} and {Applications}",+ editor = "M. Dezani-Ciancaglini and G. Plotkin"+}++@InProceedings{jones-hudak,+ author = "M. Jones and P. Hudak",+ title = "Using Types to Parse Natural Language",+ booktitle = {{Proceedings of the Glasgow Workshop on Functional Programming}},+ series = {LNCS},+ year = 1995,+ address = spv+}++@misc{minnen95offline,+ author = "G. Minnen and D. Gerdemann and T. Gotz",+ title = "Off-line optimization for Earleystyle hpsg processing",+ text = "G. Minnen, D. Gerdemann, and T. Gotz. Off-line optimization for Earleystyle+ hpsg processing. In Proc. of the 7th Conference of the eacl, Dublin, 1995.",+ year = "1995",+ url = "citeseer.ist.psu.edu/article/minnen95offline.html" }++@Manual{JavaCollection,+ title = {The Java Collection Framework}, + year = {1995--1999},+ author = {{Sun Microsystems Inc.}},+ note = {\texttt{http://java.sun.com/j2se/1.3/docs/guide/collections/}}+ }++@Article{coquand-typecheck,+ author = "T. Coquand",+ title = "An Algorithm for Type Checking Dependent Types",+ journal = "Science of {Computer} {Programming}",+ year = 1996,+ volume = 26,+ pages = {167-177}+}++@Article{hudak,+ author = "P. Hudak",+ title = "Building domain-specific embedded languages",+ journal = "{ACM} {Computing} {Surveys}",+ year = 1996,+ volume = 28,+ number = 4+}++@InProceedings{DahnWolf96,+ author = "Bernd I. Dahn and Andreas Wolf",+ title = "Natural Language Representation and Combination of+ Automatically Generated Proofs",+ editor = "Franz Baader and Klaus U.~Schulz",+ booktitle = "Frontiers of Combining Systems: Proc.\ 1st+ International Workshop, Munich, Germany",+ publisher = "Kluwer Academic Publishers",+ series = "Applied Logic",+ month = mar,+ year = "1996",+ pages = "175--192"+}++@InProceedings{coscoy:textproofs,+ AUTHOR = {Y. Coscoy and G. Kahn and L. Th\'ery},+ TITLE = {Extracting Text from Proof}, + BOOKTITLE = {{Proceedings of the International Conference on Typed Lambda+ Calculus and Applications (TLCA), Edinburgh}},+ EDITOR = {M. Dezani and G. Plotkin},+ SERIES = lncs,+ NUMBER = {902},+ PUBLISHER = {Springer-Verlag},+ YEAR = {1996}+ }++@TechReport{NeculaLee96,+ author = "G. C. Necula and P. Lee",+ title = "Proof-Carrying Code",+ institution = "School of Computer Science, Carnegie Mellon+ University, Pittsburgh, USA",+ year = "1996",+ number = "CMU-CS-96-165",+ month = nov,+ url = "http://www.cs.cmu.edu/~necula/tr96-165.ps.gz"+}++@misc{melchuk,+ AUTHOR = {I. Mel'cuk},+ TITLE = {{Vers une linguistique Sens-Texte. Le\c{c}on inaugurale}},+ YEAR = {1997},+ PUBLISHER = {{Coll\`ege de France}},+ address = {Paris},+ note = {\url{http://olst.ling.umontreal.ca/pdf/MelcukColldeFr.pdf}}+}++@Article{huet-zipper,+ author = "G. Huet",+ title = {The {Zipper}}, + journal = JFP,+ year = 1997,+ volume = 7,+ number = 5,+ pages = {549--554}+}++@Book{bescherelle,+ author = "Bescherelle",+ title = "La conjugaison pour tous",+ publisher = "Hatier",+ year = 1997+}++@Book{jasmin,+ author = {J. Meyer and T. Downing},+ title = {{Java Virtual Machine}},+ publisher = {O'Reilly},+ year = {1997}+}++@InProceedings{Necula97,+ author = "G. C. Necula",+ title = {{Proof-Carrying Code}},+ booktitle = {{Proc.\ 24th {A}{C}{M} Symposium on Principles of+ Programming Languages, {Paris}, {France}}},+ year = "1997",+ url = "http://www.cs.cmu.edu/~necula/popl97.ps.gz",+ pages = "106--119",+ publisher = "ACM Press"+}++@InProceedings{coscoy-1997,+ author = {Y. Coscoy},+ title = {A natural language explanation of formal proofs},+ booktitle = {Logical Aspects of Computational Linguistics},+ pages = {149--167},+ year = 1997,+ editor = {C. {Retor\'e}},+ address = {Heidelberg},+ publisher = {Springer},+ series = lncs,+ number= 1328+}++@article{kay-1997, + AUTHOR = {M. Kay},+ TITLE = {{The Proper Place of Men and Machines in Language Translation}},+ JOURNAL = {{Machine Translation}},+ YEAR = {1997},+ NUMBER = {1--2},+ VOLUME = {12},+ PAGES = {3--23}+ }++@inproceedings{Thompson97a,+ author = {Simon Thompson},+ title = {{\em Where do I begin?} + {A} problem solving approach to teaching + functional programming},+ month = sep,+ year = {1997},+ pages = {},+ url = {http://www.cs.ukc.ac.uk/pubs/1997/208},+ booktitle = {First International Conference on Declarative Programming Languages in Education},+ editor = {Krzysztof Apt and Pieter Hartel and Paul Klint},+ publisher = spv,+ volume = "1292",+ pages = "323--337",+ series = lncs+ } ++@Book{appel-1998,+ author = {A. Appel},+ title = {{Modern Compiler Implementation in ML}},+ publisher = {Cambridge University Press},+ year = {1998}+}++@Book{appel-java,+ author = {A. Appel},+ title = {{Modern Compiler Implementation in Java}},+ publisher = {Cambridge University Press},+ year = {1998}+}++@InProceedings{power-scott-1998,+ author = {R. Power and D. Scott},+ title = {Multilingual authoring using feedback texts},+ booktitle = {COLING-ACL 98},+ year = 1998,+ address = {Montreal, Canada}+}++@InProceedings{semBNF,+ author = {{P. M\"aenp\"a\"a}},+ title = {{Semantic BNF}},+ booktitle = "Types for Proofs and Programs, TYPES'96", + series = lncs,+ publisher = spv,+ volume = "1512",+ pages = "196--215",+ year = "1998",+ editor = "E. Gimenez and C. Paulin-Mohring"+}++@InProceedings{wysiwym,+ author = {R. Power and D. Scott},+ title = {Multilingual authoring using feedback texts},+ booktitle = {{COLING}-{ACL}},+ year = 1998+}++@PhdThesis{carlsson98:fudgets_thesis,+ author = {M. Carlsson and T. Hallgren},+ title = {{Fudgets --- Purely Functional Processes with+ applications to Graphical User Interfaces}},+ booktitle = {{Fudgets --- Purely Functional Processes with+ applications to Graphical User Interfaces}},+ school = {Department of Computing Science, Chalmers University+ of Technology},+ year = 1998,+ address = {S-412 96 Göteborg, Sweden},+ month = {March},+ documentURL = "http://www.cs.chalmers.se/~hallgren/Thesis/"+}++@PhdThesis{fudgets,+ author = {M. Carlsson and T. Hallgren},+ title = {{Fudgets---Purely Functional Processes with+ applications to Graphical User Interfaces}},+ school = {{Department of Computing Science, Chalmers University+ of Technology}},+ year = 1998,+ documentURL = "http://www.cs.chalmers.se/~hallgren/Thesis/"+}++@book{stroustrup,+ AUTHOR = {B. Stroustrup},+ TITLE = {{The C++ Programming Language, Third Edition}},+ YEAR = {1998},+ PUBLISHER = {{Addison-Wesley}}+}++@inproceedings{augustsson:cayenne,+ AUTHOR = {L. Augustsson},+ TITLE = {{Cayenne --- a language with dependent types}},+ BOOKTITLE = {Proc. of the International Conference on Functional Programming (ICFP'98)},+ PUBLISHER = {ACM Press},+ MONTH = {September},+ YEAR = {1998}+ }++@inproceedings{cayenne,+ AUTHOR = {L. Augustsson},+ TITLE = {{Cayenne---a language with dependent types}},+ BOOKTITLE = {Proc. of {ICFP'98}},+ PUBLISHER = {ACM Press},+ MONTH = {September},+ YEAR = {1998}+ }++@unpublished{agda-homepage,+ author = "C. Coquand",+ title = "{{AGDA Homepage}}",+ year = 1998,+ howpublished = {Online document},+ note = {\verb!http://www.cs.chalmers.se/~catarina/agda/!} ,+ documenturl = "http://www.cs.chalmers.se/~catarina/agda/"+ }++@Article{Holt99,+ author = {Alexander Holt},+ title = {Formal verification with natural language specifications: + guidelines, experiments and lessons so far},+ journal = {South African Computer Journal},+ year = {1999},+ volume = {24},+ pages = {253-257},+ month = nov,+ url = {http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-fvn/ps/},+}++@BOOK{CAML,+ AUTHOR = "P. Weis and X. Leroy",+ TITLE = {{Le langage Caml}},+ PUBLISHER = {Dunod},+ ADDRESS = "Paris",+ YEAR = {1999} + }++@Book{LindholmYellinJVM,+ editor = {T. Lindholm and F. Yellin},+ title = {{The Java Virtual Machine Specification Second Edition}},+ publisher = {{Addison-Wesley}},+ year = {{1999}}+}++@Book{warmer-kleppe-1999,+ author = "J. Warmer and A. Kleppe",+ title = {{The Object Constraint Language: Precise Modelling with UML}},+ publisher = {{Addison-Wesley}},+ year = "1999"+}++@INPROCEEDINGS{isar,+ AUTHOR = {M. Wenzel},+ TITLE = {{Isar - a Generic Interpretative Approach to Readable Formal Proof Documents}},+ BOOKTITLE = {{Theorem Proving in Higher Order Logics, TPHOLs'99}},+ YEAR = {1999},+ series = lncs,+ volume = {1690},+ EDITOR = {Y. Bertot and G. Dowek and A. Hirschowitz and C. Paulin and L. Th\'{e}ry}+}++@InProceedings{HKG99,+ author = {Alexander Holt and Ewan Klein and Claire Grover},+ title = {Natural language for hardware verification: + semantic interpretation and model checking},+ booktitle = {Proc.\ ICoS-1: Inference in Computational Semantics, Amsterdam},+ pages = {133-137},+ year = {1999},+ publisher = {Institute for Logic, Language and Computation, + University of Amsterdam},+ url = {http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-nlh/ps/}+}++@InProceedings{HoltEwan99,+ author = {Alexander Holt and Ewan Klein},+ title = {A semantically-derived subset of {E}nglish for + hardware verification},+ booktitle = {Proc.\ 37th Annual Meeting of the Association for + Computational Linguistics: Maryland, USA},+ pages = {451-456},+ year = {1999},+ publisher = {Association for Computational Linguistics},+ url = {\texttt{http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-sds/ps/}}+}++@InProceedings{HoltEwan99,+ author = {Alexander Holt and Ewan Klein},+ title = {A semantically-derived subset of {E}nglish for + hardware verification},+ booktitle = {Proc.\ Ann.\ Meeting Ass.\ for + Comp.\ Ling.},+ pages = {451--456},+ year = {1999},+ url = {http://www.ltg.ed.ac.uk/prosper/papers/holt-1999-sds/ps/}+}++@InProceedings{coquand1999,+ author = {C. Coquand and T. Coquand},+ title = {Structured Type Theory},+ booktitle = {Workshop on Logical Frameworkds and Meta-languages},+ year = 1999,+ address = {Paris, France}+}++@InProceedings{coquand:stt-lfm99,+ author = {C. Coquand and T. Coquand},+ title = {Structured Type Theory},+ booktitle = {Workshop on Logical Frameworkds and Meta-languages},+ year = 1999,+ address = {Paris, France},+ month = {Sep}+}++@InProceedings{luo-callaghan-1999,+ author = {Z. Luo and P. Callaghan},+ title = {Mathematical Vernacular and Conceptual Well-Formedness in Mathematical+ Language},+ booktitle = {{Logical Aspects of Computational Linguistics (LACL)}} ,+ year = 1999,+ editor = {A. Lecomte and F. Lamarche and G. Perrier},+ series = {{LNCS/LNAI}},+ volume = 1582,+ pages = {231--250}+}++@Misc{ALF-family-homepage,+ author = {},+ title = {{Implementation of Proof Editors}},+ howpublished = + {\verb!http://www.cs.chalmers.se/ComputingScience/Research/Logic/!},+ documentURL = "http://www.cs.chalmers.se/ComputingScience/Research/Logic/",+ year = 1999+}+++@Book\{bertot-casteran-2004,+ author = "Bertot, Yves and Cast\'eran, Pierre",+ title = "Interactive Theorem Proving and Program Development. Coq'Art: The Calculus of Inductive Constructions",+ series = "Texts in Theoretical Computer Science",+ year = "2004",+ publisher = "Springer Verlag",+ url = "http://www.labri.fr/publications/l3a/2004/BC04"+}++@Misc{LEGO-new-homepage,+ author = {D. Aspinall},+ title = {{The LEGO Proof Assistant}},+ howpublished = {\verb!http://www.dcs.ed.ac.uk/home/lego/!},+ documentURL = "http://www.dcs.ed.ac.uk/home/lego/",+ year = 1999+}++@Misc{coq,+ author = {{The Coq Development Team}},+ title = {{The Coq Proof Assistant Reference Manual}},+ howpublished = {\verb6pauillac.inria.fr/coq/6},+ documentURL = "http://pauillac.inria.fr/coq/",+ year = 1999+}++@Misc{coq-homepage,+ author = {Coq Development Team},+ title = {{Coq Homepage}},+ howpublished = {\verb!http://pauillac.inria.fr/coq/!},+ documentURL = "http://pauillac.inria.fr/coq/",+ year = 1999+}++@book{mueller,+ author = {Stefan Müller},+ title = {{Deutsche Syntax Deklarativ}},+ year = 1999,+ publisher = {{Max Niemeyer Verlag}}+}++@misc{bohlin-trindi,+ author = {P. Bohlin and J. Bos and S. Larsson and + I. Lewin and C. Matheson and D. Milward}, + year = 1999,+ title = {Survey of Existing Interactive Systems},+ note = {Trindi deliverable D1.3, Gothenburg University}+ }++@BOOK{steedman-book,+ AUTHOR = {M. Steedman},+ TITLE = "The Syntactic Process",+ PUBLISHER = {{The MIT Press}},+ YEAR = {2000} }++@ARTICLE{copestake,+ AUTHOR = "A. Copestake and D. Flickinger",+ TITLE = {{An open-source grammar development environment and broad-coverage English grammar using HPSG}},+ JOURNAL = {{Proceedings of the Second conference on Language Resources and Evaluation (LREC-2000)}},+ YEAR = {2000} +}++@Article{godis,+ author = "S. Larsson and D. Traum",+ title = {{Information state and dialogue management in the + TRINDI Dialogue Move Engine Toolkit}},+ journal = {{Natural Language Engineering}},+ year = 2000,+ volume = 0,+ pages = 0+}++@BOOK{rayner-al-2000,+ AUTHOR = {M. Rayner and D. Carter and P. Bouillon and V. Digalakis and + M. Wirén},+ TITLE = {{The Spoken Language Translator}},+ PUBLISHER = {{Cambridge University Press}},+ ADDRESS = {Cambridge},+ YEAR = {2000} }++@Book{jurafsky,+ author = "D. Jurafsky and J. Martin",+ title = {{Speech and Language Processing}}, + publisher = {{Prentice Hall}},+ year = 2000+}++@InProceedings{BaarHaehnle00a,+ author = {Thomas Baar and Reiner H\"ahnle},+ title = {An Integrated Metamodel for {OCL} Types},+ booktitle = {Proc.\ OOPSLA 2000 Workshop Refactoring the UML: + In Search of the Core, Minneapolis/MI, USA},+ year = {2000},+ editor = {Robert France and Bernhard Rumpe and Jonathan Whittle},+ month = oct+}++@Manual{Ranta00a,+ title = {PESCA---A Proof Editor for Sequent Calculus},+ author = {Aarne Ranta},+ organization = {Department of Computing Science, + Chalmers University of Technology and University of Gothenburg},+ address = {Gothenburg},+ month = mar,+ year = {2000},+ note = {Program and documentation.+ URL: \texttt{www.cs.chalmers.se\~{}aarne/pesca/}}+}++@Manual{UML1.3-specification,+ key = {UML 1.3},+ title = {Unified Modelling Language Specification, version 1.3},+ organization = {Object Modeling Group},+ month = mar,+ year = 2000,+ url = {http://cgi.omg.org/cgi-bin/doc?formal/00-03-01.ps.gz},+ note = {OMG document formal/00-03-01. {URL:} + \texttt{http://cgi.omg.org/cgi-bin/doc?formal/00-03-01.ps.gz}}+}+@TechReport{LBR00,+ author = "G. T. Leavens and A. L. Baker and C. Ruby",+ title = "Preliminary Design of {JML}: A Behavioral Interface+ Specification Language for {Java}",+ institution = "Iowa State University, Department of Computer+ Science",+ year = "2000",+ number = "98-06i",+ month = feb,+ note = "URL: \texttt{ftp://ftp.cs.iastate.edu/pub/techreports/TR98-06/TR.ps.gz}",+ url = "ftp://ftp.cs.iastate.edu/pub/techreports/TR98-06/TR.ps.gz"+}++@Misc{Isabelle-homepage,+ author = {Isabelle},+ title = {{Isabelle Homepage}},+ howpublished = {\verb!http://www.cl.cam.ac.uk/Research/HVG/Isabelle/!},+ documentURL = "http://www.cl.cam.ac.uk/Research/HVG/Isabelle/index.html",+ year = 2000+}++@Misc{huet-sanskrit,+ author = "G. Huet",+ title = "Sanskrit site",+ howpublished = "Program and documentation, + \verb6http://pauillac.inria.fr/~huet/SKT/6", + documentURL = "\verb6http://pauillac.inria.fr/~huet/SKT/index.html6",+ year = 2000+}++@Misc{huet-sanskrit-short,+ author = "G. Huet",+ title = "Sanskrit site",+ howpublished = {\verb6http://pauillac.inria.fr/~huet/SKT/6}, + year = 2000+}++@Misc{maple-homepage,+ author = {Waterloo Maple Inc.},+ title = {{Maple Homepage}},+ howpublished = {\verb!http://www.maplesof.com/!},+ documentURL = "http://www.maplesof.com/",+ year = 2000+}++@Misc{wolfram-2000,+ author = {Wolfram Research, Inc.},+ title = {{Mathematica Homepage}},+ howpublished = {\url{http://www.wolfram.com/products/mathematica/}},+ documentURL = "http://www.wolfram.com/products/mathematica/",+ year = 2000+}++@PhdThesis{coscoy-2000,+ author = {Y.\ Coscoy},+ title = {Explication textuelle de preuves pour le calcul des+ constructions inductives},+ school = {{Universit\'e de Nice-Sophia-Antipolis}},+ year = 2000+}++@misc{alfa-homepage,+ author = {T. Hallgren},+ year = {2000},+ title = {{Home Page of the Proof Editor Alfa}},+ howpublished = {\verb!http://www.cs.chalmers.se/~hallgren/Alfa/!},+ documentURL = {http://www.cs.chalmers.se/~hallgren/Alfa/}+ }++@unpublished{XML,+ title = {{Extensible Markup Language (XML)}},+ author = {{The World Wide Web Consortium}},+ howpublished = {Online document},+ year = {2000},+ note = {\verb!http://www.w3.org/XML/!}+ }++@Book{Ranta01a,+ author = {Sara Negri and Jan von Plato},+ title = {Structural Proof Theory},+ publisher = {Cambridge University Press},+ year = {2001, to appear},+ note = {Appendix C ``PESCA---A Proof Editor for Sequent Calculus'' + by Aarne Ranta}+}++@Book{Sommerville01,+ author = "Ian Sommerville",+ title = "Software Engineering",+ publisher = "Addison-Wesley",+ year = "2001",+ edition = "6th"+}++@Book{stallman-2001,+ author = {Richard Stallman},+ title = {{Using and Porting the GNU Compiler Collection}},+ publisher = {{Free Software Foundation}},+ year = 2001,+ isbn_issn = {ISBN 0-595-10035-X}+}++@INPROCEEDINGS{muskens-lg,+ AUTHOR = {R. Muskens},+ TITLE = {Lambda {G}rammars and the {S}yntax-{S}emantics+ {I}nterface},+ BOOKTITLE = {Proceedings of the Thirteenth Amsterdam Colloquium},+ PAGES = {150--155},+ YEAR = {2001},+ EDITOR = {van Rooy, R. and Stokhof, M.},+ note = {\url{http://let.uvt.nl/general/people/rmuskens/pubs/amscoll.pdf}},+ PS = {amscoll.ps},+ PDF = {amscoll.pdf},+ ADDRESS = {Amsterdam}+}++@Misc{UMI,+ author = {{Union Mundial pro Interlingua}},+ title = {{Interlingua Homepage}},+ howpublished = {\url{http://www.interlingua.com/}},+ url = {http://www.interlingua.com/},+ year = {2001}+}++@Misc{happy,+ author = {S. Marlow},+ title = {{Happy, The Parser Generator for Haskell}},+ note = {\verb6http://www.haskell.org/happy/6},+ year = 2001+}++@PhdThesis{fiedler,+ author = {A. Fiedler},+ title = {{User-Adaptive Proof Explanation}},+ school = {{Universität des Saarlandes}},+ year = 2001+}++@inproceedings{Dow:Hoc:Gaw:01,+ title = {{Practical Issues in Compiling Typed Unification Grammars + for Speech Recognition}},+ author = {J. Dowding and B. A. Hockey and J. M. Gawron+ and C. Culy},+ booktitle = {{ACL 2001}},+ address = {{Toulouse, France}},+ year = 2001+}++@inproceedings{degroote-acg,+ title = {{Towards Abstract Categorial Grammars}},+ author = {Ph. de Groote},+ booktitle = {{Association for Computational Linguistics, + 39th Annual Meeting and 10th Conference of the European Chapter, Toulouse, France}},+ pages = {148--155},+ note = {\url{http://www.loria.fr/~degroote/papers/acl01.pdf}},+ year = {2001}+}++@unpublished{boeing,+ title = {{Boeing Simplified English Checker}},+ author = {{The Boeing Company}},+ howpublished = {Online document},+ year = {2001},+ note = {\verb!http://www.boeing.com/assocproducts/sechecker/!}+ }++@article{minimal-recursion,+ author = "Copestake, A. and D. Flickinger and C. Pollard and I. Sag",+ title = "Minimal Recursive Semantics: An Introduction",+ journal = "Language and Computation", + volume = 1, + year = 2001,+ pages = {1--47}+ }+++@InProceedings{butt,+ author = {M. Butt and H. Dyvik and T. Holloway King and H. Masuichi + and C. Rohrer},+ title = {{The Parallel Grammar Project}},+ booktitle = {{COLING 2002, Workshop on Grammar Engineering and Evaluation}},+ pages = {1--7},+ note = {\url{http://www2.parc.com/isl/groups/nltt/pargram/buttetal-coling02.pdf}},+ year = {2002}+}++@InProceedings{degroote02,+ author = {Ph. de Groote},+ title = {{Tree-Adjoining Grammars as Abstract Categorial Grammars}},+ booktitle = {{TAG+6, Proceedings of the sixth International Workshop+ on Tree Adjoining Grammars and Related Frameworks}},+ pages = {145--150},+ publisher = {Universit\`a di Venezia},+ year = {2002}+}++@Misc{Isabelle-Paulson,+ author = "L. Paulson",+ title = {{The Isabelle Reference Manual}},+ note = {{With contributions by T. Nipkow and M. Wenzel}},+ howpublished = {Available at the Isabelle homepage \verb!http://www.cl.cam.ac.uk/Research/HVG/Isabelle/!},+ documentURL = "http://www.cl.cam.ac.uk/Research/HVG/Isabelle/dist/Isabelle2002/doc/ref.pdf",+ year = 2002+}++@Misc{nuance,+ author = {{Nuance Communications}},+ title = {{Nuance}},+ note = {\url{http://www.nuance.com}},+ year = 2002+}++@Misc{twelf,+ author = {F. Pfenning},+ title = {{The Twelf Project}},+ howpublished = {\verb!http://www-2.cs.cmu.edu/~twelf!},+ documentURL = {"http://www-2.cs.cmu.edu/~twelf"},+ year = {2002}+}++@book{CopestakeLKB,+ AUTHOR = {A. Copestake},+ TITLE = {{Implementing Typed Feature Structure Grammars}},+ YEAR = {2002},+ PUBLISHER = {{CSLI Publications}}+}++@misc{htk,+ author = {Steve Young and Gunnar Evermann and Dan Kershaw and Gareth+ Moore and Julian Odell and Dave Ollason and Dan Povey and Valtcho+ Valtchev and Phil Woodland},+ title = {{The HTK Book, Version 3.2}},+ year = 2002,+ note = {{Cambridge University Engineering Dept, December 2002},+ \url{http://www.htk.eng.cam.ac.uk.}}+}++@phdthesis{larsson02:issue-based,+ author = {Larsson, Staffan },+ citeulike-article-id = {1177735},+ keywords = {dialogue, godis},+ posted-at = {2007-03-20 16:32:36},+ priority = {2},+ school = {G\"{o}teborg University},+ title = {{I}ssue-based {D}ialogue {M}anagement},+ year = {2002}+}++@unpublished{huet-trie,+ author = {G. Huet},+ title = {{The Zen Computational Linguistics Toolkit}}, + howpublished = {{ESSLLI Summer School, Trento}},+ note = {\verb!http://pauillac.inria.fr/~huet/!},+ year = 2002+}++@unpublished{lkb,+ title = {{The LKB System}},+ author = {Ann Copestake},+ howpublished = {Online document},+ year = {2002},+ note = {Available on-line in \verb!http://www-csli.stanford.edu/~aac/lkb.html!}+ }++@book{karttunen-beesley,+ AUTHOR = {K. Beesley and L. Karttunen},+ TITLE = {{Finite State Morphology}},+ YEAR = {2003},+ PUBLISHER = {{CSLI Publications}}+}++@techreport{KeY2003,+ author = {Wolfgang Ahrendt and Thomas Baar and + Bernhard Beckert and Richard Bubel and+ Martin Giese and Reiner H\"ahnle and+ Wolfram Menzel and Wojciech Mostowski and+ Andreas Roth and Steffen Schlager and+ Peter H. Schmitt},+ title = {The KeY Tool},+ institution = {Department of Computing Science, Chalmers University+ and G\"oteborg University, G\"oteborg, Sweden},+ type = {Technical Report in Computing Science No.\ 2003-5},+ month = feb, + year = {2003}+}++@ARTICLE{lingo-redwoods,+ AUTHOR = {S. Oepen and D. Flickinger and K. Toutanova and C. D. Manning},+ TITLE = {{LinGO Redwoods, A Rich and Dynamic Treebank for HPSG}},+ JOURNAL = {{Research on Language and Computation}},+ volume = {2},+ pages = {575--596},+ note = {\url{http://www.springerlink.com/content/t851781443373812/}},+ YEAR = {2004} +}++@Book{doets-eijck,+ author = {K. Doets and J. van Eijck},+ title = {{The Haskell Road to Logic, Maths and Programming}},+ publisher = {College Publications},+ year = {2004}+}++@INPROCEEDINGS{pollard-hog,+ AUTHOR = {C. Pollard},+ TITLE = {{Higher-Order Categorical Grammar}},+ BOOKTITLE = {{Proceedings of the + Conference on Categorial Grammars (CG2004), Montpellier, France}},+ PAGES = {340--361},+ YEAR = {2004},+ note = {\url{http://www.ling.ohio-state.edu/~hana/hog/pollard2004-CG.pdf}},+ EDITOR = {M. Moortgat}+}++@Misc{Happy-GLR,+ author = {P. Callaghan and B. Medlock},+ title = {{Happy-GLR}},+ note = {\verb6http://www.dur.ac.uk/p.c.callaghan/happy-glr/6},+ year = 2004+}++@Misc{owl,+ author = {Mike Dean and Guus Schreiber},+ title = {{OWL Web Ontology Language Reference}},+ note = {\url{http://www.w3.org/TR/owl-ref/}},+ year = 2004+}++@inproceedings{bos-steedman,+ title = {{Wide-Coverage Semantic Representations from a CCG Parser}},+ author = {J. Bos and S. Clark and M. Steedman and J. Curran and J. Hockenmaier},+ booktitle = {{Coling 2004}},+ note = {\url{http://www.iccs.inf.ed.ac.uk/~stevec/papers/bos_etal.pdf}},+ year = {2004}+}++@inproceedings{wiedijk-2004,+ AUTHOR = {F. Wiedijk},+ BOOKTITLE = {{Types for Proofs and Programs}},+ PUBLISHER = {Springer},+ SERIES = {LNCS 3085},+ editors = {S. Berardi and M. Coppo and F. Damiani},+ PAGES = {378--393},+ TITLE = {{Formal Proof Sketches}}, + YEAR = {2004}+ }++@techreport{xhtml+voice,+ author = {Axelsson, Jonny and Cross, Chris and Ferrans, Jim and McCobb, Gerald and Raman, T. V. and Wilson, Les },+ citeulike-article-id = {1177339},+ institution = {{VoiceXML} Forum},+ keywords = {voicexml, web, xhtml-voice},+ posted-at = {2007-03-20 12:50:18},+ priority = {0},+ title = {{XHTML+Voice} Profile 1.2},+ type = {Specification},+ url = {http://www.voicexml.org/specs/multimodal/x+v/12/},+ year = {2004}+}++@unpublished{eclipse,+ title = {{Eclipse Homepage}},+ author = {{Eclipse.org}},+ howpublished = {Online document},+ year = {2004},+ note = {\verb!http://www.eclipse.org/!}+ }++@unpublished{together,+ title = {{Together}},+ author = {{Borland Software Corporation}},+ howpublished = {Online document},+ year = {2004},+ note = {\verb!http://www.borland.com/together/!}+ }++@ARTICLE{huet-2005,+ AUTHOR = "Gerard Huet",+ TITLE = {{A Functional Toolkit for Morphological and Phonological Processing, Application to a Sanskrit Tagger}},+ JOURNAL = {{The Journal of Functional Programming}},+ pages={573--614},+ volume={15(4)},+ YEAR = {2005} }++@INPROCEEDINGS{claessen-equinox,+ AUTHOR = {K. Claessen},+ TITLE = {{Equinox, A New Theorem Prover for Full First-Order Logic with Equality}},+ BOOKTITLE = {{Dagstuhl Seminar 05431 on Deduction and Applications}},+ note = {\url{http://www.cs.chalmers.se/~koen/pubs/entry-dagstuhl05-equinox.html}},+ YEAR = {2005}+}++@Misc{nuance-bevocal,+ author = {{Bevocal Inc.}},+ title = {{Nuance GSL Grammar Format}},+ note = {\url{http://cafe.bevocal.com/docs/grammar/gsl.html}},+ year = 2005+}++@inproceedings{bender,+ author = {Bender, Emily M. and Flickinger, Dan},+ title = {Rapid Prototyping of Scalable Grammars: + Towards Modularity in Extensions to a Language-Independent Core},+ booktitle = {Proceedings of the 2nd International Joint Conference on + Natural Language Processing IJCNLP-05 (Posters/Demos)},+ note = {\url{http://faculty.washington.edu/ebender/papers/modules05.pdf}},+ address = {Jeju Island, Korea},+ year = 2005+}++@inproceedings{carlson-2005,+ title = {{Inducing a Morphological Transducer from Inflectional Paradigms}},+ author = {Lauri Carlson},+ booktitle = {{Inquiries into Words, Constraints and Contexts.+ Festschrift for Kimmo Koskenniemi on his 60th Birthday}},+ publisher = {{CSLI}},+ year = 2005+}++@Article{frost-survey,+ author = "R. Frost",+ title = "Realization of natural language interfaces using + lazy functional programming",+ journal = {{ACM Comput. Surv.}},+ year = 2006,+ volume = 38,+ number = 4+}++@BOOK{regulus,+ AUTHOR = {Rayner, M. and Hockey, B. A. and Bouillon, P.},+ TITLE = "Putting Linguistics into Speech Recognition: The Regulus Grammar Compiler",+ publisher = {{CSLI Publications}},+ YEAR = {2006} }++@Misc{trybulec-2006,+ author = {A. Trybulec},+ title = {{The Mizar Homepage}},+ note = {\url{http://mizar.org/}},+ documentURL = "http://mizar.org/",+ year = {2006}+}++@Misc{kotus-2006,+ author = "{Kotimaisten Kielten Tutkimuskeskus}",+ title = {{KOTUS Wordlist}},+ note = {\url{http://kaino.kotus.fi/sanat/nykysuomi}},+ year = 2006+}++@article{goldsmith-2006,+ author = {John Goldsmith},+ title = {{An Algorithm for the Unsupervised Learning of Morphology}},+ journal = {{Nat. Lang. Eng.}},+ volume = {12},+ number = {4},+ year = {2006},+ issn = {1351-3249},+ pages = {353--371},+ doi = {http://dx.doi.org/10.1017/S1351324905004055},+ publisher = {Cambridge University Press},+ address = {New York, NY, USA},+ }++@book{aho-lam-ullman,+ AUTHOR = {A. Aho and M. Lam and R. Sethi and J. Ullman},+ TITLE = {{Compilers: Principles, Techniques, and Tools. Second Edition}},+ YEAR = {2006},+ PUBLISHER = {{Addison-Wesley}}+}++@Misc{XLE-homepage,+ author = {R. Kaplan and J. Maxwell},+ title = {{XLE Project Homepage}},+ note = {\verb6http://www2.parc.com/isl/groups/nltt/xle/6},+ year = 2007+}++@article{creutz,+ author = {Mathias Creutz and Krista Lagus},+ title = {{Unsupervised Models for Morpheme Segmentation and Morphology Learning}},+ journal = {{ACM Trans. Speech Lang. Process.}},+ volume = {4},+ number = {1},+ year = {2007},+ issn = {1550-4875},+ pages = {3},+ doi = {http://doi.acm.org/10.1145/1187415.1187418},+ publisher = {ACM},+ address = {New York, NY, USA},+ }++@misc{becker-sammie,+ author = {T. Becker and N. Blaylock and C. Gerstenberger and A. Korthauer and N. + Perera and M. Pitz and P. Poller and J. Schehl and F. Steffens and+ R. Stegmann and J. Steigner},+ year = 2007,+ title = {{In-Car Showcase Based on TALK}},+ note = {{TALK. Talk and Look: + Tools for Ambient Linguistic Knowledge. IST-507802. Deliverable 5.3}.+ \url{http://www.talk-project.org/}}+ }++@Misc{attempto,+ author = {Attempto},+ title = {{Attempto Project Homepage}},+ note = {\url{http://attempto.ifi.uzh.ch/site/}},+ year = {2008}+}++@inproceedings{espinosa,+ title = {{Hypertagging: Supertagging for Surface Realization with CCG}},+ author = "Espinosa, D. and M. White and D. Mehay",+ booktitle = {{ACL 2008}},+ address = {{Columbus, Ohio}},+ year = 2008+}++++@misc{peyton-jones-2003,+ author= {S. {Peyton Jones}},+ title={{Haskell 98 language and libraries: the Revised Report}}, + year=2003, + publisher={{Cambridge University Press}},+ note={\url{http://www.haskell.org/haskellwiki/Language_and_library_specification}}+}++@Book{b-b,+ author = {P. Blackburn and J. Bos},+ title = {Representation and Inference for Natural Language},+ publisher = {Studies in Logic, Language, and Information, CSLI Press},+ year = {to appear}+}++@inproceedings{airline,+ AUTHOR = {L. Augustsson},+ TITLE = {{Partial Evaluation in Airline Crew Scheduling}},+ BOOKTITLE = {???},+ PUBLISHER = {???},+ YEAR = {???}+ }++@misc{pollard-convergent,+ AUTHOR = {C. Pollard},+ TITLE = {{Convergent Grammar web page}},+ YEAR = {2009},+ note = {\url{http://www.ling.ohio-state.edu/~scott/cvg/}}+}++@inproceedings{bringert-al-2009,+ AUTHOR = {B. Bringert and K. Angelov and A. Ranta},+ TITLE = {{Grammatical Framework Web Service}},+ BOOKTITLE = {{System demo, Proceedings of EACL'09, Athens}},+ YEAR = {2009}+ }++@inproceedings{gfdemo-eacl,+ AUTHOR = {B. Bringert and K. Angelov and A. Ranta},+ TITLE = {{The GF Grammar Development System}},+ BOOKTITLE = {{System demo, Proceedings of EACL'09, Athens}},+ YEAR = {2009}+ }++@inproceedings{ranta-angelov-2010,+ AUTHOR = {Ranta, A. and K. Angelov},+ TITLE = {{Implementing Controlled Languages in GF}},+ BOOKTITLE = {{Proceedings of CNL-2009, Athens}},+ series = {LNCS},+ volume = {5972},+ pages = {82--101},+ YEAR = {2010}+ }+++%%%%%%%%%%%% below this: to be sorted++@Book{bar-hillel-1964,+ author = {Y. Bar-Hillel},+ title = {{Language and Information}},+ publisher = "Addison-Wesley",+ address = "Reading, MA",+ year = 1964+}++@InProceedings{damljanovic,+ author = {D. Damljanovic and K. Bontcheva},+ title = "Enhanced Semantic Access to Software Artefacts",+ booktitle = {{Workshop on Semantic Web Enabled Software Engineering (SWESE) held in conjunction with ISWC'08, Karlsruhe, Germany}},+ year = 2008+}++@InProceedings{papineni-2002,+ author = {Kishore Papineni and Salim Roukos and Todd Ward and Wei-Jing Zhu },+ title = {{BLEU}: a Method for Automatic Evaluation of Machine Translation },+ booktitle = {{ACL}},+ pages = {311--318},+ year = 2002+}++@Article{chandioux-1976,+ author = {J. Chandioux},+ title = {{MÉTÉO: un système opérationnel pour la traduction automatique + des bulletins météreologiques destinés au grand public}},+ journal = {{META}},+ volume = {21},+ pages = {127--133},+ year = {1976}+}+++@inproceedings{fuchs-al-2008,+ author = {Norbert E. Fuchs and Kaarel Kaljurand and Tobias Kuhn},+ title = {{Attempto Controlled English for Knowledge Representation}},+ booktitle = {{Reasoning Web, Fourth International Summer School 2008}},+ editor = {Cristina Baroglio and Piero A. Bonatti and Jan Ma{\l}uszy\'nski and Massimo Marchiori and Axel Polleres and Sebastian Schaffert},+ series = lncs,+ number = {5224},+ publisher = {Springer},+ pages = {104--124},+ year = {2008},+}+++@techreport{lc-js-as:webalt2005,+ author = {Carlson, Lauri and Saludes, Jordi and Strotmann, Andreas},+ title = {Study of the state of the art in multilingual and multicultural creation of digital mathematical content.},+ institution = {the WebALT Consortium},+ url = {http://webalt.math.helsinki.fi/content/e16/e301/e305/Deliverable1.2_eng.pdf},+ number = {D1.2},+ type = {{Project Deliverable}},+ year = {2005}+}++%+% Last day additions from Lluís (section 1.2.6)+%++@ARTICLE{brown-al-1990, + AUTHOR = {Peter~F.~Brown and John~Cocke and Stephen~A.~Della~Pietra and Vincent~J.~Della~Pietra and Fredrick~Jelinek and John~D.~Lafferty and Robert~L.~Mercer and Paul~S.~Roossin},+ YEAR = {1990},+ TITLE = {A statistical approach to machine translation},+ JOURNAL = {Computational Linguistics},+ NUMBER = {2},+ PAGES = {76--85},+ VOLUME = {16}+}++@ARTICLE{och-ney-2004, + AUTHOR = {Franz Josef Och and Hermann Ney},+ TITLE = {The Alignment Template Approach to Statistical Machine Translation},+ JOURNAL= {Computational Linguistics}, + NUMBER = 4,+ VOLUME = 30,+ YEAR = 2004,+ PAGES = {417--449}+}++@inproceedings{koehn03,+ author = {Philipp Koehn and Franz Josef Och and Daniel Marcu},+ title = "{Statistical Phrase-Based Translation}",+ booktitle = {Proceedings of the Joint Conference on Human Language Technology and the North American Chapter of the Association for Computational Linguistics (HLT-NAACL)},+ year = {2003}+}++@inproceedings{och02,+ author = {Franz Josef Och and Hermann Ney},+ title = "{Discriminative Training and Maximum Entropy Models for Statistical Machine Translation}",+ booktitle = {Proceedings of the 40th ACL},+ year = {2002},+ pages = {295--302}+}++@techreport{moses,+ author = "Philipp Koehn and Hieu Hoang and Alexandra Birch and Chris Callison-Burch and Marcello Federico and Nicola Bertoldi and Brooke Cowan and Wade Shen and Christine Moran and Richard Zens and Chris Dyer and Ondrej Bojar and Alexandra Constantin and Evan Herbst",+ title = "{Moses: Open Source Toolkit for Statistical Machine Translation}",+ year = "2007",+ institution = "(ACL 2007) demonstration session"+}++@inproceedings{gimenez06,+ author = {Jesús Giménez and Lluís Màrquez},+ title = "{Low-cost Enrichment of Spanish WordNet with Automatically Translated Glosses: Combining General and Specialized Models}",+ booktitle = {Proceedings of COLING-ACL},+ year = {2006},+}++@inproceedings{garcia09,+ author = {Miguel García and Jesús Giménez and Lluís Màrquez},+ title = {Enriching Statistical Translation Models using a Domain-independent Multilingual Lexical Knowledge Base},+ booktitle= {Proceedings of the 10th International Conference on Computational Linguistics and Intelligent Text Processing, CICLing-2009},+ year = {2009},+ pages = {--},+ address = {Ciudad de Mexico, Mexico}+}++@InProceedings{chen07,+ author = {Chen, Yu and Eisele, Andreas and Federmann, Christian and Hasler, Eva and Jellinghaus, Michael and Theison, Silke},+ title = {Multi-Engine Machine Translation with an Open-Source {SMT} Decoder},+ booktitle = {Proceedings of the Second Workshop on Statistical Machine Translation},+ month = {June},+ year = {2007},+ address = {Prague, Czech Republic},+ publisher = {Association for Computational Linguistics},+ pages = {193--196},+}+++@inproceedings{matusov06,+ author = {Evgeny Matusov and Nicola Ueffing and Hermann Ney},+ title = {Computing Consensus Translation for Multiple Machine Translation Systems Using Enhanced Hypothesis Alignment},+ booktitle= {Proceedings of EACL},+ year = {2006},+ pages = {33--40},+ address = {Trento, Italy}+}++@InProceedings{macherey07,+ author = {Macherey, Wolfgang and Och, Franz J.},+ title = {An Empirical Study on Computing Consensus Translations from Multiple Machine Translation Systems},+ booktitle = {Proceedings of the 2007 Joint Conference on Empirical Methods in Natural Language Processing and Computational Natural Language Learning (EMNLP-CoNLL)},+ month = {June},+ year = {2007},+ address = {Prague, Czech Republic},+ publisher = {Association for Computational Linguistics},+ pages = {986--995},+}++@inproceedings{mellebeek06,+ author = {B. Mellebeek and A. Khasin and K. Owczarzak and J. Van Genabith and A. Way},+ title = {Improving online Machine Translation Systems},+ booktitle= {Proceedings of the 10th Machine Translation Summit},+ year = {2006},+ pages = {290--297},+ address = {Phuket, Thailand}+}++@InProceedings{huang07,+ author = {Huang, Fei and Papineni, Kishore},+ title = {Hierarchical System Combination for Machine Translation},+ booktitle = {Proceedings of the 2007 Joint Conference on Empirical Methods in Natural Language Processing and Computational Natural Language Learning (EMNLP-CoNLL)},+ month = {June},+ year = {2007},+ address = {Prague, Czech Republic},+ publisher = {Association for Computational Linguistics},+ pages = {277--286},+}++@InProceedings{rosti07,+ author = {Rosti, Antti-Veikko and Matsoukas, Spyros and Schwartz, Richard},+ title = {Improved Word-Level System Combination for Machine Translation},+ booktitle = {Proceedings of the 45th Annual Meeting of the Association of Computational Linguistics},+ month = {June},+ year = {2007},+ address = {Prague, Czech Republic},+ publisher = {Association for Computational Linguistics},+ pages = {312--319},+}++@InProceedings{karakos08,+ author = {Karakos, Damianos and Eisner, Jason and Khudanpur, Sanjeev and Dreyer, Markus},+ title = {Machine Translation System Combination using ITG-based Alignments},+ booktitle = {Proceedings of ACL-08: HLT, Short Papers},+ month = {June},+ year = {2008},+ address = {Columbus, Ohio},+ publisher = {Association for Computational Linguistics},+ pages = {81--84},+}++@InProceedings{simard07,+ author = {Simard, Michel and Ueffing, Nicola and Isabelle, Pierre and Kuhn, Roland},+ title = {Rule-Based Translation with Statistical Phrase-Based Post-Editing},+ booktitle = {Proceedings of the Second Workshop on Statistical Machine Translation},+ month = {June},+ year = {2007},+ address = {Prague, Czech Republic},+ publisher = {Association for Computational Linguistics},+ pages = {203--206},+}++@inproceedings{terumasa07,+ author = {Ehara Terumasa},+ title = {Rule based machine translation combined with statistical post editor for Japanese to English patent translation},+ booktitle= {MT Summit XI Workshop on patent translation},+ year = {2007},+ pages = {13--18},+ address = {Copenhagen, Denmark}+}++@inproceedings{gimenez06b,+ author = {Jes\'us Gim\'enez and Enrique Amig\'o},+ title = {{\sc IQmt}: A Framework for Automatic Machine Translation Evaluation},+ booktitle = {Proceedings of the 5th International Conference on+ Language Resources and Evaluation (LREC'06)},+ year = {2006}+}++@inproceedings{callison-burch06,+ author = {Chris Callison-Burch and Miles Osborne and Philipp Koehn},+ title = "{Re-evaluating the Role of BLEU in Machine Translation Research}",+ booktitle = {Proceedings of EACL},+ year = {2006}+}+++@inproceedings{gimenez08,+ author = {Jes\'{u}s Gim\'{e}nez and Llu\'{i}s M\`{a}rquez},+ title = "{A Smorgasbord of Features for Automatic MT Evaluation}",+ booktitle = {Proceedings of the ACL Workshop on Statistical Machine Translation},+ year = {2008},+ pages = {195--198},+}+++@phdthesis{gimenez08b,+ author = {Jes\'{u}s Gim\'{e}nez},+ title = "{Empirical Machine Translation and its Evaluation}",+ school = "Universitat Polit\`ecnica de Catalunya",+ year = {2008}+}+++@inproceedings{WMT07,+ author = {Chris Callison-Burch and Cameron Fordyce and Philipp Koehn and Christof Monz and Josh Schroeder},+ title = "{(Meta-) Evaluation of Machine Translation}",+ booktitle = {Proceedings of the ACL-2007 Workshop on Statistical Machine Translation},+ year = {2007},+ pages = {136--158}+}++@inproceedings{WMT08,+ author = {Chris Callison-Burch and Cameron Fordyce and Philipp Koehn and Christof Monz and Josh Schroeder},+ title = "{Further (Meta-) Evaluation of Machine Translation}",+ booktitle = {Proceedings of the ACL-2008 Workshop on Statistical Machine Translation},+ year = {2008}+}++@InProceedings{carreras09,+ author = {Carreras, Xavier and Collins, Michael},+ title = {Non-Projective Parsing for Statistical Machine Translation},+ booktitle = {Proceedings of the 2009 Conference on Empirical Methods in Natural Language Processing},+ month = {August},+ year = {2009},+ address = {Singapore},+ publisher = {Association for Computational Linguistics},+ pages = {200--209},+ url = {http://www.aclweb.org/anthology/D/D09/D09-1021}+ }++++%%%%%%%%%%%%%%%%%%%%%++@Misc{dean-schreiber-2004,+ author = {Mike Dean and Guus Schreiber},+ title = {{OWL Web Ontology Language Reference}},+ note = {\url{http://www.w3.org/TR/owl-ref/}},+ year = 2004+}++@inproceedings{hart-al-2008,+ author = {Glen Hart and+ Martina Johnson and+ Catherine Dolbear},+ title = {Rabbit: Developing a Control Natural Language for Authoring+ Ontologies},+ booktitle = {ESWC},+ year = {2008},+ pages = {348-360}+}++@article{ranta-lilt,+ author = {A. Ranta},+ title = {{The GF Resource Grammar Library}},+ journal = {{Linguistic Issues in Language Technology}},+ volume = {2},+ year = {2009}+}+++@inproceedings{1220242,+ author = {Al-Onaizan, Yaser and Papineni, Kishore},+ title = {Distortion models for statistical machine translation},+ booktitle = {ACL-44: Proceedings of the 21st International Conference on Computational Linguistics and the 44th annual meeting of the Association for Computational Linguistics},+ year = {2006},+ pages = {529--536},+ location = {Sydney, Australia},+ doi = {http://dx.doi.org/10.3115/1220175.1220242},+ publisher = {Association for Computational Linguistics},+ address = {Morristown, NJ, USA},+ }++@ARTICLE{bringert-ranta-2008,+ AUTHOR = {B. Bringert and A. Ranta},+ TITLE = {{A Pattern for Almost Compositional Functions}},+ JOURNAL = {{The Journal of Functional Programming}},+ pages={567--598},+ volume={18(5--6)},+ YEAR = {2008}+ }+++++@book{hutchins-somers-1992,+ AUTHOR = {W. J. Hutchins and H. L. Somers},+ TITLE = {{An Introduction to Machine Translation}},+ YEAR = {1992},+ PUBLISHER = {{Academic Press Limited}},+ Address = "London"+}++@Misc{pierce-al-1966,+ author = {John R. Pierce and John B. Carroll and al.},+ title = {{Language and Machines — Computers in Translation and Linguistics. + ALPAC report}}, + publisher = {{+ National Academy of Sciences, National Research Council}}, + address = {{Washington, DC}},+ year = 1966+}++@book{hutchins-2000,+ AUTHOR = {W. J. Hutchins},+ TITLE = {{Early years in machine translation: Memoirs and biographies of pioneers}},+ YEAR = {2000},+ PUBLISHER = {{John Benjamins}},+ Address = "Amsterdam"+}++@ARTICLE{shannon-1948,+ AUTHOR = {C. Shannon},+ TITLE = {{A Mathematical Theory of Communication}},+ JOURNAL = {{The Bell System Technical Journal}},+ volume={1},+ YEAR = {1948}+ }++@ARTICLE{ajdukiewicz-1935,+ AUTHOR = {K. Ajdukiewicz},+ TITLE = {{Die syntaktische konnexität}},+ JOURNAL = {{Studia Philosophica}},+ volume={1},+ YEAR = {1935},+ pages = {1--27}+ }++@ARTICLE{welsh-al-1991,+ AUTHOR = {J. Welsh and B. Broom and D. Kiong},+ TITLE = {{A design rationale for a language-based editor}},+ JOURNAL = {{Software: Practice and Experience}},+ volume={21},+ YEAR = {1991},+ pages = {923–-948}+ }++@phdthesis{norell-2007,+ author = {Ulf Norell},+ title = {Towards a practical programming language based on dependent type+ theory},+ school = {Department of Computer Science and Engineering, Chalmers University of Technology},+ year = 2007,+ month = {September},+ address = {SE-412 96 G\"{o}teborg, Sweden}+}+++@article {angelov-al-2010,+ title = {D10.2 MOLTO web service, first version},+ number = {D10.2},+ year = {2010},+ month = {06/2010},+ type = {Project Deliverable},+ address = {Gothenburg, Sweden},+ attachments = {http://www.molto-project.eu/sites/default/files/D10.2.pdf},+ author = {Krasimir Angelov and Olga Caprotti and Ramona Enache and Thomas Hallgren and Listenmaa, Inari and Aarne Ranta and Saludes, Jordi and Slaski, Adam}+}++@article{jelinek-2009,+ author = {Jelinek, Frederick},+ title = {{The dawn of statistical ASR and MT}},+ journal = {Computational Linguistics},+ volume = {35},+ number = {4},+ year = {2009},+ issn = {0891-2017},+ pages = {483--494},+ doi = {http://dx.doi.org/10.1162/coli.2009.35.4.35401},+ publisher = {MIT Press},+ address = {Cambridge, MA, USA},+ }++@techreport{dowek-al-1993,+ HAL_ID = {inria-00070014},+ URL = {http://hal.inria.fr/inria-00070014/en/},+ title = { {T}he {C}oq proof assistant user's guide : version 5.8},+ author = {{D}owek, {G}illes and {F}elty, {A}my and {H}erbelin, {H}ugo and {H}uet, {G}{\'e}rard and {P}arent, {C}atherine and {P}aulin-{M}ohring, {C}hristine and {W}erner, {B}enjamin and {M}urthy, {C}hetan},+ language = {{E}nglish},+ affiliation = {{INRIA} {R}ocquencourt - {INRIA} {R}ocquencourt - {INRIA} },+ pages = {120 },+ type = {{R}esearch {R}eport},+ institution = {INRIA},+ number = {{RT}-0154},+ year = {1993},+ URL = {http://hal.inria.fr/inria-00070014/PDF/RT-0154.pdf},+}+++@Book{carlson-1983,+ author = {Lauri Carlson},+ title = {{Dialogue Games: An Approach to Discourse Analysis}},+ publisher = "D. Reidel Co.",+ address = "Dordrecht",+ year = {1983}+ }++@INCOLLECTION{ranta-2008,+ AUTHOR = "A. Ranta",+ TITLE = {How predictable is {Finnish} morphology? An experiment on lexicon construction},+ EDITOR = {{J. Nivre and M. Dahll\"of and B. Megyesi}},+ BOOKTITLE = "Resourceful Language Technology: Festschrift in Honor of Anna Sågvall Hein",+ PUBLISHER = {{University of Uppsala}},+ note = {\url{http://publications.uu.se/abstract.xsql?dbid=8933}},+ YEAR = {2008},+ PAGES = {130-148}+ }+++@Article{karttunen-karttunen-1976,+ author = "Frances Karttunen and Lauri Karttunen",+ title = {{The clitic -kin/-kaan in Finnish}},+ journal = "Texas Linguistic Forum",+ year = 1976,+ volume = 5,+ pages = {89-118}+}++@Article{zwicky-1977,+ author = "Arnold Zwicky",+ title = "On Clitics",+ journal = "Indiana University Linguistic Club",+ year = 1976,+ volume = 5,+ pages = {89-118}+}++@InCollection{carlson-1993,+ author = "Lauri Carlson",+ title = {{Dialogue Games with Finnish Clitics}},+ booktitle = "Yearbook of the Linguistic Society of Finland",+ publisher = "SKY",+ address = "Helsinki",+ year = "1993",+ editor = "M. Vilkuna and S. Shore"+}++@PhdThesis{nevis-1986,+ author = "Joel A. Nevis",+ title = "Finnish Particle Clitics and General Clitic Theory",+ school = "Department of Linguistics, Ohio State University, Columbus",+ year = {1986}+}++@InProceedings{benzmuller-al-1997,+ title = {Omega: Towards a mathematical assistant},+ author = {C. Benzm\"uller and L. Cheikhrouhou and D. Fehrer and A. Fiedler and Huang and M. Kerber and M. Kohlhase and K. Konrad and E. Melis and A. Meier and W. Schaarschmidt and J. Siekmann and V. Sorge},+ year = {1997},+ booktitle = {Proceedings of the 14th Conference on Automated Deduction},+ publisher = {Springer},+}++@INPROCEEDINGS{wenzel-1999,+ author = {Markus Wenzel},+ title = {Isar - A Generic Interpretative Approach to Readable Formal+ Proof Documents},+ booktitle = {TPHOLs},+ year = {1999},+ pages = {167-184},+ ee = {http://link.springer.de/link/service/series/0558/bibs/1690/16900167.htm},+ crossref = {DBLP:conf/tphol/1999},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@proceedings{DBLP:conf/tphol/1999,+ editor = {Yves Bertot and+ Gilles Dowek and+ Andr{\'e} Hirschowitz and+ C. Paulin and+ Laurent Th{\'e}ry},+ title = {Theorem Proving in Higher Order Logics, 12th International+ Conference, TPHOLs'99, Nice, France, September, 1999, Proceedings},+ booktitle = {TPHOLs},+ publisher = {Springer},+ series = lncs,+ volume = {1690},+ year = {1999},+ isbn = {3-540-66463-7},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@BOOK{frege-1879,+ AUTHOR = "Frege, Gottlob",+ TITLE = "Begriffsschrift",+ PUBLISHER = {Louis Nebert},+ ADDRESS = {Halle A/S},+ YEAR = {1879} +}+++@article{kamareddine-wells-2008,+ author = {Fairouz Kamareddine and+ J. B. Wells},+ title = {{Computerizing Mathematical Text with MathLang}},+ journal = {Electr. Notes Theor. Comput. Sci.},+ volume = {205},+ year = {2008},+ pages = {5-30},+ ee = {http://dx.doi.org/10.1016/j.entcs.2008.03.063},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@inproceedings{cramer-al-2009,+ author = {Marcos Cramer and+ Bernhard Fisseni and+ Peter Koepke and+ Daniel K{\"u}hlwein and+ Bernhard Schr{\"o}der and+ Jip Veldman},+ title = {{The Naproche Project Controlled Natural Language Proof Checking+ of Mathematical Texts}},+ booktitle = {CNL},+ year = {2009},+ pages = {170-186},+ ee = {http://dx.doi.org/10.1007/978-3-642-14418-9_11},+ crossref = {fuchs-2009},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@proceedings{fuchs-2009,+ editor = {Norbert E. Fuchs},+ title = {Controlled Natural Language, Workshop on Controlled Natural+ Language, CNL 2009, Marettimo Island, Italy, June 8-10,+ 2009. Revised Papers},+ booktitle = {CNL},+ publisher = {Springer},+ series = lncs,+ volume = {5972},+ year = {2010},+ isbn = {978-3-642-14417-2},+ ee = {http://dx.doi.org/10.1007/978-3-642-14418-9},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}+++@misc{neumaier-2009,+ author = "Arnold Neumaier",+ title = {{FMathL - Formal Mathematical Language}},+ year = "2009",+ note = {\url{http://www.mat.univie.ac.at/~neum/FMathL.html}}+}++@article{libbrecht-2001,+ author = "Paul Libbrecht",+ title = {{OpenMath Home Page}},+ year = "2001",+ note = {\url{http://www.openmath.org/}}+}++@misc{saludes-2010,+ author = "Jordi Saludes and Sebasti\`a Xamb\'o",+ title = {{MOLTO Mathematical Grammar Library}},+ year = "2010",+ note = {\url{http://www.molto-project.eu/node/1246}}+}++@article{barwise-cooper-1981,+ volume = {4},+ number = {2},+ author = {Jon Barwise and Robin Cooper},+ title = {Generalized Quantifiers and Natural Language},+ journal = {Linguistics and Philosophy},+ year = {1981},+ pages = {159--219}+}++@book{reiter-dale-2000,+ author = "Ehud Reiter and Robert Dale",+ title = {{Building Natural Language Generation Systems}},+ publisher = "Cambridge University Press",+ year = "2000"+}++@inproceedings{bos-al-2004,+ title = {{Wide-Coverage Semantic Representations from a CCG Parser}},+ author = {Bos, Johan and Clark, Stephen and Steedman, Mark and Curran, James R. and Hockenmaier, Julia},+ booktitle = {Proceedings of the 20th International Conference on Computational Linguistics (COLING '04)},+ address = {Geneva, Switzerland},+ pages = {1240--1246},+ year = {2004}+}+++@inproceedings{bos-markert-2005,+ author = {Johan Bos and+ Katja Markert},+ title = {{Recognising Textual Entailment with Robust Logical Inference}},+ booktitle = {MLCW},+ year = {2005},+ pages = {404-426},+ ee = {http://dx.doi.org/10.1007/11736790_23},+ crossref = {DBLP:conf/mlcw/2005},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}+@proceedings{DBLP:conf/mlcw/2005,+ editor = {Joaquin Qui{\~n}onero Candela and+ Ido Dagan and+ Bernardo Magnini and+ Florence d'Alch{\'e}-Buc},+ title = {{Machine Learning Challenges, Evaluating Predictive Uncertainty,+ Visual Object Classification and Recognizing Textual Entailment,+ First PASCAL Machine Learning Challenges Workshop, MLCW+ 2005, Southampton, UK, April 11-13, 2005, Revised Selected+ Papers}},+ booktitle = {MLCW},+ publisher = {Springer},+ series = lncs,+ volume = {3944},+ year = {2006},+ isbn = {3-540-33427-0},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@phdthesis{bobrow-1964,+ author = "Daniel G. Bobrow",+ title = "Natural Language Input for a Computer Problem Solving System",+ school = "Massachusetts Institute of Technology",+ year = "1964"+}++@phdthesis{zinn-2004,+ author = "Claus Zinn",+ title = "Understanding Informal Mathematical Discourse",+ school = "Department of Computer Science, University of Erlangen-N{\"u}rnberg",+ year = "2010"+}++@phdthesis{ganesalingam-2010,+ author = "Mohan Ganesalingam",+ title = "The Language of Mathematics",+ school = "Department of Computer Science, University of Cambridge",+ year = "2010",+ note = {\url{http://people.pwf.cam.ac.uk/mg262/}}+}++@article{rice-1953,+ jstor_articletype = {research-article},+ title = {Classes of Recursively Enumerable Sets and Their Decision Problems},+ author = {Rice, H. G.},+ journal = {Transactions of the American Mathematical Society},+ jstor_issuetitle = {},+ volume = {74},+ number = {2},+ jstor_formatteddate = {Mar., 1953},+ pages = {pp. 358-366},+ url = {http://www.jstor.org/stable/1990888},+ ISSN = {00029947},+ abstract = {},+ language = {English},+ year = {1953},+ publisher = {American Mathematical Society},+ copyright = {Copyright © 1953 American Mathematical Society},+ }++@article{abbott-al-1996,+ author = {Abbott, John and D\'{\i}az, Angel and Sutor, Robert S.},+ title = {{A report on OpenMath: a protocol for the exchange of mathematical information}},+ journal = {SIGSAM Bull.},+ volume = {30},+ issue = {1},+ month = {March},+ year = {1996},+ issn = {0163-5824},+ pages = {21--24},+ numpages = {4},+ url = {http://doi.acm.org/10.1145/231191.231194},+ doi = {http://doi.acm.org/10.1145/231191.231194},+ acmid = {231194},+ publisher = {ACM},+ address = {New York, NY, USA},+} ++@misc{ranta-2011b,+ author = "Aarne Ranta",+ title = {{Grammatical Framework: A Hands-On Introduction}},+ howpublished = "CADE-23 Tutorial, Wroclaw",+ year = "2011",+ note = {{\url{http://www.grammaticalframework.org/gf-cade-2011/}}},+ url = http://www.grammaticalframework.org/gf-tutorial-cade-2011/+}++@inproceedings{gruzitis-2011,+ author = "Normunds Gruzitis and Guntis Barzdins",+ title = {{Towards a More Natural Multilingual Controlled Language Interface to OWL}},+ booktitle = "9th International Conference on Computational Semantics (IWCS)",+ year = "2011",+ note = {\url{http://www.aclweb.org/anthology/W/W11/W11-0138.pdf}},+ pages = {335--339}+}++@inproceedings{niles-pease-2001,+ author = {Niles, Ian and Pease, Adam},+ title = {Towards a standard upper ontology},+ booktitle = {Proceedings of the international conference on Formal Ontology in Information Systems - Volume 2001},+ series = {FOIS '01},+ year = {2001},+ isbn = {1-58113-377-4},+ location = {Ogunquit, Maine, USA},+ pages = {2--9},+ numpages = {8},+ url = {http://doi.acm.org/10.1145/505168.505170},+ doi = {http://doi.acm.org/10.1145/505168.505170},+ acmid = {505170},+ publisher = {ACM},+ address = {New York, NY, USA},+ keywords = {knowledge interchange format, ontologies},+} ++@article{humayoun-raffalli-2010,+ author = "Muhammad Humayoun and Christophe Raffalli",+ title = {{MathNat - Mathematical Text in a Controlled Natural Language}},+ journal = {{Journal on Research in Computing Science}},+ year = "2010",+ volume = "66"+}++@article{sutcliffe-benzmuller-2010,+ author = "Geoff Sutcliffe and Christoph Benzm{\"u}ller",+ title = {{Automated Reasoning in Higher-Order Logic+ using the TPTP THF Infrastructure}},+ journal = {{Journal of Formalized Reasoning}},+ year = "2010",+ volume = "3"+}++@inproceedings{camilleri-al-2010,+ author = "John J. Camilleri and Gordon J. Pace and Michael Rosner",+ booktitle = {{Playing Nomic Using a Controlled Natural Language}},+ conference = "CNL 2010, Second Workshop on Controlled Natural Languages",+ year = "2010",+ note = {\url{http://sunsite.informatik.rwth-aachen.de/Publications/CEUR-WS/Vol-622/paper7.pdf}}+}++@misc{mitankin-al-2010,+ author = "Petar Mitankin and Atanas Ilchev",+ title = {{Knowledge Representation Infrastructure}},+ year = "2010",+ note = {{MOLTO Deliverable D4.1. \url{http://www.molto-project.eu/sites/default/files/D4.1_0.pdf}}}+}++@article{buchberger-al-2006,+ author = {Bruno Buchberger and+ Adrian Craciun and+ Tudor Jebelean and+ Laura Kov{\'a}cs and+ Temur Kutsia and+ Koji Nakagawa and+ Florina Piroi and+ Nikolaj Popov and+ Judit Robu and+ Markus Rosenkranz},+ title = {Theorema: Towards computer-aided mathematical theory exploration},+ journal = {J. Applied Logic},+ volume = {4},+ number = {4},+ year = {2006},+ pages = {470-504},+ ee = {http://dx.doi.org/10.1016/j.jal.2005.10.006},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@BOOK{wittgenstein-1953,+ AUTHOR = "Wittgenstein, Ludwig",+ TITLE = "Philosophical Investigations",+ PUBLISHER = {Basil Blackwell},+ ADDRESS = {Oxford},+ YEAR = {1953} +}++@inproceedings{shiffman-al-2010,+ author = {Shiffman, Richard N. and Michel, George and Krauthammer, Michael and Fuchs, Norbert E. and Kaljurand, Kaarel and Kuhn, Tobias},+ title = {Writing clinical practice guidelines in controlled natural language},+ booktitle = {Proceedings of the 2009 conference on Controlled natural language},+ series = {CNL'09},+ year = {2010},+ isbn = {3-642-14417-9, 978-3-642-14417-2},+ location = {Marettimo Island, Italy},+ pages = {265--280},+ numpages = {16},+ url = {http://portal.acm.org/citation.cfm?id=1893475.1893493},+ acmid = {1893493},+ publisher = {Springer-Verlag},+ address = {Berlin, Heidelberg},+} +++@inproceedings{koehn-hoang-2007,+ author = {Philipp Koehn and+ Hieu Hoang},+ title = {Factored Translation Models},+ booktitle = {EMNLP-CoNLL},+ year = {2007},+ pages = {868-876},+ ee = {http://www.aclweb.org/anthology/D07-1091},+ crossref = {DBLP:conf/emnlp/2007},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}+@proceedings{DBLP:conf/emnlp/2007,+ title = {EMNLP-CoNLL 2007, Proceedings of the 2007 Joint Conference+ on Empirical Methods in Natural Language Processing and+ Computational Natural Language Learning, June 28-30, 2007,+ Prague, Czech Republic},+ booktitle = {EMNLP-CoNLL},+ publisher = {ACL},+ year = {2007},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@article{lopez-2008,+ author = {Adam Lopez},+ title = {Statistical machine translation},+ journal = {ACM Comput. Surv.},+ volume = {40},+ number = {3},+ year = {2008},+ ee = {http://doi.acm.org/10.1145/1380584.1380586},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@inproceedings{rayner-al-2011,+ author = {Manny Rayner and Paula Estrella and Pierrette Bouillon},+ title = {Bootstrapping A Statistical Speech Translator From A Rule-Based One},+ booktitle = {Proceedings of the Second International Workshop on + Free/Open-Source Rule-Based Machine Translation (2011: Barcelona)},+ year = {2011},+ note = {\url{http://hdl.handle.net/10609/5647}}+}++@inproceedings{tyers-nordfalk-2009,+ author = {Francis Tyers and Jacob Nordfalk},+ title = {{Shallow-transfer rule-based machine translation for Swedish to Danish}},+ booktitle = {Proceedings of the First International Workshop on + Free/Open-Source Rule-Based Machine Translation (2009: Alicante)},+ year = {2009},+ note = {\url{http://hdl.handle.net/10045/12024}}+}++@Book{hellberg-1978,+ author = {S. Hellberg},+ title = {{The Morphology of Present-Day Swedish}},+ publisher = {{Almqvist \& Wiksell}},+ year = {1978}+}++@Article{borin-2008,+title = {SALDO 1.0 (Svenskt associationslexikon version 2)},+author = {L. Borin, M. Forsberg, L. Lönngren},+journal = {Språkbanken},+publisher = {Göteborg universitet},+volume* = {volume},+year = {2008},+month = {05}+}++@Article{kaplan-kay-1994,+ author = "R. Kaplan and M. Kay",+ title = {{Regular Models of Phonological Rule Systems}},+ journal = {{Computational Linguistics}},+ year = 1994,+ volume = 20,+ pages = {{331--380}}+}++@Article{chaitin-1966,+ author = {G. J. Chaitin},+ title = {On the length of programs for computing finite binary sequences},+ journal = {Journal of the ACM},+ year = 1966,+ volume = 13,+ number = 4,+ pages = {{547--569}}+}++@Article{kolmogorov-1965,+ author = {A. N. Kolmogorov},+ title = {Three approaches to the quantitative definition of informati\+on},+ journal = {Problems of Information and Transmission},+ year = 1965,+ volume = 1,+ number = 1,+ pages = {{1--7}}+}++@Article{solomonoff-1964,+ author = {R. J. Solomonoff},+ title = {A formal theory of inductive inference: Parts 1 and 2},+ journal = {Information and Control},+ year = 1964,+ volume = 7,+ pages = {{1--22 and 224--254}}+}++@article{chanod-1995,+ author = {Jean-Pierre Chanod and+ Pasi Tapanainen},+ title = {Creating a tagset, lexicon and guesser for a French tagger},+ journal = {CoRR},+ volume = {cmp-lg/9503004},+ year = {1995},+ ee = {http://arxiv.org/abs/cmp-lg/9503004},+ bibsource = {DBLP, http://dblp.uni-trier.de}+}++@incollection{hlavacova-2001,+ author = {Hlaváčová, Jaroslava},+ affiliation = {Charles university Institute of the Czech National Corpus, Faculty of Arts nám. J. Palacha 2 116 38 Prague 1 Czech Republic},+ title = {Morphological Guesser of Czech Words},+ booktitle = {Text, Speech and Dialogue},+ series = {Lecture Notes in Computer Science},+ editor = {Matoušek, Václav and Mautner, Pavel and Moucek, Roman and Taušer, Karel},+ publisher = {Springer Berlin / Heidelberg},+ isbn = {978-3-540-42557-1},+ keyword = {Computer Science},+ pages = {70-75},+ volume = {2166},+ url = {http://dx.doi.org/10.1007/3-540-44805-5_9},+ year = {2001}+}++@MISC{nakov-2003,+ author = {Preslav Nakov and Yury Bonev and et al.},+ title = {Guessing Morphological Classes of Unknown German Nouns},+ year = {2003}+}++%% inria-00121489, version 1+%% http://hal.inria.fr/inria-00121489/en/+@inproceedings{romary-2004,+ hal_id = {inria-00121489},+ url = {http://hal.inria.fr/inria-00121489/en/},+ title = {{Standards going concrete: from LMF to Morphalou}},+ author = {Romary, Laurent and Salmon-Alt, Susanne and Francopoulo, Gil},+ abstract = {{Application of the ISO standard LMF to the French CNRS lexicon Morphalou. LMF is the ISO standard for NLP lexicons (aka ISO-24613).}},+ keywords = {NLP morphology LMF ISO ISO-24613},+ language = {English},+ affiliation = {LANGUE ET DIALOGUE - INRIA Lorraine - LORIA - INRIA - CNRS : UMR7503 - Universit{\'e} Henri Poincar{\'e} - Nancy I - Universit{\'e} Nancy II - Institut National Polytechnique de Lorraine - Analyse et Traitement Informatique de la Langue Fran{\c c}aise - ATILF - CNRS : UMR7118 - Universit{\'e} Henri Poincar{\'e} - Nancy I - Universit{\'e} Nancy II},+ booktitle = {{The 20th International Conference on Computational Linguistics - COLING 2004}},+ address = {Gen{\`e}ve/Switzerland},+ organization = {coling},+ audience = {not specified },+ year = {2004},+ pdf = {http://hal.inria.fr/inria-00121489/PDF/LRSSAGFFinal.pdf},+}++@inproceedings{clement-al-2004,+ author = "L. Clement and B. Sagot and B. Lang",+ title = "Morphology based automatic acquisition of large-coverage lexica",+ booktitle = "Proceedings of LREC-04, Lisboa, Portugal",+ year = 2004,+ pages = "1841--1844"+}++@inproceedings{hunaity-al-2010,+ author = "M.b Al-Hunaity and B. Maegaard and D. Hansen:",+ title = "Using English as a Pivot Language to Enhance Danish-Arabic Statistical Machine Translation",+ booktitle = "Proceedings of the workshop in LR and HLT for Semitic Languages, Valetta, Malta, 2010",+ year = 2010,+ pages = "108--113"+}+++@ARTICLE{miller-1995,+ author = {George A. Miller},+ title = {WordNet: A Lexical Database for English},+ journal = {Communications of the ACM},+ year = {1995},+ volume = {38},+ pages = {39--41}+}++@inproceedings{demelo-weikum-2009,+ author = {Gerard de Melo and Gerhard Weikum},+ title = {Towards a Universal Wordnet by Learning from Combined Evidence},+ booktitle = {Proceedings of the 18th ACM Conference on Information and Knowledge Management (CIKM 2009)},+ publisher = {ACM},+ year = {2009},+ isbn = {978-1-60558-512-3},+ pages = {513--522},+ location = {Hong Kong, China},+ doi = {http://doi.acm.org/10.1145/1645953.1646020},+ address = {New York, NY, USA}+}++@Manual{listenmaa-al-2013,+ author = "Inari Listenmaa and Jussi Rautio",+ title = "{MOLTO translation tools -- workflow manual}",+ note = "MOLTO Project deliverable",+ year = "2013",+ month = "April"+}++@conference{camilleri-2012,+ author = "John J. Camilleri",+ title = "{An IDE for the Grammatical Framework}",+ booktitle = "Proceedings of the Third International Workshop on Free/Open-Source Rule-Based Machine Translation (FreeRBMT 2012)",+ address = "Gothenburg, Sweden",+ year = "2012",+ month = "June"+}++@Manual{hallgren-al-2012,+ title = "Grammar Tools and Best Practices",+ number = "D2.3",+ year = "2012",+ month = "June",+ publisher = {{MOLTO Consortium}},+ type = "Project Deliverable",+ keywords = "GF, Grammatical Framework, WP2",+ attachments = "http://www.molto-project.eu/sites/default/files/best\_0.pdf",+ author = "Thomas Hallgren and Aarne Ranta and John Camilleri and Gr{\'e}goire D{\'e}trez and Ramona Enache"+}++@conference{saludes-xambo-2011,+ title = {The GF Mathematics Library},+ booktitle = {Proceedings First Workshop on CTP Components for Educational Software (THedu{\textquoteright}11)},+ volume = {Electronic Proceedings in Theoretical Computer Science },+ number = {79},+ year = {2011},+ month = {02/2012},+ pages = {102--110},+ publisher = {Electronic Proceedings in Theoretical Computer Science},+ organization = {Electronic Proceedings in Theoretical Computer Science},+ address = {Wroc{\l}aw, Poland},+ abstract = {This paper is devoted to present the Mathematics Grammar Library, a system for multilingual mathematical text processing. We explain the context in which it originated, its current design and functionality and the current development goals. We also present two prototype services and comment on possible future applications in the area of artificial mathematics assistants. },+ keywords = {MOLTO dissemination, WP6},+ doi = {http://dx.doi.org/10.4204/EPTCS.79.6},+ url = {http://cgi.cse.unsw.edu.au/~rvg/eptcs/Published/THedu11/Papers/22/arXiv.pdf},+ author = {Saludes, Jordi and Sebastian Xamb{\'o}},+ editor = {Pedro Quaresma and Ralph-Johan Back}+}++@conference{archambault-al-2012,+ title = {Using GF in multimodal assistants for mathematics},+ year = {2012},+ month = {02/2012},+ type = {Conference paper},+ address = {Digitization and E-Inclusion in Mathematics and Science 2012},+ abstract = {In this paper we present an ongoing effort in the computational linguistic field to develop multilingual assistive technologies for mathematics. The approach is based on the Grammatical Framework used in combination with UMCL and semantic encodings of mathematics like OpenMath and MathML3. We review the formats for supporting alternative modalities of presentation of mathematics in order to evaluate the effectiveness of the proposed approach. Finally we describe a very initial prototype built using off-the-shelf speech synthesis to interface to the Sage suite of computer algebra systems.},+ keywords = {MOLTO dissemination, WP6},+ url = {http://www.gaea.jcn.nihon-u.ac.jp/deims12/program.htm},+ attachments = {http://www.molto-project.eu/sites/default/files/ArchambaultCaprottiRantaSaludes_0.pdf},+ author = {Archambault, Dominique and Olga Caprotti and Ranta, Aarne and Saludes Jordi}+}++@mastersthesis{listenmaa-2012,+ title = {Ontology-based lexicon management in a multilingual translation system {\textendash} a survey of use cases},+ year = {2012},+ url = {http://www.molto-project.eu/sites/default/files/listenmaa_masters_thesis_2012.pdf},+ author = {Listenmaa, Inari},+ school = {{University of Helsinki}},+ type = {{MA Thesis}},+}++@TechReport{espanya-al-2013,+ title = {{WP5 final report: statistical and robust MT}},+ author = {{Cristina Espa{\~n}a-Bonet, Ramona Enache, Krasimir Angelov, Shafqat Virk, Erzs{\'e}bet Galg{\'o}czy, Meritxell Gonz{\`a}lez, Aarne Ranta, Llu{\'i}s M{\`a}rquez}}, + note = {{MOLTO Project deliverable}},+ type = {Project Deliverable},+ year = "2013",+ month = "April"+}++@unpublished{shafqat-prasad-2013,+ title = {{Developing an interlingual translation lexicon using WordNets and Grammatical Framework}},+ year = "2013",+ abstract = "Machine translation using the Grammatical Framework (GF) was originally developed for controlled languages with well-defined abstract semantics that acts as an interlingua. More recently, the coverage of GF resource grammars and its processing capabilities have reached to a level, where open-domain tasks such as arbitrary text parsing and translation look a possibility. But, we need several new advances, including robust parsing, parse- tree disambiguation, word sense disambiguation (WSD), and wide-coverage interlingual lexicons. In this paper, we address the later two issues. First, we build a wide coverage interlingual translation lexicon using the Princeton and Universal WordNet data. Then, we propose a technique to do WSD in GF, by integrating an existing WSD tool and replacing the usual GF style lexicons, which give one target word for each source word, by the reported WordNet based lexicons. The result is that, with the help of these new lexicons and WSD, the quality of translations improves in most of the cases, as we show by examples. Both WSD in general, and WordNets are of course well known, but this is the first time these tools have been coupled with GF.",+ keywords = "Interlingua",+ attachments = "http://www.molto-project.eu/sites/default/files/uwngf.pdf",+ author = "Shafqat Mumtaz Virk and K. V. S. Prasad"+}++@inproceedings{sanroma-boleda-2010,+ author = {Roser Sanrom{\`a} and Gemma Boleda},+ title = {The Database of Catalan Adjectives},+ booktitle = {LREC},+ year = {2010},+ ee = {http://www.lrec-conf.org/proceedings/lrec2010/summaries/373.html}+}
@@ -0,0 +1,1294 @@+<html>+ <head>+ <style>+ body { background: #eee; padding-top: 200px; }++ pre.python {background-color:#ffc; display: none}+ pre.haskell {background-color:#ffc; display: block}+ pre.java {background-color:#ffc; display: none}+ pre.csharp {background-color:#ffc; display: none}+ span.python {display: none}+ span.haskell {display: inline}+ span.java {display: none}+ span.csharp {display: none}+ + .header {+ position: fixed;+ top: 0;+ left: 0;+ background: #ddd;+ width: 100%;+ padding: 5pt;+ border-bottom: solid #bbb 2pt;+ }+ </style>+++<script lang="javascript">+ function change_language(href) {+ var name = href.split("#")[1];+ if (name == null)+ name = "haskell";+ for (var s = 0; s < document.styleSheets.length; s++) {+ var sheet = document.styleSheets[s];+ if (sheet.href == null) {+ var rules = sheet.cssRules ? sheet.cssRules : sheet.rules;+ if (rules == null) return;+ for (var i = 0; i < rules.length; i++) {+ if (rules[i].selectorText.endsWith(name)) {+ if (rules[i].selectorText.startsWith("pre"))+ rules[i].style["display"] = "block";+ else+ rules[i].style["display"] = "inline";+ } else if (rules[i].selectorText.startsWith("pre") || rules[i].selectorText.startsWith("span")) {+ rules[i].style["display"] = "none";+ }+ }+ }+ }+ }+</script>+ </head>+ <body onload="change_language(window.location.href); window.addEventListener('hashchange', function(e){change_language(window.location.href);});">+ <span class="header">+ <h1>Using the <span class="python">Python</span> <span class="haskell">Haskell</span> <span class="java">Java</span> <span class="csharp">C#</span> binding to the C runtime</h1>+ + Choose a language: <a href="#haskell">Haskell</a> <a href="#python">Python</a> <a href="#java">Java</a> <a href="#csharp">C#</a>+ </span>++ <h4>Krasimir Angelov, July 2015 - August 2017</h4>+ +<h2>Loading the Grammar</h2>++Before you use the <span class="python">Python</span> binding you need to import the <span class="haskell">PGF2 module</span><span class="python">pgf module</span><span class="java">pgf package</span><span class="csharp">PGFSharp package</span>:+<pre class="python">+>>> import pgf+</pre>+<pre class="haskell">+Prelude> import PGF2+</pre>+<pre class="java">+import org.grammaticalframework.pgf.*;+</pre>+<pre class="csharp">+using PGFSharp;+</pre>++<span class="python">Once you have the module imported, you can use the <tt>dir</tt> and+<tt>help</tt> functions to see what kind of functionality is available.+<tt>dir</tt> takes an object and returns a list of methods available+in the object:+<pre class="python">+>>> dir(pgf)+</pre>+<tt>help</tt> is a little bit more advanced and it tries+to produce more human readable documentation, which more over+contains comments:+<pre class="python">+>>> help(pgf)+</pre>+</span>++A grammar is loaded by calling <span class="python">the method pgf.readPGF</span><span class="haskell">the function readPGF</span><span class="java">the method PGF.readPGF</span><span class="csharp">the method PGF.ReadPGF</span>:+<pre class="python">+>>> gr = pgf.readPGF("App12.pgf")+</pre>+<pre class="haskell">+Prelude PGF2> gr <- readPGF "App12.pgf"+</pre>+<pre class="java">+PGF gr = PGF.readPGF("App12.pgf");+</pre>+<pre class="csharp">+PGF gr = PGF.ReadPGF("App12.pgf");+</pre>++From the grammar you can query the set of available languages.+It is accessible through the property <tt>languages</tt> which+is a map from language name to an object of <span class="python">class <tt>pgf.Concr</tt></span><span class="haskell">type <tt>Concr</tt></span><span class="java">class <tt>Concr</tt></span><span class="csharp">class <tt>Concr</tt></span>+which respresents the language.+For example the following will extract the English language:+<pre class="python">+>>> eng = gr.languages["AppEng"]+>>> print(eng)+<pgf.Concr object at 0x7f7dfa4471d0>+</pre>+<pre class="haskell">+Prelude PGF2> let Just eng = Data.Map.lookup "AppEng" (languages gr)+Prelude PGF2> :t eng+eng :: Concr+</pre>+<pre class="java">+Concr eng = gr.getLanguages().get("AppEng");+</pre>+<pre class="csharp">+Concr eng = gr.Languages["AppEng"];+</pre>++<h2>Parsing</h2>++All language specific services are available as +<span class="python">methods of the class <tt>pgf.Concr</tt></span><span class="haskell">functions that take as an argument an object of type <tt>Concr</tt></span><span class="java">methods of the class <tt>Concr</tt></span><span class="csharp">methods of the class <tt>Concr</tt></span>.+For example to invoke the parser, you can call:+<pre class="python">+>>> i = eng.parse("this is a small theatre")+</pre>+<pre class="haskell">+Prelude PGF2> let res = parse eng (startCat gr) "this is a small theatre"+</pre>+<pre class="java">+Iterable<ExprProb> iterable = eng.parse(gr.getStartCat(), "this is a small theatre");+</pre>+<pre class="csharp">+IEnumerable<Tuple<Expr, float>> enumerable = eng.Parse("this is a small theatre");+</pre>+<span class="python">+This gives you an iterator which can enumerate all possible+abstract trees. You can get the next tree by calling <tt>next</tt>:+<pre class="python">+>>> p,e = i.next()+</pre>+or by calling __next__ if you are using Python 3:+<pre class="python">+>>> p,e = i.__next__()+</pre>+</span>+<span class="haskell">+This gives you a result of type <tt>ParseOutput</tt>.+If the result is <tt>ParseFailed</tt> then the parser has failed and you will+get the offset and the token where the parser got stuck. If the parsing was successful+then you get <tt>ParseOk</tt> with a potentially infinite list of parse results:+<pre class="haskell">+Prelude PGF2> let ParseOk ((e,p):rest) = res+</pre>+</span>+<span class="java">+This gives you an iterable which can enumerate all possible+abstract trees. You can get the next tree by calling <tt>next</tt>:+<pre class="java">+Iterator<ExprProb> iter = iterable.iterator();+ExprProb ep = iter.next();+</pre>+</span>+<span class="csharp">+This gives you an enumerable which can enumerate all possible+abstract trees. You can get the next tree by calling <tt>MoveNext</tt>:+<pre class="csharp">+IEnumerator<Tuple<Expr, float>> enumerator = enumerable.GetEnumerator();+enumerator.MoveNext();+Tuple<Expr, float> ep = enumerator.Current;+</pre>+</span>++<p>The results are pairs of probability and tree. The probabilities+are negated logarithmic probabilities and this means that the lowest+number encodes the most probable result. The possible trees are+returned in decreasing probability order (i.e. increasing negated logarithm).+The first tree should have the smallest <tt>p</tt>:+</p>+<pre class="python">+>>> print(p)+35.9166526794+</pre>+<pre class="haskell">+Prelude PGF2> print p+35.9166526794+</pre>+<pre class="java">+System.out.println(ep.getProb());+35.9166526794+</pre>+<pre class="csharp">+Console.WriteLine(ep.Item2);+35.9166526794+</pre>+and this is the corresponding abstract tree:+<pre class="python">+>>> print(e)+PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA small_A) (UseN theatre_N)))))))) NoVoc+</pre>+<pre class="haskell">+Prelude PGF2> print e+PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA small_A) (UseN theatre_N)))))))) NoVoc+</pre>+<pre class="java">+System.out.println(ep.getExpr());+PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA small_A) (UseN theatre_N)))))))) NoVoc+</pre>+<pre class="csharp">+Console.WriteLine(ep.Item1);+PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA small_A) (UseN theatre_N)))))))) NoVoc+</pre>++<p>Note that depending on the grammar it is absolutely possible that for +a single sentence you might get infinitely many trees. +In other cases the number of trees might be finite but still enormous.+The parser is specifically designed to be lazy, which means that +each tree is returned as soon as it is found before exhausting+the full search space. For grammars with a patological number of+trees it is advisable to pick only the top <tt>N</tt> trees+and to ignore the rest.</p>++<span class="python">+The <tt>parse</tt> method has also the following optional parameters:+<table border=1>+ <tr><td>cat</td><td>start category</td></tr>+ <tr><td>n</td><td>maximum number of trees</td></tr>+ <tr><td>heuristics</td><td>a real number from 0 to 1</td></tr>+ <tr><td>callbacks</td><td>a list of category and callback function</td></tr>+</table>++<p>By using these parameters it is possible for instance to change the start category for+the parser or to limit the number of trees returned from the parser. For example+parsing with a different start category can be done as follows:</p>+<pre class="python">+>>> i = eng.parse("a small theatre", cat=pgf.readType("NP"))+</pre>+</span>+<span class="haskell">+There is also the function <tt>parseWithHeuristics</tt> which +takes two more paramaters which let you to have a better control +over the parser's behaviour:+<pre class="haskell">+Prelude PGF2> let res = parseWithHeuristics eng (startCat gr) heuristic_factor callbacks+</pre>+</span>+<span class="java">+There is also the method <tt>parseWithHeuristics</tt> which +takes two more paramaters which let you to have a better control +over the parser's behaviour:+<pre class="java">+Iterable<ExprProb> iterable = eng.parseWithHeuristics(gr.startCat(), heuristic_factor, callbacks);+</pre>+</span>+<span class="csharp">+The <tt>Parse</tt> method has also the following optional parameters:+<table border=1>+ <tr><td>cat</td><td>start category</td></tr>+ <tr><td>heuristics</td><td>a real number from 0 to 1</td></tr>+</table>++<p>By using these parameters it is possible for instance to change the start category for+the parser. For example parsing with a different start category can be done as follows:</p>+<pre class="csharp">+IEnumerable<Tuple<Expr, float>> enumerable = eng.Parse("this is a small theatre", cat: Type.ReadType("NP"));+</pre>+</span>++<p>The heuristics factor can be used to trade parsing speed for quality.+By default the list of trees is sorted by probability and this corresponds+to factor 0.0. When we increase the factor then parsing becomes faster+but at the same time the sorting becomes imprecise. The worst+factor is 1.0. In any case the parser always returns the same set of+trees but in different order. Our experience is that even a factor+of about 0.6-0.8 with the translation grammar still orders +the most probable tree on top of the list but further down the list,+the trees become shuffled.+</p>++<p>+The callbacks is a list of functions that can be used for recognizing+literals. For example we use those for recognizing names and unknown+words in the translator.+</p>++<h2>Linearization</h2>++You can either linearize the result from the parser back to another+language, or you can explicitly construct a tree and then+linearize it in any language. For example, we can create+a new expression like this:+<pre class="python">+>>> e = pgf.readExpr("AdjCN (PositA red_A) (UseN theatre_N)")+</pre>+<pre class="haskell">+Prelude PGF2> let Just e = readExpr "AdjCN (PositA red_A) (UseN theatre_N)"+</pre>+<pre class="java">+Expr e = Expr.readExpr("AdjCN (PositA red_A) (UseN theatre_N)");+</pre>+<pre class="csharp">+Expr e = Expr.ReadExpr("AdjCN (PositA red_A) (UseN theatre_N)");+</pre>+and then we can linearize it:+<pre class="python">+>>> print(eng.linearize(e))+red theatre+</pre>+<pre class="haskell">+Prelude PGF2> putStrLn (linearize eng e)+red theatre+</pre>+<pre class="java">+System.out.println(eng.linearize(e));+red theatre+</pre>+<pre class="csharp">+Console.WriteLine(eng.Linearize(e));+red theatre+</pre>+This method produces only a single linearization. If you use variants+in the grammar then you might want to see all possible linearizations.+For that purpouse you should use <tt>linearizeAll</tt>:+<pre class="python">+>>> for s in eng.linearizeAll(e):+ print(s)+red theatre+red theater+</pre>+<pre class="haskell">+Prelude PGF2> mapM_ putStrLn (linearizeAll eng e)+red theatre+red theater+</pre>+<pre class="java">+for (String s : eng.linearizeAll(e)) {+ System.out.println(s);+}+red theatre+red theater+</pre>+<pre class="csharp">+foreach (String s in eng.LinearizeAll(e)) {+ Console.WriteLine(s);+}+red theatre+red theater+</pre>+If, instead, you need an inflection table with all possible forms+then the right method to use is <tt>tabularLinearize</tt>:+<pre class="python">+>>> eng.tabularLinearize(e):+{'s Sg Nom': 'red theatre', 's Pl Nom': 'red theatres', 's Pl Gen': "red theatres'", 's Sg Gen': "red theatre's"}+</pre>+<pre class="haskell">+Prelude PGF2> tabularLinearize eng e+[("s Sg Nom","red theatre"),("s Sg Gen","red theatre's"),("s Pl Nom","red theatres"),("s Pl Gen","red theatres'")]+</pre>+<pre class="java">+for (Map.Entry<String,String> entry : eng.tabularLinearize(e).entrySet()) {+ System.out.println(entry.getKey() + ": " + entry.getValue());+}+s Sg Nom: red theatre+s Pl Nom: red theatres+s Pl Gen: red theatres'+s Sg Gen: red theatre's+</pre>+<pre class="csharp">+foreach (Map.Entry<String,String> entry in eng.TabularLinearize(e).EntrySet()) { //// TODO+ Console.WriteLine(entry.Key + ": " + entry.Value);+}+s Sg Nom: red theatre+s Pl Nom: red theatres+s Pl Gen: red theatres'+s Sg Gen: red theatre's+</pre>++<p>+Finally, you could also get a linearization which is bracketed into+a list of phrases:+<pre class="python">+>>> [b] = eng.bracketedLinearize(e)+>>> print(b)+(CN:4 (AP:1 (A:0 red)) (CN:3 (N:2 theatre)))+</pre>+<pre class="haskell">+Prelude PGF2> let [b] = bracketedLinearize eng e+Prelude PGF2> putStrLn (showBracketedString b)+(CN:4 (AP:1 (A:0 red)) (CN:3 (N:2 theatre)))+</pre>+<pre class="java">+Object[] bs = eng.bracketedLinearize(e);+</pre>+<pre class="csharp">+Bracket b = eng.BracketedLinearize(e);+</pre>+<span class="python">+Each element in the sequence above is either a string or an object+of type <tt>pgf.Bracket</tt>. When it is actually a bracket then+the object has the following properties:+<ul>+ <li><tt>cat</tt> - the syntactic category for this bracket</li>+ <li><tt>fid</tt> - an id which identifies this bracket in the bracketed string. If there are discontinuous phrases this id will be shared for all brackets belonging to the same phrase.</li>+ <li><tt>lindex</tt> - the constituent index</li>+ <li><tt>fun</tt> - the abstract function for this bracket</li>+ <li><tt>children</tt> - a list with the children of this bracket</li>+</ul>+</span>+<span class="haskell">+The list above contains elements of type <tt>BracketedString</tt>.+This type has two constructors:+<ul>+ <li><tt>Leaf</tt> with only one argument of type <tt>String</tt> that contains the current word</li>+ <li><tt>Bracket</tt> with the following arguments:+ <ul>+ <li><tt>cat :: String</tt> - the syntactic category for this bracket</li>+ <li><tt>fid :: Int</tt> - an id which identifies this bracket in the bracketed string. If there are discontinuous phrases this id will be shared for all brackets belonging to the same phrase.</li>+ <li><tt>lindex :: Int</tt> - the constituent index</li>+ <li><tt>fun :: String</tt> - the abstract function for this bracket</li>+ <li><tt>children :: [BracketedString]</tt> - a list with the children of this bracket</li>+ </ul>+ </li>+</ul>+</span>+<span class="java">+Each element in the sequence above is either a string or an object+of type <tt>Bracket</tt>. When it is actually a bracket then+the object has the following public final variables:+<ul>+ <li><tt>String cat</tt> - the syntactic category for this bracket</li>+ <li><tt>int fid</tt> - an id which identifies this bracket in the bracketed string. If there are discontinuous phrases this id will be shared for all brackets belonging to the same phrase.</li>+ <li><tt>int lindex</tt> - the constituent index</li>+ <li><tt>String fun</tt> - the abstract function for this bracket</li>+ <li><tt>Object[] children</tt> - a list with the children of this bracket</li>+</ul>+</span>+<span class="csharp">+Each element in the sequence above is either a string or an object+of type <tt>Bracket</tt>. When it is actually a bracket then+the object has the following public final variables:+<ul>+ <li><tt>String cat</tt> - the syntactic category for this bracket</li>+ <li><tt>int fid</tt> - an id which identifies this bracket in the bracketed string. If there are discontinuous phrases this id will be shared for all brackets belonging to the same phrase.</li>+ <li><tt>int lindex</tt> - the constituent index</li>+ <li><tt>String fun</tt> - the abstract function for this bracket</li>+ <li><tt>Object[] children</tt> - a list with the children of this bracket</li>+</ul>+</span>+</p>++The linearization works even if there are functions in the tree +that doesn't have linearization definitions. In that case you+will just see the name of the function in the generated string.+It is sometimes helpful to be able to see whether a function+is linearizable or not. This can be done in this way:+<pre class="python">+>>> print(eng.hasLinearization("apple_N"))+True+</pre>+<pre class="haskell">+Prelude PGF2> print (hasLinearization eng "apple_N")+True+</pre>+<pre class="java">+System.out.println(eng.hasLinearization("apple_N"));+true+</pre>+<pre class="csharp">+Console.WriteLine(eng.HasLinearization("apple_N")); //// TODO+true+</pre>++<h2>Analysing and Constructing Expressions</h2>++<p>+An already constructed tree can be analyzed and transformed+in the host application. For example you can deconstruct +a tree into a function name and a list of arguments:+<pre class="python">+>>> e.unpack()+('AdjCN', [<pgf.Expr object at 0x7f7df6db78c8>, <pgf.Expr object at 0x7f7df6db7878>])+</pre>+<pre class="haskell">+Prelude PGF2> unApp e+Just ("AdjCN", [..., ...])+</pre>+<pre class="java">+ExprApplication app = e.unApp();+System.out.println(app.getFunction());+for (Expr arg : app.getArguments()) {+ System.out.println(arg);+}+</pre>+<pre class="csharp">+ExprApplication app = e.UnApp();+System.out.println(app.Function);+foreach (Expr arg in app.Arguments) {+ Console.WriteLine(arg);+}+</pre>+</p>+<p>+<span class="python">+The result from unpack can be different depending on the form of the+tree. If the tree is a function application then you always get+a tuple of a function name and a list of arguments. If instead the+tree is just a literal string then the return value is the actual+literal. For example the result from:+</span>+<pre class="python">+>>> pgf.readExpr('"literal"').unpack()+'literal'+</pre>+<span class="haskell">+The result from <tt>unApp</tt> is <tt>Just</tt> if the expression+is an application and <tt>Nothing</tt> in all other cases.+Similarly, if the tree is a literal string then the return value +from <tt>unStr</tt> will be <tt>Just</tt> with the actual literal. +For example the result from:+</span>+<pre class="haskell">+Prelude PGF2> readExpr "\"literal\"" >>= unStr+"literal"+</pre>+<span class="java">+The result from <tt>unApp</tt> is not <tt>null</tt> if the expression+is an application, and <tt>null</tt> in all other cases.+Similarly, if the tree is a literal string then the return value +from <tt>unStr</tt> will not be <tt>null</tt> with the actual literal. +For example the output from:+</span>+<pre class="java">+Expr elit = Expr.readExpr("\"literal\"");+System.out.println(elit.unStr());+</pre>+<span class="csharp">+The result from <tt>UnApp</tt> is not <tt>null</tt> if the expression+is an application, and <tt>null</tt> in all other cases.+Similarly, if the tree is a literal string then the return value +from <tt>UnStr</tt> will not be <tt>null</tt> with the actual literal. +For example the output from:+</span>+<pre class="csharp">+Expr elit = Expr.ReadExpr("\"literal\"");+Console.WriteLine(elit.UnStr());+</pre>+is just the string "literal". +<span class="python">Situations like this can be detected+in Python by checking the type of the result from <tt>unpack</tt>.+It is also possible to get an integer or a floating point number+for the other possible literal types in GF.</span>+<span class="haskell">+There are also the functions <tt>unAbs</tt>, <tt>unInt</tt>, <tt>unFloat</tt> and <tt>unMeta</tt> for all other possible cases.+</span>+<span class="java">+There are also the methods <tt>unAbs</tt>, <tt>unInt</tt>, <tt>unFloat</tt> and <tt>unMeta</tt> for all other possible cases.+</span>+<span class="csharp">+There are also the methods <tt>UnAbs</tt>, <tt>UnInt</tt>, <tt>UnFloat</tt> and <tt>UnMeta</tt> for all other possible cases.+</span>+</p>++Constructing new trees is also easy. You can either use +<tt>readExpr</tt> to read trees from strings, or you can+construct new trees from existing pieces. This is possible by+<span class="python">+using the constructor for <tt>pgf.Expr</tt>:+<pre class="python">+>>> quant = pgf.readExpr("DetQuant IndefArt NumSg")+>>> e2 = pgf.Expr("DetCN", [quant, e])+>>> print(e2)+DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA red_A) (UseN theatre_N))+</pre>+</span>+<span class="haskell">+using the functions <tt>mkApp</tt>, <tt>mkStr</tt>, <tt>mkInt</tt>, <tt>mkFloat</tt> and <tt>mkMeta</tt>:+<pre class="haskell">+Prelude PGF2> let Just quant = readExpr "DetQuant IndefArt NumSg"+Prelude PGF2> let e2 = mkApp "DetCN" [quant, e]+Prelude PGF2> print e2+DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA red_A) (UseN theatre_N))+</pre>+</span>+<span class="java">+using the constructor for <tt>Expr</tt>:+<pre class="java">+Expr quant = Expr.readExpr("DetQuant IndefArt NumSg");+Expr e2 = new Expr("DetCN", new Expr[] {quant, e});+System.out.println(e2);+</pre>+</span>+<span class="csharp">+using the constructor for <tt>Expr</tt>:+<pre class="csharp">+Expr quant = Expr.ReadExpr("DetQuant IndefArt NumSg");+Expr e2 = new Expr("DetCN", new Expr[] {quant, e});+Console.WriteLine(e2);+</pre>+</span>++<h2>Embedded GF Grammars</h2>++<p>If the host application needs to do a lot of expression manipulations,+then it is helpful to use a higher-level API to the grammar,+also known as "embedded grammars" in GF. The advantage is that+you can construct and analyze expressions in a more compact way.</p> ++<span class="python">+<p>In Python you first have to <tt>embed</tt> the grammar by calling:+<pre class="python">+>>> gr.embed("App")+<module 'App' (built-in)>+</pre>+After that whenever you need the API you should import the module:+<pre class="python">+>>> import App+</pre>+</p>+<p>Now creating new trees is just a matter of calling ordinary Python+functions:+<pre class="python">+>>> print(App.DetCN(quant,e))+DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA red_A) (UseN house_N))+</pre>+</p>+</span>+<span class="haskell">+<p>In order to access the API you first need to generate+one boilerplate Haskell module with the compiler:+<pre class="haskell">+$ gf -make -output-format=haskell App.pgf+</pre>+This module will expose all functions in the abstract syntax+as data type constructors together with methods for conversion from+a generic expression to Haskell data and vice versa. When you need the API you can just import the module:+<pre class="haskell">+Prelude PGF2> import App+</pre>+</p>+<p>Now creating new trees is just a matter of writing ordinary Haskell+code:+<pre class="haskell">+Prelude PGF2 App> print (gf (GDetCN (GDetQuant GIndefArt GNumSg) (GAdjCN (GPositA Gred_A) (GUseN Ghouse_N))))+</pre>+The only difference is that to the name of every abstract syntax function+the compiler adds a capital 'G' in order to guarantee that there are no conflicts+and that all names are valid names for Haskell data constructors. Here <tt>gf</tt> is a function+which converts from the data type representation to generic GF expressions.</p>++<p>The converse function <tt>fg</tt> converts an expression to a data type expression.+This is useful for instance if you want to do pattern matching+on the structure of the expression:+<pre class="haskell">+visit = case fg e2 of+ GDetCN quant cn -> do putStrLn "Found DetCN"+ visit cn+ GAdjCN adj cn -> do putStrLn "Found AdjCN"+ visit cn+ e -> return ()+</pre>+</p>+</span>+<span class="java">+<p>In order to access the API you first need to generate+one boilerplate Java class with the compiler:+<pre class="java">+$ gf -make -output-format=java App.pgf+</pre>+This class will expose all functions in the abstract syntax+as methods. Now creating new trees is just a matter of writing ordinary Java+code:+<pre class="java">+System.out.println(App.DetCN(quant, cn));+</pre>+If the grammar name is too long to write it in front of every function+name then you can create an instance with a shorter name:+<pre class="java">+App a = new App();+System.out.println(a.DetCN(quant, cn));+</pre>+</p>+</span>+<span class="csharp">+<p>In C# you first have to <tt>embed</tt> the grammar by calling:+<pre class="csharp">+dynamic g = gr.Embed()+</pre>+</p>+<p>Now creating new trees is just a matter of calling ordinary C#+methods:+<pre class="csharp">+Console.WriteLine(g.DetCN(quant,e))+DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA red_A) (UseN house_N))+</pre>+</p>+</span>++<span class="python">+<p>+Analysing expressions is also made easier by using the visitor pattern.+In object oriented languages this is a clumpsy way to do+what is called pattern matching in most functional languages.+You need to define a class which has one method for each function+in the abstract syntax that you want to handle. If the functions is called+<tt>f</tt> then you need a method called <tt>on_f</tt>. The method+will be called each time when the corresponding function is encountered,+and its arguments will be the arguments from the original tree.+If there is no matching method name then the runtime will+call the method <tt>default</tt>. The following is an example:+<pre class="python">+>>> class ExampleVisitor:+ def on_DetCN(self,quant,cn):+ print("Found DetCN")+ cn.visit(self)+ + def on_AdjCN(self,adj,cn):+ print("Found AdjCN")+ cn.visit(self)++ def default(self,e):+ pass+>>> e2.visit(ExampleVisitor())+Found DetCN+Found AdjCN+</pre>+Here we call the method <tt>visit</tt> from the tree e2 and we give+it, as parameter, an instance of class <tt>ExampleVisitor</tt>.+<tt>ExampleVisitor</tt> has two methods <tt>on_DetCN</tt>+and <tt>on_AdjCN</tt> which are called when the top function of+the current tree is <tt>DetCN</tt> or <tt>AdjCN</tt>+correspondingly. In this example we just print a message and+we call <tt>visit</tt> recursively to go deeper into the tree.+</p>+</span>+<span class="java">+<p>+Analysing expressions is also made easier by using the visitor pattern.+In object oriented languages this is a clumpsy way to do+what is called pattern matching in most functional languages.+You need to define a class which has one method for each function+in the abstract syntax that you want to handle. If the functions is called+<tt>f</tt> then you need a method called <tt>on_f</tt>. The method+will be called each time when the corresponding function is encountered,+and its arguments will be the arguments from the original tree.+If there is no matching method name then the runtime will+call the method <tt>defaultCase</tt>. The following is an example:+<pre class="java">+e2.visit(new Object() {+ public void on_DetCN(Expr quant, Expr cn) {+ System.out.println("found DetCN");+ cn.visit(this);+ }++ public void on_AdjCN(Expr adj, Expr cn) {+ System.out.println("found AdjCN");+ cn.visit(this);+ }++ public void defaultCase(Expr e) {+ System.out.println("found "+e);+ }+ });+Found DetCN+Found AdjCN+</pre>+Here we call the method <tt>visit</tt> from the tree e2 and we give+it, as parameter, an instance of a class with two methods <tt>on_DetCN</tt>+and <tt>on_AdjCN</tt> which are called when the top function of+the current tree is <tt>DetCN</tt> or <tt>AdjCN</tt>+correspondingly. In this example we just print a message and+we call <tt>visit</tt> recursively to go deeper into the tree.+</p>+</span>++<h2>Access the Morphological Lexicon</h2>++There are two methods that gives you direct access to the morphological+lexicon. The first makes it possible to dump the full form lexicon.+The following code just iterates over the lexicon and prints each+word form with its possible analyses:+<pre class="python">+>>> for entry in eng.fullFormLexicon():+>>> print(entry)+</pre>+<pre class="haskell">+Prelude PGF2> mapM_ print [(form,lemma,analysis,prob) | (form,analyses) <- fullFormLexicon eng, (lemma,analysis,prob) <- analyses]+</pre>+<pre class="java">+for (FullFormEntry entry : eng.fullFormLexicon()) {+ for (MorphoAnalysis analysis : entry.getAnalyses()) {+ System.out.println(entry.getForm()+" "+analysis.getProb()+" "+analysis.getLemma()+" "+analysis.getField());+ }+}+</pre>+<pre class="csharp">+foreach (FullFormEntry entry in eng.FullFormLexicon) { //// TODO+ foreach (MorphoAnalysis analysis in entry.Analyses) {+ Console.WriteLine(entry.Form+" "+analysis.Prob+" "+analysis.Lemma+" "+analysis.Field);+ }+}+</pre>+The second one implements a simple lookup. The argument is a word+form and the result is a list of analyses:+<pre class="python">+>>> print(eng.lookupMorpho("letter"))+[('letter_1_N', 's Sg Nom', inf), ('letter_2_N', 's Sg Nom', inf)]+</pre>+<pre class="haskell">+Prelude PGF2> print (lookupMorpho eng "letter")+[('letter_1_N', 's Sg Nom', inf), ('letter_2_N', 's Sg Nom', inf)]+</pre>+<pre class="java">+for (MorphoAnalysis an : eng.lookupMorpho("letter")) {+ System.out.println(an.getLemma()+", "+an.getField()+", "+an.getProb());+}+letter_1_N, s Sg Nom, inf+letter_2_N, s Sg Nom, inf+</pre>+<pre class="csharp">+foreach (MorphoAnalysis an in eng.LookupMorpho("letter")) { //// TODO+ Console.WriteLine(an.Lemma+", "+an.Field+", "+an.Prob);+}+letter_1_N, s Sg Nom, inf+letter_2_N, s Sg Nom, inf+</pre>++<h2>Access the Abstract Syntax</h2>++There is a simple API for accessing the abstract syntax. For example,+you can get a list of abstract functions:+<pre class="python">+>>> gr.functions+....+</pre>+<pre class="haskell">+Prelude PGF2> functions gr+....+</pre>+<pre class="java">+List<String> funs = gr.getFunctions()+....+</pre>+<pre class="csharp">+IEnumerable<String> funs = gr.Functions;+....+</pre>+or a list of categories:+<pre class="python">+>>> gr.categories+....+</pre>+<pre class="haskell">+Prelude PGF2> categories gr+....+</pre>+<pre class="java">+List<String> cats = gr.getCategories();+....+</pre>+<pre class="csharp">+IEnumerable<String> cats = gr.Categories;+....+</pre>+You can also access all functions with the same result category:+<pre class="python">+>>> gr.functionsByCat("Weekday")+['friday_Weekday', 'monday_Weekday', 'saturday_Weekday', 'sunday_Weekday', 'thursday_Weekday', 'tuesday_Weekday', 'wednesday_Weekday']+</pre>+<pre class="haskell">+Prelude PGF2> functionsByCat gr "Weekday"+['friday_Weekday', 'monday_Weekday', 'saturday_Weekday', 'sunday_Weekday', 'thursday_Weekday', 'tuesday_Weekday', 'wednesday_Weekday']+</pre>+<pre class="java">+List<String> funsByCat = gr.getFunctionsByCat("Weekday");+....+</pre>+<pre class="csharp">+IEnumerable<String> funsByCat = gr.FunctionsByCat("Weekday");+....+</pre>+The full type of a function can be retrieved as:+<pre class="python">+>>> print(gr.functionType("DetCN"))+Det -> CN -> NP+</pre>+<pre class="haskell">+Prelude PGF2> print (functionType gr "DetCN")+Just (Det -> CN -> NP)+</pre>+<pre class="java">+System.out.println(gr.getFunctionType("DetCN"));+Det -> CN -> NP+</pre>+<pre class="csharp">+Console.WriteLine(gr.FunctionType("DetCN"));+Det -> CN -> NP+</pre>++<h2>Type Checking Abstract Trees</h2>++<p>The runtime type checker can do type checking and type inference+for simple types. Dependent types are still not fully implemented+in the current runtime. The inference is done with method <tt>inferExpr</tt>:+<pre class="python">+>>> e,ty = gr.inferExpr(e)+>>> print(e)+AdjCN (PositA red_A) (UseN theatre_N)+>>> print(ty)+CN+</pre>+<pre class="haskell">+Prelude PGF2> let Right (e',ty) = inferExpr gr e+Prelude PGF2> print e'+AdjCN (PositA red_A) (UseN theatre_N)+Prelude PGF2> print ty+CN+</pre>+<pre class="java">+TypedExpr te = gr.inferExpr(e);+System.out.println(te.getExpr()+" : "+te.getType());+AdjCN (PositA red_A) (UseN theatre_N) : CN+</pre>+<pre class="csharp">+TypedExpr te = gr.InferExpr(e); //// TODO+Console.WriteLine(te.Expr+" : "+te.Type);+AdjCN (PositA red_A) (UseN theatre_N) : CN+</pre>+The result is a potentially updated expression and its type. In this+case we always deal with simple types, which means that the new+expression will be always equal to the original expression. However, this+wouldn't be true when dependent types are added.+</p>++<p>Type checking is also trivial:+<pre class="python">+>>> e = gr.checkExpr(e,pgf.readType("CN"))+>>> print(e)+AdjCN (PositA red_A) (UseN theatre_N)+</pre>+<pre class="haskell">+Prelude PGF2> let Just ty = readType "CN"+Prelude PGF2> let Right e' = checkExpr gr e ty+Prelude PGF2> print e'+AdjCN (PositA red_A) (UseN theatre_N)+</pre>+<pre class="java">+Expr new_e = gr.checkExpr(e,Type.readType("CN"));+System.out.println(e)+</pre>+<pre class="csharp">+Expr new_e = gr.CheckExpr(e,Type.ReadType("CN")); //// TODO+Console.WriteLine(e)+</pre>+<p>In case of type error you will get an error:+<pre class="python">+>>> e = gr.checkExpr(e,pgf.readType("A"))+pgf.TypeError: The expected type of the expression AdjCN (PositA red_A) (UseN theatre_N) is A but CN is infered+</pre>+<pre class="haskell">+Prelude PGF2> let Just ty = readType "A"+Prelude PGF2> let Left msg = checkExpr gr e ty+Prelude PGF2> putStrLn msg+</pre>+<pre class="java">+Expr e = gr.checkExpr(e,Type.readType("A"))+TypeError: The expected type of the expression AdjCN (PositA red_A) (UseN theatre_N) is A but CN is infered+</pre></p>++<span class="python">+<h2>Partial Grammar Loading</h2>++<p>By default the whole grammar is compiled into a single file+which consists of an abstract syntax together will all concrete+languages. For large grammars with many languages this might be+inconvinient because loading becomes slower and the grammar takes+more memory. For that purpose you could split the grammar into+one file for the abstract syntax and one file for every concrete syntax.+This is done by using the option <tt>-split-pgf</tt> in the compiler:+<pre class="python">+$ gf -make -split-pgf App12.pgf+</pre>+</p>++Now you can load the grammar as usual but this time only the+abstract syntax will be loaded. You can still use the <tt>languages</tt>+property to get the list of languages and the corresponding+concrete syntax objects:+<pre class="python">+>>> gr = pgf.readPGF("App.pgf")+>>> eng = gr.languages["AppEng"]+</pre>+However, if you now try to use the concrete syntax then you will+get an exception:+<pre class="python">+>>> eng.lookupMorpho("letter")+Traceback (most recent call last):+ File "<stdin>", line 1, in <module>+pgf.PGFError: The concrete syntax is not loaded+</pre>++Before using the concrete syntax, you need to explicitly load it: +<pre class="python">+>>> eng.load("AppEng.pgf_c")+>>> print(eng.lookupMorpho("letter"))+[('letter_1_N', 's Sg Nom', inf), ('letter_2_N', 's Sg Nom', inf)]+</pre>++When you don't need the language anymore then you can simply+unload it:+<pre class="python">+>>> eng.unload()+</pre>+</span>++<span class="java">+<h2>Partial Grammar Loading</h2>++<p>By default the whole grammar is compiled into a single file+which consists of an abstract syntax together will all concrete+languages. For large grammars with many languages this might be+inconvinient because loading becomes slower and the grammar takes+more memory. For that purpose you could split the grammar into+one file for the abstract syntax and one file for every concrete syntax.+This is done by using the option <tt>-split-pgf</tt> in the compiler:+<pre class="java">+$ gf -make -split-pgf App12.pgf+</pre>+This creates the following files:+<pre class="java">+Writing App.pgf...+Writing AppEng.pgf_c...+Writing AppSwe.pgf_c...+...+</pre>+</p>++Now you can load the grammar <tt>App.pgf</tt> as usual but this time only the+abstract syntax will be loaded. You can still use the <tt>languages</tt>+property to get the list of languages and the corresponding+concrete syntax objects:+<pre class="java">+PGF gr = PGF.readPGF("App.pgf")+Concr eng = gr.getLanguages().get("AppEng")+</pre>+However, if you now try to use the concrete syntax then you will+get an exception:+<pre class="java">+eng.lookupMorpho("letter")+Traceback (most recent call last):+ File "<stdin>", line 1, in <module>+pgf.PGFError: The concrete syntax is not loaded+</pre>++Before using the concrete syntax, you need to explicitly load it: +<pre class="java">+eng.load("AppEng.pgf_c")+for (MorphoAnalysis an : eng.lookupMorpho("letter")) {+ System.out.println(an.getLemma()+", "+an.getField()+", "+an.getProb());+}+letter_1_N, s Sg Nom, inf+letter_2_N, s Sg Nom, inf+</pre>++When you don't need the language anymore then you can simply+unload it:+<pre class="java">+eng.unload()+</pre>+</span>++<h2>GraphViz</h2>++<p>GraphViz is used for visualizing abstract syntax trees and parse trees.+In both cases the result is a GraphViz code that can be used for+rendering the trees. See the examples bellow:</p>++<pre class="python">+>>> print(gr.graphvizAbstractTree(e))+graph {+n0[label = "AdjCN", style = "solid", shape = "plaintext"]+n1[label = "PositA", style = "solid", shape = "plaintext"]+n2[label = "red_A", style = "solid", shape = "plaintext"]+n1 -- n2 [style = "solid"]+n0 -- n1 [style = "solid"]+n3[label = "UseN", style = "solid", shape = "plaintext"]+n4[label = "theatre_N", style = "solid", shape = "plaintext"]+n3 -- n4 [style = "solid"]+n0 -- n3 [style = "solid"]+}+</pre>+<pre class="haskell">+Prelude PGF2> putStrLn (graphvizAbstractTree gr graphvizDefaults e)+graph {+n0[label = "AdjCN", style = "solid", shape = "plaintext"]+n1[label = "PositA", style = "solid", shape = "plaintext"]+n2[label = "red_A", style = "solid", shape = "plaintext"]+n1 -- n2 [style = "solid"]+n0 -- n1 [style = "solid"]+n3[label = "UseN", style = "solid", shape = "plaintext"]+n4[label = "theatre_N", style = "solid", shape = "plaintext"]+n3 -- n4 [style = "solid"]+n0 -- n3 [style = "solid"]+}+</pre>+<pre class="java">+System.out.println(gr.graphvizAbstractTree(e));+graph {+n0[label = "AdjCN", style = "solid", shape = "plaintext"]+n1[label = "PositA", style = "solid", shape = "plaintext"]+n2[label = "red_A", style = "solid", shape = "plaintext"]+n1 -- n2 [style = "solid"]+n0 -- n1 [style = "solid"]+n3[label = "UseN", style = "solid", shape = "plaintext"]+n4[label = "theatre_N", style = "solid", shape = "plaintext"]+n3 -- n4 [style = "solid"]+n0 -- n3 [style = "solid"]+}+</pre>+<pre class="csharp">+Console.WriteLine(gr.GraphvizAbstractTree(e)); //// TODO+graph {+n0[label = "AdjCN", style = "solid", shape = "plaintext"]+n1[label = "PositA", style = "solid", shape = "plaintext"]+n2[label = "red_A", style = "solid", shape = "plaintext"]+n1 -- n2 [style = "solid"]+n0 -- n1 [style = "solid"]+n3[label = "UseN", style = "solid", shape = "plaintext"]+n4[label = "theatre_N", style = "solid", shape = "plaintext"]+n3 -- n4 [style = "solid"]+n0 -- n3 [style = "solid"]+}+</pre>++<pre class="python">+>>> print(eng.graphvizParseTree(e))+graph {+ node[shape=plaintext]++ subgraph {rank=same;+ n4[label="CN"]+ }++ subgraph {rank=same;+ edge[style=invis]+ n1[label="AP"]+ n3[label="CN"]+ n1 -- n3+ }+ n4 -- n1+ n4 -- n3++ subgraph {rank=same;+ edge[style=invis]+ n0[label="A"]+ n2[label="N"]+ n0 -- n2+ }+ n1 -- n0+ n3 -- n2++ subgraph {rank=same;+ edge[style=invis]+ n100000[label="red"]+ n100001[label="theatre"]+ n100000 -- n100001+ }+ n0 -- n100000+ n2 -- n100001+}+</pre>+<pre class="haskell">+Prelude PGF2> putStrLn (graphvizParseTree eng graphvizDefaults e)+graph {+ node[shape=plaintext]++ subgraph {rank=same;+ n4[label="CN"]+ }++ subgraph {rank=same;+ edge[style=invis]+ n1[label="AP"]+ n3[label="CN"]+ n1 -- n3+ }+ n4 -- n1+ n4 -- n3++ subgraph {rank=same;+ edge[style=invis]+ n0[label="A"]+ n2[label="N"]+ n0 -- n2+ }+ n1 -- n0+ n3 -- n2++ subgraph {rank=same;+ edge[style=invis]+ n100000[label="red"]+ n100001[label="theatre"]+ n100000 -- n100001+ }+ n0 -- n100000+ n2 -- n100001+}+</pre>+<pre class="java">+System.out.println(eng.graphvizParseTree(e));+graph {+ node[shape=plaintext]++ subgraph {rank=same;+ n4[label="CN"]+ }++ subgraph {rank=same;+ edge[style=invis]+ n1[label="AP"]+ n3[label="CN"]+ n1 -- n3+ }+ n4 -- n1+ n4 -- n3++ subgraph {rank=same;+ edge[style=invis]+ n0[label="A"]+ n2[label="N"]+ n0 -- n2+ }+ n1 -- n0+ n3 -- n2++ subgraph {rank=same;+ edge[style=invis]+ n100000[label="red"]+ n100001[label="theatre"]+ n100000 -- n100001+ }+ n0 -- n100000+ n2 -- n100001+}+</pre>+<pre class="csharp">+Console.WriteLine(eng.GraphvizParseTree(e)); //// TODO+graph {+ node[shape=plaintext]++ subgraph {rank=same;+ n4[label="CN"]+ }++ subgraph {rank=same;+ edge[style=invis]+ n1[label="AP"]+ n3[label="CN"]+ n1 -- n3+ }+ n4 -- n1+ n4 -- n3++ subgraph {rank=same;+ edge[style=invis]+ n0[label="A"]+ n2[label="N"]+ n0 -- n2+ }+ n1 -- n0+ n3 -- n2++ subgraph {rank=same;+ edge[style=invis]+ n100000[label="red"]+ n100001[label="theatre"]+ n100000 -- n100001+ }+ n0 -- n100000+ n2 -- n100001+}+</pre>++ </body>+</html>+
binary file changed (absent → 66840 bytes)
binary file changed (absent → 12903 bytes)
binary file changed (absent → 4241 bytes)
binary file changed (absent → 19002 bytes)
binary file changed (absent → 98845 bytes)
binary file changed (absent → 2099 bytes)
@@ -0,0 +1,5039 @@+Grammatical Framework Tutorial+Aarne Ranta+December 2010 for GF 3.2+++% NOTE: this is a txt2tags file.+% Create a tex file from this file using:+% txt2tags --toc -ttex gf-tutorial.txt++%!target:html+%!encoding: utf-8+%!options: --toc++%!postproc(tex) : "\\subsection\*" "\\newslide"+%!preproc(tex): "#NEW" ""+%!postproc(html): #NEW <!-- NEW -->++++%!postproc(html): #OVERVIEW <h2>Overview</h2>++%%!postproc(tex): "section\*" "section"++%!postproc(tex): "\\documentclass{article}" ""++%!postproc(tex): "subsection\*" "section"+%!postproc(tex): "section\*" "chapter"++%!postproc(tex): "textbf{Exercise}" "exercise"+%!postproc(tex): "textbf" "keywrd"++%!postproc(html): #BCEN <center>+%!postproc(html): #ECEN </center>++%!postproc(tex): #BCEN "begin{center}"+%!postproc(tex): #ECEN "end{center}"++%!postproc(tex): #BEQU "bequ"+%!postproc(tex): #ENQU "enqu"+%!postproc(html): #BEQU "<center>"+%!postproc(html): #ENQU "</center>"++%!preproc(html): #EDITORPNG [quick-editor.png]+%!preproc(tex): #EDITORPNG [10lang-small.png]++%!preproc(html): #LOGOPNG [Logos/gf0.png]+%!preproc(tex): #LOGOPNG [Logos/gf0.png]+++%!postproc(tex): #PARTone "part{Tutorial}"+%!postproc(tex): #PARTtwo "part{Applications of Grammars}"+%!postproc(tex): #PARTfour "part{Advanced Grammar Writing}"+%!postproc(tex): #PARTthree "part{Reference Manual}"++%%!postproc(tex): #PARTbnf "include{DocGF}"+%!postproc(tex): #PARTquickref "chapter{Quick Reference}"+%!postproc(tex): #twocolumn ""%twocolumn"+%!postproc(tex): #newpage "newpage"+%!postproc(tex): #smallsize "small"+%!postproc(tex): #normalsize "normalsize"+%!postproc(tex): #startappendix "appendix"+++%!postproc(tex): #indexYACC "index{YACC}"++%!postproc(tex): #MYTREE "input{mytree}"+%!preproc(html): #MYTREE [mytree.png]+%!preproc(html): #MYPARSE [myparse.png]+%!postproc(tex): #FOODMARKET "input{foodmarket}"+%!preproc(html): #FOODMARKET [foodmarket.png]+%!postproc(tex): #CATEGORIES "input{categories}"+%!preproc(html): #CATEGORIES [categories.png]++%!postproc(tex): #Syntaxpic "input{Syntax}"+%!postproc(tex): #Germanpic "input{German}"++%!postproc(tex): #REFERENCES "input{references}"++%!postproc(tex): #FORMULAone "input{FORMULAone}"++%!postproc(tex): #SETLENGTHS "input{SETLENGTHS}"++%!postproc(tex): #PRINTINDEX "printindex"++%!postproc(tex): #Lchaptwo "label{chaptwo}"+%!postproc(tex): #Rchaptwo "chref{chaptwo}"+%!postproc(html): #Lchaptwo <a name="chaptwo"></a>+%!postproc(html): #Rchaptwo <a href="#chaptwo">Lesson 1</a>++%!postproc(tex): #Lchapthree "label{chapthree}"+%!postproc(tex): #Rchapthree "chref{chapthree}"+%!postproc(html): #Lchapthree <a name="chapthree"></a>+%!postproc(html): #Rchapthree <a href="#chapthree">Lesson 2</a>++%!postproc(tex): #Lchapfour "label{chapfour}"+%!postproc(tex): #Rchapfour "chref{chapfour}"+%!postproc(html): #Lchapfour <a name="chapfour"></a>+%!postproc(html): #Rchapfour <a href="#chapfour">Lesson 3</a>++%!postproc(tex): #Lchapfive "label{chapfive}"+%!postproc(tex): #Rchapfive "chref{chapfive}"+%!postproc(html): #Lchapfive <a name="chapfive"></a>+%!postproc(html): #Rchapfive <a href="#chapfive">Lesson 4</a>++%!postproc(tex): #Lchapsix "label{chapsix}"+%!postproc(tex): #Rchapsix "chref{chapsix}"+%!postproc(html): #Lchapsix <a name="chapsix"></a>+%!postproc(html): #Rchapsix <a href="#chapsix">Lesson 5</a>++%!postproc(tex): #Lchapseven "label{chapseven}"+%!postproc(tex): #Rchapseven "chref{chapseven}"+%!postproc(html): #Lchapseven <a name="chapseven"></a>+%!postproc(html): #Rchapseven <a href="#chapseven">Lesson 6</a>++%!postproc(tex): #Lchapeight "label{chapeight}"+%!postproc(tex): #Rchapeight "chref{chapeight}"+%!postproc(html): #Lchapeight <a name="chapeight"></a>+%!postproc(html): #Rchapeight <a href="#chapeight">Lesson 7</a>+++%2.7.2+%!postproc(tex): #Lsecjment "label{secjment}"+%!postproc(tex): #Rsecjment "sref{secjment}"+%!postproc(html): #Lsecjment <a name="secjment"></a>+%!postproc(html): #Rsecjment <a href="#secjment">here</a>++%3.4+%!postproc(tex): #Lsecanitalian "label{secanitalian}"+%!postproc(tex): #Rsecanitalian "sref{secanitalian}"+%!postproc(html): #Lsecanitalian <a name="secanitalian"></a>+%!postproc(html): #Rsecanitalian <a href="#secanitalian">here</a>++%3.6.1+%!postproc(tex): #Lsectreebank "label{sectreebank}"+%!postproc(tex): #Rsectreebank "sref{sectreebank}"+%!postproc(html): #Lsectreebank <a name="sectreebank"></a>+%!postproc(html): #Rsectreebank <a href="#sectreebank">here</a>+++%3.6.4+%!postproc(tex): #Lsecediting "label{secediting}"+%!postproc(tex): #Rsecediting "sref{secediting}"+%!postproc(html): #Lsecediting <a name="secediting"></a>+%!postproc(html): #Rsecediting <a href="#secediting">here</a>+++%3.9.5+%!postproc(tex): #Lsecpartapp "label{secpartapp}"+%!postproc(tex): #Rsecpartapp "sref{secpartapp}"+%!postproc(html): #Lsecpartapp <a name="secpartapp"></a>+%!postproc(html): #Rsecpartapp <a href="#secpartapp">here</a>++%3.10+%!postproc(tex): #Lsecarchitecture "label{secarchitecture}"+%!postproc(tex): #Rsecarchitecture "sref{secarchitecture}"+%!postproc(html): #Lsecarchitecture <a name="secarchitecture"></a>+%!postproc(html): #Rsecarchitecture <a href="#secarchitecture">here</a>++%4.6+%!postproc(tex): #Lsecinflection "label{secinflection}"+%!postproc(tex): #Rsecinflection "sref{secinflection}"+%!postproc(html): #Lsecinflection <a name="secinflection"></a>+%!postproc(html): #Rsecinflection <a href="#secinflection">here</a>++%4.7+%!postproc(tex): #Lsecitalian "label{secitalian}"+%!postproc(tex): #Rsecitalian "sref{secitalian}"+%!postproc(html): #Lsecitalian <a name="secitalian"></a>+%!postproc(html): #Rsecitalian <a href="#secitalian">here</a>++%4.10.2+%!postproc(tex): #Lsecmatching "label{secmatching}"+%!postproc(tex): #Rsecmatching "sref{secmatching}"+%!postproc(html): #Lsecmatching <a name="secmatching"></a>+%!postproc(html): #Rsecmatching <a href="#secmatching">here</a>++%5.2+%!postproc(tex): #Lseclexical "label{seclexical}"+%!postproc(tex): #Rseclexical "sref{seclexical}"+%!postproc(html): #Lseclexical <a name="seclexical"></a>+%!postproc(html): #Rseclexical <a href="#seclexical">here</a>++%5.4+%!postproc(tex): #Lsecenglish "label{secenglish}"+%!postproc(tex): #Rsecenglish "sref{secenglish}"+%!postproc(html): #Lsecenglish <a name="secenglish"></a>+%!postproc(html): #Rsecenglish <a href="#secenglish">here</a>++%5.5+%!postproc(tex): #Lsecfunctor "label{secfunctor}"+%!postproc(tex): #Rsecfunctor "sref{secfunctor}"+%!postproc(html): #Lsecfunctor <a name="secfunctor"></a>+%!postproc(html): #Rsecfunctor <a href="#secfunctor">here</a>++%5.6+%!postproc(tex): #Lsecinterface "label{secinterface}"+%!postproc(tex): #Rsecinterface "sref{secinterface}"+%!postproc(html): #Lsecinterface <a name="secinterface"></a>+%!postproc(html): #Rsecinterface <a href="#secinterface">here</a>++%5.11+%!postproc(tex): #Lsecbrowsing "label{secbrowsing}"+%!postproc(tex): #Rsecbrowsing "sref{secbrowsing}"+%!postproc(html): #Lsecbrowsing <a name="secbrowsing"></a>+%!postproc(html): #Rsecbrowsing <a href="#secbrowsing">here</a>++%5.12+%!postproc(tex): #Lsecextended "label{secextended}"+%!postproc(tex): #Rsecextended "sref{secextended}"+%!postproc(html): #Lsecextended <a name="secextended"></a>+%!postproc(html): #Rsecextended <a href="#secextended">here</a>++%5.13+%!postproc(tex): #Lsectense "label{sectense}"+%!postproc(tex): #Rsectense "sref{sectense}"+%!postproc(html): #Lsectense <a name="sectense"></a>+%!postproc(html): #Rsectense <a href="#sectense">here</a>++%5.14.2+%!postproc(tex): #Lseclock "label{seclock}"+%!postproc(tex): #Rseclock "sref{seclock}"+%!postproc(html): #Lseclock <a name="seclock"></a>+%!postproc(html): #Rseclock <a href="#seclock">here</a>++%6.2+%!postproc(tex): #Lsecsmarthouse "label{secsmarthouse}"+%!postproc(tex): #Rsecsmarthouse "sref{secsmarthouse}"+%!postproc(html): #Lsecsmarthouse <a name="secsmarthouse"></a>+%!postproc(html): #Rsecsmarthouse <a href="#secsmarthouse">here</a>++%6.3+%!postproc(tex): #Lsecpolymorphic "label{secpolymorphic}"+%!postproc(tex): #Rsecpolymorphic "sref{secpolymorphic}"+%!postproc(html): #Lsecpolymorphic <a name="secpolymorphic"></a>+%!postproc(html): #Rsecpolymorphic <a href="#secpolymorphic">here</a>++%6.7+%!postproc(tex): #Lsecbinding "label{secbinding}"+%!postproc(tex): #Rsecbinding "sref{secbinding}"+%!postproc(html): #Lsecbinding <a name="secbinding"></a>+%!postproc(html): #Rsecbinding <a href="#secbinding">here</a>+++%6.8+%!postproc(tex): #Lsecdefdef "label{secdefdef}"+%!postproc(tex): #Rsecdefdef "sref{secdefdef}"+%!postproc(html): #Lsecdefdef <a name="secdefdef"></a>+%!postproc(html): #Rsecdefdef <a href="#secdefdef">here</a>++%7.2+%!postproc(tex): #Lseclexing "label{seclexing}"+%!postproc(tex): #Rseclexing "sref{seclexing}"+%!postproc(html): #Lseclexing <a name="seclexing"></a>+%!postproc(html): #Rseclexing <a href="#seclexing">here</a>++%7.3+%!postproc(tex): #Lsecprecedence "label{secprecedence}"+%!postproc(tex): #Rsecprecedence "sref{secprecedence}"+%!postproc(html): #Lsecprecedence <a name="secprecedence"></a>+%!postproc(html): #Rsecprecedence <a href="#secprecedence">here</a>++%8.3.4+%!postproc(tex): #Lsecmathprogram "label{secmathprogram}"+%!postproc(tex): #Rsecmathprogram "sref{secmathprogram}"+%!postproc(html): #Lsecmathprogram <a name="secmathprogram"></a>+%!postproc(html): #Rsecmathprogram <a href="#secmathprogram">here</a>+++++++%!postproc(tex): #APPENDIX "appendix"+%!postproc(tex): #CHAPTER "chapter{The GF Programming Language}"+%!postproc(tex): #TOC "tableofcontents"++%!postproc(tex): #BECE "begin{center}"+%!postproc(tex): #ENCE "end{center}"+%!postproc(tex): "subsection\*" "section"+%!postproc(tex): "section\*" "chapter"+%%!postproc(tex): "paragraph\{\}\\bf" "subsubsection"++%!postproc(tex): #PARTbnf "input{RefDocGF.tex}"+%!preproc(html): #PARTbnf %!include: RefDocGF.txt++%!postproc(tex): "textbf" "keywrd"+%!postproc(tex): #PRINTINDEX "printindex"+%!preproc(html): #PRINTINDEX ""++%!postproc(tex): #sugar "sugar"+%!postproc(tex): #comput "computes"++%!postproc(tex): #Aone "subscr{A}{1}"+%!postproc(tex): #Aen "subscr{A}{n}"+%!postproc(tex): #Aii "subscr{A}{i}"+%!postproc(tex): #aone "subscr{a}{1}"+%!postproc(tex): #anone "subscr{a}{n-1}"+%!postproc(tex): #aen "subscr{a}{n}"+%!postproc(tex): #Bone "subscr{B}{1}"+%!postproc(tex): #Bem "subscr{B}{m}"+%!postproc(tex): #Ben "subscr{B}{n}"+%!postproc(tex): #Cone "subscr{C}{1}"+%!postproc(tex): #Cen "subscr{C}{n}"+%!postproc(tex): #Cii "subscr{C}{i}"+%!postproc(tex): #fone "subscr{f}{1}"+%!postproc(tex): #fen "subscr{f}{n}"+%!postproc(tex): #Gone "subscr{G}{1}"+%!postproc(tex): #Gen "subscr{G}{n}"+%!postproc(tex): #pone "subscr{p}{1}"+%!postproc(tex): #pem "subscr{p}{m}"+%!postproc(tex): #pen "subscr{p}{n}"+%!postproc(tex): #pii "subscr{p}{i}"+%!postproc(tex): #rii "subscr{r}{i}"+%!postproc(tex): #rone "subscr{r}{1}"+%!postproc(tex): #ren "subscr{r}{n}"+%!postproc(tex): #sii "subscr{s}{i}"+%!postproc(tex): #sone "subscr{s}{1}"+%!postproc(tex): #sen "subscr{s}{n}"+%!postproc(tex): #Tone "subscr{T}{1}"+%!postproc(tex): #Ten "subscr{T}{n}"+%!postproc(tex): #tone "subscr{t}{1}"+%!postproc(tex): #tem "subscr{t}{m}"+%!postproc(tex): #ten "subscr{t}{n}"+%!postproc(tex): #tii "subscr{t}{i}"+%!postproc(tex): #Vone "subscr{V}{1}"+%!postproc(tex): #Ven "subscr{V}{n}"+%!postproc(tex): #Vii "subscr{V}{i}"+%!postproc(tex): #xnone "subscr{x}{n-1}"+%!postproc(tex): #xone "subscr{x}{1}"+%!postproc(tex): #xen "subscr{x}{n}"+%!postproc(tex): #xii "subscr{x}{i}"+%!postproc(tex): #yone "subscr{y}{1}"+%!postproc(tex): #yem "subscr{y}{m}"+%!postproc(tex): #zone "subscr{z}{1}"+%!postproc(tex): #zem "subscr{z}{m}"++%%% undo the effect for these links in the synopsis+%!postproc(tex): "subscr\{G\}\{n\}der" "#Gender"+%!postproc(tex): "subscr\{T\}\{n\}se" "#Tense"+++%%!target:html+%!postproc(html): #APPENDIX ""+%!postproc(html): #CHAPTER ""+%!postproc(html): #TOC ""++%!postproc(html): #BECE "<center>"+%!postproc(html): #ENCE "</center>"+%%!postproc(html): "subsection\*" "section"+%%!postproc(html): "section\*" "chapter"+%%!preproc(html): #PARTbnf "[BNF Grammar of GF RefDocGF.html]"++%!postproc(html): #sugar "==="+%!postproc(html): #comput "==>"++%!postproc(html): #Aone "<i>A</i><sub>1</sub>"+%!postproc(html): #Aen "<i>A</i><sub>n</sub>"+%!postproc(html): #Aii "<i>A</i><sub>i</sub>"+%!postproc(html): #aone "<i>a</i><sub>1</sub>"+%!postproc(html): #anone "<i>a</i><sub>n-1</sub>"+%!postproc(html): #aen "<i>a</i><sub>n</sub>"+%!postproc(html): #Bone "<i>B</i><sub>1</sub>"+%!postproc(html): #Bem "<i>B</i><sub>m</sub>"+%!postproc(html): #Ben "<i>B</i><sub>n</sub>"+%!postproc(html): #Cone "<i>C</i><sub>1</sub>"+%!postproc(html): #Cen "<i>C</i><sub>n</sub>"+%!postproc(html): #Cii "<i>C</i><sub>i</sub>"+%!postproc(html): #fone "<i>f</i><sub>1</sub>"+%!postproc(html): #fen "<i>f</i><sub>n</sub>"+%!postproc(html): #Gone "<i>G</i><sub>1</sub>"+%!postproc(html): #Gen "<i>G</i><sub>n</sub>"+%!postproc(html): #pone "<i>p</i><sub>1</sub>"+%!postproc(html): #pem "<i>p</i><sub>m</sub>"+%!postproc(html): #pen "<i>p</i><sub>n</sub>"+%!postproc(html): #pii "<i>p</i><sub>i</sub>"+%!postproc(html): #rii "<i>r</i><sub>i</sub>"+%!postproc(html): #rone "<i>r</i><sub>1</sub>"+%!postproc(html): #ren "<i>r</i><sub>n</sub>"+%!postproc(html): #sii "<i>s</i><sub>i</sub>"+%!postproc(html): #sone "<i>s</i><sub>1</sub>"+%!postproc(html): #sen "<i>s</i><sub>n</sub>"+%!postproc(html): #Tone "<i>T</i><sub>1</sub>"+%!postproc(html): #Ten "<i>T</i><sub>n</sub>"+%!postproc(html): #tone "<i>t</i><sub>1</sub>"+%!postproc(html): #tem "<i>t</i><sub>m</sub>"+%!postproc(html): #ten "<i>t</i><sub>n</sub>"+%!postproc(html): #tii "<i>t</i><sub>i</sub>"+%!postproc(html): #Vone "<i>V</i><sub>1</sub>"+%!postproc(html): #Ven "<i>V</i><sub>n</sub>"+%!postproc(html): #Vii "<i>V</i><sub>i</sub>"+%!postproc(html): #xnone "<i>x</i><sub>n-1</sub>"+%!postproc(html): #xone "<i>x</i><sub>1</sub>"+%!postproc(html): #xen "<i>x</i><sub>n</sub>"+%!postproc(html): #xii "<i>x</i><sub>i</sub>"+%!postproc(html): #yone "<i>y</i><sub>1</sub>"+%!postproc(html): #yem "<i>y</i><sub>m</sub>"+%!postproc(html): #zone "<i>z</i><sub>1</sub>"+%!postproc(html): #zem "<i>z</i><sub>m</sub>"+++%!postproc(tex): #Lpatternmatching "label{patternmatching}"+%!postproc(tex): #Rpatternmatching "sref{patternmatching}"+%!postproc(html): #Lpatternmatching <a name="patternmatching"></a>+%!postproc(html): #Rpatternmatching <a href="#patternmatching">here</a>++%!postproc(tex): #Lcatjudgements "label{catjudgements}"+%!postproc(tex): #Rcatjudgements "sref{catjudgements}"+%!postproc(html): #Lcatjudgements <a name="catjudgements"></a>+%!postproc(html): #Rcatjudgements <a href="#catjudgements">here</a>++%!postproc(tex): #Lcnctypes "label{cnctypes}"+%!postproc(tex): #Rcnctypes "sref{cnctypes}"+%!postproc(html): #Lcnctypes <a name="cnctypes"></a>+%!postproc(html): #Rcnctypes <a href="#cnctypes">here</a>++%!postproc(tex): #Lcompleteness "label{completeness}"+%!postproc(tex): #Rcompleteness "sref{completeness}"+%!postproc(html): #Lcompleteness <a name="completeness"></a>+%!postproc(html): #Rcompleteness <a href="#completeness">here</a>++%!postproc(tex): #Lcontexts "label{contexts}"+%!postproc(tex): #Rcontexts "sref{contexts}"+%!postproc(html): #Lcontexts <a name="contexts"></a>+%!postproc(html): #Rcontexts <a href="#contexts">here</a>++%!postproc(tex): #Lconversions "label{conversions}"+%!postproc(tex): #Rconversions "sref{conversions}"+%!postproc(html): #Lconversions <a name="conversions"></a>+%!postproc(html): #Rconversions <a href="#conversions">here</a>++%!postproc(tex): #Lexpressions "label{expressions}"+%!postproc(tex): #Rexpressions "sref{expressions}"+%!postproc(html): #Lexpressions <a name="expressions"></a>+%!postproc(html): #Rexpressions <a href="#expressions">here</a>++%!postproc(tex): #Lflagvalues "label{flagvalues}"+%!postproc(tex): #Rflagvalues "sref{flagvalues}"+%!postproc(html): #Lflagvalues <a name="flagvalues"></a>+%!postproc(html): #Rflagvalues <a href="#flagvalues">here</a>++%!postproc(tex): #Lfunctionelimination "label{functionelimination}"+%!postproc(tex): #Rfunctionelimination "sref{functionelimination}"+%!postproc(html): #Lfunctionelimination <a name="functionelimination"></a>+%!postproc(html): #Rfunctionelimination <a href="#functionelimination">here</a>++%!postproc(tex): #Lfunctiontype "label{functiontype}"+%!postproc(tex): #Rfunctiontype "sref{functiontype}"+%!postproc(html): #Lfunctiontype <a name="functiontype"></a>+%!postproc(html): #Rfunctiontype <a href="#functiontype">here</a>++%!postproc(tex): #Lgluing "label{gluing}"+%!postproc(tex): #Rgluing "sref{gluing}"+%!postproc(html): #Lgluing <a name="gluing"></a>+%!postproc(html): #Rgluing <a href="#gluing">here</a>++%!postproc(tex): #LHOAS "label{HOAS}"+%!postproc(tex): #RHOAS "sref{HOAS}"+%!postproc(html): #LHOAS <a name="HOAS"></a>+%!postproc(html): #RHOAS <a href="#HOAS">here</a>++%!postproc(tex): #Lidentifiers "label{identifiers}"+%!postproc(tex): #Ridentifiers "sref{identifiers}"+%!postproc(html): #Lidentifiers <a name="identifiers"></a>+%!postproc(html): #Ridentifiers <a href="#identifiers">here</a>++%!postproc(tex): #Ljudgementforms "label{judgementforms}"+%!postproc(tex): #Rjudgementforms "sref{judgementforms}"+%!postproc(html): #Ljudgementforms <a name="judgementforms"></a>+%!postproc(html): #Rjudgementforms <a href="#judgementforms">here</a>++%!postproc(tex): #Llindefjudgements "label{lindefjudgements}"+%!postproc(tex): #Rlindefjudgements "sref{lindefjudgements}"+%!postproc(html): #Llindefjudgements <a name="lindefjudgements"></a>+%!postproc(html): #Rlindefjudgements <a href="#lindefjudgements">here</a>++%!postproc(tex): #Llinexpansion "label{linexpansion}"+%!postproc(tex): #Rlinexpansion "sref{linexpansion}"+%!postproc(html): #Llinexpansion <a name="linexpansion"></a>+%!postproc(html): #Rlinexpansion <a href="#linexpansion">here</a>++%!postproc(tex): #Loldgf "label{oldgf}"+%!postproc(tex): #Roldgf "sref{oldgf}"+%!postproc(html): #Loldgf <a name="oldgf"></a>+%!postproc(html): #Roldgf <a href="#oldgf">here</a>++%!postproc(tex): #Lopenabstract "label{openabstract}"+%!postproc(tex): #Ropenabstract "sref{openabstract}"+%!postproc(html): #Lopenabstract <a name="openabstract"></a>+%!postproc(html): #Ropenabstract <a href="#openabstract">here</a>++%!postproc(tex): #Loverloading "label{overloading}"+%!postproc(tex): #Roverloading "sref{overloading}"+%!postproc(html): #Loverloading <a name="overloading"></a>+%!postproc(html): #Roverloading <a href="#overloading">here</a>++%!postproc(tex): #Lparamjudgements "label{paramjudgements}"+%!postproc(tex): #Rparamjudgements "sref{paramjudgements}"+%!postproc(html): #Lparamjudgements <a name="paramjudgements"></a>+%!postproc(html): #Rparamjudgements <a href="#paramjudgements">here</a>++%!postproc(tex): #Lparamtypes "label{paramtypes}"+%!postproc(tex): #Rparamtypes "sref{paramtypes}"+%!postproc(html): #Lparamtypes <a name="paramtypes"></a>+%!postproc(html): #Rparamtypes <a href="#paramtypes">here</a>++%!postproc(tex): #Lparamvalues "label{paramvalues}"+%!postproc(tex): #Rparamvalues "sref{paramvalues}"+%!postproc(html): #Lparamvalues <a name="paramvalues"></a>+%!postproc(html): #Rparamvalues <a href="#paramvalues">here</a>++%!postproc(tex): #Lpredefabs "label{predefabs}"+%!postproc(tex): #Rpredefabs "sref{predefabs}"+%!postproc(html): #Lpredefabs <a name="predefabs"></a>+%!postproc(html): #Rpredefabs <a href="#predefabs">here</a>++%!postproc(tex): #Lpredefcnc "label{predefcnc}"+%!postproc(tex): #Rpredefcnc "sref{predefcnc}"+%!postproc(html): #Lpredefcnc <a name="predefcnc"></a>+%!postproc(html): #Rpredefcnc <a href="#predefcnc">here</a>++%!postproc(tex): #Lqualifiednames "label{qualifiednames}"+%!postproc(tex): #Rqualifiednames "sref{qualifiednames}"+%!postproc(html): #Lqualifiednames <a name="qualifiednames"></a>+%!postproc(html): #Rqualifiednames <a href="#qualifiednames">here</a>++%!postproc(tex): #Lrenaming "label{renaming}"+%!postproc(tex): #Rrenaming "sref{renaming}"+%!postproc(html): #Lrenaming <a name="renaming"></a>+%!postproc(html): #Rrenaming <a href="#renaming">here</a>++%!postproc(tex): #Lrestrictedinheritance "label{restrictedinheritance}"+%!postproc(tex): #Rrestrictedinheritance "sref{restrictedinheritance}"+%!postproc(html): #Lrestrictedinheritance <a name="restrictedinheritance"></a>+%!postproc(html): #Rrestrictedinheritance <a href="#restrictedinheritance">here</a>++%!postproc(tex): #Lreuse "label{reuse}"+%!postproc(tex): #Rreuse "sref{reuse}"+%!postproc(html): #Lreuse <a name="reuse"></a>+%!postproc(html): #Rreuse <a href="#reuse">here</a>++%!postproc(tex): #Lruntimevariables "label{runtimevariables}"+%!postproc(tex): #Rruntimevariables "sref{runtimevariables}"+%!postproc(html): #Lruntimevariables <a name="runtimevariables"></a>+%!postproc(html): #Rruntimevariables <a href="#runtimevariables">here</a>++%!postproc(tex): #Lstrtype "label{strtype}"+%!postproc(tex): #Rstrtype "sref{strtype}"+%!postproc(html): #Lstrtype <a name="strtype"></a>+%!postproc(html): #Rstrtype <a href="#strtype">here</a>++%!postproc(tex): #Lsubtyping "label{subtyping}"+%!postproc(tex): #Rsubtyping "sref{subtyping}"+%!postproc(html): #Lsubtyping <a name="subtyping"></a>+%!postproc(html): #Rsubtyping <a href="#subtyping">here</a>++%!postproc(tex): #Lsyntaxtrees "label{syntaxtrees}"+%!postproc(tex): #Rsyntaxtrees "sref{syntaxtrees}"+%!postproc(html): #Lsyntaxtrees <a name="syntaxtrees"></a>+%!postproc(html): #Rsyntaxtrees <a href="#syntaxtrees">here</a>++%!postproc(tex): #Ltables "label{tables}"+%!postproc(tex): #Rtables "sref{tables}"+%!postproc(html): #Ltables <a name="tables"></a>+%!postproc(html): #Rtables <a href="#tables">here</a>++%!postproc(tex): #Lvariablebinding "label{variablebinding}"+%!postproc(tex): #Rvariablebinding "sref{variablebinding}"+%!postproc(html): #Lvariablebinding <a name="variablebinding"></a>+%!postproc(html): #Rvariablebinding <a href="#variablebinding">here</a>++%% last, to avoid overriding with subsection* -> section+%!postproc(tex): #PREFACE "subsection*{Preface}"+%!postproc(tex): #OVERVIEW "subsection*{Overview}"+%!postproc(html): #OVERVIEW <h2>Overview</h2>+++++#NEW++=Overview=++This is a hands-on introduction to grammar writing in GF.++Main ingredients of GF:+- linguistics+- functional programming+++Prerequisites:+- some previous experience from some programming language+- the basics of using computers, e.g. the use of+ text editors and the management of files.+- knowledge of Unix commands is useful but not necessary+- knowledge of many natural languages may add fun to experience+++++#NEW++==Outline==++#Rchaptwo: a multilingual "Hello World" grammar. English, Finnish, Italian.++#Rchapthree: a larger grammar for the domain of food. English and Italian.++#Rchapfour: parameters - morphology and agreement.++#Rchapfive: using the resource grammar library.++#Rchapsix: semantics - **dependent types**, **variable bindings**,+and **semantic definitions**.++#Rchapseven: implementing formal languages.++#Rchapeight: embedded grammar applications.++++#NEW++==Slides==++You can chop this tutorial into a set of slides by the command+```+ htmls gf-tutorial.html+```+where the program ``htmls`` is distributed with GF (see below), in++ [``GF/src/tools/Htmls.hs`` http://grammaticalframework.org/src/tools/Htmls.hs]++The slides will appear as a set of files beginning with ``01-gf-tutorial.htmls``.++Internal links will not work in the slide format, except for those in the+upper left corner of each slide, and the links behind the "Contents" link.++++#NEW++=Lesson 1: Getting Started with GF=+++#Lchaptwo++Goals:+- install and run GF+- write the first GF grammar: a "Hello World" grammar in three languages+- use GF for translation and multilingual generation+++#NEW++==What GF is==++We use the term GF for three different things:+- a **system** (computer program) used for working with grammars+- a **programming language** in which grammars can be written+- a **theory** about grammars and languages+++The GF system is an implementation+of the GF programming language, which in turn is built on the ideas of the+GF theory.++The focus of this tutorial is on using the GF programming language.++At the same time, we learn the way of thinking in the GF theory.++We make the grammars run on a computer by+using the GF system.+++#NEW++==GF grammars and language processing tasks==++A GF program is called a **grammar**.++A grammar defines a language.++From this definition, language processing components can be derived:+- **parsing**: to analyse the language+- **linearization**: to generate the language+- **translation**: to analyse one language and generate another+++In general, a GF grammar is **multilingual**:+- many languages in one grammar+- translations between them++++++++#NEW++==Getting the GF system==++Open-source free software, downloaded via the GF Homepage:++[``grammaticalframework.org`` http://grammaticalframework.org/]++There you find+- binaries for Linux, Mac OS X, and Windows+- source code and documentation+- grammar libraries and examples+++Many examples in this tutorial are+[online http://grammaticalframework.org/examples/tutorial].++Normally you don't have to compile GF yourself.+But, if you do want to compile GF from source follow the+instructions in the [Developers Guide ../gf-developers.html].+++#NEW++==Running the GF system==++Type ``gf`` in the Unix (or Cygwin) shell:+```+ % gf+```+You will see GF's welcome message and the prompt ``>``.+The command+```+ > help+```+will give you a list of available commands.++As a common convention, we will use+- ``%`` as a prompt that marks system commands+- ``>`` as a prompt that marks GF commands+++Thus you should not type these prompts, but only the characters that+follow them.+++#NEW++==A "Hello World" grammar==++Like most programming language tutorials, we start with a+program that prints "Hello World" on the terminal.++Extra features:+- **Multilinguality**: the message is printed in many languages.+- **Reversibility**: in addition to printing, you can **parse** the+ message and **translate** it to other languages.+++#NEW++===The program: abstract syntax and concrete syntaxes===++A GF program, in general, is a **multilingual grammar**. Its main parts+are+- an **abstract syntax**+- one or more **concrete syntaxes**+++The abstract syntax defines what **meanings**+can be expressed in the grammar+- //Greetings//, where we greet a //Recipient//, which can be+ //World// or //Mum// or //Friends//++++#NEW++GF code for the abstract syntax:+```+ -- a "Hello World" grammar+ abstract Hello = {++ flags startcat = Greeting ;++ cat Greeting ; Recipient ;++ fun+ Hello : Recipient -> Greeting ;+ World, Mum, Friends : Recipient ;+ }+```+The code has the following parts:+- a **comment** (optional), saying what the module is doing+- a **module header** indicating that it is an abstract syntax+ module named ``Hello``+- a **module body** in braces, consisting of+ - a **startcat flag declaration** stating that ``Greeting`` is the+ default start category for parsing and generation+ - **category declarations** introducing two categories, i.e. types of meanings+ - **function declarations** introducing three meaning-building functions+++#NEW++English concrete syntax (mapping from meanings to strings):+```+ concrete HelloEng of Hello = {++ lincat Greeting, Recipient = {s : Str} ;++ lin+ Hello recip = {s = "hello" ++ recip.s} ;+ World = {s = "world"} ;+ Mum = {s = "mum"} ;+ Friends = {s = "friends"} ;+ }+```+The major parts of this code are:+- a module header indicating that it is a concrete syntax of the abstract syntax+ ``Hello``, itself named ``HelloEng``+- a module body in curly brackets, consisting of+ - **linearization type definitions** stating that+ ``Greeting`` and ``Recipient`` are **records** with a **string** ``s``+ - **linearization definitions** telling what records are assigned to+ each of the meanings defined in the abstract syntax+++Notice the concatenation ``++`` and the record projection ``.``.+++#NEW++Finnish and an Italian concrete syntaxes:+```+ concrete HelloFin of Hello = {+ lincat Greeting, Recipient = {s : Str} ;+ lin+ Hello recip = {s = "terve" ++ recip.s} ;+ World = {s = "maailma"} ;+ Mum = {s = "äiti"} ;+ Friends = {s = "ystävät"} ;+ }++ concrete HelloIta of Hello = {+ lincat Greeting, Recipient = {s : Str} ;+ lin+ Hello recip = {s = "ciao" ++ recip.s} ;+ World = {s = "mondo"} ;+ Mum = {s = "mamma"} ;+ Friends = {s = "amici"} ;+ }+```+++#NEW++===Using grammars in the GF system===++In order to compile the grammar in GF,+we create four files, one for each module, named //Modulename//``.gf``:+```+ Hello.gf HelloEng.gf HelloFin.gf HelloIta.gf+```+The first GF command: **import** a grammar.+```+ > import HelloEng.gf+```+All commands also have short names; here:+```+ > i HelloEng.gf+```+The GF system will **compile** your grammar+into an internal representation and show the CPU time was consumed, followed+by a new prompt:+```+ > i HelloEng.gf+ - compiling Hello.gf... wrote file Hello.gfo 8 msec+ - compiling HelloEng.gf... wrote file HelloEng.gfo 12 msec++ 12 msec+ >+```++#NEW++You can use GF for **parsing** (``parse`` = ``p``)+```+ > parse "hello world"+ Hello World+```+Parsing takes a **string** into an **abstract syntax tree**.++The notation for trees is that of **function application**:+```+ function argument1 ... argumentn+```+Parentheses are only needed for grouping.++Parsing something that is not in grammar will fail:+```+ > parse "hello dad"+ Unknown words: dad++ > parse "world hello"+ no tree found+```++#NEW++You can also use GF for **linearization** (``linearize = l``).+It takes trees into strings:+```+ > linearize Hello World+ hello world+```+**Translation**: **pipe** linearization to parsing:+```+ > import HelloEng.gf+ > import HelloIta.gf++ > parse -lang=HelloEng "hello mum" | linearize -lang=HelloIta+ ciao mamma+```+Default of the language flag (``-lang``): the last-imported concrete syntax.++**Multilingual generation**:+```+ > parse -lang=HelloEng "hello friends" | linearize+ terve ystävät+ ciao amici+ hello friends+```+Linearization is by default to all available languages.++#NEW++===Exercises on the Hello World grammar===+++ Test the parsing and translation examples shown above, as well as+some other examples, in different combinations of languages.+++ Extend the grammar ``Hello.gf`` and some of the+concrete syntaxes by five new recipients and one new greeting+form.+++ Add a concrete syntax for some other+languages you might know.+++ Add a pair of greetings that are expressed in one and+the same way in+one language and in two different ways in another.+For instance, //good morning//+and //good afternoon// in English are both expressed+as //buongiorno// in Italian.+Test what happens when you translate //buongiorno// to English in GF.+++ Inject errors in the ``Hello`` grammars, for example, leave out+some line, omit a variable in a ``lin`` rule, or change the name+in one occurrence+of a variable. Inspect the error messages generated by GF.+++#NEW++==Using grammars from outside GF==++You can use the ``gf`` program in a Unix pipe.+- echo a GF command+- pipe it into GF with grammar names as arguments+++```+ % echo "l Hello World" | gf HelloEng.gf HelloFin.gf HelloIta.gf+```+You can also write a **script**, a file containing the lines+```+ import HelloEng.gf+ import HelloFin.gf+ import HelloIta.gf+ linearize Hello World+```+++#NEW++==GF scripts==++If we name this script ``hello.gfs``, we can do+```+ $ gf --run <hello.gfs++ ciao mondo+ terve maailma+ hello world+```+The option ``--run`` removes prompts, CPU time, and other messages.++See #Rchapeight, for stand-alone programs that don't need the GF system to run.++**Exercise**. (For Unix hackers.) Write a GF application that reads+an English string from the standard input and writes an Italian+translation to the output.+++#NEW++==What else can be done with the grammar==++Some more functions that will be covered:+- **morphological analysis**: find out the possible inflection forms of words+- **morphological synthesis**: generate all inflection forms of words+- **random generation**: generate random expressions+- **corpus generation**: generate all expressions+- **treebank generation**: generate a list of trees with their linearizations+- **teaching quizzes**: train morphology and translation+- **multilingual authoring**: create a document in many languages simultaneously+- **speech input**: optimize a speech recognition system for a grammar++++#NEW++==Embedded grammar applications==++Application programs, using techniques from #Rchapeight:+- compile grammars to new formats, such as speech recognition grammars+- embed grammars in Java and Haskell programs+- build applications using compilation and embedding:+ - voice commands+ - spoken language translators+ - dialogue systems+ - user interfaces+ - localization: render the messages printed by a program+ in different languages+++++#NEW++=Lesson 2: Designing a grammar for complex phrases=++#Lchapthree++Goals:+- build a larger grammar: phrases about food in English and Italian+- learn to write reusable library functions ("operations")+- learn the basics of GF's module system+++#NEW+++==The abstract syntax Food==++Phrases usable for speaking about food:+- the start category is ``Phrase``+- a ``Phrase`` can be built by assigning a ``Quality`` to an ``Item``+ (e.g. //this cheese is Italian//)+- an``Item`` is build from a ``Kind`` by prefixing //this// or //that//+ (e.g. //this wine//)+- a ``Kind`` is either **atomic** (e.g. //cheese//), or formed+ qualifying a given ``Kind`` with a ``Quality`` (e.g. //Italian cheese//)+- a ``Quality`` is either atomic (e.g. //Italian//,+ or built by modifying a given ``Quality`` with the word //very// (e.g. //very warm//)+++Abstract syntax:+```+ abstract Food = {++ flags startcat = Phrase ;++ cat+ Phrase ; Item ; Kind ; Quality ;++ fun+ Is : Item -> Quality -> Phrase ;+ This, That : Kind -> Item ;+ QKind : Quality -> Kind -> Kind ;+ Wine, Cheese, Fish : Kind ;+ Very : Quality -> Quality ;+ Fresh, Warm, Italian, Expensive, Delicious, Boring : Quality ;+ }+```+Example ``Phrase``+```+ Is (This (QKind Delicious (QKind Italian Wine))) (Very (Very Expensive))+ this delicious Italian wine is very very expensive+```+++#NEW++==The concrete syntax FoodEng==++```+ concrete FoodEng of Food = {++ lincat+ Phrase, Item, Kind, Quality = {s : Str} ;++ lin+ Is item quality = {s = item.s ++ "is" ++ quality.s} ;+ This kind = {s = "this" ++ kind.s} ;+ That kind = {s = "that" ++ kind.s} ;+ QKind quality kind = {s = quality.s ++ kind.s} ;+ Wine = {s = "wine"} ;+ Cheese = {s = "cheese"} ;+ Fish = {s = "fish"} ;+ Very quality = {s = "very" ++ quality.s} ;+ Fresh = {s = "fresh"} ;+ Warm = {s = "warm"} ;+ Italian = {s = "Italian"} ;+ Expensive = {s = "expensive"} ;+ Delicious = {s = "delicious"} ;+ Boring = {s = "boring"} ;+ }+```++#NEW++Test the grammar for parsing:+```+ > import FoodEng.gf+ > parse "this delicious wine is very very Italian"+ Is (This (QKind Delicious Wine)) (Very (Very Italian))+```+Parse in other categories setting the ``cat`` flag:+```+ p -cat=Kind "very Italian wine"+ QKind (Very Italian) Wine+```+++#NEW++===Exercises on the Food grammar===+++ Extend the ``Food`` grammar by ten new food kinds and+qualities, and run the parser with new kinds of examples.+++ Add a rule that enables question phrases of the form+//is this cheese Italian//.+++ Enable the optional prefixing of+phrases with the words "excuse me but". Do this in such a way that+the prefix can occur at most once.++++#NEW++==Commands for testing grammars==++===Generating trees and strings===++Random generation (``generate_random = gr``): build+build a random tree in accordance with an abstract syntax:+```+ > generate_random+ Is (This (QKind Italian Fish)) Fresh+```+By using a pipe, random generation can be fed into linearization:+```+ > generate_random | linearize+ this Italian fish is fresh+```+Use the ``number`` flag to generate several trees:+```+ > gr -number=4 | l+ that wine is boring+ that fresh cheese is fresh+ that cheese is very boring+ this cheese is Italian+```++#NEW++To generate //all// phrases that a grammar can produce,+use ``generate_trees = gt``.+```+ > generate_trees | l+ that cheese is very Italian+ that cheese is very boring+ that cheese is very delicious+ ...+ this wine is fresh+ this wine is warm+```+The default **depth** is 3; the depth can be+set by using the ``depth`` flag:+```+ > generate_trees -depth=2 | l+```+What options a command has can be seen by the ``help = h`` command:+```+ > help gr+ > help gt+```+++#NEW++===Exercises on generation===+++ If the command ``gt`` generated all+trees in your grammar, it would never terminate. Why?+++ Measure how many trees the grammar gives with depths 4 and 5,+respectively. **Hint**. You can+use the Unix **word count** command ``wc`` to count lines.++++#NEW++===More on pipes: tracing===++Put the **tracing** option ``-tr`` to each command whose output you+want to see:+```+ > gr -tr | l -tr | p++ Is (This Cheese) Boring+ this cheese is boring+ Is (This Cheese) Boring+```+Useful for test purposes: the pipe above can show+if a grammar is **ambiguous**, i.e.+contains strings that can be parsed in more than one way.++**Exercise**. Extend the ``Food`` grammar so that it produces ambiguous+strings, and try out the ambiguity test.+++#NEW++===Writing and reading files===++To save the outputs into a file, pipe it to the ``write_file = wf`` command,+```+ > gr -number=10 | linearize | write_file -file=exx.tmp+```+To read a file to GF, use the ``read_file = rf`` command,+```+ > read_file -file=exx.tmp -lines | parse+```+The flag ``-lines`` tells GF to read each line of the file separately.++Files with examples can be used for **regression testing**+of grammars - the most systematic way to do this is by+**treebanks**; see #Rsectreebank.+++#NEW++===Visualizing trees===++Parentheses give a linear representation of trees,+useful for the computer.++Human eye may prefer to see a visualization: ``visualize_tree = vt``:+```+ > parse "this delicious cheese is very Italian" | visualize_tree+```+The tree is generated in postscript (``.ps``) file. The ``-view`` option is used for+telling what command to use to view the file. Its default is ``"open"``, which works+on Mac OS X. On Ubuntu Linux, one can write+```+ > parse "this delicious cheese is very Italian" | visualize_tree -view="eog"+```+++++#MYTREE++This command uses the program [Graphviz http://www.graphviz.org/], which you+might not have, but which are freely available on the web.++You can save the temporary file ``_grph.dot``,+which the command ``vt`` produces.++Then you can process this file with the ``dot``+program (from the Graphviz package).+```+ % dot -Tpng _grph.dot > mytree.png+```+You can also visualize **parse trees**, which show categories and words instead of+function symbols. The command is ``visualize_parse = vp``:+```+ > parse "this delicious cheese is very Italian" | visualize_parse+```++#MYPARSE++#NEW++===System commands===++You can give a **system command** without leaving GF:+``!`` followed by a Unix command,+```+ > ! dot -Tpng grphtmp.dot > mytree.png+ > ! open mytree.png+```+A system command may also receive its argument from+a GF pipes. It then uses the symbol ``?``:+```+ > generate_trees -depth=4 | ? wc -l+```+This command example returns the number of generated trees.+++**Exercise**.+Measure how many trees the grammar ``FoodEng`` gives with depths 4 and 5,+respectively. Use the Unix **word count** command ``wc`` to count lines, and+a system pipe from a GF command into a Unix command.++++++#NEW++==An Italian concrete syntax==++#Lsecanitalian++Just (?) replace English words with their dictionary equivalents:+```+ concrete FoodIta of Food = {++ lincat+ Phrase, Item, Kind, Quality = {s : Str} ;++ lin+ Is item quality = {s = item.s ++ "è" ++ quality.s} ;+ This kind = {s = "questo" ++ kind.s} ;+ That kind = {s = "quel" ++ kind.s} ;+ QKind quality kind = {s = kind.s ++ quality.s} ;+ Wine = {s = "vino"} ;+ Cheese = {s = "formaggio"} ;+ Fish = {s = "pesce"} ;+ Very quality = {s = "molto" ++ quality.s} ;+ Fresh = {s = "fresco"} ;+ Warm = {s = "caldo"} ;+ Italian = {s = "italiano"} ;+ Expensive = {s = "caro"} ;+ Delicious = {s = "delizioso"} ;+ Boring = {s = "noioso"} ;+ }+```+++#NEW++Not just replacing words:++The order of a quality and the kind it modifies is changed in+```+ QKind quality kind = {s = kind.s ++ quality.s} ;+```+Thus Italian says ``vino italiano`` for ``Italian wine``.++(Some Italian adjectives+are put before the noun. This distinction can be controlled by parameters,+which are introduced in #Rchapfour.)++Multilingual grammars have yet another visualization option:+**word alignment**, which shows what words correspond to each other.+Technically, this means words that have the same smallest spanning subtrees+in abstract syntax. The command is ``align_words = aw``:+```+ > parse "this delicious cheese is very Italian" | align_words+```++[align2.png]+++#NEW++===Exercises on multilinguality===+++ Write a concrete syntax of ``Food`` for some other language.+You will probably end up with grammatically incorrect+linearizations - but don't+worry about this yet.+++ If you have written ``Food`` for German, Swedish, or some+other language, test with random or exhaustive generation what constructs+come out incorrect, and prepare a list of those ones that cannot be helped+with the currently available fragment of GF. You can return to your list+after having worked out #Rchapfour.+++++#NEW++==Free variation==++Semantically indistinguishable ways of expressing a thing.++The **variants** construct of GF expresses free variation. For example,+```+ lin Delicious = {s = "delicious" | "exquisit" | "tasty"} ;+```+By default, the ``linearize`` command+shows only the first variant from such lists; to see them+all, use the option ``-all``:+```+ > p "this exquisit wine is delicious" | l -all+ this delicious wine is delicious+ this delicious wine is exquisit+ ...+```++#NEW++An equivalent notation for variants is+```+ lin Delicious = {s = variants {"delicious" ; "exquisit" ; "tasty"}} ;+```+This notation also allows the limiting case: an empty variant list,+```+ variants {}+```+It can be used e.g. if a word lacks a certain inflection form.++Free variation works for all types in concrete syntax; all terms in+a variant list must be of the same type.+++#NEW++==More application of multilingual grammars==++===Multilingual treebanks===++#Lsectreebank++**Multilingual treebank**: a set of trees with their+linearizations in different languages:+```+ > gr -number=2 | l -treebank++ Is (That Cheese) (Very Boring)+ quel formaggio è molto noioso+ that cheese is very boring++ Is (That Cheese) Fresh+ quel formaggio è fresco+ that cheese is fresh+```++++#NEW++===Translation quiz===++``translation_quiz = tq``:+generate random sentences, display them in one language, and check the user's+answer given in another language.+```+ > translation_quiz -from=FoodEng -to=FoodIta++ Welcome to GF Translation Quiz.+ The quiz is over when you have done at least 10 examples+ with at least 75 % success.+ You can interrupt the quiz by entering a line consisting of a dot ('.').++ this fish is warm+ questo pesce è caldo+ > Yes.+ Score 1/1++ this cheese is Italian+ questo formaggio è noioso+ > No, not questo formaggio è noioso, but+ questo formaggio è italiano++ Score 1/2+ this fish is expensive+```++++#NEW++==Context-free grammars and GF==++===The "cf" grammar format===++The grammar ``FoodEng`` can be written in a BNF format as follows:+```+ Is. Phrase ::= Item "is" Quality ;+ That. Item ::= "that" Kind ;+ This. Item ::= "this" Kind ;+ QKind. Kind ::= Quality Kind ;+ Cheese. Kind ::= "cheese" ;+ Fish. Kind ::= "fish" ;+ Wine. Kind ::= "wine" ;+ Italian. Quality ::= "Italian" ;+ Boring. Quality ::= "boring" ;+ Delicious. Quality ::= "delicious" ;+ Expensive. Quality ::= "expensive" ;+ Fresh. Quality ::= "fresh" ;+ Very. Quality ::= "very" Quality ;+ Warm. Quality ::= "warm" ;+```+GF can convert BNF grammars into GF.+BNF files are recognized by the file name suffix ``.cf`` (for **context-free**):+```+ > import food.cf+```+The compiler creates separate abstract and concrete modules internally.+++#NEW++===Restrictions of context-free grammars===++Separating concrete and abstract syntax allows+three deviations from context-free grammar:+- **permutation**: changing the order of constituents+- **suppression**: omitting constituents+- **reduplication**: repeating constituents+++**Exercise**. Define the non-context-free+copy language ``{x x | x <- (a|b)*}`` in GF.++++#NEW++%--!+==Modules and files==++GF uses suffixes to recognize different file formats:+- Source files: //Modulename//``.gf``+- Target files: //Modulename//``.gfo``+++Importing generates target from source:+```+ > i FoodEng.gf+ - compiling Food.gf... wrote file Food.gfo 16 msec+ - compiling FoodEng.gf... wrote file FoodEng.gfo 20 msec+```+The ``.gfo`` format (="GF Object") is precompiled GF, which is+faster to load than source GF (``.gf``).++When reading a module, GF decides whether+to use an existing ``.gfo`` file or to generate+a new one, by looking at modification times.+++#NEW++**Exercise**. What happens when you import ``FoodEng.gf`` for+a second time? Try this in different situations:+- Right after importing it the first time (the modules are kept in+ the memory of GF and need no reloading).+- After issuing the command ``empty`` (``e``), which clears the memory+ of GF.+- After making a small change in ``FoodEng.gf``, be it only an added space.+- After making a change in ``Food.gf``.++++#NEW++==Using operations and resource modules==++===Operation definitions===++The golden rule of functional programmin:++//Whenever you find yourself programming by copy-and-paste, write a function instead.//++Functions in concrete syntax are defined using the keyword ``oper`` (for+**operation**), distinct from ``fun`` for the sake of clarity.++Example:+```+ oper ss : Str -> {s : Str} = \x -> {s = x} ;+```+The operation can be **applied** to an argument, and GF will+**compute** the value:+```+ ss "boy" ===> {s = "boy"}+```+The symbol ``===>`` will be used for computation.+++#NEW++Notice the **lambda abstraction** form+- ``\``//x// ``->`` //t//+++This is read:+- function with variable //x// and **function body** //t//+++For lambda abstraction with multiple arguments, we have the shorthand+```+ \x,y -> t === \x -> \y -> t+```+Linearization rules actually use syntactic+sugar for abstraction:+```+ lin f x = t === lin f = \x -> t+```++++#NEW++%--!+===The ``resource`` module type===++The ``resource`` module type is used to package+``oper`` definitions into reusable resources.+```+ resource StringOper = {+ oper+ SS : Type = {s : Str} ;+ ss : Str -> SS = \x -> {s = x} ;+ cc : SS -> SS -> SS = \x,y -> ss (x.s ++ y.s) ;+ prefix : Str -> SS -> SS = \p,x -> ss (p ++ x.s) ;+ }+```+++#NEW++%--!+===Opening a resource===++Any number of ``resource`` modules can be+**open**ed in a ``concrete`` syntax.+```+ concrete FoodEng of Food = open StringOper in {++ lincat+ S, Item, Kind, Quality = SS ;++ lin+ Is item quality = cc item (prefix "is" quality) ;+ This k = prefix "this" k ;+ That k = prefix "that" k ;+ QKind k q = cc k q ;+ Wine = ss "wine" ;+ Cheese = ss "cheese" ;+ Fish = ss "fish" ;+ Very = prefix "very" ;+ Fresh = ss "fresh" ;+ Warm = ss "warm" ;+ Italian = ss "Italian" ;+ Expensive = ss "expensive" ;+ Delicious = ss "delicious" ;+ Boring = ss "boring" ;+ }+```+++#NEW++%--!+===Partial application===++#Lsecpartapp++The rule+```+ lin This k = prefix "this" k ;+```+can be written more concisely+```+ lin This = prefix "this" ;+```+Part of the art in functional programming:+decide the order of arguments in a function,+so that partial application can be used as much as possible.++For instance, ``prefix`` is typically applied to+linearization variables with constant strings. Hence we+put the ``Str`` argument before the ``SS`` argument.+++**Exercise**. Define an operation ``infix`` analogous to ``prefix``,+such that it allows you to write+```+ lin Is = infix "is" ;+```+++#NEW++===Testing resource modules===++Import with the flag ``-retain``,+```+ > import -retain StringOper.gf+```+Compute the value with ``compute_concrete = cc``,+```+ > compute_concrete prefix "in" (ss "addition")+ {s : Str = "in" ++ "addition"}+```+++#NEW++==Grammar architecture==++#Lsecarchitecture++===Extending a grammar===++A new module can **extend** an old one:+```+ abstract Morefood = Food ** {+ cat+ Question ;+ fun+ QIs : Item -> Quality -> Question ;+ Pizza : Kind ;+ }+```+Parallel to the abstract syntax, extensions can+be built for concrete syntaxes:+```+ concrete MorefoodEng of Morefood = FoodEng ** {+ lincat+ Question = {s : Str} ;+ lin+ QIs item quality = {s = "is" ++ item.s ++ quality.s} ;+ Pizza = {s = "pizza"} ;+ }+```+The effect of extension: all of the contents of the extended+and extending modules are put together.++In other words: the new module **inherits** the contents of the old module.++#NEW++Simultaneous extension and opening:+```+ concrete MorefoodIta of Morefood = FoodIta ** open StringOper in {+ lincat+ Question = SS ;+ lin+ QIs item quality = ss (item.s ++ "è" ++ quality.s) ;+ Pizza = ss "pizza" ;+ }+```+Resource modules can extend other resource modules - thus it is+possible to build resource hierarchies.++++#NEW++===Multiple inheritance===++Extend several grammars at the same time:+```+ abstract Foodmarket = Food, Fruit, Mushroom ** {+ fun+ FruitKind : Fruit -> Kind ;+ MushroomKind : Mushroom -> Kind ;+ }+```+where+```+ abstract Fruit = {+ cat Fruit ;+ fun Apple, Peach : Fruit ;+ }++ abstract Mushroom = {+ cat Mushroom ;+ fun Cep, Agaric : Mushroom ;+ }+```++**Exercise**. Refactor ``Food`` by taking apart ``Wine`` into a special+``Drink`` module.++++#NEW++=Lesson 3: Grammars with parameters=++#Lchapfour++Goals:+- implement sophisticated linguistic structures:+ - morphology: the inflection of words+ - agreement: rules for selecting word forms in syntactic combinations+++- Cover all GF constructs for concrete syntax+++It is possible to skip this chapter and go directly+to the next, since the use of the GF Resource Grammar library+makes it unnecessary to use parameters: they+could be left to library implementors.+++#NEW++==The problem: words have to be inflected==++Plural forms are needed in things like+#BEQU+//these Italian wines are delicious//+#ENQU+This requires two things:+- the **inflection** of nouns and verbs in singular and plural+- the **agreement** of the verb to subject:+ the verb must have the same number as the subject+++Different languages have different types of inflection and agreement.+- Italian has also gender (masculine vs. feminine).++++In a multilingual grammar,+we want to ignore such distinctions in abstract syntax.++**Exercise**. Make a list of the possible forms that nouns,+adjectives, and verbs can have in some languages that you know.+++#NEW++==Parameters and tables==++We define the **parameter type** of number in English by+a new form of judgement:+```+ param Number = Sg | Pl ;+```+This judgement defines the parameter type ``Number`` by listing+its two **constructors**, ``Sg`` and ``Pl``+(singular and plural).++We give ``Kind`` a linearization type that has a **table** depending on number:+```+ lincat Kind = {s : Number => Str} ;+```+The **table type** ``Number => Str`` is similar a function type+(``Number -> Str``).++Difference: the argument must be a parameter type. Then+the argument-value pairs can be listed in a finite table.++#NEW++Here is a table:+```+ lin Cheese = {+ s = table {+ Sg => "cheese" ;+ Pl => "cheeses"+ }+ } ;+```+The table has **branches**, with a **pattern** on the+left of the arrow ``=>`` and a **value** on the right.++The application of a table is done by the **selection** operator ``!``.++It which is computed by **pattern matching**: return+the value from the first branch whose pattern matches the+argument. For instance,+```+ table {Sg => "cheese" ; Pl => "cheeses"} ! Pl+ ===> "cheeses"+```++#NEW++**Case expressions** are syntactic sugar:+```+ case e of {...} === table {...} ! e+```+Since they are familiar to Haskell and ML programmers, they can come out handy+when writing GF programs.+++#NEW++Constructors can take arguments from other parameter types.++Example: forms of English verbs (except //be//):+```+ param VerbForm = VPresent Number | VPast | VPastPart | VPresPart ;+```+Fact expressed: only present tense has number variation.++Example table: the forms of the verb //drink//:+```+ table {+ VPresent Sg => "drinks" ;+ VPresent Pl => "drink" ;+ VPast => "drank" ;+ VPastPart => "drunk" ;+ VPresPart => "drinking"+ }+```+++**Exercise**. In an earlier exercise (previous section),+you made a list of the possible+forms that nouns, adjectives, and verbs can have in some languages that+you know. Now take some of the results and implement them by+using parameter type definitions and tables. Write them into a ``resource``+module, which you can test by using the command ``compute_concrete``.++++#NEW++==Inflection tables and paradigms==++A morphological **paradigm** is a formula telling how a class of+words is inflected.++From the GF point of view, a paradigm is a function that takes+a **lemma** (also known as a **dictionary form**, or a **citation form**) and+returns an inflection table.++The following operation defines the regular noun paradigm of English:+```+ oper regNoun : Str -> {s : Number => Str} = \dog -> {+ s = table {+ Sg => dog ;+ Pl => dog + "s"+ }+ } ;+```+The **gluing** operator ``+`` glues strings to one **token**:+```+ (regNoun "cheese").s ! Pl ===> "cheese" + "s" ===> "cheeses"+```+++#NEW++A more complex example: regular verbs,+```+ oper regVerb : Str -> {s : VerbForm => Str} = \talk -> {+ s = table {+ VPresent Sg => talk + "s" ;+ VPresent Pl => talk ;+ VPresPart => talk + "ing" ;+ _ => talk + "ed"+ }+ } ;+```+The catch-all case for the past tense and the past participle+uses a **wild card** pattern ``_``.+++#NEW++===Exercises on morphology===+++ Identify cases in which the ``regNoun`` paradigm does not+apply in English, and implement some alternative paradigms.+++ Implement some regular paradigms for other languages you have+considered in earlier exercises.++++#NEW++==Using parameters in concrete syntax==++Purpose: a more radical+variation between languages+than just the use of different words and word orders.++We add to the grammar ``Food`` two rules for forming plural items:+```+ fun These, Those : Kind -> Item ;+```+We also add a noun which in Italian has the feminine case:+```+ fun Pizza : Kind ;+```+This will force us to deal with gender-+++#NEW++%--!+===Agreement===++In English, the phrase-forming rule+```+ fun Is : Item -> Quality -> Phrase ;+```+is affected by the number because of **subject-verb agreement**:+the verb of a sentence must be inflected in the number of the subject,+```+ Is (This Pizza) Warm ===> "this pizza is warm"+ Is (These Pizza) Warm ===> "these pizzas are warm"+```+It is the **copula** (the verb //be//) that is affected:+```+ oper copula : Number -> Str = \n ->+ case n of {+ Sg => "is" ;+ Pl => "are"+ } ;+```+The **subject** ``Item`` must have such a number to provide to the copula:+```+ lincat Item = {s : Str ; n : Number} ;+```+Now we can write+```+ lin Is item qual = {s = item.s ++ copula item.n ++ qual.s} ;+```++++#NEW++===Determiners===++How does an ``Item`` subject receive its number? The rules+```+ fun This, These : Kind -> Item ;+```+add **determiners**, either //this// or //these//, which+require different //this pizza// vs.+//these pizzas//.++Thus ``Kind`` must have both singular and plural forms:+```+ lincat Kind = {s : Number => Str} ;+```+We can write+```+ lin This kind = {+ s = "this" ++ kind.s ! Sg ;+ n = Sg+ } ;++ lin These kind = {+ s = "these" ++ kind.s ! Pl ;+ n = Pl+ } ;+```+++#NEW++To avoid copy-and-paste, we can factor out the pattern of determination,+```+ oper det :+ Str -> Number -> {s : Number => Str} -> {s : Str ; n : Number} =+ \det,n,kind -> {+ s = det ++ kind.s ! n ;+ n = n+ } ;+```+Now we can write+```+ lin This = det Sg "this" ;+ lin These = det Pl "these" ;+```+In a more **lexicalized** grammar, determiners would be a category:+```+ lincat Det = {s : Str ; n : Number} ;+ fun Det : Det -> Kind -> Item ;+ lin Det det kind = {+ s = det.s ++ kind.s ! det.n ;+ n = det.n+ } ;+```+++#NEW++===Parametric vs. inherent features===++``Kind``s have number as a **parametric feature**: both singular and plural+can be formed,+```+ lincat Kind = {s : Number => Str} ;+```+``Item``s have number as an **inherent feature**: they are inherently either+singular or plural,+```+ lincat Item = {s : Str ; n : Number} ;+```+Italian ``Kind`` will have parametric number and inherent gender:+```+ lincat Kind = {s : Number => Str ; g : Gender} ;+```+++#NEW++Questions to ask when designing parameters:+- existence: what forms are possible to build by morphological and+ other means?+- need: what features are expected via agreement or government?+++Dictionaries give good advice:+#BEQU+**uomo**, pl. //uomini//, n.m. "man"+#ENQU+tells that //uomo// is a masculine noun with the plural form //uomini//.+Hence, parametric number and an inherent gender.++For words, inherent features are usually given as lexical information.++For combinations, they are //inherited// from some part of the construction+(typically the one called the **head**). Italian modification:+```+ lin QKind qual kind =+ let gen = kind.g in {+ s = table {n => kind.s ! n ++ qual.s ! gen ! n} ;+ g = gen+ } ;+```+Notice+- **local definition** (``let`` expression)+- **variable pattern** ``n``++++#NEW++==An English concrete syntax for Foods with parameters==++We use some string operations from the library ``Prelude`` are used.+```+ concrete FoodsEng of Foods = open Prelude in {++ lincat+ S, Quality = SS ;+ Kind = {s : Number => Str} ;+ Item = {s : Str ; n : Number} ;++ lin+ Is item quality = ss (item.s ++ copula item.n ++ quality.s) ;+ This = det Sg "this" ;+ That = det Sg "that" ;+ These = det Pl "these" ;+ Those = det Pl "those" ;+ QKind quality kind = {s = table {n => quality.s ++ kind.s ! n}} ;+ Wine = regNoun "wine" ;+ Cheese = regNoun "cheese" ;+ Fish = noun "fish" "fish" ;+ Pizza = regNoun "pizza" ;+ Very = prefixSS "very" ;+ Fresh = ss "fresh" ;+ Warm = ss "warm" ;+ Italian = ss "Italian" ;+ Expensive = ss "expensive" ;+ Delicious = ss "delicious" ;+ Boring = ss "boring" ;+```++#NEW++```+ param+ Number = Sg | Pl ;++ oper+ det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} =+ \n,d,cn -> {+ s = d ++ cn.s ! n ;+ n = n+ } ;+ noun : Str -> Str -> {s : Number => Str} =+ \man,men -> {s = table {+ Sg => man ;+ Pl => men+ }+ } ;+ regNoun : Str -> {s : Number => Str} =+ \car -> noun car (car + "s") ;+ copula : Number -> Str =+ \n -> case n of {+ Sg => "is" ;+ Pl => "are"+ } ;+ }+```++#NEW++==More on inflection paradigms==++#Lsecinflection++Let us extend the English noun paradigms so that we can+deal with all nouns, not just the regular ones. The goal is to+provide a morphology module that makes it easy to+add words to a lexicon.+++#NEW++===Worst-case functions===++We perform **data abstraction** from the type+of nouns by writing a a **worst-case function**:+```+ oper Noun : Type = {s : Number => Str} ;++ oper mkNoun : Str -> Str -> Noun = \x,y -> {+ s = table {+ Sg => x ;+ Pl => y+ }+ } ;++ oper regNoun : Str -> Noun = \x -> mkNoun x (x + "s") ;+```+Then we can define+```+ lincat N = Noun ;+ lin Mouse = mkNoun "mouse" "mice" ;+ lin House = regNoun "house" ;+```+where the underlying types are not seen.++#NEW++We are free to change the undelying definitions, e.g.+add **case** (nominative or genitive) to noun inflection:+```+ param Case = Nom | Gen ;++ oper Noun : Type = {s : Number => Case => Str} ;+```+Now we have to redefine the worst-case function+```+ oper mkNoun : Str -> Str -> Noun = \x,y -> {+ s = table {+ Sg => table {+ Nom => x ;+ Gen => x + "'s"+ } ;+ Pl => table {+ Nom => y ;+ Gen => y + case last y of {+ "s" => "'" ;+ _ => "'s"+ }+ }+ } ;+```+But up from this level, we can retain the old definitions+```+ lin Mouse = mkNoun "mouse" "mice" ;+ oper regNoun : Str -> Noun = \x -> mkNoun x (x + "s") ;+```++++#NEW++In the last definition of ``mkNoun``, we used a case expression+on the last character of the plural, as well as the ``Prelude``+operation+```+ last : Str -> Str ;+```+returning the string consisting of the last character.++The case expression uses **pattern matching over strings**, which+is supported in GF, alongside with pattern matching over+parameters.++++#NEW++===Smart paradigms===++The regular //dog//-//dogs// paradigm has+predictable variations:+- nouns ending with an //y//: //fly//-//flies//, except if+ a vowel precedes the //y//: //boy//-//boys//+- nouns ending with //s//, //ch//, and a number of+ other endings: //bus//-//buses//, //leech//-//leeches//+++We could provide alternative paradigms:+```+ noun_y : Str -> Noun = \fly -> mkNoun fly (init fly + "ies") ;+ noun_s : Str -> Noun = \bus -> mkNoun bus (bus + "es") ;+```+(The Prelude function ``init`` drops the last character of a token.)++Drawbacks:+- it can be difficult to select the correct paradigm+- it can be difficult to remember the names of the different paradigms+++#NEW++Better solution: a **smart paradigm**:+```+ regNoun : Str -> Noun = \w ->+ let+ ws : Str = case w of {+ _ + ("a" | "e" | "i" | "o") + "o" => w + "s" ; -- bamboo+ _ + ("s" | "x" | "sh" | "o") => w + "es" ; -- bus, hero+ _ + "z" => w + "zes" ;-- quiz+ _ + ("a" | "e" | "o" | "u") + "y" => w + "s" ; -- boy+ x + "y" => x + "ies" ;-- fly+ _ => w + "s" -- car+ }+ in+ mkNoun w ws+```+GF has **regular expression patterns**:+- **disjunctive patterns** //P// ``|`` //Q//+- **concatenation patterns** //P// ``+`` //Q//+++The patterns are ordered in such a way that, for instance,+the suffix ``"oo"`` prevents //bamboo// from matching the suffix+``"o"``.+++#NEW++===Exercises on regular patterns===+++ The same rules that form plural nouns in English also+apply in the formation of third-person singular verbs.+Write a regular verb paradigm that uses this idea, but first+rewrite ``regNoun`` so that the analysis needed to build //s//-forms+is factored out as a separate ``oper``, which is shared with+``regVerb``.+++ Extend the verb paradigms to cover all verb forms+in English, with special care taken of variations with the suffix+//ed// (e.g. //try//-//tried//, //use//-//used//).+++ Implement the German **Umlaut** operation on word stems.+The operation changes the vowel of the stressed stem syllable as follows:+//a// to //ä//, //au// to //äu//, //o// to //ö//, and //u// to //ü//. You+can assume that the operation only takes syllables as arguments. Test the+operation to see whether it correctly changes //Arzt// to //Ärzt//,+//Baum// to //Bäum//, //Topf// to //Töpf//, and //Kuh// to //Küh//.++++#NEW++===Function types with variables===++In #Rchapsix, **dependent function types** need a notation+that binds a variable to the argument type, as in+```+ switchOff : (k : Kind) -> Action k+```+Function types //without// variables are actually a shorthand:+```+ PredVP : NP -> VP -> S+```+means+```+ PredVP : (x : NP) -> (y : VP) -> S+```+or any other naming of the variables.+++#NEW++Sometimes variables shorten the code, since they can share a type:+```+ octuple : (x,y,z,u,v,w,s,t : Str) -> Str+```+If a bound variable is not used, it can be replaced by a wildcard:+```+ octuple : (_,_,_,_,_,_,_,_ : Str) -> Str+```+A good practice is to indicate the number of arguments:+```+ octuple : (x1,_,_,_,_,_,_,x8 : Str) -> Str+```+For inflection paradigms, it is handy to use heuristic variable names,+looking like the expected forms:+```+ mkNoun : (mouse,mice : Str) -> Noun+```+++#NEW++===Separating operation types and definitions===++In librarues, it is useful to group type signatures separately from+definitions. It is possible to divide an ``oper`` judgement,+```+ oper regNoun : Str -> Noun ;+ oper regNoun s = mkNoun s (s + "s") ;+```+and put the parts in different places.++With the ``interface`` and ``instance`` module types+(see #Rsecinterface): the parts can even be put to different files.+++#NEW++===Overloading of operations===++**Overloading**: different functions can be given the same name, as e.g. in C++.++The compiler performs **overload resolution**, which works as long as the+functions have different types.++In GF, the functions must be grouped together in ``overload`` groups.++Example: different ways to define nouns in English:+```+ oper mkN : overload {+ mkN : (dog : Str) -> Noun ; -- regular nouns+ mkN : (mouse,mice : Str) -> Noun ; -- irregular nouns+ }+```+Cf. dictionaries: if the+word is regular, just one form is needed. If it is irregular,+more forms are given.++The definition can be given separately, or at the same time, as the types:+```+ oper mkN = overload {+ mkN : (dog : Str) -> Noun = regNoun ;+ mkN : (mouse,mice : Str) -> Noun = mkNoun ;+ }+```+**Exercise**. Design a system of English verb paradigms presented by+an overload group.+++#NEW++===Morphological analysis and morphology quiz===++The command ``morpho_analyse = ma``+can be used to read a text and return for each word its analyses+(in the current grammar):+```+ > read_file bible.txt | morpho_analyse+```+The command ``morpho_quiz = mq`` generates inflection exercises.+```+ % gf -path=alltenses:prelude $GF_LIB_PATH/alltenses/IrregFre.gfo++ > morpho_quiz -cat=V++ Welcome to GF Morphology Quiz.+ ...++ réapparaître : VFin VCondit Pl P2+ réapparaitriez+ > No, not réapparaitriez, but+ réapparaîtriez+ Score 0/1+```+To create a list for later use, use the command ``morpho_list = ml``+```+ > morpho_list -number=25 -cat=V | write_file exx.txt+```+++++#NEW++==The Italian Foods grammar==++#Lsecitalian++Parameters include not only number but also gender.+```+concrete FoodsIta of Foods = open Prelude in {++ param+ Number = Sg | Pl ;+ Gender = Masc | Fem ;+```+Qualities are inflected for gender and number, whereas kinds+have a parametric number and an inherent gender.+Items have an inherent number and gender.+```+ lincat+ Phr = SS ;+ Quality = {s : Gender => Number => Str} ;+ Kind = {s : Number => Str ; g : Gender} ;+ Item = {s : Str ; g : Gender ; n : Number} ;+```++#NEW++A Quality is an adjective, with one form for each gender-number combination.+```+ oper+ adjective : (_,_,_,_ : Str) -> {s : Gender => Number => Str} =+ \nero,nera,neri,nere -> {+ s = table {+ Masc => table {+ Sg => nero ;+ Pl => neri+ } ;+ Fem => table {+ Sg => nera ;+ Pl => nere+ }+ }+ } ;+```+Regular adjectives work by adding endings to the stem.+```+ regAdj : Str -> {s : Gender => Number => Str} = \nero ->+ let ner = init nero+ in adjective nero (ner + "a") (ner + "i") (ner + "e") ;+```++#NEW++For noun inflection, we are happy to give the two forms and the gender+explicitly:+```+ noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} =+ \vino,vini,g -> {+ s = table {+ Sg => vino ;+ Pl => vini+ } ;+ g = g+ } ;+```+We need only number variation for the copula.+```+ copula : Number -> Str =+ \n -> case n of {+ Sg => "è" ;+ Pl => "sono"+ } ;+```++#NEW++Determination is more complex than in English, because of gender:+```+ det : Number -> Str -> Str -> {s : Number => Str ; g : Gender} ->+ {s : Str ; g : Gender ; n : Number} =+ \n,m,f,cn -> {+ s = case cn.g of {Masc => m ; Fem => f} ++ cn.s ! n ;+ g = cn.g ;+ n = n+ } ;+```+++#NEW++The complete set of linearization rules:+```+ lin+ Is item quality =+ ss (item.s ++ copula item.n ++ quality.s ! item.g ! item.n) ;+ This = det Sg "questo" "questa" ;+ That = det Sg "quel" "quella" ;+ These = det Pl "questi" "queste" ;+ Those = det Pl "quei" "quelle" ;+ QKind quality kind = {+ s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ;+ g = kind.g+ } ;+ Wine = noun "vino" "vini" Masc ;+ Cheese = noun "formaggio" "formaggi" Masc ;+ Fish = noun "pesce" "pesci" Masc ;+ Pizza = noun "pizza" "pizze" Fem ;+ Very qual = {s = \\g,n => "molto" ++ qual.s ! g ! n} ;+ Fresh = adjective "fresco" "fresca" "freschi" "fresche" ;+ Warm = regAdj "caldo" ;+ Italian = regAdj "italiano" ;+ Expensive = regAdj "caro" ;+ Delicious = regAdj "delizioso" ;+ Boring = regAdj "noioso" ;+ }+```+++#NEW++===Exercises on using parameters===+++ Experiment with multilingual generation and translation in the+``Foods`` grammars.+++ Add items, qualities, and determiners to the grammar,+and try to get their inflection and inherent features right.+++ Write a concrete syntax of ``Food`` for a language of your choice,+now aiming for complete grammatical correctness by the use of parameters.+++ Measure the size of the context-free grammar corresponding to+``FoodsIta``. You can do this by printing the grammar in the context-free format+(``print_grammar -printer=bnf``) and counting the lines.+++++#NEW++==Discontinuous constituents==++A linearization record may contain more strings than one, and those+strings can be put apart in linearization.++Example: English particle+verbs, (//switch off//). The object can appear between:++//he switched it off//++The verb //switch off// is called a+**discontinuous constituents**.++We can define transitive verbs and their combinations as follows:+```+ lincat TV = {s : Number => Str ; part : Str} ;++ fun AppTV : Item -> TV -> Item -> Phrase ;++ lin AppTV subj tv obj =+ {s = subj.s ++ tv.s ! subj.n ++ obj.s ++ tv.part} ;+```++**Exercise**. Define the language ``a^n b^n c^n`` in GF, i.e.+any number of //a//'s followed by the same number of //b//'s and+the same number of //c//'s. This language is not context-free,+but can be defined in GF by using discontinuous constituents.+++#NEW++==Strings at compile time vs. run time==++Tokens are created in the following ways:+- quoted string: ``"foo"``+- gluing : ``t + s``+- predefined operations ``init, tail, tk, dp``+- pattern matching over strings+++Since //tokens must be known at compile time//,+the above operations may not be applied to **run-time variables**+(i.e. variables that stand for function arguments in linearization rules).++Hence it is not legal to write+```+ cat Noun ;+ fun Plural : Noun -> Noun ;+ lin Plural n = {s = n.s + "s"} ;+```+because ``n`` is a run-time variable. Also+```+ lin Plural n = {s = (regNoun n).s ! Pl} ;+```+is incorrect with ``regNoun`` as defined #Rsecinflection, because the run-time+variable is eventually sent to string pattern matching and gluing.+++#NEW++How to write tokens together without a space?+```+ lin Question p = {s = p + "?"} ;+```+is incorrect.++The way to go is to use an **unlexer** that creates correct spacing+after linearization.++Correspondingly, a **lexer** that e.g. analyses ``"warm?"`` into+to tokens is needed before parsing.+This topic will be covered in #Rseclexing.+++++++#NEW++===Supplementary constructs for concrete syntax===++====Record extension and subtyping====++The symbol ``**`` is used for both record types and record objects.+```+ lincat TV = Verb ** {c : Case} ;++ lin Follow = regVerb "folgen" ** {c = Dative} ;+```+``TV`` becomes a **subtype** of ``Verb``.++If //T// is a subtype of //R//, an object of //T// can be used whenever+an object of //R// is required.++**Covariance**: a function returning a record //T// as value can+also be used to return a value of a supertype //R//.++**Contravariance**: a function taking an //R// as argument+can also be applied to any object of a subtype //T//.+++#NEW++====Tuples and product types====++Product types and tuples are syntactic sugar for record types and records:+```+ T1 * ... * Tn === {p1 : T1 ; ... ; pn : Tn}+ <t1, ..., tn> === {p1 = T1 ; ... ; pn = Tn}+```+Thus the labels ``p1, p2,...`` are hard-coded.+++#NEW++====Prefix-dependent choices====++English indefinite article:+```+ oper artIndef : Str =+ pre {"a" ; "an" / strs {"a" ; "e" ; "i" ; "o"}} ;+```+Thus+```+ artIndef ++ "cheese" ---> "a" ++ "cheese"+ artIndef ++ "apple" ---> "an" ++ "apple"+```+++++++++#NEW++=Lesson 4: Using the resource grammar library=++#Lchapfive++Goals:+- navigate in the GF resource grammar library and use it in applications+- get acquainted with basic linguistic categories+- write functors to achieve maximal sharing of code in multilingual grammars+++#NEW++==The coverage of the library==++The current 16 resource languages (GF version 3.2, December 2010) are+- ``Bul``garian+- ``Cat``alan+- ``Dan``ish+- ``Dut``ch+- ``Eng``lish+- ``Fin``nish+- ``Fre``nch+- ``Ger``man+- ``Ita``lian+- ``Nor``wegian+- ``Pol``ish+- ``Ron``, Romanian+- ``Rus``sian+- ``Spa``nish+- ``Swe``dish+- ``Urd``u+++The first three letters (``Eng`` etc) are used in grammar module names+(ISO 639-3 standard).+++#NEW++==The structure of the library==++#Lseclexical++Semantic grammars (up to now in this tutorial):+a grammar defines a system of meanings (abstract syntax) and+tells how they are expressed(concrete syntax).++Resource grammars (as usual in linguistic tradition):+a grammar specifies the **grammatically correct combinations of words**,+whatever their meanings are.++With resource grammars, we can achieve a+wider coverage than with semantic grammars.++#NEW++===Lexical vs. phrasal rules===++A resource grammar has two kinds of categories and two kinds of rules:+- lexical:+ - lexical categories, to classify words+ - lexical rules, to define words and their properties++- phrasal (combinatorial, syntactic):+ - phrasal categories, to classify phrases of arbitrary size+ - phrasal rules, to combine phrases into larger phrases+++GE makes no formal distinction between these two kinds.++But it is a good discipline to follow.+++#NEW++===Lexical categories===++Two kinds of lexical categories:+- **closed**:+ - a finite number of words+ - seldom extended in the history of language+ - structural words / function words, e.g.+```+ Conj ; -- conjunction e.g. "and"+ Det ; -- determiner e.g. "this"+```++- **open**:+ - new words are added all the time+ - content words, e.g.+```+ N ; -- noun e.g. "pizza"+ A ; -- adjective e.g. "good"+ V ; -- verb e.g. "sleep"+```+++#NEW++===Lexical rules===++Closed classes: module ``Syntax``. In the ``Foods`` grammar, we need+```+ this_Det, that_Det, these_Det, those_Det : Det ;+ very_AdA : AdA ;+```+Naming convention: word followed by the category (so we can+distinguish the quantifier //that// from the conjunction //that//).++Open classes have no objects in ``Syntax``. Words are+built as they are needed in applications: if we have+```+ fun Wine : Kind ;+```+we will define+```+ lin Wine = mkN "wine" ;+```+where we use ``mkN`` from ``ParadigmsEng``:++++#NEW++===Resource lexicon===++Alternative concrete syntax for+```+ fun Wine : Kind ;+```+is to provide a **resource lexicon**, which contains definitions such as+```+ oper wine_N : N = mkN "wine" ;+```+so that we can write+```+ lin Wine = wine_N ;+```+Advantages:+- we accumulate a reusable lexicon+- we can use a #Rsecfunctor to speed up multilingual grammar implementation+++#NEW++===Phrasal categories===++In ``Foods``, we need just four phrasal categories:+```+ Cl ; -- clause e.g. "this pizza is good"+ NP ; -- noun phrase e.g. "this pizza"+ CN ; -- common noun e.g. "warm pizza"+ AP ; -- adjectival phrase e.g. "very warm"+```+Clauses are similar to sentences (``S``), but without a+fixed tense and mood; see #Rsecextended for how they relate.++Common nouns are made into noun phrases by adding determiners.+++#NEW++===Syntactic combinations===++We need the following combinations:+```+ mkCl : NP -> AP -> Cl ; -- e.g. "this pizza is very warm"+ mkNP : Det -> CN -> NP ; -- e.g. "this pizza"+ mkCN : AP -> CN -> CN ; -- e.g. "warm pizza"+ mkAP : AdA -> AP -> AP ; -- e.g. "very warm"+```+We also need **lexical insertion**, to form phrases from single words:+```+ mkCN : N -> NP ;+ mkAP : A -> AP ;+```+Naming convention: to construct a //C//, use a function ``mk``//C//.++Heavy overloading: the current library+(version 1.2) has 23 operations named ``mkNP``!+++#NEW++===Example syntactic combination===++The sentence+#BEQU+//these very warm pizzas are Italian//+#ENQU+can be built as follows:+```+ mkCl+ (mkNP these_Det+ (mkCN (mkAP very_AdA (mkAP warm_A)) (mkCN pizza_CN)))+ (mkAP italian_AP)+```+The task now: to define the concrete syntax of ``Foods`` so that+this syntactic tree gives the value of linearizing the semantic tree+```+ Is (These (QKind (Very Warm) Pizza)) Italian+```++++#NEW++==The resource API==++Language-specific and language-independent parts - roughly,+- the syntax API ``Syntax``//L// has the same types and+ functions for all languages //L//+- the morphology API ``Paradigms``//L// has partly+ different types and functions+ for different languages //L//+++Full API documentation on-line: the **resource synopsis**,++[``grammaticalframework.org/lib/doc/synopsis.html`` http://grammaticalframework.org/lib/doc/synopsis.html]+++#NEW++===A miniature resource API: categories===++|| Category | Explanation | Example ||+| ``Cl`` | clause (sentence), with all tenses | //she looks at this// |+| ``AP`` | adjectival phrase | //very warm// |+| ``CN`` | common noun (without determiner) | //red house// |+| ``NP`` | noun phrase (subject or object) | //the red house// |+| ``AdA`` | adjective-modifying adverb, | //very// |+| ``Det`` | determiner | //these// |+| ``A`` | one-place adjective | //warm// |+| ``N`` | common noun | //house// |+++#NEW++===A miniature resource API: rules===++|| Function | Type | Example ||+| ``mkCl`` | ``NP -> AP -> Cl`` | //John is very old// |+| ``mkNP`` | ``Det -> CN -> NP`` | //these old man// |+| ``mkCN`` | ``N -> CN`` | //house// |+| ``mkCN`` | ``AP -> CN -> CN`` | //very big blue house// |+| ``mkAP`` | ``A -> AP`` | //old// |+| ``mkAP`` | ``AdA -> AP -> AP`` | //very very old// |++#NEW++===A miniature resource API: structural words===++|| Function | Type | In English ||+| ``this_Det`` | ``Det`` | //this// |+| ``that_Det`` | ``Det`` | //that// |+| ``these_Det`` | ``Det`` | //this// |+| ``those_Det`` | ``Det`` | //that// |+| ``very_AdA`` | ``AdA`` | //very// |+++#NEW++===A miniature resource API: paradigms===++From ``ParadigmsEng``:++|| Function | Type ||+| ``mkN`` | ``(dog : Str) -> N`` |+| ``mkN`` | ``(man,men : Str) -> N`` |+| ``mkA`` | ``(cold : Str) -> A`` |++From ``ParadigmsIta``:++|| Function | Type ||+| ``mkN`` | ``(vino : Str) -> N`` |+| ``mkA`` | ``(caro : Str) -> A`` |+++#NEW++===A miniature resource API: more paradigms===++From ``ParadigmsGer``:++|| Function | Type ||+| ``Gender`` | ``Type`` |+| ``masculine`` | ``Gender`` |+| ``feminine`` | ``Gender`` |+| ``neuter`` | ``Gender`` |+| ``mkN`` | ``(Stufe : Str) -> N`` |+| ``mkN`` | ``(Bild,Bilder : Str) -> Gender -> N`` |+| ``mkA`` | ``(klein : Str) -> A`` |+| ``mkA`` | ``(gut,besser,beste : Str) -> A`` |++From ``ParadigmsFin``:++|| Function | Type ||+| ``mkN`` | ``(talo : Str) -> N`` |+| ``mkA`` | ``(hieno : Str) -> A`` |++++#NEW++===Exercises===++1. Try out the morphological paradigms in different languages. Do+as follows:+```+ > i -path=alltenses -retain alltenses/ParadigmsGer.gfo+ > cc -table mkN "Farbe"+ > cc -table mkA "gut" "besser" "beste"+```+++#NEW++==Example: English==++#Lsecenglish++We assume the abstract syntax ``Foods`` from #Rchapfour.++We don't need to think about inflection and agreement, but just pick+functions from the resource grammar library.++We need a path with+- the current directory ``.``+- the directory ``../foods``, in which ``Foods.gf`` resides.+- the library directory ``present``, which is relative to the+ environment variable ``GF_LIB_PATH``+++Thus the beginning of the module is+```+ --# -path=.:../foods:present++ concrete FoodsEng of Foods = open SyntaxEng,ParadigmsEng in {+```+++#NEW++===English example: linearization types and combination rules===++As linearization types, we use clauses for ``Phrase``, noun phrases+for ``Item``, common nouns for ``Kind``, and adjectival phrases for ``Quality``.+```+ lincat+ Phrase = Cl ;+ Item = NP ;+ Kind = CN ;+ Quality = AP ;+```+Now the combination rules we need almost write themselves automatically:+```+ lin+ Is item quality = mkCl item quality ;+ This kind = mkNP this_Det kind ;+ That kind = mkNP that_Det kind ;+ These kind = mkNP these_Det kind ;+ Those kind = mkNP those_Det kind ;+ QKind quality kind = mkCN quality kind ;+ Very quality = mkAP very_AdA quality ;+```+++#NEW++===English example: lexical rules===++We use resource paradigms and lexical insertion rules.++The two-place noun paradigm is needed only once, for+//fish// - everythins else is regular.+```+ Wine = mkCN (mkN "wine") ;+ Pizza = mkCN (mkN "pizza") ;+ Cheese = mkCN (mkN "cheese") ;+ Fish = mkCN (mkN "fish" "fish") ;+ Fresh = mkAP (mkA "fresh") ;+ Warm = mkAP (mkA "warm") ;+ Italian = mkAP (mkA "Italian") ;+ Expensive = mkAP (mkA "expensive") ;+ Delicious = mkAP (mkA "delicious") ;+ Boring = mkAP (mkA "boring") ;+ }+```+++#NEW++===English example: exercises===++1. Compile the grammar ``FoodsEng`` and generate+and parse some sentences.++2. Write a concrete syntax of ``Foods`` for Italian+or some other language included in the resource library. You can+compare the results with the hand-written+grammars presented earlier in this tutorial.++++#NEW++==Functor implementation of multilingual grammars==++#Lsecfunctor++===New language by copy and paste===++If you write a concrete syntax of ``Foods`` for some other+language, much of the code will look exactly the same+as for English. This is because+- the ``Syntax`` API is the same for all languages (because+ all languages in the resource package do implement the same+ syntactic structures)+- languages tend to use the syntactic structures in similar ways+++But lexical rules are more language-dependent.++Thus, to port a grammar to a new language, you++ copy the concrete syntax of a given language++ change the words (strings and inflection paradigms)+++Can we avoid this programming by copy-and-paste?++++#NEW++===Functors: functions on the module level===++**Functors** familiar from the functional programming languages ML and OCaml,+also known as **parametrized modules**.++In GF, a functor is a module that ``open``s one or more **interfaces**.++An ``interface`` is a module similar to a ``resource``, but it only+contains the //types// of ``oper``s, not (necessarily) their definitions.++Syntax for functors: add the keyword ``incomplete``. We will use the header+```+ incomplete concrete FoodsI of Foods = open Syntax, LexFoods in+```+where+```+ interface Syntax -- the resource grammar interface+ interface LexFoods -- the domain lexicon interface+```+When we moreover have+```+ instance SyntaxEng of Syntax -- the English resource grammar+ instance LexFoodsEng of LexFoods -- the English domain lexicon+```+we can write a **functor instantiation**,+```+ concrete FoodsGer of Foods = FoodsI with+ (Syntax = SyntaxGer),+ (LexFoods = LexFoodsGer) ;+```++#NEW++===Code for the Foods functor===++```+ --# -path=.:../foods++ incomplete concrete FoodsI of Foods = open Syntax, LexFoods in {+ lincat+ Phrase = Cl ;+ Item = NP ;+ Kind = CN ;+ Quality = AP ;+ lin+ Is item quality = mkCl item quality ;+ This kind = mkNP this_Det kind ;+ That kind = mkNP that_Det kind ;+ These kind = mkNP these_Det kind ;+ Those kind = mkNP those_Det kind ;+ QKind quality kind = mkCN quality kind ;+ Very quality = mkAP very_AdA quality ;++ Wine = mkCN wine_N ;+ Pizza = mkCN pizza_N ;+ Cheese = mkCN cheese_N ;+ Fish = mkCN fish_N ;+ Fresh = mkAP fresh_A ;+ Warm = mkAP warm_A ;+ Italian = mkAP italian_A ;+ Expensive = mkAP expensive_A ;+ Delicious = mkAP delicious_A ;+ Boring = mkAP boring_A ;+ }+```+++#NEW++===Code for the LexFoods interface===++#Lsecinterface++```+ interface LexFoods = open Syntax in {+ oper+ wine_N : N ;+ pizza_N : N ;+ cheese_N : N ;+ fish_N : N ;+ fresh_A : A ;+ warm_A : A ;+ italian_A : A ;+ expensive_A : A ;+ delicious_A : A ;+ boring_A : A ;+ }+```++#NEW++===Code for a German instance of the lexicon===++```+ instance LexFoodsGer of LexFoods = open SyntaxGer, ParadigmsGer in {+ oper+ wine_N = mkN "Wein" ;+ pizza_N = mkN "Pizza" "Pizzen" feminine ;+ cheese_N = mkN "Käse" "Käsen" masculine ;+ fish_N = mkN "Fisch" ;+ fresh_A = mkA "frisch" ;+ warm_A = mkA "warm" "wärmer" "wärmste" ;+ italian_A = mkA "italienisch" ;+ expensive_A = mkA "teuer" ;+ delicious_A = mkA "köstlich" ;+ boring_A = mkA "langweilig" ;+ }+```+++#NEW++===Code for a German functor instantiation===++```+ --# -path=.:../foods:present++ concrete FoodsGer of Foods = FoodsI with+ (Syntax = SyntaxGer),+ (LexFoods = LexFoodsGer) ;+```++++#NEW++===Adding languages to a functor implementation===++Just two modules are needed:+- a domain lexicon instance+- a functor instantiation+++The functor instantiation is completely mechanical to write.++The domain lexicon instance requires some knowledge of the words of the+language:+- what words are used for which concepts+- how the words are+- features such as genders+++#NEW++===Example: adding Finnish===++Lexicon instance+```+ instance LexFoodsFin of LexFoods = open SyntaxFin, ParadigmsFin in {+ oper+ wine_N = mkN "viini" ;+ pizza_N = mkN "pizza" ;+ cheese_N = mkN "juusto" ;+ fish_N = mkN "kala" ;+ fresh_A = mkA "tuore" ;+ warm_A = mkA "lämmin" ;+ italian_A = mkA "italialainen" ;+ expensive_A = mkA "kallis" ;+ delicious_A = mkA "herkullinen" ;+ boring_A = mkA "tylsä" ;+ }+```+Functor instantiation+```+ --# -path=.:../foods:present++ concrete FoodsFin of Foods = FoodsI with+ (Syntax = SyntaxFin),+ (LexFoods = LexFoodsFin) ;+```+++#NEW++===A design pattern===++This can be seen as a //design pattern// for multilingual grammars:+```+ concrete DomainL*++ instance LexDomainL instance SyntaxL*++ incomplete concrete DomainI+ / | \+ interface LexDomain abstract Domain interface Syntax*+```+Modules marked with ``*`` are either given in the library, or trivial.++Of the hand-written modules, only ``LexDomainL`` is language-dependent.+++#NEW++===Functors: exercises===++1. Compile and test ``FoodsGer``.++2. Refactor ``FoodsEng`` into a functor instantiation.++3. Instantiate the functor ``FoodsI`` to some language of+your choice.++4. Design a small grammar that can be used for controlling+an MP3 player. The grammar should be able to recognize commands such+as //play this song//, with the following variations:+- verbs: //play//, //remove//+- objects: //song//, //artist//+- determiners: //this//, //the previous//+- verbs without arguments: //stop//, //pause//+++The implementation goes in the following phases:++ abstract syntax++ (optional:) prototype string-based concrete syntax++ functor over resource syntax and lexicon interface++ lexicon instance for the first language++ functor instantiation for the first language++ lexicon instance for the second language++ functor instantiation for the second language++ ...++++#NEW++==Restricted inheritance==++===A problem with functors===++Problem: a functor only works when all languages use the resource ``Syntax``+in the same way.++Example (contrived): assume that English has+no word for ``Pizza``, but has to use the paraphrase //Italian pie//.+This is no longer a noun ``N``, but a complex phrase+in the category ``CN``.++Possible solution: change interface the ``LexFoods`` with+```+ oper pizza_CN : CN ;+```+Problem with this solution:+- we may end up changing the interface and the function with each new language+- we must every time also change the instances for the old languages to maintain+ type correctness+++#NEW++===Restricted inheritance: include or exclude===++A module may inherit just a selection of names.++Example: the ``FoodMarket`` example "Rsecarchitecture:+```+ abstract Foodmarket = Food, Fruit [Peach], Mushroom - [Agaric]+```+Here, from ``Fruit`` we include ``Peach`` only, and from ``Mushroom``+we exclude ``Agaric``.++A concrete syntax of ``Foodmarket`` must make the analogous restrictions.+++#NEW++===The functor problem solved===++The English instantiation inherits the functor+implementation except for the constant ``Pizza``. This constant+is defined in the body instead:+```+ --# -path=.:../foods:present++ concrete FoodsEng of Foods = FoodsI - [Pizza] with+ (Syntax = SyntaxEng),+ (LexFoods = LexFoodsEng) **+ open SyntaxEng, ParadigmsEng in {++ lin Pizza = mkCN (mkA "Italian") (mkN "pie") ;+ }+```+++#NEW++==Grammar reuse==++Abstract syntax modules can be used as interfaces,+and concrete syntaxes as their instances.++The following correspondencies are then applied:+```+ cat C <---> oper C : Type++ fun f : A <---> oper f : A++ lincat C = T <---> oper C : Type = T++ lin f = t <---> oper f : A = t+```+++++#NEW++===Library exercises===++1. Find resource grammar terms for the following+English phrases (in the category ``Phr``). You can first try to+build the terms manually.++//every man loves a woman//++//this grammar speaks more than ten languages//++//which languages aren't in the grammar//++//which languages did you want to speak//+++Then translate the phrases to other languages.+++#NEW++==Tenses==++#Lsectense++In ``Foods`` grammars, we have used the path+```+ --# -path=.:../foods+```+The library subdirectory ``present`` is a restricted version+of the resource, with only present tense of verbs and sentences.++By just changing the path, we get all tenses:+```+ --# -path=.:../foods:alltenses+```+Now we can see all the tenses of phrases, by using the ``-all`` flag+in linearization:+```+ > gr | l -all+ This wine is delicious+ Is this wine delicious+ This wine isn't delicious+ Isn't this wine delicious+ This wine is not delicious+ Is this wine not delicious+ This wine has been delicious+ Has this wine been delicious+ This wine hasn't been delicious+ Hasn't this wine been delicious+ This wine has not been delicious+ Has this wine not been delicious+ This wine was delicious+ Was this wine delicious+ This wine wasn't delicious+ Wasn't this wine delicious+ This wine was not delicious+ Was this wine not delicious+ This wine had been delicious+ Had this wine been delicious+ This wine hadn't been delicious+ Hadn't this wine been delicious+ This wine had not been delicious+ Had this wine not been delicious+ This wine will be delicious+ Will this wine be delicious+ This wine won't be delicious+ Won't this wine be delicious+ This wine will not be delicious+ Will this wine not be delicious+ This wine will have been delicious+ Will this wine have been delicious+ This wine won't have been delicious+ Won't this wine have been delicious+ This wine will not have been delicious+ Will this wine not have been delicious+ This wine would be delicious+ Would this wine be delicious+ This wine wouldn't be delicious+ Wouldn't this wine be delicious+ This wine would not be delicious+ Would this wine not be delicious+ This wine would have been delicious+ Would this wine have been delicious+ This wine wouldn't have been delicious+ Wouldn't this wine have been delicious+ This wine would not have been delicious+ Would this wine not have been delicious+```+We also see+- polarity (positive vs. negative)+- word order (direct vs. inverted)+- variation between contracted and full negation+++The list is even longer in languages that have more+tenses and moods, e.g. the Romance languages.++++#NEW++=Lesson 5: Refining semantics in abstract syntax=++#Lchapsix++Goals:+- include semantic conditions in grammars, by using+ - **dependent types**+ - **higher order abstract syntax**+ - proof objects+ - semantic definitions++These concepts are inherited from **type theory** (more precisely:+constructive type theory, or Martin-Löf type theory).++Type theory is the basis **logical frameworks**.++GF = logical framework + concrete syntax.+++#NEW++==Dependent types==++#Lsecsmarthouse++Problem: to express **conditions of semantic well-formedness**.++Example: a voice command system for a "smart house" wants to+eliminate meaningless commands.++Thus we want to restrict particular actions to+particular devices - we can //dim a light//, but we cannot+//dim a fan//.++The following example is borrowed from the+Regulus Book (Rayner & al. 2006).++A simple example is a "smart house" system, which+defines voice commands for household appliances.+++#NEW++===A dependent type system===++Ontology:+- there are commands and device kinds+- for each kind of device, there are devices and actions+- a command concerns an action of some kind on a device of the same kind+++Abstract syntax formalizing this:+```+ cat+ Command ;+ Kind ;+ Device Kind ; -- argument type Kind+ Action Kind ;+ fun+ CAction : (k : Kind) -> Action k -> Device k -> Command ;+```+``Device`` and ``Action`` are both dependent types.+++#NEW++===Examples of devices and actions===++Assume the kinds ``light`` and ``fan``,+```+ light, fan : Kind ;+ dim : Action light ;+```+Given a kind, //k//, you can form the device //the k//.+```+ DKindOne : (k : Kind) -> Device k ; -- the light+```+Now we can form the syntax tree+```+ CAction light dim (DKindOne light)+```+but we cannot form the trees+```+ CAction light dim (DKindOne fan)+ CAction fan dim (DKindOne light)+ CAction fan dim (DKindOne fan)+```+++#NEW++===Linearization and parsing with dependent types===++Concrete syntax does not know if a category is a dependent type.+```+ lincat Action = {s : Str} ;+ lin CAction _ act dev = {s = act.s ++ dev.s} ;+```+Notice that the ``Kind`` argument is suppressed in linearization.++Parsing with dependent types is performed in two phases:++ context-free parsing++ filtering through type checker+++By just doing the first phase, the ``kind`` argument is not found:+```+ > parse "dim the light"+ CAction ? dim (DKindOne light)+```+Moreover, type-incorrect commands are not rejected:+```+ > parse "dim the fan"+ CAction ? dim (DKindOne fan)+```+The term ``?`` is a **metavariable**, returned by the parser+for any subtree that is suppressed by a linearization rule.+These are the same kind of metavariables as were used #Rsecediting+to mark incomplete parts of trees in the syntax editor.++++#NEW++===Solving metavariables===++Use the command ``put_tree = pt`` with the option ``-typecheck``:+```+ > parse "dim the light" | put_tree -typecheck+ CAction light dim (DKindOne light)+```+The ``typecheck`` process may fail, in which case an error message+is shown and no tree is returned:+```+ > parse "dim the fan" | put_tree -typecheck++ Error in tree UCommand (CAction ? 0 dim (DKindOne fan)) :+ (? 0 <> fan) (? 0 <> light)+```+++++#NEW++==Polymorphism==++#Lsecpolymorphic++Sometimes an action can be performed on all kinds of devices.++This is represented as a function that takes a ``Kind`` as an argument+and produce an ``Action`` for that ``Kind``:+```+ fun switchOn, switchOff : (k : Kind) -> Action k ;+```+Functions of this kind are called **polymorphic**.++We can use this kind of polymorphism in concrete syntax as well,+to express Haskell-type library functions:+```+ oper const :(a,b : Type) -> a -> b -> a =+ \_,_,c,_ -> c ;++ oper flip : (a,b,c : Type) -> (a -> b ->c) -> b -> a -> c =+ \_,_,_,f,x,y -> f y x ;+```+++#NEW++===Dependent types: exercises===++1. Write an abstract syntax module with above contents+and an appropriate English concrete syntax. Try to parse the commands+//dim the light// and //dim the fan//, with and without ``solve`` filtering.+++2. Perform random and exhaustive generation, with and without+``solve`` filtering.++3. Add some device kinds and actions to the grammar.++++#NEW++==Proof objects==++**Curry-Howard isomorphism** = **propositions as types principle**:+a proposition is a type of proofs (= proof objects).++Example: define the //less than// proposition for natural numbers,+```+ cat Nat ;+ fun Zero : Nat ;+ fun Succ : Nat -> Nat ;+```+Define inductively what it means for a number //x// to be //less than//+a number //y//:+- ``Zero`` is less than ``Succ`` //y// for any //y//.+- If //x// is less than //y//, then ``Succ`` //x// is less than ``Succ`` //y//.+++Expressing these axioms in type theory+with a dependent type ``Less`` //x y// and two functions constructing+its objects:+```+ cat Less Nat Nat ;+ fun lessZ : (y : Nat) -> Less Zero (Succ y) ;+ fun lessS : (x,y : Nat) -> Less x y -> Less (Succ x) (Succ y) ;+```+Example: the fact that 2 is less that 4 has the proof object+```+ lessS (Succ Zero) (Succ (Succ (Succ Zero)))+ (lessS Zero (Succ (Succ Zero)) (lessZ (Succ Zero)))+ : Less (Succ (Succ Zero)) (Succ (Succ (Succ (Succ Zero))))+```++++#NEW++===Proof-carrying documents===++Idea: to be semantically well-formed, the abstract syntax of a document+must contain a proof of some property,+although the proof is not shown in the concrete document.++Example: documents describing flight connections:++//To fly from Gothenburg to Prague, first take LH3043 to Frankfurt, then OK0537 to Prague.//++The well-formedness of this text is partly expressible by dependent typing:+```+ cat+ City ;+ Flight City City ;+ fun+ Gothenburg, Frankfurt, Prague : City ;+ LH3043 : Flight Gothenburg Frankfurt ;+ OK0537 : Flight Frankfurt Prague ;+```+To extend the conditions to flight connections, we introduce a category+of proofs that a change is possible:+```+ cat IsPossible (x,y,z : City)(Flight x y)(Flight y z) ;+```+A legal connection is formed by the function+```+ fun Connect : (x,y,z : City) ->+ (u : Flight x y) -> (v : Flight y z) ->+ IsPossible x y z u v -> Flight x z ;+```+++#NEW++==Restricted polymorphism==++Above, all Actions were either of+- **monomorphic**: defined for one Kind+- **polymorphic**: defined for all Kinds+++To make this scale up for new Kinds, we can refine this to+**restricted polymorphism**: defined for Kinds of a certain **class**+++The notion of class uses the Curry-Howard isomorphism as follows:+- a class is a **predicate** of Kinds --- i.e. a type depending of Kinds+- a Kind is in a class if there is a proof object of this type+++#NEW++===Example: classes for switching and dimming===++We modify the smart house grammar:+```+cat+ Switchable Kind ;+ Dimmable Kind ;+fun+ switchable_light : Switchable light ;+ switchable_fan : Switchable fan ;+ dimmable_light : Dimmable light ;++ switchOn : (k : Kind) -> Switchable k -> Action k ;+ dim : (k : Kind) -> Dimmable k -> Action k ;+```+Classes for new actions can be added incrementally.++++#NEW++==Variable bindings==++#Lsecbinding++Mathematical notation and programming languages have+expressions that **bind** variables.++Example: universal quantifier formula+```+ (All x)B(x)+```+The variable ``x`` has a **binding** ``(All x)``, and+occurs **bound** in the **body** ``B(x)``.++Examples from informal mathematical language:+```+ for all x, x is equal to x++ the function that for any numbers x and y returns the maximum of x+y+ and x*y++ Let x be a natural number. Assume that x is even. Then x + 3 is odd.+```++++#NEW++===Higher-order abstract syntax===++Abstract syntax can use functions as arguments:+```+ cat Ind ; Prop ;+ fun All : (Ind -> Prop) -> Prop+```+where ``Ind`` is the type of individuals and ``Prop``,+the type of propositions.++Let us add an equality predicate+```+ fun Eq : Ind -> Ind -> Prop+```+Now we can form the tree+```+ All (\x -> Eq x x)+```+which we want to relate to the ordinary notation+```+ (All x)(x = x)+```+In **higher-order abstract syntax** (HOAS), all variable bindings are+expressed using higher-order syntactic constructors.+++#NEW++===Higher-order abstract syntax: linearization===++HOAS has proved to be useful in the semantics and computer implementation of+variable-binding expressions.++How do we relate HOAS to the concrete syntax?++In GF, we write+```+ fun All : (Ind -> Prop) -> Prop+ lin All B = {s = "(" ++ "All" ++ B.$0 ++ ")" ++ B.s}+```+General rule: if an argument type of a ``fun`` function is+a function type ``A -> C``, the linearization type of+this argument is the linearization type of ``C``+together with a new field ``$0 : Str``.++The argument ``B`` thus has the linearization type+```+ {s : Str ; $0 : Str},+```+If there are more bindings, we add ``$1``, ``$2``, etc.+++#NEW++===Eta expansion===++To make sense of linearization, syntax trees must be+**eta-expanded**: for any function of type+```+ A -> B+```+an eta-expanded syntax tree has the form+```+ \x -> b+```+where ``b : B`` under the assumption ``x : A``.++Given the linearization rule+```+ lin Eq a b = {s = "(" ++ a.s ++ "=" ++ b.s ++ ")"}+```+the linearization of the tree+```+ \x -> Eq x x+```+is the record+```+ {$0 = "x", s = ["( x = x )"]}+```+Then we can compute the linearization of the formula,+```+ All (\x -> Eq x x) --> {s = "[( All x ) ( x = x )]"}.+```+The linearization of the variable ``x`` is,+"automagically", the string ``"x"``.++++#NEW++===Parsing variable bindings===++GF can treat any one-word string as a variable symbol.+```+ > p -cat=Prop "( All x ) ( x = x )"+ All (\x -> Eq x x)+```+Variables must be bound if they are used:+```+ > p -cat=Prop "( All x ) ( x = y )"+ no tree found+```+++++#NEW++===Exercises on variable bindings===++1. Write an abstract syntax of the whole+**predicate calculus**, with the+**connectives** "and", "or", "implies", and "not", and the+**quantifiers** "exists" and "for all". Use higher-order functions+to guarantee that unbounded variables do not occur.++2. Write a concrete syntax for your favourite+notation of predicate calculus. Use Latex as target language+if you want nice output. You can also try producing boolean+expressions of some programming language. Use as many parenthesis as you need to+guarantee non-ambiguity.+++#NEW++==Semantic definitions==++#Lsecdefdef++The ``fun`` judgements of GF are declarations of functions, giving their types.++Can we **compute** ``fun`` functions?++Mostly we are not interested, since functions are seen as constructors,+i.e. data forms - as usual with+```+ fun Zero : Nat ;+ fun Succ : Nat -> Nat ;+```+But it is also possible to give **semantic definitions** to functions.+The key word is ``def``:+```+ fun one : Nat ;+ def one = Succ Zero ;++ fun twice : Nat -> Nat ;+ def twice x = plus x x ;++ fun plus : Nat -> Nat -> Nat ;+ def+ plus x Zero = x ;+ plus x (Succ y) = Succ (Sum x y) ;+```++#NEW++===Computing a tree===++Computation: follow a chain of definition until no definition+can be applied,+```+ plus one one -->+ plus (Succ Zero) (Succ Zero) -->+ Succ (plus (Succ Zero) Zero) -->+ Succ (Succ Zero)+```+Computation in GF is performed with the ``put_term`` command and the+``compute`` transformation, e.g.+```+ > parse -tr "1 + 1" | put_term -transform=compute -tr | l+ plus one one+ Succ (Succ Zero)+ s(s(0))+```+++#NEW++===Definitional equality===++Two trees are definitionally equal if they compute into the same tree.++Definitional equality does not guarantee sameness of linearization:+```+ plus one one ===> 1 + 1+ Succ (Succ Zero) ===> s(s(0))+```+The main use of this concept is in type checking: sameness of types.++Thus e.g. the following types are equal+```+ Less Zero one+ Less Zero (Succ Zero))+```+so that an object of one also is an object of the other.++++#NEW++===Judgement forms for constructors===++The judgement form ``data`` tells that a category has+certain functions as constructors:+```+ data Nat = Succ | Zero ;+```+The type signatures of constructors are given separately,+```+ fun Zero : Nat ;+ fun Succ : Nat -> Nat ;+```+There is also a shorthand:+```+ data Succ : Nat -> Nat ; === fun Succ : Nat -> Nat ;+ data Nat = Succ ;+```+Notice: in ``def`` definitions, identifier patterns not+marked as ``data`` will be treated as variables.+++#NEW++===Exercises on semantic definitions===++1. Implement an interpreter of a small functional programming+language with natural numbers, lists, pairs, lambdas, etc. Use higher-order+abstract syntax with semantic definitions. As concrete syntax, use+your favourite programming language.++2. There is no termination checking for ``def`` definitions.+Construct an examples that makes type checking loop.+Type checking can be invoked with ``put_term -transform=solve``.++++#NEW++==Lesson 6: Grammars of formal languages==+++#Lchapseven++Goals:+- write grammars for formal languages (mathematical notation, programming languages)+- interface between formal and natural langauges+- implement a compiler by using GF+++#NEW++===Arithmetic expressions===++We construct a calculator with addition, subtraction, multiplication, and+division of integers.+```+ abstract Calculator = {++ cat Exp ;++ fun+ EPlus, EMinus, ETimes, EDiv : Exp -> Exp -> Exp ;+ EInt : Int -> Exp ;+ }+```+The category ``Int`` is a built-in category of+integers. Its syntax trees **integer literals**, i.e.+sequences of digits:+```+ 5457455814608954681 : Int+```+These are the only objects of type ``Int``:+grammars are not allowed to declare functions with ``Int`` as value type.+++#NEW++===Concrete syntax: a simple approach===++We begin with a+concrete syntax that always uses parentheses around binary+operator applications:+```+ concrete CalculatorP of Calculator = {++ lincat+ Exp = SS ;+ lin+ EPlus = infix "+" ;+ EMinus = infix "-" ;+ ETimes = infix "*" ;+ EDiv = infix "/" ;+ EInt i = i ;++ oper+ infix : Str -> SS -> SS -> SS = \f,x,y ->+ ss ("(" ++ x.s ++ f ++ y.s ++ ")") ;+ }+```+Now we have+```+ > linearize EPlus (EInt 2) (ETimes (EInt 3) (EInt 4))+ ( 2 + ( 3 * 4 ) )+```+First problems:+- to get rid of superfluous spaces and+- to recognize integer literals in the parser+++#NEW++==Lexing and unlexing==++#Lseclexing++The input of parsing in GF is not just a string, but a list of+**tokens**, returned by a **lexer**.++The default lexer in GF returns chunks separated by spaces:+```+ "(12 + (3 * 4))" ===> "(12", "+", "(3". "*". "4))"+```+The proper way would be+```+ "(", "12", "+", "(", "3", "*", "4", ")", ")"+```+Moreover, the tokens ``"12"``, ``"3"``, and ``"4"`` should be recognized as+integer literals - they cannot be found in the grammar.+++#NEW++Lexers are invoked by flags to the command ``put_string = ps``.+```+ > put_string -lexcode "(2 + (3 * 4))"+ ( 2 + ( 3 * 4 ) )+```+This can be piped into a parser, as usual:+```+ > ps -lexcode "(2 + (3 * 4))" | parse+ EPlus (EInt 2) (ETimes (EInt 3) (EInt 4))+```+In linearization, we use a corresponding **unlexer**:+```+ > linearize EPlus (EInt 2) (ETimes (EInt 3) (EInt 4)) | ps -unlexcode+ (2 + (3 * 4))+```+++#NEW++===Most common lexers and unlexers===++ || lexer | unlexer | description ||+ | ``chars`` | ``unchars`` | each character is a token+ | ``lexcode`` | ``unlexcode`` | program code conventions (uses Haskell's lex)+ | ``lexmixed`` | ``unlexmixed`` | like text, but between $ signs like code+ | ``lextext`` | ``unlextext`` | with conventions on punctuation and capitals+ | ``words`` | ``unwords`` | (default) tokens separated by space characters++%TODO: also on alphabet encodings - although somewhere else+++#NEW++==Precedence and fixity==++Arithmetic expressions should be unambiguous. If we write+```+ 2 + 3 * 4+```+it should be parsed as one, but not both, of+```+ EPlus (EInt 2) (ETimes (EInt 3) (EInt 4))+ ETimes (EPlus (EInt 2) (EInt 3)) (EInt 4)+```+We choose the former tree, because+multiplication has **higher precedence** than addition.++To express the latter tree, we have to use parentheses:+```+ (2 + 3) * 4+```+The usual precedence rules:+- Integer constants and expressions in parentheses have the highest precedence.+- Multiplication and division have equal precedence, lower than the highest+ but higher than addition and subtraction, which are again equal.+- All the four binary operations are **left-associative**:+ ``1 + 2 + 3`` means the same as ``(1 + 2) + 3``.++++#NEW++===Precedence as a parameter===++Precedence can be made into an inherent feature of expressions:+```+ oper+ Prec : PType = Ints 2 ;+ TermPrec : Type = {s : Str ; p : Prec} ;++ mkPrec : Prec -> Str -> TermPrec = \p,s -> {s = s ; p = p} ;++ lincat+ Exp = TermPrec ;+```+Notice ``Ints 2``: a parameter type, whose values are the integers+``0,1,2``.++Using precedence levels: compare the inherent precedence of an+expression with the expected precedence.+- if the inherent precedence is lower than the expected precedence,+ use parentheses+- otherwise, no parentheses are needed+++This idea is encoded in the operation+```+ oper usePrec : TermPrec -> Prec -> Str = \x,p ->+ case lessPrec x.p p of {+ True => "(" x.s ")" ;+ False => x.s+ } ;+```+(We use ``lessPrec`` from ``lib/prelude/Formal``.)++++#NEW++===Fixities===++We can define left-associative infix expressions:+```+ infixl : Prec -> Str -> (_,_ : TermPrec) -> TermPrec = \p,f,x,y ->+ mkPrec p (usePrec x p ++ f ++ usePrec y (nextPrec p)) ;+```+Constant-like expressions (the highest level):+```+ constant : Str -> TermPrec = mkPrec 2 ;+```+All these operations can be found in ``lib/prelude/Formal``,+which has 5 levels.++Now we can write the whole concrete syntax of ``Calculator`` compactly:+```+ concrete CalculatorC of Calculator = open Formal, Prelude in {++ flags lexer = codelit ; unlexer = code ; startcat = Exp ;++ lincat Exp = TermPrec ;++ lin+ EPlus = infixl 0 "+" ;+ EMinus = infixl 0 "-" ;+ ETimes = infixl 1 "*" ;+ EDiv = infixl 1 "/" ;+ EInt i = constant i.s ;+ }+```+++#NEW++===Exercises on precedence===++1. Define non-associative and right-associative infix operations+analogous to ``infixl``.++2. Add a constructor that puts parentheses around expressions+to raise their precedence, but that is eliminated by a ``def`` definition.+Test parsing with and without a pipe to ``pt -transform=compute``.++++#NEW++==Code generation as linearization==++Translate arithmetic (infix) to JVM (postfix):+```+ 2 + 3 * 4++ ===>++ iconst 2 : iconst 3 ; iconst 4 ; imul ; iadd+```+Just give linearization rules for JVM:+```+ lin+ EPlus = postfix "iadd" ;+ EMinus = postfix "isub" ;+ ETimes = postfix "imul" ;+ EDiv = postfix "idiv" ;+ EInt i = ss ("iconst" ++ i.s) ;+ oper+ postfix : Str -> SS -> SS -> SS = \op,x,y ->+ ss (x.s ++ ";" ++ y.s ++ ";" ++ op) ;+```+++#NEW++===Programs with variables===++A **straight code** programming language, with+**initializations** and **assignments**:+```+ int x = 2 + 3 ;+ int y = x + 1 ;+ x = x + 9 * y ;+```+We define programs by the following constructors:+```+ fun+ PEmpty : Prog ;+ PInit : Exp -> (Var -> Prog) -> Prog ;+ PAss : Var -> Exp -> Prog -> Prog ;+```+``PInit`` uses higher-order abstract syntax for making the+initialized variable available in the **continuation** of the program.++The abstract syntax tree for the above code is+```+ PInit (EPlus (EInt 2) (EInt 3)) (\x ->+ PInit (EPlus (EVar x) (EInt 1)) (\y ->+ PAss x (EPlus (EVar x) (ETimes (EInt 9) (EVar y)))+ PEmpty))+```+No uninitialized variables are allowed - there are no constructors for ``Var``!+But we do have the rule+```+ fun EVar : Var -> Exp ;+```+The rest of the grammar is just the same as for arithmetic expressions+#Rsecprecedence. The best way to implement it is perhaps by writing a+module that extends the expression module. The most natural start category+of the extension is ``Prog``.+++#NEW++===Exercises on code generation===++1. Define a C-like concrete syntax of the straight-code language.++2. Extend the straight-code language to expressions of type ``float``.+To guarantee type safety, you can define a category ``Typ`` of types, and+make ``Exp`` and ``Var`` dependent on ``Typ``. Basic floating point expressions+can be formed from literal of the built-in GF type ``Float``. The arithmetic+operations should be made polymorphic (as #Rsecpolymorphic).++3. Extend JVM generation to the straight-code language, using+two more instructions+- ``iload`` //x//, which loads the value of the variable //x//+- ``istore`` //x// which stores a value to the variable //x//+++Thus the code for the example in the previous section is+```+ iconst 2 ; iconst 3 ; iadd ; istore x ;+ iload x ; iconst 1 ; iadd ; istore y ;+ iload x ; iconst 9 ; iload y ; imul ; iadd ; istore x ;+```++4. If you made the exercise of adding floating point numbers to+the language, you can now cash out the main advantage of type checking+for code generation: selecting type-correct JVM instructions. The floating+point instructions are precisely the same as the integer one, except that+the prefix is ``f`` instead of ``i``, and that ``fconst`` takes floating+point literals as arguments.++++#NEW++=Lesson 7: Embedded grammars=++#Lchapeight++Goals:+- use grammars as parts of programs written in Haskell and JavaScript+- implement stand-alone question-answering systems and translators based on+ GF grammars+- generate language models for speech recognition from GF grammars++++#NEW++==Functionalities of an embedded grammar format==++GF grammars can be used as parts of programs written in other programming+languages, to be called **host languages**.+This facility is based on several components:+- PGF: a portable format for multilingual GF grammars+- a PGF interpreter written in the host language+- a library in the host language that enables calling the interpreter+- a way to manipulate abstract syntax trees in the host language+++++#NEW++==The portable grammar format==++The portable format is called PGF, "Portable Grammar Format".++This format is produced by using GF as batch compiler, with the option ``-make``,+from the operative system shell:+```+ % gf -make SOURCE.gf+```+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+faster than sets of separate modules.++Application programmers have never any need to read or modify PGF files.++PGF thus plays the same role as machine code in+general-purpose programming (or bytecode in Java).+++#NEW++===Haskell: the EmbedAPI module===++The Haskell API contains (among other things) the following types and functions:+```+ readPGF :: FilePath -> IO PGF++ linearize :: PGF -> Language -> Tree -> String+ parse :: PGF -> Language -> Category -> String -> [Tree]++ linearizeAll :: PGF -> Tree -> [String]+ linearizeAllLang :: PGF -> Tree -> [(Language,String)]++ parseAll :: PGF -> Category -> String -> [[Tree]]+ parseAllLang :: PGF -> Category -> String -> [(Language,[Tree])]++ languages :: PGF -> [Language]+ categories :: PGF -> [Category]+ startCat :: PGF -> Category+```+This is the only module that needs to be imported in the Haskell application.+It is available as a part of the GF distribution, in the file+``src/PGF.hs``.++++#NEW++===First application: a translator===++Let us first build a stand-alone translator, which can translate+in any multilingual grammar between any languages in the grammar.+```+module Main where++import PGF+import System (getArgs)++main :: IO ()+main = do+ file:_ <- getArgs+ gr <- readPGF file+ interact (translate gr)++translate :: PGF -> String -> String+translate gr s = case parseAllLang gr (startCat gr) s of+ (lg,t:_):_ -> unlines [linearize gr l t | l <- languages gr, l /= lg]+ _ -> "NO PARSE"+```+To run the translator, first compile it by+```+ % ghc -make -o trans Translator.hs+```+For this, you need the Haskell compiler [GHC http://www.haskell.org/ghc].+++#NEW++===Producing PGF for the translator===++Then produce a PGF file. For instance, the ``Food`` grammar set can be+compiled as follows:+```+ % gf -make FoodEng.gf FoodIta.gf+```+This produces the file ``Food.pgf`` (its name comes from the abstract syntax).++The Haskell library function ``interact`` makes the ``trans`` program work+like a Unix filter, which reads from standard input and writes to standard+output. Therefore it can be a part of a pipe and read and write files.+The simplest way to translate is to ``echo`` input to the program:+```+ % echo "this wine is delicious" | ./trans Food.pgf+ questo vino è delizioso+```+The result is given in all languages except the input language.++%TODO convert the output to UTF8+++#NEW++===A translator loop===++To avoid starting the translator over and over again:+change ``interact`` in the main function to ``loop``, defined as+follows:+```+loop :: (String -> String) -> IO ()+loop trans = do+ s <- getLine+ if s == "quit" then putStrLn "bye" else do+ putStrLn $ trans s+ loop trans+```+The loop keeps on translating line by line until the input line+is ``quit``.++++#NEW++===A question-answer system===++#Lsecmathprogram++The next application is also a translator, but it adds a+**transfer** component - a function that transforms syntax trees.++The transfer function we use is one that computes a question into an answer.++The program accepts simple questions about arithmetic and answers+"yes" or "no" in the language in which the question was made:+```+ Is 123 prime?+ No.+ 77 est impair ?+ Oui.+```+We change the pure translator by giving+the ``translate`` function the transfer as an extra argument:+```+ translate :: (Tree -> Tree) -> PGF -> String -> String+```+Ordinary translation as a special case where+transfer is the identity function (``id`` in Haskell).++To reply in the //same// language as the question:+```+ translate tr gr = case parseAllLang gr (startCat gr) s of+ (lg,t:_):_ -> linearize gr lg (tr t)+ _ -> "NO PARSE"+```+++#NEW++===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 ;+}+```+++#NEW++===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:+```+ % gf --output-format=haskell Query.pgf+```+It is also possible to produce the Haskell file together with PGF, by+```+ % gf -make --output-format=haskell QueryEng.gf+```+The result is a file named ``Query.hs``, containing a+module named ``Query``.+++#NEW++Output: Haskell definitions+```+module Query where+import PGF++data GAnswer =+ GYes+ | GNo++data GObject = GNumber GInt++data GQuestion =+ GPrime GObject+ | GOdd GObject+ | GEven GObject++newtype GInt = GInt Integer+```+All type and constructor names are prefixed with a ``G`` to prevent clashes.++The Haskell module name is the same as the abstract syntax name.+++#NEW++===The question-answer function===++Haskell's type checker guarantees that the functions are well-typed also with+respect to GF.+```+answer :: GQuestion -> GAnswer+answer p = case p of+ GOdd x -> test odd x+ GEven x -> test even x+ GPrime x -> test prime x++value :: GObject -> Int+value e = case e of+ GNumber (GInt i) -> fromInteger i++test :: (Int -> Bool) -> GObject -> GAnswer+test f x = if f (value x) then GYes else GNo+```+++#NEW++===Converting between Haskell and GF trees===++The generated Haskell module also contains+```+class Gf a where+ gf :: a -> Tree+ fg :: Tree -> a++instance Gf GQuestion where+ gf (GEven x1) = DTr [] (AC (CId "Even")) [gf x1]+ gf (GOdd x1) = DTr [] (AC (CId "Odd")) [gf x1]+ gf (GPrime x1) = DTr [] (AC (CId "Prime")) [gf x1]+ fg t =+ case t of+ DTr [] (AC (CId "Even")) [x1] -> GEven (fg x1)+ DTr [] (AC (CId "Odd")) [x1] -> GOdd (fg x1)+ DTr [] (AC (CId "Prime")) [x1] -> GPrime (fg x1)+ _ -> error ("no Question " ++ show t)+```+For the programmer, it is enough to know:+- all GF names are in Haskell prefixed with ``G``+- ``gf`` translates from Haskell objects to GF trees+- ``fg`` translates from GF trees to Haskell objects++++#NEW++===Putting it all together: the transfer definition===++```+module TransferDef where++import PGF (Tree)+import Query -- generated from GF++transfer :: Tree -> Tree+transfer = gf . answer . fg++answer :: GQuestion -> GAnswer+answer p = case p of+ GOdd x -> test odd x+ GEven x -> test even x+ GPrime x -> test prime x++value :: GObject -> Int+value e = case e of+ GNumber (GInt i) -> fromInteger i++test :: (Int -> Bool) -> GObject -> GAnswer+test f x = if f (value x) then GYes else GNo++prime :: Int -> Bool+prime x = elem x primes where+ primes = sieve [2 .. x]+ sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ]+ sieve [] = []+```+++#NEW++===Putting it all together: the Main module===++Here is the complete code in the Haskell file ``TransferLoop.hs``.+```+module Main where++import PGF+import TransferDef (transfer)++main :: IO ()+main = do+ gr <- readPGF "Query.pgf"+ loop (translate transfer gr)++loop :: (String -> String) -> IO ()+loop trans = do+ s <- getLine+ if s == "quit" then putStrLn "bye" else do+ putStrLn $ trans s+ loop trans++translate :: (Tree -> Tree) -> PGF -> String -> String+translate tr gr s = case parseAllLang gr (startCat gr) s of+ (lg,t:_):_ -> linearize gr lg (tr t)+ _ -> "NO PARSE"+```++++#NEW++===Putting it all together: the Makefile===++To automate the production of the system, we write a ``Makefile`` as follows:+```+all:+ gf -make --output-format=haskell QueryEng+ ghc --make -o ./math TransferLoop.hs+ strip math+```+(The empty segments starting the command lines in a Makefile must be tabs.)+Now we can compile the whole system by just typing+```+ make+```+Then you can run it by typing+```+ ./math+```+Just to summarize, the source of the application consists of the following files:+```+ Makefile -- a makefile+ Math.gf -- abstract syntax+ Math???.gf -- concrete syntaxes+ TransferDef.hs -- definition of question-to-answer function+ TransferLoop.hs -- Haskell Main module+```++#NEW++==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++===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.+```+ % gf -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`` http://grammaticalframework.org:41296],+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 grammar.++++++#NEW++==Language models for speech recognition==++The standard way of using GF in speech recognition is by building+**grammar-based language models**.++GF supports several formats, including+GSL, the formatused in the [Nuance speech recognizer www.nuance.com].++GSL is produced from GF by running ``gf`` with the flag+``--output-format=gsl``.++Example: GSL generated from ``FoodsEng.gf``.+```+ % gf -make --output-format=gsl FoodsEng.gf+ % more FoodsEng.gsl++ ;GSL2.0+ ; Nuance speech recognition grammar for FoodsEng+ ; Generated by GF++ .MAIN Phrase_cat++ Item_1 [("that" Kind_1) ("this" Kind_1)]+ Item_2 [("these" Kind_2) ("those" Kind_2)]+ Item_cat [Item_1 Item_2]+ Kind_1 ["cheese" "fish" "pizza" (Quality_1 Kind_1)+ "wine"]+ Kind_2 ["cheeses" "fish" "pizzas"+ (Quality_1 Kind_2) "wines"]+ Kind_cat [Kind_1 Kind_2]+ Phrase_1 [(Item_1 "is" Quality_1)+ (Item_2 "are" Quality_1)]+ Phrase_cat Phrase_1++ Quality_1 ["boring" "delicious" "expensive"+ "fresh" "italian" ("very" Quality_1) "warm"]+ Quality_cat Quality_1+```+++#NEW++===More speech recognition grammar formats===++Other formats available via the ``--output-format`` flag include:++ || Format | Description ||+ | ``gsl`` | Nuance GSL speech recognition grammar+ | ``jsgf`` | Java Speech Grammar Format (JSGF)+ | ``jsgf_sisr_old`` | JSGF with semantic tags in SISR WD 20030401 format+ | ``srgs_abnf`` | SRGS ABNF format+ | ``srgs_xml`` | SRGS XML format+ | ``srgs_xml_prob`` | SRGS XML format, with weights+ | ``slf`` | finite automaton in the HTK SLF format+ | ``slf_sub`` | finite automaton with sub-automata in HTK SLF++All currently available formats can be seen with ``gf --help``.
binary file changed (absent → 17150 bytes)
binary file changed (absent → 27852 bytes)
binary file changed (absent → 2230 bytes)
@@ -0,0 +1,85 @@+GF character encoding changes+Thomas Hallgren+2013-12-18++==Changes to character encodings in GF grammar files ==++Between the release of GF 3.5 and the next version, two changes were made+relating to character encodings in GF grammar files:+++ The default character encoding was changed from Latin-1+(also known as iso-8859-1, cp1252) to UTF-8.+++ They way you specify alternate character encodings was changed. Instead of+ using a ``flags coding = ...`` declaration in the source file, you should now+ use a pragma ``--# -coding=...`` at the top of the file instead.+++== Advantages ==++UTF-8 is the default encoding for text files on many systems these days, so+it makes sense to use it as the default for GF grammar files too.++Changing how alternate encodings are specified allows conversion to Unicode+to be done before parsing, which means that++- we can allow Unicode characters in identifiers, not just in string literals,+- it makes accurate column positions in error messages possible,+- and (an implementation detail) we can use Alex to generate the lexer again.+++== How are my grammar files affected? ==++If your files still compile without errors after the change, you don't need+to do anything. (But see Known problems below!)+If you get one of the following errors,++- ``lexical error``,+- ``encoding mismatch``,+- ``Warning: default encoding has changed from Latin-1 to UTF-8``+++ you need to add a+``--# -coding=...`` pragma to your file (or convert it to UTF-8).++- For files containing only ASCII characters, no change is needed.+- For files encoded in UTF-8 (and thus using a ``flags coding=utf8``+ declaration), no change is needed.+- For files containing Latin-1 characters (e.g. characters like+ å ä ö ü é), add a ``#-- -coding=latin1`` pragma at the top of the file.+- For files using other encodings, copy the encoding specified in the+ ``flags coding=``//enc// to a corresponding ``--# -coding=``//enc//.+++Grammars will still compile with GF-3.5 after these changes.+++Note that GF only understands one option per pragma line. If you already+have a ``--path=...`` pragma, you can not put the ``-coding=...`` option on+the same line. Add it on a separate line:++```+ --# -path=...+ --# -coding=...+```++The recommendation for the future is to use UTF-8 for all source files.+++== Known problems ==++The intention is that if a grammar file is affected by the changed default+encoding, then you will see one of the messages listed in the previous+section when you compile the grammar. But there are a couple if issues to be+aware of:++- Alex 3.0 seems to be confused about the length of matched strings sometimes.+ This can cause it to skip more than one line when it encounters a one-line+ comment in a grammar file with character encoding problems. So instead of a+ lexical error in the comment, you can get an odd syntax error+ on a subsequent line.++- If you explicitly specify -coding=utf8 for a file that is not in UTF-8, you+ will not get an error, because the UTF-8 decoding function we currently use is+ forgiving, substituting the Unicode replacement character �, instead of+ reporting an error. Hopefully, we will be able to change this.
@@ -0,0 +1,25 @@+#!/bin/sh++prefix="/usr/local"++case "i386-apple-darwin9.3.0" in+ *-cygwin)+ prefix=`cygpath -w "$prefix"`;;+esac++exec_prefix="${prefix}"+GF_BIN_DIR="${exec_prefix}/bin"+GF_DATA_DIR="${prefix}/share/GF-3.0-beta"++GFBIN="$GF_BIN_DIR/gf"++if [ ! -x "${GFBIN}" ]; then+ GFBIN=`which gf`+fi++if [ ! -x "${GFBIN}" ]; then+ echo "gf not found."+ exit 1+fi++exec $GFBIN --batch "$@"
@@ -0,0 +1,72 @@+Grammatical Framework Download and Installation+Version 3.1.6, 23 April 2010+++==Latest developer code==++[GF darcs repository ../doc/darcs.html]++==Latest release==++GF 3.1.6 released 23 April 2010.+- MacOS X installer package:+ [``gf-3.1.6-leopard.pkg`` gf-3.1.6-leopard.pkg] (7.7MB)+- MacOS X (gzipped executable, Leopard and Snow Leopard):+ [``gf-3.1.6-bin-intel-mac.gz`` gf-3.1.6-bin-intel-mac.gz] (1.9MB)+- Windows (zipped executable):+ [``gf-3.1.6-bin-i486-windows.zip`` gf-3.1.6-bin-i486-windows.zip]+ (1.6 MB)+- Ubuntu Linux (gzipped executable):+ [``gf-3.1.6-bin-i486-linux.gz`` gf-3.1.6-bin-i486-linux.gz]+ (1.7 MB)+- compiled library package:+ [``gf-3.1.6-lib.tar.gz`` gf-3.1.6-lib.tar.gz]+ (4.4 MB)+- full source package (GF system, libraries, examples, documentation):+ [``gf-3.1.6-src.tar.gz`` gf-3.1.6-src.tar.gz]+ (11 MB)++GF is also on [Hackage http://hackage.haskell.org/package/gf]+++What's new? See the [release notes release-3.1.6.html].+++==Previous releases==++[Follow this link old-index.html].+++==Installation instructions==+++The Windows package is installed by just unpacking it anywhere.+It finds the libraries relative to the ``.exe`` file.++To install a binary package for MacOS X or Linux: uncompress the executable and+put it somewhere on your path, renaming it to just ``gf``. For instance:+```+ gunzip gf-bin-[version].gz+ sudo mv gf-bin-[version] /usr/local/bin/gf+```+To install the libraries (if done separately), unpack them in the place to which your+``GF_LIB_PATH`` points.+```+ cd $GF_LIB_PATH+ gtar xvfz gf-lib-[VERSION].tgz+```+If this variable hasn't been defined, it is useful define it, e.g.+```+ export GF_LIB_PATH=/usr/local/lib/gf/+```++To compile and install from source on Mac or Linux, do:+```+ tar xvfz gf-[VERSION].tgz+ cd GF/src+ runghc Setup configure --user+ runghc Setup build+ runghc Setup install+```+The last command must be prefixed by ``sudo``, if the installation is outside+user-writeable area.
@@ -0,0 +1,74 @@+Grammatical Framework Download and Installation+++**GF 3.2.9** source-only snapshot was released on 12 September 2011.++What's new? Faster grammar compilation!+++== Binary packages ==+++No binary packages were created for this release.+++==Installing from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so the prodedure is+fairly simple:+++ Install the+ [Haskell Platform 2010.2.0.0 (July 2010) http://hackage.haskell.org/platform]+ or newer.++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution (see below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.2.9.tar.gz`` gf-3.2.9.tar.gz].++=== Notes ===++The above steps installs GF for a single user and does not require root+privileges. The executables are put in ``$HOME/.cabal/bin``, so it is a good+idea to put a line in your ``.bash_profile`` to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```++GF uses ``haskeline``, which depends some non-Haskell libraries that+won't be installed automatically by cabal, so you need to install+them manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc6-terminfo-dev``+- On Fedora: ``sudo yum install ghc-terminfo-devel``+++==Installing from the latest developer code==++The first time:++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++The above notes for installing from source apply also in this case.+++==Older releases==++- [GF 3.2 index-3.2.html] (December 2011).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,102 @@+Grammatical Framework Download and Installation+++**GF 3.2** was released on 23 December 2010.++What's new? See the [Release notes release-3.2.html].+++== Binary packages for the latest release ==+++| **Platform** | **Download** | **How to install**+| Ubuntu (32-bit) | [gf_3.2-4_i386.deb gf_3.2-4_i386.deb] | Double-click on the package icon, or use ``sudo dpkg -i gf_3.2-4_i386.deb``+| Ubuntu (64-bit) | [gf_3.2-4_amd64.deb gf_3.2-4_amd64.deb] | Double-click on the package icon, or use ``sudo dpkg -i gf_3.2-4_amd64.deb``+| Linux (32-bit) | [gf-3.2-bin-i386-linux.tar.gz gf-3.2-bin-i386-linux.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.2-bin-i386-linux.tar.gz``+| Linux (64-bit) | [gf-3.2-bin-x86_64-linux.tar.gz gf-3.2-bin-x86_64-linux.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.2-bin-x86_64-linux.tar.gz``+| MacOS X | [gf-3.2-snowleopard.pkg gf-3.2-snowleopard.pkg] | Double-click on the package icon and follow the instructions+| MacOS X | [gf-3.2-bin-intel-mac.tar.gz gf-3.2-bin-intel-mac.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.2-bin-intel-mac.tar.gz``+| Windows | [gf-3.2-bin-i386-windows.zip gf-3.2-bin-i386-windows.zip] | ``unzip gf-3.2-bin-i386-windows.zip``++More packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+It finds the libraries relative to the ``.exe`` file.++The ``.deb`` packages work on Ubuntu 10.04 and 10.10.++The ``.pkg`` package works on MacOS X 10.6 (Snow Leopard). The MacOS tar+package works on 10.5 (Leopard) and 10.6 (Snow Leopard).++The MacOS and Linux tar packages are designed to be installed in ``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.2/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++GF is on [Hackage http://hackage.haskell.org/package/gf], so the prodedure is+fairly simple:+++ Install the+ [Haskell Platform 2010.2.0.0 (July 2010) http://hackage.haskell.org/platform].++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution (see below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.2.tar.gz`` gf-3.2.tar.gz].++=== Notes ===++The above steps installs GF for a single user and does not require root+privileges. The executables are put in ``$HOME/.cabal/bin``, so it is a good+idea to put a line in your ``.bash_profile`` to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```++GF uses ``haskeline``, which depends some non-Haskell libraries that+won't be installed automatically by cabal, so you need to install+them manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc6-terminfo-dev``+- On Fedora: ``sudo yum install ghc-terminfo-devel``+++==Older releases==++- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).+++==Installing from the latest developer code==++The first time:++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++The above notes for installing from source apply also in this case.
@@ -0,0 +1,123 @@+Grammatical Framework Download and Installation+++**GF 3.3.3** was released on 3 March 2012.++What's new? See the [Release notes release-3.3.3.html].+++== Binary packages ==++| **Platform** | **Download** | **How to install**+| Linux (32-bit) | [gf-3.3.3-bin-i386-linux.tar.gz gf-3.3.3-bin-i386-linux.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.3.3-bin-i386-linux.tar.gz``+| Linux (64-bit) | [gf-3.3.3-bin-amd64-linux.tar.gz gf-3.3.3-bin-amd64-linux.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.3.3-bin-amd64-linux.tar.gz``+| MacOS X | [gf-3.3.3-bin-intel-mac.tar.gz gf-3.3.3-bin-intel-mac.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.3.3-bin-intel-mac.tar.gz``+| Windows | [gf-3.3.3-bin-windows.zip gf-3.3.3-bin-windows.zip] | ``unzip gf-3.3.3-bin-windows.zip``++%More packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+It finds the libraries relative to the ``.exe`` file.++%The ``.deb`` packages work on Ubuntu 10.04 and 10.10.++%The ``.pkg`` package works on MacOS X 10.6 (Snow Leopard).+The MacOS tar package works on 10.5 (Leopard), 10.6 (Snow Leopard) and probably+also 10.7 (Lion).++The MacOS and Linux ``.tar.gz`` packages are designed to be installed in ``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.3.3/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so the prodedure is+fairly simple:+++ Install the [Haskell Platform http://hackage.haskell.org/platform]+ (versions 2010.2.0.0 - 2011.4.0.0 should work) (see notes 2&3 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.3.3.tar.gz`` gf-3.3.3.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc6-terminfo-dev``+- On Fedora: ``sudo yum install ghc-terminfo-devel``+++**Note 2**.+GF (<=3.3.3) does **not** compile with the most recent versions of GHC (>=7.2).+GF does **not** compile with the most recent versions of Alex (>=3.0).++**Note 3**.+[The Haskell Platform for Mac OS X http://hackage.haskell.org/platform/mac.html]+page states that you need Xcode 3.2 or later, but in fact it appears you need+Xcode 3.2.3 or later. If you have Xcode 3.2.2, you can get an error from the+linker: ``ld: unknown option: -no_pie``.++==Installing from the latest developer code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++The above notes for installing from source apply also in this case.+For more info, see the [GF Developers Guide ../doc/gf-developers.html].++==Older releases==++- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,112 @@+Grammatical Framework Download and Installation+++**GF 3.3** was released on 27 October 2011.++What's new? See the [Release notes release-3.3.html].+++== Binary packages ==++| **Platform** | **Download** | **How to install**+| Linux (32-bit) | [gf-3.3-bin-i386-linux.tar.gz gf-3.3-bin-i386-linux.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.3-bin-i386-linux.tar.gz``+| Linux (64-bit) | [gf-3.3-bin-amd64-linux.tar.gz gf-3.3-bin-amd64-linux.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.3-bin-amd64-linux.tar.gz``+| MacOS X | [gf-3.3-bin-intel-mac.tar.gz gf-3.3-bin-intel-mac.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.3-bin-intel-mac.tar.gz``+| Ubuntu 11.10 (32-bit) | [gf_3.3-1_i386-oneiric.deb gf_3.3-1_i386-oneiric.deb] | Double-click on the package icon, or use ``sudo dpkg -i gf_3.3-1_i386-oneiric.deb``+| Ubuntu 11.10 (64-bit) | [gf_3.3-1_amd64-oneiric.deb gf_3.3-1_amd64-oneiric.deb] | Double-click on the package icon, or use ``sudo dpkg -i gf_3.3-1_amd64-oneiric.deb``+| Ubuntu 11.04 (32-bit) | [gf_3.3-1_i386-natty.deb gf_3.3-1_i386-natty.deb] | Double-click on the package icon, or use ``sudo dpkg -i gf_3.3-1_i386-natty.deb``+| Ubuntu 11.04 (64-bit) | [gf_3.3-1_amd64-natty.deb gf_3.3-1_amd64-natty.deb] | Double-click on the package icon, or use ``sudo dpkg -i gf_3.3-1_amd64-natty.deb``+| Windows | [gf-3.3-bin-i386-windows.zip gf-3.3-bin-i386-windows.zip] | ``unzip gf-3.3-bin-i386-windows.zip``++More packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+It finds the libraries relative to the ``.exe`` file.++%The ``.deb`` packages work on Ubuntu 10.04 and 10.10.++%The ``.pkg`` package works on MacOS X 10.6 (Snow Leopard).+The MacOS tar package works on 10.5 (Leopard), 10.6 (Snow Leopard) and probably+also 10.7 (Lion).++The MacOS and Linux ``.tar.gz`` packages are designed to be installed in ``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.3/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so the prodedure is+fairly simple:+++ Install the+ [Haskell Platform 2010.2.0.0 (July 2010) http://hackage.haskell.org/platform]+ or newer.++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution (see below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.3.tar.gz`` gf-3.3.tar.gz].++=== Notes ===++The above steps installs GF for a single user and does not require root+privileges. The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++GF uses ``haskeline``, which depends some non-Haskell libraries that+won't be installed automatically by cabal, so you need to install+them manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc6-terminfo-dev``+- On Fedora: ``sudo yum install ghc-terminfo-devel``+++==Installing from the latest developer code==++The first time:++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++The above notes for installing from source apply also in this case.+++==Older releases==++- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,145 @@+Grammatical Framework Download and Installation+++**GF 3.4** was released on 31 January 2013.++What's new? See the [Release notes release-3.4.html].+++== Binary packages ==++| **Platform** | **Download** | **How to install**+| MacOS X | [gf-3.4-bin-intel-mac.tar.gz gf-3.4-bin-intel-mac.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.4-bin-intel-mac.tar.gz``+| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | ``sudo rpm -i ...``+| Ubuntu (32-bit) | [gf_3.4-1_i386.deb gf_3.4-1_i386.deb] | ``sudo dpkg -i gf_3.4-1_i386.deb``+| Ubuntu (64-bit) | [gf_3.4-1_amd64.deb gf_3.4-1_amd64.deb] | ``sudo dpkg -i gf_3.4-1_amd64.deb``+| Windows | [gf-3.4-bin-windows.zip gf-3.4-bin-windows.zip] | -++===Notes===++%The Windows package is installed by just unpacking it anywhere.+%It finds the libraries relative to the ``.exe`` file.++The ``.deb`` packages work on Ubuntu 12.04, 12.10 and 13.04.++%The ``.pkg`` package works on MacOS X 10.6 (Snow Leopard).+The MacOS tar package works on 10.6 (Leopard), 10.7 (Lion)+and 10.8 (Mountain Lion).++The MacOS and Linux ``.tar.gz`` packages are designed to be installed in ``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.4/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so the prodedure is+fairly simple:+++ Install the [Haskell Platform http://hackage.haskell.org/platform]+ version 2012.4.0.0 (see notes 2&3 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.4.tar.gz`` gf-3.4.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc6-terminfo-dev``+- On Fedora: ``sudo yum install ghc-terminfo-devel``+++**Note 2**.+GF 3.4 does **not** compile with the most recent versions of GHC (>=7.6).+We recommend using GHC 7.4 (which is part of the Haskell Platform 2012.4.0.0).+Older versions of GHC (6.12 and 7.0) still works for the most part.+(For example, there is a issue with error reporting in ``gf -server``+when compiled with GHC 7.0.)+%GF does **not** compile with the most recent versions of Alex (>=3.0).++**Note 3**.+[The Haskell Platform for Mac OS X http://hackage.haskell.org/platform/mac.html]+page states that you need Xcode 3.2 or later, but in fact it appears you need+Xcode 3.2.3 or later. If you have Xcode 3.2.2, you can get an error from the+linker: ``ld: unknown option: -no_pie``.++=== Known problems ===++There seems to be a bug in some versions of Cabal that can cause++```+ Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+```++ if GF is+already installed. If you encounter this, you can use ``ghc-pkg unregister gf``+to remove the installed version of GF and ``ghc-pkg list gf`` to verify that+it is gone.++==Installing from the latest developer code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++Alternatively, you can get the code from the+[GF GitHub https://github.com/GrammaticalFramework/GF/] mirror, which is+updated nightly.++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide ../doc/gf-developers.html].++==Older releases==++- [GF 3.3.3 index-3.3.3.html] (March 2012).+- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,152 @@+Grammatical Framework Download and Installation+++**GF 3.5** was released on 6 August 2013.++What's new? See the [Release notes release-3.5.html].+++== Binary packages ==++| **Platform** | **Download** | **How to install**+| MacOS X | [gf-3.5-bin-intel-mac.tar.gz gf-3.5-bin-intel-mac.tar.gz] | ``sudo tar -C /usr/local -zxf gf-3.5-bin-intel-mac.tar.gz``+%| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | ``sudo rpm -i ...``+| Ubuntu (32-bit) | [gf_3.5-1_i386.deb gf_3.5-1_i386.deb] | ``sudo dpkg -i gf_3.5-1_i386.deb``+| Ubuntu (64-bit) | [gf_3.5-1_amd64.deb gf_3.5-1_amd64.deb] | ``sudo dpkg -i gf_3.5-1_amd64.deb``+| Windows | [gf-3.5-bin-windows.zip gf-3.5-bin-windows.zip] | ``unzip gf-3.5-bin-windows.zip``+%| ... | ... | ...++%More binary packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+%It finds the libraries relative to the ``.exe`` file.+You will probably need to set the ``PATH`` and ``GF_LIB_PATH`` environment+variables, see Inari's notes on+[Installing GF on Windows http://www.grammaticalframework.org/~inari/gf-windows.html#toc3].++The ``.deb`` packages work on Ubuntu 12.04, 12.10 and 13.04.++%The ``.pkg`` package works on MacOS X 10.6 (Snow Leopard).+The MacOS tar package works on 10.6 (Leopard), 10.7 (Lion)+and 10.8 (Mountain Lion).++The MacOS and Linux ``.tar.gz`` packages are designed to be installed in ``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.5/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so the prodedure is+fairly simple:+++ Install the [Haskell Platform http://hackage.haskell.org/platform]+ version 2013.2.0.0 or 2012.4.0.0 (see notes 2&3 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.5.tar.gz`` gf-3.5.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``+- On Fedora: ``sudo yum install ghc-haskeline-devel``+++**Note 2**.+We recommend using GHC 7.6 (which is part of the Haskell Platform 2013.2.0.0)+or GHC 7.4 (which is part of the Haskell Platform 2012.4.0.0).+Older versions of GHC (6.12 and 7.0) probably still work for the most part.+(For example, there is a issue with error reporting in ``gf -server``+when compiled with GHC 7.0.)+%GF does **not** compile with the most recent versions of Alex (>=3.0).++**Note 3**.+[The Haskell Platform for Mac OS X http://hackage.haskell.org/platform/mac.html]+page states that you need Xcode 3.2 or later, but in fact it appears you need+Xcode 3.2.3 or later. If you have Xcode 3.2.2, you can get an error from the+linker: ``ld: unknown option: -no_pie``.++=== Known problems ===++There seems to be a bug in some versions of Cabal that can cause++```+ Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+```++if the same version of GF is+already installed. If you encounter this, you can use ``ghc-pkg unregister gf``+to remove the installed version of GF and ``ghc-pkg list gf`` to verify that+it is gone.++==Installing from the latest developer code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++Alternatively, you can get the code from the+[GF GitHub https://github.com/GrammaticalFramework/GF/] mirror, which is+updated nightly.++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide ../doc/gf-developers.html].++==Older releases==++- [GF 3.4 index-3.4.html] (January 2013).+- [GF 3.3.3 index-3.3.3.html] (March 2012).+- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,172 @@+Grammatical Framework Download and Installation+++**GF 3.6** was released on 23 June 2014.++What's new? See the [Release notes release-3.6.html].+++== Binary packages ==++|| Platform | Download | Features | How to install+| Mac OS X | [gf-3.6.pkg gf-3.6.pkg] | //GF+S+C// | Double-click on the package icon+| Mac OS X | [gf-3.6-bin-intel-mac.tar.gz gf-3.6-bin-intel-mac.tar.gz] | //GF+S+C+P// | ``sudo tar -C /usr/local -zxf gf-3.6-bin-intel-mac.tar.gz``+%| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | //GF+S+C+P// | ``sudo rpm -i ...``+| Ubuntu (32-bit) | [gf_3.6-1_i386.deb gf_3.6-1_i386.deb] | //GF+S+C+P// | ``sudo dpkg -i gf_3.6-1_i386.deb``+| Ubuntu (64-bit) | [gf_3.6-1_amd64.deb gf_3.6-1_amd64.deb] | //GF+S+C+P// | ``sudo dpkg -i gf_3.6-1_amd64.deb``+| Windows | [gf-3.6-bin-windows.zip gf-3.6-bin-windows.zip] | //GF+S// | ``unzip gf-3.6-bin-windows.zip``+| MINGW | [gf-3.6-bin-i686-MINGW32_NT-6.1.tar.gz gf-3.6-bin-i686-MINGW32_NT-6.1.tar.gz] | //GF+S+C// | ``tar -C / gf-3.6-bin-i686-MINGW32_NT-6.1.tar.gz``+%| ... | ... | | ...++Features: GF = GF shell and grammar compiler and the Resource Grammar Library,+S = ``gf -server`` mode, C = C run-time system, P = Python binding to the C run-time system++%More binary packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+%It finds the libraries relative to the ``.exe`` file.+You will probably need to set the ``PATH`` and ``GF_LIB_PATH`` environment+variables, see Inari's notes on+[Installing GF on Windows http://www.grammaticalframework.org/~inari/gf-windows.html#toc3].++The new experimental MINGW package is for use in the+[MINGW http://www.mingw.org] environment in Windows. Unpack it in the MSYS shell+(which is started with ``C:\MinGW\msys\1.0\msys.bat``).+It should work out of the box without any additional settings.++The ``.deb`` packages work on Ubuntu 12.04, 13.10 and 14.04.++The packages for Mac OS work on 10.8 (Mountain Lion) and on 10.9 (Mavericks).++The Mac OS and Linux ``.tar.gz`` packages are designed to be installed in+``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.6/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so under normal+circumstances the prodedure is fairly simple:+++ Install the [Haskell Platform http://hackage.haskell.org/platform]+ version 2013.2.0.0 or 2012.4.0.0 (see notes 2&3 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.6.tar.gz`` gf-3.6.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` or ``.profile``+to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``+- On Fedora: ``sudo yum install ghc-haskeline-devel``+++**Note 2**.+We recommend using GHC 7.6 (which is part of the Haskell Platform 2013.2.0.0)+or GHC 7.4 (which is part of the Haskell Platform 2012.4.0.0).+Using GHC 7.0 will probably still work for the most part+(but there is an issue with error reporting in ``gf -server``+when compiled with GHC 7.0).+Compilation with GHC 6.12 is no longer supported, because of multiple package+version dependency problems.++The GF source code has been updated to be compilable with GHC 7.8,+unlike the [cgi http://hackage.haskell.org/package/cgi] package on Hackage,+which is needed to compile GF with ``gf -server`` mode support.+If you want to compile GF with GHC 7.8 and need ``gf -server`` mode,+there is+[a patched version of the cgi package on github https://github.com/jhenahan/haskell-cgi]+that you can install instead of the version on Hackage.++**Note 3**.+[The Haskell Platform for Mac OS X http://www.haskell.org/platform/mac.html]+page states that you need Xcode 3.2 or later, but in fact it appears you need+Xcode 3.2.3 or later. If you have Xcode 3.2.2, you can get an error from the+linker: ``ld: unknown option: -no_pie``.++=== Known problems ===++There seems to be a bug in some versions of Cabal that can cause++```+ Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+```++if the same version of GF is+already installed. If you encounter this, you can use ``ghc-pkg unregister gf``+to remove the installed version of GF and ``ghc-pkg list gf`` to verify that+it is gone.++==Installing from the latest developer source code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++Alternatively, you can get the code from the+[GF GitHub https://github.com/GrammaticalFramework/GF/] mirror, which is+updated nightly.++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide ../doc/gf-developers.html].++==Older releases==++- [GF 3.5 index-3.5.html] (August 2013)+- [GF 3.4 index-3.4.html] (January 2013).+- [GF 3.3.3 index-3.3.3.html] (March 2012).+- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,176 @@+Grammatical Framework Download and Installation+++**GF 3.7.1** was released on 2 October 2015.++What's new? See the [Release notes release-3.7.1.html].+++== Binary packages ==++|| Platform | Download | Features | How to install+| Mac OS X | [gf-3.7.1.pkg gf-3.7.1.pkg] | //GF+S+C// | Double-click on the package icon (*)+| Mac OS X | [gf-3.7.1-bin-intel-mac.tar.gz gf-3.7.1-bin-intel-mac.tar.gz] | //GF+S+C+P// | ``sudo tar -C /usr/local -zxf gf-3.7.1-bin-intel-mac.tar.gz``+%| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | //GF+S+C+P// | ``sudo rpm -i ...``+| Ubuntu (32-bit) | [gf_3.7.1-1_i386.deb gf_3.7.1-1_i386.deb] | //GF+S+C+P// | ``sudo dpkg -i gf_3.7.1-1_i386.deb``+| Ubuntu (64-bit) | [gf_3.7.1-1_amd64.deb gf_3.7.1-1_amd64.deb] | //GF+S+C+P// | ``sudo dpkg -i gf_3.7.1-1_amd64.deb``+| Windows | [gf-3.7.1-bin-windows.zip gf-3.7.1-bin-windows.zip] | //GF+S// | ``unzip gf-3.7.1-bin-windows.zip``+%| MINGW | [gf-3.7.1-bin-i686-MINGW32_NT-6.1.tar.gz gf-3.7.1-bin-i686-MINGW32_NT-6.1.tar.gz] | //GF+S+C// | ``tar -C / gf-3.7.1-bin-i686-MINGW32_NT-6.1.tar.gz``+%| ... | ... | ... | ...++Features: GF = GF shell and grammar compiler and the Resource Grammar Library,+S = ``gf -server`` mode, C = C run-time system, P = Python binding to the C run-time system++%More binary packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+%It finds the libraries relative to the ``.exe`` file.+You will probably need to set the ``PATH`` and ``GF_LIB_PATH`` environment+variables, see Inari's notes on+[Installing GF on Windows http://www.grammaticalframework.org/~inari/gf-windows.html#toc3].++%The new experimental MINGW package is for use in the+%[MINGW http://www.mingw.org] environment in Windows. Unpack it in the MSYS shell+%(which is started with ``C:\MinGW\msys\1.0\msys.bat``).+%It should work out of the box without any additional settings.++The ``.deb`` packages work on Ubuntu 12.04, 14.04 and 15.04.++The packages for Mac OS X should work on at least 10.9, 10.10 and 10.11 (Mavericks, Yosemite and El Capitan).++(*) **Note** that for compatibility with OS X 10.11,+``gf-3.7.1.pkg`` will install the ``gf`` executable in ``/usr/local/bin``+instead of ``/usr/bin``, so make sure ``/usr/local/bin`` is in your ``$PATH``.+Also, if you still have an older version of GF installed in ``/usr/bin``,+remove it and/or make sure ``/usr/local/bin`` comes before ``/usr/bin``+in your ``$PATH`` so you don't accidentally run the old version.++The Mac OS and Linux ``.tar.gz`` packages are designed to be installed in+``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.7.1/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so under normal+circumstances the prodedure is fairly simple:+++ Install the [Haskell Platform http://hackage.haskell.org/platform]+ version 2013.2.0.0 or 2012.4.0.0 (see note 2 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.7.1.tar.gz`` gf-3.7.1.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` or ``.profile``+to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``+- On Fedora: ``sudo yum install ghc-haskeline-devel``+++**Note 2**.+We recommend using GHC 7.8 (which is part of the Haskell Platform 2014.2.0.0)+or GHC 7.6 (which is part of the Haskell Platform 2013.2.0.0).+Using GHC 7.10.2 or GHC 7.4 (Haskell Platform 2012.4.0.0) should work too.+%Compilation with GHC 6.12 is no longer supported, because of multiple package+%version dependency problems.++%With GHC 70.10.1 we+%have seen cases where GF stops with the message ``gf: <<loop>>`` when running+%with multiple threads (``-j +RTS -N -RTS``), so it's probably better to stick+%with GHC 7.8, at least until GHC 7.10.2 is out.++%**Note 3**.+%[The Haskell Platform for Mac OS X http://www.haskell.org/platform/mac.html]+%page states that on OS X 10.6 you need Xcode 3.2 or later, but in fact it appears you need+%Xcode 3.2.3 or later. If you have Xcode 3.2.2, you can get an error from the+%linker: ``ld: unknown option: -no_pie``.++=== Known problems ===++There seems to be a bug in some versions of Cabal that can cause++```+ Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+```++if the same version of GF is+already installed. If you encounter this, you can use ``ghc-pkg unregister gf``+to remove the installed version of GF and ``ghc-pkg list gf`` to verify that+it is gone.++==Installing from the latest developer source code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++Alternatively, you can get the code from the+[GF GitHub https://github.com/GrammaticalFramework/GF/] mirror, which is+updated nightly.++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide ../doc/gf-developers.html].++==Older releases==++- [GF 3.7 index-3.7.html] (June 2015)+- [GF 3.6 index-3.6.html] (June 2014)+- [GF 3.5 index-3.5.html] (August 2013)+- [GF 3.4 index-3.4.html] (January 2013).+- [GF 3.3.3 index-3.3.3.html] (March 2012).+- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,168 @@+Grammatical Framework Download and Installation+++**GF 3.7** was released on 25 June 2015.++What's new? See the [Release notes release-3.7.html].+++== Binary packages ==++|| Platform | Download | Features | How to install+| Mac OS X | [gf-3.7.pkg gf-3.7.pkg] | //GF+S+C// | Double-click on the package icon+| Mac OS X | [gf-3.7-bin-intel-mac.tar.gz gf-3.7-bin-intel-mac.tar.gz] | //GF+S+C+P// | ``sudo tar -C /usr/local -zxf gf-3.7-bin-intel-mac.tar.gz``+%| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | //GF+S+C+P// | ``sudo rpm -i ...``+| Ubuntu (32-bit) | [gf_3.7-1_i386.deb gf_3.7-1_i386.deb] | //GF+S+C+P// | ``sudo dpkg -i gf_3.7-1_i386.deb``+| Ubuntu (64-bit) | [gf_3.7-1_amd64.deb gf_3.7-1_amd64.deb] | //GF+S+C+P// | ``sudo dpkg -i gf_3.7-1_amd64.deb``+| Windows | [gf-3.7-bin-windows.zip gf-3.7-bin-windows.zip] | //GF// | ``unzip gf-3.7-bin-windows.zip``+%| MINGW | [gf-3.7-bin-i686-MINGW32_NT-6.1.tar.gz gf-3.7-bin-i686-MINGW32_NT-6.1.tar.gz] | //GF+S+C// | ``tar -C / gf-3.7-bin-i686-MINGW32_NT-6.1.tar.gz``+%| ... | ... | ... | ...++Features: GF = GF shell and grammar compiler and the Resource Grammar Library,+S = ``gf -server`` mode, C = C run-time system, P = Python binding to the C run-time system++%More binary packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+%It finds the libraries relative to the ``.exe`` file.+You will probably need to set the ``PATH`` and ``GF_LIB_PATH`` environment+variables, see Inari's notes on+[Installing GF on Windows http://www.grammaticalframework.org/~inari/gf-windows.html#toc3].++%The new experimental MINGW package is for use in the+%[MINGW http://www.mingw.org] environment in Windows. Unpack it in the MSYS shell+%(which is started with ``C:\MinGW\msys\1.0\msys.bat``).+%It should work out of the box without any additional settings.++The ``.deb`` packages work on Ubuntu 12.04, 14.04 and 15.04.++The packages for Mac OS work on 10.9 (Mavericks) and on 10.10 (Yosemite).++The Mac OS and Linux ``.tar.gz`` packages are designed to be installed in+``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.7/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so under normal+circumstances the prodedure is fairly simple:+++ Install the [Haskell Platform http://hackage.haskell.org/platform]+ version 2013.2.0.0 or 2012.4.0.0 (see notes 2&3 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.7.tar.gz`` gf-3.7.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` or ``.profile``+to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``+- On Fedora: ``sudo yum install ghc-haskeline-devel``+++**Note 2**.+We recommend using GHC 7.8 (which is part of the Haskell Platform 2014.2.0.0)+or GHC 7.6 (which is part of the Haskell Platform 2013.2.0.0).+Using GHC 7.4 (Haskell Platform 2012.4.0.0) still works too.+%Compilation with GHC 6.12 is no longer supported, because of multiple package+%version dependency problems.++The GF source code has been updated to be compilable with GHC 7.10.1, but we+have seen cases where GF stops with the message ``gf: <<loop>>`` when running+with multiple threads (``-j +RTS -N -RTS``), so it's probably better to stick+with GHC 7.8, at least until GHC 7.10.2 is out.++**Note 3**.+[The Haskell Platform for Mac OS X http://www.haskell.org/platform/mac.html]+page states that on OS X 10.6 you need Xcode 3.2 or later, but in fact it appears you need+Xcode 3.2.3 or later. If you have Xcode 3.2.2, you can get an error from the+linker: ``ld: unknown option: -no_pie``.++=== Known problems ===++There seems to be a bug in some versions of Cabal that can cause++```+ Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+```++if the same version of GF is+already installed. If you encounter this, you can use ``ghc-pkg unregister gf``+to remove the installed version of GF and ``ghc-pkg list gf`` to verify that+it is gone.++==Installing from the latest developer source code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++Alternatively, you can get the code from the+[GF GitHub https://github.com/GrammaticalFramework/GF/] mirror, which is+updated nightly.++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide ../doc/gf-developers.html].++==Older releases==++- [GF 3.6 index-3.6.html] (June 2014)+- [GF 3.5 index-3.5.html] (August 2013)+- [GF 3.4 index-3.4.html] (January 2013).+- [GF 3.3.3 index-3.3.3.html] (March 2012).+- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,167 @@+Grammatical Framework Download and Installation+++**GF 3.8** was released on 22 June 2016.++What's new? See the [Release notes release-3.8.html].+++== Binary packages ==++|| Platform | Download | Features | How to install+| Mac OS X | [gf-3.8.pkg gf-3.8.pkg] | //GF+S+C+P// | Double-click on the package icon (*)+| Mac OS X | [gf-3.8-bin-intel-mac.tar.gz gf-3.8-bin-intel-mac.tar.gz] | //GF+S+C+P// | ``sudo tar -C /usr/local -zxf gf-3.8-bin-intel-mac.tar.gz``+%| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | //GF+S+C+J+P// | ``sudo rpm -i ...``+| Ubuntu (32-bit) | [gf_3.8-1_i386.deb gf_3.8-1_i386.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.8-1_i386.deb``+| Ubuntu (64-bit) | [gf_3.8-1_amd64.deb gf_3.8-1_amd64.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.8-1_amd64.deb``+| Windows | [gf-3.8-bin-windows.zip gf-3.8-bin-windows.zip] | //GF+S// | ``unzip gf-3.8-bin-windows.zip``+%| MINGW | [gf-3.8-bin-i686-MINGW32_NT-6.1.tar.gz gf-3.8-bin-i686-MINGW32_NT-6.1.tar.gz] | //GF+S+C// | ``tar -C / gf-3.8-bin-i686-MINGW32_NT-6.1.tar.gz``+%| ... | ... | ... | ...++Features: GF = GF shell and grammar compiler and the Resource Grammar Library,+S = ``gf -server`` mode,+C = C run-time system,+J/P = Java/Python binding to the C run-time system++%More binary packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+%It finds the libraries relative to the ``.exe`` file.+You will probably need to set the ``PATH`` and ``GF_LIB_PATH`` environment+variables, see Inari's notes on+[Installing GF on Windows http://www.grammaticalframework.org/~inari/gf-windows.html#toc3].++%The new experimental MINGW package is for use in the+%[MINGW http://www.mingw.org] environment in Windows. Unpack it in the MSYS shell+%(which is started with ``C:\MinGW\msys\1.0\msys.bat``).+%It should work out of the box without any additional settings.++The ``.deb`` packages should work on Ubuntu 12.04, 14.04 and 16.04 and similar+Linux distributions.++The packages for Mac OS X should work on at least 10.9, 10.10 and 10.11 (Mavericks, Yosemite and El Capitan).++(*) **Note** that for compatibility with OS X 10.11,+``gf-3.8.pkg`` will install the ``gf`` executable in ``/usr/local/bin``+instead of ``/usr/bin``, so make sure ``/usr/local/bin`` is in your ``$PATH``.+Also, if you still have an older version of GF installed in ``/usr/bin``,+remove it and/or make sure ``/usr/local/bin`` comes before ``/usr/bin``+in your ``$PATH`` so you don't accidentally run the old version.++The Mac OS and Linux ``.tar.gz`` packages are designed to be installed in+``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.8/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so under normal+circumstances the prodedure is fairly simple:+++ Install a recent version of the+ [Haskell Platform http://hackage.haskell.org/platform],+ e.g. version 7.10.3 (see note 2 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.8.tar.gz`` gf-3.8.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` or ``.profile``+to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``+- On Fedora: ``sudo yum install ghc-haskeline-devel``+++**Note 2**.+The GF source code has been updated to compile with GHC 8.0.1. Using older+versions of GHC (7.10.3, 7.10.2, 7.8, 7.6) should work too.++=== Known problems ===++There seems to be a bug in some versions of Cabal that can cause++```+ Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+```++if the same version of GF is+already installed. If you encounter this, you can use ``ghc-pkg unregister gf``+to remove the installed version of GF and ``ghc-pkg list gf`` to verify that+it is gone.++==Installing from the latest developer source code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ darcs get --lazy http://www.grammaticalframework.org/ GF+ cd GF+ cabal install+```++Subsequently:++```+ cd GF+ darcs pull -a+ cabal install+```++Alternatively, you can get the code from the+[GF GitHub https://github.com/GrammaticalFramework/GF/] mirror, which is+updated nightly.++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide ../doc/gf-developers.html].++==Older releases==++- [GF 3.7.1 index-3.7.1.html] (October 2015)+- [GF 3.7 index-3.7.html] (June 2015)+- [GF 3.6 index-3.6.html] (June 2014)+- [GF 3.5 index-3.5.html] (August 2013)+- [GF 3.4 index-3.4.html] (January 2013).+- [GF 3.3.3 index-3.3.3.html] (March 2012).+- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,192 @@+Grammatical Framework Download and Installation+++**GF 3.9** was released on 11 August 2017.++What's new? See the [Release notes release-3.9.html].+++== Binary packages ==++|| Platform | Download | Features | How to install+| macOS | [gf-3.9.pkg gf-3.9.pkg] | //GF+S+C+J+P// | Double-click on the package icon+| macOS | [gf-3.9-bin-intel-mac.tar.gz gf-3.9-bin-intel-mac.tar.gz] | //GF+S+C+J+P// | ``sudo tar -C /usr/local -zxf gf-3.9-bin-intel-mac.tar.gz``+%| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | //GF+S+C+J+P// | ``sudo rpm -i ...``+| Raspbian 9.1 | [gf_3.9-1_armhf.deb gf_3.9-1_armhf.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.9-1_armhf.deb``+| Ubuntu (32-bit) | [gf_3.9-1_i386.deb gf_3.9-1_i386.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.9-1_i386.deb``+| Ubuntu (64-bit) | [gf_3.9-1_amd64.deb gf_3.9-1_amd64.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.9-1_amd64.deb``+| Windows | [gf-3.9-bin-windows.zip gf-3.9-bin-windows.zip] | //GF+S// | ``unzip gf-3.9-bin-windows.zip``++%| MINGW | [gf-3.9-bin-i686-MINGW32_NT-6.1.tar.gz gf-3.9-bin-i686-MINGW32_NT-6.1.tar.gz] | //GF+S+C// | ``tar -C / gf-3.9-bin-i686-MINGW32_NT-6.1.tar.gz``+%| ... | ... | ... | ...++Features: GF = GF shell and grammar compiler and the Resource Grammar Library,+S = ``gf -server`` mode,+C = C run-time system,+J/P = Java/Python binding to the C run-time system++%More binary packages might be added later.++===Notes===++The Windows package is installed by just unpacking it anywhere.+%It finds the libraries relative to the ``.exe`` file.+You will probably need to set the ``PATH`` and ``GF_LIB_PATH`` environment+variables, see Inari's notes on+[Installing GF on Windows http://www.grammaticalframework.org/~inari/gf-windows.html#toc3].++%The new experimental MINGW package is for use in the+%[MINGW http://www.mingw.org] environment in Windows. Unpack it in the MSYS shell+%(which is started with ``C:\MinGW\msys\1.0\msys.bat``).+%It should work out of the box without any additional settings.++The Ubuntu ``.deb`` packages should work on Ubuntu 16.04 and 17.04 and similar+Linux distributions.++The Raspian ``.deb`` package was created on a Raspberry Pi 3 and will probably+work on other ARM-based systems running Debian 9 (stretch) or similar+Linux distributions.++The packages for macOS (Mac OS X) should work on at+least 10.11 and 10.12 (El Capitan and Sierra).++%(*) **Note** that for compatibility with OS X 10.11 and newer,+%``gf-3.9.pkg`` will install the ``gf`` executable in ``/usr/local/bin``+%instead of ``/usr/bin``, so make sure ``/usr/local/bin`` is in your ``$PATH``.+%Also, if you still have an older version of GF installed in ``/usr/bin``,+%remove it and/or make sure ``/usr/local/bin`` comes before ``/usr/bin``+%in your ``$PATH`` so you don't accidentally run the old version.++The Mac OS and Linux ``.tar.gz`` packages are designed to be installed in+``/usr/local``.+You can install them in other locations, but then you need to set the+``GF_LIB_PATH`` environment variable:++```+ export GF_LIB_PATH=/usr/local/share/gf-3.9/lib+```++where ``/usr/local`` should be replaced with the path to the location where you+unpacked the package.+++==Installing the latest release from source==++[GF is on Hackage http://hackage.haskell.org/package/gf], so under normal+circumstances the prodedure is fairly simple:+++ Install a recent version of the+ [Haskell Platform http://hackage.haskell.org/platform],+ e.g. version 7.10.3 (see note 2 below)++ ``cabal update``++ On Linux: install some C libraries from your Linux distribution+ (see note 1 below)++ ``cabal install gf``+++You can also download the full source package from here:+[``gf-3.9.tar.gz`` gf-3.9.tar.gz].++=== Notes ===++The above steps installs GF for a single user.+% and does not require root privileges.+The executables are put in ``$HOME/.cabal/bin``+(or, with recent versions of the Haskell platform on Mac OS X,+in ``$HOME/Library/Haskell/bin``), so it is a good+idea to put a line in your ``.bash_profile`` or ``.profile``+to add that directory to you path:++```+ PATH=$HOME/.cabal/bin:$PATH+```+or+```+ PATH=$HOME/Library/Haskell/bin:$PATH+```++**Note 1**.+GF uses [``haskeline`` http://hackage.haskell.org/package/haskeline], which+on Linux depends on some non-Haskell libraries that+won't be installed automatically by cabal, and therefore need to be installed+manually. Here is one way to do this:++- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``+- On Fedora: ``sudo yum install ghc-haskeline-devel``+++**Note 2**.+The GF source code has been updated to compile with GHC 8.2.1. Using older+versions of GHC (e.g. 8.0.x and 7.10.3) should still work too.++%=== Known problems ===+%+%There seems to be a bug in some versions of Cabal that can cause+%+%```+% Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed+%```+%+%if the same version of GF is+%already installed. If you encounter this, you can use ``ghc-pkg unregister gf``+%to remove the installed version of GF and ``ghc-pkg list gf`` to verify that+%it is gone.++==Installing from the latest developer source code==++The first time:+%, assuming you already have the Haskell Platform and darcs++```+ git clone https://github.com/GrammaticalFramework/gf-core.git+ cd gf-core+ cabal install+```++and++```+ git clone https://github.com/GrammaticalFramework/gf-rgl.git+ cd gf-rgl+ make+```++Subsequently:++```+ cd gf-core+ git pull+ cabal install+```++and++```+ cd gf-rgl+ git pull+ make+```++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide ../doc/gf-developers.html].++==Using Stack==++You can also use [Stack https://www.haskellstack.org] to compile GF, just replace ``cabal install`` above+with ``stack install`` (assuming you already have Stack set up).++==Older releases==++- [GF 3.8 index-3.8.html] (June 2016)+- [GF 3.7.1 index-3.7.1.html] (October 2015)+- [GF 3.7 index-3.7.html] (June 2015)+- [GF 3.6 index-3.6.html] (June 2014)+- [GF 3.5 index-3.5.html] (August 2013)+- [GF 3.4 index-3.4.html] (January 2013).+- [GF 3.3.3 index-3.3.3.html] (March 2012).+- [GF 3.3 index-3.3.html] (October 2011).+- [GF 3.2.9 index-3.2.9.html] source-only snapshot (September 2011).+- [GF 3.2 index-3.2.html] (December 2010).+- [GF 3.1.6 index-3.1.6.html] (April 2010).+- [GF 3.1 old-index.html] (December 2009).
@@ -0,0 +1,184 @@+---+title: Grammatical Framework Download and Installation+...++**GF 3.10** was released on 2 December 2018.+It is the first version of GF which _does not include the RGL_.++What's new? See the [release notes](release-3.10.html).++## Binary packages++| Platform | Download | Features | How to install |+|:----------------|:---------------------------------------------------|:---------------|:-----------------------------------|+| macOS | [gf-3.10.pkg](gf-3.10.pkg) | GF, S, C, J, P | Double-click on the package icon |+| Ubuntu (64-bit) | [gf\_3.10-1\_amd64.deb](gf_3.10-1_amd64.deb) | GF, S, C, J, P | `sudo dpkg -i gf_3.10-1_amd64.deb` |+| Windows | [gf-3.10-bin-windows.zip](gf-3.10-bin-windows.zip) | GF, S | `unzip gf-3.10-bin-windows.zip` |++<!--+| macOS | [gf-3.10-bin-intel-mac.tar.gz](gf-3.10-bin-intel-mac.tar.gz) | GF,S,C,J,P | `sudo tar -C /usr/local -zxf gf-3.10-bin-intel-mac.tar.gz` |+| Raspbian 9.1 | [gf\_3.10-1\_armhf.deb](gf_3.10-1_armhf.deb) | GF,S,C,J,P | `sudo dpkg -i gf_3.10-1_armhf.deb` |+| Ubuntu (32-bit) | [gf\_3.10-1\_i386.deb](gf_3.10-1_i386.deb) | GF,S,C,J,P | `sudo dpkg -i gf_3.10-1_i386.deb` |+-->++**Features**++- GF = GF shell and grammar compiler+- S = `gf -server` mode+- C = C run-time system+- J/P = Java/Python binding to the C run-time system++### Notes++The Windows package is installed by just unpacking it anywhere. You will+probably need to set the `PATH` and `GF_LIB_PATH` environment variables,+see Inari's notes on [Installing GF on Windows](http://www.grammaticalframework.org/~inari/gf-windows.html#toc3).++The Ubuntu `.deb` packages should work on Ubuntu 16.04 and 18.04 and+similar Linux distributions.++<!-- The Raspbian `.deb` package was created on a Raspberry Pi 3 and will+probably work on other ARM-based systems running Debian 9 (stretch) or+similar Linux distributions. -->++The packages for macOS (Mac OS X) should work on at least 10.13 and+10.14 (High Sierra and Mojave)++<!-- The Mac OS and Linux `.tar.gz` packages are designed to be installed in+`/usr/local`. You can install them in other locations, but then you need+to set the `GF_LIB_PATH` environment variable:++```+export GF_LIB_PATH=/usr/local/share/gf-3.10/lib+```++where `/usr/local` should be replaced with the path to the location+where you unpacked the package. -->++## Installing the latest release from source++[GF is on Hackage](http://hackage.haskell.org/package/gf), so under+normal circumstances the procedure is fairly simple:++1. Install a recent version of the [Haskell+ Platform](http://hackage.haskell.org/platform) (see note below)+2. `cabal update`+3. On Linux: install some C libraries from your Linux distribution (see note below)+4. `cabal install gf`++Note that this installs GF _without_ the RGL.++You can also download full source packages from GitHub at the following links:++- [GF releases](https://github.com/GrammaticalFramework/gf-core/releases)+- [RGL releases](https://github.com/GrammaticalFramework/gf-rgl/releases)++### Notes++**Installation location**++The above steps installs GF for a single user. The executables are put+in `$HOME/.cabal/bin` (or, with recent versions of the Haskell platform+on Mac OS X, in `$HOME/Library/Haskell/bin`), so it is a good idea to+put a line in your `.bash_profile` or `.profile` to add that directory+to you path:++```+PATH=$HOME/.cabal/bin:$PATH+```++or++```+PATH=$HOME/Library/Haskell/bin:$PATH+```++**Build tools**++In order to compile GF you need the build tools **Alex** and **Happy**.+These can be installed via Cabal, e.g.:++```+cabal install alex happy+```++or obtained by other means, depending on your OS.++**Haskeline**++GF uses [`haskeline`](http://hackage.haskell.org/package/haskeline), which+on Linux depends on some non-Haskell libraries that won't be installed+automatically by cabal, and therefore need to be installed manually.+Here is one way to do this:++- On Ubuntu: `sudo apt-get install libghc-haskeline-dev`+- On Fedora: `sudo yum install ghc-haskeline-devel`++**GHC version**++The GF source code has been updated to compile with GHC 8.4.+Using older versions of GHC (e.g. 8.2, 8.0 and 7.10) should still work too.++## Installing from the latest developer source code++If you haven't already, clone the repository with:++```+git clone https://github.com/GrammaticalFramework/gf-core.git+```++If you've already cloned the repository previously, update with:++```+git pull+```++Then install with:++```+cabal install+```++or, if you're a Stack user:++```+stack install+```++The above notes for installing from source apply also in these cases.+For more info on working with the GF source code, see the+[GF Developers Guide](../doc/gf-developers.html).++## Installing the RGL from source++To install the RGL from source,+you can download a release from [GitHub](https://github.com/GrammaticalFramework/gf-rgl/releases)+or get the latest version by cloning the repository:++```+git clone https://github.com/GrammaticalFramework/gf-rgl.git+```++In both cases, once you have the RGL sources you can install them by running:++```+make+```++in the RGL folder.+For more details about building the RGL, see the [RGL README](https://github.com/GrammaticalFramework/gf-rgl/blob/master/README.md).++## Older releases++- [GF 3.9](index-3.9.html) (August 2017)+- [GF 3.8](index-3.8.html) (June 2016)+- [GF 3.7.1](index-3.7.1.html) (October 2015)+- [GF 3.7](index-3.7.html) (June 2015)+- [GF 3.6](index-3.6.html) (June 2014)+- [GF 3.5](index-3.5.html) (August 2013)+- [GF 3.4](index-3.4.html) (January 2013)+- [GF 3.3.3](index-3.3.3.html) (March 2012)+- [GF 3.3](index-3.3.html) (October 2011)+- [GF 3.2.9](index-3.2.9.html) source-only snapshot (September 2011)+- [GF 3.2](index-3.2.html) (December 2010)+- [GF 3.1.6](index-3.1.6.html) (April 2010)
@@ -0,0 +1,59 @@+GF Version 3.1.6 Release Notes+23 April 2010+++=Installation=++The binaries now work out of the box for each platform and support+completions (file names and parsing), because readline has been+changed to haskeline.++To compile from source, GHC 6.12 is now required. But GHC is not needed+if the binary executables are used.++Binaries (``.gfo`` and ``.pgf`` files) compiled with GF 3.1 are incompatible+with 3.1.6 and must either be removed; alternatively, the ``-src`` flag can be+used when compiling.++Notice the new place to send bug reports (see GF's welcome message)!+++=New features=++Grammar language+- improved support for dependent types (see ``SUMO``, ``nqueens`` in ``examples``)+++Shell commands and options (see ``help`` in GF for more information)+- ``eb``: example-based grammar file conversion+ (see ``examples/animals/QuestionI.gf``)+- ``vd = visualize_dependency``: show dependency tree+- ``vp = visualize_parse``: show parse tree+- ``gr, gt, mq, tq``: use a seed tree with metavariables+- ``gr, p, tq``: use ``-probs=FILE`` to bias or rank generated trees+- ``gt`` now tries the different alternatives in the order in which they appear in the source code+- ``dg``: hide modules when printing dependency graph+- -output-format=lambda_prolog let us to use Lambda Prolog for exhaustive generation with dependent types+++Libraries+- Urdu completed (Shafqat Virk)+- Turkish morphology + Zamberek's dictionary in GF (Server Cimen)+++Examples+- SUMO+- phrasebook+- nqueens+++Internal+- single PMCFG format for both linearization and parsing+- use of Haskeline for completion - more portable than Readline+- unicode support from Haskell 6.12 instead of home-made coding+++==Issues==++Javascript generation is not updated to the new PGF format.+[GF 3.1 old-index.html] should still be used for building Javascript applications.
@@ -0,0 +1,16 @@+---+title: GF 3.10 Release Notes+date: 2 December 2018+...++## Installation++See the [download page](index.html).++## What's new++- In this release, the GF "core" (compiler and runtimes) have been split from the RGL.++### Other++- A lot of repository cleanup
@@ -0,0 +1,33 @@+GF Version 3.2 Release Notes+December 2010++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==New features==++- Faster parsing.+- Faster handling of grammars with big lexicons.+- Dependent types.+- Exhaustive random generation with dependent types.+- [Bracketed strings data structure http://code.google.com/p/grammatical-framework/wiki/BracketingAPI].+%- example based+- Probabilities in PGF files.+%- giza alignments+%- language quiz+- The Resource Grammar Library now supports 16 languages and has an+ [updated synopsis ../lib/doc/synopsis.html].+- The darcs repo is now available from ``www.grammaticalframework.org`` and+ should be a lot faster than ``code.haskell.org``.+- Build of the web services is simplified and an instantly usable demo is+ included in the binary distribution+ (see [Quickstart ../doc/gf-quickstart.html]).+- Clarified license scheme.+- ...+++===Licenses===++- GF compiler: GPL+- Run-time libraries and Resource Grammar Library: LGPL + BSD
@@ -0,0 +1,23 @@+GF Version 3.3.3 Release Notes+March 2012++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==New features==++- New option ``gf -tags`` generates tags files for use with the+ [GF Eclipse plugin http://www.grammaticalframework.org/eclipse/].+- New languages in the Resource Grammar Library: Latvian, Thai, Hindi, Sindhi+ (see the [updated synopsis ../lib/doc/synopsis.html]). Improvements for other+ languages, e.g. Russian and Swedish.+- Improved separate compilation makes recompiling large grammars faster.+ The flag ``-no-pmcfg`` reverts to the old behaviour.+- Version numbers in ``.gfo`` files to avoid problems caused by reuse of+ ``.gfo`` files produced with an incompatible version of the compiler.+- The web-based grammar editor now supports grammar extension and text mode+ editing with instant syntax checking.+- Fix for a bug that prevented the shell commands ``abstract_info``,+ ``generate_random`` and ``generate_trees`` from working properly.+- Various other small improvements and bug fixes.
@@ -0,0 +1,27 @@+GF Version 3.3 Release Notes+October 2011++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==New features==++- Source language extension: it is now possible to override the oper definitions in an interface, by using the+ header syntax ``instance Foo of Bar - [f,g,h]``.+- New functionalities in GF shell commands (more information with ``help`` command-name).+ - ``aw`` = ``align_words`` option ``-giza`` prints word alignments in Giza++ format.+ - ``i`` = ``import`` now recognizes changes in abstract syntax without the need of ``empty``.+ - ``pg`` = ``print_grammar`` option ``-lexc`` prints lexicon in Xerox LEXC format.+ - ``ps`` = ``put_string`` now has flags for reading transliteration rules from a user-provided file.+ - ``r`` = ``reload`` repeats the latest instance of ``import``.+ - ``sd`` = ``show_dependencies`` shows all dependencies of a constant, and optionally their code sizes.+ - ``so`` = ``show_operations`` shows the oper's in scope, optionally restricted to a value type.+ - ``ss`` = ``show_source`` shows source code, or optionally just function headers or source code sizes.+++- Haskell output as Generalized Algebraic Datatypes: ``gf -make -output-format=haskell --haskell=gadt``+- ``gf -server`` replaces ``pgf-http`` and makes it easy to test the minibar+ and the web-based grammar editor.+- Faster grammar compilation (also included in the GF 3.2.9 source-only+ snapshot).
@@ -0,0 +1,44 @@+GF Version 3.4 Release Notes+January 2013++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==What's new==++===GF compiler and run-time library===++- A new partial evaluator that should provide more efficient grammar+ complilation, and solve problems with stack overflows and overly long+ compilaton times for certain grammars.+- New options for visualization of parse trees with the+ shell command [``visualize_parse`` ../doc/gf-shell-reference.html#toc39].+- ``alltenses`` is now part of the default search path, eliminating the need for+ ``-path=…`` flags in many cases.+- Various other small improvements and bug fixes.+%- [...]+++===Resource Grammar Library===++- New languages in the Resource Grammar Library: Japanese, Chinese (complete);+ Maltese, Hebrew (partial).+% [more?]+ (see the [updated synopsis ../lib/doc/synopsis.html]).+- Improvements for other languages, e.g. Latvian.+% [more?]+- Large morphological dictionaries for German, Urdu.+% [more?]+- Updated web-based RGL browser ([/lib/doc/browse/ ../lib/doc/browse/]).+++===GF Cloud services===++- A [Simple Translation Tool http://cloud.grammaticalframework.org/translator/about.html]+ (a bilingual document editor) has been added.+- A [syntax tree editor http://cloud.grammaticalframework.org/syntax-editor/about.html]+ has been added.+- Some new functionality in the web-based grammar editor, e.g. preliminary+ support for public grammars.+- Various other small improvements and bug fixes.
@@ -0,0 +1,68 @@+GF 3.5 Release Notes+August 2013++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==What's new==++Over 400 changes have been pushed to the source repository since the release+of GF 3.4.+++===GF compiler and run-time library===++- The Haskell source code for GF now compiles with GHC 7.6 and hence the+ the latest [Haskell Platform http://www.haskell.org/platform/] (2013.2.0.0).+ Compatibility with GHC 7.4 is also maintained.+- ``gf -s/-q`` now silences ``no linearization of ...`` warnings.+- Faster regular expression pattern matching in the grammar compiler.+- Two bugs in the partial evaluator that caused problems with pattern macros+ and variants have been fixed.+- A portability problem with PGF files has been fixed. It could cause problems+ when PGF files were produced on a 32-bit system and used on a 64-bit system.+++- The new runtime in C (in [/src/runtime/c/ ../src/runtime/c/])+ is now stable enough to be used although there+ are still features from the Haskell runtime which are not ported yet.+ The new runtime provides the following new features:+ - state of the art statistical parser for GF (PMCFG)+ - the parser is usable in a robust mode, i.e. even if the+ sentence is not in the scope of the grammar it is still possible+ to get a list of parsable chunks+ - the linearizer is also more robust than the one in Haskell since+ it can linearize the partial trees returned from the robust parser+ - the exhaustive generation for GF abstract trees generates the trees+ in decreasing probability order (the order in Haskell is unspecified).+ - we have started using just-in-time compilation to native code in+ the exhaustive generator. The goal is to reach the state where+ GF will provide state of the art theorem prover.+- There is a binding from Python to the C runtime in [/src/runtime/python/ ../src/runtime/python/].+- A volunteer to complete the binding from Java is highly wanted,+ [/src/runtime/java/ ../src/runtime/java/].+++===Resource Grammar Library===++- New languages in the Resource Grammar Library: Greek, Maltese+ (see the [updated synopsis ../lib/doc/synopsis.html]).+- Various improvements for several other languages.+%, e.g. [...]+- Updated web-based RGL browser ([/lib/doc/browse/ ../lib/doc/browse/]),+ with search-by-type and inbuilt syntax tree builder.+++===GF Cloud services===++- Word alignment diagrams can now be restricted to a subset+ of the languages supported by the grammar.+- Minibar: you can now click on a linearization to obtain a table with all+ variants and forms.+- Support for [cross-site HTTP requests https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS].+- A UTF-8 decoding problem in ``gf -server`` has been fixed.+ It was caused by a backward incompatible change in+ [``network-2.4.1.1`` https://github.com/haskell/network/commit/f2168b1f8978b4ad9c504e545755f0795ac869ce].+- Various other small improvements and bug fixes.+%- [...]
@@ -0,0 +1,105 @@+GF 3.6 Release Notes+June 2014++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==What's new==++Over 1300 changes have been pushed to the source repository since the release+of GF 3.5 in August 2013.++Closed [issues http://code.google.com/p/grammatical-framework/issues/list]:+ 25, 30, 41, 57, 60, 61, 68, 80, 81, 82.++===GF compiler and run-time library===++====New features and notable changes====++- The default character encoding in grammar files has been changed from+ Latin-1 to UTF-8. Also, alternate character encodings should now be specified+ as ``--# -coding=``//enc//, instead of ``flags coding=``//enc//.+ See the separate document+ [GF character encoding changes encoding-change.html] for more details.+- Record update: in record objects (but not types) of form ``r ** s``, the values assigned+ in ``s`` now overwrite those in ``r``. In previous versions, record extensions with+ overlapping assignments in ``r`` and ``s`` were not supported, and their behaviour was+ unpredictable.+- The PGF file format has changed in minor but backward incompatible ways.+ GF can still read the old format, thanks to a backward compatibility+ module. The C run-time system supports only the new format. Old PGF files+ can be converted to the new format by loading them in the GF shell and+ writing out a new PGF file with the ``pg -pgf`` command.+- The PGF run-time Haskell library includes some new modules, e.g.+ ``PGF.Lexing`` which contains lexing and unlexing functions, and+ ``PGF2``, which is a binding to the C run-time system. The latter is included+ only if GF is configured with ``-fc-runtime``, which is not the default,+ since the C run-time system still has to be compiled and installed+ separately before installing GF. The binary packages for GF 3.6 available+ from the download page will include C run-time support.+- ``nonExist`` now exists. It can be used in concrete syntax to mark+ non-existing morphological forms.+- Token gluing: ``BIND`` and ``SOFT_BIND`` can be used in concrete syntax to+ mark that the surrounding tokens should not be separated by space.+% - Unicode characters in identifiers [...] (not documented, not tested)+++====Bug fixes and minor changes====++- Nonlinear patterns (i.e., patterns where the same variable appears more than+ once) in concrete syntax are now detected and reported as errors.+ (Section C.4.13 in the GF book states that patterns must be+ linear.)+- A pattern matching bug which prevented variables in patterns to be bound to+ table values has been fixed.+- A bug with local variable name shadowing has been fixed.+- Type checking fixes: correction of+ subtyping check for ``Ints n<=Ints m`` and contravariance in table types.+- The refresh pass+% (and thus the command line option --dump-refresh)+ had become obsolete and has been removed.+- The old partial evaluator+ (and thus the command line options ``--new-comp`` and ``--old-comp``)+ has been removed.+- A missing rewrite rule has been added to the partial evaluator. It+ can significantly reduce the compilation time for certain grammars.+- Some additional datestamp checks have been added to ``gf -make`` to avoid+ recreating a PGF file when an uptodate PGF file already exists.+- The ``--output-dir`` option now applies also to PGF files.+++===Resource Grammar Library===++- New languages in the Resource Grammar Library: Estonian+ (see the [updated synopsis ../lib/doc/synopsis.html]).+- Grammars and dictionaries for wide coverage translation+ ([source ../lib/src/translator/]).+- Bug fixes and some new inflection paradigms in many languages.+% - [...]+++===GF Cloud services===++- There is a preliminary new [Wide Coverage Translation Demo http://cloud.grammaticalframework.org/wc.html] web app. The same wide coverage translation+ method has also been added to the+ [Simple Translation Tool http://cloud.grammaticalframework.org/translator/].+- PGF web service API:+ - the ``lookupmorpho`` request has been added to lookup the morphological+ analysis of a word.+ - Requests like ``parse`` and ``translate`` that parse text input now+ accept a ``lexer`` parameter to apply a lexer to the input text before+ parsing. The lexer can be ``text``, ``code`` or ``mixed``.+ - Requests like ``linearize`` and ``translate`` that produce+ linearizations now accept an ``unlexer`` parameter to apply an unlexer to the+ linearizations. The unlexer can be ``text``, ``code`` or ``mixed``.+ - Preliminary new requests to access the C run-time system have been added:+ - ``c-parse``, ``c-linearize``, ``c-translate``, ``c-lookupmorpho``,+ ``c-grammar``. These work in the same way as the corresponding requests+ without the ``c-`` prefix. Since the ``c-parse`` and ``c-translate`` can+ produce very many (even infinitely many) results when used with large+ ambiguous grammars, using the ``limit`` parameter to restrict number of+ results, e.g. ``limit=10``, is recommended.+ - ``c-wordforword``: this works as ``c-translate`` but does a+ word-for-word lookup to create a (potentially very low quality)+ translation that can be used if all else fails.
@@ -0,0 +1,75 @@+GF 3.7.1 Release Notes+October 2015++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==What's new==++Over 170 changes have been pushed to the source repository since+[the release of GF 3.7 release-3.7.html] in June 2015.++===GF compiler and run-time library===++====New features and notable changes====++- GF shell: ``cc -trace`` (preliminary): you can now do things like++ ``cc -trace mkV "debug"``++ to see a trace of all opers with their arguments and results during the+ computation of ``mkV "debug"``.++- GF shell: you can now parse and linearize with the C run-time system+ from the GF shell by starting GF with ``gf -cshell`` or ``gf -crun``.+ Only limited functionality is available when running the shell in these+ modes (use the ``help`` command in the shell for details):++ - You can only import ``.pgf`` files, not source files.+ - The ``-retain`` flag can not be used and the commands that require it to+ work are not available.++- GF now supports parallel batch compilation of grammars.++ - ``gf -make -j=``//n// uses //n// parallel threads.+ - ``gf -make -j`` adapts to the number of processors in the system.++ (This depends on the function ``Control.Concurrent.setNumCapabilities``,+ which is only available in GHC>=7.6 (base>=4.6).+ GF can still be compiled with GHC<7.6, but then you have+ to use ``+RTS -N -RTS`` to take advantage of multicore processors.)++- GF shell: more commands (``cc``, ``sd``, ``so``, ``ss``, ``dg``, ``ph``)+ can now be used in pipes and+ the ``eh`` (``execute_history``) command now works again.+++====Other changes and bug fixes====++- Various improvements and bug fixes in the C run-time system and its+ bindings to other languages.+++====Changes of interest to compiler developers====++- The implementation of the GF shell has been refactored, both to accommodate+ the C run-time mode (``gf -cshell``), to allow a more uniform treatment+ of different types of commands, and to fix some commands that have been+ broken for years.+++===Resource Grammar Library===++- Various fixes for several languages.+- Numerous fixes in the translation dictionaries.+++===GF Cloud services===++- PGF service: by adding ``unlexer=none`` (or ``unlexer=id``)+ in requests that output linearizations+ (e.g. ``command=linearize``, ``command=translate``),+ you can leave ``&+`` uninterpreted instead of gluing the adjacent tokens.+ This means that the output is left in a format that can be parsed in+ a subsequent request.
@@ -0,0 +1,101 @@+GF 3.7 Release Notes+June 2015++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].++==What's new==++Over 800 changes have been pushed to the source repository since+[the release of GF 3.6 release-3.6.html] in June 2014.++===GF compiler and run-time library===++====New features and notable changes====++- GF shell: the commands available in the shell after importing with the+ ``-retain`` flag are now a superset of the commands available after+ importing without ``-retain``.+ (Previously commands that require compilation all the way to PMCFG were+ not available when the ``-retain`` flag was used.)+- The command line flag ``-s``/``-q`` now silences all warnings.+- GF now supports parallel batch compilation of grammars.+ This is activated with the ``-j``+ flag. (For the time being, you also need to pass ``+RTS -N -RTS`` to enable+ parallelism in the GHC run-time system.)+- Concrete syntax can now be translated to Haskell. The flag+ ``-output-format=haskell`` translates abstract syntax to Haskell as before.+ By also adding ``-haskell=concrete`` you get a Haskell module for each+ concrete syntax of the grammar. These contain translations of+ linearization types and linearization functions.+ By adding ``-haskell=variants`` you get linearization functions that output+ all variants.+ (You don't get any functions for parsing.)+- Now there is full support for all orthographic primitives:+ ``BIND``, ``SOFT_BIND``, ``SOFT_SPACE``, ``CAPIT``, ``ALL_CAPIT`` and+ ``nonExist``.+- It is now possible to define callbacks for literals from the Haskell+ binding to the C runtime. This is used for instance in+ the Wide Coverage translator on the Web.+++====Other changes and bug fixes====++- GF now uses colors to highlight errors and warnings (except on Windows).+- Even though GF works with absolute paths internally, GF now shows paths+ relative to the current directory in diagnostic output.+- GF Shell and ``gf -server``: improved responsiveness when large grammars are+ loaded (by increasing the GHC RTS idle timeout before full GC from the+ default 0.3s to 5s).+- Numerous fixes in the translation dictionaries.+- C-run-time system: Bug fixes in the Java and Python bindings.+- C-run-time system: the parser is now fully Unicode compatible.+- Because of the new orthographic primitives, the version numbers in+ ``.pgf`` and ``.gfo`` files have been bumped. PGF files+ produced with this version of GF can not be used with older versions of GF.+ If you get an error message saying ``.gfo file version mismatch``, remove+ old ``.gfo`` files.+++====Changes of interest to compiler developers====++- The compiler is now available as a Haskell library. The module ``GF``+ serves as a preliminary compiler API. It exports a selection of+ types and functions from the compiler.+- Some Haddock documentation improvements to document the compiler API.+- Various refactoring for readability, modularity and efficiency. Removal of+ some dead code.+++===Resource Grammar Library===++- New languages in the Resource Grammar Library: Mongolian+ (see the [updated synopsis ../lib/doc/synopsis.html]).+++===GF Cloud services===++- Minibar and Wide Coverage Translation Demo: speech output is now available+ (in browsers that support it).+- The Wide Coverage Translation Demo can now draw syntax trees and show+ inflection tables. There are also lots of improvements in the+ translation grammar and dictionaries.+- PGF service: add commands ``c-abstrtree`` and ``c-parsetree``.+ These are the C runtime variants of the ``absttree`` and ``parsetree``+ commands. They work in the same way, but support fewer rendering options.+- PGF service:+ The ``parse``/``translate``/``c-parse``/``c-translate`` commands now+ recognize the option ``jsontree=true`` to augment the returned JSON+ structure with a field called+ ``jsontree`` next to the field ``tree``, or ``jsontrees`` next to ``trees``,+ containing the the returned syntax tree in JSON format.+- PGF service: when using ``full=yes`` with the ``complete`` command,+ additional information about completions is included in the output, in+ particular there is an additional field ``seq`` containing the longest+ possible completion.+- PGF service: add command ``c-linearizeAll`` to obtain all variants.+- PGF service: PGFs now expire from the internal cache when they have been+ unused for 24 hours, to keep memory use down in long running servers.+- PGF service: limit the number of parallel calls to the C run-time parse+ function to 4 by default. The limit can be changed with the ``-j`` flag.
@@ -0,0 +1,98 @@+GF 3.8 Release Notes+June 2016++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].+++==What's new==++Roughly 400 changes have been pushed to the source repository since+[the release of GF 3.7.1 release-3.7.1.html] in October 2015.+++===GF compiler and run-time library===+++====New features and notable changes====++- GF shell: ``vd`` can now output+ [universal dependency http://universaldependencies.org/] diagrams+ in various formats, see ``help vd``.+- The C runtime now includes an experimental library for managing+ and querying ontologies built on top of the abstract syntax of+ a grammar. Since the ontology is based on an abstract syntax,+ it is language independent by design. For now the library is+ only used in the GF Offline Translator. The library uses+ the B-tree backend of [SQLite https://www.sqlite.org/]+ which makes it scalable even for non-trivial ontologies.+++====Other changes and bug fixes====++- GF shell: a simple post-processing step has been added in the ``cc`` command+ to try compute ``pre{...}`` tokens instead of leaving them uninterpreted.+- GF shell: an argument parsing problem has been fixed in the ``cc`` command.+ The problem was introduced before the release of GF 3.7.1 and prevented+ commands like ``cc "last"`` and ``cc "last"++"year"`` from working,+ but they should work again now.+- Python binding: with the OS X installer package (``gf-3.8.pkg``),+ the Python binding should now work directly out of the package.+ (The installer puts the modules under ``/Library/Python/2.7/site-packages``,+ where the Python interpreter can find them.)+- Various improvements and bug fixes in the C run-time system and its bindings+ to other languages.+++====Changes of interest to compiler developers====++- The compiler source code has been updated for compatibility with GHC 8.0.1.+++===Resource Grammar Library===++- New languages:+ - Nynorsk by Stian Rødven Eide (fairly complete, supports API)+ - Ancient Greek by Hans Leiß (partial, no API yet)+ - Slovene by Krasimir Angelov (partial, no API yet, donated by [Digital Grammars http://www.digitalgrammars.com/])++- Various fixes for several languages.+ - English and Scandinavian: relative clauses and slash questions have been modernized to+ using preposition stranding by default. This also enables the use of //that// in English,+ which solves a problem of choosing between //which// and //who// when animacy information+ is not available. The previous defaults (//which//,//who//,//whom//, pied piping) are available+ in ``Extra`` modules.++- Numerous fixes in the translation dictionaries.+ - two new wide-coverage languages: Estonian and Russian+ - The abstract syntax of the translation dictionary is now annotated+ with glosses, examples and sense IDs from WordNet. This gives us+ a basis on how to choose the best translations for different languages.+ - We have started splitting many of the lexical entries in the abstract+ syntax of the dictionary into different entries for senses that+ translate differently accross languages.+++===Apps and Cloud services===++- GF Offline Translator (for Android) now includes a user interface similar+ to the Phrasomatic. This lets the user explore the controlled+ language fragment of the wide coverage grammar. Althought+ the code is already there, the new release of the app+ will be postponed to get some of its other features stable.+- GF Offline Translator (for Android) now offers glosses and examples for+ most of its lexical items. This means that now it can be used as a more+ explanatory dictionary.+- Minibar can now show universal dependency diagrams for grammars that+ support it (e.g. the ResourceDemo grammar).+- PGF service: there is a new command ``deptree`` that can output+ universal dependency diagrams for grammars that support it (there+ has to be a label configuration file).+- Wide Coverage Translation Demo:+ there is now a new button "Grammars..." which show a list where users can+ select which application grammars to use for translation, in addition to+ the wide coverage grammar. Application grammars can give higher quality+ translations in the domain they cover.+ You can change the order in which the selected grammars are tried+ by dragging them up and down in the list.
@@ -0,0 +1,64 @@+GF 3.9 Release Notes+August 2017++==Installation==++See the [download page http://www.grammaticalframework.org/download/index.html].+++==What's new==++The [GF repository on GitHub https://github.com/GrammaticalFramework/GF/]+is now our master source repository, not just a read-only mirror.+Bug reports and feature requests can be submitted to the+[issue tracker https://github.com/GrammaticalFramework/GF/issues],+and we also accept pull requests.++Over 200 changes have been pushed to the source repository since+[the release of GF 3.8 release-3.8.html] in June 2016.+++===GF compiler and run-time library===+++====New features and notable changes====++- Support for language-specific depencency configurations (in addition to abstract syntax based ones); see ``help vd`` in the GF shell++- An experimental support for sentence lookup which makes it possible+to find the sentence from the grammar that matches best a set of keywords.+Right now it is usable only with controlled languages since it might be+very innefficient for some grammars.++- A new .NET binding for the GF runtime is available.++- The API in the Java binding is extended and it covers more from+the full functionality of the C runtime.+++====Changes of interest to compiler developers====++- The compiler source code has been updated for compatibility with GHC 8.2.1.+++===Resource Grammar Library===++- New languages:+ - Icelandic+ - Norwegian Nynorsk+++- API now usable for incomplete languages via ``Missing`` modules:+ implemented for Arabic and Latin.+- Punctuation with ``BIND`` and ``SOFT_BIND`` tokens for a number of languages+++- Various fixes for several languages.++- Various fixes in the translation dictionaries.+++===Apps and Cloud services===++- PGF service: support for language-specific depencency configurations in+ ``command=deptree``.
binary file changed (absent → 15086 bytes)
@@ -0,0 +1,7 @@+concrete Copy of CopyAbs = {+ lincat S, AB = Str ;+ lin s x = x ++ x ;+ end = [] ;+ a x = "a" ++ x ;+ b x = "b" ++ x ;+}
@@ -0,0 +1,6 @@+abstract CopyAbs = {+ cat S ; AB ;+ fun s : AB -> S ;+ end : AB ;+ a,b : AB -> AB ;+}
@@ -0,0 +1,13 @@+abstract Food = {+ flags startcat = Comment ;+ cat+ Comment ; Item ; Kind ; Quality ; + fun+ Pred : Item -> Quality -> Comment ;+ This, That : Kind -> Item ;+ Mod : Quality -> Kind -> Kind ;+ Wine, Cheese, Fish : Kind ;+ Very : Quality -> Quality ;+ Fresh, Warm, Italian, + Expensive, Delicious, Boring : Quality ;+}
@@ -0,0 +1,4 @@+ This 0.8+ Mod 0.2+ Wine 0.0+ Fresh 0.4
@@ -0,0 +1,19 @@+concrete FoodEng of Food = {+ lincat+ Comment, Item, Kind, Quality = Str ;+ lin+ Pred item quality = item ++ "is" ++ quality ;+ This kind = "this" ++ kind ;+ That kind = "that" ++ kind ;+ Mod quality kind = quality ++ kind ;+ Wine = "wine" ;+ Cheese = "cheese" ;+ Fish = "fish" ;+ Very quality = "very" ++ quality ;+ Fresh = "fresh" ;+ Warm = "warm" ;+ Italian = "Italian" ;+ Expensive = "expensive" ;+ Delicious = "delicious" ;+ Boring = "boring" ;+}
@@ -0,0 +1,24 @@++ concrete FoodHin of Food = {+ flags coding = utf8 ;+ lincat Comment, Item, Kind, Quality = Str ;+ lin+ Pred item quality = item ++ quality ++ "है" ;+ This kind = "यह" ++ kind ;+ That kind = "वह" ++ kind ;+ Mod quality kind = quality ++ kind ;+ Wine = "मदिरा" ;+ Cheese = "पनीर" ;+ Fish = "मछली" ;+ Very quality = "अति" ++ quality ;+ Fresh = "ताज़ा" ;+ Warm = "गरम" ;+ Italian = "इटली" ; + Expensive = "बहुमूल्य" ;+ Delicious = "स्वादिष्ट" ;+ Boring = "अरुचिकर" ;+ }++++
@@ -0,0 +1,19 @@+concrete FoodIta of Food = {+ lincat+ Comment, Item, Kind, Quality = Str ;+ lin+ Pred item quality = item ++ "è" ++ quality ;+ This kind = "questo" ++ kind ;+ That kind = "quel" ++ kind ;+ Mod quality kind = kind ++ quality ;+ Wine = "vino" ;+ Cheese = "formaggio" ;+ Fish = "pesce" ;+ Very quality = "molto" ++ quality ;+ Fresh = "fresco" ;+ Warm = "caldo" ;+ Italian = "italiano" ;+ Expensive = "caro" ;+ Delicious = "delizioso" ;+ Boring = "noioso" ;+}
@@ -0,0 +1,8 @@+abstract Letters = {++cat L ;+fun + a, b, c, d, e, f, g, h, i, j, k, l, m, + n, o, p, q, r, s, t, u, v, w, x, y, z : L ;++}
@@ -0,0 +1,31 @@+concrete LettersCnc of Letters = {++ lincat L = Str ;+ lin + a = "a" ;+ b = "b" ;+ c = "c" ;+ d = "d" ;+ e = "e" ;+ f = "f" ;+ g = "g" ;+ h = "h" ;+ i = "i" ;+ j = "j" ;+ k = "k" ;+ l = "l" ;+ m = "m" ;+ n = "n" ;+ o = "o" ;+ p = "p" ;+ q = "q" ;+ r = "r" ;+ s = "s" ;+ t = "t" ;+ u = "u" ;+ v = "v" ;+ w = "w" ;+ x = "x" ;+ y = "y" ;+ z = "z" ;+}
@@ -0,0 +1,7 @@+abstract Strings = Letters ** {++cat S ;+fun + E : S ;+ C : L -> S -> S ;+}
@@ -0,0 +1,5 @@+concrete StringsBW of Strings = LettersCnc ** {+ lincat S = Str ;+ lin E = [] ;+ lin C head tail = tail ++ head ;+}
@@ -0,0 +1,5 @@+concrete StringsFW of Strings = LettersCnc ** {+ lincat S = Str ;+ lin E = [] ;+ lin C head tail = head ++ tail ;+}
@@ -0,0 +1,10 @@+abstract Ticket = {++flags startcat = Request ;+cat+ Request ; Station ;+fun + Ticket : Station -> Station -> Request ;+ Hamburg, Paris : Station ;++}
@@ -0,0 +1,19 @@+concrete TicketEng of Ticket = {++lincat+ Request, Station = Str ;+lin + Ticket X Y = + ((("I" ++ ("would like" | "want") ++ "to get" |+ ("may" | "can") ++ "I get" | + "can you give me" |+ []) ++ + "a ticket") | + []) ++ + "from" ++ X ++ "to" ++ Y ++ + ("please" | []) ;++ Hamburg = "Hamburg" ;+ Paris = "Paris" ;++}
@@ -0,0 +1,14 @@+Pred. Comment ::= Item "is" Quality+This. Item ::= "this" Kind +That. Item ::= "that" Kind+Mod. Kind ::= Quality Kind +Wine. Kind ::= "wine" +Cheese. Kind ::= "cheese" +Fish. Kind ::= "fish"+Very. Quality ::= "very" Quality+Fresh. Quality ::= "fresh" +Warm. Quality ::= "warm" +Italian. Quality ::= "Italian" +Expensive. Quality ::= "expensive" +Delicious. Quality ::= "delicious" +Boring. Quality ::= "boring"
@@ -0,0 +1,14 @@+Pred. Comment ::= Item "è" Quality+This. Item ::= "questo" Kind +That. Item ::= "quel" Kind+Mod. Kind ::= Kind Quality+Wine. Kind ::= "vino" +Cheese. Kind ::= "formaggio"+Fish. Kind ::= "pesce"+Very. Quality ::= "molto" Quality+Fresh. Quality ::= "fresco" +Warm. Quality ::= "caldo" +Italian. Quality ::= "italiano" +Expensive. Quality ::= "caro" +Delicious. Quality ::= "delizioso" +Boring. Quality ::= "noioso"
@@ -0,0 +1,118 @@+resource Arabic = {+oper+ Root : Type = {F,C,L : Str} ;+ Pattern : Type = Root -> Str ;++ Filling : Type = {F,FC,CL,L : Str} ;++ fill : Filling -> Root -> Str = \p,r ->+ p.F + r.F + p.FC + r.C + p.CL + r.L + p.L ;++ dfill : Filling -> Root -> Str = \p,r ->+ p.F + r.F + p.FC + r.C + r.C + p.CL + r.L + p.L ;++ getRoot : Str -> Root = \s -> case s of {+ F@? + C@? + L@? => {F = F ; C = C ; L = L} ;+ _ => Predef.error ("cannot get root from" ++ s)+ } ;++ getPattern : Str -> Pattern = \s -> case s of {+ F + "F" + FC + "CC" + CL + "L" + L => + dfill {F = F ; FC = FC ; CL = CL ; L = L} ;+ F + "F" + FC + "C" + CL + "L" + L => + fill {F = F ; FC = FC ; CL = CL ; L = L} ;+ _ => Predef.error ("cannot get pattern from" ++ s)+ } ;++ word : Str -> Str -> Str = \p,r ->+ getPattern p (getRoot r) ;++param+ Number = Sg | Dl | Pl ;+ Gender = Masc | Fem ;+ Tense = Perf | Impf ;++ VPer = Vp3 Number Gender | Vp2Sg Gender | Vp2Dl | Vp2Pl Gender | Vp1Sg | Vp1Pl ;++oper+ Verb : Type = {s : Tense => VPer => Str} ; ++ pattV_u : Tense -> VPer -> Pattern = \t,v -> getPattern (case t of {+ Perf => case v of {+ Vp3 Sg Masc => "FaCaLa" ;+ Vp3 Sg Fem => "FaCaLat" ;+ Vp3 Dl Masc => "FaCaLaA" ;+ Vp3 Dl Fem => "FaCaLataA" ;+ Vp3 Pl Masc => "FaCaLuwA" ;+ Vp3 Pl Fem => "FaCaLona" ;++ Vp2Sg Masc => "FaCaLota" ;+ Vp2Sg Fem => "FaCaLoti" ;+ Vp2Dl => "FaCaLotumaA" ;+ Vp2Pl Masc => "FaCaLotum" ;+ Vp2Pl Fem => "FaCaLotunv2a" ;+ + Vp1Sg => "FaCaLotu" ;+ Vp1Pl => "FaCaLonaA"+ } ;+ Impf => case v of {+ Vp3 Sg Masc => "yaFoCuLu" ;+ Vp3 Sg Fem => "taFoCuLu" ;+ Vp3 Dl Masc => "yaFoCuLaAni" ;+ Vp3 Dl Fem => "taFoCuLaAni" ;+ Vp3 Pl Masc => "yaFoCuLuwna" ;+ Vp3 Pl Fem => "yaFoCuLna" ;++ Vp2Sg Masc => "taFoCuLu" ;+ Vp2Sg Fem => "taFoCuLiyna" ;+ Vp2Dl => "taFoCuLaAni" ;+ Vp2Pl Masc => "taFoCuLuwna" ;+ Vp2Pl Fem => "taFoCuLona" ;+ + Vp1Sg => "A?aFoCuLu" ;+ Vp1Pl => "naFoCuLu"+ }+ }) ;++ u_Verb : Str -> Verb = \s -> {+ s = \\t,p => pattV_u t p (getRoot s) ;+ } ;++-- for html++ tag : Str -> Str = \t -> "<" + t + ">" ;+ etag : Str -> Str = \t -> "</" + t + ">" ;+ atag : Str -> Str -> Str = \t,a -> "<" + t ++ a + ">" ;++ intag : Str -> Str -> Str = \t,s -> tag t ++ s ++ etag t ;+ intagAttr : Str -> Str -> Str -> Str = \t,a,s -> atag t a ++ s ++ etag t ;++ verbTable : Verb -> Str = \v -> + let + vsp = v.s ! Perf ;+ vsi = v.s ! Impf ;+ tr : Str -> Str = intag "tr" ;+ td : Str -> Str = intag "td" ;+ ts : Str -> Str = \s -> td ("\"" ++ s ++ "\"") ;+ trs : Str -> Str -> VPer -> Str = \s,n,v -> + tr (td s ++ td n ++ ts (vsp ! v) ++ ts (vsi ! v))+ in + intagAttr "table" "border=1" (+ tr ((td "Persona") ++ (td "Numerus") ++ (td "Perfectum") ++ (td "Imperfectum")) +++ trs "3. masc." "sing." (Vp3 Sg Masc) +++ trs "3. fem." "sing." (Vp3 Sg Fem) +++ trs "2. masc." "sing." (Vp2Sg Masc) +++ trs "2. fem." "sing." (Vp2Sg Fem) +++ trs "1." "sing." (Vp1Sg) +++ trs "3. masc." "dual." (Vp3 Dl Masc) +++ trs "3. fem." "dual." (Vp3 Dl Fem) +++ trs "2." "dual." (Vp2Dl) +++ trs "3. masc." "plur." (Vp3 Pl Masc) +++ trs "3. fem." "plur." (Vp3 Pl Fem) +++ trs "2. masc." "plur." (Vp2Pl Masc) +++ trs "2. fem." "plur." (Vp2Pl Fem) +++ trs "1." "plur." (Vp1Pl)+ ) ;+++}
@@ -0,0 +1,11 @@+abstract Discont = {+ cat + S ; Cl ; NP ; VP ; AP ; + fun + DeclCl : Cl -> S ;+ QuestCl : Cl -> S ;+ PredVP : NP -> VP -> Cl ; + CompAP : AP -> VP ;+ John : NP ;+ Old : AP ;+}
@@ -0,0 +1,21 @@+concrete DiscontEng of Discont = {+ param+ SForm = SDecl | SQuest ;+ lincat + S, NP, AP = Str ;+ Cl = SForm => Str ;+ VP = {verb,comp : Str} ; + lin + DeclCl cl = cl ! SDecl ;+ QuestCl cl = cl ! SQuest ;+ PredVP np vp = table {+ SDecl => np ++ vp.verb ++ vp.comp ;+ SQuest => vp.verb ++ np ++ vp.comp+ } ;+ CompAP ap = {+ verb = "is" ;+ comp = ap+ } ;+ John = "John" ;+ Old = "old" ;+}
@@ -0,0 +1,13 @@+abstract Foods = {+ flags startcat = Comment ;+ cat+ Comment ; Item ; Kind ; Quality ;+ fun+ Pred : Item -> Quality -> Comment ;+ This, That, These, Those : Kind -> Item ;+ Mod : Quality -> Kind -> Kind ;+ Wine, Cheese, Fish, Pizza : Kind ;+ Very : Quality -> Quality ;+ Fresh, Warm, Italian, + Expensive, Delicious, Boring : Quality ;+}
@@ -0,0 +1,40 @@+concrete FoodsEng of Foods = {+ lincat+ Comment, Quality = {s : Str} ; + Kind = {s : Number => Str} ; + Item = {s : Str ; n : Number} ; + lin+ Pred item quality = + {s = item.s ++ copula ! item.n ++ quality.s} ;+ This = det Sg "this" ;+ That = det Sg "that" ;+ These = det Pl "these" ;+ Those = det Pl "those" ;+ Mod quality kind = + {s = \\n => quality.s ++ kind.s ! n} ;+ Wine = regNoun "wine" ;+ Cheese = regNoun "cheese" ;+ Fish = noun "fish" "fish" ;+ Pizza = regNoun "pizza" ;+ Very a = {s = "very" ++ a.s} ;+ Fresh = adj "fresh" ;+ Warm = adj "warm" ;+ Italian = adj "Italian" ;+ Expensive = adj "expensive" ;+ Delicious = adj "delicious" ;+ Boring = adj "boring" ;+ param+ Number = Sg | Pl ;+ oper+ det : Number -> Str -> + {s : Number => Str} -> {s : Str ; n : Number} = + \n,det,noun -> {s = det ++ noun.s ! n ; n = n} ;+ noun : Str -> Str -> {s : Number => Str} = + \man,men -> {s = table {Sg => man ; Pl => men}} ;+ regNoun : Str -> {s : Number => Str} = + \car -> noun car (car + "s") ;+ adj : Str -> {s : Str} = + \cold -> {s = cold} ;+ copula : Number => Str = + table {Sg => "is" ; Pl => "are"} ;+}
@@ -0,0 +1,32 @@+concrete FoodsIta of Foods = open ResIta in {+ lincat+ Comment = {s : Str} ; + Quality = Adjective ; + Kind = Noun ; + Item = NounPhrase ;+ lin+ Pred item quality = + {s = item.s ++ copula ! item.n ++ + quality.s ! item.g ! item.n} ;+ This = det Sg "questo" "questa" ;+ That = det Sg "quel" "quella" ;+ These = det Pl "questi" "queste" ;+ Those = det Pl "quei" "quelle" ;+ Mod quality kind = {+ s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ;+ g = kind.g+ } ;+ Wine = noun "vino" "vini" Masc ;+ Cheese = noun "formaggio" "formaggi" Masc ;+ Fish = noun "pesce" "pesci" Masc ;+ Pizza = noun "pizza" "pizze" Fem ;+ Very qual = {s = \\g,n => "molto" ++ qual.s ! g ! n} ;+ Fresh = + adjective "fresco" "fresca" "freschi" "fresche" ;+ Warm = regAdj "caldo" ;+ Italian = regAdj "italiano" ;+ Expensive = regAdj "caro" ;+ Delicious = regAdj "delizioso" ;+ Boring = regAdj "noioso" ;+}+
@@ -0,0 +1,36 @@+resource ResIta = open Prelude in {+ param+ Number = Sg | Pl ;+ Gender = Masc | Fem ;+ oper+ NounPhrase : Type = + {s : Str ; g : Gender ; n : Number} ; + Noun : Type = {s : Number => Str ; g : Gender} ;+ Adjective : Type = {s : Gender => Number => Str} ;++ det : Number -> Str -> Str -> Noun -> NounPhrase =+ \n,m,f,cn -> {+ s = table {Masc => m ; Fem => f} ! cn.g ++ + cn.s ! n ;+ g = cn.g ;+ n = n+ } ;+ noun : Str -> Str -> Gender -> Noun =+ \vino,vini,g -> {+ s = table {Sg => vino ; Pl => vini} ;+ g = g+ } ;+ adjective : (nero,nera,neri,nere : Str) -> Adjective =+ \nero,nera,neri,nere -> {+ s = table {+ Masc => table {Sg => nero ; Pl => neri} ; + Fem => table {Sg => nera ; Pl => nere}+ }+ } ;+ regAdj : Str -> Adjective = \nero ->+ let ner : Str = init nero + in + adjective nero (ner+"a") (ner+"i") (ner+"e") ;+ copula : Number => Str = + table {Sg => "è" ; Pl => "sono"} ;+}
@@ -0,0 +1,5 @@+abstract Clothes = Comments ** {+ fun+ Shirt, Jacket : Kind ;+ Comfortable, Elegant : Quality ;+}
@@ -0,0 +1,10 @@+--# -path=.:present++concrete ClothesEng of Clothes = CommentsEng ** + open SyntaxEng, ParadigmsEng in {+ lin+ Shirt = mkCN (mkN "shirt") ;+ Jacket = mkCN (mkN "jacket") ;+ Comfortable = mkAP (mkA "comfortable") ;+ Elegant = mkAP (mkA "elegant") ;+}
@@ -0,0 +1,8 @@+concrete ClothesIta of Clothes = CommentsIta ** + open SyntaxIta, ParadigmsIta in {+ lin+ Shirt = mkCN (mkN "camicia") ;+ Jacket = mkCN (mkN "giacca") ;+ Comfortable = mkAP (mkA "comodo") ;+ Elegant = mkAP (mkA "elegante") ;+}
@@ -0,0 +1,13 @@+abstract Comment = {+ flags startcat = Comment ;+ cat+ Comment ; Item ; Kind ; Quality ;+ fun+ Pred : Item -> Quality -> Comment ;+ This, That, These, Those : Kind -> Item ;+ Mod : Quality -> Kind -> Kind ;+ Wine, Cheese, Fish, Pizza : Kind ;+ Very : Quality -> Quality ;+ Fresh, Warm, Italian, + Expensive, Delicious, Boring : Quality ;+}
@@ -0,0 +1,10 @@+abstract Comments = {+ flags startcat = Comment ;+ cat+ Comment ; Item ; Kind ; Quality ;+ fun+ Pred : Item -> Quality -> Comment ;+ This, That, These, Those : Kind -> Item ;+ Mod : Quality -> Kind -> Kind ;+ Very : Quality -> Quality ;+}
@@ -0,0 +1,4 @@+--# -path=.:present++concrete CommentsEng of Comments = CommentsI with + (Syntax = SyntaxEng) ;
@@ -0,0 +1,15 @@+incomplete concrete CommentsI of Comments = open Syntax in {+ lincat+ Comment = Cl ; + Item = NP ;+ Kind = CN ;+ Quality = AP ;+ lin+ Pred item quality = mkCl item quality ;+ This kind = mkNP this_QuantSg kind ;+ That kind = mkNP that_QuantSg kind ;+ These kind = mkNP these_QuantPl kind ;+ Those kind = mkNP those_QuantPl kind ;+ Mod quality kind = mkCN quality kind ;+ Very quality = mkAP very_AdA quality ;+}
@@ -0,0 +1,4 @@+--# -path=.:present++concrete CommentsIta of Comments = CommentsI with + (Syntax = SyntaxIta) ;
@@ -0,0 +1,5 @@+abstract Computers = Comments ** {+ fun+ Computer, HardDisk : Kind ;+ Efficient, Slow : Quality ;+}
@@ -0,0 +1,10 @@+--# -path=.:present++concrete ComputersEng of Computers = CommentsEng ** + open SyntaxEng, ParadigmsEng in {+ lin+ Computer = mkCN (mkN "computer") ;+ HardDisk = mkCN (mkA "hard") (mkN "disk") ;+ Efficient = mkAP (mkA "efficient") ;+ Slow = mkAP (mkA "slow") ;+}
@@ -0,0 +1,9 @@+concrete ComputersIta of Computers = + CommentsIta ** open ResIta in {+ lin+ Computer = noun "computer" "computer" Masc ;+ HardDisk = noun "disco rigido" "dischi rigidi" Masc ;+ Efficient = adjective "efficiente" "efficiente" + "efficienti" "efficienti" ;+ Slow = regAdj "lento" ;+}
@@ -0,0 +1,16 @@+resource DefArtGer = {++ param DetForm = DSg Gender Case | DPl Case ;+ param Gender = Masc | Fem | Neutr ;+ param Case = Nom | Acc | Dat | Gen ;++ oper artDef : DetForm => Str = table {+ DSg Masc Acc | DPl Dat => "den" ;+ DSg (Masc | Neutr) Dat => "dem" ;+ DSg (Masc | Neutr) Gen => "des" ;+ DSg Neutr _ => "das" ;+ DSg Fem (Nom | Acc) | DPl (Nom | Acc) => "die" ; + _ => "der"+ } ;++}
@@ -0,0 +1,6 @@+abstract Foods = Comments ** {+ fun+ Wine, Cheese, Fish, Pizza : Kind ;+ Fresh, Warm, Italian, + Expensive, Delicious, Boring : Quality ;+}
@@ -0,0 +1,16 @@+--# -path=.:present++concrete FoodsEng of Foods = CommentsEng ** + open SyntaxEng, ParadigmsEng in {+ lin+ Wine = mkCN (mkN "wine") ;+ Pizza = mkCN (mkN "pizza") ;+ Cheese = mkCN (mkN "cheese") ;+ Fish = mkCN (mkN "fish" "fish") ;+ Fresh = mkAP (mkA "fresh") ;+ Warm = mkAP (mkA "warm") ;+ Italian = mkAP (mkA "Italian") ;+ Expensive = mkAP (mkA "expensive") ;+ Delicious = mkAP (mkA "delicious") ;+ Boring = mkAP (mkA "boring") ;+}
@@ -0,0 +1,16 @@+--# -path=.:present++concrete FoodsIta of Foods = CommentsIta ** + open SyntaxIta, ParadigmsIta in {+ lin+ Wine = mkCN (mkN "vino") ;+ Pizza = mkCN (mkN "pizza") ;+ Cheese = mkCN (mkN "formaggio") ;+ Fish = mkCN (mkN "pesce") ;+ Fresh = mkAP (mkA "fresco") ;+ Warm = mkAP (mkA "caldo") ;+ Italian = mkAP (mkA "italiano") ;+ Expensive = mkAP (mkA "caro") ;+ Delicious = mkAP (mkA "delizioso") ;+ Boring = mkAP (mkA "noioso") ;+}
@@ -0,0 +1,2 @@+abstract Shopping = Foods, Clothes ;+
@@ -0,0 +1,4 @@+--# -path=.:present++concrete ShoppingEng of Shopping = FoodsEng, ClothesEng ;+
@@ -0,0 +1,4 @@+--# -path=.:present++concrete ShoppingIta of Shopping = FoodsIta, ClothesIta ;+
@@ -0,0 +1,3 @@+abstract SmallShopping = + Foods - [Wine], + Clothes [Kind,Quality,Shirt,Elegant] ;
@@ -0,0 +1,15 @@+-- (c) 2009 Aarne Ranta under LGPL++abstract Foods = {+ flags startcat = Comment ;+ cat+ Comment ; Item ; Kind ; Quality ;+ fun+ Pred : Item -> Quality -> Comment ;+ This, That, These, Those : Kind -> Item ;+ Mod : Quality -> Kind -> Kind ;+ Wine, Cheese, Fish, Pizza : Kind ;+ Very : Quality -> Quality ;+ Fresh, Warm, Italian, + Expensive, Delicious, Boring : Quality ;+}
@@ -0,0 +1,7 @@+--# -path=.:present++-- (c) 2009 Jordi Saludes under LGPL++concrete FoodsCat of Foods = FoodsI with + (Syntax = SyntaxCat),+ (LexFoods = LexFoodsCat) ;
@@ -0,0 +1,28 @@+--# -path=.:present++concrete FoodsEng of Foods = + open SyntaxEng,ParadigmsEng in {+ lincat+ Comment = Utt ; + Item = NP ;+ Kind = CN ;+ Quality = AP ;+ lin+ Pred item quality = mkUtt (mkCl item quality) ;+ This kind = mkNP this_Quant kind ;+ That kind = mkNP that_Quant kind ;+ These kind = mkNP this_Quant plNum kind ;+ Those kind = mkNP that_Quant plNum kind ;+ Mod quality kind = mkCN quality kind ;+ Wine = mkCN (mkN "wine") ;+ Pizza = mkCN (mkN "pizza") ;+ Cheese = mkCN (mkN "cheese") ;+ Fish = mkCN (mkN "fish" "fish") ;+ Very quality = mkAP very_AdA quality ;+ Fresh = mkAP (mkA "fresh") ;+ Warm = mkAP (mkA "warm") ;+ Italian = mkAP (mkA "Italian") ;+ Expensive = mkAP (mkA "expensive") ;+ Delicious = mkAP (mkA "delicious") ;+ Boring = mkAP (mkA "boring") ;+}
@@ -0,0 +1,7 @@+--# -path=.:present++-- (c) 2009 Aarne Ranta under LGPL++concrete FoodsFin of Foods = FoodsI with + (Syntax = SyntaxFin),+ (LexFoods = LexFoodsFin) ;
@@ -0,0 +1,7 @@+--# -path=.:present++-- (c) 2009 Aarne Ranta under LGPL++concrete FoodsGer of Foods = FoodsI with + (Syntax = SyntaxGer),+ (LexFoods = LexFoodsGer) ;
@@ -0,0 +1,29 @@+-- (c) 2009 Aarne Ranta under LGPL++incomplete concrete FoodsI of Foods = + open Syntax, LexFoods in {+ lincat+ Comment = Utt ; + Item = NP ;+ Kind = CN ;+ Quality = AP ;+ lin+ Pred item quality = mkUtt (mkCl item quality) ;+ This kind = mkNP this_Det kind ;+ That kind = mkNP that_Det kind ;+ These kind = mkNP these_Det kind ;+ Those kind = mkNP those_Det kind ;+ Mod quality kind = mkCN quality kind ;+ Very quality = mkAP very_AdA quality ;++ Wine = mkCN wine_N ;+ Pizza = mkCN pizza_N ;+ Cheese = mkCN cheese_N ;+ Fish = mkCN fish_N ;+ Fresh = mkAP fresh_A ;+ Warm = mkAP warm_A ;+ Italian = mkAP italian_A ;+ Expensive = mkAP expensive_A ;+ Delicious = mkAP delicious_A ;+ Boring = mkAP boring_A ;+}
@@ -0,0 +1,8 @@+--# -path=.:present++-- (c) 2009 Aarne Ranta under LGPL++concrete FoodsIta of Foods = FoodsI with + (Syntax = SyntaxIta),+ (LexFoods = LexFoodsIta) ;+
@@ -0,0 +1,7 @@+--# -path=.:present++-- (c) 2009 Aarne Ranta under LGPL++concrete FoodsSwe of Foods = FoodsI with + (Syntax = SyntaxSwe),+ (LexFoods = LexFoodsSwe) ** {flags language = sv_SE;} ;
@@ -0,0 +1,15 @@+-- (c) 2009 Aarne Ranta under LGPL++interface LexFoods = open Syntax in {+ oper+ wine_N : N ;+ pizza_N : N ;+ cheese_N : N ;+ fish_N : N ;+ fresh_A : A ;+ warm_A : A ;+ italian_A : A ;+ expensive_A : A ;+ delicious_A : A ;+ boring_A : A ;+}
@@ -0,0 +1,18 @@+-- (c) 2009 Jordi Saludes under LGPL++instance LexFoodsCat of LexFoods = + open SyntaxCat, ParadigmsCat, (M = MorphoCat) in {+ flags+ coding = utf8 ;+ oper+ wine_N = mkN "vi" "vins" M.Masc ;+ pizza_N = mkN "pizza" ;+ cheese_N = mkN "formatge" ;+ fish_N = mkN "peix" "peixos" M.Masc;+ fresh_A = mkA "fresc" "fresca" "frescos" "fresques" "frescament";+ warm_A = mkA "calent" ;+ italian_A = mkA "italià" "italiana" "italians" "italianes" "italianament" ;+ expensive_A = mkA "car" ;+ delicious_A = mkA "deliciós" "deliciosa" "deliciosos" "delicioses" "deliciosament";+ boring_A = mkA "aburrit" "aburrida" "aburrits" "aburrides" "aburridament" ;+}
@@ -0,0 +1,20 @@+instance LexFoodsEng of LexFoods = open SyntaxEng, ParadigmsEng, IrregEng in {+ oper+ wine_N = mkN "wine" ;+ pizza_N = mkN "pizza" ;+ cheese_N = mkN "cheese" ;+ fish_N = mkN "fish" "fish" ;+ fresh_A = mkA "fresh" ;+ warm_A = mkA "warm" ;+ italian_A = mkA "Italian" ;+ expensive_A = mkA "expensive" ;+ delicious_A = mkA "delicious" ;+ boring_A = mkA "boring" ;++ eat_V2 = mkV2 eat_V ;+ drink_V2 = mkV2 drink_V ;+ pay_V2 = mkV2 pay_V ;+ lady_N = mkN "lady" ;+ gentleman_N = mkN "gentleman" "gentlemen" ;++}
@@ -0,0 +1,20 @@+-- (c) 2009 Aarne Ranta under LGPL++instance LexFoodsFin of LexFoods = + open SyntaxFin, ParadigmsFin in {+ oper+ wine_N = mkN "viini" ;+ pizza_N = mkN "pizza" ;+ cheese_N = mkN "juusto" ;+ fish_N = mkN "kala" ;+ fresh_A = mkA "tuore" ;+ warm_A = mkA + (mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään" + "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"+ ) + "lämpimämpi" "lämpimin" ;+ italian_A = mkA "italialainen" ;+ expensive_A = mkA "kallis" ;+ delicious_A = mkA "herkullinen" ;+ boring_A = mkA "tylsä" ;+}
@@ -0,0 +1,16 @@+-- (c) 2009 Aarne Ranta under LGPL++instance LexFoodsGer of LexFoods = + open SyntaxGer, ParadigmsGer in {+ oper+ wine_N = mkN "Wein" ;+ pizza_N = mkN "Pizza" "Pizzen" feminine ;+ cheese_N = mkN "Käse" "Käse" masculine ;+ fish_N = mkN "Fisch" ;+ fresh_A = mkA "frisch" ;+ warm_A = mkA "warm" "wärmer" "wärmste" ;+ italian_A = mkA "italienisch" ;+ expensive_A = mkA "teuer" ;+ delicious_A = mkA "köstlich" ;+ boring_A = mkA "langweilig" ;+}
@@ -0,0 +1,16 @@+-- (c) 2009 Aarne Ranta under LGPL++instance LexFoodsIta of LexFoods = + open SyntaxIta, ParadigmsIta in {+ oper+ wine_N = mkN "vino" ;+ pizza_N = mkN "pizza" ;+ cheese_N = mkN "formaggio" ;+ fish_N = mkN "pesce" ;+ fresh_A = mkA "fresco" ;+ warm_A = mkA "caldo" ;+ italian_A = mkA "italiano" ;+ expensive_A = mkA "caro" ;+ delicious_A = mkA "delizioso" ;+ boring_A = mkA "noioso" ;+}
@@ -0,0 +1,16 @@+-- (c) 2009 Aarne Ranta under LGPL++instance LexFoodsSwe of LexFoods = + open SyntaxSwe, ParadigmsSwe in {+ oper+ wine_N = mkN "vin" "vinet" "viner" "vinerna" ;+ pizza_N = mkN "pizza" ;+ cheese_N = mkN "ost" ;+ fish_N = mkN "fisk" ;+ fresh_A = mkA "färsk" ;+ warm_A = mkA "varm" ;+ italian_A = mkA "italiensk" ;+ expensive_A = mkA "dyr" ;+ delicious_A = mkA "läcker" ;+ boring_A = mkA "tråkig" ;+}
@@ -0,0 +1,33 @@+abstract Aggregation = {+ cat S ; NP ; VP ;+ data + PredVP : NP -> VP -> S ;+ ConjS : S -> S -> S ;+ ConjVP : VP -> VP -> VP ;+ ConjNP : NP -> NP -> NP ;+ Run, Walk : VP ;+ John, Mary : NP ;++ fun aggr : S -> S ; -- main aggregation function+ def aggr (ConjS (PredVP x X) (PredVP y Y)) = + ifS (eqNP x y) + (PredVP x (ConjVP X Y)) + (ifS (eqVP X Y) + (PredVP (ConjNP x y) X)+ (ConjS (PredVP x X) (PredVP y Y))) ;+ fun ifS : Bool -> S -> S -> S ; -- if b then x else y + def+ ifS True x _ = x ;+ ifS False _ y = y ;+ fun eqNP : NP -> NP -> Bool ; -- x == y+ def + eqNP John John = True ;+ eqNP Mary Mary = True ;+ eqNP _ _ = False ;+ fun eqVP : VP -> VP -> Bool ; -- X == Y+ def + eqVP Run Run = True ;+ eqVP Walk Walk = True ;+ eqVP _ _ = False ;+ cat Bool ; data True, False : Bool ;+}
@@ -0,0 +1,17 @@+concrete AggregationEng of Aggregation = {++lincat S, NP, VP = Str ;++lin + PredVP x y = x ++ y ;+ ConjS a b = a ++ "or" ++ b ;+ ConjVP a b = a ++ "or" ++ b ;+ ConjNP a b = a ++ "or" ++ b ;++ Run = "runs" ;+ Walk = "walks" ;+ John = "John" ;+ Mary = "Mary" ;++}+
@@ -0,0 +1,30 @@+abstract Arithm = {+ cat+ Prop ; -- proposition+ Nat ; -- natural number+ data+ Zero : Nat ; -- 0+ Succ : Nat -> Nat ; -- the successor of x+ fun+ Even : Nat -> Prop ; -- x is even+ And : Prop -> Prop -> Prop ; -- A and B++ cat Less Nat Nat ; + data LessZ : (y : Nat) -> Less Zero (Succ y) ;+ data LessS : (x,y : Nat) -> Less x y -> Less (Succ x) (Succ y) ;++ cat Span ;+ data FromTo : (m,n : Nat) -> Less m n -> Span ;++ fun one : Nat ;+ def one = Succ Zero ;++ fun twice : Nat -> Nat ;+ def twice x = plus x x ;++ fun plus : Nat -> Nat -> Nat ;+ def + plus x Zero = x ;+ plus x (Succ y) = Succ (plus x y) ;++}
@@ -0,0 +1,50 @@+abstract Bin = {++cat Nat ; Bin ; Pos ;++data + Zero : Nat ; + Succ : Nat -> Nat ;++ BZero : Bin ; -- 0+ BPos : Pos -> Bin ; -- p+ BOne : Pos ; -- 1+ AZero : Pos -> Pos ; -- p0+ AOne : Pos -> Pos ; -- p1++fun+ bin2nat : Bin -> Nat ;+def+ bin2nat BZero = Zero ;+ bin2nat (BPos p) = pos2nat p ;+fun + pos2nat : Pos -> Nat ;+def+ pos2nat BOne = one ;+ pos2nat (AZero p) = twice (pos2nat p) ;+ pos2nat (AOne p) = Succ (twice (pos2nat p)) ;+fun one : Nat ;+def one = Succ Zero ;+fun twice : Nat -> Nat ;+def + twice Zero = Zero ;+ twice (Succ n) = Succ (Succ (twice n)) ;++fun+ nat2bin : Nat -> Bin ;+def+ nat2bin Zero = BZero ;+ nat2bin (Succ n) = bSucc (nat2bin n) ;+fun+ bSucc : Bin -> Bin ;+def+ bSucc BZero = BPos BOne ;+ bSucc (BPos p) = BPos (pSucc p) ;+fun+ pSucc : Pos -> Pos ;+def+ pSucc BOne = AZero BOne ;+ pSucc (AZero p) = AOne p ;+ pSucc (AOne p) = AZero (pSucc p) ;++}
@@ -0,0 +1,28 @@+abstract Classes = {++flags + startcat = Command ;++cat+ Command ;+ Kind ;+ Class ;+ Instance Class Kind ;+ Action Class ;+ Device Kind ;++fun+ Act : (c : Class) -> (k : Kind) -> Instance c k -> Action c -> Device k -> Command ;+ The : (k : Kind) -> Device k ;++ Light, Fan : Kind ;+ Switchable, Dimmable : Class ;+ + SwitchOn, SwitchOff : Action Switchable ;+ Dim : Action Dimmable ;++ switchable_Light : Instance Switchable Light ;+ switchable_Fan : Instance Switchable Fan ;+ dimmable_Light : Instance Dimmable Light ;++}
@@ -0,0 +1,29 @@+--# -path=.:present++concrete ClassesEng of Classes = open SyntaxEng, ParadigmsEng in {++lincat+ Command = Utt ;+ Kind = CN ;+ Class = {} ;+ Instance = {} ;+ Action = V2 ;+ Device = NP ;++lin+ Act _ _ _ a d = mkUtt (mkImp a d) ;+ The k = mkNP the_Det k ;++ Light = mkCN (mkN "light") ;+ Fan = mkCN (mkN "fan") ;+ Switchable, Dimmable = <> ;+ + SwitchOn = mkV2 (partV (mkV "switch") "on") ;+ SwitchOff = mkV2 (partV (mkV "switch") "off") ;+ Dim = mkV2 (mkV "dim") ;++ switchable_Light = <> ;+ switchable_Fan = <> ;+ dimmable_Light = <> ;++}
@@ -0,0 +1,24 @@+abstract DShopping = {+ flags startcat = Comment ;+ cat+ Comment ; + Dom ;+ Item Dom ; + Kind Dom ; + Quality Dom ;+ fun+ DFood, DCloth : Dom ;++ Pred : (d : Dom) -> Item d -> Quality d -> Comment ;+ This, That : (d : Dom) -> Kind d -> Item d ;+ Mod : (d : Dom) -> Quality d -> Kind d -> Kind d ;+ Wine, Cheese, Fish : Kind DFood ;+ Very : (d : Dom) -> Quality d -> Quality d ;+ Fresh, Warm, Delicious, Boring : Quality DFood ;++ Shirt, Jacket : Kind DCloth ;+ Comfortable : Quality DCloth ;++ Italian, Expensive, Elegant : (d : Dom) -> Quality d ;++}
@@ -0,0 +1,33 @@+--# -path=.:present++concrete DShoppingEng of DShopping = open SyntaxEng, ParadigmsEng in {++ lincat+ Comment = Cl ; + Item = NP ;+ Kind = CN ;+ Quality = AP ;+ lin+ Pred _ item quality = mkCl item quality ;+ This _ kind = mkNP this_QuantSg kind ;+ That _ kind = mkNP that_QuantSg kind ;+ Mod _ quality kind = mkCN quality kind ;+ Very _ quality = mkAP very_AdA quality ;++ Shirt = mkCN (mkN "shirt") ;+ Jacket = mkCN (mkN "jacket") ;+ Wine = mkCN (mkN "wine") ;+ Cheese = mkCN (mkN "cheese") ;+ Fish = mkCN (mkN "fish" "fish") ;+ Fresh = mkAP (mkA "fresh") ;+ Warm = mkAP (mkA "warm") ;+ Italian _ = mkAP (mkA "Italian") ;+ Expensive _ = mkAP (mkA "expensive") ;+ Elegant _ = mkAP (mkA "elegant") ;+ Delicious = mkAP (mkA "delicious") ;+ Boring = mkAP (mkA "boring") ;+ Comfortable = mkAP (mkA "comfortable") ;++ DFood, DCloth = {s = []} ;++}
@@ -0,0 +1,22 @@+abstract Nat = {+ cat+ Prop ; -- proposition+ Nat ; -- natural number+ data+ Zero : Nat ; -- 0+ Succ : Nat -> Nat ; -- the successor of x+ fun+ Even : Nat -> Prop ; -- x is even+ And : Prop -> Prop -> Prop ; -- A and B++ fun one : Nat ;+ def one = Succ Zero ;++ fun twice : Nat -> Nat ;+ def twice x = plus x x ;++ fun plus : Nat -> Nat -> Nat ;+ def + plus x Zero = x ;+ plus x (Succ y) = Succ (plus x y) ;+}
@@ -0,0 +1,16 @@+abstract Smart = {++ cat+ Command ;+ Kind ; + Device Kind ; + Action Kind ; ++ fun + Act : (k : Kind) -> Action k -> Device k -> Command ;+ The : (k : Kind) -> Device k ; -- the light+ Light, Fan : Kind ;+ Dim : Action Light ;+ SwitchOn, SwitchOff : (k : Kind) -> Action k ;++}
@@ -0,0 +1,22 @@+abstract Verbs = {++cat+ S ; NP ; Subcat ; V Subcat ; Args Subcat ;++fun+ cIntr : Subcat ;+ cTr : Subcat ;+ cS : Subcat ;++ aIntr : NP -> Args cIntr ;+ aTr : NP -> NP -> Args cTr ;+ aS : NP -> S -> Args cS ;++ pred : (s : Subcat) -> V s -> Args s -> S ;++ john, mary : NP ;+ walk : V cIntr ;+ love : V cTr ;+ know : V cS ;++}
@@ -0,0 +1,22 @@+concrete VerbsEng of Verbs = {++lincat+ S, NP, Subcat, V = Str ; Args = Str * Str ;++lin+ cIntr = [] ;+ cTr = [] ;+ cS = [] ;++ aIntr su = <su,[]> ;+ aTr su ob = <su,ob> ;+ aS su s = <su,"that" ++ s> ;++ pred _ v xs = xs.p1 ++ v ++ xs.p2 ;++ john = "John" ; mary = "Mary" ;+ walk = "walks" ;+ love = "loves" ;+ know = "knows" ;++}
@@ -0,0 +1,10 @@+abstract Map = {+flags startcat = Query ;+cat+ Query ; Input ; Place ; Click ;+fun+ GoFromTo : Place -> Place -> Input ;+ ThisPlace : Click -> Place ;+ QueryInput : Input -> Query ;+ ClickCoord : Int -> Int -> Click ;+}
@@ -0,0 +1,17 @@+concrete MapEng of Map = {+lincat+ Query = {s : Str} ;+ Input, Place = {s : Str ; p : Str} ;+ Click = {p : Str} ;+lin+ GoFromTo x y = {+ s = "I want to go from" ++ x.s ++ "to" ++ y.s ; + p = x.p ++ y.p+ } ;+ ThisPlace c = {+ s = "this place" ; + p = c.p+ } ;+ QueryInput i = {s = i.s ++ ";" ++ i.p} ;+ ClickCoord x y = {p = "(" ++ x.s ++ "," ++ y.s ++ ")"} ;+}
@@ -0,0 +1,12 @@+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 ;+}
@@ -0,0 +1,13 @@+concrete QueryEng of Query = {+ lincat + Answer, Question, Object = Str ;+ lin + Even = pred "even" ;+ Odd = pred "odd" ;+ Prime = pred "prime" ;+ Number i = i.s ;+ Yes = "yes" ;+ No = "no" ;+ oper+ pred : Str -> Str -> Str = \f,x -> "is" ++ x ++ f ;+}
@@ -0,0 +1,13 @@+concrete QueryFin of Query = {+ lincat + Answer, Question, Object = Str ;+ lin + Even = pred "parillinen" ;+ Odd = pred "pariton" ;+ Prime = pred "alkuluku" ;+ Number i = i.s ;+ Yes = "kyllä" ;+ No = "ei" ;+ oper+ pred : Str -> Str -> Str = \f,x -> "onko" ++ x ++ f ;+}
@@ -0,0 +1,7 @@+abstract Calculator = {+flags startcat = Exp ;+cat Exp ;+fun+ EPlus, EMinus, ETimes, EDiv : Exp -> Exp -> Exp ;+ EInt : Int -> Exp ;+}
@@ -0,0 +1,10 @@+concrete CalculatorC of Calculator = open Formal, Prelude in {+lincat + Exp = TermPrec ;+lin+ EPlus = infixl 0 "+" ;+ EMinus = infixl 0 "-" ;+ ETimes = infixl 1 "*" ;+ EDiv = infixl 1 "/" ;+ EInt i = constant i.s ;+}
@@ -0,0 +1,13 @@+concrete CalculatorJ of Calculator = open Prelude in {+lincat + Exp = SS ;+lin+ EPlus = postfix "iadd" ;+ EMinus = postfix "isub" ;+ ETimes = postfix "imul" ;+ EDiv = postfix "idiv" ;+ EInt i = ss ("ldc" ++ i.s) ;+oper+ postfix : Str -> SS -> SS -> SS = \op,x,y -> + ss (x.s ++ ";" ++ y.s ++ ";" ++ op) ;+}
@@ -0,0 +1,14 @@+concrete CalculatorP of Calculator = open Prelude in {++lincat + Exp = SS ;+lin+ EPlus = infix "+" ;+ EMinus = infix "-" ;+ ETimes = infix "*" ;+ EDiv = infix "/" ;+ EInt i = i ;+oper+ infix : Str -> SS -> SS -> SS = \f,x,y -> + ss ("(" ++ x.s ++ f ++ y.s ++ ")") ;+}
@@ -0,0 +1,11 @@+concrete CalculatorS of Calculator = open Prelude in {+ lin+ EPlus = infix "plus" ;+ EMinus = infix "minus" ;+ ETimes = infix "times" ;+ EDiv = infix ["divided by"] ;+ EInt i = i ;+ oper+ infix : Str -> SS -> SS -> SS = \op,x,y -> + ss (x.s ++ op ++ y.s ++ "PAUSE") ;+}
@@ -0,0 +1,7 @@+abstract Geometry = Logic ** {+fun+ Line, Point, Circle : Dom ;+ Intersect, Parallel : Ind -> Ind -> Atom ;+ Vertical : Ind -> Atom ;+ Centre : Ind -> Ind ;+}
@@ -0,0 +1,13 @@+--# -path=.:present++concrete GeometryEng of Geometry = LogicEng ** + open SyntaxEng, ParadigmsEng in {+lin+ Line = mkCN (mkN "line") ;+ Point = mkCN (mkN "point") ; + Circle = mkCN (mkN "circle") ;+ Intersect = pred (mkV2 "intersect") ;+ Parallel = pred (mkA2 (mkA "parallel") (mkPrep "to")) ;+ Vertical = pred (mkA "vertical") ;+ Centre = app (mkN2 (mkN "centre") (mkPrep "of")) ;+}
@@ -0,0 +1,11 @@+concrete GeometryEng of Geometry = LogicEng ** + open SyntaxEng, ParadigmsEng in {+lin+ Line = mkN "line" ;+ Point = mkN "point" ; + Circle = mkN "circle" ;+ Intersect = pred (mkV2 "intersect") ;+ Parallel = pred (mkA2 (mkA "parallel") (mkPrep "to")) ;+ Vertical = pred (mkA "vertical") ;+ Centre = app (mkN2 (mkN "centre") (mkPrep "of")) ;+}
@@ -0,0 +1,7 @@+abstract Geometry = Logic ** {+fun+ Line, Point, Circle : Dom ;+ Intersect, Parallel : Ind -> Ind -> Prop ;+ Vertical : Ind -> Prop ;+ Centre : Ind -> Ind ;+}
@@ -0,0 +1,7 @@+-- (c) Krasimir Angelov 2009+abstract Graftal = {+ cat N; S;+ fun z : N ;+ s : N -> N ;+ c : N -> S ;+ }
@@ -0,0 +1,21 @@+abstract Logic = {+flags startcat = Stm ;+cat+ Stm ; -- top-level statement + Prop ; -- proposition + Atom ; -- atomic formula+ Ind ; -- individual term + Dom ; -- domain expression+ Var ; -- variable+ [Prop] {2} ; -- list of propositions, 2 or more+ [Var] {1} ; -- list of variables, 1 or more+fun+ SProp : Prop -> Stm ;+ And, Or : [Prop] -> Prop ;+ If : Prop -> Prop -> Prop ;+ Not : Prop -> Prop ;+ PAtom : Atom -> Prop ;+ All, Exist : [Var] -> Dom -> Prop -> Prop ;+ IVar : Var -> Ind ;+ VString : String -> Var ;+}
@@ -0,0 +1,38 @@+concrete LogicEng of Logic = open + SyntaxEng, (P = ParadigmsEng), SymbolicEng, Prelude in {+lincat+ Stm = Text ;+ Prop = S ;+ Atom = Cl ; + Ind = NP ; + Dom = CN ; + Var = NP ; + [Prop] = [S] ; + [Var] = NP ; +lin+ SProp = mkText ;+ And = mkS and_Conj ; -- A, B ... and C+ Or = mkS or_Conj ; -- A, B ... or C+ If A B = -- if A B+ mkS (mkAdv if_Subj A) B ; + Not A = -- it is not the case that A+ mkS negativePol (mkCl + (mkVP (mkNP the_Quant + (mkCN case_CN A)))) ; + All xs A B = -- for all A's xs, B+ mkS (mkAdv for_Prep + (mkNP all_Predet (mkNP a_Quant + plNum (mkCN A xs)))) B ;+ Exist xs A B = -- for some A's xs, B+ mkS (mkAdv for_Prep + (mkNP somePl_Det (mkCN A xs))) B ;+ PAtom = mkS ;+ IVar x = x ;+ VString s = symb s ;+ BaseProp A B = mkListS A B ; + ConsProp A As = mkListS A As ;+ BaseVar x = x ;+ ConsVar x xs = mkNP and_Conj (mkListNP x xs) ;+oper+ case_CN : CN = mkCN (P.mkN "case") ;+}
@@ -0,0 +1,39 @@+concrete LogicEng of Logic = open + SyntaxEng, (P = ParadigmsEng), SymbolicEng, Prelude in {+lincat+ Stm = Text ;+ Prop = {pos,neg : S ; isAtom : Bool} ; + Atom = Cl ; + Ind = NP ; + Dom = CN ; + Var = NP ; + [Prop] = ListS ; + [Var] = NP ; +lin+ SProp p = mkText p.pos ;+ And ps = complexProp (mkS and_Conj ps) ;+ Or ps = complexProp (mkS or_Conj ps) ;+ If A B = complexProp (mkS if_then_Conj (mkListS A.pos B.pos)) ;+ Not A = complexProp A.neg ;+ All xs A B = complexProp (mkS (mkAdv for_Prep + (mkNP all_Predet (mkNP a_Quant plNum (mkCN A xs)))) B.pos) ;+ Exist xs A B = complexProp (mkS (mkAdv for_Prep + (mkNP somePl_Det (mkCN A xs))) B.pos) ;+ PAtom p = + {pos = mkS p ; neg = mkS negativePol p ; isAtom = True} ;+ IVar x = x ;+ VString s = symb s ;+ BaseProp A B = mkListS A.pos B.pos ; + ConsProp A As = mkListS A.pos As ;+ BaseVar x = x ;+ ConsVar x xs = mkNP and_Conj (mkListNP x xs) ;+oper + complexProp : S -> {pos,neg : S ; isAtom : Bool} = \s -> {+ pos = s ; + neg = negS s ; + isAtom = False + } ;+ negS : S -> S = \s -> mkS negativePol (mkCl (mkNP it_Pron) + (mkNP the_Quant (mkCN (mkCN (P.mkN "case")) s))) ; + if_Then_Conj : Conj = P.mkConj "if" "then" ;+}
@@ -0,0 +1,11 @@+abstract Logic = {+cat+ Prop ; Ind ; Dom ; Var ; [Prop] {2} ; [Var] {1} ;+fun+ And, Or : [Prop] -> Prop ;+ If : Prop -> Prop -> Prop ;+ Not : Prop -> Prop ;+ All, Exist : [Var] -> Dom -> Prop -> Prop ;+ IVar : Var -> Ind ;+ VString : String -> Var ;+}
@@ -0,0 +1,16 @@+concrete Sierpinski of Graftal = {+ lincat N = {a : Str; b : Str} ;+ lincat S = {s : Str} ;++ lin z = {a = A; b = B} ;+ lin s x = {+ a = x.b ++ R ++ x.a ++ R ++ x.b ; + b = x.a ++ L ++ x.b ++ L ++ x.a+ } ;+ lin c x = {s = "newpath 300 550 moveto" ++ x.a ++ "stroke showpage"} ;++ oper A : Str = "0 2 rlineto" ;+ oper B : Str = "0 2 rlineto" ;+ oper L : Str = "+60 rotate" ;+ oper R : Str = "-60 rotate" ;+}
@@ -0,0 +1,17 @@+abstract Anaphora = TestSemantics - [she_NP] ** {++cat+ Proof Prop ;++fun+ IfS : (A : S) -> (Proof (iS A) -> S) -> S ;++ AnaNP : (A : CN) -> (a : Ind) -> Proof (iCN A a) -> NP ;++ pe : (B : Ind -> Prop) -> Proof (Exist B) -> Ind ;+ qe : (B : Ind -> Prop) -> (c : Proof (Exist B)) -> Proof (B (pe B c)) ;++ pc : (A,B : Prop) -> Proof (And A B) -> Proof A ;+ qc : (A,B : Prop) -> Proof (And A B) -> Proof B ;++}
@@ -0,0 +1,17 @@+concrete AnaphoraIta of Anaphora = TestSemanticsIta - [she_NP] ** + open ResIta, Prelude, Formal in {++lincat+ Proof = {} ;++lin+ IfS A B = {s = "se" ++ A.s ++ B.s} ;++ AnaNP cn _ _ = case cn.g of {+ Masc => pronNP "lui" "lo" "gli" Masc Sg Per3 ;+ Fem => pronNP "lei" "la" "le" Fem Sg Per3+ } ;++ pe _ _ = constant [] ; ----++}
@@ -0,0 +1,39 @@+abstract Grammar = {++ flags startcat = S ;++ cat + S ; Cl ; NP ; VP ; AP ; CN ; + Det ; N ; A ; V ; V2 ; AdA ; + Tense ; Pol ;+ Conj ;+ data+ UseCl : Tense -> Pol -> Cl -> S ;+ PredVP : NP -> VP -> Cl ;+ ComplV2 : V2 -> NP -> VP ;+ DetCN : Det -> CN -> NP ;+ ModCN : AP -> CN -> CN ;++ CompAP : AP -> VP ;+ AdAP : AdA -> AP -> AP ;++ ConjS : Conj -> S -> S -> S ;+ ConjNP : Conj -> NP -> NP -> NP ;++ UseV : V -> VP ;+ UseN : N -> CN ;+ UseA : A -> AP ;++ a_Det, the_Det, every_Det : Det ;+ this_Det, these_Det : Det ;+ that_Det, those_Det : Det ;+ i_NP, she_NP, we_NP : NP ;+ very_AdA : AdA ;++ Pos, Neg : Pol ;+ Pres, Perf : Tense ;++ and_Conj, or_Conj : Conj ;++ +}
@@ -0,0 +1,141 @@+concrete GrammarIta of Grammar = open ResIta, Prelude in {+ lincat + S = {s : Str} ;+ Cl = {s : ResIta.Tense => Bool => Str} ; + NP = ResIta.NP ; + -- {s : Case => {clit,obj : Str ; isClit : Bool} ; a : Agr} ; + VP = ResIta.VP ; + -- {v : Verb ; clit : Str ; clitAgr : ClitAgr ; obj : Agr => Str} ;+ AP = {s : Gender => Number => Str ; isPre : Bool} ;+ CN = Noun ; -- {s : Number => Str ; g : Gender} ;+ Det = {s : Gender => Case => Str ; n : Number} ;+ N = Noun ; -- {s : Number => Str ; g : Gender} ;+ A = Adj ; -- {s : Gender => Number => Str ; isPre : Bool} ;+ V = Verb ; -- {s : VForm => Str ; aux : Aux} ;+ V2 = Verb ** {c : Case} ;+ AdA = {s : Str} ;+ Pol = {s : Str ; b : Bool} ;+ Tense = {s : Str ; t : ResIta.Tense} ;+ Conj = {s : Str ; n : Number} ;+ lin+ UseCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! p.b} ; + PredVP np vp = + let + subj = (np.s ! Nom).obj ;+ obj = vp.obj ! np.a ;+ clit = vp.clit ;+ verb = table {+ Pres => agrV vp.v np.a ;+ Perf => agrV (auxVerb vp.v.aux) np.a ++ agrPart vp.v np.a vp.clitAgr+ }+ in {+ s = \\t,b => subj ++ neg b ++ clit ++ verb ! t ++ obj+ } ;++ ComplV2 v2 np = + let+ nps = np.s ! v2.c+ in {+ v = v2 ; + clit = nps.clit ; + clitAgr = case <nps.isClit,v2.c> of {+ <True,Acc> => CAgr np.a ;+ _ => CAgrNo+ } ;+ obj = \\_ => nps.obj+ } ;++ UseV v = {+ v = v ; + clit = [] ; + clitAgr = CAgrNo ;+ obj = \\_ => []+ } ;++ DetCN det cn = {+ s = \\c => {+ obj = det.s ! cn.g ! c ++ cn.s ! det.n ; + clit = [] ; + isClit = False+ } ;+ a = Ag cn.g det.n Per3+ } ;++ ModCN ap cn = {+ s = \\n => preOrPost ap.isPre (ap.s ! cn.g ! n) (cn.s ! n) ;+ g = cn.g+ } ;++ CompAP ap = {+ v = essere_V ; + clit = [] ; + clitAgr = CAgrNo ;+ obj = \\ag => case ag of {+ Ag g n _ => ap.s ! g ! n+ }+ } ;++ AdAP ada ap = {+ s = \\g,n => ada.s ++ ap.s ! g ! n ;+ isPre = ap.isPre ;+ } ;++ ConjNP co nx ny = {+ s = \\c => {+ obj = (nx.s ! c).obj ++ co.s ++ (ny.s ! c).obj ; + clit = [] ; + isClit = False+ } ;+ a = conjAgr co.n nx.a ny.a+ } ;++ ConjS co x y = {s = x.s ++ co.s ++ y.s} ;++ UseN n = n ;++ UseA adj = adj ;++ a_Det = adjDet (mkAdj "un" "una" [] [] True) Sg ;++ every_Det = adjDet (regAdj "ogni") Sg ;++ the_Det = {+ s = table {+ Masc => table {+ Nom | Acc => elisForms "lo" "l'" "il" ;+ Dat => elisForms "allo" "all'" "al"+ } ;+ Fem => table {+ Nom | Acc => elisForms "la" "'l" "la" ;+ Dat => elisForms "alla" "all'" "alla"+ }+ } ;+ n = Sg+ } ;+ + this_Det = adjDet (regAdj "questo") Sg ;+ these_Det = adjDet (regAdj "questo") Pl ;+ that_Det = adjDet quello_A Sg ;+ those_Det = adjDet quello_A Pl ;++ i_NP = pronNP "io" "mi" "mi" Masc Sg Per1 ;+ she_NP = pronNP "lei" "la" "le" Fem Sg Per3 ;+ we_NP = pronNP "noi" "ci" "ci" Masc Pl Per1 ;++ very_AdA = ss "molto" ;++ Pos = {s = [] ; b = True} ;+ Neg = {s = [] ; b = False} ;+ Pres = {s = [] ; t = ResIta.Pres} ;+ Perf = {s = [] ; t = ResIta.Perf} ;++ and_Conj = {s = "e" ; n = Pl} ;+ or_Conj = {s = "o" ; n = Sg} ;++ oper+ quello_A : Adj = mkAdj + (elisForms "quello" "quell'" "quel") "quella"+ (elisForms "quegli" "quegli" "quei") "quelle"+ True ;++}
@@ -0,0 +1,9 @@+abstract Logic = {+ cat+ Prop ; Ind ;+ data+ And, Or, If : Prop -> Prop -> Prop ;+ Not : Prop -> Prop ;+ All, Exist : (Ind -> Prop) -> Prop ;+ Past : Prop -> Prop ;+}
@@ -0,0 +1,54 @@+concrete LogicIta of Logic = GrammarIta ** open ResIta, Formal, Prelude in {+++lincat+ T, I = SS ;+lin+ And x y = infixSS "&" x y ;+ Or x y = infixSS "v" x y ;+ If x y = infixSS "->" x y ;+ Not x = prefixSS "~" x ;+ All P = prefixSS (parenth ("A" ++ P.$0)) P ;+ Exist P = prefixSS (parenth ("E" ++ P.$0)) P ;+ Past P = prefixSS "Past" P ;++lin+ iN f = star (f.s ! Sg) ;+ iA f = star (f.s ! Masc ! Sg) ;+ iV f = star (f.s ! VInf) ;+ iV2 f x y = star (f.s ! VInf) (cc2 x y) ;++oper star : Str -> SS -> SS = \f,x -> prefixSS f (ss (parenth x.s)) ;++{-++lincat+ T, I = TermPrec ;+lin+ And = infixl 2 "&" ;+ Or = infixl 2 "v" ;+ If = infixr 1 "->" ;+-- Not = prefix 3 "~" ;+-- All : (I -> T) -> T ;+-- Exist : (I -> T) -> T ;+-- Past : T -> T ;++lin+ iS : S -> T ;+ iCl : Cl -> T ;+ iNP : NP -> (I -> T) -> T ;+ iVP : VP -> I -> T ;+ iAP : AP -> I -> T ;+ iCN : CN -> I -> T ;+ iDet : Det -> (I -> T) -> (I -> T) -> T ;+ iN : N -> I -> T ;+ iA : A -> I -> T ;+ iV : V -> I -> T ;+ iV2 : V2 -> I -> I -> T ;+ iAdA : AdA -> (I -> T) -> I -> T ;+ iTense : Tense -> T -> T ;+ iPol : Pol -> T -> T ;+ iConj : Conj -> T -> T -> T ;+-}++}
@@ -0,0 +1,13 @@+concrete LogicSymb of Logic = open Formal, Prelude in {++lincat+ Prop, Ind = TermPrec ;+lin+ And = infixl 2 "\\&" ;+ Or = infixl 2 "\\vee" ;+ If = infixr 1 "\\sup" ;+ Not = prefix 3 "\\sim" ;+ All P = prefix 3 (parenth ("\\forall" ++ P.$0)) P ;+ Exist P = prefix 3 (parenth ("\\exists" ++ P.$0)) P ;+ Past = prefix 3 "P" ;+}
@@ -0,0 +1,47 @@+resource ParadigmsIta = GrammarIta [N,A,V] ** + open ResIta, GrammarIta, Prelude in {++oper+ masculine : Gender = Masc ;+ feminine : Gender = Fem ;++ accusative : Case = Acc ;+ dative : Case = Dat ;++ mkN = overload {+ mkN : (vino : Str) -> N + = \n -> lin N (regNoun n) ;+ mkN : (uomo, uomini : Str) -> Gender -> N + = \s,p,g -> lin N (mkNoun s p g) ;+ } ;++ mkA = overload {+ mkA : (nero : Str) -> A + = \a -> lin A (regAdj a) ;+ mkA : (buono,buona,buoni,buone : Str) -> Bool -> A + = \sm,sf,pm,pf,p -> lin A (mkAdj sm sf pm pf False) ;+ } ;++ preA : A -> A+ = \a -> lin A {s = a.s ; isPre = True} ;++ mkV = overload {+ mkV : (finire : Str) -> V + = \v -> lin V (regVerb v) ;+ mkV : (andare,vado,vadi,va,andiamo,andate,vanno,andato : Str) -> V + = \i,p1,p2,p3,p4,p5,p6,p -> lin V (mkVerb i p1 p2 p3 p4 p5 p6 p Avere) ;+ } ;++ essereV : V -> V+ = \v -> lin V {s = v.s ; aux = Essere} ;++ mkV2 = overload {+ mkV2 : Str -> V2+ = \s -> lin V2 (regVerb s ** {c = accusative}) ;+ mkV2 : V -> V2+ = \v -> lin V2 (v ** {c = accusative}) ;+ mkV2 : V -> Case -> V2+ = \v,c -> lin V2 (v ** {c = c}) ;+ } ;++}
@@ -0,0 +1,178 @@+resource ResIta = open Prelude in {++-- parameters++param+ Number = Sg | Pl ;+ Gender = Masc | Fem ;+ Case = Nom | Acc | Dat ;+ Agr = Ag Gender Number Person ;+ Aux = Avere | Essere ;+ Tense = Pres | Perf ;+ Person = Per1 | Per2 | Per3 ;++ VForm = VInf | VPres Number Person | VPart Gender Number ;++ ClitAgr = CAgrNo | CAgr Agr ;++-- parts of speech++oper+ VP = {+ v : Verb ; + clit : Str ; + clitAgr : ClitAgr ; + obj : Agr => Str+ } ;+ NP = {+ s : Case => {clit,obj : Str ; isClit : Bool} ; + a : Agr+ } ; ++-- the preposition word of an abstract case++ prepCase : Case -> Str = \c -> case c of {+ Dat => "a" ;+ _ => []+ } ;++-- for predication++ agrV : Verb -> Agr -> Str = \v,a -> case a of {+ Ag _ n p => v.s ! VPres n p+ } ;++ auxVerb : Aux -> Verb = \a -> case a of {+ Avere => + mkVerb "avere" "ho" "hai" "ha" "abbiamo" "avete" "hanno" "avuto" Avere ;+ Essere => + mkVerb "essere" "sono" "sei" "è" "siamo" "siete" "sono" "stato" Essere+ } ;++ agrPart : Verb -> Agr -> ClitAgr -> Str = \v,a,c -> case v.aux of {+ Avere => case c of {+ CAgr (Ag g n _) => v.s ! VPart g n ;+ _ => v.s ! VPart Masc Sg+ } ;+ Essere => case a of {+ Ag g n _ => v.s ! VPart g n+ }+ } ;++ neg : Bool -> Str = \b -> case b of {True => [] ; False => "non"} ;++ essere_V = auxVerb Essere ;++-- for coordination++ conjAgr : Number -> Agr -> Agr -> Agr = \n,xa,ya -> + let + x = agrFeatures xa ; y = agrFeatures ya+ in Ag + (conjGender x.g y.g) + (conjNumber (conjNumber x.n y.n) n)+ (conjPerson x.p y.p) ;++ agrFeatures : Agr -> {g : Gender ; n : Number ; p : Person} = \a -> + case a of {Ag g n p => {g = g ; n = n ; p = p}} ;++ conjGender : Gender -> Gender -> Gender = \g,h ->+ case g of {Masc => Masc ; _ => h} ;++ conjNumber : Number -> Number -> Number = \m,n ->+ case m of {Pl => Pl ; _ => n} ;++ conjPerson : Person -> Person -> Person = \p,q ->+ case <p,q> of {+ <Per1,_> | <_,Per1> => Per1 ;+ <Per2,_> | <_,Per2> => Per2 ;+ _ => Per3+ } ;++++-- for morphology++ Noun : Type = {s : Number => Str ; g : Gender} ;+ Adj : Type = {s : Gender => Number => Str ; isPre : Bool} ;+ Verb : Type = {s : VForm => Str ; aux : Aux} ;++ mkNoun : Str -> Str -> Gender -> Noun = \vino,vini,g -> {+ s = table {Sg => vino ; Pl => vini} ;+ g = g+ } ;++ regNoun : Str -> Noun = \vino -> case vino of {+ fuo + c@("c"|"g") + "o" => mkNoun vino (fuo + c + "hi") Masc ;+ ol + "io" => mkNoun vino (ol + "i") Masc ;+ vin + "o" => mkNoun vino (vin + "i") Masc ;+ cas + "a" => mkNoun vino (cas + "e") Fem ;+ pan + "e" => mkNoun vino (pan + "i") Masc ;+ _ => mkNoun vino vino Masc + } ;++ mkAdj : (_,_,_,_ : Str) -> Bool -> Adj = \buono,buona,buoni,buone,p -> {+ s = table {+ Masc => table {Sg => buono ; Pl => buoni} ;+ Fem => table {Sg => buona ; Pl => buone}+ } ;+ isPre = p+ } ;++ regAdj : Str -> Adj = \nero -> case nero of {+ ner + "o" => mkAdj nero (ner + "a") (ner + "i") (ner + "e") False ;+ verd + "e" => mkAdj nero nero (verd + "i") (verd + "i") False ;+ _ => mkAdj nero nero nero nero False+ } ;++ mkVerb : (_,_,_,_,_,_,_,_ : Str) -> Aux -> Verb = + \amare,amo,ami,ama,amiamo,amate,amano,amato,aux -> {+ s = table {+ VInf => amare ;+ VPres Sg Per1 => amo ;+ VPres Sg Per2 => ami ;+ VPres Sg Per3 => ama ;+ VPres Pl Per1 => amiamo ;+ VPres Pl Per2 => amate ;+ VPres Pl Per3 => amano ;+ VPart g n => (regAdj amato).s ! g ! n+ } ;+ aux = aux+ } ;++ regVerb : Str -> Verb = \amare -> case amare of {+ am + "are" => mkVerb amare (am+"o") (am+"i") (am+"a") + (am+"iamo") (am+"ate") (am+"ano") (am+"ato") Avere ;+ tem + "ere" => mkVerb amare (tem+"o") (tem+"i") (tem+"e") + (tem+"iamo") (tem+"ete") (tem+"ono") (tem+"uto") Avere ;+ fin + "ire" => mkVerb amare (fin+"isco") (fin+"isci") (fin+"isce") + (fin+"iamo") (fin+"ite") (fin+"iscono") (fin+"ito") Avere+ } ; ++-- for structural words++ adjDet : Adj -> Number -> {s : Gender => Case => Str ; n : Number} = + \adj,n -> {+ s = \\g,c => prepCase c ++ adj.s ! g ! n ;+ n = n+ } ;++ pronNP : (s,a,d : Str) -> Gender -> Number -> Person -> NP = + \s,a,d,g,n,p -> {+ s = table {+ Nom => {clit = [] ; obj = s ; isClit = False} ;+ Acc => {clit = a ; obj = [] ; isClit = True} ;+ Dat => {clit = d ; obj = [] ; isClit = True}+ } ;+ a = Ag g n p+ } ;++-- phonological auxiliaries++ vowel : pattern Str = #("a" | "e" | "i" | "o" | "u" | "h") ;+ s_impuro : pattern Str = #("z" | "s" + ("b"|"c"|"d"|"f"|"m"|"p"|"q"|"t")) ;++ elisForms : (_,_,_ : Str) -> Str = \lo,l',il ->+ pre {#s_impuro => lo ; #vowel => l' ; _ => il} ;++}
@@ -0,0 +1,39 @@+abstract Semantics = Grammar, Logic ** {+fun+ iS : S -> Prop ;+ iCl : Cl -> Prop ;+ iNP : NP -> (Ind -> Prop) -> Prop ;+ iVP : VP -> Ind -> Prop ;+ iAP : AP -> Ind -> Prop ;+ iCN : CN -> Ind -> Prop ;+ iDet : Det -> (Ind -> Prop) -> (Ind -> Prop) -> Prop ;+ iN : N -> Ind -> Prop ;+ iA : A -> Ind -> Prop ;+ iV : V -> Ind -> Prop ;+ iV2 : V2 -> Ind -> Ind -> Prop ;+ iAdA : AdA -> (Ind -> Prop) -> Ind -> Prop ;+ iTense : Tense -> Prop -> Prop ;+ iPol : Pol -> Prop -> Prop ;+ iConj : Conj -> Prop -> Prop -> Prop ;+def+ iS (UseCl t p cl) = iTense t (iPol p (iCl cl)) ;+ iCl (PredVP np vp) = iNP np (iVP vp) ;+ iVP (ComplV2 v2 np) i = iNP np (iV2 v2 i) ;+ iNP (DetCN det cn) f = iDet det (iCN cn) f ;+ iCN (ModCN ap cn) i = And (iAP ap i) (iCN cn i) ;+ iVP (CompAP ap) i = iAP ap i ;+ iAP (AdAP ada ap) i = iAdA ada (iAP ap) i ;+ iS (ConjS conj x y) = iConj conj (iS x) (iS y) ;+ iNP (ConjNP conj x y) f = iConj conj (iNP x f) (iNP y f) ;+ iVP (UseV v) i = iV v i ;+ iAP (UseA a) i = iA a i ;+ iCN (UseN n) i = iN n i ;+ iDet a_Det d f = Exist (\x -> And (d x) (f x)) ;+ iDet every_Det d f = All (\x -> If (d x) (f x)) ;+ iPol Pos t = t ;+ iPol Neg t = Not t ;+ iTense Pres t = t ;+ iTense Perf t = Past t ;+ iConj and_Conj a b = And a b ;+ iConj or_Conj a b = Or a b ;+}
@@ -0,0 +1,42 @@+concrete SemanticsIta of Semantics = GrammarIta, LogicSymb ** open ResIta, Formal, Prelude in {++lin+ iN f = star (f.s ! Sg) ;+ iA f = star (f.s ! Masc ! Sg) ;+ iV f = star (f.s ! VInf) ;+ iV2 f x y = star (f.s ! VInf) (cc2 x y) ;++oper star : Str -> SS -> TermPrec = \f,x -> prefix 3 (f ++ "*") (constant (parenth x.s)) ;++{-++lincat+ T, I = TermPrec ;+lin+ And = infixl 2 "&" ;+ Or = infixl 2 "v" ;+ If = infixr 1 "->" ;+-- Not = prefix 3 "~" ;+-- All : (I -> T) -> T ;+-- Exist : (I -> T) -> T ;+-- Past : T -> T ;++lin+ iS : S -> T ;+ iCl : Cl -> T ;+ iNP : NP -> (I -> T) -> T ;+ iVP : VP -> I -> T ;+ iAP : AP -> I -> T ;+ iCN : CN -> I -> T ;+ iDet : Det -> (I -> T) -> (I -> T) -> T ;+ iN : N -> I -> T ;+ iA : A -> I -> T ;+ iV : V -> I -> T ;+ iV2 : V2 -> I -> I -> T ;+ iAdA : AdA -> (I -> T) -> I -> T ;+ iTense : Tense -> T -> T ;+ iPol : Pol -> T -> T ;+ iConj : Conj -> T -> T -> T ;+-}++}
@@ -0,0 +1,47 @@+interface Syntax = Grammar - + [UseCl,PredVP,ComplV2,UseV,DetCN,ModCN,CompAP,AdAP,+ ConjS,ConjNP,UseN,UseA,Pres,Perf,Pos,Neg] **+ open Grammar in {++oper+ mkS = overload {+ mkS : Cl -> S = UseCl Pres Pos ;+ mkS : Tense -> Cl -> S = \t -> UseCl t Pos ;+ mkS : Pol -> Cl -> S = UseCl Pres ;+ mkS : Tense -> Pol -> Cl -> S = UseCl ;+ mkS : Conj -> S -> S -> S = ConjS ;+ } ;++ mkCl = overload {+ mkCl : NP -> V -> Cl = \np,v -> PredVP np (UseV v) ;+ mkCl : NP -> V2 -> NP -> Cl = \np,v,o -> PredVP np (ComplV2 v o) ;+ mkCl : NP -> A -> Cl = \np,a -> PredVP np (CompAP (UseA a)) ;+ mkCl : NP -> AP -> Cl = \np,ap -> PredVP np (CompAP ap) ;+ mkCl : NP -> VP -> Cl = PredVP ;+ } ;++ mkAP = overload {+ mkAP : A -> AP = UseA ;+ mkAP : AdA -> AP -> AP = AdAP ;+ } ;++ mkNP = overload {+ mkNP : Det -> N -> NP = \d,n -> DetCN d (UseN n) ;+ mkNP : Det -> CN -> NP = \d,n -> DetCN d n ;+ mkNP : Conj -> NP -> NP -> NP = ConjNP ;+ } ;++ mkCN = overload {+ mkCN : N -> CN = UseN ;+ mkCN : A -> N -> CN = \a,n -> ModCN (UseA a) (UseN n) ; + mkCN : A -> CN -> CN = \a,n -> ModCN (UseA a) n ; + mkCN : AP -> N -> CN = \a,n -> ModCN a (UseN n) ; + mkCN : AP -> CN -> CN = \a,n -> ModCN a n ; + } ;++ presTense : Tense = Pres ;+ perfTense : Tense = Perf ;+ posPol : Pol = Pos ;+ negPol : Pol = Neg ;++}
@@ -0,0 +1,3 @@+instance SyntaxIta of Syntax = GrammarIta - + [PredVP,ComplV2,UseV,DetCN,ModCN,CompAP,AdAP,UseN,UseA] **+ open GrammarIta in {} ;
@@ -0,0 +1,9 @@+abstract Test = Grammar ** {++fun+ man_N, woman_N, house_N, tree_N : N ;+ big_A, small_A, green_A : A ;+ walk_V, arrive_V : V ;+ love_V2, please_V2 : V2 ;++} ;
@@ -0,0 +1,17 @@+concrete TestIta of Test = GrammarIta ** open ParadigmsIta in {++lin+ man_N = mkN "uomo" "uomini" masculine ;+ woman_N = mkN "donna" ;+ house_N = mkN "casa" ;+ tree_N = mkN "albero" ;+ big_A = preA (mkA "grande") ;+ small_A = preA (mkA "piccolo") ;+ green_A = mkA "verde" ;+ walk_V = mkV "camminare" ;+ arrive_V = essereV (mkV "arrivare") ;+ love_V2 = mkV2 "amare" ;+ please_V2 = mkV2 (essereV (mkV "piacere" "piaccio" "piaci" "piace" + "piacciamo" "piacete" "piacciono" "piaciuto")) dative ;++} ;
@@ -0,0 +1,1 @@+abstract TestSemantics = Test, Semantics ;
@@ -0,0 +1,1 @@+concrete TestSemanticsIta of TestSemantics = TestIta, SemanticsIta ;
@@ -0,0 +1,20 @@+abstract Grammar = {++cat + Cl ; NP ; VP ; AP ; CN ; Det ; N ; A ; V ; V2 ;++fun+ PredVP : NP -> VP -> Cl ;+ ComplV2 : V2 -> NP -> VP ;+ DetCN : Det -> CN -> NP ; + ModCN : CN -> AP -> CN ;++ UseV : V -> VP ;+ UseN : N -> CN ;+ UseA : A -> AP ;++ a_Det, the_Det : Det ;+ this_Det, these_Det : Det ;+ i_NP, she_NP, we_NP : NP ;++}
@@ -0,0 +1,97 @@+--# -path=alltenses++concrete GrammarHeb of Grammar = open ResHeb, Prelude in {++ lincat ++ Cl = {s : ResHeb.Tense => Str} ; + VP = ResHeb.VP ; -- {v : Verb ; obj : Str} ;+ NP = ResHeb.NP ; -- {s : Case => {obj : Str} ; a : Agr ; isDef : Bool ; sp : Species} ;+ AP = {s : Number => Species => Gender => Str } ; + CN = ResHeb.Noun ; -- {s : Number => Species => Str ; g: Gender} ;+ Det = {s : Gender => Str ; n : Number ; sp : Species; isDef : Bool} ; + N = ResHeb.Noun ; -- {s : Number => Species => Str ; g: Gender } ;+ A = ResHeb.Adj ; -- {s : Number => Species => Gender => Str} ; + V = ResHeb.Verb ; -- {s : Tense => VPerNumGen => Str } ;+ V2 = ResHeb.Verb2 ; -- Verb ** {c : Case} ; ++ lin++-- predication++ PredVP np vp = + let + subj = (np.s ! Nom ).obj ;+ obj = vp.obj+ in {+ s = \\t => subj ++ (agrV vp.v t np.a) ++ obj } ;+++ ComplV2 v2 np = + let+ nps = np.s ! v2.c + in {+ v = {s = v2.s } ;+ obj = case <np.isDef> of + { <True> => "At" ++ nps.obj; -- direct objects require the object marker 'et' and must be in definite form+ _ => nps.obj } + } ; +++-- determination+-- ha-Aysh ha-zwt : this woman +-- ha-bait : the house+-- ha-bait ha-ze : this house+-- ha-bait ha-yarok ha-ze : this green house ++ DetCN det cn = {+ s = \\c => {obj = cn.s ! det.n ! det.sp ++ det.s ! cn.g } ;+ isDef = det.isDef ;+ sp = det.sp ;+ a = Ag cn.g det.n Per3 + } ;+ + ModCN cn ap = {+ s = \\sp => table {n => cn.s ! sp ! n ++ ap.s ! sp ! n ! cn.g} ; + g = cn.g + } ;++ UseV v = { v = v ; obj = [] };++ UseN n = n ; ++ UseA adj = adj ;+ + a_Det = { + s = table { _ => "" } ;+ n = Sg ;+ sp = Indef ;+ isDef = False + } ; + + the_Det = {+ s = table { _ => "" } ;+ n = Sg ;+ sp = Def ;+ isDef = True + } ;++ this_Det = {+ s = table { Masc => "hzh" ; Fem => "hzAt" } ;+ n = Sg ;+ sp = Def ;+ isDef = True + } ;++ these_Det = {+ s = table {_ => "hAlh" } ;+ n = Pl ;+ sp = Def ;+ isDef = True + } ;++ i_NP = pronNP "Any" "Awty" "ly" Masc Sg Per1 ; --both fem and masc+ we_NP = pronNP "AnHnw" "Awtnw" "lnw" Masc Pl Per1; --both fem and masc+ she_NP = pronNP "hyA" "Awth" "lh" Fem Sg Per3 ; +}+
@@ -0,0 +1,41 @@+resource PatternsHeb = {++flags coding=utf8 ;++oper++C1aC2aC3ti = {C1 ="" ; C1C2=""; C2C3 =""; C3="ty"};+C1aC2aC3nu = { C1 = "" ; C1C2=""; C2C3 =""; C3="nw"};+C1aC2aC3ta = { C1 = "" ; C1C2=""; C2C3 =""; C3="ta"}; +C1aC2aC3t = { C1 = "" ; C1C2=""; C2C3 =""; C3="t"}; +C1aC2aC3tem = { C1 = "" ; C1C2=""; C2C3 =""; C3="teM"}; +C1aC2aC3ten = { C1 = "" ; C1C2=""; C2C3 =""; C3="teN"}; +C1aC2aC3 = { C1 = "" ; C1C2=""; C2C3 =""; C3=""}; +C1aC2aC3a = { C1 = "" ; C1C2=""; C2C3 =""; C3="h"}; +C1aC2aC3u = { C1 = "" ; C1C2=""; C2C3 =""; C3="w"}; ++C1oC2eC3 = { C1 = "" ; C1C2="w"; C2C3 =""; C3=""}; +C1oC2eC3et = { C1 = "" ; C1C2="w"; C2C3 =""; C3="t"}; +C1oC2C3im = { C1 = "" ; C1C2="w"; C2C3 =""; C3="yM"}; +C1oC2C3ot = { C1 = "" ; C1C2="w"; C2C3 =""; C3="wt"}; ++eC1C2oC3 = { C1 = "y" ; C1C2=""; C2C3 =""; C3=""}; +niC1C2oC3 = { C1 = "n" ; C1C2=""; C2C3 =""; C3=""};+tiC1C2oC3 = { C1 = "t" ; C1C2=""; C2C3 =""; C3=""};+tiC1C2eC3i = { C1 = "t" ; C1C2=""; C2C3 ="e"; C3="y"};+tiC1C2eC3o = { C1 = "t" ; C1C2=""; C2C3 ="e"; C3="w"};++yiC1C2oC3 = { C1 = "y" ; C1C2=""; C2C3 =""; C3=""};+yiC1C2eC3u = { C1 = "y" ; C1C2=""; C2C3 =""; C3="w"};++hiC1C2aC3ti = {C1 ="h" ; C1C2=""; C2C3 =""; C3="ty"};+hiC1C2aC3nu = { C1 = "h" ; C1C2=""; C2C3 =""; C3="nw"};+hiC1C2aC3ta = { C1 = "h" ; C1C2=""; C2C3 =""; C3="ta"}; +hiC1C2aC3t = { C1 = "h" ; C1C2=""; C2C3 =""; C3="t"}; +hiC1C2aC3tem= { C1 = "h" ; C1C2=""; C2C3 =""; C3="teM"}; +hiC1C2aC3ten = { C1 = "h" ; C1C2=""; C2C3 =""; C3="teN"}; +hiC1C2iC3= { C1 = "h" ; C1C2=""; C2C3 ="y"; C3=""}; +hiC1C2iC3a= { C1 = "h" ; C1C2=""; C2C3 ="y"; C3="h"}; +hiC1C2iC3u = { C1 = "h" ; C1C2=""; C2C3 ="y"; C3="w"}; ++}
@@ -0,0 +1,351 @@+--# -path=alltenses++-- (c) 2011 Dana Dannells+-- Licensed under LGPL+-- Compiled with GF version 3.2++resource ResHeb = open PatternsHeb, Prelude, Predef in {++ flags coding=utf8 ;++param++ Number = Sg | Pl | Dl ;+ Gender = Masc | Fem ;+ Species = Def | Indef ;+ Case = Nom | Acc | Dat ;+ Agr = Ag Gender Number Person;+ Person = Per1 | Per2 | Per3 ;+ Voice = Active | Passive | Reflexive ; + VPerNumGen = Vp1Sg | Vp1Pl | Vp2Sg Gender | Vp2Pl Gender | Vp3Sg Gender | Vp3Pl Gender ;+ Tense = Perf | Part | Imperf ;+++oper+ + VP = {v : Verb ; obj : Str} ; -- obj value to deal with direct objects + NP = {s : Case => {obj : Str} ; a : Agr ; isDef : Bool ; sp : Species };++------------------------------------------------- +-- Auxiliaries+-- Pronouns modify nouns in a noun phrase, they agree +-- in gender and number with the head noun.++ pronNP : (s,a,d : Str) -> Gender -> Number -> Person -> NP =+ \s,a,d,g,n,p -> { + s = + table {+ Nom => {obj = s} ;+ Acc => {obj = a} ;+ Dat => {obj = []}+ };+ isDef = False ;+ sp = Indef ; + a = Ag g n p + } ;++------------------------------------------------- +-- Predication++ agrV : Verb -> Tense -> Agr -> Str = \v,t,a -> case a of {+ Ag g n p => v.s ! t ! (chooseForm g n p) + } ;+ + chooseForm : Gender -> Number -> Person -> VPerNumGen = \g,n,p->+ case <g,n,p> of {+ <_,Sg,Per1> => Vp1Sg;+ <_,Pl,Per1> => Vp1Pl; + <_,Sg,Per2> => Vp2Sg g ; + <_,Pl,Per2> => Vp2Pl g ; + <_,Sg,Per3> => Vp3Sg g ; + <_,Pl,Per3> => Vp3Pl g ;+ _ => Vp3Sg Masc+ };+ +------------------------------------------------- +-- Roots and patterns for verbs ++oper + + Pattern : Type = {C1, C1C2, C2C3, C3 : Str}; + Root : Type = {C1,C2,C3 : Str}; -- most verb roots consist of three consonants+ Root4 : Type = Root ** {C4 : Str}; -- for verb roots with four consonants+++------------------------------------------------- +-- Morphology++oper + + Noun : Type = {s : Number => Species => Str ; g : Gender} ; + Adj : Type = {s : Number => Species => Gender => Str} ; + Verb : Type = {s : Tense => VPerNumGen => Str } ;+ Verb2 : Type = Verb ** {c : Case} ; ++------------------------------------------------- +-- Nouns +-- Nouns have different endings, +-- some are also duals: his- anashim, bait- batim, bat-banot. ++oper ++mkNoun : (bait,batim,batimD : Str) -> Gender -> Noun = \bait,batim,batimD,g -> {+ s = table {+ Sg => table{Indef => bait ; Def => defH bait};+ Pl => table{Indef => batim ; Def => defH batim} ;+ Dl => table{Indef => batimD ; Def => defH batimD}+ };+ g=g ;+ }; ++-- For some nouns it is not possible to infer the gender from the pefix, +-- depending on the gender, a noun can either end with yM or wt. ++regNoun2 : Str -> Gender -> Noun = \root,g -> + case root of {+ heret + c@? => table {+ Masc => mkNoun root (heret + replaceLastLet (c) + "yM" ) ("") g;+ Fem => mkNoun root (heret + replaceLastLet (c) + "wt") ("") g+ } ! g+ } ;+ +-- For regular nouns, it is possible to infer the gender from the pefix.++regNoun : Str -> Noun = + \root -> case root of {+ malc + "h" => mkNoun root (malc + "wt") ("") Fem ;+ mecon + "yt" => mkNoun root (mecon + "ywt") ("") Fem ; -- (it -> iyot) + khan + "wt" => mkNoun root (khan + "ywt") ("") Fem; -- (ut -> uyot) + tsalakh + "t" => mkNoun root (tsalakh + "wt") ("") Fem ; -- (at -> ot)+ _ => mkNoun root (root + "yM") ("") Masc + } ;++mkN = overload {+ mkN : (root: Str) -> Noun = regNoun ;+ mkN : (kaf : Str) -> Gender-> Noun = regNoun2 ; + mkN : (bait, batim : Str) -> Gender -> Noun = \bait,batim -> mkNoun bait batim ""; + mkN : (regel, raglayim, raglaim : Str) -> Gender -> Noun = mkNoun ; + } ;+ +replaceLastLet : Str -> Str = \c -> + case c of {"P" => "p" ; "M" => "m" ; "N" => "n" ; "Z." => "Z" ; "K" => "k"; _ => c} ;+ +------------------------------------------------- +-- Adjectives+-- Adjectives are formed either linearly, +-- by adding a suffix without affecting the stem +-- or discontinuously, by adding feminine or plural marker +-- that requires a shift of stress in the word and certain +-- vowel deletions and modifications. ++oper++regA : Str -> Adj = \root + -> case root of { kaTan + c@? =>+ mkAdj root (kaTan + replaceLastLet (c) + "h") (kaTan ++ replaceLastLet (c) + "yM") (kaTan + replaceLastLet (c) + "wt") + };++regA2 : Str -> Adj = \bwleT+ -> mkAdj bwleT ( bwleT + "t") ( bwleT + "yM" ) (bwleT + "wt" ); + +mkAdj : (_,_,_,_ : Str) -> Adj = \tov,tova,tovim,tovot -> {+ s = table {+ Sg => table { + Indef => table { Masc => tov ; Fem => tova } ; + Def => table { Masc => defH tov ; Fem => defH tova } + } ; + _ => table { + Indef => table {Masc => tovim ; Fem => tovot } ; + Def => table { Masc => defH tovim ; Fem => defH tovot }+ }+ }+ };+++------------------------------------------------- +-- Determination++defH : Str -> Str = \cn ->+ case cn of {_ => "h" + cn}; +++------------------------------------------------- +-- Verbs +-- The way of forming verbs follows the traditional +-- Hebrew pattern group classification, called Binyanim. +-- Each pattern has a three consonant slot structure with special+-- inflectional characteristics. +-- Verbs are formed by a [root + pattern] combination. + +oper++dirV2: Verb -> Verb2 =\v -> + {+ s = v.s ;+ c = Acc + }; + ++mkVPaal : Str -> Verb = \v ->+ let root = getRoot v+ in {s = table { + Perf => table { + Vp1Sg => appPattern root C1aC2aC3ti ;+ Vp1Pl => appPattern root C1aC2aC3nu ;+ + Vp2Sg Masc => appPattern root C1aC2aC3ta ;+ Vp2Sg Fem => appPattern root C1aC2aC3t ;+ Vp2Pl Masc => appPattern root C1aC2aC3tem ;+ Vp2Pl Fem => appPattern root C1aC2aC3ten ;+ + Vp3Sg Masc => appPattern root C1aC2aC3 ;+ Vp3Sg Fem => appPattern root C1aC2aC3a ;+ Vp3Pl Masc => appPattern root C1aC2aC3u ;+ Vp3Pl Fem => appPattern root C1aC2aC3u + } ;++ Part => table { + Vp1Sg => appPattern root C1oC2eC3 ;+ Vp1Pl => appPattern root C1oC2C3im ;+ + Vp2Sg Masc => appPattern root C1oC2eC3 ;+ Vp2Sg Fem => appPattern root C1oC2eC3et ;+ Vp2Pl Masc => appPattern root C1oC2C3im ;+ Vp2Pl Fem => appPattern root C1oC2C3ot ;+ + Vp3Sg Masc => appPattern root C1oC2eC3;+ Vp3Sg Fem => appPattern root C1oC2eC3et ;+ Vp3Pl Masc => appPattern root C1oC2C3im ;+ Vp3Pl Fem => appPattern root C1oC2C3ot+ } ;+ + Imperf => table { + Vp1Sg => appPattern root eC1C2oC3 ;+ Vp1Pl => appPattern root niC1C2oC3 ;+ + Vp2Sg Masc => appPattern root tiC1C2oC3 ;+ Vp2Sg Fem => appPattern root tiC1C2eC3i ;+ Vp2Pl Masc => appPattern root tiC1C2eC3o ;+ Vp2Pl Fem => appPattern root tiC1C2eC3o ;+ + Vp3Sg Masc => appPattern root yiC1C2oC3 ;+ Vp3Sg Fem => appPattern root tiC1C2oC3 ;+ Vp3Pl Masc => appPattern root yiC1C2eC3u ;+ Vp3Pl Fem => appPattern root yiC1C2eC3u + } + }+ };+ ++mkVHifhil : Str -> Verb = \v ->+ let root = getRoot v+ in {s = table { + Perf => table { + Vp1Sg => appPattern root hiC1C2aC3ti ;+ Vp1Pl => appPattern root hiC1C2aC3nu ;+ + Vp2Sg Masc => appPattern root hiC1C2aC3ta ;+ Vp2Sg Fem => appPattern root hiC1C2aC3t ;+ Vp2Pl Masc => appPattern root hiC1C2aC3tem ;+ Vp2Pl Fem => appPattern root hiC1C2aC3ten ;+ + Vp3Sg Masc => appPattern root hiC1C2iC3 ;+ Vp3Sg Fem => appPattern root hiC1C2iC3a ;+ Vp3Pl Masc => appPattern root hiC1C2iC3u ;+ Vp3Pl Fem => appPattern root hiC1C2iC3u + } ;++ Part => table { + Vp1Sg => appPattern root C1oC2eC3 ;+ Vp1Pl => appPattern root C1oC2C3im ;+ + Vp2Sg Masc => appPattern root C1oC2eC3 ;+ Vp2Sg Fem => appPattern root C1oC2eC3et ;+ Vp2Pl Masc => appPattern root C1oC2C3im ;+ Vp2Pl Fem => appPattern root C1oC2C3ot ;+ + Vp3Sg Masc => appPattern root C1oC2eC3;+ Vp3Sg Fem => appPattern root C1oC2eC3et ;+ Vp3Pl Masc => appPattern root C1oC2C3im ;+ Vp3Pl Fem => appPattern root C1oC2C3ot+ };+ Imperf => table { + Vp1Sg => appPattern root eC1C2oC3 ;+ Vp1Pl => appPattern root niC1C2oC3 ;+ + Vp2Sg Masc => appPattern root tiC1C2oC3 ;+ Vp2Sg Fem => appPattern root tiC1C2eC3i ;+ Vp2Pl Masc => appPattern root tiC1C2eC3o ;+ Vp2Pl Fem => appPattern root tiC1C2eC3o ;+ + Vp3Sg Masc => appPattern root yiC1C2oC3 ;+ Vp3Sg Fem => appPattern root tiC1C2oC3 ;+ Vp3Pl Masc => appPattern root yiC1C2eC3u ;+ Vp3Pl Fem => appPattern root yiC1C2eC3u + } + }+ } ;++mkVHifhil2 : Str -> Verb = \v ->+ let root = getRoot v + in {s = table { + Perf => table { + Vp1Sg => appPattern2 root hiC1C2aC3ti ;+ Vp1Pl => appPattern2 root hiC1C2aC3nu ;+ + Vp2Sg Masc => appPattern2 root hiC1C2aC3ta ;+ Vp2Sg Fem => appPattern2 root hiC1C2aC3t ;+ Vp2Pl Masc => appPattern2 root hiC1C2aC3tem ;+ Vp2Pl Fem => appPattern2 root hiC1C2aC3ten ;+ + Vp3Sg Masc => appPattern2 root hiC1C2iC3 ;+ Vp3Sg Fem => appPattern2 root hiC1C2iC3a ;+ Vp3Pl Masc => appPattern2 root hiC1C2iC3u ;+ Vp3Pl Fem => appPattern2 root hiC1C2iC3u + } ;++ Part => table { + Vp1Sg => appPattern2 root C1oC2eC3 ;+ Vp1Pl => appPattern2 root C1oC2C3im ;+ + Vp2Sg Masc => appPattern2 root C1oC2eC3 ;+ Vp2Sg Fem => appPattern2 root C1oC2eC3et ;+ Vp2Pl Masc => appPattern2 root C1oC2C3im ;+ Vp2Pl Fem => appPattern2 root C1oC2C3ot ;+ + Vp3Sg Masc => appPattern2 root C1oC2eC3;+ Vp3Sg Fem => appPattern2 root C1oC2eC3et ;+ Vp3Pl Masc => appPattern2 root C1oC2C3im ;+ Vp3Pl Fem => appPattern2 root C1oC2C3ot+ } ;+ Imperf => table { + Vp1Sg => appPattern2 root eC1C2oC3 ;+ Vp1Pl => appPattern2 root niC1C2oC3 ;+ + Vp2Sg Masc => appPattern2 root tiC1C2oC3 ;+ Vp2Sg Fem => appPattern2 root tiC1C2eC3i ;+ Vp2Pl Masc => appPattern2 root tiC1C2eC3o ;+ Vp2Pl Fem => appPattern2 root tiC1C2eC3o ;+ + Vp3Sg Masc => appPattern2 root yiC1C2oC3 ;+ Vp3Sg Fem => appPattern2 root tiC1C2oC3 ;+ Vp3Pl Masc => appPattern2 root yiC1C2eC3u ;+ Vp3Pl Fem => appPattern2 root yiC1C2eC3u + } + }+ };+ + appPattern : Root -> Pattern -> Str = \r,p ->+ p.C1 + r.C1 + p.C1C2 + r.C2 + p.C2C3 + r.C3 + p.C3 ;++-- remove the first letter+ appPattern2 : Root -> Pattern -> Str = \r,p ->+ p.C1 + p.C1C2 + r.C2 + p.C2C3 + r.C3 + p.C3 ;++ getRoot : Str -> Root = \s -> case s of {+ C1@? + C2@? + C3 => {C1 = C1 ; C2 = C2 ; C3 = C3} ;+ _ => Predef.error ("cannot get root from" ++ s)+ } ;++}
@@ -0,0 +1,11 @@+abstract Test = Grammar ** {+++fun+ + man_N, woman_N, house_N, leg_N, store_N, chair_N, eyes_N, spoon_N: N ;+ big_A, small_A, green_A, delicious_A, italian_A : A ;+ write_V, walk_V, finish_V, arrive_V , express_V: V ;+ love_V2, please_V2 : V2 ;+ +};
@@ -0,0 +1,29 @@+--# -path=alltenses++concrete TestHeb of Test = GrammarHeb ** open ResHeb in {++flags+ coding=utf8 ;++lin+ man_N = mkN "Ays" "AnsyM" Masc;+ woman_N = mkN "Aysh" "nsyM" Fem ;+ house_N = mkN "byt" "btyM" Masc; + leg_N = mkN "rgl" "rglyyM" "rglyyM" Fem; + store_N = mkN "Hnwt" "Hnwywt" Fem;+ chair_N = mkN "kSA" "kSAwt" Masc; + eyes_N = mkN "OyN" "OynyyM" "OynyyM" Fem; + spoon_N = mkN "kP" Fem; + big_A = regA "gdwl";+ small_A = regA "qTN";+ green_A = regA "yrwq";+ delicious_A = regA2 "nhdr"; + italian_A = regA2 "AyTlqy";+ write_V = mkVPaal "ktb" ; + finish_V = mkVPaal "gmr" ; + walk_V = mkVPaal "ZOd" ; + arrive_V = mkVHifhil2 "ngO" ;+ express_V = mkVHifhil2 "nbO" ;+ love_V2 = dirV2 (mkVPaal "Ahb") ;+ please_V2 = dirV2 (mkVPaal "Spq") ;+}
binary file changed (absent → 56576 bytes)
@@ -0,0 +1,139 @@+Grammatical Framework: Programming with Multilingual Grammars+Aarne Ranta++%!style:../css/style.css+%!Encoding:utf8++%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>+%!postproc(html): "#BOOKCOVER" '<center><img style="width: 200px" src="gf-book-cover.png"></center>'+++#BOOKCOVER+++This is the web page of the book +- Aarne Ranta,+ //Grammatical Framework: Programming with Multilingual Grammars//,+ CSLI Publications, + Stanford, + 2011,+ 340 pp,+ ISBN-10: 1-57586-626-9 (Paper), 1-57586-627-7 (Cloth).+++++==Publisher's information==++Publisher's web page (look for "Series" -> "CSLI Studies in Computational Linguistics")++ http://www-csli.stanford.edu/pubs/+++==Order==++Direct order ($32.50 paperback, $70 hardcover):++ http://press.uchicago.edu/ucp/books/book/distributed/G/bo12469871.html++Amazon order USA ($32.50 paperback, $70 hardcover):++ http://www.amazon.com/Grammatical-Framework-Programming-Multilingual-Information/dp/1575866269/ref=sr_1_2?ie=UTF8&qid=1308585697&sr=8-2++Amazon order UK (£21 paperback, £45 hardcover):++ http://www.amazon.co.uk/Grammatical-Framework-Programming-Multilingual-Computational/dp/1575866269/ref=sr_1_6?ie=UTF8&qid=1315580083&sr=8-6+++==Book description==++Grammars of natural languages are complex systems, and their +computer implementation requires both programming skills and +linguistic knowledge, especially when dealing with other languages+than English. This book makes such tasks accessible for a wide +range of programmers. It introduces GF (Grammatical Framework),+which is a programming language designed for writing grammars, which+may moreover address several languages in parallel. +The book shows how to write grammars in GF and use them in applications +such as tourist phrasebooks, spoken dialogue systems, and natural +language interfaces. The examples and exercises address several +languages, and the readers are guided to look at their own languages +from the computational perspective.++With an emphasis on good engineering, the book promotes modularity+and division of labour - in particular, the use of libraries. It +introduces the GF Resource Grammar Library, which currently addresses +16 languages. This number is constantly growing due to contributions +from the international GF community. The library makes it painless to +build applications and to port them to new languages. The book +introduces a wide range of such applications, which run on platforms +ranging from web servers to mobile phones. But the book also gives +guidance for those readers who want to understand the underlying +linguistics and implement resource grammars for new languages.++The book starts with a hands-on tutorial, continues with a selection +of advanced topics, and ends with a complete reference manual +of GF. Requiring very little background knowledge, it is accessible +for second-year students that have experience with computers and an +interest for languages. At the same time, its novel and advanced +material makes it interesting for senior researchers in computer science, +linguistics, and related fields. +++==How to cite==++```+@Book{ranta-2011,+ author = {Aarne Ranta},+ title = {{Grammatical Framework:+ Programming with Multilingual Grammars}},+ publisher = {{CSLI Publications}},+ year = {2011},+ address = "Stanford",+ note = "ISBN-10: 1-57586-626-9 (Paper), 1-57586-627-7 (Cloth)"+}+```++==Table of Contents==++[Detailed Table of Contents toc-gf-book.txt]+++==Supporting material==++[Slides ./gf-book-slides.pdf] for teaching the book chapter by chapter.++[Code examples ./examples]. You can also download the+complete example set as a compressed tar file, +[gf-book-examples.tgz gf-book-examples.tgz].++[GF Web IDE http://www.grammaticalframework.org/demos/gfse/]: +build grammars in the cloud, without installing GF.++Demos +- [on-line translator http://www.grammaticalframework.org:41296/minibar/minibar.html] (Section 7.12)+- [syntax editor http://www.grammaticalframework.org/demos/resource-api/editor.html] (Section 7.13)+- [multimodal dialogue system http://www.youtube.com/watch?v=1bfaYHWS6zU] (Section 7.15)+++Other tutorials:+- [GF Tutorial ../doc/tutorial/gf-tutorial.html]: programmer-oriented,+ covering parts of chapters 2-8 +- [GF Resource Tutorial ../doc/gf-lrec-2010.pdf]: linguist-oriented,+ covering parts of chapters 2-5, 9-10+++[Works mentioned in references http://www.grammaticalframework.org/doc/gf-bibliography.html];+more download links will be added.++[Resource Grammar Library API http://www.grammaticalframework.org/lib/doc/synopsis.html]++[Sources and binaries http://www.grammaticalframework.org/download] +for GF 3.2, which exactly matches the book.++GF Home Page: http://www.grammaticalframework.org/++Author's email: aarne'at'chalmers'dot'se++Author's home page: http://www.cse.chalmers.se/~aarne/+
@@ -0,0 +1,263 @@+1 Introduction+1.1 What this book is about +1.2 How to use this book +1.3 The role of grammars in language processing +1.4 The cost of grammars +1.5 Multilinguality +1.6 Semantic actions and interoperability +1.7 Application grammars and resource grammars +1.8 History of GF and its applications +1.9 Related work ++part I A GF Tutorial++2 Basic concepts of multilingual grammars +2.1 The BNF grammar format +2.2 Using the GF system +2.3 Testing a grammar in the GF system +2.4 A BNF grammar for Italian +2.5 BNF grammars and translation +2.6 Abstract and concrete syntax +2.7 Translating in GF +2.8 The structure of grammar modules +2.9 On the limitations of BNF grammars +2.10 Suppression and metavariables +2.11 Free variation +2.12 Ambiguity +2.13 Remaining problems +2.14 Graph-based visualization and shell escapes +2.15 Lexing and unlexing +2.16 Character encoding ++3 Parameters, tables, and records +3.1 The problem of morphological variation +3.2 Parameters and tables +3.3 Variable vs. inherent features +3.4 Records and record types +3.5 Linearization types and agreement +3.6 Functional programming in GF: operation definitions +3.7 The Food grammar revisited +3.8 Testing inflection and operations in GF +3.9 Partial application +3.10 Discontinuous constituents +3.11 Non-concatenative morphology ++4 Modular and scalable grammar writing +4.1 Reusable resource modules +4.2 Data abstraction +4.3 Case expressions and string matching +4.4 Smart paradigms +4.5 Arabic morphology revisited +4.6 Separating operation types and definitions +4.7 Overloading of operations +4.8 Module extension and inheritance +4.9 Inheritance and opening +4.10 Dependency graphs +4.11 Algebraic datatypes for parameters +4.12 Record extension and subtyping +4.13 Tuples and product types +4.14 Prefix-dependent choices and pattern macros +4.15 Strings at compile time vs. run time ++5 Using the Resource Grammar Library +5.1 The purpose and coverage of the library +5.2 Lexical vs. phrasal rules +5.3 Lexical categories and rules +5.4 Phrasal categories and rules +5.5 The resource API +5.6 The library path +5.7 Example: English +5.8 Functor implementation of multilingual grammars +5.9 Interfaces and instances +5.10 A design pattern for multilingual grammars +5.11 Division of labour revisited +5.12 Overriding a functor +5.13 Compile-time transfer +5.14 The resource grammar as a linguistic ontology +5.15 A tour of the resource API +5.16 Flattening of constructions +5.17 Tense and polarity +5.18 Browsing the library ++6 Semantic actions and conditions in abstract syntax +6.1 GF as a logical framework +6.2 Dependent types +6.3 Selectional restrictions +6.4 Polymorphism +6.5 Dependent types in concrete syntax +6.6 Proof objects +6.7 Proof-carrying documents +6.8 Restricted polymorphism +6.9 Variable bindings and higher-order abstract syntax +6.10 Anaphoric expressions +6.11 Semantic definitions +6.12 Intensional and extensional equality +6.13 Semantic actions and run-time transfer +6.14 Predefined categories +6.15 Probabilistic GF grammars ++part II Larger Grammars and Applications++7 Embedded grammars and code generation +7.1 The portable grammar format +7.2 The embedded interpreter and its API +7.3 Embedded GF applications in Haskell +7.4 The module PGF +7.5 A stand-alone translator +7.6 A translator loop +7.7 A question-answer system +7.8 Exporting GF datatypes +7.9 Putting it all together +7.10 Web server applications +7.11 Embedded grammars in other host languages +7.12 Multilingual syntax editing +7.13 Language models for speech recognition +7.14 Statistical language models +7.15 Multimodal dialogue systems ++8 Interfacing formal and natural languages +8.1 Arithmetic expressions +8.2 Code generation as linearization +8.3 Programs with variables +8.4 The concrete syntax of assignments +8.5 A liberal syntax of variables +8.6 Is GF useful for defining formal languages? +8.7 Natural language generation from logic +8.8 Logical semantics of natural language +8.9 Grammars for fractals ++9 Getting started with resource grammar programming +9.1 Overview +9.2 The miniature resource grammar +9.3 Feature design +9.4 Predication +9.5 Complementation +9.6 Determination +9.7 Modification +9.8 Lexical insertion +9.9 The miniature resource in Italian +9.10 Implementing morphology +9.11 Implementing modification and determination +9.12 Implementing verb phrases and complementation +9.13 Implementing predication +9.14 Implementing the rest +9.15 Coordination and extraction ++10 Extending the Resource Grammar Library +10.1 The module structure of a resource grammar +10.2 Effort statistics +10.3 Workflow for a new language +10.4 Reusing code from the miniature resource +10.5 The development-test cycle +10.6 Non-ASCII alphabets and transliterations +10.7 Coding discipline +10.8 Functors in the resource grammar +10.9 Widening the coverage for parsing text +10.10 Bootstrapping a resource lexicon ++A A miniature resource grammar +A.1 Abstract syntax +A.2 Auxiliary resource module for Italian +A.3 Italian concrete syntax +A.4 Morphological paradigms API for Italian +A.5 Test lexicon +A.6 Syntax API ++B A glossary of linguistic terms ++part III GF Reference Manual++C The GF Programming Language ++C.1 Overview of GF +C.2 The module system +C.2.1 Top-level and supplementary module structure +C.2.2 Compilation units +C.2.3 Names +C.2.4 The structure of a module +C.2.5 Module types, headers, and bodies +C.2.6 Digression: the logic of module types +C.2.7 Inheritance +C.2.8 Opening +C.2.9 Name resolution +C.2.10 Functor instantiations +C.2.11 Completeness +C.3 Judgements +C.3.1 Overview of the forms of judgement +C.3.2 Category declarations, cat +C.3.3 Hypotheses and contexts +C.3.4 Function declarations, fun +C.3.5 Function definitions, def +C.3.6 Data constructor declarations, data +C.3.7 The semantic status of an abstract syntax function +C.3.8 Linearization type definitions, lincat +C.3.9 Linearization definitions, lin +C.3.10 Linearization default definitions, lindef +C.3.11 Printname definitions, printname cat/fun +C.3.12 Parameter type definitions, param +C.3.13 Parameter values +C.3.14 Operation definitions, oper +C.3.15 Operation overloading +C.3.16 Flag definitions, flags +C.4 Types and expressions +C.4.1 Overview of expression forms +C.4.2 The functional fragment: expressions in abstract syntax +C.4.3 List categories +C.4.4 Conversions +C.4.5 Syntax trees +C.4.6 Predefined types in abstract syntax +C.4.7 Overview of expressions in concrete syntax +C.4.8 Values, canonical forms, and run-time variables +C.4.9 Token lists, tokens, and strings +C.4.10 Records and record types +C.4.11 Subtyping +C.4.12 Tables and table types +C.4.13 Pattern matching +C.4.14 Free variation +C.4.15 Local definitions +C.4.16 Function applications in concrete syntax +C.4.17 Reusing top-level grammars as resources +C.4.18 Predefined concrete syntax types +C.4.19 Predefined concrete syntax operations +C.5 Flags and pragmas +C.5.1 Some flags and their values +C.5.2 Compiler pragmas +C.6 The grammar of GF +C.6.1 The lexical structure of GF +C.6.2 The syntactic structure of GF ++D The GF Resource Grammar Library +D.1 The category system +D.1.1 Phrasal and closed lexical categories +D.1.2 Open lexical categories +D.2 Syntax rules +D.2.1 Suprasentential level: texts and utterances +D.2.2 Sentential level: polarity, tense, and mood +D.2.3 Predication, complementation, and extraction +D.2.4 Question and relative clause formation +D.2.5 Interrogative and relative pronouns +D.2.6 Noun phrases and determiners +D.2.7 The numeral system +D.2.8 Common nouns, adjectives, and adverbs +D.2.9 Coordination +D.2.10 Structural words +D.3 Lexical Paradigms +D.3.1 Paradigms for regular words +D.3.2 Paradigms for verb, adjective, and noun subcategories +D.4 Other library modules +D.4.1 The Prelude module +D.4.2 The Formal module +D.4.3 The Symbolic module +D.4.4 The Combinators module ++E The GF Software System +E.1 The GF shell +E.2 The GF batch compiler ++F Bibliography +F.1 Publications on GF +F.2 Background and related work ++Index++
@@ -0,0 +1,349 @@+name: gf+version: 3.10++cabal-version: >= 1.22+build-type: Custom+license: OtherLicense+license-file: LICENSE+category: Natural Language Processing, Compiler+synopsis: Grammatical Framework+description: GF, Grammatical Framework, is a programming language for multilingual grammar applications+homepage: http://www.grammaticalframework.org/+bug-reports: https://github.com/GrammaticalFramework/gf-core/issues+maintainer: Thomas Hallgren+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3++data-dir: src+data-files:+ www/*.html+ www/*.css+ www/P/*.png+ www/gfse/*.html+ www/gfse/*.css+ www/gfse/*.js+ www/gfse/P/*.png+ www/gfse/P/*.jpg+ www/js/*.js+ www/minibar/*.html+ www/minibar/*.css+ www/minibar/*.js+ www/minibar/*.png+ www/syntax-editor/*.html+ www/syntax-editor/*.css+ www/syntax-editor/*.js+ www/TransQuiz/*.html+ www/TransQuiz/*.css+ www/TransQuiz/*.js+ www/TransQuiz/*.png+ www/translator/*.html+ www/translator/*.css+ www/translator/*.js++custom-setup+ setup-depends:+ base,+ Cabal >=1.22.0.0,+ directory,+ filepath,+ process >=1.0.1.1++source-repository head+ type: git+ location: https://github.com/GrammaticalFramework/gf-core.git++flag interrupt+ Description: Enable Ctrl+Break in the shell+ Default: True++flag server+ Description: Include --server mode+ Default: True++flag network-uri+ description: Get Network.URI from the network-uri package+ default: True++--flag new-comp+-- Description: Make -new-comp the default+-- Default: True++flag c-runtime+ Description: Include functionality from the C run-time library (which must be installed already)+ Default: False++Library+ default-language: Haskell2010+ build-depends: base >= 4.6 && <5,+ array,+ containers,+ bytestring,+ utf8-string,+ random,+ pretty,+ mtl,+ exceptions+ hs-source-dirs: src/runtime/haskell++ other-modules:+ -- not really part of GF but I have changed the original binary library+ -- and we have to keep the copy for now.+ Data.Binary+ Data.Binary.Put+ Data.Binary.Get+ Data.Binary.Builder+ Data.Binary.IEEE754++--ghc-options: -fwarn-unused-imports+--if impl(ghc>=7.8)+-- ghc-options: +RTS -A20M -RTS+ ghc-prof-options: -fprof-auto+ extensions:++ exposed-modules:+ PGF+ PGF.Internal+ PGF.Haskell++ other-modules:+ PGF.Data+ PGF.Macros+ PGF.Binary+ PGF.Optimize+ PGF.Printer+ PGF.CId+ PGF.Expr+ PGF.Generate+ PGF.Linearize+ PGF.Morphology+ PGF.Paraphrase+ PGF.Parse+ PGF.Probabilistic+ PGF.SortTop+ PGF.Tree+ PGF.Type+ PGF.TypeCheck+ PGF.Forest+ PGF.TrieMap+ PGF.VisualizeTree+ PGF.ByteCode+ PGF.OldBinary+ PGF.Utilities++ if flag(c-runtime)+ exposed-modules: PGF2+ other-modules: PGF2.FFI PGF2.Expr PGF2.Type+ GF.Interactive2 GF.Command.Commands2+ hs-source-dirs: src/runtime/haskell-bind+ build-tools: hsc2hs+ extra-libraries: pgf gu+ c-sources: src/runtime/haskell-bind/utils.c+ cc-options: -std=c99++---- GF compiler as a library:++ build-depends: filepath, directory, time, time-compat,+ process, haskeline, parallel>=3++ hs-source-dirs: src/compiler+ exposed-modules:+ GF+ GF.Support+ GF.Text.Pretty+ GF.Text.Lexing++ other-modules:+ GF.Main GF.Compiler GF.Interactive++ GF.Compile GF.CompileInParallel GF.CompileOne GF.Compile.GetGrammar+ GF.Grammar++ GF.Data.Operations GF.Infra.Option GF.Infra.UseIO++ GF.Command.Abstract+ GF.Command.CommandInfo+ GF.Command.Commands+ GF.Command.CommonCommands+ GF.Command.SourceCommands+ GF.Command.Help+ GF.Command.Importing+ GF.Command.Interpreter+ GF.Command.Messages+ GF.Command.Parse+ GF.Command.TreeOperations+ GF.Compile.CFGtoPGF+ GF.Compile.CheckGrammar+ GF.Compile.Compute.AppPredefined+ GF.Compile.Compute.ConcreteNew+-- GF.Compile.Compute.ConcreteNew1+ GF.Compile.Compute.Predef+ GF.Compile.Compute.Value+ GF.Compile.ExampleBased+ GF.Compile.Export+ GF.Compile.GenerateBC+ GF.Compile.GeneratePMCFG+ GF.Compile.GrammarToPGF+ GF.Compile.Multi+ GF.Compile.Optimize+ GF.Compile.PGFtoHaskell+ GF.Compile.PGFtoJava+ GF.Haskell+ GF.Compile.ConcreteToHaskell+ GF.Compile.PGFtoJS+ GF.Compile.PGFtoProlog+ GF.Compile.PGFtoPython+ GF.Compile.ReadFiles+ GF.Compile.Rename+ GF.Compile.SubExOpt+ GF.Compile.Tags+ GF.Compile.ToAPI+ GF.Compile.TypeCheck.Abstract+ GF.Compile.TypeCheck.Concrete+ GF.Compile.TypeCheck.ConcreteNew+ GF.Compile.TypeCheck.Primitives+ GF.Compile.TypeCheck.RConcrete+ GF.Compile.TypeCheck.TC+ GF.Compile.Update+ GF.Data.BacktrackM+ GF.Data.ErrM+ GF.Data.Graph+ GF.Data.Graphviz+ GF.Data.Relation+ GF.Data.Str+ GF.Data.Utilities+ GF.Data.XML+ GF.Grammar.Analyse+ GF.Grammar.Binary+ GF.Grammar.CFG+ GF.Grammar.EBNF+ GF.Grammar.BNFC+ GF.Grammar.Grammar+ GF.Grammar.Lexer+ GF.Grammar.Lockfield+ GF.Grammar.Lookup+ GF.Grammar.Macros+ GF.Grammar.Parser+ GF.Grammar.PatternMatch+ GF.Grammar.Predef+ GF.Grammar.Printer+ GF.Grammar.ShowTerm+ GF.Grammar.Unify+ GF.Grammar.Values+ GF.Infra.BuildInfo+ GF.Infra.CheckM+ GF.Infra.Concurrency+ GF.Infra.Dependencies+ GF.Infra.GetOpt+ GF.Infra.Ident+ GF.Infra.Location+ GF.Infra.SIO+ GF.JavaScript.AbsJS+ GF.JavaScript.PrintJS+ GF.Quiz+ GF.Speech.CFGToFA+ GF.Speech.FiniteState+ GF.Speech.GSL+ GF.Speech.JSGF+ GF.Speech.PGFToCFG+ GF.Speech.PrRegExp+ GF.Speech.RegExp+ GF.Speech.SISR+ GF.Speech.SLF+ GF.Speech.SRG+ GF.Speech.SRGS_ABNF+ GF.Speech.SRGS_XML+ GF.Speech.VoiceXML+ GF.System.Catch+ GF.System.Concurrency+ GF.System.Console+ GF.System.Directory+ GF.System.Process+ GF.System.Signal+ GF.Text.Clitics+ GF.Text.Coding+ GF.Text.Transliterations+ Paths_gf++ if flag(c-runtime)+ cpp-options: -DC_RUNTIME++ if flag(server)+ build-depends: httpd-shed>=0.4.0.3, network>=2.3 && <2.7, json,+ cgi>=3001.2.2.0+ if flag(network-uri)+ build-depends: network-uri>=2.6, network>=2.6+ else+ build-depends: network<2.6++ cpp-options: -DSERVER_MODE+ other-modules:+ GF.Server+ PGFService+ RunHTTP+ SimpleEditor.Convert+ SimpleEditor.JSON+ SimpleEditor.Syntax+ URLEncoding+ CGI+ CGIUtils+ Cache+ Fold+ ExampleDemo+ ExampleService+ hs-source-dirs: src/server src/server/transfer src/example-based++ if flag(interrupt)+ cpp-options: -DUSE_INTERRUPT+ other-modules: GF.System.UseSignal+ else+ other-modules: GF.System.NoSignal++ if impl(ghc>=7.8)+ build-tools: happy>=1.19, alex>=3.1+-- ghc-options: +RTS -A20M -RTS+ else+ build-tools: happy, alex>=3++ ghc-options: -fno-warn-tabs++ if os(windows)+ build-depends: Win32+ else+ build-depends: unix, terminfo>=0.4++ if impl(ghc>=8.2)+ ghc-options: -fhide-source-paths++Executable gf+ hs-source-dirs: src/programs+ main-is: gf-main.hs+ default-language: Haskell2010+ build-depends: gf, base+ ghc-options: -threaded+--ghc-options: -fwarn-unused-imports++ if impl(ghc>=7.0)+ ghc-options: -rtsopts -with-rtsopts=-I5+ if impl(ghc<7.8)+ ghc-options: -with-rtsopts=-K64M++ ghc-prof-options: -auto-all++ if impl(ghc>=8.2)+ ghc-options: -fhide-source-paths++executable pgf-shell+--if !flag(c-runtime)+ buildable: False+ main-is: pgf-shell.hs+ hs-source-dirs: src/runtime/haskell-bind/examples+ build-depends: gf, base, containers, mtl, lifted-base+ default-language: Haskell2010+ if impl(ghc>=7.0)+ ghc-options: -rtsopts++test-suite gf-tests+ type: exitcode-stdio-1.0+ main-is: run.hs+ hs-source-dirs: testsuite+ build-depends: base>=4.3 && <5, Cabal>=1.8, directory, filepath, process+ default-language: Haskell2010
@@ -0,0 +1,389 @@+<!doctype html>+<html lang="en">+<head>+ <meta charset="utf-8">++ <title>GF - Grammatical Framework</title>+ <meta name="keywords" content="machine translation">++ <meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">+ <link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">+ <link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.4.2/css/all.css" integrity="sha384-/rXc/GQVaYpyDdyxK+ecHPVYJSN9bmVFBvjA/9eOB+pb3F2w2N6fc5qB9Ew5yIns" crossorigin="anonymous">++ <link rel="alternate" href="https://github.com/GrammaticalFramework/gf-core/" title="GF GitHub repository">+</head>++<body>+<div class="container-fluid my-5" style="max-width:1200px">++<div class="text-center">+ <img style="height:250px" src="doc/Logos/gf1.svg" alt="GF Logo">+ <h1 class="display-4" style="text-shadow: 1px 1px 5px #999;">Grammatical Framework</h1>+ <h4 class="text-black-50">A programming language for multilingual grammar applications</h4>+</div>++<div class="row my-4">++ <div class="col-sm-6 col-md-3">+ <h3>Get started</h3>+ <ul>+ <li><a href="https://www.youtube.com/watch?v=x1LFbDQhbso">Google Tech Talk</a></li>+ <li>+ <a href="http://cloud.grammaticalframework.org/">+ GF Cloud+ <img src="http://www.grammaticalframework.org/src/www/P/gf-cloud.png" style="height:30px" class="ml-2">+ </a>+ </li>+ <li><a href="doc/tutorial/gf-tutorial.html">Tutorial</a></li>+ </ul>++ <a href="download/index.html" class="btn btn-primary ml-3">+ <i class="fas fa-download mr-1"></i>+ Download GF+ </a>+ </div>++ <div class="col-sm-6 col-md-3">+ <h3>Learn more</h3>++ <ul>+ <li><a href="gf-book">The GF Book</a></li>+ <li><a href="doc/gf-refman.html">Reference Manual</a></li>+ <li><a href="doc/gf-shell-reference.html">Shell Reference</a></li>+ <li><a href="http://www.molto-project.eu/sites/default/files/MOLTO_D2.3.pdf">Best Practices</a> <small>[PDF]</small></li>+ </ul>++ <a href="lib/doc/synopsis/index.html" class="btn btn-primary ml-3">+ <i class="fab fa-readme mr-1"></i>+ RGL Synopsis+ </a>+ </div>++ <div class="col-sm-6 col-md-3">+ <h3>Develop</h3>+ <ul>+ <li><a href="doc/gf-developers.html">Developers Guide</a></li>+ <!-- <li><a href="/~hallgren/gf-experiment/browse/">Browse Source Code</a></li> -->+ <li><a href="http://hackage.haskell.org/package/gf/docs/PGF.html">PGF library API (Haskell runtime)</a></li>+ <li><a href="doc/runtime-api.html">PGF library API (C runtime)</a></li>+ <li><a href="http://hackage.haskell.org/package/gf/docs/GF.html">GF compiler API</a></li>+ <!-- <li><a href="src/ui/android/README">GF on Android (new)</a></li>+ <li><a href="/android/">GF on Android (old) </a></li> -->+ <li><a href="doc/gf-editor-modes.html">Text Editor Support</a></li>+ </ul>+ </div>++ <div class="col-sm-6 col-md-3">+ <h3>Contribute</h3>+ <ul>+ <li><a href="http://groups.google.com/group/gf-dev">Mailing List</a></li>+ <li><a href="https://github.com/GrammaticalFramework/gf-core/issues">Issue Tracker</a></li>+ <li><a href="doc/gf-people.html">Authors</a></li>+ <li><a href="http://school.grammaticalframework.org/2018/">Summer School</a></li>+ </ul>+ <a href="https://github.com/GrammaticalFramework/" class="btn btn-primary ml-3">+ <i class="fab fa-github mr-1"></i>+ GF on GitHub+ </a>+ </div>++</div>++<h2>What is GF?</h2>+<p>+GF, Grammatical Framework, is a programming language for+<strong>multilingual grammar applications</strong>. It is+</p>+<ul>+<li>a <strong>special-purpose language for grammars</strong>, like+ <a href="http://dinosaur.compilertools.net/yacc/">YACC</a>,+ <a href="http://www.gnu.org/software/bison/">Bison</a>,+ <a href="http://www.haskell.org/happy/">Happy</a>,+ <a href="http://bnfc.digitalgrammars.com/">BNFC</a>,+ but not restricted to programming languages+</li>+<li>a <strong>functional programming language</strong>, like+ <a href="http://www.haskell.org/">Haskell</a>,+ <a href="http://en.wikipedia.org/wiki/Lisp_(programming_language)">Lisp</a>,+ <a href="http://ocaml.org/">OCaml</a>,+ <a href="http://www.smlnj.org/">SML</a>,+ <a href="http://schemers.org/">Scheme</a>,+ but specialized to grammar writing+</li>+<li>a <strong>development platform for natural language grammars</strong>, like+ <a href="http://moin.delph-in.net/LkbTop">LKB</a>,+ <a href="http://www2.parc.com/isl/groups/nltt/xle/">XLE</a>,+ <a href="http://www.issco.unige.ch/en/research/projects/regulus/news.shtml">Regulus</a>,+ but based on functional programming and type theory+</li>+<li>a <strong>categorial grammar formalism</strong>, like+ <a href="http://www.loria.fr/equipes/calligramme/acg/">ACG</a>,+ <a href="http://openccg.sourceforge.net/">CCG</a>,+ but specialized for multilingual grammars,+</li>+<li>a <strong>logical framework</strong>, like+ <a href="http://wiki.portal.chalmers.se/agda/pmwiki.php">Agda</a>,+ <a href="http://coq.inria.fr/">Coq</a>,+ <a href="http://www.cl.cam.ac.uk/research/hvg/Isabelle/">Isabelle</a>,+ but equipped with concrete syntax in addition to logic+</li>+<li>a <strong>platform for machine translation</strong>, like+ <a href="http://www.statmt.org/moses/">Moses</a>,+ <a href="http://www.apertium.org/">Apertium</a>,+ but based on deep structural analysis (and usually applied for+ limited fragments of language).+</li>+</ul>++<p>+Don't worry if you don't know most of the references above - but if you do know at+least one, it may help you to get a first idea of what GF is.+</p>++<hr>++<div class="row">++ <div class="col-md-6">+ <h2>Applications & Availability</h2>+ <p>+ GF can be used for building+ <a href="http://cloud.grammaticalframework.org/translator/">translation systems</a>,+ <a href="http://cloud.grammaticalframework.org/minibar/minibar.html">multilingual web gadgets</a>,+ <a href="http://www.cs.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">natural-language interfaces</a>,+ <a href="http://www.youtube.com/watch?v=1bfaYHWS6zU">dialogue systems</a>, and+ <a href="lib/doc/synopsis/index.html">natural language resources</a>.+ </p>++ <p>+ GF is <strong>open-source</strong>, licensed under <a href="LICENSE">GPL</a> (the program) and+ <a href="LICENSE">LGPL</a> and <a href="LICENSE">BSD</a> (the libraries). It+ is available for+ </p>+ <ul>+ <li>Linux</li>+ <li>macOS</li>+ <li>Windows</li>+ <li>Android mobile platform (via Java; runtime)</li>+ <li>via compilation to JavaScript, almost any platform that has a web browser (runtime)</li>+ </ul>++ <h2>Programming in GF</h2>+ <p>+ GF is easy to learn by following the <a href="doc/tutorial/gf-tutorial.html">tutorial</a>.+ You can write your first translator in 15 minutes.+ </p>+ <p>+ GF has an interactive command interpreter, as well as a batch compiler.+ Grammars can be compiled to parser and translator code in many different+ formats. These components can then be embedded in applications written+ in other programming languages. The formats currently supported are:+ </p>+ <ul>+ <li>Haskell</li>+ <li>Java, in particular the Android platform</li>+ <li>JavaScript</li>+ <li>Speech recognition: HTK/ATK, Nuance, JSGF</li>+ </ul>++ <p>+ The GF programming language is high-level and advanced, featuring:+ </p>+ <ul>+ <li>static type checking</li>+ <li>higher-order functions</li>+ <li>dependent types</li>+ <li>pattern matching with data constructors and regular expressions</li>+ <li>module system with multiple inheritance and parametrized modules</li>+ </ul>++ <h3>Getting help</h3>+ <p>+ If you need some help with GF, the first places to start are the <a href="doc/tutorial/gf-tutorial.html">Tutorial</a> and <a href="doc/gf-refman.html">Reference</a> pages.+ The printed <a href="gf-book">book</a> contains all the material in the tutorial and some extra bits, and is the recommended reference for GF.+ </p>++ <p>+ We run the IRC channel <strong><code>#gf</code></strong> on the Freenode network, where you are welcome to look for help with small questions or just start a general discussion.+ IRC logs (in raw format) are available <a href="http://www.grammaticalframework.org/irc/">here</a>.+ If you have a larger question which the community may benefit from, we recommend you ask it on the <a href="http://groups.google.com/group/gf-dev">mailing list</a>.+ </p>++ </div>++ <div class="col-md-6">+ <h2>News</h2>++ <dl class="row">+ <dt class="col-sm-3 text-center text-nowrap">2018-12-03</dt>+ <dd class="col-sm-9">+ <a href="http://school.grammaticalframework.org/2018/">Sixth GF Summer School</a> in Stellenbosch (South Africa), 3–14 December 2018+ </dd>+ <dt class="col-sm-3 text-center text-nowrap">2018-12-02</dt>+ <dd class="col-sm-9">+ <strong>GF 3.10 released.</strong>+ <!-- <a href="download/release-3.10.html">Release notes</a> -->+ </dd>+ <dt class="col-sm-3 text-center text-nowrap">2018-07-25</dt>+ <dd class="col-sm-9">+ The GF repository has been split in two:+ <a href="https://github.com/GrammaticalFramework/gf-core">gf-core</a> and+ <a href="https://github.com/GrammaticalFramework/gf-rgl">gf-rgl</a>.+ The original <a href="https://github.com/GrammaticalFramework/GF">GF</a> repository is now archived.+ </dd>+ <dt class="col-sm-3 text-center text-nowrap">2017-08-11</dt>+ <dd class="col-sm-9">+ <strong>GF 3.9 released.</strong>+ <a href="download/release-3.9.html">Release notes</a>+ </dd>+ <dt class="col-sm-3 text-center text-nowrap">2017-06-29</dt>+ <dd class="col-sm-9">+ GF is moving to <a href="https://github.com/GrammaticalFramework/GF/">GitHub</a>.</dd>+ <dt class="col-sm-3 text-center text-nowrap">2017-03-13</dt>+ <dd class="col-sm-9">+ <a href="http://school.grammaticalframework.org/2017/">GF Summer School</a> in Riga (Latvia), 14-25 August 2017+ </dd>+ </dl>++ <h2>Projects</h2>+ <p>+ GF was first created in 1998 at+ <a href="http://www.xrce.xerox.com/">Xerox Research Centre Europe</a>,+ Grenoble, in the project+ Multilingual Document Authoring. At Xerox, it was used for prototypes including+ a restaurant phrase book,+ a database query system,+ a formalization of an alarm system instructions with translations to 5 languages, and+ an authoring system for medical drug descriptions.+ </p>+ <p>+ Later projects using GF and involving third parties include, in chronological order:+ </p>+ <ul>+ <li>+ <a href="http://www.cs.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">GF-Alfa</a>:+ natural language interface to formal proofs+ </li>+ <li>+ <a href="http://efficient.citi.tudor.lu/index_noframe.html">Efficient</a>:+ authoring tool for business models.+ </li>+ <li>+ <a href="http://www.key-project.org/">GF-KeY</a>:+ authoring and translation of software specifications+ </li>+ <li>+ <a href="http://www.talk-project.org">TALK</a>:+ multilingual and multimodal spoken dialogue systems+ </li>+ <li>+ <a href="http://webalt.math.helsinki.fi/">WebALT</a>:+ multilingual generation of mathematical exercises (commercial project)+ </li>+ <li>+ <a href="http://spraakbanken.gu.se/sal/">SALDO</a>:+ Swedish morphological dictionary based on rules developed for GF and+ <a href="http://www.cse.chalmers.se/alumni/markus/FM/">Functional Morphology</a>+ </li>+ <li>+ <a href="http://www.molto-project.eu">MOLTO</a>:+ multilingual online translation+ </li>+ <li>+ <a href="http://remu.grammaticalframework.org">REMU</a>:+ reliable multilingual digital communication+ </li>+ </ul>+ <!-- <p>+ Here is a <a+ href="http://videos.xrce.xerox.com/index.php/videos/index/618">talk+ about GF at XRCE</a>,+ 14 years later.+ </p> -->++ <p>+ Academically, GF has been used in at least ten PhD theses and resulted+ in more than a hundred scientific publications.+ <!-- (see <a href="doc/gf-bibliography.html">GF publication list</a>). -->+ </p>++ <h2>Libraries</h2>+ <p>+ Libraries are at the heart of modern software engineering. In natural language+ applications, libraries are a way to cope with thousands of details involved in+ syntax, lexicon, and inflection. The+ <a href="lib/doc/synopsis/index.html">GF resource grammar library</a> has+ support for an increasing number of languages, currently including+ Afrikaans,+ Amharic (partial),+ Arabic (partial),+ Bulgarian,+ Catalan,+ Chinese,+ Danish,+ Dutch,+ English,+ Estonian,+ Finnish,+ French,+ German,+ Greek ancient (partial),+ Greek modern,+ Hebrew (fragments),+ Hindi,+ Interlingua,+ Japanese,+ Italian,+ Latin (fragments),+ Latvian,+ Maltese,+ Mongolian,+ Nepali,+ Norwegian bokmål,+ Norwegian nynorsk,+ Persian,+ Polish,+ Punjabi,+ Romanian,+ Russian,+ Sindhi,+ Slovene (partial),+ Spanish,+ Swahili (fragments),+ Swedish,+ Thai,+ Turkish (fragments),+ Urdu+ </p>++ <p>+ Adding a language to the resource library takes 3 to 9+ months - contributions+ are welcome! You can start with the <a href="doc/gf-lrec-2010.pdf">resource grammarian's tutorial</a>.+ </p>++ </div><!-- .col-6 -->++</div><!-- .row -->++</div><!-- .container -->++<footer class="bg-light mt-5 py-5">+ <div class="container mb-5">+ <div class="row">+ <div>+ <div>+</footer>++<script type="text/javascript">+var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www.");+document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E"));+</script>+<script type="text/javascript">+try {+var pageTracker = _gat._getTracker("UA-7811807-3");+pageTracker._trackPageview();+} catch(err) {}</script>++</body>+</html>
@@ -0,0 +1,38 @@+-- | GF, the Grammatical Framework, as a library+module GF(+ -- * Command line interface+ module GF.Main,+ module GF.Interactive,+ module GF.Compiler,++ -- * Compiling GF grammars+ module GF.Compile,+ module GF.CompileInParallel,+-- module PF.Compile.Export, -- haddock does the wrong thing with this+ exportPGF,+ module GF.CompileOne,++ -- * Abstract syntax, parsing, pretty printing and serialisation+ module GF.Compile.GetGrammar,+ module GF.Grammar.Grammar,+ module GF.Grammar.Macros,+ module GF.Grammar.Printer,+ module GF.Infra.Ident,+ -- ** Binary serialisation+ module GF.Grammar.Binary+ ) where+import GF.Main+import GF.Compiler+import GF.Interactive++import GF.Compile+import GF.CompileInParallel+import GF.CompileOne+import GF.Compile.Export(exportPGF)++import GF.Compile.GetGrammar+import GF.Grammar.Grammar+import GF.Grammar.Macros+import GF.Grammar.Printer+import GF.Infra.Ident+import GF.Grammar.Binary
@@ -0,0 +1,86 @@+module GF.Command.Abstract(module GF.Command.Abstract,Expr,showExpr,Term) where++import PGF(CId,mkCId,Expr,showExpr)+import GF.Grammar.Grammar(Term)++type Ident = String++type CommandLine = [Pipe]++type Pipe = [Command]++data Command+ = Command Ident [Option] Argument+ deriving (Eq,Ord,Show)++data Option+ = OOpt Ident+ | OFlag Ident Value+ deriving (Eq,Ord,Show)++data Value+ = VId Ident+ | VInt Int+ | VStr String+ deriving (Eq,Ord,Show)++data Argument+ = AExpr Expr+ | ATerm Term+ | ANoArg+ | AMacro Ident+ deriving (Eq,Ord,Show)++valCIdOpts :: String -> CId -> [Option] -> CId+valCIdOpts flag def opts =+ case [v | OFlag f (VId v) <- opts, f == flag] of+ (v:_) -> mkCId v+ _ -> def++valIntOpts :: String -> Int -> [Option] -> Int+valIntOpts flag def opts =+ case [v | OFlag f (VInt v) <- opts, f == flag] of+ (v:_) -> v+ _ -> def++valStrOpts :: String -> String -> [Option] -> String+valStrOpts flag def opts =+ case listFlags flag opts of+ v:_ -> valueString v+ _ -> def++listFlags flag opts = [v | OFlag f v <- opts, f == flag]++valueString v =+ case v of+ VStr v -> v+ VId v -> v+ VInt v -> show v++isOpt :: String -> [Option] -> Bool+isOpt o opts = elem (OOpt o) opts++isFlag :: String -> [Option] -> Bool+isFlag o opts = elem o [x | OFlag x _ <- opts]++optsAndFlags :: [Option] -> ([Option],[Option])+optsAndFlags = foldr add ([],[]) where+ add o (os,fs) = case o of+ OOpt _ -> (o:os,fs)+ OFlag _ _ -> (os,o:fs)++prOpt :: Option -> String+prOpt o = case o of+ OOpt i -> i+ OFlag f x -> f ++ "=" ++ show x++mkOpt :: String -> Option+mkOpt = OOpt++-- abbreviation convention from gf commands+getCommandOp s = case break (=='_') s of+ (a:_,_:b:_) -> [a,b] -- axx_byy --> ab+ _ -> case s of+ [a,b] -> s -- ab --> ab+ a:_ -> [a] -- axx --> a+
@@ -0,0 +1,84 @@+module GF.Command.CommandInfo where+import GF.Command.Abstract(Option,Expr,Term)+import GF.Text.Pretty(render)+import GF.Grammar.Printer() -- instance Pretty Term+import GF.Grammar.Macros(string2term)+import qualified PGF as H(showExpr)+import qualified PGF.Internal as H(Literal(LStr),Expr(ELit)) ----++data CommandInfo m = CommandInfo {+ exec :: [Option] -> CommandArguments -> m CommandOutput,+ synopsis :: String,+ syntax :: String,+ explanation :: String,+ longname :: String,+ options :: [(String,String)],+ flags :: [(String,String)],+ examples :: [(String,String)],+ needsTypeCheck :: Bool+ }++mapCommandExec f c = c { exec = \ opts ts -> f (exec c opts ts) }++--emptyCommandInfo :: CommandInfo env+emptyCommandInfo = CommandInfo {+ exec = error "command not implemented",+ synopsis = "",+ syntax = "",+ explanation = "",+ longname = "",+ options = [],+ flags = [],+ examples = [],+ needsTypeCheck = True+ }+--------------------------------------------------------------------------------++class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr++--------------------------------------------------------------------------------++data CommandArguments = Exprs [Expr] | Strings [String] | Term Term++newtype CommandOutput = Piped (CommandArguments,String) ---- errors, etc++-- ** Converting command output+fromStrings ss = Piped (Strings ss, unlines ss)+fromExprs es = Piped (Exprs es,unlines (map (H.showExpr []) es))+fromString s = Piped (Strings [s], s)+pipeWithMessage es msg = Piped (Exprs es,msg)+pipeMessage msg = Piped (Exprs [],msg)+pipeExprs es = Piped (Exprs es,[]) -- only used in emptyCommandInfo+void = Piped (Exprs [],"")++stringAsExpr = H.ELit . H.LStr -- should be a pattern macro++-- ** Converting command input++toStrings args =+ case args of+ Strings ss -> ss+ Exprs es -> zipWith showAsString (True:repeat False) es+ Term t -> [render t]+ where+ showAsString first t =+ case t of+ H.ELit (H.LStr s) -> s+ _ -> ['\n'|not first] +++ H.showExpr [] t ---newline needed in other cases than the first++toExprs args =+ case args of+ Exprs es -> es+ Strings ss -> map stringAsExpr ss+ Term t -> [stringAsExpr (render t)]++toTerm args =+ case args of+ Term t -> t+ Strings ss -> string2term $ unwords ss -- hmm+ Exprs es -> string2term $ unwords $ map (H.showExpr []) es -- hmm++-- ** Creating documentation++mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl))
@@ -0,0 +1,1020 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module GF.Command.Commands (+ PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,+ options,flags,+ ) where+import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import PGF++import PGF.Internal(lookStartCat,functionsToCat,lookValCat,restrictPGF,hasLin)+import PGF.Internal(abstract,funs,cats,Expr(EFun)) ----+import PGF.Internal(ppFun,ppCat)+import PGF.Internal(optimizePGF)++import GF.Compile.Export+import GF.Compile.ToAPI+import GF.Compile.ExampleBased+import GF.Infra.Option (noOptions, readOutputFormat, outputFormatsExpl)+import GF.Infra.UseIO(writeUTF8File)+import GF.Infra.SIO+import GF.Command.Abstract+import GF.Command.CommandInfo+import GF.Command.CommonCommands+import GF.Text.Clitics+import GF.Quiz++import GF.Command.TreeOperations ---- temporary place for typecheck and compute++import GF.Data.Operations++import PGF.Internal (encodeFile)+import Data.List(intersperse,nub)+import Data.Maybe+import qualified Data.Map as Map+import GF.Text.Pretty+import Data.List (sort)+--import Debug.Trace+++data PGFEnv = Env {pgf::PGF,mos::Map.Map Language Morpho}++pgfEnv pgf = Env pgf mos+ where mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf]++class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv++instance (Monad m,HasPGFEnv m) => TypeCheckArg m where+ typeCheckArg e = (either (fail . render . ppTcError) (return . fst)+ . flip inferExpr e . pgf) =<< getPGFEnv++pgfCommands :: HasPGFEnv m => Map.Map String (CommandInfo m)+pgfCommands = Map.fromList [+ ("aw", emptyCommandInfo {+ longname = "align_words",+ synopsis = "show word alignments between languages graphically",+ explanation = unlines [+ "Prints a set of strings in the .dot format (the graphviz format).",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by 'dot' (graphviz) and displayed by the program indicated",+ "by the view flag. The target format is png, unless overridden by the",+ "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick)."+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ let es = toExprs arg+ let langs = optLangs pgf opts+ if isOpt "giza" opts+ then do+ let giz = map (gizaAlignment pgf (head $ langs, head $ tail $ langs)) es+ let lsrc = unlines $ map (\(x,_,_) -> x) giz+ let ltrg = unlines $ map (\(_,x,_) -> x) giz+ let align = unlines $ map (\(_,_,x) -> x) giz+ let grph = if null es then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align+ return $ fromString grph+ else do+ let grphs = map (graphvizAlignment pgf langs) es+ if isFlag "view" opts || isFlag "format" opts+ then do+ let view = optViewGraph opts+ let format = optViewFormat opts+ viewGraphviz view format "_grpha_" grphs+ else return $ fromString $ unlines grphs,+ examples = [+ ("gr | aw" , "generate a tree and show word alignment as graph script"),+ ("gr | aw -view=\"open\"" , "generate a tree and display alignment on Mac"),+ ("gr | aw -view=\"eog\"" , "generate a tree and display alignment on Ubuntu"),+ ("gt | aw -giza | wf -file=aligns" , "generate trees, send giza alignments to file")+ ],+ options = [+ ("giza", "show alignments in the Giza format; the first two languages")+ ],+ flags = [+ ("format","format of the visualization file (default \"png\")"),+ ("lang", "alignments for this list of languages (default: all)"),+ ("view", "program to open the resulting file")+ ]+ }),+ ("ca", emptyCommandInfo {+ longname = "clitic_analyse",+ synopsis = "print the analyses of all words into stems and clitics",+ explanation = unlines [+ "Analyses all words into all possible combinations of stem + clitics.",+ "The analysis is returned in the format stem &+ clitic1 &+ clitic2 ...",+ "which is hence the inverse of 'pt -bind'. The list of clitics is give",+ "by the flag '-clitics'. The list of stems is given as the list of words",+ "of the language given by the '-lang' flag."+ ],+ exec = getEnv $ \opts ts env -> case opts of+ _ | isOpt "raw" opts ->+ return . fromString .+ unlines . map (unwords . map (concat . intersperse "+")) .+ map (getClitics (isInMorpho (optMorpho env opts)) (optClitics opts)) .+ concatMap words $ toStrings ts+ _ ->+ return . fromStrings .+ getCliticsText (isInMorpho (optMorpho env opts)) (optClitics opts) .+ concatMap words $ toStrings ts,+ flags = [+ ("clitics","the list of possible clitics (comma-separated, no spaces)"),+ ("lang", "the language of analysis")+ ],+ options = [+ ("raw", "analyse each word separately (not suitable input for parser)")+ ],+ examples = [+ mkEx "ca -lang=Fin -clitics=ko,ni \"nukkuuko minun vaimoni\" | p -- to parse Finnish"+ ]+ }),++ ("eb", emptyCommandInfo {+ longname = "example_based",+ syntax = "eb (-probs=FILE | -lang=LANG)* -file=FILE.gfe",+ synopsis = "converts .gfe files to .gf files by parsing examples to trees",+ explanation = unlines [+ "Reads FILE.gfe and writes FILE.gf. Each expression of form",+ "'%ex CAT QUOTEDSTRING' in FILE.gfe is replaced by a syntax tree.",+ "This tree is the first one returned by the parser; a biased ranking",+ "can be used to regulate the order. If there are more than one parses",+ "the rest are shown in comments, with probabilities if the order is biased.",+ "The probabilities flag and configuration file is similar to the commands",+ "gr and rt. Notice that the command doesn't change the environment,",+ "but the resulting .gf file must be imported separately."+ ],+ options = [+ ("api","convert trees to overloaded API expressions (using Syntax not Lang)")+ ],+ flags = [+ ("file","the file to be converted (suffix .gfe must be given)"),+ ("lang","the language in which to parse"),+ ("probs","file with probabilities to rank the parses")+ ],+ exec = getEnv $ \ opts _ env@(Env pgf mos) -> do+ let file = optFile opts+ pgf <- optProbs opts pgf+ let printer = if (isOpt "api" opts) then exprToAPI else (showExpr [])+ let conf = configureExBased pgf (optMorpho env opts) (optLang pgf opts) printer+ (file',ws) <- restricted $ parseExamplesInGrammar conf file+ if null ws then return () else putStrLn ("unknown words: " ++ unwords ws)+ return (fromString ("wrote " ++ file')),+ needsTypeCheck = False+ }),+ ("gr", emptyCommandInfo {+ longname = "generate_random",+ synopsis = "generate random trees in the current abstract syntax",+ syntax = "gr [-cat=CAT] [-number=INT]",+ examples = [+ mkEx "gr -- one tree in the startcat of the current grammar",+ mkEx "gr -cat=NP -number=16 -- 16 trees in the category NP",+ mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha",+ mkEx "gr -probs=FILE -- generate with bias",+ mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))"+ ],+ explanation = unlines [+ "Generates a list of random trees, by default one tree.",+ "If a tree argument is given, the command completes the Tree with values to",+ "all metavariables in the tree. The generation can be biased by probabilities,",+ "given in a file in the -probs flag."+ ],+ flags = [+ ("cat","generation category"),+ ("lang","uses only functions that have linearizations in all these languages"),+ ("number","number of trees generated"),+ ("depth","the maximum generation depth"),+ ("probs", "file with biased probabilities (format 'f 0.4' one by line)")+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ pgf <- optProbs opts (optRestricted opts pgf)+ gen <- newStdGen+ let dp = valIntOpts "depth" 4 opts+ let ts = case mexp (toExprs arg) of+ Just ex -> generateRandomFromDepth gen pgf ex (Just dp)+ Nothing -> generateRandomDepth gen pgf (optType pgf opts) (Just dp)+ returnFromExprs $ take (optNum opts) ts+ }),+ ("gt", emptyCommandInfo {+ longname = "generate_trees",+ synopsis = "generates a list of trees, by default exhaustive",+ explanation = unlines [+ "Generates all trees of a given category. By default, ",+ "the depth is limited to 4, but this can be changed by a flag.",+ "If a Tree argument is given, the command completes the Tree with values",+ "to all metavariables in the tree."+ ],+ flags = [+ ("cat","the generation category"),+ ("depth","the maximum generation depth"),+ ("lang","excludes functions that have no linearization in this language"),+ ("number","the number of trees generated")+ ],+ examples = [+ mkEx "gt -- all trees in the startcat, to depth 4",+ mkEx "gt -cat=NP -number=16 -- 16 trees in the category NP",+ mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2",+ mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))"+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ let pgfr = optRestricted opts pgf+ let dp = valIntOpts "depth" 4 opts+ let ts = case mexp (toExprs arg) of+ Just ex -> generateFromDepth pgfr ex (Just dp)+ Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp)+ returnFromExprs $ take (optNumInf opts) ts+ }),+ ("i", emptyCommandInfo {+ longname = "import",+ synopsis = "import a grammar from source code or compiled .pgf file",+ explanation = unlines [+ "Reads a grammar from File and compiles it into a GF runtime grammar.",+ "If its abstract is different from current state, old modules are discarded.",+ "If its abstract is the same and a concrete with the same name is already in the state",+ "it is overwritten - but only if compilation succeeds.",+ "The grammar parser depends on the file name suffix:",+ " .cf context-free (labelled BNF) source",+ " .ebnf extended BNF source",+ " .gfm multi-module GF source",+ " .gf normal GF source",+ " .gfo compiled GF source",+ " .pgf precompiled grammar in Portable Grammar Format"+ ],+ flags = [+ ("probs","file with biased probabilities for generation")+ ],+ options = [+ -- ["gfo", "src", "no-cpu", "cpu", "quiet", "verbose"]+ ("retain","retain operations (used for cc command)"),+ ("src", "force compilation from source"),+ ("v", "be verbose - show intermediate status information")+ ],+ needsTypeCheck = False+ }),+ ("l", emptyCommandInfo {+ longname = "linearize",+ synopsis = "convert an abstract syntax expression to string",+ explanation = unlines [+ "Shows the linearization of a Tree by the grammars in scope.",+ "The -lang flag can be used to restrict this to fewer languages.",+ "A sequence of string operations (see command ps) can be given",+ "as options, and works then like a pipe to the ps command, except",+ "that it only affect the strings, not e.g. the table labels.",+ "These can be given separately to each language with the unlexer flag",+ "whose results are prepended to the other lexer flags. The value of the",+ "unlexer flag is a space-separated list of comma-separated string operation",+ "sequences; see example."+ ],+ examples = [+ mkEx "l -lang=LangSwe,LangNor no_Utt -- linearize tree to LangSwe and LangNor",+ mkEx "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table",+ mkEx "l -unlexer=\"LangAra=to_arabic LangHin=to_devanagari\" -- different unlexers"+ ],+ exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings . optLins pgf opts $ toExprs ts,+ options = [+ ("all", "show all forms and variants, one by line (cf. l -list)"),+ ("bracket","show tree structure with brackets and paths to nodes"),+ ("groups", "all languages, grouped by lang, remove duplicate strings"),+ ("list","show all forms and variants, comma-separated on one line (cf. l -all)"),+ ("multi","linearize to all languages (default)"),+ ("table","show all forms labelled by parameters"),+ ("tabtreebank","show the tree and its linearizations on a tab-separated line"),+ ("treebank","show the tree and tag linearizations with language names")+ ] ++ stringOpOptions,+ flags = [+ ("lang","the languages of linearization (comma-separated, no spaces)"),+ ("unlexer","set unlexers separately to each language (space-separated)")+ ]+ }),+ ("lc", emptyCommandInfo {+ longname = "linearize_chunks",+ synopsis = "linearize a tree that has metavariables in maximal chunks without them",+ explanation = unlines [+ "A hopefully temporary command, intended to work around the type checker that fails",+ "trees where a function node is a metavariable."+ ],+ examples = [+ mkEx "l -lang=LangSwe,LangNor -chunks ? a b (? c d)"+ ],+ exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings $ optLins pgf (opts ++ [OOpt "chunks"]) (toExprs ts),+ options = [+ ("treebank","show the tree and tag linearizations with language names")+ ] ++ stringOpOptions,+ flags = [+ ("lang","the languages of linearization (comma-separated, no spaces)")+ ],+ needsTypeCheck = False+ }),+ ("ma", emptyCommandInfo {+ longname = "morpho_analyse",+ synopsis = "print the morphological analyses of all words in the string",+ explanation = unlines [+ "Prints all the analyses of space-separated words in the input string,",+ "using the morphological analyser of the actual grammar (see command pg)"+ ],+ exec = getEnv $ \opts ts env -> case opts of+ _ | isOpt "missing" opts ->+ return . fromString . unwords .+ morphoMissing (optMorpho env opts) .+ concatMap words $ toStrings ts+ _ | isOpt "known" opts ->+ return . fromString . unwords .+ morphoKnown (optMorpho env opts) .+ concatMap words $ toStrings ts+ _ -> return . fromString . unlines .+ map prMorphoAnalysis . concatMap (morphos env opts) .+ concatMap words $ toStrings ts,+ flags = [+ ("lang","the languages of analysis (comma-separated, no spaces)")+ ],+ options = [+ ("known", "return only the known words, in order of appearance"),+ ("missing","show the list of unknown words, in order of appearance")+ ]+ }),++ ("mq", emptyCommandInfo {+ longname = "morpho_quiz",+ synopsis = "start a morphology quiz",+ syntax = "mq (-cat=CAT)? (-probs=FILE)? TREE?",+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ let lang = optLang pgf opts+ let typ = optType pgf opts+ pgf <- optProbs opts pgf+ let mt = mexp (toExprs arg)+ restricted $ morphologyQuiz mt pgf lang typ+ return void,+ flags = [+ ("lang","language of the quiz"),+ ("cat","category of the quiz"),+ ("number","maximum number of questions"),+ ("probs","file with biased probabilities for generation")+ ]+ }),++ ("p", emptyCommandInfo {+ longname = "parse",+ synopsis = "parse a string to abstract syntax expression",+ explanation = unlines [+ "Shows all trees returned by parsing a string in the grammars in scope.",+ "The -lang flag can be used to restrict this to fewer languages.",+ "The default start category can be overridden by the -cat flag.",+ "See also the ps command for lexing and character encoding.",+ "",+ "The -openclass flag is experimental and allows some robustness in ",+ "the parser. For example if -openclass=\"A,N,V\" is given, the parser",+ "will accept unknown adjectives, nouns and verbs with the resource grammar."+ ],+ exec = getEnv $ \ opts ts (Env pgf mos) ->+ return $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]),+ flags = [+ ("cat","target category of parsing"),+ ("lang","the languages of parsing (comma-separated, no spaces)"),+ ("openclass","list of open-class categories for robust parsing"),+ ("depth","maximal depth for proof search if the abstract syntax tree has meta variables")+ ],+ options = [+ ("bracket","prints the bracketed string from the parser")+ ]+ }),+ ("pg", emptyCommandInfo { -----+ longname = "print_grammar",+ synopsis = "print the actual grammar with the given printer",+ explanation = unlines [+ "Prints the actual grammar, with all involved languages.",+ "In some printers, this can be restricted to a subset of languages",+ "with the -lang=X,Y flag (comma-separated, no spaces).",+ "The -printer=P flag sets the format in which the grammar is printed.",+ "N.B.1 Since grammars are compiled when imported, this command",+ "generally shows a grammar that looks rather different from the source.",+ "N.B.2 Another way to produce different formats is to use 'gf -make',",+ "the batch compiler. The following values are available both for",+ "the batch compiler (flag -output-format) and the print_grammar",+ "command (flag -printer):",+ ""+ ] ++ unlines (sort [+ " " ++ opt ++ "\t\t" ++ expl |+ ((opt,_),expl) <- outputFormatsExpl, take 1 expl /= "*"+ ]),+ exec = getEnv $ \opts _ env -> prGrammar env opts,+ flags = [+ --"cat",+ ("file", "set the file name when printing with -pgf option"),+ ("lang", "select languages for the some options (default all languages)"),+ ("printer","select the printing format (see flag values above)")+ ],+ options = [+ ("cats", "show just the names of abstract syntax categories"),+ ("fullform", "print the fullform lexicon"),+ ("funs", "show just the names and types of abstract syntax functions"),+ ("langs", "show just the names of top concrete syntax modules"),+ ("lexc", "print the lexicon in Xerox LEXC format"),+ ("missing","show just the names of functions that have no linearization"),+ ("opt", "optimize the generated pgf"),+ ("pgf", "write current pgf image in file"),+ ("words", "print the list of words")+ ],+ examples = [+ mkEx ("pg -funs | ? grep \" S ;\" -- show functions with value cat S")+ ]+ }),+ ("pt", emptyCommandInfo {+ longname = "put_tree",+ syntax = "pt OPT? TREE",+ synopsis = "return a tree, possibly processed with a function",+ explanation = unlines [+ "Returns a tree obtained from its argument tree by applying",+ "tree processing functions in the order given in the command line",+ "option list. Thus 'pt -f -g s' returns g (f s). Typical tree processors",+ "are type checking and semantic computation."+ ],+ examples = [+ mkEx "pt -compute (plus one two) -- compute value"+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) ->+ returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg,+ options = treeOpOptions undefined{-pgf-},+ flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-}+ }),+ ("rf", emptyCommandInfo {+ longname = "read_file",+ synopsis = "read string or tree input from a file",+ explanation = unlines [+ "Reads input from file. The filename must be in double quotes.",+ "The input is interpreted as a string by default, and can hence be",+ "piped e.g. to the parse command. The option -tree interprets the",+ "input as a tree, which can be given e.g. to the linearize command.",+ "The option -lines will result in a list of strings or trees, one by line."+ ],+ options = [+ ("lines","return the list of lines, instead of the singleton of all contents"),+ ("paragraphs","return the list of paragraphs, as separated by empty lines"),+ ("tree","convert strings into trees")+ ],+ exec = getEnv $ \ opts _ (Env pgf mos) -> do+ let file = valStrOpts "file" "_gftmp" opts+ let exprs [] = ([],empty)+ exprs ((n,s):ls) | null s+ = exprs ls+ exprs ((n,s):ls) = case readExpr s of+ Just e -> let (es,err) = exprs ls+ in case inferExpr pgf e of+ Right (e,t) -> (e:es,err)+ Left tcerr -> (es,"on line" <+> n <> ':' $$ nest 2 (ppTcError tcerr) $$ err)+ Nothing -> let (es,err) = exprs ls+ in (es,"on line" <+> n <> ':' <+> "parse error" $$ err)+ returnFromLines ls = case exprs ls of+ (es, err) | null es -> return $ pipeMessage $ render (err $$ "no trees found")+ | otherwise -> return $ pipeWithMessage es (render err)++ s <- restricted $ readFile file+ case opts of+ _ | isOpt "lines" opts && isOpt "tree" opts ->+ returnFromLines (zip [1::Int ..] (lines s))+ _ | isOpt "tree" opts ->+ returnFromLines [(1::Int,s)]+ _ | isOpt "lines" opts -> return (fromStrings $ lines s)+ _ | isOpt "paragraphs" opts -> return (fromStrings $ toParagraphs $ lines s)+ _ -> return (fromString s),+ flags = [("file","the input file name")]+ }),+ ("rt", emptyCommandInfo {+ longname = "rank_trees",+ synopsis = "show trees in an order of decreasing probability",+ explanation = unlines [+ "Order trees from the most to the least probable, using either",+ "even distribution in each category (default) or biased as specified",+ "by the file given by flag -probs=FILE, where each line has the form",+ "'function probability', e.g. 'youPol_Pron 0.01'."+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ let ts = toExprs arg+ pgf <- optProbs opts pgf+ let tds = rankTreesByProbs pgf ts+ if isOpt "v" opts+ then putStrLn $+ unlines [showExpr [] t ++ "\t--" ++ show d | (t,d) <- tds]+ else return ()+ returnFromExprs $ map fst tds,+ flags = [+ ("probs","probabilities from this file (format 'f 0.6' per line)")+ ],+ options = [+ ("v","show all trees with their probability scores")+ ],+ examples = [+ mkEx "p \"you are here\" | rt -probs=probs | pt -number=1 -- most probable result"+ ]+ }),+ ("tq", emptyCommandInfo {+ longname = "translation_quiz",+ syntax = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",+ synopsis = "start a translation quiz",+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ let from = optLangFlag "from" pgf opts+ let to = optLangFlag "to" pgf opts+ let typ = optType pgf opts+ let mt = mexp (toExprs arg)+ pgf <- optProbs opts pgf+ restricted $ translationQuiz mt pgf from to typ+ return void,+ flags = [+ ("from","translate from this language"),+ ("to","translate to this language"),+ ("cat","translate in this category"),+ ("number","the maximum number of questions"),+ ("probs","file with biased probabilities for generation")+ ],+ examples = [+ mkEx ("tq -from=Eng -to=Swe -- any trees in startcat"),+ mkEx ("tq -from=Eng -to=Swe (AdjCN (PositA ?2) (UseN ?)) -- only trees of this form")+ ]+ }),+++ ("vd", emptyCommandInfo {+ longname = "visualize_dependency",+ synopsis = "show word dependency tree graphically",+ explanation = unlines [+ "Prints a dependency tree in the .dot format (the graphviz format, default)",+ "or LaTeX (flag -output=latex)",+ "or the CoNLL/MaltParser format (flag -output=conll for training, malt_input",+ "for unanalysed input).",+ "By default, the last argument is the head of every abstract syntax",+ "function; moreover, the head depends on the head of the function above.",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by dot (graphviz) and displayed by the program indicated",+ "by the view flag. The target format is png, unless overridden by the",+ "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",+ "See also 'vp -showdep' for another visualization of dependencies." + ],+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ let absname = abstractName pgf+ let es = toExprs arg+ let debug = isOpt "v" opts+ let abslabels = valStrOpts "abslabels" (valStrOpts "file" "" opts) opts+ let cnclabels = valStrOpts "cnclabels" "" opts+ let outp = valStrOpts "output" "dot" opts+ mlab <- case abslabels of+ "" -> return Nothing+ _ -> (Just . getDepLabels) `fmap` restricted (readFile abslabels)+ mclab <- case cnclabels of+ "" -> return Nothing+ _ -> (Just . getCncDepLabels) `fmap` restricted (readFile cnclabels)+ let lang = optLang pgf opts+ let grphs = map (graphvizDependencyTree outp debug mlab mclab pgf lang) es+ if isOpt "conll2latex" opts+ then return $ fromString $ conlls2latexDoc $ stanzas $ unlines $ toStrings arg+ else if isFlag "view" opts && valStrOpts "output" "" opts == "latex"+ then do+ let view = optViewGraph opts+ viewLatex view "_grphd_" grphs+ else if isFlag "view" opts || isFlag "format" opts+ then do+ let view = optViewGraph opts+ let format = optViewFormat opts+ viewGraphviz view format "_grphd_" grphs+ else return $ fromString $ unlines $ intersperse "" grphs,+ examples = [+ mkEx "gr | vd -- generate a tree and show dependency tree in .dot",+ mkEx "gr | vd -view=open -- generate a tree and display dependency tree on with Mac's 'open'",+ mkEx "gr | vd -view=open -output=latex -- generate a tree and display latex dependency tree with Mac's 'open'",+ mkEx "gr -number=1000 | vd -abslabels=Lang.labels -cnclabels=LangSwe.labels -output=conll -- generate a random treebank",+ mkEx "rf -file=ex.conll | vd -conll2latex | wf -file=ex.tex -- convert conll file to latex"+ ],+ options = [+ ("v","show extra information"),+ ("conll2latex", "convert conll to latex")+ ],+ flags = [+ ("abslabels","abstract configuration file for labels, format per line 'fun label*'"),+ ("cnclabels","concrete configuration file for labels, format per line 'fun {words|*} pos label head'"),+ ("file", "same as abslabels (abstract configuration file)"),+ ("format", "format of the visualization file using dot (default \"png\")"),+ ("output", "output format of graph source (latex, conll, dot (default but deprecated))"),+ ("view", "program to open the resulting graph file (default \"open\")"),+ ("lang", "the language of analysis")+ ]+ }),+++ ("vp", emptyCommandInfo {+ longname = "visualize_parse",+ synopsis = "show parse tree graphically",+ explanation = unlines [+ "Prints a parse tree in the .dot format (the graphviz format).",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by dot (graphviz) and displayed by the program indicated",+ "by the view flag. The target format is png, unless overridden by the",+ "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick)."+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ let es = toExprs arg+ let lang = optLang pgf opts+ let gvOptions = GraphvizOptions {noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts),+ noFun = isOpt "nofun" opts || not (isOpt "showfun" opts),+ noCat = isOpt "nocat" opts && not (isOpt "showcat" opts),+ noDep = not (isOpt "showdep" opts),+ nodeFont = valStrOpts "nodefont" "" opts,+ leafFont = valStrOpts "leaffont" "" opts,+ nodeColor = valStrOpts "nodecolor" "" opts,+ leafColor = valStrOpts "leafcolor" "" opts,+ nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts,+ leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts+ }+ let depfile = valStrOpts "file" "" opts+ mlab <- case depfile of+ "" -> return Nothing+ _ -> (Just . getDepLabels) `fmap` restricted (readFile depfile)+ let grphs = map (graphvizParseTreeDep mlab pgf lang gvOptions) es+ if isFlag "view" opts || isFlag "format" opts+ then do+ let view = optViewGraph opts+ let format = optViewFormat opts+ viewGraphviz view format "_grphp_" grphs+ else return $ fromString $ unlines grphs,+ examples = [+ mkEx "p \"John walks\" | vp -- generate a tree and show parse tree as .dot script",+ mkEx "gr | vp -view=open -- generate a tree and display parse tree on a Mac",+ mkEx "p \"she loves us\" | vp -view=open -showdep -file=uddeps.labels -nocat -- show a visual variant of a dependency tree"+ ],+ options = [+ ("showcat","show categories in the tree nodes (default)"),+ ("nocat","don't show categories"),+ ("showdep","show dependency labels"),+ ("showfun","show function names in the tree nodes"),+ ("nofun","don't show function names (default)"),+ ("showleaves","show the leaves of the tree (default)"),+ ("noleaves","don't show the leaves of the tree (i.e., only the abstract tree)")+ ],+ flags = [+ ("lang","the language to visualize"),+ ("file","configuration file for dependency labels with -deps, format per line 'fun label*'"),+ ("format","format of the visualization file (default \"png\")"),+ ("view","program to open the resulting file (default \"open\")"),+ ("nodefont","font for tree nodes (default: Times -- graphviz standard font)"),+ ("leaffont","font for tree leaves (default: nodefont)"),+ ("nodecolor","color for tree nodes (default: black -- graphviz standard color)"),+ ("leafcolor","color for tree leaves (default: nodecolor)"),+ ("nodeedgestyle","edge style between tree nodes (solid/dashed/dotted/bold, default: solid)"),+ ("leafedgestyle","edge style for links to leaves (solid/dashed/dotted/bold, default: dashed)")+ ]+ }),+++ ("vt", emptyCommandInfo {+ longname = "visualize_tree",+ synopsis = "show a set of trees graphically",+ explanation = unlines [+ "Prints a set of trees in the .dot format (the graphviz format).",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by dot (graphviz) and displayed by the command indicated",+ "by the view flag. The target format is postscript, unless overridden by the",+ "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",+ "With option -mk, use for showing library style function names of form 'mkC'."+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) ->+ let es = toExprs arg in+ if isOpt "mk" opts+ then return $ fromString $ unlines $ map (tree2mk pgf) es+ else if isOpt "api" opts+ then do+ let ss = map exprToAPI es+ mapM_ putStrLn ss+ return void+ else do+ let funs = not (isOpt "nofun" opts)+ let cats = not (isOpt "nocat" opts)+ let grphs = map (graphvizAbstractTree pgf (funs,cats)) es+ if isFlag "view" opts || isFlag "format" opts+ then do+ let view = optViewGraph opts+ let format = optViewFormat opts+ viewGraphviz view format "_grpht_" grphs+ else return $ fromString $ unlines grphs,+ examples = [+ mkEx "p \"hello\" | vt -- parse a string and show trees as graph script",+ mkEx "p \"hello\" | vt -view=\"open\" -- parse a string and display trees on a Mac"+ ],+ options = [+ ("api", "show the tree with function names converted to 'mkC' with value cats C"),+ ("mk", "similar to -api, deprecated"),+ ("nofun","don't show functions but only categories"),+ ("nocat","don't show categories but only functions")+ ],+ flags = [+ ("format","format of the visualization file (default \"png\")"),+ ("view","program to open the resulting file (default \"open\")")+ ]+ }),+ ("ai", emptyCommandInfo {+ longname = "abstract_info",+ syntax = "ai IDENTIFIER or ai EXPR",+ synopsis = "Provides an information about a function, an expression or a category from the abstract syntax",+ explanation = unlines [+ "The command has one argument which is either function, expression or",+ "a category defined in the abstract syntax of the current grammar. ",+ "If the argument is a function then ?its type is printed out.",+ "If it is a category then the category definition is printed.",+ "If a whole expression is given it prints the expression with refined",+ "metavariables and the type of the expression."+ ],+ exec = getEnv $ \ opts arg (Env pgf mos) -> do+ case toExprs arg of+ [EFun id] -> case Map.lookup id (funs (abstract pgf)) of+ Just fd -> do putStrLn $ render (ppFun id fd)+ let (_,_,_,prob) = fd+ putStrLn ("Probability: "++show prob)+ return void+ Nothing -> case Map.lookup id (cats (abstract pgf)) of+ Just cd -> do putStrLn $+ render (ppCat id cd $$+ if null (functionsToCat pgf id)+ then empty+ else ' ' $$+ vcat [ppFun fid (ty,0,Just ([],[]),0) | (fid,ty) <- functionsToCat pgf id] $$+ ' ')+ let (_,_,prob) = cd+ putStrLn ("Probability: "++show prob)+ return void+ Nothing -> do putStrLn ("unknown category of function identifier "++show id)+ return void+ [e] -> case inferExpr pgf e of+ Left tcErr -> error $ render (ppTcError tcErr)+ Right (e,ty) -> do putStrLn ("Expression: "++showExpr [] e)+ putStrLn ("Type: "++showType [] ty)+ putStrLn ("Probability: "++show (probTree pgf e))+ return void+ _ -> do putStrLn "a single identifier or expression is expected from the command"+ return void,+ needsTypeCheck = False+ })+ ]+ where+ getEnv exec opts ts = liftSIO . exec opts ts =<< getPGFEnv++ par pgf opts s = case optOpenTypes opts of+ [] -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]+ open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]+ where+ dp = valIntOpts "depth" 4 opts++ fromParse opts = foldr (joinPiped . fromParse1 opts) void++ joinPiped (Piped (es1,ms1)) (Piped (es2,ms2)) = Piped (jA es1 es2,ms1+++-ms2)+ where+ jA (Exprs es1) (Exprs es2) = Exprs (es1++es2)+ -- ^ fromParse1 always output Exprs++ fromParse1 opts (s,(po,bs))+ | isOpt "bracket" opts = pipeMessage (showBracketedString bs)+ | otherwise =+ case po of+ ParseOk ts -> fromExprs ts+ ParseFailed i -> pipeMessage $ "The parser failed at token "+ ++ show i ++": "+ ++ show (words s !! max 0 (i-1))+ -- ++ " in " ++ show s+ ParseIncomplete -> pipeMessage "The sentence is not complete"+ TypeError errs ->+ pipeMessage . render $+ "The parsing is successful but the type checking failed with error(s):"+ $$ nest 2 (vcat (map (ppTcError . snd) errs))++ optLins pgf opts ts = case opts of+ _ | isOpt "groups" opts ->+ concatMap snd $ groupResults+ [[(lang, s) | lang <- optLangs pgf opts,s <- linear pgf opts lang t] | t <- ts]+ _ -> concatMap (optLin pgf opts) ts+ optLin pgf opts t =+ case opts of+ _ | isOpt "treebank" opts && isOpt "chunks" opts ->+ (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :+ [showCId lang ++ ": " ++ li | (lang,li) <- linChunks pgf opts t] --linear pgf opts lang t | lang <- optLangs pgf opts]+ _ | isOpt "treebank" opts ->+ (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :+ [showCId lang ++ ": " ++ s | lang <- optLangs pgf opts, s<-linear pgf opts lang t]+ _ | isOpt "tabtreebank" opts ->+ return $ concat $ intersperse "\t" $ (showExpr [] t) :+ [s | lang <- optLangs pgf opts, s <- linear pgf opts lang t]+ _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t + _ -> [s | lang <- optLangs pgf opts, s<-linear pgf opts lang t]+ linChunks pgf opts t = + [(lang, unwords (intersperse "<+>" (map (unlines . linear pgf opts lang) (treeChunks t)))) | lang <- optLangs pgf opts]++ linear :: PGF -> [Option] -> CId -> Expr -> [String]+ linear pgf opts lang = let unl = unlex opts lang in case opts of+ _ | isOpt "all" opts -> concat . -- intersperse [[]] .+ map (map (unl . snd)) . tabularLinearizes pgf lang+ _ | isOpt "list" opts -> (:[]) . commaList . concat .+ map (map (unl . snd)) . tabularLinearizes pgf lang+ _ | isOpt "table" opts -> concat . -- intersperse [[]] .+ map (map (\(p,v) -> p+++":"+++unl v)) . tabularLinearizes pgf lang+ _ | isOpt "bracket" opts -> (:[]) . unwords . map showBracketedString . bracketedLinearize pgf lang+ _ -> (:[]) . unl . linearize pgf lang++ -- replace each non-atomic constructor with mkC, where C is the val cat+ tree2mk pgf = showExpr [] . t2m where+ t2m t = case unApp t of+ Just (cid,ts@(_:_)) -> mkApp (mk cid) (map t2m ts)+ _ -> t+ mk = mkCId . ("mk" ++) . showCId . lookValCat (abstract pgf)++ unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ----++ getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of+ lexs -> case lookup lang+ [(mkCId la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of+ Just le -> chunks ',' le+ _ -> []++ commaList [] = []+ commaList ws = concat $ head ws : map (", " ++) (tail ws)++-- Proposed logic of coding in unlexing:+-- - If lang has no coding flag, or -to_utf8 is not in opts, just opts are used.+-- - If lang has flag coding=utf8, -to_utf8 is ignored.+-- - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first.+-- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly+{-+ unlexx pgf opts lang = {- trace (unwords optsC) $ -} stringOps Nothing optsC where ----+ optsC = case lookConcrFlag pgf (mkCId lang) (mkCId "coding") of+ Just (LStr "utf8") -> filter (/="to_utf8") $ map prOpt opts+ Just (LStr other) | isOpt "to_utf8" opts ->+ let cod = ("from_" ++ other)+ in cod : filter (/=cod) (map prOpt opts)+ _ -> map prOpt opts+-}+ optRestricted opts pgf =+ restrictPGF (\f -> and [hasLin pgf la f | la <- optLangs pgf opts]) pgf++ optLang = optLangFlag "lang"+ optLangs = optLangsFlag "lang"++ optLangsFlag f pgf opts = case valStrOpts f "" opts of+ "" -> languages pgf+ lang -> map (completeLang pgf) (chunks ',' lang)+ completeLang pgf la = let cla = (mkCId la) in+ if elem cla (languages pgf)+ then cla+ else (mkCId (showCId (abstractName pgf) ++ la))++ optLangFlag f pgf opts = head $ optLangsFlag f pgf opts ++ [wildCId]++ optOpenTypes opts = case valStrOpts "openclass" "" opts of+ "" -> []+ cats -> mapMaybe readType (chunks ',' cats)++ optProbs opts pgf = case valStrOpts "probs" "" opts of+ "" -> return pgf+ file -> do+ probs <- restricted $ readProbabilitiesFromFile file pgf+ return (setProbabilities probs pgf)++ optFile opts = valStrOpts "file" "_gftmp" opts++ optType pgf opts =+ let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts+ in case readType str of+ Just ty -> case checkType pgf ty of+ Left tcErr -> error $ render (ppTcError tcErr)+ Right ty -> ty+ Nothing -> error ("Can't parse '"++str++"' as a type")+ optViewFormat opts = valStrOpts "format" "png" opts+ optViewGraph opts = valStrOpts "view" "open" opts+ optNum opts = valIntOpts "number" 1 opts+ optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9+ takeOptNum opts = take (optNumInf opts)++ returnFromExprs es = return $ case es of+ [] -> pipeMessage "no trees found"+ _ -> fromExprs es++ prGrammar (Env pgf mos) opts+ | isOpt "pgf" opts = do+ let pgf1 = if isOpt "opt" opts then optimizePGF pgf else pgf+ let outfile = valStrOpts "file" (showCId (abstractName pgf) ++ ".pgf") opts+ restricted $ encodeFile outfile pgf1+ putStrLn $ "wrote file " ++ outfile+ return void+ | isOpt "cats" opts = return $ fromString $ unwords $ map showCId $ categories pgf+ | isOpt "funs" opts = return $ fromString $ unlines $ map showFun $ funsigs pgf+ | isOpt "fullform" opts = return $ fromString $ concatMap (morpho mos "" prFullFormLexicon) $ optLangs pgf opts+ | isOpt "langs" opts = return $ fromString $ unwords $ map showCId $ languages pgf++ | isOpt "lexc" opts = return $ fromString $ concatMap (morpho mos "" prLexcLexicon) $ optLangs pgf opts+ | isOpt "missing" opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) |+ la <- optLangs pgf opts, let cs = missingLins pgf la]+ | isOpt "words" opts = return $ fromString $ concatMap (morpho mos "" prAllWords) $ optLangs pgf opts+ | otherwise = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)+ return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf++ funsigs pgf = [(f,ty) | (f,(ty,_,_,_)) <- Map.assocs (funs (abstract pgf))]+ showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;"++ morphos (Env pgf mos) opts s =+ [(s,morpho mos [] (\mo -> lookupMorpho mo s) la) | la <- optLangs pgf opts]++ morpho mos z f la = maybe z f $ Map.lookup la mos++ optMorpho (Env pgf mos) opts = morpho mos (error "no morpho") id (head (optLangs pgf opts))++ optClitics opts = case valStrOpts "clitics" "" opts of+ "" -> []+ cs -> map reverse $ chunks ',' cs++ mexp xs = case xs of+ t:_ -> Just t+ _ -> Nothing++ -- ps -f -g s returns g (f s)+ treeOps pgf opts s = foldr app s (reverse opts) where+ app (OOpt op) | Just (Left f) <- treeOp pgf op = f+ app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f (mkCId x)+ app _ = id++treeOpOptions pgf = [(op,expl) | (op,(expl,Left _)) <- allTreeOps pgf]+treeOpFlags pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf]++translationQuiz :: Maybe Expr -> PGF -> Language -> Language -> Type -> IO ()+translationQuiz mex pgf ig og typ = do+ tts <- translationList mex pgf ig og typ infinity+ mkQuiz "Welcome to GF Translation Quiz." tts++morphologyQuiz :: Maybe Expr -> PGF -> Language -> Type -> IO ()+morphologyQuiz mex pgf ig typ = do+ tts <- morphologyList mex pgf ig typ infinity+ mkQuiz "Welcome to GF Morphology Quiz." tts++-- | the maximal number of precompiled quiz problems+infinity :: Int+infinity = 256++prLexcLexicon :: Morpho -> String+prLexcLexicon mo =+ unlines $ "Multichar_Symbols":multichars:"":"LEXICON Root" : [prLexc l p ++ ":" ++ w ++ " # ;" | (w,lps) <- morpho, (l,p) <- lps] ++ ["END"]+ where+ morpho = fullFormLexicon mo+ prLexc l p = showCId l ++ concat (mkTags (words p))+ mkTags p = case p of+ "s":ws -> mkTags ws --- remove record field+ ws -> map ('+':) ws++ multichars = unwords $ nub $ concat [mkTags (words p) | (w,lps) <- morpho, (l,p) <- lps]+ -- thick_A+(AAdj+Posit+Gen):thick's # ;++prFullFormLexicon :: Morpho -> String+prFullFormLexicon mo =+ unlines (map prMorphoAnalysis (fullFormLexicon mo))++prAllWords :: Morpho -> String+prAllWords mo =+ unwords [w | (w,_) <- fullFormLexicon mo]++prMorphoAnalysis :: (String,[(Lemma,Analysis)]) -> String+prMorphoAnalysis (w,lps) =+ unlines (w:[showCId l ++ " : " ++ p | (l,p) <- lps])++viewGraphviz :: String -> String -> String -> [String] -> SIO CommandOutput+viewGraphviz view format name grphs = do+ let file i s = name ++ i ++ "." ++ s+ mapM_ (\ (grph,i) -> restricted $ writeUTF8File (file (show i) "dot") grph) (zip grphs [1..])+ mapM_ (\i -> restrictedSystem $ "dot -T" ++ format ++ " " ++ file (show i) "dot" ++ " > " ++ file (show i) format) [1..length grphs]+ if length grphs > 1+ then do+ let files = unwords [file (show i) format | i <- [1..length grphs]]+ restrictedSystem $ "convert " ++ files ++ " " ++ file "all" "pdf"+ restrictedSystem $ view ++ " " ++ file "all" "pdf"+ else restrictedSystem $ view ++ " " ++ file "1" format+--- restrictedSystem $ "rm " ++ file "*" format --- removing temporary files+--- restrictedSystem $ "rm " ++ file "*" "dot"+--- restrictedSystem $ "rm " ++ file "all" "pdf"+ return void++viewLatex :: String -> String -> [String] -> SIO CommandOutput+viewLatex view name grphs = do+ let texfile = name ++ ".tex"+ let pdffile = name ++ ".pdf"+ restricted $ writeUTF8File texfile (latexDoc grphs)+ restrictedSystem $ "pdflatex " ++ texfile+ restrictedSystem $ view ++ " " ++ pdffile+ return void+ +---- copied from VisualizeTree ; not sure about proper place AR Nov 2015+latexDoc :: [String] -> String+latexDoc body = unlines $+ "\\batchmode"+ : "\\documentclass{article}"+ : "\\usepackage[utf8]{inputenc}" + : "\\begin{document}"+ : spaces body+ ++ ["\\end{document}"]+ where+ spaces = intersperse "\\vspace{6mm}"+ ---- also reduce the size for long sentences++stanzas :: String -> [String]+stanzas = map unlines . chop . lines where+ chop ls = case break (=="") ls of+ (ls1,[]) -> [ls1]+ (ls1,_:ls2) -> ls1 : chop ls2
@@ -0,0 +1,822 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module GF.Command.Commands2 (+ PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands,+ options, flags,+ ) where+import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import PGF2+import qualified PGF as H+import GF.Compile.ToAPI(exprToAPI)+import GF.Infra.UseIO(writeUTF8File)+import GF.Infra.SIO(MonadSIO,liftSIO,putStrLn,restricted,restrictedSystem)+import GF.Command.Abstract+import GF.Command.CommandInfo+import GF.Data.Operations+import Data.List(intersperse,intersect,nub,sortBy)+import Data.Maybe+import qualified Data.Map as Map+import GF.Text.Pretty+import Control.Monad(mplus)+++data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr}++pgfEnv pgf = Env (Just pgf) (languages pgf)+emptyPGFEnv = Env Nothing Map.empty++class (Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv++instance (Monad m,HasPGFEnv m) => TypeCheckArg m where+ typeCheckArg e = do env <- getPGFEnv+ case pgf env of+ Just gr -> either fail+ (return . hsExpr . fst)+ (inferExpr gr (cExpr e))+ Nothing -> fail "Import a grammar before using this command"++pgfCommands :: HasPGFEnv m => Map.Map String (CommandInfo m)+pgfCommands = Map.fromList [+ ("aw", emptyCommandInfo {+ longname = "align_words",+ synopsis = "show word alignments between languages graphically",+ explanation = unlines [+ "Prints a set of strings in the .dot format (the graphviz format).",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by graphviz and displayed by the program indicated",+ "by the flag. The target format is postscript, unless overridden by the",+ "flag -format."+ ],+ exec = needPGF $ \opts es env -> do+ let cncs = optConcs env opts+ if isOpt "giza" opts+ then if length cncs == 2+ then let giz = map (gizaAlignment pgf (snd (cncs !! 0)) (snd (cncs !! 1)) . cExpr) (toExprs es)+ lsrc = unlines $ map (\(x,_,_) -> x) giz+ ltrg = unlines $ map (\(_,x,_) -> x) giz+ align = unlines $ map (\(_,_,x) -> x) giz+ grph = if null (toExprs es) then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align+ in return (fromString grph)+ else error "For giza alignment you need exactly two languages"+ else let gvOptions=graphvizDefaults{leafFont = valStrOpts "font" "" opts,+ leafColor = valStrOpts "color" "" opts,+ leafEdgeStyle = valStrOpts "edgestyle" "" opts+ }+ grph = if null (toExprs es) then [] else graphvizWordAlignment (map snd cncs) gvOptions (cExpr (head (toExprs es)))+ in if isFlag "view" opts || isFlag "format" opts+ then do let file s = "_grph." ++ s+ let view = optViewGraph opts+ let format = optViewFormat opts+ restricted $ writeUTF8File (file "dot") grph+ restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format+ restrictedSystem $ view ++ " " ++ file format+ return void+ else return (fromString grph),+ examples = [+ ("gr | aw" , "generate a tree and show word alignment as graph script"),+ ("gr | aw -view=\"open\"" , "generate a tree and display alignment on Mac"),+ ("gr | aw -view=\"eog\"" , "generate a tree and display alignment on Ubuntu"),+ ("gt | aw -giza | wf -file=aligns" , "generate trees, send giza alignments to file")+ ],+ options = [+ ("giza", "show alignments in the Giza format; the first two languages")+ ],+ flags = [+ ("format","format of the visualization file (default \"png\")"),+ ("lang", "alignments for this list of languages (default: all)"),+ ("view", "program to open the resulting file"),+ ("font", "font for the words"),+ ("color", "color for the words"),+ ("edgestyle", "the style for links between words")+ ]+ }),+{-+ ("eb", emptyCommandInfo {+ longname = "example_based",+ syntax = "eb (-probs=FILE | -lang=LANG)* -file=FILE.gfe",+ synopsis = "converts .gfe files to .gf files by parsing examples to trees",+ explanation = unlines [+ "Reads FILE.gfe and writes FILE.gf. Each expression of form",+ "'%ex CAT QUOTEDSTRING' in FILE.gfe is replaced by a syntax tree.",+ "This tree is the first one returned by the parser; a biased ranking",+ "can be used to regulate the order. If there are more than one parses",+ "the rest are shown in comments, with probabilities if the order is biased.",+ "The probabilities flag and configuration file is similar to the commands",+ "gr and rt. Notice that the command doesn't change the environment,",+ "but the resulting .gf file must be imported separately."+ ],+ options = [+ ("api","convert trees to overloaded API expressions (using Syntax not Lang)")+ ],+ flags = [+ ("file","the file to be converted (suffix .gfe must be given)"),+ ("lang","the language in which to parse"),+ ("probs","file with probabilities to rank the parses")+ ],+ exec = \env@(pgf, mos) opts _ -> do+ let file = optFile opts+ pgf <- optProbs opts pgf+ let printer = if (isOpt "api" opts) then exprToAPI else (H.showExpr [])+ let conf = configureExBased pgf (optMorpho env opts) (optLang pgf opts) printer+ (file',ws) <- restricted $ parseExamplesInGrammar conf file+ if null ws then return () else putStrLn ("unknown words: " ++ unwords ws)+ return (fromString ("wrote " ++ file')),+ needsTypeCheck = False+ }),+-}+{-+ ("gr", emptyCommandInfo {+ longname = "generate_random",+ synopsis = "generate random trees in the current abstract syntax",+ syntax = "gr [-cat=CAT] [-number=INT]",+ examples = [+ mkEx "gr -- one tree in the startcat of the current grammar",+ mkEx "gr -cat=NP -number=16 -- 16 trees in the category NP",+ mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha",+ mkEx "gr -probs=FILE -- generate with bias",+ mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))"+ ],+ explanation = unlines [+ "Generates a list of random trees, by default one tree.",+ "If a tree argument is given, the command completes the Tree with values to",+ "all metavariables in the tree. The generation can be biased by probabilities,",+ "given in a file in the -probs flag."+ ],+ flags = [+ ("cat","generation category"),+ ("lang","uses only functions that have linearizations in all these languages"),+ ("number","number of trees generated"),+ ("depth","the maximum generation depth"),+ ("probs", "file with biased probabilities (format 'f 0.4' one by line)")+ ],+ exec = \env@(pgf, mos) opts xs -> do+ pgf <- optProbs opts (optRestricted opts pgf)+ gen <- newStdGen+ let dp = valIntOpts "depth" 4 opts+ let ts = case mexp xs of+ Just ex -> H.generateRandomFromDepth gen pgf ex (Just dp)+ Nothing -> H.generateRandomDepth gen pgf (optType pgf opts) (Just dp)+ returnFromExprs $ take (optNum opts) ts+ }),+-}+ ("gt", emptyCommandInfo {+ longname = "generate_trees",+ synopsis = "generates a list of trees, by default exhaustive",+ flags = [("cat","the generation category"),+ ("number","the number of trees generated")],+ examples = [+ mkEx "gt -- all trees in the startcat",+ mkEx "gt -cat=NP -number=16 -- 16 trees in the category NP"],+ exec = needPGF $ \ opts _ env@(pgf,_) ->+ let ts = map fst (generateAll pgf cat)+ cat = optType pgf opts+ in returnFromCExprs (takeOptNum opts ts),+ needsTypeCheck = False+ }),+ ("i", emptyCommandInfo {+ longname = "import",+ synopsis = "import a grammar from a compiled .pgf file",+ explanation = unlines [+ "Reads a grammar from a compiled .pgf file.",+ "Old modules are discarded.",+{-+ "The grammar parser depends on the file name suffix:",++ " .cf context-free (labelled BNF) source",+ " .ebnf extended BNF source",+ " .gfm multi-module GF source",+ " .gf normal GF source",+ " .gfo compiled GF source",+-}+ " .pgf precompiled grammar in Portable Grammar Format"+ ],+ flags = [+-- ("probs","file with biased probabilities for generation")+ ],+ options = [+ -- ["gfo", "src", "no-cpu", "cpu", "quiet", "verbose"]+-- ("retain","retain operations (used for cc command)"),+-- ("src", "force compilation from source"),+-- ("v", "be verbose - show intermediate status information")+ ],+ needsTypeCheck = False+ }),+ ("l", emptyCommandInfo {+ longname = "linearize",+ synopsis = "convert an abstract syntax expression to string",+ explanation = unlines [+ "Shows the linearization of a Tree by the grammars in scope.",+ "The -lang flag can be used to restrict this to fewer languages.",+ "A sequence of string operations (see command ps) can be given",+ "as options, and works then like a pipe to the ps command, except",+ "that it only affect the strings, not e.g. the table labels.",+ "These can be given separately to each language with the unlexer flag",+ "whose results are prepended to the other lexer flags. The value of the",+ "unlexer flag is a space-separated list of comma-separated string operation",+ "sequences; see example."+ ],+ examples = [+ mkEx "l -lang=LangSwe,LangNor no_Utt -- linearize a tree to LangSwe and LangNor",+ mkEx "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table",+ mkEx "l -unlexer=\"LangAra=to_arabic LangHin=to_devanagari\" -- different unlexers"+ ],+ exec = needPGF $ \ opts arg env ->+ return . fromStrings . optLins env opts . map cExpr $ toExprs arg,+ options = [+ ("all", "show all forms and variants, one by line (cf. l -list)"),+ ("bracket","show tree structure with brackets and paths to nodes"),+ ("groups", "all languages, grouped by lang, remove duplicate strings"),+ ("list","show all forms and variants, comma-separated on one line (cf. l -all)"),+ ("multi","linearize to all languages (default)"),+ ("table","show all forms labelled by parameters"),+ ("treebank","show the tree and tag linearizations with language names")+ ],+ flags = [+ ("lang","the languages of linearization (comma-separated, no spaces)")+ ]+ }),+ ("ma", emptyCommandInfo {+ longname = "morpho_analyse",+ synopsis = "print the morphological analyses of the (multiword) expression in the string",+ explanation = unlines [+ "Prints all the analyses of the (multiword) expression in the input string,",+ "using the morphological analyser of the actual grammar (see command pg)"+ ],+ exec = needPGF $ \opts args env -> + return ((fromString . unlines .+ map prMorphoAnalysis . concatMap (morphos env opts) . toStrings) args),+ flags = [+ ("lang","the languages of analysis (comma-separated, no spaces)")+ ]+ }),+{-+ ("mq", emptyCommandInfo {+ longname = "morpho_quiz",+ synopsis = "start a morphology quiz",+ syntax = "mq (-cat=CAT)? (-probs=FILE)? TREE?",+ exec = \env@(pgf, mos) opts xs -> do+ let lang = optLang pgf opts+ let typ = optType pgf opts+ pgf <- optProbs opts pgf+ let mt = mexp xs+ restricted $ morphologyQuiz mt pgf lang typ+ return void,+ flags = [+ ("lang","language of the quiz"),+ ("cat","category of the quiz"),+ ("number","maximum number of questions"),+ ("probs","file with biased probabilities for generation")+ ]+ }),+-}+ ("p", emptyCommandInfo {+ longname = "parse",+ synopsis = "parse a string to abstract syntax expression",+ explanation = unlines [+ "Shows all trees returned by parsing a string in the grammars in scope.",+ "The -lang flag can be used to restrict this to fewer languages.",+ "The default start category can be overridden by the -cat flag.",+ "See also the ps command for lexing and character encoding."+ ],+ flags = [+ ("cat","target category of parsing"),+ ("lang","the languages of parsing (comma-separated, no spaces)"),+ ("number","maximum number of trees returned")+ ],+ examples = [+ mkEx "p \"this fish is fresh\" | l -lang=Swe -- try parsing with all languages and translate the successful parses to Swedish"+ ],+ exec = needPGF $ \ opts ts env -> return . cParse env opts $ toStrings ts+ }),+ ("pg", emptyCommandInfo {+ longname = "print_grammar",+ synopsis = "prints different information about the grammar",+ exec = needPGF $ \opts _ env -> prGrammar env opts,+ options = [+ ("cats", "show just the names of abstract syntax categories"),+ ("fullform", "print the fullform lexicon"),+ ("funs", "show just the names and types of abstract syntax functions"),+ ("langs", "show just the names of top concrete syntax modules"),+ ("lexc", "print the lexicon in Xerox LEXC format"),+ ("missing","show just the names of functions that have no linearization"),+ ("words", "print the list of words")+ ],+ flags = [+ ("lang","the languages that need to be printed")+ ],+ examples = [+ mkEx "pg -langs -- show the names of top concrete syntax modules",+ mkEx "pg -funs | ? grep \" S ;\" -- show functions with value cat S"+ ]+ }),++{-+ ("pt", emptyCommandInfo {+ longname = "put_tree",+ syntax = "pt OPT? TREE",+ synopsis = "return a tree, possibly processed with a function",+ explanation = unlines [+ "Returns a tree obtained from its argument tree by applying",+ "tree processing functions in the order given in the command line",+ "option list. Thus 'pt -f -g s' returns g (f s). Typical tree processors",+ "are type checking and semantic computation."+ ],+ examples = [+ mkEx "pt -compute (plus one two) -- compute value",+ mkEx "p \"4 dogs love 5 cats\" | pt -transfer=digits2numeral | l -- four...five..."+ ],+ exec = \env@(pgf, mos) opts ->+ returnFromExprs . takeOptNum opts . treeOps pgf opts,+ options = treeOpOptions undefined{-pgf-},+ flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-}+ }),+-}+ ("rf", emptyCommandInfo {+ longname = "read_file",+ synopsis = "read string or tree input from a file",+ explanation = unlines [+ "Reads input from file. The filename must be in double quotes.",+ "The input is interpreted as a string by default, and can hence be",+ "piped e.g. to the parse command. The option -tree interprets the",+ "input as a tree, which can be given e.g. to the linearize command.",+ "The option -lines will result in a list of strings or trees, one by line."+ ],+ options = [+ ("lines","return the list of lines, instead of the singleton of all contents"),+ ("tree","convert strings into trees")+ ],+ exec = needPGF $ \opts _ env@(pgf, mos) -> do+ let file = optFile opts+ let exprs [] = ([],empty)+ exprs ((n,s):ls) | null s+ = exprs ls+ exprs ((n,s):ls) = case readExpr s of+ Just e -> let (es,err) = exprs ls+ in case inferExpr pgf e of+ Right (e,t) -> (e:es,err)+ Left msg -> (es,"on line" <+> n <> ':' $$ msg $$ err)+ Nothing -> let (es,err) = exprs ls+ in (es,"on line" <+> n <> ':' <+> "parse error" $$ err)+ returnFromLines ls = case exprs ls of+ (es, err) | null es -> return $ pipeMessage $ render (err $$ "no trees found")+ | otherwise -> return $ pipeWithMessage (map hsExpr es) (render err)++ s <- restricted $ readFile file+ case opts of+ _ | isOpt "lines" opts && isOpt "tree" opts ->+ returnFromLines (zip [1::Int ..] (lines s))+ _ | isOpt "tree" opts ->+ returnFromLines [(1::Int,s)]+ _ | isOpt "lines" opts -> return (fromStrings $ lines s)+ _ -> return (fromString s),+ flags = [("file","the input file name")]+ }),+ ("rt", emptyCommandInfo {+ longname = "rank_trees",+ synopsis = "show trees in an order of decreasing probability",+ explanation = unlines [+ "Order trees from the most to the least probable, using either",+ "even distribution in each category (default) or biased as specified",+ "by the file given by flag -probs=FILE, where each line has the form",+ "'function probability', e.g. 'youPol_Pron 0.01'."+ ],+ exec = needPGF $ \opts es env@(pgf, _) -> do+ let tds = sortBy (\(_,p) (_,q) -> compare p q)+ [(t, treeProbability pgf t) | t <- map cExpr (toExprs es)]+ if isOpt "v" opts+ then putStrLn $+ unlines [PGF2.showExpr [] t ++ "\t--" ++ show d | (t,d) <- tds]+ else return ()+ returnFromExprs $ map (hsExpr . fst) tds,+ flags = [+ ("probs","probabilities from this file (format 'f 0.6' per line)")+ ],+ options = [+ ("v","show all trees with their probability scores")+ ],+ examples = [+ mkEx "p \"you are here\" | rt -probs=probs | pt -number=1 -- most probable result"+ ]+ }),+{-+ ("tq", emptyCommandInfo {+ longname = "translation_quiz",+ syntax = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",+ synopsis = "start a translation quiz",+ exec = \env@(pgf, mos) opts xs -> do+ let from = optLangFlag "from" pgf opts+ let to = optLangFlag "to" pgf opts+ let typ = optType pgf opts+ let mt = mexp xs+ pgf <- optProbs opts pgf+ restricted $ translationQuiz mt pgf from to typ+ return void,+ flags = [+ ("from","translate from this language"),+ ("to","translate to this language"),+ ("cat","translate in this category"),+ ("number","the maximum number of questions"),+ ("probs","file with biased probabilities for generation")+ ],+ examples = [+ mkEx ("tq -from=Eng -to=Swe -- any trees in startcat"),+ mkEx ("tq -from=Eng -to=Swe (AdjCN (PositA ?2) (UseN ?)) -- only trees of this form")+ ]+ }),+ ("vd", emptyCommandInfo {+ longname = "visualize_dependency",+ synopsis = "show word dependency tree graphically",+ explanation = unlines [+ "Prints a dependency tree in the .dot format (the graphviz format, default)",+ "or the CoNLL/MaltParser format (flag -output=conll for training, malt_input",+ "for unanalysed input).",+ "By default, the last argument is the head of every abstract syntax",+ "function; moreover, the head depends on the head of the function above.",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by graphviz and displayed by the program indicated",+ "by the flag. The target format is png, unless overridden by the",+ "flag -format."+ ],+ exec = \env@(pgf, mos) opts es -> do+ let debug = isOpt "v" opts+ let file = valStrOpts "file" "" opts+ let outp = valStrOpts "output" "dot" opts+ mlab <- case file of+ "" -> return Nothing+ _ -> (Just . H.getDepLabels . lines) `fmap` restricted (readFile file)+ let lang = optLang pgf opts+ let grphs = unlines $ map (H.graphvizDependencyTree outp debug mlab Nothing pgf lang) es+ if isFlag "view" opts || isFlag "format" opts then do+ let file s = "_grphd." ++ s+ let view = optViewGraph opts+ let format = optViewFormat opts+ restricted $ writeUTF8File (file "dot") grphs+ restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format+ restrictedSystem $ view ++ " " ++ file format+ return void+ else return $ fromString grphs,+ examples = [+ mkEx "gr | vd -- generate a tree and show dependency tree in .dot",+ mkEx "gr | vd -view=open -- generate a tree and display dependency tree on a Mac",+ mkEx "gr -number=1000 | vd -file=dep.labels -output=malt -- generate training treebank",+ mkEx "gr -number=100 | vd -file=dep.labels -output=malt_input -- generate test sentences"+ ],+ options = [+ ("v","show extra information")+ ],+ flags = [+ ("file","configuration file for labels per fun, format 'fun l1 ... label ... l2'"),+ ("format","format of the visualization file (default \"png\")"),+ ("output","output format of graph source (default \"dot\")"),+ ("view","program to open the resulting file (default \"open\")"),+ ("lang","the language of analysis")+ ]+ }),+-}++ ("vp", emptyCommandInfo {+ longname = "visualize_parse",+ synopsis = "show parse tree graphically",+ explanation = unlines [+ "Prints a parse tree in the .dot format (the graphviz format).",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by graphviz and displayed by the program indicated",+ "by the flag. The target format is png, unless overridden by the",+ "flag -format."+ ],+ exec = needPGF $ \opts arg env@(pgf, concs) ->+ do let es = toExprs arg+ let concs = optConcs env opts++ let gvOptions=graphvizDefaults{noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts),+ noFun = isOpt "nofun" opts || not (isOpt "showfun" opts),+ noCat = isOpt "nocat" opts && not (isOpt "showcat" opts),+ nodeFont = valStrOpts "nodefont" "" opts,+ leafFont = valStrOpts "leaffont" "" opts,+ nodeColor = valStrOpts "nodecolor" "" opts,+ leafColor = valStrOpts "leafcolor" "" opts,+ nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts,+ leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts+ }++ let grph= if null es || null concs+ then []+ else graphvizParseTree (snd (head concs)) gvOptions (cExpr (head es))+ if isFlag "view" opts || isFlag "format" opts then do+ let file s = "_grph." ++ s+ let view = optViewGraph opts+ let format = optViewFormat opts+ restricted $ writeUTF8File (file "dot") grph+ restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format+ restrictedSystem $ view ++ " " ++ file format+ return void+ else return $ fromString grph,+ examples = [+ mkEx "p -lang=Eng \"John walks\" | vp -- generate a tree and show parse tree as .dot script",+ mkEx "gr | vp -view=\"open\" -- generate a tree and display parse tree on a Mac"+ ],+ options = [+ ("showcat","show categories in the tree nodes (default)"),+ ("nocat","don't show categories"),+ ("showfun","show function names in the tree nodes"),+ ("nofun","don't show function names (default)"),+ ("showleaves","show the leaves of the tree (default)"),+ ("noleaves","don't show the leaves of the tree (i.e., only the abstract tree)")+ ],+ flags = [+ ("lang","the language to visualize"),+ ("format","format of the visualization file (default \"png\")"),+ ("view","program to open the resulting file (default \"open\")"),+ ("nodefont","font for tree nodes (default: Times -- graphviz standard font)"),+ ("leaffont","font for tree leaves (default: nodefont)"),+ ("nodecolor","color for tree nodes (default: black -- graphviz standard color)"),+ ("leafcolor","color for tree leaves (default: nodecolor)"),+ ("nodeedgestyle","edge style between tree nodes (solid/dashed/dotted/bold, default: solid)"),+ ("leafedgestyle","edge style for links to leaves (solid/dashed/dotted/bold, default: dashed)")+ ]+ }),++ ("vt", emptyCommandInfo {+ longname = "visualize_tree",+ synopsis = "show a set of trees graphically",+ explanation = unlines [+ "Prints a set of trees in the .dot format (the graphviz format).",+ "The graph can be saved in a file by the wf command as usual.",+ "If the -view flag is defined, the graph is saved in a temporary file",+ "which is processed by graphviz and displayed by the program indicated",+ "by the flag. The target format is postscript, unless overridden by the",+ "flag -format."+ ],+ exec = needPGF $ \opts arg env@(pgf, _) ->+ let es = toExprs arg in+ if isOpt "api" opts+ then do+ mapM_ (putStrLn . exprToAPI) es+ return void+ else do+ let gvOptions=graphvizDefaults{noFun = isOpt "nofun" opts,+ noCat = isOpt "nocat" opts,+ nodeFont = valStrOpts "nodefont" "" opts,+ nodeColor = valStrOpts "nodecolor" "" opts,+ nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts+ }+ let grph = unlines (map (graphvizAbstractTree pgf gvOptions . cExpr) es)+ if isFlag "view" opts || isFlag "format" opts then do+ let file s = "_grph." ++ s+ let view = optViewGraph opts+ let format = optViewFormat opts+ restricted $ writeUTF8File (file "dot") grph+ restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format+ restrictedSystem $ view ++ " " ++ file format+ return void+ else return $ fromString grph,+ examples = [+ mkEx "p \"hello\" | vt -- parse a string and show trees as graph script",+ mkEx "p \"hello\" | vt -view=\"open\" -- parse a string and display trees on a Mac"+ ],+ options = [+ ("api", "show the tree with function names converted to 'mkC' with value cats C"),+ ("nofun","don't show functions but only categories"),+ ("nocat","don't show categories but only functions")+ ],+ flags = [+ ("format","format of the visualization file (default \"png\")"),+ ("view","program to open the resulting file (default \"open\")"),+ ("nodefont","font for tree nodes (default: Times -- graphviz standard font)"),+ ("nodecolor","color for tree nodes (default: black -- graphviz standard color)"),+ ("nodeedgestyle","edge style between tree nodes (solid/dashed/dotted/bold, default: solid)")+ ]+ }),++ ("ai", emptyCommandInfo {+ longname = "abstract_info",+ syntax = "ai IDENTIFIER or ai EXPR",+ synopsis = "Provides an information about a function, an expression or a category from the abstract syntax",+ explanation = unlines [+ "The command has one argument which is either function, expression or",+ "a category defined in the abstract syntax of the current grammar. ",+ "If the argument is a function then its type is printed out.",+ "If it is a category then the category definition is printed.",+ "If a whole expression is given it prints the expression with refined",+ "metavariables and the type of the expression."+ ],+ exec = needPGF $ \opts args env@(pgf,cncs) ->+ case map cExpr (toExprs args) of+ [e] -> case unApp e of+ Just (id,[]) -> return (fromString + (case functionType pgf id of+ Just ty -> showFun id ty+ Nothing -> let funs = functionsByCat pgf id+ in showCat id funs))+ where+ showCat c funs = "cat "++c+++ " ;\n\n"+++ unlines [showFun f ty| f<-funs,+ Just ty <- [functionType pgf f]]+ showFun f ty = "fun "++f++" : "++showType [] ty++" ;"+ _ -> case inferExpr pgf e of+ Left msg -> error msg+ Right (e,ty) -> do putStrLn ("Expression: "++PGF2.showExpr [] e)+ putStrLn ("Type: "++PGF2.showType [] ty)+ putStrLn ("Probability: "++show (treeProbability pgf e))+ return void+ _ -> do putStrLn "a single function name or category name is expected"+ return void,+ needsTypeCheck = False+ })+ ]+ where+ cParse env@(pgf,_) opts ss = + parsed [ parse cnc cat s | s<-ss,(lang,cnc)<-cncs]+ where+ cat = optType pgf opts+ cncs = optConcs env opts+ parsed rs = Piped (Exprs ts,unlines msgs)+ where+ ts = [hsExpr t|ParseOk ts<-rs,(t,p)<-takeOptNum opts ts]+ msgs = concatMap mkMsg rs++ mkMsg (ParseOk ts) = (map (PGF2.showExpr [] . fst).takeOptNum opts) ts+ mkMsg (ParseFailed _ tok) = ["Parse failed: "++tok]+ mkMsg (ParseIncomplete) = ["The sentence is incomplete"]++ optLins env opts ts = case opts of+ _ | isOpt "groups" opts ->+ concatMap snd $ groupResults+ [[(lang, s) | (lang,concr) <- optConcs env opts,s <- linear opts lang concr t] | t <- ts]+ _ -> concatMap (optLin env opts) ts+ optLin env@(pgf,_) opts t =+ case opts of+ _ | isOpt "treebank" opts ->+ (abstractName pgf ++ ": " ++ PGF2.showExpr [] t) :+ [lang ++ ": " ++ s | (lang,concr) <- optConcs env opts, s<-linear opts lang concr t]+ _ -> [s | (lang,concr) <- optConcs env opts, s<-linear opts lang concr t]++ linear :: [Option] -> ConcName -> Concr -> PGF2.Expr -> [String]+ linear opts lang concr = case opts of+ _ | isOpt "all" opts -> concat . map (map snd) . tabularLinearizeAll concr+ _ | isOpt "list" opts -> (:[]) . commaList .+ concatMap (map snd) . tabularLinearizeAll concr+ _ | isOpt "table" opts -> concatMap (map (\(p,v) -> p+++":"+++v)) . tabularLinearizeAll concr+ _ | isOpt "bracket" opts -> (:[]) . unwords . map showBracketedString . bracketedLinearize concr+ _ -> (:[]) . linearize concr++ groupResults :: [[(ConcName,String)]] -> [(ConcName,[String])]+ groupResults = Map.toList . foldr more Map.empty . start . concat+ where+ start ls = [(l,[s]) | (l,s) <- ls]+ more (l,s) = + Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s++ optConcs = optConcsFlag "lang"++ optConcsFlag f (pgf,cncs) opts =+ case valStrOpts f "" opts of+ "" -> Map.toList cncs+ lang -> mapMaybe pickLang (chunks ',' lang)+ where+ pickLang l = pick l `mplus` pick fl+ where+ fl = abstractName pgf++l+ pick l = (,) l `fmap` Map.lookup l cncs++{-+ -- replace each non-atomic constructor with mkC, where C is the val cat+ tree2mk pgf = H.showExpr [] . t2m where+ t2m t = case H.unApp t of+ Just (cid,ts@(_:_)) -> H.mkApp (mk cid) (map t2m ts)+ _ -> t+ mk = H.mkCId . ("mk" ++) . H.showCId . H.lookValCat (H.abstract pgf)++ unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ----++ getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of+ lexs -> case lookup lang+ [(H.mkCId la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of+ Just le -> chunks ',' le+ _ -> []+-}+ commaList [] = []+ commaList ws = concat $ head ws : map (", " ++) (tail ws)++ optFile opts = valStrOpts "file" "_gftmp" opts++ optType pgf opts =+ case listFlags "cat" opts of+ v:_ -> let str = valueString v+ in case readType str of+ Just ty -> case checkType pgf ty of+ Left msg -> error msg+ Right ty -> ty+ Nothing -> error ("Can't parse '"++str++"' as a type")+ _ -> startCat pgf++ optViewFormat opts = valStrOpts "format" "png" opts+ optViewGraph opts = valStrOpts "view" "open" opts+{-+ optNum opts = valIntOpts "number" 1 opts+-}+ optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9+ takeOptNum opts = take (optNumInf opts)++ returnFromCExprs = returnFromExprs . map hsExpr+ returnFromExprs es =+ return $ case es of+ [] -> pipeMessage "no trees found"+ _ -> fromExprs es++ prGrammar env@(pgf,cncs) opts+ | isOpt "langs" opts = return . fromString . unwords $ (map fst (optConcs env opts))+ | isOpt "cats" opts = return . fromString . unwords $ categories pgf+ | isOpt "funs" opts = return . fromString . unwords $ functions pgf+ | isOpt "missing" opts = return . fromString . unwords $+ [f | f <- functions pgf, not (and [hasLinearization concr f | (_,concr) <- optConcs env opts])]+ | isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . snd) $ optConcs env opts+ | isOpt "words" opts = return $ fromString $ concatMap (prAllWords . snd) $ optConcs env opts+ | isOpt "lexc" opts = return $ fromString $ concatMap (prLexcLexicon . snd) $ optConcs env opts+ | otherwise = return void++ gizaAlignment pgf src_cnc tgt_cnc e =+ let src_res = alignWords src_cnc e+ tgt_res = alignWords tgt_cnc e+ alignment = [show i++"-"++show j | (i,(_,src_fids)) <- zip [0..] src_res, (j,(_,tgt_fids)) <- zip [0..] tgt_res, not (null (intersect src_fids tgt_fids))]+ in (unwords (map fst src_res), unwords (map fst tgt_res), unwords alignment)++ morphos env opts s =+ [(s,res) | (lang,concr) <- optConcs env opts, let res = lookupMorpho concr s, not (null res)]+{-+ mexp xs = case xs of+ t:_ -> Just t+ _ -> Nothing+-}+ -- ps -f -g s returns g (f s)+{-+ treeOps pgf opts s = foldr app s (reverse opts) where+ app (OOpt op) | Just (Left f) <- treeOp pgf op = f+ app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f (H.mkCId x)+ app _ = id++treeOpOptions pgf = [(op,expl) | (op,(expl,Left _)) <- allTreeOps pgf]+treeOpFlags pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf]++translationQuiz :: Maybe H.Expr -> H.PGF -> H.Language -> H.Language -> H.Type -> IO ()+translationQuiz mex pgf ig og typ = do+ tts <- translationList mex pgf ig og typ infinity+ mkQuiz "Welcome to GF Translation Quiz." tts++morphologyQuiz :: Maybe H.Expr -> H.PGF -> H.Language -> H.Type -> IO ()+morphologyQuiz mex pgf ig typ = do+ tts <- morphologyList mex pgf ig typ infinity+ mkQuiz "Welcome to GF Morphology Quiz." tts++-- | the maximal number of precompiled quiz problems+infinity :: Int+infinity = 256+-}+prLexcLexicon :: Concr -> String+prLexcLexicon concr =+ unlines $ "Multichar_Symbols":multichars:"":"LEXICON Root" : [prLexc l p ++ ":" ++ w ++ " # ;" | (w,lps) <- morpho, (l,p,_) <- lps] ++ ["END"]+ where+ morpho = fullFormLexicon concr+ prLexc l p = l ++ concat (mkTags (words p))+ mkTags p = case p of+ "s":ws -> mkTags ws --- remove record field+ ws -> map ('+':) ws++ multichars = unwords $ nub $ concat [mkTags (words p) | (w,lps) <- morpho, (l,p,_) <- lps]+ -- thick_A+(AAdj+Posit+Gen):thick's # ;++prFullFormLexicon :: Concr -> String+prFullFormLexicon concr =+ unlines (map prMorphoAnalysis (fullFormLexicon concr))++prAllWords :: Concr -> String+prAllWords concr =+ unwords [w | (w,_) <- fullFormLexicon concr]++prMorphoAnalysis :: (String,[MorphoAnalysis]) -> String+prMorphoAnalysis (w,lps) =+ unlines (w:[fun ++ " : " ++ cat | (fun,cat,p) <- lps])++hsExpr c =+ case unApp c of+ Just (f,cs) -> H.mkApp (H.mkCId f) (map hsExpr cs)+ _ -> case unStr c of+ Just str -> H.mkStr str+ _ -> error $ "GF.Command.Commands2.hsExpr "++show c++cExpr e =+ case H.unApp e of+ Just (f,es) -> mkApp (H.showCId f) (map cExpr es)+ _ -> case H.unStr e of+ Just str -> mkStr str+ _ -> error $ "GF.Command.Commands2.cExpr "++show e++needPGF exec opts ts =+ do Env mb_pgf cncs <- getPGFEnv+ case mb_pgf of+ Just pgf -> liftSIO $ exec opts ts (pgf,cncs)+ _ -> fail "Import a grammar before using this command"
@@ -0,0 +1,282 @@+-- | Commands that work in any type of environment, either because they don't+-- use the PGF, or because they are just documented here and implemented+-- elsewhere+module GF.Command.CommonCommands where+import Data.List(sort)+import Data.Char (isSpace)+import GF.Command.CommandInfo+import qualified Data.Map as Map+import GF.Infra.SIO+import GF.Infra.UseIO(writeUTF8File)+import GF.Infra.Option(renameEncoding)+import GF.System.Console(changeConsoleEncoding)+import GF.System.Process+import GF.Command.Abstract --(isOpt,valStrOpts,prOpt)+import GF.Text.Pretty+import GF.Text.Transliterations+import GF.Text.Lexing(stringOp,opInEnv)++import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))++extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased++commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)+commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [+ ("!", emptyCommandInfo {+ synopsis = "system command: escape to system shell",+ syntax = "! SYSTEMCOMMAND",+ examples = [+ ("! ls *.gf", "list all GF files in the working directory")+ ]+ }),+ ("?", emptyCommandInfo {+ synopsis = "system pipe: send value from previous command to a system command",+ syntax = "? SYSTEMCOMMAND",+ examples = [+ ("gt | l | ? wc", "generate, linearize, word-count")+ ]+ }),+ ("dc", emptyCommandInfo {+ longname = "define_command",+ syntax = "dc IDENT COMMANDLINE",+ synopsis = "define a command macro",+ explanation = unlines [+ "Defines IDENT as macro for COMMANDLINE, until IDENT gets redefined.",+ "A call of the command has the form %IDENT. The command may take an",+ "argument, which in COMMANDLINE is marked as ?0. Both strings and",+ "trees can be arguments. Currently at most one argument is possible.",+ "This command must be a line of its own, and thus cannot be a part",+ "of a pipe."+ ]+ }),+ ("dt", emptyCommandInfo {+ longname = "define_tree",+ syntax = "dt IDENT (TREE | STRING | \"<\" COMMANDLINE)",+ synopsis = "define a tree or string macro",+ explanation = unlines [+ "Defines IDENT as macro for TREE or STRING, until IDENT gets redefined.",+ "The defining value can also come from a command, preceded by \"<\".",+ "If the command gives many values, the first one is selected.",+ "A use of the macro has the form %IDENT. Currently this use cannot be",+ "a subtree of another tree. This command must be a line of its own",+ "and thus cannot be a part of a pipe."+ ],+ examples = [+ mkEx ("dt ex \"hello world\" -- define ex as string"),+ mkEx ("dt ex UseN man_N -- define ex as string"),+ mkEx ("dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"),+ mkEx ("l -lang=LangSwe %ex | ps -to_utf8 -- linearize the tree ex")+ ]+ }),+ ("e", emptyCommandInfo {+ longname = "empty",+ synopsis = "empty the environment"+ }),+ ("eh", emptyCommandInfo {+ longname = "execute_history",+ syntax = "eh FILE",+ synopsis = "read commands from a file and execute them"+ }),+ ("ph", emptyCommandInfo {+ longname = "print_history",+ synopsis = "print command history",+ explanation = unlines [+ "Prints the commands issued during the GF session.",+ "The result is readable by the eh command.",+ "The result can be used as a script when starting GF."+ ],+ examples = [+ mkEx "ph | wf -file=foo.gfs -- save the history into a file"+ ]+ }),+ ("ps", emptyCommandInfo {+ longname = "put_string",+ syntax = "ps OPT? STRING",+ synopsis = "return a string, possibly processed with a function",+ explanation = unlines [+ "Returns a string obtained from its argument string by applying",+ "string processing functions in the order given in the command line",+ "option list. Thus 'ps -f -g s' returns g (f s). Typical string processors",+ "are lexers and unlexers, but also character encoding conversions are possible.",+ "The unlexers preserve the division of their input to lines.",+ "To see transliteration tables, use command ut."+ ],+ examples = [+-- mkEx "l (EAdd 3 4) | ps -code -- linearize code-like output",+ mkEx "l (EAdd 3 4) | ps -unlexcode -- linearize code-like output",+-- mkEx "ps -lexer=code | p -cat=Exp -- parse code-like input",+ mkEx "ps -lexcode | p -cat=Exp -- parse code-like input",+ mkEx "gr -cat=QCl | l | ps -bind -- linearization output from LangFin",+ mkEx "ps -to_devanagari \"A-p\" -- show Devanagari in UTF8 terminal",+ mkEx "rf -file=Hin.gf | ps -env=quotes -to_devanagari -- convert translit to UTF8",+ mkEx "rf -file=Ara.gf | ps -from_utf8 -env=quotes -from_arabic -- convert UTF8 to transliteration",+ mkEx "ps -to=chinese.trans \"abc\" -- apply transliteration defined in file chinese.trans",+ mkEx "ps -lexgreek \"a)gavoi` a)'nvrwpoi' tines*\" -- normalize ancient greek accentuation"+ ],+ exec = \opts x-> do+ let (os,fs) = optsAndFlags opts+ trans <- optTranslit opts++ case opts of+ _ | isOpt "lines" opts -> return $ fromStrings $ map (trans . stringOps (envFlag fs) (map prOpt os)) $ toStrings x+ _ | isOpt "paragraphs" opts -> return $ fromStrings $ map (trans . stringOps (envFlag fs) (map prOpt os)) $ toParagraphs $ toStrings x+ _ -> return ((fromString . trans . stringOps (envFlag fs) (map prOpt os) . toString) x),+ options = [+ ("lines","apply the operation separately to each input line, returning a list of lines"),+ ("paragraphs","apply separately to each input paragraph (as separated by empty lines), returning a list of lines")+ ] +++ stringOpOptions,+ flags = [+ ("env","apply in this environment only"),+ ("from","backward-apply transliteration defined in this file (format 'unicode translit' per line)"),+ ("to", "forward-apply transliteration defined in this file")+ ]+ }),+ ("q", emptyCommandInfo {+ longname = "quit",+ synopsis = "exit GF interpreter"+ }),+ ("r", emptyCommandInfo {+ longname = "reload",+ synopsis = "repeat the latest import command"+ }),++ ("se", emptyCommandInfo {+ longname = "set_encoding",+ synopsis = "set the encoding used in current terminal",+ syntax = "se ID",+ examples = [+ mkEx "se cp1251 -- set encoding to cp1521",+ mkEx "se utf8 -- set encoding to utf8 (default)"+ ],+ needsTypeCheck = False,+ exec = \ opts ts ->+ case words (toString ts) of+ [c] -> do let cod = renameEncoding c+ restricted $ changeConsoleEncoding cod+ return void+ _ -> return (pipeMessage "se command not parsed")+ }),+ ("sp", emptyCommandInfo {+ longname = "system_pipe",+ synopsis = "send argument to a system command",+ syntax = "sp -command=\"SYSTEMCOMMAND\", alt. ? SYSTEMCOMMAND",+ exec = \opts arg -> do+ let syst = optComm opts -- ++ " " ++ tmpi+ {-+ let tmpi = "_tmpi" ---+ let tmpo = "_tmpo"+ restricted $ writeFile tmpi $ toString arg+ restrictedSystem $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo+ fmap fromString $ restricted $ readFile tmpo,+ -}+ fmap fromString . restricted . readShellProcess syst $ toString arg,+ flags = [+ ("command","the system command applied to the argument")+ ],+ examples = [+ mkEx "gt | l | ? wc -- generate trees, linearize, and count words"+ ]+ }),+ ("tt", emptyCommandInfo {+ longname = "to_trie",+ syntax = "to_trie",+ synopsis = "combine a list of trees into a trie",+ exec = \ _ -> return . fromString . trie . toExprs+ }),+ ("ut", emptyCommandInfo {+ longname = "unicode_table",+ synopsis = "show a transliteration table for a unicode character set",+ exec = \opts _ -> do+ let t = concatMap prOpt (take 1 opts)+ let out = maybe "no such transliteration" characterTable $ transliteration t+ return $ fromString out,+ options = transliterationPrintNames+ }),+ ("wf", emptyCommandInfo {+ longname = "write_file",+ synopsis = "send string or tree to a file",+ exec = \opts arg-> do+ let file = valStrOpts "file" "_gftmp" opts+ if isOpt "append" opts+ then restricted $ appendFile file (toLines arg)+ else restricted $ writeUTF8File file (toLines arg)+ return void,+ options = [+ ("append","append to file, instead of overwriting it")+ ],+ flags = [("file","the output filename")]+ })+ ]+ where+ optComm opts = valStrOpts "command" "" opts++ optTranslit opts = case (valStrOpts "to" "" opts, valStrOpts "from" "" opts) of+ ("","") -> return id+ (file,"") -> do+ src <- restricted $ readFile file+ return $ transliterateWithFile file src False+ (_,file) -> do+ src <- restricted $ readFile file+ return $ transliterateWithFile file src True++stringOps menv opts s = foldr (menvop . app) s (reverse opts)+ where+ app f = maybe id id (stringOp (const False) f)+ menvop op = maybe op (\ (b,e) -> opInEnv b e op) menv++envFlag fs =+ case valStrOpts "env" "global" fs of+ "quotes" -> Just ("\"","\"")+ _ -> Nothing++stringOpOptions = sort $ [+ ("bind","bind tokens separated by Prelude.BIND, i.e. &+"),+ ("chars","lexer that makes every non-space character a token"),+ ("from_cp1251","decode from cp1251 (Cyrillic used in Bulgarian resource)"),+ ("from_utf8","decode from utf8 (default)"),+ ("lextext","text-like lexer"),+ ("lexcode","code-like lexer"),+ ("lexmixed","mixture of text and code, as in LaTeX (code between $...$, \\(...)\\, \\[...\\])"),+ ("lexgreek","lexer normalizing ancient Greek accentuation"),+ ("lexgreek2","lexer normalizing ancient Greek accentuation for text with vowel length annotations"),+ ("to_cp1251","encode to cp1251 (Cyrillic used in Bulgarian resource)"),+ ("to_html","wrap in a html file with linebreaks"),+ ("to_utf8","encode to utf8 (default)"),+ ("unlextext","text-like unlexer"),+ ("unlexcode","code-like unlexer"),+ ("unlexmixed","mixture of text and code (code between $...$, \\(...)\\, \\[...\\])"),+ ("unchars","unlexer that puts no spaces between tokens"),+ ("unlexgreek","unlexer de-normalizing ancient Greek accentuation"),+ ("unwords","unlexer that puts a single space between tokens (default)"),+ ("words","lexer that assumes tokens separated by spaces (default)")+ ] +++ concat [+ [("from_" ++ p, "from unicode to GF " ++ n ++ " transliteration"),+ ("to_" ++ p, "from GF " ++ n ++ " transliteration to unicode")] |+ (p,n) <- transliterationPrintNames]++trie = render . pptss . H.toTrie . map H.toATree+ where+ pptss [ts] = "*"<+>nest 2 (ppts ts)+ pptss tss = vcat [i<+>nest 2 (ppts ts)|(i,ts)<-zip [(1::Int)..] tss]++ ppts = vcat . map ppt++ ppt t =+ case t of+ H.Oth e -> pp (H.showExpr [] e)+ H.Ap f [[]] -> pp (H.showCId f)+ H.Ap f tss -> H.showCId f $$ nest 2 (pptss tss)++-- ** Converting command input+toString = unwords . toStrings+toLines = unlines . toStrings++toParagraphs = map (unwords . words) . toParas+ where+ toParas ls = case break (all isSpace) ls of+ ([],[]) -> []+ ([],_:ll) -> toParas ll+ (l, []) -> [unwords l]+ (l, _:ll) -> unwords l : toParas ll
@@ -0,0 +1,91 @@+module GF.Command.Help where+import GF.Command.Messages+import GF.Command.Abstract(isOpt,getCommandOp)+import GF.Command.CommandInfo++import GF.Data.Operations((++++))+import qualified Data.Map as Map+++commandHelpAll' allCommands opts = unlines $+ commandHelp' opts (isOpt "full" opts) `map` Map.toList allCommands++commandHelp' opts = if isOpt "t2t" opts then commandHelpTags else commandHelp++--commandHelp :: Bool -> (String,CommandInfo env) -> String+commandHelp full (co,info) = unlines . compact $ [+ co ++ optionally (", " ++) (longname info),+ synopsis info] ++ if full then [+ "",+ optionally (("syntax:" ++++).(" "++).(++"\n")) (syntax info),+ explanation info,+ section "options:" [" -" ++ o ++ "\t" ++ e | (o,e) <- options info],+ section "flags:" [" -" ++ o ++ "\t" ++ e | (o,e) <- flags info],+ section "examples:" [" " ++ o ++ "\t--" ++ e | (o,e) <- examples info]+ ] else []++-- for printing with txt2tags formatting++--commandHelpTags :: Bool -> (String,CommandInfo env) -> String+commandHelpTags full (co,info) = unlines . compact $ [+ "#VSPACE","",+ "===="++hdrname++"====",+ "#NOINDENT",+ name ++ ": " +++ "//" ++ synopsis info ++ ".//"] ++ if full then [+ "","#TINY","",+ explanation info,+ optionally ("- Syntax: "++) (lit (syntax info)),+ section "- Options:\n" [" | ``-" ++ o ++ "`` | " ++ e | (o,e) <- options info],+ section "- Flags:\n" [" | ``-" ++ o ++ "`` | " ++ e | (o,e) <- flags info],+ section "- Examples:\n" [" | ``" ++ o ++ "`` | " ++ e | (o,e) <- examples info],+ "", "#NORMAL", ""+ ] else []+ where+ hdrname = co ++ equal (longname info)+ name = lit co ++ equal (lit (longname info))++ lit = optionally (wrap "``")+ equal = optionally (" = "++)+-- verbatim = optionally (wrap ["```"])+ wrap d s = d++s++d++section hdr = optionally ((hdr++++).unlines)++optionally f [] = []+optionally f s = f s++compact [] = []+compact ([]:xs@([]:_)) = compact xs+compact (x:xs) = x:compact xs++helpCommand allCommands =+ ("h", emptyCommandInfo {+ longname = "help",+ syntax = "h (-full)? COMMAND?",+ synopsis = "get description of a command, or a the full list of commands",+ explanation = unlines [+ "Displays information concerning the COMMAND.",+ "Without argument, shows the synopsis of all commands."+ ],+ options = [+ ("changes","give a summary of changes from GF 2.9"),+ ("coding","give advice on character encoding"),+ ("full","give full information of the commands"),+ ("license","show copyright and license information"),+ ("t2t","output help in txt2tags format")+ ],+ exec = \opts args ->+ let+ msg = case toStrings args of+ _ | isOpt "changes" opts -> changesMsg+ _ | isOpt "coding" opts -> codingMsg+ _ | isOpt "license" opts -> licenseMsg+ [s] -> let co = getCommandOp s in+ case Map.lookup co allCommands of+ Just info -> commandHelp' opts True (co,info)+ _ -> "command not found"+ _ -> commandHelpAll' allCommands opts+ in return (fromString msg),+ needsTypeCheck = False+ })
@@ -0,0 +1,62 @@+module GF.Command.Importing (importGrammar, importSource) where++import PGF+import PGF.Internal(optimizePGF,unionPGF,msgUnionPGF)++import GF.Compile+import GF.Compile.Multi (readMulti)+import GF.Compile.GetGrammar (getBNFCRules, getEBNFRules)+import GF.Grammar (SourceGrammar) -- for cc command+import GF.Grammar.BNFC+import GF.Grammar.EBNF+import GF.Grammar.CFG+import GF.Compile.CFGtoPGF+import GF.Infra.UseIO(die,tryIOE)+import GF.Infra.Option+import GF.Data.ErrM++import System.FilePath+import qualified Data.Set as Set++-- import a grammar in an environment where it extends an existing grammar+importGrammar :: PGF -> Options -> [FilePath] -> IO PGF+importGrammar pgf0 _ [] = return pgf0+importGrammar pgf0 opts files =+ case takeExtensions (last files) of+ ".cf" -> importCF opts files getBNFCRules bnfc2cf+ ".ebnf" -> importCF opts files getEBNFRules ebnf2cf+ ".gfm" -> do+ ascss <- mapM readMulti files+ let cs = concatMap snd ascss+ importGrammar pgf0 opts cs+ s | elem s [".gf",".gfo"] -> do+ res <- tryIOE $ compileToPGF opts files+ case res of+ Ok pgf2 -> ioUnionPGF pgf0 pgf2+ Bad msg -> do putStrLn ('\n':'\n':msg)+ return pgf0+ ".pgf" -> do+ pgf2 <- mapM readPGF files >>= return . foldl1 unionPGF+ ioUnionPGF pgf0 pgf2+ ext -> die $ "Unknown filename extension: " ++ show ext++ioUnionPGF :: PGF -> PGF -> IO PGF+ioUnionPGF one two = case msgUnionPGF one two of+ (pgf, Just msg) -> putStrLn msg >> return pgf+ (pgf,_) -> return pgf++importSource :: Options -> [FilePath] -> IO SourceGrammar+importSource opts files = fmap (snd.snd) (batchCompile opts files)++-- for different cf formats+importCF opts files get convert = impCF+ where+ impCF = do+ rules <- fmap (convert . concat) $ mapM (get opts) files+ startCat <- case rules of+ (Rule cat _ _ : _) -> return cat+ _ -> fail "empty CFG"+ let pgf = cf2pgf (last files) (mkCFG startCat Set.empty rules)+ probs <- maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf+ return $ setProbabilities probs + $ if flag optOptimizePGF opts then optimizePGF pgf else pgf
@@ -0,0 +1,113 @@+module GF.Command.Interpreter (+ CommandEnv(..),mkCommandEnv,+ interpretCommandLine,+ getCommandOp+ ) where+import GF.Command.CommandInfo+import GF.Command.Abstract+import GF.Command.Parse+import PGF.Internal(Expr(..))+import GF.Infra.UseIO(putStrLnE)++import Control.Monad(when)+import qualified Data.Map as Map++data CommandEnv m = CommandEnv {+ commands :: Map.Map String (CommandInfo m),+ commandmacros :: Map.Map String CommandLine,+ expmacros :: Map.Map String Expr+ }++--mkCommandEnv :: PGFEnv -> CommandEnv+mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty++--interpretCommandLine :: CommandEnv -> String -> SIO ()+interpretCommandLine env line =+ case readCommandLine line of+ Just [] -> return ()+ Just pipes -> mapM_ (interpretPipe env) pipes+ Nothing -> putStrLnE $ "command not parsed: "++line++interpretPipe env cs = do+ Piped v@(_,s) <- intercs cs void+ putStrLnE s+ return ()+ where+ intercs [] args = return args+ intercs (c:cs) (Piped (args,_)) = interc c args >>= intercs cs++ interc comm@(Command co opts arg) args =+ case co of+ '%':f -> case Map.lookup f (commandmacros env) of+ Just css ->+ do args <- getCommandTrees env False arg args+ mapM_ (interpretPipe env) (appLine args css)+ return void+ Nothing -> do+ putStrLnE $ "command macro " ++ co ++ " not interpreted"+ return void+ _ -> interpret env args comm++ appLine = map . map . appCommand++-- | macro definition applications: replace ?i by (exps !! i)+appCommand :: CommandArguments -> Command -> Command+appCommand args c@(Command i os arg) = case arg of+ AExpr e -> Command i os (AExpr (app e))+ _ -> c+ where+ xs = toExprs args++ app e = case e of+ EAbs b x e -> EAbs b x (app e)+ EApp e1 e2 -> EApp (app e1) (app e2)+ ELit l -> ELit l+ EMeta i -> xs !! i+ EFun x -> EFun x++-- | return the trees to be sent in pipe, and the output possibly printed+--interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput+interpret env trees comm = + do (info,opts,trees) <- getCommand env trees comm+ tss@(Piped (_,s)) <- exec info opts trees+ when (isOpt "tr" opts) $ putStrLnE s+ return tss++-- | analyse command parse tree to a uniform datastructure, normalizing comm name+--- the env is needed for macro lookup+--getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo PGFEnv,[Option],[Expr])+getCommand env es co@(Command c opts arg) =+ do info <- getCommandInfo env c+ checkOpts info opts+ es <- getCommandTrees env (needsTypeCheck info) arg es+ return (info,opts,es)++--getCommandInfo :: CommandEnv -> String -> Either String (CommandInfo PGFEnv)+getCommandInfo env cmd = + case Map.lookup (getCommandOp cmd) (commands env) of+ Just info -> return info+ Nothing -> fail $ "command not found: " ++ cmd++--checkOpts :: CommandInfo env -> [Option] -> Either String ()+checkOpts info opts = + case+ [o | OOpt o <- opts, notElem o ("tr" : map fst (options info))] +++ [o | OFlag o _ <- opts, notElem o (map fst (flags info))]+ of+ [] -> return () + [o] -> fail $ "option not interpreted: " ++ o+ os -> fail $ "options not interpreted: " ++ unwords os++--getCommandTrees :: CommandEnv -> Bool -> Argument -> [Expr] -> Either String [Expr]+getCommandTrees env needsTypeCheck a args =+ case a of+ AMacro m -> case Map.lookup m (expmacros env) of+ Just e -> one e+ _ -> return (Exprs []) -- report error?+ AExpr e -> if needsTypeCheck+ then one =<< typeCheckArg e+ else one e+ ATerm t -> return (Term t)+ ANoArg -> return args -- use piped+ where+ one e = return (Exprs [e]) -- ignore piped
@@ -0,0 +1,83 @@+module GF.Command.Messages where++import GF.Infra.BuildInfo(buildInfo)+import Data.Version(showVersion)+import Paths_gf(version)+++welcome = unlines [+ " ",+ " * * * ",+ " * * ",+ " * * ",+ " * ",+ " * ",+ " * * * * * * * ",+ " * * * ",+ " * * * * * * ",+ " * * * ",+ " * * * ",+ " ",+ "This is GF version "++showVersion version++". ",+ buildInfo,+ "License: see help -license. "--,+ -- Google Code is shutting down August 2015+--"Bug reports: http://code.google.com/p/grammatical-framework/issues/list"+ ]++licenseMsg = unlines [+ "Copyright (c)", + "Krasimir Angelov, Bj\246rn Bringert, H\229kan Burden, Hans-Joachim Daniels,",+ "Ramona Enache, Markus Forsberg, Thomas Hallgren, Harald Hammarstr\246m,",+ "Kristofer Johannisson, Janna Khegai, Peter Ljungl\246f, Petri M\228enp\228\228, and", + "Aarne Ranta, 1998-2010.",+ "",+ "The compiler is under GNU General Public License (GPL)",+ "while all Haskell and most GF libraries that come with the distribution are",+ "under dual GNU Lesser General Public License (LGPL) and BSD License,",+ "see LICENSE in the GF source distribution for details."+ ]++codingMsg = unlines [+ "The GF shell uses Unicode internally, but assumes user input to be UTF8",+ "and converts terminal and file output to UTF8. If your terminal is not UTF8", + "see 'help set_encoding."+ ]++changesMsg = unlines [+ "While GF 3.0 is backward compatible with source grammars, the shell commands", + "have changed from version 2.9. Below the most importand changes. Bug reports",+ "and feature requests should be sent to http://trac.haskell.org/gf/.",+ "",+ "af use wf -append",+ "at not supported",+ "eh not yet supported", + "es no longer supported; use javascript generation",+ "g not yet supported", + "l now by default multilingual",+ "ml not yet supported", + "p now by default multilingual",+ "pi not yet supported", + "pl not yet supported", + "pm subsumed to pg",+ "po not yet supported",+ "pt not yet supported", + "r not yet supported",+ "rf changed syntax",+ "rl not supported",+ "s no longer needed",+ "sa not supported",+ "sf not supported",+ "si not supported",+ "so not yet supported", + "t use pipe with l and p",+ "tb use l -treebank",+ "tl not yet supported", + "tq changed syntax",+ "ts not supported",+ "tt use ps",+ "ut not supported",+ "vg not yet supported",+ "wf changed syntax",+ "wt not supported"+ ]
@@ -0,0 +1,72 @@+module GF.Command.Parse(readCommandLine, pCommand) where++import PGF(pExpr,pIdent)+import GF.Grammar.Parser(runPartial,pTerm)+import GF.Command.Abstract++import Data.Char(isDigit,isSpace)+import Control.Monad(liftM2)+import Text.ParserCombinators.ReadP++readCommandLine :: String -> Maybe CommandLine+readCommandLine s =+ case [x | (x,cs) <- readP_to_S pCommandLine s, all isSpace cs] of+ [x] -> Just x+ _ -> Nothing++pCommandLine =+ (skipSpaces >> char '-' >> char '-' >> pTheRest >> return []) -- comment+ <+++ (sepBy (skipSpaces >> pPipe) (skipSpaces >> char ';'))++pPipe = sepBy1 (skipSpaces >> pCommand) (skipSpaces >> char '|')++pCommand = (do+ cmd <- pIdent <++ (char '%' >> fmap ('%':) pIdent)+ skipSpaces+ opts <- sepBy pOption skipSpaces+ arg <- if getCommandOp cmd == "cc" then pArgTerm else pArgument+ return (Command cmd opts arg)+ )+ <++ (do+ char '?'+ skipSpaces+ c <- pSystemCommand+ return (Command "sp" [OFlag "command" (VStr c)] ANoArg)+ )++pOption = do+ char '-'+ flg <- pIdent+ option (OOpt flg) (fmap (OFlag flg) (char '=' >> pValue))++pValue = do+ fmap VInt (readS_to_P reads)+ <+++ fmap VStr (readS_to_P reads)+ <+++ fmap VId pFilename++pFilename = liftM2 (:) (satisfy isFileFirst) (munch (not . isSpace)) where+ isFileFirst c = not (isSpace c) && not (isDigit c)++pArgument =+ option ANoArg+ (fmap AExpr pExpr+ <+++ (skipSpaces >> char '%' >> fmap AMacro pIdent))++pArgTerm = ATerm `fmap` readS_to_P sTerm+ where+ sTerm s = case runPartial pTerm s of+ Right (s,t) -> [(t,s)]+ _ -> []++pSystemCommand =+ (char '"' >> (manyTill (pEsc <++ get) (char '"')))+ <+++ pTheRest+ where+ pEsc = char '\\' >> get++pTheRest = munch (const True)
@@ -0,0 +1,286 @@+-- | Commands requiring source grammar in env+module GF.Command.SourceCommands(HasGrammar(..),sourceCommands) where+import Prelude hiding (putStrLn)+import qualified Prelude as P(putStrLn)+import Data.List(nub,isInfixOf,isPrefixOf)+import qualified Data.ByteString.UTF8 as UTF8(fromString)+import qualified Data.Map as Map++import GF.Infra.SIO(MonadSIO(..),restricted)+import GF.Infra.Option(modifyFlags,optTrace) --,noOptions+import GF.Data.Operations (chunks,err,raise)+import GF.Text.Pretty(render)+import GF.Data.Str(sstr)++import GF.Grammar hiding (Ident,isPrefixOf)+import GF.Grammar.Analyse+import GF.Grammar.Parser (runP, pExp)+import GF.Grammar.ShowTerm+import GF.Grammar.Lookup (allOpers,allOpersTo)+import GF.Compile.Rename(renameSourceTerm)+import qualified GF.Compile.Compute.ConcreteNew as CN(normalForm,resourceValues)+import GF.Compile.TypeCheck.RConcrete as TC(inferLType,ppType)+import GF.Infra.Dependencies(depGraph)+import GF.Infra.CheckM(runCheck)++import GF.Command.Abstract(Option(..),isOpt,listFlags,valueString,valStrOpts)+import GF.Command.CommandInfo++class (Monad m,MonadSIO m) => HasGrammar m where+ getGrammar :: m Grammar++sourceCommands :: HasGrammar m => Map.Map String (CommandInfo m)+sourceCommands = Map.fromList [+ ("cc", emptyCommandInfo {+ longname = "compute_concrete",+ syntax = "cc (-all | -table | -unqual)? TERM",+ synopsis = "computes concrete syntax term using a source grammar",+ explanation = unlines [+ "Compute TERM by concrete syntax definitions. Uses the topmost",+ "module (the last one imported) to resolve constant names.",+ "N.B.1 You need the flag -retain when importing the grammar, if you want",+ "the definitions to be retained after compilation.",+ "N.B.2 The resulting term is not a tree in the sense of abstract syntax",+ "and hence not a valid input to a Tree-expecting command.",+ "This command must be a line of its own, and thus cannot be a part",+ "of a pipe."+ ],+ options = [+ ("all","pick all strings (forms and variants) from records and tables"),+ ("list","all strings, comma-separated on one line"),+ ("one","pick the first strings, if there is any, from records and tables"),+ ("table","show all strings labelled by parameters"),+ ("unqual","hide qualifying module names"),+ ("trace","trace computations")+ ],+ needsTypeCheck = False, -- why not True?+ exec = withStrings compute_concrete+ }),+ ("dg", emptyCommandInfo {+ longname = "dependency_graph",+ syntax = "dg (-only=MODULES)?",+ synopsis = "print module dependency graph",+ explanation = unlines [+ "Prints the dependency graph of source modules.",+ "Requires that import has been done with the -retain flag.",+ "The graph is written in the file _gfdepgraph.dot",+ "which can be further processed by Graphviz (the system command 'dot').",+ "By default, all modules are shown, but the -only flag restricts them",+ "by a comma-separated list of patterns, where 'name*' matches modules",+ "whose name has prefix 'name', and other patterns match modules with",+ "exactly the same name. The graphical conventions are:",+ " solid box = abstract, solid ellipse = concrete, dashed ellipse = other",+ " solid arrow empty head = of, solid arrow = **, dashed arrow = open",+ " dotted arrow = other dependency"+ ],+ flags = [+ ("only","list of modules included (default: all), literally or by prefix*")+ ],+ examples = [+ mkEx "dg -only=SyntaxEng,Food* -- shows only SyntaxEng, and those with prefix Food"+ ],+ needsTypeCheck = False,+ exec = withStrings dependency_graph+ }),+ ("sd", emptyCommandInfo {+ longname = "show_dependencies",+ syntax = "sd QUALIFIED_CONSTANT+",+ synopsis = "show all constants that the given constants depend on",+ explanation = unlines [+ "Show recursively all qualified constant names, by tracing back the types and definitions",+ "of each constant encountered, but just listing every name once.",+ "This command requires a source grammar to be in scope, imported with 'import -retain'.",+ "Notice that the accuracy is better if the modules are compiled with the flag -optimize=noexpand.",+ "This command must be a line of its own, and thus cannot be a part of a pipe."+ ],+ options = [+ ("size","show the size of the source code for each constants (number of constructors)")+ ],+ examples = [+ mkEx "sd ParadigmsEng.mkV ParadigmsEng.mkN -- show all constants on which mkV and mkN depend",+ mkEx "sd -size ParadigmsEng.mkV -- show all constants on which mkV depends, together with size"+ ],+ needsTypeCheck = False,+ exec = withStrings show_deps+ }),++ ("so", emptyCommandInfo {+ longname = "show_operations",+ syntax = "so (-grep=STRING)* TYPE?",+ synopsis = "show all operations in scope, possibly restricted to a value type",+ explanation = unlines [+ "Show the names and type signatures of all operations available in the current resource.",+ "This command requires a source grammar to be in scope, imported with 'import -retain'.",+ "The operations include the parameter constructors that are in scope.",+ "The optional TYPE filters according to the value type.",+ "The grep STRINGs filter according to other substrings of the type signatures."{-,+ "This command must be a line of its own, and thus cannot be a part",+ "of a pipe."-}+ ],+ flags = [+ ("grep","substring used for filtering (the command can have many of these)")+ ],+ options = [+ ("raw","show the types in computed forms (instead of category names)")+ ],+ examples = [+ mkEx "so Det -- show all opers that create a Det",+ mkEx "so -grep=Prep -- find opers relating to Prep",+ mkEx "so | wf -file=/tmp/opers -- write the list of opers to a file"+ ],+ needsTypeCheck = False,+ exec = withStrings show_operations+ }),++ ("ss", emptyCommandInfo {+ longname = "show_source",+ syntax = "ss (-strip)? (-save)? MODULE*",+ synopsis = "show the source code of modules in scope, possibly just headers",+ explanation = unlines [+ "Show compiled source code, i.e. as it is included in GF object files.",+ "This command requires a source grammar to be in scope, imported with 'import -retain'.",+ "The optional MODULE arguments cause just these modules to be shown.",+ "The -size and -detailedsize options show code size as the number of constructor nodes.",+ "This command must be a line of its own, and thus cannot be a part of a pipe."+ ],+ options = [+ ("detailedsize", "instead of code, show the sizes of all judgements and modules"),+ ("save", "save each MODULE in file MODULE.gfh instead of printing it on terminal"),+ ("size", "instead of code, show the sizes of all modules"),+ ("strip","show only type signatures of oper's and lin's, not their definitions")+ ],+ examples = [+ mkEx "ss -- print complete current source grammar on terminal",+ mkEx "ss -strip -save MorphoFin -- print the headers in file MorphoFin.gfh"+ ],+ needsTypeCheck = False,+ exec = withStrings show_source+ })+ ]+ where+ withStrings exec opts ts =+ do sgr <- getGrammar+ liftSIO (exec opts (toStrings ts) sgr)++ compute_concrete opts ws sgr =+ case runP pExp (UTF8.fromString s) of+ Left (_,msg) -> return $ pipeMessage msg+ Right t -> return $ err pipeMessage+ (fromString . showTerm sgr style q)+ $ checkComputeTerm opts sgr t+ where+ (style,q) = pOpts TermPrintDefault Qualified opts+ s = unwords ws++ pOpts style q [] = (style,q)+ pOpts style q (o:os) =+ case o of+ OOpt "table" -> pOpts TermPrintTable q os+ OOpt "all" -> pOpts TermPrintAll q os+ OOpt "list" -> pOpts TermPrintList q os+ OOpt "one" -> pOpts TermPrintOne q os+ OOpt "default" -> pOpts TermPrintDefault q os+ OOpt "unqual" -> pOpts style Unqualified os+ OOpt "qual" -> pOpts style Qualified os+ _ -> pOpts style q os++ show_deps os xs sgr = do+ ops <- case xs of+ _:_ -> do+ let ts = [t | Right t <- map (runP pExp . UTF8.fromString) xs]+ err error (return . nub . concat) $ mapM (constantDepsTerm sgr) ts+ _ -> error "expected one or more qualified constants as argument"+ let prTerm = showTerm sgr TermPrintDefault Qualified+ let size = sizeConstant sgr+ let printed+ | isOpt "size" os =+ let sz = map size ops in+ unlines $ ("total: " ++ show (sum sz)) :+ [prTerm f ++ "\t" ++ show s | (f,s) <- zip ops sz]+ | otherwise = unwords $ map prTerm ops+ return $ fromString printed++ show_operations os ts sgr =+ case greatestResource sgr of+ Nothing -> return $ fromString "no source grammar in scope; did you import with -retain?"+ Just mo -> do+ let greps = map valueString (listFlags "grep" os)+ let isRaw = isOpt "raw" os+ ops <- case ts of+ _:_ -> do+ let Right t = runP pExp (UTF8.fromString (unwords ts))+ ty <- err error return $ checkComputeTerm os sgr t+ return $ allOpersTo sgr ty+ _ -> return $ allOpers sgr+ let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]+ let printer = if isRaw+ then showTerm sgr TermPrintDefault Qualified+ else (render . TC.ppType)+ let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]+ return . fromString $ unlines [l | l <- printed, all (`isInfixOf` l) greps]++ show_source os ts sgr = do+ let strip = if isOpt "strip" os then stripSourceGrammar else id+ let mygr = strip $ case ts of+ _:_ -> mGrammar [(i,m) | (i,m) <- modules sgr, elem (render i) ts]+ [] -> sgr+ case () of+ _ | isOpt "detailedsize" os ->+ return . fromString $ printSizesGrammar mygr+ _ | isOpt "size" os -> do+ let sz = sizesGrammar mygr+ return . fromStrings $+ ("total\t" ++ show (fst sz)):+ [render j ++ "\t" ++ show (fst k) | (j,k) <- snd sz]+ _ | isOpt "save" os ->+ do mapM_ saveModule (modules mygr)+ return void+ where+ saveModule m@(i,_) =+ let file = (render i ++ ".gfh")+ in restricted $+ do writeFile file (render (ppModule Qualified m))+ P.putStrLn ("wrote " ++ file)++ _ -> return . fromString $ render mygr++ dependency_graph opts ws sgr =+ do let stop = case valStrOpts "only" "" opts of+ "" -> Nothing+ fs -> Just $ chunks ',' fs+ restricted $+ do writeFile "_gfdepgraph.dot" (depGraph stop sgr)+ P.putStrLn "wrote graph in file _gfdepgraph.dot"+ return void++checkComputeTerm os sgr t =+ do mo <- maybe (raise "no source grammar in scope") return $+ greatestResource sgr+ ((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t+ inferLType sgr [] t+ let opts = modifyFlags (\fs->fs{optTrace=isOpt "trace" os})+ t1 = CN.normalForm (CN.resourceValues opts sgr) (L NoLoc identW) t+ t2 = evalStr t1+ checkPredefError t2+ where+ -- ** Try to compute pre{...} tokens in token sequences+ evalStr t =+ case t of+ C t1 t2 -> foldr1 C (evalC [t])+ _ -> composSafeOp evalStr t++ evalC (C t1 t2:ts) = evalC (t1:t2:ts)+ evalC (t1@(Alts t tts):ts) = case evalC ts of+ K s:ts' -> matchPrefix t tts s:K s:ts'+ ts' -> evalStr t1:ts'+ evalC (t:ts) = evalStr t:evalC ts+ evalC [] = []++ matchPrefix t0 tts0 s = foldr match1 t tts+ where+ alts@(Alts t tts) = evalStr (Alts t0 tts0)++ match1 (u,a) r = err (const alts) ok (strsFromTerm a)+ where ok as = if any (`isPrefixOf` s) (map sstr as)+ then u+ else r
@@ -0,0 +1,50 @@+module GF.Command.TreeOperations (+ treeOp,+ allTreeOps,+ treeChunks+ ) where++import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)+import Data.List++type TreeOp = [Expr] -> [Expr]++treeOp :: PGF -> String -> Maybe (Either TreeOp (CId -> TreeOp))+treeOp pgf f = fmap snd $ lookup f $ allTreeOps pgf++allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]+allTreeOps pgf = [+ ("compute",("compute by using semantic definitions (def)",+ Left $ map (compute pgf))),+ ("largest",("sort trees from largest to smallest, in number of nodes",+ Left $ largest)),+ ("nub",("remove duplicate trees",+ Left $ nub)),+ ("smallest",("sort trees from smallest to largest, in number of nodes",+ Left $ smallest)),+ ("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest",+ Left $ concatMap subtrees)),+ ("funs",("return all fun functions appearing in the tree, with duplications",+ Left $ \es -> [mkApp f [] | e <- es, f <- exprFunctions e]))+ ]++largest :: [Expr] -> [Expr]+largest = reverse . smallest++smallest :: [Expr] -> [Expr]+smallest = sortBy (\t u -> compare (exprSize t) (exprSize u))++treeChunks :: Expr -> [Expr]+treeChunks = snd . cks where+ cks t = + case unapply t of+ (t, ts) -> case unMeta t of+ Just _ -> (False,concatMap (snd . cks) ts)+ Nothing -> case unzip (map cks ts) of+ (bs,_) | and bs -> (True, [t])+ (_,cts) -> (False,concat cts)++subtrees :: Expr -> [Expr]+subtrees t = t : case unApp t of+ Just (f,ts) -> concatMap subtrees ts+ _ -> [] -- don't go under abstractions
@@ -0,0 +1,131 @@+module GF.Compile (compileToPGF, link, batchCompile, srcAbsName) where++import GF.Compile.GrammarToPGF(mkCanon2pgf)+import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,+ importsOfModule)+import GF.CompileOne(compileOne)++import GF.Grammar.Grammar(Grammar,emptyGrammar,+ abstractOfConcrete,prependModule)--,msrc,modules++import GF.Infra.Ident(ModuleName,moduleNameS)--,showIdent+import GF.Infra.Option+import GF.Infra.UseIO(IOE,FullPath,liftIO,getLibraryDirectory,putIfVerb,+ justModuleName,extendPathEnv,putStrE,putPointE)+import GF.Data.Operations(raise,(+++),err)++import Control.Monad(foldM,when,(<=<),filterM,liftM)+import GF.System.Directory(doesFileExist,getModificationTime)+import System.FilePath((</>),isRelative,dropFileName)+import qualified Data.Map as Map(empty,insert,elems) --lookup+import Data.List(nub)+import Data.Time(UTCTime)+import GF.Text.Pretty(render,($$),(<+>),nest)++import PGF.Internal(optimizePGF)+import PGF(PGF,defaultProbabilities,setProbabilities,readProbabilitiesFromFile)++-- | Compiles a number of source files and builds a 'PGF' structure for them.+-- This is a composition of 'link' and 'batchCompile'.+compileToPGF :: Options -> [FilePath] -> IOE PGF+compileToPGF opts fs = link opts . snd =<< batchCompile opts fs++-- | Link a grammar into a 'PGF' that can be used to 'PGF.linearize' and+-- 'PGF.parse' with the "PGF" run-time system.+link :: Options -> (ModuleName,Grammar) -> IOE PGF+link opts (cnc,gr) =+ putPointE Normal opts "linking ... " $ do+ let abs = srcAbsName gr cnc+ pgf <- mkCanon2pgf opts gr abs+ probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)+ when (verbAtLeast opts Normal) $ putStrE "OK"+ return $ setProbabilities probs + $ if flag optOptimizePGF opts then optimizePGF pgf else pgf++-- | Returns the name of the abstract syntax corresponding to the named concrete syntax+srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc++-- | Compile the given grammar files and everything they depend on.+-- Compiled modules are stored in @.gfo@ files (unless the @-tags@ option is+-- used, in which case tags files are produced instead).+-- Existing @.gfo@ files are reused if they are up-to-date+-- (unless the option @-src@ aka @-force-recomp@ is used).+batchCompile :: Options -> [FilePath] -> IOE (UTCTime,(ModuleName,Grammar))+batchCompile opts files = do+ (gr,menv) <- foldM (compileModule opts) emptyCompileEnv files+ let cnc = moduleNameS (justModuleName (last files))+ t = maximum . map fst $ Map.elems menv+ return (t,(cnc,gr))+{-+-- to compile a set of modules, e.g. an old GF or a .cf file+compileSourceGrammar :: Options -> Grammar -> IOE Grammar+compileSourceGrammar opts gr = do+ cwd <- getCurrentDirectory+ (_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing)+ emptyCompileEnv+ (modules gr)+ return gr'+-}++-- | compile with one module as starting point+-- command-line options override options (marked by --#) in the file+-- As for path: if it is read from file, the file path is prepended to each name.+-- If from command line, it is used as it is.++compileModule :: Options -- ^ Options from program command line and shell command.+ -> CompileEnv -> FilePath -> IOE CompileEnv+compileModule opts1 env@(_,rfs) file =+ do file <- getRealFile file+ opts0 <- getOptionsFromFile file+ let curr_dir = dropFileName file+ lib_dirs <- getLibraryDirectory (addOptions opts0 opts1)+ let opts = addOptions (fixRelativeLibPaths curr_dir lib_dirs opts0) opts1+-- putIfVerb opts $ "curr_dir:" +++ show curr_dir ----+-- putIfVerb opts $ "lib_dir:" +++ show lib_dirs ----+ ps0 <- extendPathEnv opts+ let ps = nub (curr_dir : ps0)+-- putIfVerb opts $ "options from file: " ++ show opts0+-- putIfVerb opts $ "augmented options: " ++ show opts+ putIfVerb opts $ "module search path:" +++ show ps ----+ files <- getAllFiles opts ps rfs file+ putIfVerb opts $ "files to read:" +++ show files ----+ let names = map justModuleName files+ putIfVerb opts $ "modules to include:" +++ show names ----+ foldM (compileOne' opts) env files+ where+ getRealFile file = do+ exists <- doesFileExist file+ if exists+ then return file+ else if isRelative file+ then do+ lib_dirs <- getLibraryDirectory opts1+ let candidates = [ lib_dir </> file | lib_dir <- lib_dirs ]+ putIfVerb opts1 (render ("looking for: " $$ nest 2 candidates))+ file1s <- filterM doesFileExist candidates+ case length file1s of+ 0 -> raise (render ("Unable to find: " $$ nest 2 candidates))+ 1 -> do return $ head file1s+ _ -> do putIfVerb opts1 ("matched multiple candidates: " +++ show file1s)+ return $ head file1s+ else raise (render ("File" <+> file <+> "does not exist"))++compileOne' :: Options -> CompileEnv -> FullPath -> IOE CompileEnv+compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr++-- auxiliaries++-- | The environment+type CompileEnv = (Grammar,ModEnv)++emptyCompileEnv :: CompileEnv+emptyCompileEnv = (emptyGrammar,Map.empty)++extendCompileEnv (gr,menv) (mfile,mo) =+ do menv2 <- case mfile of+ Just file ->+ do let (mod,imps) = importsOfModule mo+ t <- getModificationTime file+ return $ Map.insert mod (t,imps) menv+ _ -> return menv+ return (prependModule gr mo,menv2)
@@ -0,0 +1,134 @@+{-# LANGUAGE FlexibleContexts #-}+module GF.Compile.CFGtoPGF (cf2pgf) where++import GF.Grammar.CFG+import GF.Infra.UseIO++import PGF+import PGF.Internal++import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import Data.Array.IArray+import Data.List++--------------------------+-- the compiler ----------+--------------------------++cf2pgf :: FilePath -> ParamCFG -> PGF+cf2pgf fpath cf = + let pgf = PGF Map.empty aname (cf2abstr cf) (Map.singleton cname (cf2concr cf))+ in updateProductionIndices pgf+ where+ name = justModuleName fpath+ aname = mkCId (name ++ "Abs")+ cname = mkCId name++cf2abstr :: ParamCFG -> Abstr+cf2abstr cfg = Abstr aflags afuns acats+ where+ aflags = Map.singleton (mkCId "startcat") (LStr (fst (cfgStartCat cfg)))++ acats = Map.fromList [(cat, ([], [(0,mkRuleName rule) | rule <- rules], 0))+ | (cat,rules) <- (Map.toList . Map.fromListWith (++))+ [(cat2id cat, catRules cfg cat) | + cat <- allCats' cfg]]+ afuns = Map.fromList [(mkRuleName rule, (cftype [cat2id c | NonTerminal c <- ruleRhs rule] (cat2id (ruleLhs rule)), 0, Nothing, 0))+ | rule <- allRules cfg]++ cat2id = mkCId . fst++cf2concr :: ParamCFG -> Concr+cf2concr cfg = Concr Map.empty Map.empty+ cncfuns lindefsrefs lindefsrefs+ sequences productions+ IntMap.empty Map.empty+ cnccats+ IntMap.empty+ totalCats+ where+ cats = allCats' cfg+ rules = allRules cfg++ sequences0 = Set.fromList (listArray (0,0) [SymCat 0 0] : + map mkSequence rules)+ sequences = listArray (0,Set.size sequences0-1) (Set.toList sequences0)++ idFun = CncFun wildCId (listArray (0,0) [seqid])+ where+ seq = listArray (0,0) [SymCat 0 0]+ seqid = binSearch seq sequences (bounds sequences)+ ((fun_cnt,cncfuns0),productions0) = mapAccumL (convertRule cs) (1,[idFun]) rules+ productions = foldl addProd IntMap.empty (concat (productions0++coercions))+ cncfuns = listArray (0,fun_cnt-1) (reverse cncfuns0)++ lbls = listArray (0,0) ["s"]+ (fid,cnccats0) = (mapAccumL mkCncCat 0 . Map.toList . Map.fromListWith max)+ [(c,p) | (c,ps) <- cats, p <- ps]+ ((totalCats,cs), coercions) = mapAccumL mkCoercions (fid,Map.empty) cats+ cnccats = Map.fromList cnccats0++ lindefsrefs =+ IntMap.fromList (map mkLinDefRef cats)++ convertRule cs (funid,funs) rule =+ let args = [PArg [] (cat2arg c) | NonTerminal c <- ruleRhs rule]+ prod = PApply funid args+ seqid = binSearch (mkSequence rule) sequences (bounds sequences)+ fun = CncFun (mkRuleName rule) (listArray (0,0) [seqid])+ funid' = funid+1+ in funid' `seq` ((funid',fun:funs),let (c,ps) = ruleLhs rule in [(cat2fid c p, prod) | p <- ps])++ mkSequence rule = listArray (0,length syms-1) syms+ where+ syms = snd $ mapAccumL convertSymbol 0 (ruleRhs rule)++ convertSymbol d (NonTerminal (c,_)) = (d+1,if c `elem` ["Int","Float","String"] then SymLit d 0 else SymCat d 0)+ convertSymbol d (Terminal t) = (d, SymKS t)++ mkCncCat fid (cat,n)+ | cat == "Int" = (fid, (mkCId cat, CncCat fidInt fidInt lbls))+ | cat == "Float" = (fid, (mkCId cat, CncCat fidFloat fidFloat lbls))+ | cat == "String" = (fid, (mkCId cat, CncCat fidString fidString lbls))+ | otherwise = let fid' = fid+n+1+ in fid' `seq` (fid', (mkCId cat,CncCat fid (fid+n) lbls))++ mkCoercions (fid,cs) c@(cat,[p]) = ((fid,cs),[])+ mkCoercions (fid,cs) c@(cat,ps ) =+ let fid' = fid+1+ in fid' `seq` ((fid', Map.insert c fid cs), [(fid,PCoerce (cat2fid cat p)) | p <- ps])++ mkLinDefRef (cat,_) =+ (cat2fid cat 0,[0])+ + addProd prods (fid,prod) =+ case IntMap.lookup fid prods of+ Just set -> IntMap.insert fid (Set.insert prod set) prods+ Nothing -> IntMap.insert fid (Set.singleton prod) prods++ binSearch v arr (i,j)+ | i <= j = case compare v (arr ! k) of+ LT -> binSearch v arr (i,k-1)+ EQ -> k+ GT -> binSearch v arr (k+1,j)+ | otherwise = error "binSearch"+ where+ k = (i+j) `div` 2++ cat2fid cat p =+ case Map.lookup (mkCId cat) cnccats of+ Just (CncCat fid _ _) -> fid+p+ _ -> error "cat2fid"++ cat2arg c@(cat,[p]) = cat2fid cat p+ cat2arg c@(cat,ps ) =+ case Map.lookup c cs of+ Just fid -> fid+ Nothing -> error "cat2arg"++mkRuleName rule =+ case ruleName rule of+ CFObj n _ -> n+ _ -> wildCId
@@ -0,0 +1,325 @@+----------------------------------------------------------------------+-- |+-- Module : CheckGrammar+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/11 23:24:33 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.31 $+--+-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003+--+-- type checking also does the following modifications:+--+-- - types of operations and local constants are inferred and put in place+--+-- - both these types and linearization types are computed+--+-- - tables are type-annotated+-----------------------------------------------------------------------------++module GF.Compile.CheckGrammar(checkModule) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import GF.Infra.Ident+import GF.Infra.Option++import GF.Compile.TypeCheck.Abstract+import GF.Compile.TypeCheck.RConcrete+import qualified GF.Compile.TypeCheck.ConcreteNew as CN+import qualified GF.Compile.Compute.ConcreteNew as CN++import GF.Grammar+import GF.Grammar.Lexer+import GF.Grammar.Lookup+--import GF.Grammar.Predef+--import GF.Grammar.PatternMatch++import GF.Data.Operations+import GF.Infra.CheckM++import Data.List+import qualified Data.Set as Set+import Control.Monad+import GF.Text.Pretty++-- | checking is performed in the dependency order of modules+checkModule :: Options -> FilePath -> SourceGrammar -> SourceModule -> Check SourceModule+checkModule opts cwd sgr mo@(m,mi) = do+ checkRestrictedInheritance cwd sgr mo+ mo <- case mtype mi of+ MTConcrete a -> do let gr = prependModule sgr mo+ abs <- lookupModule gr a+ checkCompleteGrammar opts cwd gr (a,abs) mo+ _ -> return mo+ infoss <- checkInModule cwd mi NoLoc empty $ topoSortJments2 mo+ foldM updateCheckInfos mo infoss+ where+ updateCheckInfos mo = fmap (foldl update mo) . parallelCheck . map check+ where check (i,info) = fmap ((,) i) (checkInfo opts cwd sgr mo i info)+ update mo@(m,mi) (i,info) = (m,mi{jments=updateTree (i,info) (jments mi)})++-- check if restricted inheritance modules are still coherent+-- i.e. that the defs of remaining names don't depend on omitted names+checkRestrictedInheritance :: FilePath -> SourceGrammar -> SourceModule -> Check ()+checkRestrictedInheritance cwd sgr (name,mo) = checkInModule cwd mo NoLoc empty $ do+ let irs = [ii | ii@(_,mi) <- mextend mo, mi /= MIAll] -- names with restr. inh.+ let mrs = [((i,m),mi) | (i,m) <- mos, Just mi <- [lookup i irs]]+ -- the restr. modules themself, with restr. infos+ mapM_ checkRem mrs+ where+ mos = modules sgr+ checkRem ((i,m),mi) = do+ let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))+ let incld c = Set.member c (Set.fromList incl)+ let illegal c = Set.member c (Set.fromList excl)+ let illegals = [(f,is) | + (f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]+ case illegals of + [] -> return ()+ cs -> checkWarn ("In inherited module" <+> i <> ", dependence of excluded constants:" $$+ nest 2 (vcat [f <+> "on" <+> fsep is | (f,is) <- cs]))+ allDeps = concatMap (allDependencies (const True) . jments . snd) mos++checkCompleteGrammar :: Options -> FilePath -> Grammar -> Module -> Module -> Check Module+checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc empty $ do+ let jsa = jments abs+ let jsc = jments cnc++ -- check that all concrete constants are in abstract; build types for all lin+ jsc <- foldM checkCnc emptyBinTree (tree2list jsc)++ -- check that all abstract constants are in concrete; build default lin and lincats+ jsc <- foldM checkAbs jsc (tree2list jsa)+ + return (cm,cnc{jments=jsc})+ where+ checkAbs js i@(c,info) =+ case info of+ AbsFun (Just (L loc ty)) _ _ _ + -> do let mb_def = do+ let (cxt,(_,i),_) = typeForm ty+ info <- lookupIdent i js+ info <- case info of+ (AnyInd _ m) -> do (m,info) <- lookupOrigInfo gr (m,i)+ return info+ _ -> return info+ case info of+ CncCat (Just (L loc (RecType []))) _ _ _ _ -> return (foldr (\_ -> Abs Explicit identW) (R []) cxt)+ _ -> Bad "no def lin"++ case lookupIdent c js of+ Ok (AnyInd _ _) -> return js+ Ok (CncFun ty (Just def) mn mf) ->+ return $ updateTree (c,CncFun ty (Just def) mn mf) js+ Ok (CncFun ty Nothing mn mf) ->+ case mb_def of+ Ok def -> return $ updateTree (c,CncFun ty (Just (L NoLoc def)) mn mf) js+ Bad _ -> do noLinOf c+ return js+ _ -> do+ case mb_def of+ Ok def -> do (cont,val) <- linTypeOfType gr cm ty+ let linty = (snd (valCat ty),cont,val)+ return $ updateTree (c,CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js+ Bad _ -> do noLinOf c+ return js+ where noLinOf c = checkWarn ("no linearization of" <+> c)+ AbsCat (Just _) -> case lookupIdent c js of+ Ok (AnyInd _ _) -> return js+ Ok (CncCat (Just _) _ _ _ _) -> return js+ Ok (CncCat Nothing md mr mp mpmcfg) -> do+ checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")+ return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js+ _ -> do+ checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")+ return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing Nothing) js+ _ -> return js+ + checkCnc js i@(c,info) =+ case info of+ CncFun _ d mn mf -> case lookupOrigInfo gr (am,c) of+ Ok (_,AbsFun (Just (L _ ty)) _ _ _) -> + do (cont,val) <- linTypeOfType gr cm ty+ let linty = (snd (valCat ty),cont,val)+ return $ updateTree (c,CncFun (Just linty) d mn mf) js+ _ -> do checkWarn ("function" <+> c <+> "is not in abstract")+ return js+ CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of+ Ok _ -> return $ updateTree i js+ _ -> do checkWarn ("category" <+> c <+> "is not in abstract")+ return js+ _ -> return $ updateTree i js+++-- | General Principle: only Just-values are checked. +-- A May-value has always been checked in its origin module.+checkInfo :: Options -> FilePath -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info+checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do+ checkReservedId c+ case info of+ AbsCat (Just (L loc cont)) -> + mkCheck loc "the category" $ + checkContext gr cont++ AbsFun (Just (L loc typ0)) ma md moper -> do+ typ <- compAbsTyp [] typ0 -- to calculate let definitions+ mkCheck loc "the type of function" $+ checkTyp gr typ+ case md of+ Just eqs -> mapM_ (\(L loc eq) -> mkCheck loc "the definition of function" $+ checkDef gr (m,c) typ eq) eqs+ Nothing -> return ()+ return (AbsFun (Just (L loc typ)) ma md moper)++ CncCat mty mdef mref mpr mpmcfg -> do+ mty <- case mty of+ Just (L loc typ) -> chIn loc "linearization type of" $ + (if False --flag optNewComp opts+ then do (typ,_) <- CN.checkLType (CN.resourceValues opts gr) typ typeType+ typ <- computeLType gr [] typ+ return (Just (L loc typ))+ else do (typ,_) <- checkLType gr [] typ typeType+ typ <- computeLType gr [] typ+ return (Just (L loc typ)))+ Nothing -> return Nothing+ mdef <- case (mty,mdef) of+ (Just (L _ typ),Just (L loc def)) -> + chIn loc "default linearization of" $ do+ (def,_) <- checkLType gr [] def (mkFunType [typeStr] typ)+ return (Just (L loc def))+ _ -> return Nothing+ mref <- case (mty,mref) of+ (Just (L _ typ),Just (L loc ref)) -> + chIn loc "reference linearization of" $ do+ (ref,_) <- checkLType gr [] ref (mkFunType [typ] typeStr)+ return (Just (L loc ref))+ _ -> return Nothing+ mpr <- case mpr of+ (Just (L loc t)) -> + chIn loc "print name of" $ do+ (t,_) <- checkLType gr [] t typeStr+ return (Just (L loc t))+ _ -> return Nothing+ return (CncCat mty mdef mref mpr mpmcfg)++ CncFun mty mt mpr mpmcfg -> do+ mt <- case (mty,mt) of+ (Just (cat,cont,val),Just (L loc trm)) -> + chIn loc "linearization of" $ do+ (trm,_) <- checkLType gr [] trm (mkFunType (map (\(_,_,ty) -> ty) cont) val) -- erases arg vars+ return (Just (L loc trm))+ _ -> return mt+ mpr <- case mpr of+ (Just (L loc t)) -> + chIn loc "print name of" $ do+ (t,_) <- checkLType gr [] t typeStr+ return (Just (L loc t))+ _ -> return Nothing+ return (CncFun mty mt mpr mpmcfg)++ ResOper pty pde -> do+ (pty', pde') <- case (pty,pde) of+ (Just (L loct ty), Just (L locd de)) -> do+ ty' <- chIn loct "operation" $+ (if False --flag optNewComp opts+ then CN.checkLType (CN.resourceValues opts gr) ty typeType >>= return . CN.normalForm (CN.resourceValues opts gr) (L loct c) . fst -- !!+ else checkLType gr [] ty typeType >>= computeLType gr [] . fst)+ (de',_) <- chIn locd "operation" $+ (if False -- flag optNewComp opts+ then CN.checkLType (CN.resourceValues opts gr) de ty'+ else checkLType gr [] de ty')+ return (Just (L loct ty'), Just (L locd de'))+ (Nothing , Just (L locd de)) -> do+ (de',ty') <- chIn locd "operation" $+ (if False -- flag optNewComp opts+ then CN.inferLType (CN.resourceValues opts gr) de+ else inferLType gr [] de)+ return (Just (L locd ty'), Just (L locd de'))+ (Just (L loct ty), Nothing) -> do+ chIn loct "operation" $+ checkError (pp "No definition given to the operation")+ return (ResOper pty' pde')++ ResOverload os tysts -> chIn NoLoc "overloading" $ do+ tysts' <- mapM (uncurry $ flip (\(L loc1 t) (L loc2 ty) -> checkLType gr [] t ty >>= \(t,ty) -> return (L loc1 t, L loc2 ty))) tysts -- return explicit ones+ tysts0 <- lookupOverload gr (m,c) -- check against inherited ones too+ tysts1 <- mapM (uncurry $ flip (checkLType gr [])) + [(mkFunType args val,tr) | (args,(val,tr)) <- tysts0]+ --- this can only be a partial guarantee, since matching+ --- with value type is only possible if expected type is given+ checkUniq $ + sort [let (xs,t) = typeFormCnc x in t : map (\(b,x,t) -> t) xs | (_,x) <- tysts1]+ return (ResOverload os [(y,x) | (x,y) <- tysts'])++ ResParam (Just (L loc pcs)) _ -> do+ ts <- chIn loc "parameter type" $ + liftM concat $ mapM mkPar pcs+ return (ResParam (Just (L loc pcs)) (Just ts))++ _ -> return info+ where+ gr = prependModule sgr (m,mo)+ chIn loc cat = checkInModule cwd mo loc ("Happened in" <+> cat <+> c)++ mkPar (f,co) = do+ vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co+ return $ map (mkApp (QC (m,f))) vs++ checkUniq xss = case xss of+ x:y:xs + | x == y -> checkError $ "ambiguous for type" <+>+ ppType (mkFunType (tail x) (head x)) + | otherwise -> checkUniq $ y:xs+ _ -> return ()++ mkCheck loc cat ss = case ss of+ [] -> return info+ _ -> chIn loc cat $ checkError (vcat ss)++ compAbsTyp g t = case t of+ Vr x -> maybe (checkError ("no value given to variable" <+> x)) return $ lookup x g+ Let (x,(_,a)) b -> do+ a' <- compAbsTyp g a+ compAbsTyp ((x, a'):g) b+ Prod b x a t -> do+ a' <- compAbsTyp g a+ t' <- compAbsTyp ((x,Vr x):g) t+ return $ Prod b x a' t'+ Abs _ _ _ -> return t+ _ -> composOp (compAbsTyp g) t +++-- | for grammars obtained otherwise than by parsing ---- update!!+checkReservedId :: Ident -> Check ()+checkReservedId x =+ when (isReservedWord x) $+ checkWarn ("reserved word used as identifier:" <+> x)++-- auxiliaries++-- | linearization types and defaults+linTypeOfType :: Grammar -> ModuleName -> Type -> Check (Context,Type)+linTypeOfType cnc m typ = do+ let (cont,cat) = typeSkeleton typ+ val <- lookLin cat+ args <- mapM mkLinArg (zip [0..] cont)+ return (args, val)+ where+ mkLinArg (i,(n,mc@(m,cat))) = do+ val <- lookLin mc+ let vars = mkRecType varLabel $ replicate n typeStr+ symb = argIdent n cat i+ rec <- if n==0 then return val else+ errIn (render ("extending" $$+ nest 2 vars $$+ "with" $$+ nest 2 val)) $+ plusRecType vars val+ return (Explicit,symb,rec)+ lookLin (_,c) = checks [ --- rather: update with defLinType ?+ lookupLincat cnc m c >>= computeLType cnc []+ ,return defLinType+ ]
@@ -0,0 +1,64 @@+module GF.Compile.Coding where+{-+import GF.Grammar.Grammar+import GF.Grammar.Macros+import GF.Text.Coding+--import GF.Infra.Option+import GF.Data.Operations++--import Data.Char+import System.IO+import qualified Data.ByteString.Char8 as BS++encodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule+encodeStringsInModule enc = codeSourceModule (BS.unpack . encodeUnicode enc)++decodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule+decodeStringsInModule enc mo = codeSourceModule (decodeUnicode enc . BS.pack) mo++codeSourceModule :: (String -> String) -> SourceModule -> SourceModule+codeSourceModule co (id,mo) = (id,mo{jments = mapTree codj (jments mo)})+ where+ codj (c,info) = case info of+ ResOper pty pt -> ResOper (codeLTerms co pty) (codeLTerms co pt) + ResOverload es tyts -> ResOverload es [(codeLTerm co ty,codeLTerm co t) | (ty,t) <- tyts]+ CncCat mcat mdef mref mpr mpmcfg -> CncCat mcat (codeLTerms co mdef) (codeLTerms co mref) (codeLTerms co mpr) mpmcfg+ CncFun mty mt mpr mpmcfg -> CncFun mty (codeLTerms co mt) (codeLTerms co mpr) mpmcfg+ _ -> info++codeLTerms co = fmap (codeLTerm co)++codeLTerm :: (String -> String) -> L Term -> L Term+codeLTerm = fmap . codeTerm++codeTerm :: (String -> String) -> Term -> Term+codeTerm co = codt+ where+ codt t = case t of+ K s -> K (co s)+ T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]+ EPatt p -> EPatt (codp p)+ _ -> composSafeOp codt t++ codp p = case p of --- really: composOpPatt+ PR rs -> PR [(l,codp p) | (l,p) <- rs]+ PString s -> PString (co s)+ PChars s -> PChars (co s)+ PT x p -> PT x (codp p)+ PAs x p -> PAs x (codp p)+ PNeg p -> PNeg (codp p)+ PRep p -> PRep (codp p)+ PSeq p q -> PSeq (codp p) (codp q)+ PAlt p q -> PAlt (codp p) (codp q)+ _ -> p++-- | Run an encoding function on all string literals within the given string.+codeStringLiterals :: (String -> String) -> String -> String+codeStringLiterals _ [] = []+codeStringLiterals co ('"':cs) = '"' : inStringLiteral cs+ where inStringLiteral [] = error "codeStringLiterals: unterminated string literal"+ inStringLiteral ('"':ds) = '"' : codeStringLiterals co ds+ inStringLiteral ('\\':d:ds) = '\\' : co [d] ++ inStringLiteral ds+ inStringLiteral (d:ds) = co [d] ++ inStringLiteral ds+codeStringLiterals co (c:cs) = c : codeStringLiterals co cs+-}
@@ -0,0 +1,138 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Compile.Abstract.Compute+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/10/02 20:50:19 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.8 $+--+-- computation in abstract syntax w.r.t. explicit definitions.+--+-- old GF computation; to be updated+-----------------------------------------------------------------------------++module GF.Compile.Compute.Abstract (LookDef,+ compute, + computeAbsTerm, + computeAbsTermIn, + beta+ ) where++import GF.Data.Operations++import GF.Grammar+import GF.Grammar.Lookup++import Debug.Trace+import Data.List(intersperse)+import Control.Monad (liftM, liftM2)+import GF.Text.Pretty++-- for debugging+tracd m t = t +-- tracd = trace++compute :: SourceGrammar -> Term -> Err Term+compute = computeAbsTerm++computeAbsTerm :: SourceGrammar -> Term -> Err Term+computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []++-- | a hack to make compute work on source grammar as well+type LookDef = Ident -> Ident -> Err (Maybe Int,Maybe [Equation])++computeAbsTermIn :: LookDef -> [Ident] -> Term -> Err Term+computeAbsTermIn lookd xs e = errIn (render (text "computing" <+> ppTerm Unqualified 0 e)) $ compt xs e where+ compt vv t = case t of+-- Prod x a b -> liftM2 (Prod x) (compt vv a) (compt (x:vv) b)+-- Abs x b -> liftM (Abs x) (compt (x:vv) b)+ _ -> do+ let t' = beta vv t+ (yy,f,aa) <- termForm t'+ let vv' = map snd yy ++ vv+ aa' <- mapM (compt vv') aa+ case look f of+ Just eqs -> tracd (text "\nmatching" <+> ppTerm Unqualified 0 f) $ + case findMatch eqs aa' of+ Ok (d,g) -> do+ --- let (xs,ts) = unzip g+ --- ts' <- alphaFreshAll vv' ts+ let g' = g --- zip xs ts'+ d' <- compt vv' $ substTerm vv' g' d+ tracd (text "by Egs:" <+> ppTerm Unqualified 0 d') $ return $ mkAbs yy $ d'+ _ -> tracd (text "no match" <+> ppTerm Unqualified 0 t') $ + do+ let v = mkApp f aa'+ return $ mkAbs yy $ v+ _ -> do+ let t2 = mkAbs yy $ mkApp f aa'+ tracd (text "not defined" <+> ppTerm Unqualified 0 t2) $ return t2++ look t = case t of+ (Q (m,f)) -> case lookd m f of+ Ok (_,md) -> md+ _ -> Nothing+ _ -> Nothing++beta :: [Ident] -> Exp -> Exp+beta vv c = case c of+ Let (x,(_,a)) b -> beta vv $ substTerm vv [(x,beta vv a)] (beta (x:vv) b) + App f a -> + let (a',f') = (beta vv a, beta vv f) in + case f' of+ Abs _ x b -> beta vv $ substTerm vv [(x,a')] (beta (x:vv) b) + _ -> (if a'==a && f'==f then id else beta vv) $ App f' a'+ Prod b x a t -> Prod b x (beta vv a) (beta (x:vv) t)+ Abs b x t -> Abs b x (beta (x:vv) t)+ _ -> c++-- special version of pattern matching, to deal with comp under lambda++findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution)+findMatch cases terms = case cases of+ [] -> Bad $ render (text "no applicable case for" <+> hcat (punctuate comma (map (ppTerm Unqualified 0) terms)))+ (patts,_):_ | length patts /= length terms -> + Bad (render (text "wrong number of args for patterns :" <+> + hsep (map (ppPatt Unqualified 0) patts) <+> text "cannot take" <+> hsep (map (ppTerm Unqualified 0) terms)))+ (patts,val):cc -> case mapM tryMatch (zip patts terms) of+ Ok substs -> return (tracd (text "value" <+> ppTerm Unqualified 0 val) val, concat substs)+ _ -> findMatch cc terms++tryMatch :: (Patt, Term) -> Err [(Ident, Term)]+tryMatch (p,t) = do + t' <- termForm t+ trym p t'+ where++ trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ---- + case (p,t') of+ (PW, _) | notMeta t -> return [] -- optimization with wildcard+ (PV x, _) | notMeta t -> return [(x,t)]+ (PString s, ([],K i,[])) | s==i -> return []+ (PInt s, ([],EInt i,[])) | s==i -> return []+ (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?+ (PP (q,p) pp, ([], QC (r,f), tt)) | + p `eqStrIdent` f && length pp == length tt -> do+ matches <- mapM tryMatch (zip pp tt)+ return (concat matches)+ (PP (q,p) pp, ([], Q (r,f), tt)) | + p `eqStrIdent` f && length pp == length tt -> do+ matches <- mapM tryMatch (zip pp tt)+ return (concat matches)+ (PT _ p',_) -> trym p' t'+ (PAs x p',_) -> do+ subst <- trym p' t'+ return $ (x,t) : subst+ _ -> Bad (render (text "no match in pattern" <+> ppPatt Unqualified 0 p <+> text "for" <+> ppTerm Unqualified 0 t))++ notMeta e = case e of+ Meta _ -> False+ App f a -> notMeta f && notMeta a + Abs _ _ b -> notMeta b+ _ -> True++ prtm p g = + ppPatt Unqualified 0 p <+> colon $$ hsep (punctuate semi [ppIdent x <+> char '=' <+> ppTerm Unqualified 0 y | (x,y) <- g])
@@ -0,0 +1,143 @@+----------------------------------------------------------------------+-- |+-- Module : AppPredefined+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/10/06 14:21:34 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.13 $+--+-- Predefined function type signatures and definitions.+-----------------------------------------------------------------------------++module GF.Compile.Compute.AppPredefined ({-+ isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined-}+ ) where+{-+import GF.Compile.TypeCheck.Primitives+import GF.Infra.Option+import GF.Data.Operations+import GF.Grammar+import GF.Grammar.Predef++import qualified Data.Map as Map+import GF.Text.Pretty+import Data.Char (isUpper,toUpper,toLower)++-- predefined function type signatures and definitions. AR 12/3/2003.++isInPredefined :: Ident -> Bool+isInPredefined f = Map.member f primitives++arrityPredefined :: Ident -> Maybe Int+arrityPredefined f = do ty <- typPredefined f+ let (ctxt,_) = typeFormCnc ty+ return (length ctxt)++predefModInfo :: SourceModInfo+predefModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] "Predef.gf" Nothing primitives++appPredefined :: Term -> Err (Term,Bool)+appPredefined t = case t of+ App f x0 -> do+ (x,_) <- appPredefined x0+ case f of+ -- one-place functions+ Q (mod,f) | mod == cPredef ->+ case x of+ (K s) | f == cLength -> retb $ EInt $ length s+ (K s) | f == cIsUpper -> retb $ if (all isUpper s) then predefTrue else predefFalse+ (K s) | f == cToUpper -> retb $ K $ map toUpper s+ (K s) | f == cToLower -> retb $ K $ map toLower s+ (K s) | f == cError -> retb $ Error s++ _ -> retb t++ -- two-place functions+ App (Q (mod,f)) z0 | mod == cPredef -> do+ (z,_) <- appPredefined z0+ case (norm z, norm x) of+ (EInt i, K s) | f == cDrop -> retb $ K (drop i s)+ (EInt i, K s) | f == cTake -> retb $ K (take i s)+ (EInt i, K s) | f == cTk -> retb $ K (take (max 0 (length s - i)) s)+ (EInt i, K s) | f == cDp -> retb $ K (drop (max 0 (length s - i)) s)+ (K s, K t) | f == cEqStr -> retb $ if s == t then predefTrue else predefFalse+ (K s, K t) | f == cOccur -> retb $ if substring s t then predefTrue else predefFalse+ (K s, K t) | f == cOccurs -> retb $ if any (flip elem t) s then predefTrue else predefFalse+ (EInt i, EInt j) | f == cEqInt -> retb $ if i==j then predefTrue else predefFalse+ (EInt i, EInt j) | f == cLessInt -> retb $ if i<j then predefTrue else predefFalse+ (EInt i, EInt j) | f == cPlus -> retb $ EInt $ i+j+ (_, t) | f == cShow && notVar t -> retb $ foldrC $ map K $ words $ render (ppTerm Unqualified 0 t)+ (_, K s) | f == cRead -> retb $ Cn (identS s) --- because of K, only works for atomic tags+ (_, t) | f == cToStr -> trm2str t >>= retb+ _ -> retb t ---- prtBad "cannot compute predefined" t++ -- three-place functions+ App (App (Q (mod,f)) z0) y0 | mod == cPredef -> do+ (y,_) <- appPredefined y0+ (z,_) <- appPredefined z0+ case (z, y, x) of+ (ty,op,t) | f == cMapStr -> retf $ mapStr ty op t+ _ | f == cEqVal && notVar y && notVar x -> retb $ if y==x then predefTrue else predefFalse+ _ -> retb t ---- prtBad "cannot compute predefined" t++ _ -> retb t ---- prtBad "cannot compute predefined" t+ _ -> retb t+ ---- should really check the absence of arg variables+ where+ retb t = return (retc t,True) -- no further computing needed+ retf t = return (retc t,False) -- must be computed further+ retc t = case t of+ K [] -> t+ K s -> foldr1 C (map K (words s))+ _ -> t+ norm t = case t of+ Empty -> K []+ C u v -> case (norm u,norm v) of+ (K x,K y) -> K (x +++ y)+ _ -> t+ _ -> t+ notVar t = case t of+ Vr _ -> False+ App f a -> notVar f && notVar a+ _ -> True ---- would need to check that t is a value+ foldrC ts = if null ts then Empty else foldr1 C ts++-- read makes variables into constants++predefTrue = QC (cPredef,cPTrue)+predefFalse = QC (cPredef,cPFalse)++substring :: String -> String -> Bool+substring s t = case (s,t) of+ (c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds+ ([],_) -> True+ _ -> False++trm2str :: Term -> Err Term+trm2str t = case t of+ R ((_,(_,s)):_) -> trm2str s+ T _ ((_,s):_) -> trm2str s+ V _ (s:_) -> trm2str s+ C _ _ -> return $ t+ K _ -> return $ t+ S c _ -> trm2str c+ Empty -> return $ t+ _ -> Bad (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t))++-- simultaneous recursion on type and term: type arg is essential!+-- But simplify the task by assuming records are type-annotated+-- (this has been done in type checking)+mapStr :: Type -> Term -> Term -> Term+mapStr ty f t = case (ty,t) of+ _ | elem ty [typeStr,typeTok] -> App f t+ (_, R ts) -> R [(l,mapField v) | (l,v) <- ts]+ (Table a b,T ti cs) -> T ti [(p,mapStr b f v) | (p,v) <- cs]+ _ -> t + where+ mapField (mty,te) = case mty of+ Just ty -> (mty,mapStr ty f te)+ _ -> (mty,te)+-}
@@ -0,0 +1,3 @@+module GF.Compile.Compute.Concrete{-(module M)-} where+--import GF.Compile.Compute.ConcreteLazy as M -- New+--import GF.Compile.Compute.ConcreteStrict as M -- Old, inefficient
@@ -0,0 +1,580 @@+-- | Functions for computing the values of terms in the concrete syntax, in+-- | preparation for PMCFG generation.+module GF.Compile.Compute.ConcreteNew+ (GlobalEnv, GLocation, resourceValues, geLoc, geGrammar,+ normalForm,+ Value(..), Bind(..), Env, value2term, eval, vapply+ ) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import GF.Grammar hiding (Env, VGen, VApp, VRecType)+import GF.Grammar.Lookup(lookupResDefLoc,allParamValues)+import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr,cTrace,cPBool)+import GF.Grammar.PatternMatch(matchPattern,measurePatt)+import GF.Grammar.Lockfield(isLockLabel,lockRecType) --unlockRecord,lockLabel+import GF.Compile.Compute.Value hiding (Error)+import GF.Compile.Compute.Predef(predef,predefName,delta)+import GF.Data.Str(Str,glueStr,str2strings,str,sstr,plusStr,strTok)+import GF.Data.Operations(Err,err,errIn,maybeErr,combinations,mapPairsM)+import GF.Data.Utilities(mapFst,mapSnd)+import GF.Infra.Option+import Control.Monad(ap,liftM,liftM2) -- ,unless,mplus+import Data.List (findIndex,intersect,nub,elemIndex,(\\)) --,isInfixOf+--import Data.Char (isUpper,toUpper,toLower)+import GF.Text.Pretty+import qualified Data.Map as Map+import Debug.Trace(trace)++-- * Main entry points++normalForm :: GlobalEnv -> L Ident -> Term -> Term+normalForm (GE gr rv opts _) loc = err (bugloc loc) id . nfx (GE gr rv opts loc)++nfx env@(GE _ _ _ loc) t = do+ v <- eval env [] t+ case value2term loc [] v of+ Left i -> fail ("variable #"++show i++" is out of scope")+ Right t -> return t++eval :: GlobalEnv -> Env -> Term -> Err Value+eval (GE gr rvs opts loc) env t = ($ (map snd env)) # value cenv t+ where+ cenv = CE gr rvs opts loc (map fst env)++--apply env = apply' env++--------------------------------------------------------------------------------++-- * Environments++type ResourceValues = Map.Map ModuleName (Map.Map Ident (Err Value))++data GlobalEnv = GE Grammar ResourceValues Options GLocation+data CompleteEnv = CE {srcgr::Grammar,rvs::ResourceValues,+ opts::Options,+ gloc::GLocation,local::LocalScope}+type GLocation = L Ident+type LocalScope = [Ident]+type Stack = [Value]+type OpenValue = Stack->Value++geLoc (GE _ _ _ loc) = loc+geGrammar (GE gr _ _ _) = gr++ext b env = env{local=b:local env}+extend bs env = env{local=bs++local env}+global env = GE (srcgr env) (rvs env) (opts env) (gloc env)++var :: CompleteEnv -> Ident -> Err OpenValue+var env x = maybe unbound pick' (elemIndex x (local env))+ where+ unbound = fail ("Unknown variable: "++showIdent x)+ pick' i = return $ \ vs -> maybe (err i vs) ok (pick i vs)+ err i vs = bug $ "Stack problem: "++showIdent x++": "+ ++unwords (map showIdent (local env))+ ++" => "++show (i,length vs)+ ok v = --trace ("var "++show x++" = "++show v) $+ v++pick :: Int -> Stack -> Maybe Value+pick 0 (v:_) = Just v+pick i (_:vs) = pick (i-1) vs+pick i vs = Nothing -- bug $ "pick "++show (i,vs)++resource env (m,c) =+-- err bug id $+ if isPredefCat c+ then value0 env =<< lockRecType c defLinType -- hmm+ else maybe e id $ Map.lookup c =<< Map.lookup m (rvs env)+ where e = fail $ "Not found: "++render m++"."++showIdent c++-- | Convert operators once, not every time they are looked up+resourceValues :: Options -> SourceGrammar -> GlobalEnv+resourceValues opts gr = env+ where+ env = GE gr rvs opts (L NoLoc identW)+ rvs = Map.mapWithKey moduleResources (moduleMap gr)+ moduleResources m = Map.mapWithKey (moduleResource m) . jments+ moduleResource m c _info = do L l t <- lookupResDefLoc gr (m,c)+ let loc = L l c+ qloc = L l (Q (m,c))+ eval (GE gr rvs opts loc) [] (traceRes qloc t)++ traceRes = if flag optTrace opts+ then traceResource+ else const id++-- * Tracing++-- | Insert a call to the trace function under the top-level lambdas+traceResource (L l q) t =+ case termFormCnc t of+ (abs,body) -> mkAbs abs (mkApp traceQ [args,body])+ where+ args = R $ tuple2record (K lstr:[Vr x|(bt,x)<-abs,bt==Explicit])+ lstr = render (l<>":"<>ppTerm Qualified 0 q)+ traceQ = Q (cPredef,cTrace)++-- * Computing values++-- | Computing the value of a top-level term+value0 :: CompleteEnv -> Term -> Err Value+value0 env = eval (global env) []++-- | Computing the value of a term+value :: CompleteEnv -> Term -> Err OpenValue+value env t0 =+ -- Each terms is traversed only once by this function, using only statically+ -- available information. Notably, the values of lambda bound variables + -- will be unknown during the term traversal phase.+ -- The result is an OpenValue, which is a function that may be applied many+ -- times to different dynamic values, but without the term traversal overhead+ -- and without recomputing other statically known information.+ -- For this to work, there should be no recursive calls under lambdas here.+ -- Whenever we need to construct the OpenValue function with an explicit+ -- lambda, we have to lift the recursive calls outside the lambda.+ -- (See e.g. the rules for Let, Prod and Abs)+{-+ trace (render $ text "value"<+>sep [ppL (gloc env)<>text ":",+ brackets (fsep (map ppIdent (local env))),+ ppTerm Unqualified 10 t0]) $+--}+ errIn (render t0) $+ case t0 of+ Vr x -> var env x+ Q x@(m,f)+ | m == cPredef -> if f==cErrorType -- to be removed+ then let p = identS "P"+ in const # value0 env (mkProd [(Implicit,p,typeType)] (Vr p) [])+ else if f==cPBool+ then const # resource env x+ else const . flip VApp [] # predef f+ | otherwise -> const # resource env x --valueResDef (fst env) x+ QC x -> return $ const (VCApp x [])+ App e1 e2 -> apply' env e1 . (:[]) =<< value env e2+ Let (x,(oty,t)) body -> do vb <- value (ext x env) body+ vt <- value env t+ return $ \ vs -> vb (vt vs:vs)+ Meta i -> return $ \ vs -> VMeta i (zip (local env) vs) []+ Prod bt x t1 t2 ->+ do vt1 <- value env t1+ vt2 <- value (ext x env) t2+ return $ \ vs -> VProd bt (vt1 vs) x $ Bind $ \ vx -> vt2 (vx:vs)+ Abs bt x t -> do vt <- value (ext x env) t+ return $ VAbs bt x . Bind . \ vs vx -> vt (vx:vs)+ EInt n -> return $ const (VInt n)+ EFloat f -> return $ const (VFloat f)+ K s -> return $ const (VString s)+ Empty -> return $ const (VString "")+ Sort s | s == cTok -> return $ const (VSort cStr) -- to be removed + | otherwise -> return $ const (VSort s)+ ImplArg t -> (VImplArg.) # value env t+ Table p res -> liftM2 VTblType # value env p <# value env res+ RecType rs -> do lovs <- mapPairsM (value env) rs+ return $ \vs->VRecType $ mapSnd ($vs) lovs+ t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)+ FV ts -> ((vfv .) # sequence) # mapM (value env) ts+ R as -> do lovs <- mapPairsM (value env.snd) as+ return $ \ vs->VRec $ mapSnd ($vs) lovs+ T i cs -> valueTable env i cs+ V ty ts -> do pvs <- paramValues env ty+ ((VV ty pvs .) . sequence) # mapM (value env) ts+ C t1 t2 -> ((ok2p vconcat.) # both id) # both (value env) (t1,t2)+ S t1 t2 -> ((select env.) # both id) # both (value env) (t1,t2)+ P t l -> --maybe (bug $ "project "++show l++" from "++show v) id $+ do ov <- value env t+ return $ \ vs -> let v = ov vs+ in maybe (VP v l) id (proj l v)+ Alts t tts -> (\v vts -> VAlts # v <# mapM (both id) vts) # value env t <# mapM (both (value env)) tts+ Strs ts -> ((VStrs.) # sequence) # mapM (value env) ts+ Glue t1 t2 -> ((ok2p (glue env).) # both id) # both (value env) (t1,t2)+ ELin c r -> (unlockVRec (gloc env) c.) # value env r+ EPatt p -> return $ const (VPatt p) -- hmm+ EPattType ty -> do vt <- value env ty+ return (VPattType . vt)+ Typed t ty -> value env t+ t -> fail.render $ "value"<+>ppTerm Unqualified 10 t $$ show t++vconcat vv@(v1,v2) =+ case vv of+ (VString "",_) -> v2+ (_,VString "") -> v1+ (VApp NonExist _,_) -> v1+ (_,VApp NonExist _) -> v2+ _ -> VC v1 v2++proj l v | isLockLabel l = return (VRec [])+ ---- a workaround 18/2/2005: take this away and find the reason+ ---- why earlier compilation destroys the lock field+proj l v =+ case v of+ VFV vs -> liftM vfv (mapM (proj l) vs)+ VRec rs -> lookup l rs+-- VExtR v1 v2 -> proj l v2 `mplus` proj l v1 -- hmm+ VS (VV pty pvs rs) v2 -> flip VS v2 . VV pty pvs # mapM (proj l) rs+ _ -> return (ok1 VP v l)++ok1 f v1@(VError {}) _ = v1+ok1 f v1 v2 = f v1 v2+ +ok2 f v1@(VError {}) _ = v1+ok2 f _ v2@(VError {}) = v2+ok2 f v1 v2 = f v1 v2++ok2p f (v1@VError {},_) = v1+ok2p f (_,v2@VError {}) = v2+ok2p f vv = f vv++unlockVRec loc c0 v0 = v0+{-+unlockVRec loc c0 v0 = unlockVRec' c0 v0+ where+ unlockVRec' ::Ident -> Value -> Value+ unlockVRec' c v =+ case v of+ -- VClosure env t -> err bug (VClosure env) (unlockRecord c t)+ VAbs bt x (Bind f) -> VAbs bt x (Bind $ \ v -> unlockVRec' c (f v))+ VRec rs -> plusVRec rs lock+ -- _ -> VExtR v (VRec lock) -- hmm+ _ -> {-trace (render $ ppL loc $ "unlock non-record "++show v0)-} v -- hmm+ -- _ -> bugloc loc $ "unlock non-record "++show v0+ where+ lock = [(lockLabel c,VRec [])]+-}++-- suspicious, but backwards compatible+plusVRec rs1 rs2 = VRec ([(l,v)|(l,v)<-rs1,l `notElem` ls2] ++ rs2)+ where ls2 = map fst rs2++extR t vv =+ case vv of+ (VFV vs,v2) -> vfv [extR t (v1,v2)|v1<-vs]+ (v1,VFV vs) -> vfv [extR t (v1,v2)|v2<-vs]+ (VRecType rs1, VRecType rs2) ->+ case intersect (map fst rs1) (map fst rs2) of+ [] -> VRecType (rs1 ++ rs2)+ ls -> error $ "clash"<+>show ls+ (VRec rs1, VRec rs2) -> plusVRec rs1 rs2+ (v1 , VRec [(l,_)]) | isLockLabel l -> v1 -- hmm+ (VS (VV t pvs vs) s,v2) -> VS (VV t pvs [extR t (v1,v2)|v1<-vs]) s+-- (v1,v2) -> ok2 VExtR v1 v2 -- hmm+ (v1,v2) -> error $ "not records" $$ show v1 $$ show v2+ where+ error explain = ppbug $ "The term" <+> t+ <+> "is not reducible" $$ explain++glue env (v1,v2) = glu v1 v2+ where+ glu v1 v2 =+ case (v1,v2) of+ (VFV vs,v2) -> vfv [glu v1 v2|v1<-vs]+ (v1,VFV vs) -> vfv [glu v1 v2|v2<-vs]+ (VString s1,VString s2) -> VString (s1++s2)+ (v1,VAlts d vs) -> VAlts (glx d) [(glx v,c) | (v,c) <- vs]+ where glx v2 = glu v1 v2+ (v1@(VAlts {}),v2) ->+ --err (const (ok2 VGlue v1 v2)) id $+ err bug id $+ do y' <- strsFromValue v2+ x' <- strsFromValue v1+ return $ vfv [foldr1 VC (map VString (str2strings (glueStr v u))) | v <- x', u <- y']+ (VC va vb,v2) -> VC va (glu vb v2)+ (v1,VC va vb) -> VC (glu v1 va) vb+ (VS (VV ty pvs vs) vb,v2) -> VS (VV ty pvs [glu v v2|v<-vs]) vb+ (v1,VS (VV ty pvs vs) vb) -> VS (VV ty pvs [glu v1 v|v<-vs]) vb+ (v1@(VApp NonExist _),_) -> v1+ (_,v2@(VApp NonExist _)) -> v2+-- (v1,v2) -> ok2 VGlue v1 v2+ (v1,v2) -> if flag optPlusAsBind (opts env)+ then VC v1 (VC (VApp BIND []) v2)+ else let loc = gloc env+ vt v = case value2term loc (local env) v of+ Left i -> Error ('#':show i)+ Right t -> t+ in error . render $+ ppL loc (hang "unsupported token gluing:" 4+ (Glue (vt v1) (vt v2)))+++-- | to get a string from a value that represents a sequence of terminals+strsFromValue :: Value -> Err [Str]+strsFromValue t = case t of+ VString s -> return [str s]+ VC s t -> do+ s' <- strsFromValue s+ t' <- strsFromValue t+ return [plusStr x y | x <- s', y <- t']+{-+ VGlue s t -> do+ s' <- strsFromValue s+ t' <- strsFromValue t+ return [glueStr x y | x <- s', y <- t']+-}+ VAlts d vs -> do+ d0 <- strsFromValue d+ v0 <- mapM (strsFromValue . fst) vs+ c0 <- mapM (strsFromValue . snd) vs+ --let vs' = zip v0 c0+ return [strTok (str2strings def) vars | + def <- d0,+ vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | + vv <- combinations v0]+ ]+ VFV ts -> concat # mapM strsFromValue ts+ VStrs ts -> concat # mapM strsFromValue ts++ _ -> fail ("cannot get Str from value " ++ show t)++vfv vs = case nub vs of+ [v] -> v+ vs -> VFV vs++select env vv =+ case vv of+ (v1,VFV vs) -> vfv [select env (v1,v2)|v2<-vs]+ (VFV vs,v2) -> vfv [select env (v1,v2)|v1<-vs]+ (v1@(VV pty vs rs),v2) ->+ err (const (VS v1 v2)) id $+ do --ats <- allParamValues (srcgr env) pty+ --let vs = map (value0 env) ats+ i <- maybeErr "no match" $ findIndex (==v2) vs+ return (ix (gloc env) "select" rs i)+ (VT _ _ [(PW,Bind b)],_) -> {-trace "eliminate wild card table" $-} b []+ (v1@(VT _ _ cs),v2) ->+ err (\_->ok2 VS v1 v2) (err bug id . valueMatch env) $+ match (gloc env) cs v2+ (VS (VV pty pvs rs) v12,v2) -> VS (VV pty pvs [select env (v11,v2)|v11<-rs]) v12+ (v1,v2) -> ok2 VS v1 v2++match loc cs v = + case value2term loc [] v of+ Left i -> bad ("variable #"++show i++" is out of scope")+ Right t -> err bad return (matchPattern cs t)+ where+ bad = fail . ("In pattern matching: "++)++valueMatch :: CompleteEnv -> (Bind Env,Substitution) -> Err Value+valueMatch env (Bind f,env') = f # mapPairsM (value0 env) env'++valueTable :: CompleteEnv -> TInfo -> [Case] -> Err OpenValue+valueTable env i cs =+ case i of+ TComp ty -> do pvs <- paramValues env ty+ ((VV ty pvs .) # sequence) # mapM (value env.snd) cs+ _ -> do ty <- getTableType i+ cs' <- mapM valueCase cs+ err (dynamic cs' ty) return (convert cs' ty)+ where+ dynamic cs' ty _ = cases cs' # value env ty++ cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))+ where+ keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $+ VT wild (vty vs) (mapSnd ($vs) cs')++ wild = case i of TWild _ -> True; _ -> False++ convertv cs' vty = + case value2term (gloc env) [] vty of+ Left i -> fail ("variable #"++show i++" is out of scope")+ Right pty -> convert' cs' =<< paramValues'' env pty++ convert cs' ty = convert' cs' =<< paramValues' env ty++ convert' cs' ((pty,vs),pvs) =+ do sts <- mapM (matchPattern cs') vs+ return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)+ (mapFst ($vs) sts)++ valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p+ pvs <- linPattVars p'+ vt <- value (extend pvs env) t+ return (p',\vs-> Bind $ \bs-> vt (push' p' bs pvs vs))++ inlinePattMacro p =+ case p of+ PM qc -> do r <- resource env qc+ case r of+ VPatt p' -> inlinePattMacro p'+ _ -> ppbug $ hang "Expected pattern macro:" 4+ (show r)+ _ -> composPattOp inlinePattMacro p+++paramValues env ty = snd # paramValues' env ty++paramValues' env ty = paramValues'' env =<< nfx (global env) ty++paramValues'' env pty = do ats <- allParamValues (srcgr env) pty+ pvs <- mapM (eval (global env) []) ats+ return ((pty,ats),pvs)++push' p bs xs = if length bs/=length xs+ then bug $ "push "++show (p,bs,xs)+ else push bs xs++push :: Env -> LocalScope -> Stack -> Stack+push bs [] vs = vs+push bs (x:xs) vs = maybe err id (lookup x bs):push bs xs vs+ where err = bug $ "Unbound pattern variable "++showIdent x++apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue+apply' env t [] = value env t+apply' env t vs =+ case t of+ QC x -> return $ \ svs -> VCApp x (map ($svs) vs)+{-+ Q x@(m,f) | m==cPredef -> return $+ let constr = --trace ("predef "++show x) .+ VApp x + in \ svs -> maybe constr id (Map.lookup f predefs)+ $ map ($svs) vs+ | otherwise -> do r <- resource env x+ return $ \ svs -> vapply (gloc env) r (map ($svs) vs)+-}+ App t1 t2 -> apply' env t1 . (:vs) =<< value env t2+ _ -> do fv <- value env t+ return $ \ svs -> vapply (gloc env) (fv svs) (map ($svs) vs)++vapply :: GLocation -> Value -> [Value] -> Value+vapply loc v [] = v+vapply loc v vs =+ case v of+ VError {} -> v+-- VClosure env (Abs b x t) -> beta gr env b x t vs+ VAbs bt _ (Bind f) -> vbeta loc bt f vs+ VApp pre vs1 -> delta' pre (vs1++vs)+ where+ delta' Trace (v1:v2:vs) = let vr = vapply loc v2 vs+ in vtrace loc v1 vr+ delta' pre vs = err msg vfv $ mapM (delta pre) (varyList vs)+ --msg = const (VApp pre (vs1++vs))+ msg = bug . (("Applying Predef."++showIdent (predefName pre)++": ")++)+ VS (VV t pvs fs) s -> VS (VV t pvs [vapply loc f vs|f<-fs]) s+ VFV fs -> vfv [vapply loc f vs|f<-fs]+ VCApp f vs0 -> VCApp f (vs0++vs)+ VMeta i env vs0 -> VMeta i env (vs0++vs)+ VGen i vs0 -> VGen i (vs0++vs)+ v -> bug $ "vapply "++show v++" "++show vs++vbeta loc bt f (v:vs) =+ case (bt,v) of+ (Implicit,VImplArg v) -> ap v+ (Explicit, v) -> ap v+ where+ ap (VFV avs) = vfv [vapply loc (f v) vs|v<-avs]+ ap v = vapply loc (f v) vs++vary (VFV vs) = vs+vary v = [v]+varyList = mapM vary++{-+beta env b x t (v:vs) =+ case (b,v) of+ (Implicit,VImplArg v) -> apply' (ext (x,v) env) t vs+ (Explicit, v) -> apply' (ext (x,v) env) t vs+-}++vtrace loc arg res = trace (render (hang (pv arg) 4 ("->"<+>pv res))) res+ where+ pv v = case v of+ VRec (f:as) -> hang (pf f) 4 (fsep (map pa as))+ _ -> ppV v+ pf (_,VString n) = pp n+ pf (_,v) = ppV v+ pa (_,v) = ppV v+ ppV v = case value2term' True loc [] v of+ Left i -> "variable #" <> pp i <+> "is out of scope"+ Right t -> ppTerm Unqualified 10 t++-- | Convert a value back to a term+value2term :: GLocation -> [Ident] -> Value -> Either Int Term+value2term = value2term' False+value2term' stop loc xs v0 =+ case v0 of+ VApp pre vs -> liftM (foldl App (Q (cPredef,predefName pre))) (mapM v2t vs)+ VCApp f vs -> liftM (foldl App (QC f)) (mapM v2t vs)+ VGen j vs -> liftM2 (foldl App) (var j) (mapM v2t vs)+ VMeta j env vs -> liftM (foldl App (Meta j)) (mapM v2t vs)+ VProd bt v x f -> liftM2 (Prod bt x) (v2t v) (v2t' x f)+ VAbs bt x f -> liftM (Abs bt x) (v2t' x f)+ VInt n -> return (EInt n)+ VFloat f -> return (EFloat f)+ VString s -> return (if null s then Empty else K s)+ VSort s -> return (Sort s)+ VImplArg v -> liftM ImplArg (v2t v)+ VTblType p res -> liftM2 Table (v2t p) (v2t res)+ VRecType rs -> liftM RecType (mapM (\(l,v) -> fmap ((,) l) (v2t v)) rs)+ VRec as -> liftM R (mapM (\(l,v) -> v2t v >>= \t -> return (l,(Nothing,t))) as)+ VV t _ vs -> liftM (V t) (mapM v2t vs)+ VT wild v cs -> v2t v >>= \t -> liftM (T ((if wild then TWild else TTyped) t)) (mapM nfcase cs)+ VFV vs -> liftM FV (mapM v2t vs)+ VC v1 v2 -> liftM2 C (v2t v1) (v2t v2)+ VS v1 v2 -> liftM2 S (v2t v1) (v2t v2)+ VP v l -> v2t v >>= \t -> return (P t l)+ VPatt p -> return (EPatt p)+ VPattType v -> v2t v >>= return . EPattType+ VAlts v vvs -> liftM2 Alts (v2t v) (mapM (\(x,y) -> liftM2 (,) (v2t x) (v2t y)) vvs)+ VStrs vs -> liftM Strs (mapM v2t vs)+-- VGlue v1 v2 -> Glue (v2t v1) (v2t v2)+-- VExtR v1 v2 -> ExtR (v2t v1) (v2t v2)+ VError err -> return (Error err)+ _ -> bug ("value2term "++show loc++" : "++show v0)+ where+ v2t = v2txs xs+ v2txs = value2term' stop loc+ v2t' x f = v2txs (x:xs) (bind f (gen xs))++ var j+ | j<length xs = Right (Vr (reverse xs !! j))+ | otherwise = Left j+++ pushs xs e = foldr push e xs+ push x (env,xs) = ((x,gen xs):env,x:xs)+ gen xs = VGen (length xs) []++ nfcase (p,f) = liftM ((,) p) (v2txs xs' (bind f env'))+ where (env',xs') = pushs (pattVars p) ([],xs)++ bind (Bind f) x = if stop+ then VSort (identS "...") -- hmm+ else f x+++linPattVars p =+ if null dups+ then return pvs+ else fail.render $ hang "Pattern is not linear:" 4 (ppPatt Unqualified 0 p)+ where+ allpvs = allPattVars p+ pvs = nub allpvs+ dups = allpvs \\ pvs++pattVars = nub . allPattVars+allPattVars p =+ case p of+ PV i -> [i]+ PAs i p -> i:allPattVars p+ _ -> collectPattOp allPattVars p++---+ix loc fn xs i =+ if i<n+ then xs !! i+ else bugloc loc $ "(!!): index too large in "++fn++", "++show i++"<"++show n+ where n = length xs++infixl 1 #,<# --,@@++f # x = fmap f x+mf <# mx = ap mf mx+--m1 @@ m2 = (m1 =<<) . m2++both f (x,y) = (,) # f x <# f y++bugloc loc s = ppbug $ ppL loc s++bug msg = ppbug msg+ppbug doc = error $ render $ hang "Internal error in Compute.ConcreteNew:" 4 doc
@@ -0,0 +1,168 @@+-- | Implementations of predefined functions+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module GF.Compile.Compute.Predef(predef,predefName,delta) where++import qualified Data.Map as Map+import Data.Array(array,(!))+import Data.List (isInfixOf)+import Data.Char (isUpper,toLower,toUpper)+import Control.Monad(ap)++import GF.Data.Utilities (apBoth) --mapSnd++import GF.Compile.Compute.Value+import GF.Infra.Ident (Ident,showIdent) --,varX+import GF.Data.Operations(Err) -- ,err+import GF.Grammar.Predef++--------------------------------------------------------------------------------+class Predef a where+ toValue :: a -> Value+ fromValue :: Value -> Err a++instance Predef Int where+ toValue = VInt+ fromValue (VInt i) = return i+ fromValue v = verror "Int" v++instance Predef Bool where+ toValue = boolV++instance Predef String where+ toValue = string+ fromValue v = case norm v of+ VString s -> return s+ _ -> verror "String" v++instance Predef Value where+ toValue = id+ fromValue = return++instance Predef Predefined where+ toValue p = VApp p []+ fromValue v = case v of+ VApp p _ -> return p+ _ -> fail $ "Expected a predefined constant, got something else"++{-+instance (Predef a,Predef b) => Predef (a->b) where+ toValue f = VAbs Explicit (varX 0) $ Bind $ err bug (toValue . f) . fromValue+-}+verror t v =+ case v of+ VError e -> fail e+ VGen {} -> fail $ "Expected a static value of type "++t+ ++", got a dynamic value"+ _ -> fail $ "Expected a value of type "++t++", got "++show v++--------------------------------------------------------------------------------++predef f = maybe undef return (Map.lookup f predefs)+ where+ undef = fail $ "Unimplemented predfined operator: Predef."++showIdent f++predefs :: Map.Map Ident Predefined+predefs = Map.fromList predefList++predefName pre = predefNames ! pre+predefNames = array (minBound,maxBound) (map swap predefList)++predefList =+ [(cDrop,Drop),(cTake,Take),(cTk,Tk),(cDp,Dp),(cEqStr,EqStr),+ (cOccur,Occur),(cOccurs,Occurs),(cToUpper,ToUpper),(cToLower,ToLower),+ (cIsUpper,IsUpper),(cLength,Length),(cPlus,Plus),(cEqInt,EqInt),+ (cLessInt,LessInt),+ -- cShow, cRead, cMapStr, cEqVal+ (cError,Error),(cTrace,Trace),+ -- Canonical values:+ (cPBool,PBool),(cPFalse,PFalse),(cPTrue,PTrue),(cInt,Int),(cFloat,Float),+ (cInts,Ints),(cNonExist,NonExist)+ ,(cBIND,BIND),(cSOFT_BIND,SOFT_BIND),(cSOFT_SPACE,SOFT_SPACE)+ ,(cCAPIT,CAPIT),(cALL_CAPIT,ALL_CAPIT)]+ --- add more functions!!!++delta f vs =+ case f of+ Drop -> fromNonExist vs NonExist (ap2 (drop::Int->String->String))+ Take -> fromNonExist vs NonExist (ap2 (take::Int->String->String))+ Tk -> fromNonExist vs NonExist (ap2 tk)+ Dp -> fromNonExist vs NonExist (ap2 dp)+ EqStr -> fromNonExist vs PFalse (ap2 ((==)::String->String->Bool))+ Occur -> fromNonExist vs PFalse (ap2 occur)+ Occurs -> fromNonExist vs PFalse (ap2 occurs)+ ToUpper -> fromNonExist vs NonExist (ap1 (map toUpper))+ ToLower -> fromNonExist vs NonExist (ap1 (map toLower))+ IsUpper -> fromNonExist vs PFalse (ap1 (all' isUpper))+ Length -> fromNonExist vs (0::Int) (ap1 (length::String->Int))+ Plus -> ap2 ((+)::Int->Int->Int)+ EqInt -> ap2 ((==)::Int->Int->Bool)+ LessInt -> ap2 ((<)::Int->Int->Bool)+ {- -- | Show | Read | ToStr | MapStr | EqVal -}+ Error -> ap1 VError+ Trace -> ap2 vtrace+ -- Canonical values:+ PBool -> canonical+ Int -> canonical+ Float -> canonical+ Ints -> canonical+ PFalse -> canonical+ PTrue -> canonical+ NonExist-> canonical+ BIND -> canonical+ SOFT_BIND->canonical+ SOFT_SPACE->canonical+ CAPIT -> canonical+ ALL_CAPIT->canonical+ where+ canonical = delay+ delay = return (VApp f vs) -- wrong number of arguments++ ap1 f = case vs of+ [v1] -> (toValue . f) `fmap` fromValue v1+ _ -> delay++ ap2 f = case vs of+ [v1,v2] -> toValue `fmap` (f `fmap` fromValue v1 `ap` fromValue v2)+ _ -> delay++ fromNonExist vs a b+ | null [v | v@(VApp NonExist _) <- vs] = b+ | otherwise = return (toValue a)++ vtrace :: Value -> Value -> Value+ vtrace x y = y -- tracing is implemented elsewhere++-- unimpl id = bug $ "unimplemented predefined function: "++showIdent id+-- problem id vs = bug $ "unexpected arguments: Predef."++showIdent id++" "++show vs++ tk i s = take (max 0 (length s - i)) s :: String+ dp i s = drop (max 0 (length s - i)) s :: String+ occur s t = isInfixOf (s::String) (t::String)+ occurs s t = any (`elem` (t::String)) (s::String)+ all' = all :: (a->Bool) -> [a] -> Bool++boolV b = VCApp (cPredef,if b then cPTrue else cPFalse) []++norm v =+ case v of+ VC v1 v2 -> case apBoth norm (v1,v2) of+ (VString s1,VString s2) -> VString (s1++" "++s2)+ (v1,v2) -> VC v1 v2+ _ -> v+{-+strict v = case v of+ VError err -> Left err+ _ -> Right v+-}+string s = case words s of+ [] -> VString ""+ ss -> foldr1 VC (map VString ss)++---++swap (x,y) = (y,x)+{-+bug msg = ppbug msg+ppbug doc = error $ render $+ hang "Internal error in Compute.Predef:" 4 doc+-}
@@ -0,0 +1,56 @@+module GF.Compile.Compute.Value where+import GF.Grammar.Grammar(Label,Type,MetaId,Patt,QIdent)+import PGF.Internal(BindType)+import GF.Infra.Ident(Ident)+import Text.Show.Functions()+import Data.Ix(Ix)++-- | Self-contained (not quite) representation of values+data Value+ = VApp Predefined [Value] -- from Q, always Predef.x, has a built-in value+ | VCApp QIdent [Value] -- from QC, constructors+ | VGen Int [Value] -- for lambda bound variables, possibly applied+ | VMeta MetaId Env [Value]+-- -- | VClosure Env Term -- used in Typecheck.ConcreteNew+ | VAbs BindType Ident Binding -- used in Compute.ConcreteNew+ | VProd BindType Value Ident Binding -- used in Compute.ConcreteNew+ | VInt Int+ | VFloat Double+ | VString String+ | VSort Ident+ | VImplArg Value+ | VTblType Value Value+ | VRecType [(Label,Value)]+ | VRec [(Label,Value)]+ | VV Type [Value] [Value] -- preserve type for conversion back to Term+ | VT Wild Value [(Patt,Bind Env)]+ | VC Value Value+ | VS Value Value+ | VP Value Label+ | VPatt Patt+ | VPattType Value+ | VFV [Value]+ | VAlts Value [(Value, Value)]+ | VStrs [Value]+-- -- | VGlue Value Value -- hmm+-- -- | VExtR Value Value -- hmm+ | VError String+ deriving (Eq,Show)++type Wild = Bool+type Binding = Bind Value+data Bind a = Bind (a->Value) deriving Show++instance Eq (Bind a) where x==y = False++type Env = [(Ident,Value)]++-- | Predefined functions+data Predefined = Drop | Take | Tk | Dp | EqStr | Occur | Occurs | ToUpper+ | ToLower | IsUpper | Length | Plus | EqInt | LessInt + {- | Show | Read | ToStr | MapStr | EqVal -}+ | Error | Trace+ -- Canonical values below:+ | PBool | PFalse | PTrue | Int | Float | Ints | NonExist + | BIND | SOFT_BIND | SOFT_SPACE | CAPIT | ALL_CAPIT+ deriving (Show,Eq,Ord,Ix,Bounded,Enum)
@@ -0,0 +1,437 @@+-- | Translate concrete syntax to Haskell+module GF.Compile.ConcreteToHaskell(concretes2haskell,concrete2haskell) where+import Data.List(sort,sortBy)+import Data.Function(on)+import qualified Data.Map as M+import qualified Data.Set as S+import GF.Data.ErrM+import GF.Data.Utilities(mapSnd)+import GF.Text.Pretty+import GF.Grammar.Grammar+import GF.Grammar.Lookup(lookupFunType,lookupOrigInfo,allOrigInfos)--,allParamValues+import GF.Grammar.Macros(typeForm,collectOp,collectPattOp,mkAbs,mkApp)+import GF.Grammar.Lockfield(isLockLabel)+import GF.Grammar.Predef(cPredef,cInts)+import GF.Compile.Compute.Predef(predef)+import GF.Compile.Compute.Value(Predefined(..))+import GF.Infra.Ident(Ident,identS,prefixIdent) --,moduleNameS+import GF.Infra.Option+import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)+import GF.Haskell+import Debug.Trace++-- | Generate Haskell code for the all concrete syntaxes associated with+-- the named abstract syntax in given the grammar.+concretes2haskell opts absname gr =+ [(cncname,concrete2haskell opts gr cenv absname cnc cncmod)+ | let cenv = resourceValues opts gr,+ cnc<-allConcretes gr absname,+ let cncname = render cnc ++ ".hs" :: FilePath+ Ok cncmod = lookupModule gr cnc+ ]++-- | Generate Haskell code for the given concrete module.+-- The only options that make a difference are+-- @-haskell=noprefix@ and @-haskell=variants@.+concrete2haskell opts gr cenv absname cnc modinfo =+ renderStyle style{lineLength=80,ribbonsPerLine=1} $+ haskPreamble va absname cnc $$ vcat (+ nl:Comment "--- Parameter types ---":+ neededParamTypes S.empty (params defs) +++ nl:Comment "--- Type signatures for linearization functions ---":+ map signature (S.toList allcats)+++ nl:Comment "--- Linearization functions for empty categories ---":+ emptydefs +++ nl:Comment "--- Linearization types and linearization functions ---":+ map ppDef defs +++ nl:Comment "--- Type classes for projection functions ---":+ map labelClass (S.toList labels) +++ nl:Comment "--- Record types ---":+ concatMap recordType recs)+ where+ nl = Comment ""+ labels = S.difference (S.unions (map S.fromList recs)) common_labels+ recs = S.toList (S.difference (records rhss) common_records)+ common_records = S.fromList [[label_s]]+ common_labels = S.fromList [label_s]+ label_s = ident2label (identS "s")++ rhss = map (either snd (snd.snd)) defs+ defs = sortBy (compare `on` either (const Nothing) (Just . fst)) .+ concatMap (toHaskell gId gr absname cenv) . + M.toList $+ jments modinfo++-- signature c = "lin"<>c<+>"::"<+>"A."<>gId c<+>"->"<+>"Lin"<>c+-- signature c = "--lin"<>c<+>":: (Applicative f,Monad f) =>"<+>"A."<>gId c<+>"->"<+>"f Lin"<>c+ signature c = TypeSig lf (Fun abs (pure lin))+ where+ abs = tcon0 (prefixIdent "A." (gId c))+ lin = tcon0 lc+ lf = prefixIdent "lin" c+ lc = prefixIdent "Lin" c++ emptydefs = map emptydef (S.toList emptyCats)+ emptydef c = Eqn (prefixIdent "lin" c,[WildP]) (Const "undefined")++ emptyCats = allcats `S.difference` cats+ cats = S.fromList [c|Right (c,_)<-defs]+ allcats = S.fromList [c|((_,c),AbsCat (Just _))<-allOrigInfos gr absname]++ params = S.toList . S.unions . map params1+ params1 (Left (_,rhs)) = paramTypes gr rhs+ params1 (Right (_,(_,rhs))) = tableTypes gr [rhs]++ ppDef (Left (lhs,rhs)) = lhs (convType va gId rhs)+ ppDef (Right (_,(lhs,rhs))) = lhs (convert va gId gr rhs)++ gId :: Ident -> Ident+ gId = if haskellOption opts HaskellNoPrefix then id else prefixIdent "G"+ va = haskellOption opts HaskellVariants+ pure = if va then ListT else id++ neededParamTypes have [] = []+ neededParamTypes have (q:qs) =+ if q `S.member` have+ then neededParamTypes have qs+ else let ((got,need),def) = paramType va gId gr q+ in def++neededParamTypes (S.union got have) (S.toList need++qs)++haskPreamble :: Bool -> ModuleName -> ModuleName -> Doc+haskPreamble va absname cncname =+ "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, LambdaCase #-}" $$+ "module" <+> cncname <+> "where" $$+ "import Prelude hiding (Ordering(..))" $$+ "import Control.Applicative((<$>),(<*>))" $$+ "import PGF.Haskell" $$+ "import qualified" <+> absname <+> "as A" $$+ "" $$+ "--- Standard definitions ---" $$+ "linString (A.GString s) ="<+>pure "R_s [TK s]" $$+ "linInt (A.GInt i) ="<+>pure "R_s [TK (show i)]" $$+ "linFloat (A.GFloat x) ="<+>pure "R_s [TK (show x)]" $$+ "" $$+ "----------------------------------------------------" $$+ "-- Automatic translation from GF to Haskell follows" $$+ "----------------------------------------------------"+ where+ pure = if va then brackets else pp++toHaskell gId gr absname cenv (name,jment) =+ case jment of+ CncCat (Just (L loc typ)) _ _ pprn _ ->+ [Left (tsyn0 (prefixIdent "Lin" name),nf loc typ)]+ CncFun (Just r@(cat,ctx,lincat)) (Just (L loc def)) pprn _ ->+-- trace (render (name<+>hcat[parens (x<>"::"<>t)|(_,x,t)<-ctx]<+>"::"<+>cat)) $+ [Right (cat,(Eqn (prefixIdent "lin" cat,lhs),coerce [] lincat rhs))]+ where+ Ok abstype = lookupFunType gr absname name+ (absctx,_abscat,_absargs) = typeForm abstype++ e' = unAbs (length params) $+ nf loc (mkAbs params (mkApp def (map Vr args)))+ params = [(b,prefixIdent "g" x)|(b,x,_)<-ctx]+ args = map snd params+ abs_args = map (prefixIdent "abs_") args+ lhs = [ConP (aId name) (map VarP abs_args)]+ rhs = foldr letlin e' (zip args absctx)+ letlin (a,(_,_,at)) =+ Let (a,(Just (con ("Lin"++render at)),(App (con ("lin"++render at)) (con ("abs_"++render a)))))+ AnyInd _ m -> case lookupOrigInfo gr (m,name) of+ Ok (m,jment) -> toHaskell gId gr absname cenv (name,jment)+ _ -> []+ _ -> []+ where+ nf loc = normalForm cenv (L loc name)+ aId n = prefixIdent "A." (gId n)++ unAbs 0 t = t+ unAbs n (Abs _ _ t) = unAbs (n-1) t+ unAbs _ t = t+++con = Cn . identS++tableTypes gr ts = S.unions (map tabtys ts)+ where+ tabtys t =+ case t of+ V t cc -> S.union (paramTypes gr t) (tableTypes gr cc)+ T (TTyped t) cs -> S.union (paramTypes gr t) (tableTypes gr (map snd cs))+ _ -> collectOp tabtys t++paramTypes gr t =+ case t of+ RecType fs -> S.unions (map (paramTypes gr.snd) fs)+ Table t1 t2 -> S.union (paramTypes gr t1) (paramTypes gr t2)+ App tf ta -> S.union (paramTypes gr tf) (paramTypes gr ta)+ Sort _ -> S.empty+ EInt _ -> S.empty+ Q q -> lookup q+ QC q -> lookup q+ FV ts -> S.unions (map (paramTypes gr) ts)+ _ -> ignore+ where+ lookup q = case lookupOrigInfo gr q of+ Ok (_,ResOper _ (Just (L _ t))) ->+ S.insert q (paramTypes gr t)+ Ok (_,ResParam {}) -> S.singleton q+ _ -> ignore++ ignore = trace ("Ignore: "++show t) S.empty++++records ts = S.unions (map recs ts)+ where+ recs t =+ case t of+ R r -> S.insert (labels r) (records (map (snd.snd) r))+ RecType r -> S.insert (labels r) (records (map snd r))+ _ -> collectOp recs t++ labels = sort . filter (not . isLockLabel) . map fst+++coerce env ty t =+ case (ty,t) of + (_,Let d t) -> Let d (coerce (extend env d) ty t)+ (_,FV ts) -> FV (map (coerce env ty) ts)+ (Table ti tv,V _ ts) -> V ti (map (coerce env tv) ts)+ (Table ti tv,T (TTyped _) cs) -> T (TTyped ti) (mapSnd (coerce env tv) cs)+ (RecType rt,R r) ->+ R [(l,(Just ft,coerce env ft f))|(l,(_,f))<-r,Just ft<-[lookup l rt]]+ (RecType rt,Vr x)->+ case lookup x env of+ Just ty' | ty'/=ty -> -- better to compare to normal form of ty'+ --trace ("coerce "++render ty'++" to "++render ty) $+ App (to_rcon (map fst rt)) t+ _ -> trace ("no coerce to "++render ty) t+ _ -> t+ where+ extend env (x,(Just ty,rhs)) = (x,ty):env+ extend env _ = env++convert va gId gr = convert' va gId [] gr++convert' va gId vs gr = ppT+ where+ ppT0 = convert' False gId vs gr+ ppTv vs' = convert' va gId vs' gr++ ppT t =+ case t of+ -- Only for 'let' inserted on the top-level by this converter:+ Let (x,(_,xt)) t -> let1 x (ppT0 xt) (ppT t)+-- Abs b x t -> ...+ V ty ts -> pure (c "table" `Ap` dedup ts)+ T (TTyped ty) cs -> pure (LambdaCase (map ppCase cs))+ S t p -> select (ppT t) (ppT p)+ C t1 t2 -> concat (ppT t1) (ppT t2)+ App f a -> ap (ppT f) (ppT a)+ R r -> aps (ppT (rcon (map fst r))) (fields r)+ P t l -> ap (ppT (proj l)) (ppT t)+ FV [] -> empty+ Vr x -> if x `elem` vs then pure (Var x) else Var x+ Cn x -> pure (Var x)+ Con c -> pure (Var (gId c))+ Sort k -> pure (Var k)+ EInt n -> pure (lit n)+ Q (m,n) -> if m==cPredef then pure (ppPredef n) else Var (qual m n)+ QC (m,n) -> pure (Var (gId (qual m n)))+ K s -> pure (token s)+ Empty -> pure (List [])+ FV ts@(_:_) -> variants ts+ Alts t' vs -> pure (alts t' vs)++ ppCase (p,t) = (ppP p,ppTv (patVars p++vs) t)++ ppPredef n =+ case predef n of+ Ok BIND -> single (c "BIND")+ Ok SOFT_BIND -> single (c "SOFT_BIND")+ Ok SOFT_SPACE -> single (c "SOFT_SPACE")+ Ok CAPIT -> single (c "CAPIT")+ Ok ALL_CAPIT -> single (c "ALL_CAPIT")+ _ -> Var n++ ppP p =+ case p of+ PC c ps -> ConP (gId c) (map ppP ps)+ PP (_,c) ps -> ConP (gId c) (map ppP ps)+ PR r -> ConP (rcon' (map fst r)) (map (ppP.snd) (filter (not.isLockLabel.fst) r))+ PW -> WildP+ PV x -> VarP x+ PString s -> Lit (show s) -- !!+ PInt i -> Lit (show i)+ PFloat x -> Lit (show x)+ PT _ p -> ppP p+ PAs x p -> AsP x (ppP p)+ + token s = single (c "TK" `Ap` lit s)++ alts t' vs = single (c "TP" `Ap` List (map alt vs) `Ap` ppT0 t')+ where+ alt (t,p) = Pair (List (pre p)) (ppT0 t)++ pre (K s) = [lit s]+ pre (Strs ts) = concatMap pre ts+ pre (EPatt p) = pat p+ pre t = error $ "pre "++show t++ pat (PString s) = [lit s]+ pat (PAlt p1 p2) = pat p1++pat p2+ pat p = error $ "pat "++show p++ fields = map (ppT.snd.snd) . sort . filter (not.isLockLabel.fst)++ c = Const+ lit s = c (show s) -- hmm+ concat = if va then concat' else plusplus+ where+ concat' (List [List ts1]) (List [List ts2]) = List [List (ts1++ts2)]+ concat' t1 t2 = Op t1 "+++" t2+ pure = if va then single else id+ pure' = single -- forcing the list monad++ select = if va then select' else Ap+ select' (List [t]) (List [p]) = Op t "!" p+ select' (List [t]) p = Op t "!$" p+ select' t p = Op t "!*" p++ ap = if va then ap' else Ap+ where+ ap' (List [f]) x = fmap f x+ ap' f x = Op f "<*>" x+ fmap f (List [x]) = pure' (Ap f x)+ fmap f x = Op f "<$>" x++-- join = if va then join' else id+ join' (List [x]) = x+ join' x = c "concat" `Ap` x++ empty = if va then List [] else c "error" `Ap` c (show "empty variant")+ variants = if va then \ ts -> join' (List (map ppT ts))+ else \ (t:_) -> ppT t++ aps f [] = f+ aps f (a:as) = aps (ap f a) as++ dedup ts =+ if M.null dups+ then List (map ppT ts)+ else Lets [(ev i,ppT t)|(i,t)<-defs] (List (zipWith entry ts is))+ where+ entry t i = maybe (ppT t) (Var . ev) (M.lookup i dups)+ ev i = identS ("e'"++show i)++ defs = [(i1,t)|(t,i1:_:_)<-ms]+ dups = M.fromList [(i2,i1)|(_,i1:is@(_:_))<-ms,i2<-i1:is]+ ms = M.toList m+ m = fmap sort (M.fromListWith (++) (zip ts [[i]|i<-is]))+ is = [0..]::[Int]++patVars p =+ case p of+ PV x -> [x]+ PAs x p -> x:patVars p+ _ -> collectPattOp patVars p++convType va gId = ppT+ where+ ppT t =+ case t of+ Table ti tv -> Fun (ppT ti) (if va then ListT (ppT tv) else ppT tv)+ RecType rt -> tcon (rcon' (map fst rt)) (fields rt)+ App tf ta -> TAp (ppT tf) (ppT ta)+ FV [] -> tcon0 (identS "({-empty variant-})")+ Sort k -> tcon0 k+ EInt n -> tcon0 (identS ("({-"++show n++"-})")) -- type level numeric literal+ FV (t:ts) -> ppT t -- !!+ QC (m,n) -> tcon0 (gId (qual m n))+ Q (m,n) -> tcon0 (gId (qual m n))+ _ -> error $ "Missing case in convType for: "++show t++ fields = map (ppT.snd) . sort . filter (not.isLockLabel.fst)++proj = con . proj'+proj' l = "proj_"++render l+rcon = con . rcon_name+rcon' = identS . rcon_name+rcon_name ls = "R"++concat (sort ['_':render l|l<-ls,not (isLockLabel l)])+to_rcon = con . to_rcon'+to_rcon' = ("to_"++) . rcon_name++recordType ls =+ Data lhs [app] ["Eq","Ord","Show"]:+ enumAllInstance:+ zipWith projection vs ls +++ [Eqn (identS (to_rcon' ls),[VarP r])+ (foldl Ap (Var cn) [Var (identS (proj' l)) `Ap` Var r|l<-ls])]+ where+ r = identS "r"+ cn = rcon' ls+ -- Not all record labels are syntactically correct as type variables in Haskell+ -- app = cn<+>ls+ lhs = ConAp cn vs -- don't reuse record labels+ app = fmap TId lhs+ tapp = foldl TAp (TId cn) (map TId vs)+ vs = [identS ('t':show i)|i<-[1..n]]+ n = length ls++ projection v l = Instance [] (TId name `TAp` tapp `TAp` TId v)+ [((prj,[papp]),Var v)]+ where+ name = identS ("Has_"++render l)+ prj = identS (proj' l)+ papp = ConP cn (map VarP vs)++ enumAllInstance =+ Instance ctx (tEnumAll `TAp` tapp)[(lhs0 "enumAll",enumCon cn n)]+ where+ ctx = [tEnumAll `TAp` TId v|v<-vs]+ tEnumAll = TId (identS "EnumAll")++labelClass l =+ Class [] (ConAp name [r,a]) [([r],[a])]+ [(identS (proj' l),TId r `Fun` TId a)]+ where+ name = identS ("Has_"++render l)+ r = identS "r"+ a = identS "a"++paramType va gId gr q@(_,n) =+ case lookupOrigInfo gr q of+ Ok (m,ResParam (Just (L _ ps)) _)+ {- - | m/=cPredef && m/=moduleNameS "Prelude"-} ->+ ((S.singleton (m,n),argTypes ps),+ [Data (conap0 name) (map (param m) ps)["Eq","Ord","Show"],+ Instance [] (TId (identS "EnumAll") `TAp` TId name)+ [(lhs0 "enumAll",foldr1 plusplus (map (enumParam m) ps))]]+ )+ where name = gId (qual m n)+ Ok (m,ResOper _ (Just (L _ t)))+ | m==cPredef && n==cInts ->+ ((S.singleton (m,n),S.empty),+ [Type (ConAp (gId (qual m n)) [identS "n"]) (TId (identS "Int"))])+ | otherwise ->+ ((S.singleton (m,n),paramTypes gr t),+ [Type (conap0 (gId (qual m n))) (convType va gId t)])+ _ -> ((S.empty,S.empty),[])+ where+ param m (n,ctx) = ConAp (gId (qual m n)) [convType va gId t|(_,_,t)<-ctx]+ argTypes = S.unions . map argTypes1+ argTypes1 (n,ctx) = S.unions [paramTypes gr t|(_,_,t)<-ctx]++ enumParam m (n,ctx) = enumCon (gId (qual m n)) (length ctx)++enumCon name arity =+ if arity==0+ then single (Var name)+ else foldl ap (single (Var name)) (replicate arity (Const "enumAll"))+ where+ ap (List [f]) a = Op f "<$>" a+ ap f a = Op f "<*>" a++qual :: ModuleName -> Ident -> Ident+qual m = prefixIdent (render m++"_")
@@ -0,0 +1,83 @@+module GF.Compile.ExampleBased (+ parseExamplesInGrammar,+ configureExBased+ ) where++import PGF+--import PGF.Probabilistic+--import PGF.Morphology+--import GF.Compile.ToAPI++import Data.List++parseExamplesInGrammar :: ExConfiguration -> FilePath -> IO (FilePath,[String])+parseExamplesInGrammar conf file = do+ src <- readFile file -- .gfe+ let file' = take (length file - 3) file ++ "gf" -- .gf+ ws <- convertFile conf src file'+ return (file',ws)++convertFile :: ExConfiguration -> String -> FilePath -> IO [String]+convertFile conf src file = do+ writeFile file "" -- "-- created by example-based grammar writing in GF\n"+ conv [] src+ where+ conv ws s = do+ (cex,end) <- findExample s+ if null end then return (nub (sort ws)) else do+ ws2 <- convEx cex+ conv (ws2 ++ ws) end+ findExample s = case s of+ '%':'e':'x':cs -> return $ getExample cs+ c:cs -> appf [c] >> findExample cs+ _ -> return (undefined,s)+ getExample s = + let + (cat,exend) = break (=='"') s+ (ex, end) = break (=='"') (tail exend)+ in ((unwords (words cat),ex), tail end) -- quotes ignored+ pgf = resource_pgf conf+ morpho = resource_morpho conf+ lang = language conf + convEx (cat,ex) = do+ appn "("+ let typ = maybe (error "no valid cat") id $ readType cat+ ws <- case fst (parse_ pgf lang typ (Just 4) ex) of+ ParseFailed _ -> do+ let ws = morphoMissing morpho (words ex)+ appv ("WARNING: cannot parse example " ++ ex) + case ws of+ [] -> return ()+ _ -> appv (" missing words: " ++ unwords ws)+ return ws+ TypeError _ ->+ return []+ ParseIncomplete ->+ return []+ ParseOk ts ->+ case rank ts of+ (t:tt) -> do+ if null tt + then return ()+ else appv ("WARNING: ambiguous example " ++ ex) + appn t + mapM_ (appn . (" --- " ++)) tt+ appn ")" + return [] + return ws+ rank ts = [printExp conf t ++ " -- " ++ show p | (t,p) <- rankTreesByProbs pgf ts]+ appf = appendFile file+ appn s = appf s >> appf "\n"+ appv s = appn ("--- " ++ s) >> putStrLn s++data ExConfiguration = ExConf {+ resource_pgf :: PGF,+ resource_morpho :: Morpho,+ verbose :: Bool,+ language :: Language,+ printExp :: Tree -> String+ }++configureExBased :: PGF -> Morpho -> Language -> (Tree -> String) -> ExConfiguration+configureExBased pgf morpho lang pr = ExConf pgf morpho False lang pr+
@@ -0,0 +1,68 @@+module GF.Compile.Export where++import PGF+import PGF.Internal(ppPGF)+import GF.Compile.PGFtoHaskell+import GF.Compile.PGFtoJava+import GF.Compile.PGFtoProlog+import GF.Compile.PGFtoJS+import GF.Compile.PGFtoPython+import GF.Infra.Option+--import GF.Speech.CFG+import GF.Speech.PGFToCFG+import GF.Speech.SRGS_ABNF+import GF.Speech.SRGS_XML+import GF.Speech.JSGF+import GF.Speech.GSL+import GF.Speech.SRG+import GF.Speech.VoiceXML+import GF.Speech.SLF+import GF.Speech.PrRegExp++import Data.Maybe+import System.FilePath+import GF.Text.Pretty++-- top-level access to code generation++-- | Export a PGF to the given 'OutputFormat'. For many output formats,+-- additional 'Options' can be used to control the output.+exportPGF :: Options+ -> OutputFormat + -> PGF + -> [(FilePath,String)] -- ^ List of recommended file names and contents.+exportPGF opts fmt pgf = + case fmt of+ FmtPGFPretty -> multi "txt" (render . ppPGF)+ FmtJavaScript -> multi "js" pgf2js+ FmtPython -> multi "py" pgf2python+ FmtHaskell -> multi "hs" (grammar2haskell opts name)+ FmtJava -> multi "java" (grammar2java opts name)+ FmtProlog -> multi "pl" grammar2prolog+ FmtBNF -> single "bnf" bnfPrinter+ FmtEBNF -> single "ebnf" (ebnfPrinter opts)+ FmtSRGS_XML -> single "grxml" (srgsXmlPrinter opts)+ FmtSRGS_XML_NonRec -> single "grxml" (srgsXmlNonRecursivePrinter opts)+ FmtSRGS_ABNF -> single "gram" (srgsAbnfPrinter opts)+ FmtSRGS_ABNF_NonRec -> single "gram" (srgsAbnfNonRecursivePrinter opts)+ FmtJSGF -> single "jsgf" (jsgfPrinter opts)+ FmtGSL -> single "gsl" (gslPrinter opts)+ FmtVoiceXML -> single "vxml" grammar2vxml+ FmtSLF -> single "slf" slfPrinter+ FmtRegExp -> single "rexp" regexpPrinter+ FmtFA -> single "dot" slfGraphvizPrinter+ where+ name = fromMaybe (showCId (abstractName pgf)) (flag optName opts)++ multi :: String -> (PGF -> String) -> [(FilePath,String)]+ multi ext pr = [(name <.> ext, pr pgf)]++ single :: String -> (PGF -> CId -> String) -> [(FilePath,String)]+ single ext pr = [(showCId cnc <.> ext, pr pgf cnc) | cnc <- languages pgf]++-- | Get the name of the concrete syntax to generate output from.+-- FIXME: there should be an option to change this.+outputConcr :: PGF -> CId+outputConcr pgf = case languages pgf of+ [] -> error "No concrete syntax."+ cnc:_ -> cnc
@@ -0,0 +1,306 @@+module GF.Compile.GenerateBC(generateByteCode) where++import GF.Grammar+import GF.Grammar.Lookup(lookupAbsDef,lookupFunType)+import GF.Data.Operations+import PGF(CId,utf8CId)+import PGF.Internal(CodeLabel,Instr(..),IVal(..),TailInfo(..),Literal(..))+import qualified Data.Map as Map+import Data.List(nub,mapAccumL)+import Data.Maybe(fromMaybe)++generateByteCode :: SourceGrammar -> Int -> [L Equation] -> [[Instr]]+generateByteCode gr arity eqs =+ let (bs,instrs) = compileEquations gr arity (arity+1) is + (map (\(L _ (ps,t)) -> ([],ps,t)) eqs) + Nothing+ [b]+ b = if arity == 0 || null eqs+ then instrs+ else CHECK_ARGS arity:instrs+ in case bs of+ [[FAIL]] -> [] -- in the runtime this is a more efficient variant of [[FAIL]]+ _ -> reverse bs+ where+ is = push_is (arity-1) arity []++compileEquations :: SourceGrammar -> Int -> Int -> [IVal] -> [([(Ident,IVal)],[Patt],Term)] -> Maybe (Int,CodeLabel) -> [[Instr]] -> ([[Instr]],[Instr])+compileEquations gr arity st _ [] fl bs = (bs,mkFail arity st fl)+compileEquations gr arity st [] ((vs,[],t):_) fl bs = compileBody gr arity st vs t bs+compileEquations gr arity st (i:is) eqs fl bs = whilePP eqs Map.empty+ where+ whilePP [] cns = case Map.toList cns of+ [] -> (bs,[FAIL])+ (cn:cns) -> let (bs1,instrs1) = compileBranch0 fl bs cn+ bs2 = foldl (compileBranch fl) bs1 cns+ bs3 = mkFail arity st fl : bs2+ in (bs3,[PUSH_FRAME, EVAL (shiftIVal (st+2) i) RecCall] ++ instrs1)+ whilePP ((vs, PP c ps' : ps, t):eqs) cns = whilePP eqs (Map.insertWith (++) (Q c,length ps') [(vs,ps'++ps,t)] cns)+ whilePP ((vs, PInt n : ps, t):eqs) cns = whilePP eqs (Map.insertWith (++) (EInt n,0) [(vs,ps,t)] cns)+ whilePP ((vs, PString s: ps, t):eqs) cns = whilePP eqs (Map.insertWith (++) (K s,0) [(vs,ps,t)] cns)+ whilePP ((vs, PFloat d : ps, t):eqs) cns = whilePP eqs (Map.insertWith (++) (EFloat d,0) [(vs,ps,t)] cns)+ whilePP ((vs, PImplArg p:ps, t):eqs) cns = whilePP ((vs,p:ps,t):eqs) cns+ whilePP ((vs, PT _ p : ps, t):eqs) cns = whilePP ((vs,p:ps,t):eqs) cns+ whilePP ((vs, PAs x p : ps, t):eqs) cns = whilePP (((x,i):vs,p:ps,t):eqs) cns+ whilePP eqs cns = case Map.toList cns of+ [] -> whilePV eqs []+ (cn:cns) -> let fl1 = Just (st,length bs2)+ (bs1,instrs1) = compileBranch0 fl1 bs cn+ bs2 = foldl (compileBranch fl1) bs1 cns+ (bs3,instrs3) = compileEquations gr arity st (i:is) eqs fl (instrs3:bs2)+ in (bs3,[PUSH_FRAME, EVAL (shiftIVal (st+2) i) RecCall] ++ instrs1)++ whilePV [] vrs = compileEquations gr arity st is vrs fl bs+ whilePV ((vs, PV x : ps, t):eqs) vrs = whilePV eqs (((x,i):vs,ps,t) : vrs)+ whilePV ((vs, PW : ps, t):eqs) vrs = whilePV eqs (( vs,ps,t) : vrs)+ whilePV ((vs, PTilde _ : ps, t):eqs) vrs = whilePV eqs (( vs,ps,t) : vrs)+ whilePV ((vs, PImplArg p:ps, t):eqs) vrs = whilePV ((vs,p:ps,t):eqs) vrs+ whilePV ((vs, PT _ p : ps, t):eqs) vrs = whilePV ((vs,p:ps,t):eqs) vrs+ whilePV eqs vrs = let fl1 = Just (st,length bs1)+ (bs1,instrs1) = compileEquations gr arity st is vrs fl1 bs+ (bs2,instrs2) = compileEquations gr arity st (i:is) eqs fl (instrs2:bs1)+ in (bs2,instrs1)++ case_instr t =+ case t of+ (Q (_,id)) -> CASE (i2i id)+ (EInt n) -> CASE_LIT (LInt n)+ (K s) -> CASE_LIT (LStr s)+ (EFloat d) -> CASE_LIT (LFlt d)++ saves n = reverse [SAVE i | i <- [0..n-1]]++ compileBranch0 fl bs ((t,n),eqs) =+ let (bs1,instrs) = compileEquations gr arity (st+n) (push_is (st+n-1) n is) eqs fl bs+ in (bs1, case_instr t (length bs1) : saves n ++ instrs)++ compileBranch l bs ((t,n),eqs) =+ let (bs1,instrs) = compileEquations gr arity (st+n) (push_is (st+n-1) n is) eqs fl ((case_instr t (length bs1) : saves n ++ instrs) : bs)+ in bs1++mkFail arity st1 Nothing+ | arity+1 /= st1 = [DROP (st1-arity), FAIL]+ | otherwise = [FAIL]+mkFail arity st1 (Just (st0,l))+ | st1 /= st0 = [DROP (st1-st0), JUMP l]+ | otherwise = [JUMP l]++compileBody gr arity st vs e bs =+ let eval st fun args + | arity == 0 = let (st1,is) = pushArgs (st+2) (reverse args)+ fun' = shiftIVal st1 fun+ in [PUSH_FRAME]++is++[EVAL fun' UpdateCall]+ | otherwise = let (st1,fun',is) = tuckArgs arity st fun args+ in is++[EVAL fun' (TailCall (st1-length args-1))]+ (heap,bs1,is) = compileFun gr eval st vs e 0 bs []+ in (bs1,if heap > 0 then (ALLOC heap : is) else is)++compileFun gr eval st vs (Abs _ x e) h0 bs args =+ let (h1,bs1,arg,is1) = compileLambda gr st vs [x] e h0 bs+ in (h1,bs1,is1++eval st arg args)+compileFun gr eval st vs (App e1 e2) h0 bs args =+ let (h1,bs1,arg,is1) = compileArg gr st vs e2 h0 bs+ (h2,bs2,is2) = compileFun gr eval st vs e1 h1 bs1 (arg:args)+ in (h2,bs2,is1++is2)+compileFun gr eval st vs (Q (m,id)) h0 bs args =+ case lookupAbsDef gr m id of+ Ok (_,Just _)+ -> (h0,bs,eval st (GLOBAL (i2i id)) args)+ _ -> let Ok ty = lookupFunType gr m id+ (ctxt,_,_) = typeForm ty+ c_arity = length ctxt+ n_args = length args+ is1 = setArgs st args+ diff = c_arity-n_args+ in if diff <= 0+ then if n_args == 0+ then (h0,bs,eval st (GLOBAL (i2i id)) [])+ else let h1 = h0 + 2 + n_args+ in (h1,bs,PUT_CONSTR (i2i id):is1++eval st (HEAP h0) [])+ else let h1 = h0 + 1 + n_args+ is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]+ b = CHECK_ARGS diff :+ ALLOC (c_arity+2) : + PUT_CONSTR (i2i id) : + is2 +++ TUCK (ARG_VAR 0) diff :+ EVAL (HEAP h0) (TailCall diff) :+ []+ in (h1,b:bs,PUT_CLOSURE (length bs):is1++eval st (HEAP h0) [])+compileFun gr eval st vs (QC qid) h0 bs args =+ compileFun gr eval st vs (Q qid) h0 bs args+compileFun gr eval st vs (Vr x) h0 bs args =+ (h0,bs,eval st (getVar vs x) args)+compileFun gr eval st vs (EInt n) h0 bs _ =+ let h1 = h0 + 2+ in (h1,bs,PUT_LIT (LInt n) : eval st (HEAP h0) [])+compileFun gr eval st vs (K s) h0 bs _ =+ let h1 = h0 + 2+ in (h1,bs,PUT_LIT (LStr s) : eval st (HEAP h0) [])+compileFun gr eval st vs (EFloat d) h0 bs _ =+ let h1 = h0 + 2+ in (h1,bs,PUT_LIT (LFlt d) : eval st (HEAP h0) [])+compileFun gr eval st vs (Typed e _) h0 bs args =+ compileFun gr eval st vs e h0 bs args+compileFun gr eval st vs (Let (x, (_, e1)) e2) h0 bs args =+ let (h1,bs1,arg,is1) = compileLambda gr st vs [] e1 h0 bs+ (h2,bs2,is2) = compileFun gr eval st ((x,arg):vs) e2 h1 bs1 args+ in (h2,bs2,is1++is2)+compileFun gr eval st vs e@(Glue e1 e2) h0 bs args =+ let eval' st fun args = [PUSH_FRAME]++is++[EVAL fun' RecCall]+ where+ (_st1,is) = pushArgs (st+2) (reverse args)+ fun' = shiftIVal st fun++ flatten (Glue e1 e2) h0 bs =+ let (h1,bs1,is1) = flatten e1 h0 bs+ (h2,bs2,is2) = flatten e2 h1 bs1+ in (h2,bs2,is1++is2)+ flatten e h0 bs =+ let (h1,bs1,is1) = compileFun gr eval' (st+3) vs e h0 bs args+ in (h1,bs1,is1++[ADD])++ (h1,bs1,is) = flatten e h0 bs++ in (h1,bs1,[PUSH_ACCUM (LFlt 0)]++is++[POP_ACCUM]++eval (st+1) (ARG_VAR st) [])+compileFun gr eval st vs e _ _ _ = error (show e)++compileArg gr st vs (Q(m,id)) h0 bs =+ case lookupAbsDef gr m id of+ Ok (_,Just _) -> (h0,bs,GLOBAL (i2i id),[])+ _ -> let Ok ty = lookupFunType gr m id+ (ctxt,_,_) = typeForm ty+ c_arity = length ctxt+ in if c_arity == 0+ then (h0,bs,GLOBAL (i2i id),[])+ else let is2 = [SET (ARG_VAR (i+1)) | i <- [0..c_arity-1]]+ b = CHECK_ARGS c_arity :+ ALLOC (c_arity+2) :+ PUT_CONSTR (i2i id) :+ is2 +++ TUCK (ARG_VAR 0) c_arity :+ EVAL (HEAP h0) (TailCall c_arity) :+ []+ h1 = h0 + 2+ in (h1,b:bs,HEAP h0,[PUT_CLOSURE (length bs),SET_PAD])+compileArg gr st vs (QC qid) h0 bs =+ compileArg gr st vs (Q qid) h0 bs+compileArg gr st vs (Vr x) h0 bs =+ (h0,bs,getVar vs x,[])+compileArg gr st vs (EInt n) h0 bs =+ let h1 = h0 + 2+ in (h1,bs,HEAP h0,[PUT_LIT (LInt n)])+compileArg gr st vs (K s) h0 bs =+ let h1 = h0 + 2+ in (h1,bs,HEAP h0,[PUT_LIT (LStr s)])+compileArg gr st vs (EFloat d) h0 bs =+ let h1 = h0 + 2+ in (h1,bs,HEAP h0,[PUT_LIT (LFlt d)])+compileArg gr st vs (Typed e _) h0 bs =+ compileArg gr st vs e h0 bs+compileArg gr st vs (ImplArg e) h0 bs =+ compileArg gr st vs e h0 bs+compileArg gr st vs e h0 bs =+ let (f,es) = appForm e+ isConstr = case f of+ Q c@(m,id) -> case lookupAbsDef gr m id of+ Ok (_,Just _) -> Nothing+ _ -> Just c+ QC c@(m,id) -> case lookupAbsDef gr m id of+ Ok (_,Just _) -> Nothing+ _ -> Just c+ _ -> Nothing+ in case isConstr of+ Just (m,id) ->+ let Ok ty = lookupFunType gr m id+ (ctxt,_,_) = typeForm ty+ c_arity = length ctxt+ ((h1,bs1,is1),args) = mapAccumL (\(h,bs,is) e -> let (h1,bs1,arg,is1) = compileArg gr st vs e h bs+ in ((h1,bs1,is++is1),arg)) + (h0,bs,[])+ es+ n_args = length args+ is2 = setArgs st args+ diff = c_arity-n_args+ in if diff <= 0+ then let h2 = h1 + 2 + n_args+ in (h2,bs1,HEAP h1,is1 ++ (PUT_CONSTR (i2i id) : is2))+ else let h2 = h1 + 1 + n_args+ is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]+ b = CHECK_ARGS diff :+ ALLOC (c_arity+2) :+ PUT_CONSTR (i2i id) :+ is2 +++ TUCK (ARG_VAR 0) diff :+ EVAL (HEAP h0) (TailCall diff) :+ []+ in (h2,b:bs1,HEAP h1,is1 ++ (PUT_CLOSURE (length bs):is2))+ Nothing -> compileLambda gr st vs [] e h0 bs++compileLambda gr st vs xs (Abs _ x e) h0 bs =+ compileLambda gr st vs (x:xs) e h0 bs+compileLambda gr st vs xs e h0 bs =+ let ys = nub (freeVars xs e)+ arity = length xs+ (bs1,b) = compileBody gr arity+ (arity+1)+ (zip xs (map ARG_VAR [0..]) +++ zip ys (map FREE_VAR [0..]))+ e (b1:bs)+ b1 = if arity == 0+ then b+ else CHECK_ARGS arity:b+ is = if null ys+ then [SET_PAD]+ else map (SET . shiftIVal st . getVar vs) ys+ h1 = h0 + 1 + length is+ in (h1,bs1,HEAP h0,PUT_CLOSURE (length bs) : is)++getVar vs x =+ case lookup x vs of+ Just arg -> arg+ Nothing -> error "compileVar: unknown variable"++shiftIVal st (ARG_VAR i) = ARG_VAR (st-i-1)+shiftIVal st arg = arg++pushArgs st [] = (st,[])+pushArgs st (arg:args) = let (st1,is) = pushArgs (st+1) args+ in (st1, PUSH (shiftIVal st arg) : is)++tuckArgs arity st fun args = (st2,shiftIVal st2 fun',is1++is2)+ where+ (st2,fun',is2) = tucks st1 0 fun tas+ (st1,is1) = pushArgs st pas+ (tas,pas) = splitAt st args'+ args' = reverse (ARG_VAR arity : args)++ tucks st i fun [] = (st,fun,[])+ tucks st i fun (arg:args)+ | arg == ARG_VAR i = tucks st (i+1) fun args+ | otherwise = case save st (ARG_VAR i) (fun:args) of+ Just (fun:args) -> let (st1,fun',is) = tucks (st+1) (i+1) fun args+ in (st1, fun', PUSH (ARG_VAR (st-i-1)) :+ TUCK (shiftIVal (st+1) arg) (st-i) : is)+ Nothing -> let (st1,fun',is) = tucks st (i+1) fun args+ in (st1, fun', TUCK (shiftIVal st arg) (st-i-1) : is)++ save st arg0 [] = Nothing+ save st arg0 (arg:args)+ | arg0 == arg = Just (ARG_VAR st1 : fromMaybe args (save st arg0 args))+ | otherwise = fmap (arg :) (save st arg0 args)++setArgs st [] = []+setArgs st (arg:args) = SET (shiftIVal st arg) : setArgs st args++freeVars xs (Abs _ x e) = freeVars (x:xs) e+freeVars xs (Vr x) + | not (elem x xs) = [x]+freeVars xs e = collectOp (freeVars xs) e++i2i :: Ident -> CId+i2i = utf8CId . ident2utf8++push_is :: Int -> Int -> [IVal] -> [IVal]+push_is i 0 is = is+push_is i n is = ARG_VAR i : push_is (i-1) (n-1) is
@@ -0,0 +1,619 @@+{-# LANGUAGE BangPatterns, RankNTypes, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+----------------------------------------------------------------------+-- |+-- Maintainer : Krasimir Angelov+-- Stability : (stable)+-- Portability : (portable)+--+-- Convert PGF grammar to PMCFG grammar.+--+-----------------------------------------------------------------------------++module GF.Compile.GeneratePMCFG+ (generatePMCFG, pgfCncCat, addPMCFG, resourceValues+ ) where++--import PGF.CId+import PGF.Internal as PGF(CncCat(..),Symbol(..),fidVar)++import GF.Infra.Option+import GF.Grammar hiding (Env, mkRecord, mkTable)+import GF.Grammar.Lookup+import GF.Grammar.Predef+import GF.Grammar.Lockfield (isLockLabel)+import GF.Data.BacktrackM+import GF.Data.Operations+import GF.Infra.UseIO (ePutStr,ePutStrLn) -- IOE,+import GF.Data.Utilities (updateNthM) --updateNth+import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.List as List+--import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import GF.Text.Pretty+import Data.Array.IArray+import Data.Array.Unboxed+--import Data.Maybe+--import Data.Char (isDigit)+import Control.Applicative(Applicative(..))+import Control.Monad+import Control.Monad.Identity+--import Control.Exception+--import Debug.Trace(trace)++----------------------------------------------------------------------+-- main conversion function++--generatePMCFG :: Options -> SourceGrammar -> Maybe FilePath -> SourceModule -> IOE SourceModule+generatePMCFG opts sgr opath cmo@(cm,cmi) = do+ (seqs,js) <- mapAccumWithKeyM (addPMCFG opts gr cenv opath am cm) Map.empty (jments cmi)+ when (verbAtLeast opts Verbose) $ ePutStrLn ""+ return (cm,cmi{mseqs = Just (mkSetArray seqs), jments = js})+ where+ cenv = resourceValues opts gr+ gr = prependModule sgr cmo+ MTConcrete am = mtype cmi++mapAccumWithKeyM :: (Monad m, Ord k) => (a -> k -> b -> m (a,c)) -> a+ -> Map.Map k b -> m (a,Map.Map k c)+mapAccumWithKeyM f a m = do let xs = Map.toAscList m+ (a,ys) <- mapAccumM f a xs+ return (a,Map.fromAscList ys)+ where+ mapAccumM f a [] = return (a,[])+ mapAccumM f a ((k,x):kxs) = do (a,y ) <- f a k x+ (a,kys) <- mapAccumM f a kxs+ return (a,(k,y):kys)+++--addPMCFG :: Options -> SourceGrammar -> GlobalEnv -> Maybe FilePath -> Ident -> Ident -> SeqSet -> Ident -> Info -> IOE (SeqSet, Info)+addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin@(Just (L loc term)) mprn Nothing) = do+--when (verbAtLeast opts Verbose) $ ePutStr ("\n+ "++showIdent id++" ...")+ let pres = protoFCat gr res val+ pargs = [protoFCat gr (snd $ catSkeleton ty) lincat | ((_,_,ty),(_,_,lincat)) <- zip ctxt cont]++ pmcfgEnv0 = emptyPMCFGEnv+ b <- convert opts gr cenv (floc opath loc id) term (cont,val) pargs+ let (seqs1,b1) = addSequencesB seqs b+ pmcfgEnv1 = foldBM addRule+ pmcfgEnv0+ (goB b1 CNil [])+ (pres,pargs)+ pmcfg = getPMCFG pmcfgEnv1+ + stats = let PMCFG prods funs = pmcfg+ (s,e) = bounds funs+ !prods_cnt = length prods+ !funs_cnt = e-s+1+ in (prods_cnt,funs_cnt)++ when (verbAtLeast opts Verbose) $+ ePutStr ("\n+ "++showIdent id++" "++show (product (map catFactor pargs)))+ seqs1 `seq` stats `seq` return ()+ when (verbAtLeast opts Verbose) $ ePutStr (" "++show stats)+ return (seqs1,GF.Grammar.CncFun mty mlin mprn (Just pmcfg))+ where+ (ctxt,res,_) = err bug typeForm (lookupFunType gr am id)++ addRule lins (newCat', newArgs') env0 =+ let [newCat] = getFIds newCat'+ !fun = mkArray lins+ newArgs = map getFIds newArgs'+ in addFunction env0 newCat fun newArgs++addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat)) + mdef@(Just (L loc1 def))+ mref@(Just (L loc2 ref))+ mprn+ Nothing) = do+ let pcat = protoFCat gr (am,id) lincat+ pvar = protoFCat gr (MN identW,cVar) typeStr++ pmcfgEnv0 = emptyPMCFGEnv++ let lincont = [(Explicit, varStr, typeStr)]+ b <- convert opts gr cenv (floc opath loc1 id) def (lincont,lincat) [pvar]+ let (seqs1,b1) = addSequencesB seqs b+ pmcfgEnv1 = foldBM addLindef+ pmcfgEnv0+ (goB b1 CNil [])+ (pcat,[pvar])++ let lincont = [(Explicit, varStr, lincat)]+ b <- convert opts gr cenv (floc opath loc2 id) ref (lincont,typeStr) [pcat]+ let (seqs2,b2) = addSequencesB seqs1 b+ pmcfgEnv2 = foldBM addLinref+ pmcfgEnv1+ (goB b2 CNil [])+ (pvar,[pcat])++ let pmcfg = getPMCFG pmcfgEnv2++ when (verbAtLeast opts Verbose) $ ePutStr ("\n+ "++showIdent id++" "++show (catFactor pcat))+ seqs2 `seq` pmcfg `seq` return (seqs2,GF.Grammar.CncCat mty mdef mref mprn (Just pmcfg))+ where+ addLindef lins (newCat', newArgs') env0 =+ let [newCat] = getFIds newCat'+ !fun = mkArray lins+ in addFunction env0 newCat fun [[fidVar]]++ addLinref lins (newCat', [newArg']) env0 =+ let newArg = getFIds newArg'+ !fun = mkArray lins+ in addFunction env0 fidVar fun [newArg]++addPMCFG opts gr cenv opath am cm seqs id info = return (seqs, info)++floc opath loc id = maybe (L loc id) (\path->L (External path loc) id) opath++convert opts gr cenv loc term ty@(_,val) pargs =+ case normalForm cenv loc (etaExpand ty term) of+ Error s -> fail $ render $ ppL loc ("Predef.error: "++s)+ term -> return $ runCnvMonad gr (convertTerm opts CNil val term) (pargs,[])+ where+ etaExpand (context,val) = mkAbs pars . flip mkApp args+ where pars = [(Explicit,v) | v <- vars]+ args = map Vr vars+ vars = map (\(bt,x,t) -> x) context++pgfCncCat :: SourceGrammar -> Type -> Int -> CncCat+pgfCncCat gr lincat index =+ let ((_,size),schema) = computeCatRange gr lincat+ in PGF.CncCat index (index+size-1)+ (mkArray (map (renderStyle style{mode=OneLineMode} . ppPath) + (getStrPaths schema)))+ where+ getStrPaths :: Schema Identity s c -> [Path]+ getStrPaths = collect CNil []+ where+ collect path paths (CRec rs) = foldr (\(lbl,Identity t) paths -> collect (CProj lbl path) paths t) paths rs+ collect path paths (CTbl _ cs) = foldr (\(trm,Identity t) paths -> collect (CSel trm path) paths t) paths cs+ collect path paths (CStr _) = reversePath path : paths+ collect path paths (CPar _) = paths++----------------------------------------------------------------------+-- CnvMonad monad+--+-- The branching monad provides backtracking together with+-- recording of the choices made. We have two cases+-- when we have alternative choices:+--+-- * when we have parameter type, then+-- we have to try all possible values+-- * when we have variants we have to try all alternatives+--+-- The conversion monad keeps track of the choices and they are+-- returned as 'Branch' data type.++data Branch a+ = Case Int Path [(Term,Branch a)]+ | Variant [Branch a]+ | Return a++newtype CnvMonad a = CM {unCM :: SourceGrammar+ -> forall b . (a -> ([ProtoFCat],[Symbol]) -> Branch b)+ -> ([ProtoFCat],[Symbol])+ -> Branch b}++instance Applicative CnvMonad where+ pure = return+ (<*>) = ap++instance Monad CnvMonad where+ return a = CM (\gr c s -> c a s)+ CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)++instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where+ get = CM (\gr c s -> c s s)+ put s = CM (\gr c _ -> c () s)++instance Functor CnvMonad where+ fmap f (CM m) = CM (\gr c s -> m gr (c . f) s)++runCnvMonad :: SourceGrammar -> CnvMonad a -> ([ProtoFCat],[Symbol]) -> Branch a+runCnvMonad gr (CM m) s = m gr (\v s -> Return v) s++-- | backtracking for all variants+variants :: [a] -> CnvMonad a+variants xs = CM (\gr c s -> Variant [c x s | x <- xs])++-- | backtracking for all parameter values that a variable could take+choices :: Int -> Path -> CnvMonad Term+choices nr path = do (args,_) <- get+ let PFCat _ _ schema = args !! nr+ descend schema path CNil+ where+ descend (CRec rs) (CProj lbl path) rpath = case lookup lbl rs of+ Just (Identity t) -> descend t path (CProj lbl rpath)+ descend (CRec rs) CNil rpath = do rs <- mapM (\(lbl,Identity t) -> fmap (assign lbl) (descend t CNil (CProj lbl rpath))) rs+ return (R rs)+ descend (CTbl pt cs) (CSel trm path) rpath = case lookup trm cs of+ Just (Identity t) -> descend t path (CSel trm rpath)+ descend (CTbl pt cs) CNil rpath = do cs <- mapM (\(trm,Identity t) -> descend t CNil (CSel trm rpath)) cs+ return (V pt cs)+ descend (CPar (m,vs)) CNil rpath = case vs of+ [(value,index)] -> return value+ values -> let path = reversePath rpath+ in CM (\gr c s -> Case nr path [(value, updateEnv path value gr c s)+ | (value,index) <- values])+ descend schema path rpath = bug $ "descend "++show (schema,path,rpath)++ updateEnv path value gr c (args,seq) = + case updateNthM (restrictProtoFCat path value) nr args of+ Just args -> c value (args,seq)+ Nothing -> bug "conflict in updateEnv"++-- | the argument should be a parameter type and then+-- the function returns all possible values.+getAllParamValues :: Type -> CnvMonad [Term]+getAllParamValues ty = CM (\gr c -> c (err bug id (allParamValues gr ty)))++mkRecord :: [(Label,CnvMonad (Schema Branch s c))] -> CnvMonad (Schema Branch s c)+mkRecord xs = CM (\gr c -> foldl (\c (lbl,CM m) bs s -> c ((lbl,m gr (\v s -> Return v) s) : bs) s) (c . CRec) xs [])++mkTable :: Type -> [(Term ,CnvMonad (Schema Branch s c))] -> CnvMonad (Schema Branch s c)+mkTable pt xs = CM (\gr c -> foldl (\c (trm,CM m) bs s -> c ((trm,m gr (\v s -> Return v) s) : bs) s) (c . CTbl pt) xs [])++----------------------------------------------------------------------+-- Term Schema+--+-- The term schema is a term-like structure, with records, tables,+-- strings and parameters values, but in addition we could add+-- annotations of arbitrary types++-- | Term schema+data Schema b s c+ = CRec [(Label,b (Schema b s c))]+ | CTbl Type [(Term, b (Schema b s c))]+ | CStr s+ | CPar c+--deriving Show -- doesn't work++instance Show s => Show (Schema b s c) where+ showsPrec _ sch =+ case sch of+ CRec r -> showString "CRec " . shows (map fst r)+ CTbl t _ -> showString "CTbl " . showsPrec 10 t . showString " _"+ CStr s -> showString "CStr " . showsPrec 10 s+ CPar c -> showString "CPar{}"++-- | Path into a term or term schema+data Path+ = CProj Label Path+ | CSel Term Path+ | CNil+ deriving (Eq,Show)++-- | The ProtoFCat represents a linearization type as term schema.+-- The annotations are as follows: the strings are annotated with+-- their index in the PMCFG tuple, the parameters are annotated+-- with their value both as term and as index.+data ProtoFCat = PFCat Ident Int (Schema Identity Int (Int,[(Term,Int)]))+type Env = (ProtoFCat, [ProtoFCat])++protoFCat :: SourceGrammar -> Cat -> Type -> ProtoFCat+protoFCat gr cat lincat =+ case computeCatRange gr lincat of+ ((_,f),schema) -> PFCat (snd cat) f schema++getFIds :: ProtoFCat -> [FId]+getFIds (PFCat _ _ schema) =+ reverse (solutions (variants schema) ())+ where+ variants (CRec rs) = fmap sum $ mapM (\(lbl,Identity t) -> variants t) rs+ variants (CTbl _ cs) = fmap sum $ mapM (\(trm,Identity t) -> variants t) cs+ variants (CStr _) = return 0+ variants (CPar (m,values)) = do (value,index) <- member values+ return (m*index)++catFactor :: ProtoFCat -> Int+catFactor (PFCat _ f _) = f++computeCatRange gr lincat = compute (0,1) lincat+ where+ compute st (RecType rs) = let (st',rs') = List.mapAccumL (\st (lbl,t) -> case lbl of+ LVar _ -> let (st',t') = compute st t+ in (st ,(lbl,Identity t'))+ _ -> let (st',t') = compute st t+ in (st',(lbl,Identity t'))) st rs+ in (st',CRec rs')+ compute st (Table pt vt) = let vs = err bug id (allParamValues gr pt)+ (st',cs') = List.mapAccumL (\st v -> let (st',vt') = compute st vt+ in (st',(v,Identity vt'))) st vs+ in (st',CTbl pt cs')+ compute st (Sort s)+ | s == cStr = let (index,m) = st+ in ((index+1,m),CStr index)+ compute st t = let vs = err bug id (allParamValues gr t)+ (index,m) = st+ in ((index,m*length vs),CPar (m,zip vs [0..]))++ppPath (CProj lbl path) = lbl <+> ppPath path+ppPath (CSel trm path) = ppU 5 trm <+> ppPath path+ppPath CNil = empty++reversePath path = rev CNil path+ where+ rev path0 CNil = path0+ rev path0 (CProj lbl path) = rev (CProj lbl path0) path+ rev path0 (CSel trm path) = rev (CSel trm path0) path+++----------------------------------------------------------------------+-- term conversion++type Value a = Schema Branch a Term++convertTerm :: Options -> Path -> Type -> Term -> CnvMonad (Value [Symbol])+convertTerm opts sel ctype (Vr x) = convertArg opts ctype (getVarIndex x) (reversePath sel)+convertTerm opts sel ctype (Abs _ _ t) = convertTerm opts sel ctype t -- there are only top-level abstractions and we ignore them !!!+convertTerm opts sel ctype (R record) = convertRec opts sel ctype record+convertTerm opts sel ctype (P term l) = convertTerm opts (CProj l sel) ctype term+convertTerm opts sel ctype (V pt ts) = convertTbl opts sel ctype pt ts+convertTerm opts sel ctype (S term p) = do v <- evalTerm CNil p+ convertTerm opts (CSel v sel) ctype term+convertTerm opts sel ctype (FV vars) = do term <- variants vars+ convertTerm opts sel ctype term+convertTerm opts sel ctype (C t1 t2) = do v1 <- convertTerm opts sel ctype t1+ v2 <- convertTerm opts sel ctype t2+ return (CStr (concat [s | CStr s <- [v1,v2]]))+convertTerm opts sel ctype (K t) = return (CStr [SymKS t])+convertTerm opts sel ctype Empty = return (CStr [])+convertTerm opts sel ctype (Alts s alts)= do CStr s <- convertTerm opts CNil ctype s+ alts <- forM alts $ \(u,alt) -> do+ CStr u <- convertTerm opts CNil ctype u+ Strs ps <- unPatt alt+ ps <- mapM (convertTerm opts CNil ctype) ps+ return (u,map unSym ps)+ return (CStr [SymKP s alts])+ where+ unSym (CStr []) = ""+ unSym (CStr [SymKS t]) = t+ unSym _ = ppbug $ hang ("invalid prefix in pre expression:") 4 (Alts s alts)++ unPatt (EPatt p) = fmap Strs (getPatts p)+ unPatt u = return u++ getPatts p = case p of+ PAlt a b -> liftM2 (++) (getPatts a) (getPatts b)+ PString s -> return [K s]+ PSeq a b -> do+ as <- getPatts a+ bs <- getPatts b+ return [K (s ++ t) | K s <- as, K t <- bs]+ _ -> fail (render ("not valid pattern in pre expression" <+> ppPatt Unqualified 0 p))++convertTerm opts sel ctype (Q (m,f))+ | m == cPredef &&+ f == cBIND = return (CStr [SymBIND])+ | m == cPredef &&+ f == cSOFT_BIND = return (CStr [SymSOFT_BIND])+ | m == cPredef &&+ f == cSOFT_SPACE = return (CStr [SymSOFT_SPACE])+ | m == cPredef &&+ f == cCAPIT = return (CStr [SymCAPIT])+ | m == cPredef &&+ f == cALL_CAPIT = return (CStr [SymALL_CAPIT])+ | m == cPredef &&+ f == cNonExist = return (CStr [SymNE])+{-+convertTerm opts sel@(CProj l _) ctype (ExtR t1 t2@(R rs2))+ | l `elem` map fst rs2 = convertTerm opts sel ctype t2+ | otherwise = convertTerm opts sel ctype t1++convertTerm opts sel@(CProj l _) ctype (ExtR t1@(R rs1) t2)+ | l `elem` map fst rs1 = convertTerm opts sel ctype t1+ | otherwise = convertTerm opts sel ctype t2+-}+convertTerm opts CNil ctype t = do v <- evalTerm CNil t+ return (CPar v)+convertTerm _ sel _ t = ppbug ("convertTerm" <+> sep [parens (show sel),ppU 10 t])++convertArg :: Options -> Term -> Int -> Path -> CnvMonad (Value [Symbol])+convertArg opts (RecType rs) nr path =+ mkRecord (map (\(lbl,ctype) -> (lbl,convertArg opts ctype nr (CProj lbl path))) rs)+convertArg opts (Table pt vt) nr path = do+ vs <- getAllParamValues pt+ mkTable pt (map (\v -> (v,convertArg opts vt nr (CSel v path))) vs)+convertArg opts (Sort _) nr path = do+ (args,_) <- get+ let PFCat cat _ schema = args !! nr+ l = index (reversePath path) schema+ sym | CProj (LVar i) CNil <- path = SymVar nr i+ | isLiteralCat opts cat = SymLit nr l+ | otherwise = SymCat nr l+ return (CStr [sym])+ where+ index (CProj lbl path) (CRec rs) = case lookup lbl rs of+ Just (Identity t) -> index path t+ index (CSel trm path) (CTbl _ rs) = case lookup trm rs of+ Just (Identity t) -> index path t+ index CNil (CStr idx) = idx+convertArg opts ty nr path = do+ value <- choices nr (reversePath path)+ return (CPar value)++convertRec opts CNil (RecType rs) record =+ mkRecord [(lbl,convertTerm opts CNil ctype (proj lbl))|(lbl,ctype)<-rs]+ where proj lbl = if isLockLabel lbl then R [] else projectRec lbl record+convertRec opts (CProj lbl path) ctype record =+ convertTerm opts path ctype (projectRec lbl record)+convertRec opts _ ctype _ = bug ("convertRec: "++show ctype)++convertTbl opts CNil (Table _ vt) pt ts = do+ vs <- getAllParamValues pt+ mkTable pt (zipWith (\v t -> (v,convertTerm opts CNil vt t)) vs ts)+convertTbl opts (CSel v sub_sel) ctype pt ts = do+ vs <- getAllParamValues pt+ case lookup v (zip vs ts) of+ Just t -> convertTerm opts sub_sel ctype t+ Nothing -> ppbug ( "convertTbl:" <+> ("missing value" <+> v $$+ "among" <+> vcat vs))+convertTbl opts _ ctype _ _ = bug ("convertTbl: "++show ctype)+++goB :: Branch (Value SeqId) -> Path -> [SeqId] -> BacktrackM Env [SeqId]+goB (Case nr path bs) rpath ss = do (value,b) <- member bs+ restrictArg nr path value+ goB b rpath ss+goB (Variant bs) rpath ss = do b <- member bs+ goB b rpath ss+goB (Return v) rpath ss = goV v rpath ss++goV :: Value SeqId -> Path -> [SeqId] -> BacktrackM Env [SeqId]+goV (CRec xs) rpath ss = foldM (\ss (lbl,b) -> goB b (CProj lbl rpath) ss) ss (reverse xs)+goV (CTbl _ xs) rpath ss = foldM (\ss (trm,b) -> goB b (CSel trm rpath) ss) ss (reverse xs)+goV (CStr seqid) rpath ss = return (seqid : ss)+goV (CPar t) rpath ss = restrictHead (reversePath rpath) t >> return ss+++----------------------------------------------------------------------+-- SeqSet++type SeqSet = Map.Map Sequence SeqId++addSequencesB :: SeqSet -> Branch (Value [Symbol]) -> (SeqSet, Branch (Value SeqId))+addSequencesB seqs (Case nr path bs) = let !(seqs1,bs1) = mapAccumL' (\seqs (trm,b) -> let !(seqs',b') = addSequencesB seqs b+ in (seqs',(trm,b'))) seqs bs+ in (seqs1,Case nr path bs1)+addSequencesB seqs (Variant bs) = let !(seqs1,bs1) = mapAccumL' addSequencesB seqs bs+ in (seqs1,Variant bs1)+addSequencesB seqs (Return v) = let !(seqs1,v1) = addSequencesV seqs v+ in (seqs1,Return v1)++addSequencesV :: SeqSet -> Value [Symbol] -> (SeqSet, Value SeqId)+addSequencesV seqs (CRec vs) = let !(seqs1,vs1) = mapAccumL' (\seqs (lbl,b) -> let !(seqs',b') = addSequencesB seqs b+ in (seqs',(lbl,b'))) seqs vs+ in (seqs1,CRec vs1)+addSequencesV seqs (CTbl pt vs)=let !(seqs1,vs1) = mapAccumL' (\seqs (trm,b) -> let !(seqs',b') = addSequencesB seqs b+ in (seqs',(trm,b'))) seqs vs+ in (seqs1,CTbl pt vs1)+addSequencesV seqs (CStr lin) = let !(seqs1,seqid) = addSequence seqs lin+ in (seqs1,CStr seqid)+addSequencesV seqs (CPar i) = (seqs,CPar i)++-- a strict version of Data.List.mapAccumL+mapAccumL' f s [] = (s,[])+mapAccumL' f s (x:xs) = (s'',y:ys)+ where !(s', y ) = f s x+ !(s'',ys) = mapAccumL' f s' xs++addSequence :: SeqSet -> [Symbol] -> (SeqSet,SeqId)+addSequence seqs lst =+ case Map.lookup seq seqs of+ Just id -> (seqs,id)+ Nothing -> let !last_seq = Map.size seqs+ in (Map.insert seq last_seq seqs, last_seq)+ where+ seq = mkArray lst+++------------------------------------------------------------+-- eval a term to ground terms++evalTerm :: Path -> Term -> CnvMonad Term+evalTerm CNil (QC f) = return (QC f)+evalTerm CNil (App x y) = do x <- evalTerm CNil x+ y <- evalTerm CNil y+ return (App x y)+evalTerm path (Vr x) = choices (getVarIndex x) path+evalTerm path (R rs) =+ case path of+ CProj lbl path -> evalTerm path (projectRec lbl rs)+ CNil -> R `fmap` mapM (\(lbl,(_,t)) -> assign lbl `fmap` evalTerm path t) rs+evalTerm path (P term lbl) = evalTerm (CProj lbl path) term+evalTerm path (V pt ts) =+ case path of+ CNil -> V pt `fmap` mapM (evalTerm path) ts+ CSel trm path ->+ do vs <- getAllParamValues pt+ case lookup trm (zip vs ts) of+ Just t -> evalTerm path t+ Nothing -> ppbug $ "evalTerm: missing value:"<+>trm+ $$ "among:" <+>fsep (map (ppU 10) vs)+evalTerm path (S term sel) = do v <- evalTerm CNil sel+ evalTerm (CSel v path) term+evalTerm path (FV terms) = variants terms >>= evalTerm path+evalTerm path (EInt n) = return (EInt n)+evalTerm path t = ppbug ("evalTerm" <+> parens t)+--evalTerm path t = ppbug (text "evalTerm" <+> sep [parens (text (show path)),parens (text (show t))])++getVarIndex x = maybe err id $ getArgIndex x+ where err = bug ("getVarIndex "++show x)++----------------------------------------------------------------------+-- GrammarEnv++data PMCFGEnv = PMCFGEnv !ProdSet !FunSet+type ProdSet = Set.Set Production+type FunSet = Map.Map (UArray LIndex SeqId) FunId++emptyPMCFGEnv =+ PMCFGEnv Set.empty Map.empty++addFunction :: PMCFGEnv -> FId -> UArray LIndex SeqId -> [[FId]] -> PMCFGEnv+addFunction (PMCFGEnv prodSet funSet) !fid fun args =+ case Map.lookup fun funSet of+ Just !funid -> PMCFGEnv (Set.insert (Production fid funid args) prodSet)+ funSet+ Nothing -> let !funid = Map.size funSet+ in PMCFGEnv (Set.insert (Production fid funid args) prodSet)+ (Map.insert fun funid funSet)++getPMCFG :: PMCFGEnv -> PMCFG+getPMCFG (PMCFGEnv prodSet funSet) =+ PMCFG (optimize prodSet) (mkSetArray funSet)+ where+ optimize ps = Map.foldrWithKey ff [] (Map.fromListWith (++) [((fid,funid),[args]) | (Production fid funid args) <- Set.toList ps])+ where+ ff :: (FId,FunId) -> [[[FId]]] -> [Production] -> [Production]+ ff (fid,funid) xs prods+ | product (map IntSet.size ys) == count+ = (Production fid funid (map IntSet.toList ys)) : prods+ | otherwise = map (Production fid funid) xs ++ prods+ where+ count = sum (map (product . map length) xs)+ ys = foldl (zipWith (foldr IntSet.insert)) (repeat IntSet.empty) xs++------------------------------------------------------------+-- updating the MCF rule++restrictArg :: LIndex -> Path -> Term -> BacktrackM Env ()+restrictArg nr path index = do+ (head, args) <- get+ args <- updateNthM (restrictProtoFCat path index) nr args+ put (head, args)++restrictHead :: Path -> Term -> BacktrackM Env ()+restrictHead path term = do+ (head, args) <- get+ head <- restrictProtoFCat path term head+ put (head, args)++restrictProtoFCat :: (Functor m, MonadPlus m) => Path -> Term -> ProtoFCat -> m ProtoFCat+restrictProtoFCat path v (PFCat cat f schema) = do+ schema <- addConstraint path v schema+ return (PFCat cat f schema)+ where+ addConstraint (CProj lbl path) v (CRec rs) = fmap CRec $ update lbl (addConstraint path v) rs+ addConstraint (CSel trm path) v (CTbl pt cs) = fmap (CTbl pt) $ update trm (addConstraint path v) cs+ addConstraint CNil v (CPar (m,vs)) = case lookup v vs of+ Just index -> return (CPar (m,[(v,index)]))+ Nothing -> mzero+ addConstraint CNil v (CStr _) = bug "restrictProtoFCat: string path"+ + update k0 f [] = return []+ update k0 f (x@(k,Identity v):xs)+ | k0 == k = do v <- f v+ return ((k,Identity v):xs)+ | otherwise = do xs <- update k0 f xs+ return (x:xs)++mkArray lst = listArray (0,length lst-1) lst+mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]++bug msg = ppbug msg+ppbug msg = error . render $ hang "Internal error in GeneratePMCFG:" 4 msg++ppU = ppTerm Unqualified
@@ -0,0 +1,145 @@+----------------------------------------------------------------------+-- |+-- Module : GetGrammar+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/15 17:56:13 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.16 $+--+-- this module builds the internal GF grammar that is sent to the type checker+-----------------------------------------------------------------------------++module GF.Compile.GetGrammar (getSourceModule, getBNFCRules, getEBNFRules) where++import Prelude hiding (catch)++import GF.Data.Operations++import GF.Infra.UseIO+import GF.Infra.Option(Options,optPreprocessors,addOptions,renameEncoding,optEncoding,flag,defaultEncoding)+import GF.Grammar.Lexer+import GF.Grammar.Parser+import GF.Grammar.Grammar+import GF.Grammar.BNFC+import GF.Grammar.EBNF+import GF.Compile.ReadFiles(parseSource)++import qualified Data.ByteString.Char8 as BS+import Data.Char(isAscii)+import Control.Monad (foldM,when,unless)+import System.Process (system)+import GF.System.Directory(removeFile,getCurrentDirectory)+import System.FilePath(makeRelative)++--getSourceModule :: Options -> FilePath -> IOE SourceModule+-- | Read a source file and parse it (after applying preprocessors specified in the options)+getSourceModule opts file0 = +--errIn file0 $+ do tmp <- liftIO $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts)+ raw <- liftIO $ keepTemp tmp+ --ePutStrLn $ "1 "++file0+ (optCoding,parsed) <- parseSource opts pModDef raw+ case parsed of+ Left (Pn l c,msg) -> do file <- liftIO $ writeTemp tmp+ cwd <- getCurrentDirectory+ let location = makeRelative cwd file++":"++show l++":"++show c+ raise (location++":\n "++msg)+ Right (i,mi0) ->+ do liftIO $ removeTemp tmp+ let mi =mi0 {mflags=mflags mi0 `addOptions` opts, msrc=file0}+ optCoding' = renameEncoding `fmap` flag optEncoding (mflags mi0)+ case (optCoding,optCoding') of+ {-+ (Nothing,Nothing) ->+ unless (BS.all isAscii raw) $+ ePutStrLn $ file0++":\n Warning: default encoding has changed from Latin-1 to UTF-8"+ -}+ (_,Just coding') -> + when (coding/=coding') $+ raise $ "Encoding mismatch: "++coding++" /= "++coding'+ where coding = maybe defaultEncoding renameEncoding optCoding+ _ -> return ()+ --liftIO $ transcodeModule' (i,mi) -- old lexer+ return (i,mi) -- new lexer++getBNFCRules :: Options -> FilePath -> IOE [BNFCRule]+getBNFCRules opts fpath = do+ raw <- liftIO (BS.readFile fpath)+---- debug BS.putStrLn $ raws+ (optCoding,parsed) <- parseSource opts pBNFCRules raw+ case parsed of+ Left _ -> do+ let ifToChange s ss = if (BS.all (\c -> elem c [' ','\t']) s || BS.last s == ';') then s else ss -- change if not all space or end with ';'+ let raws = BS.concat $ map (\s -> ifToChange s $ BS.concat [s,BS.singleton ';']) $ BS.split '\n' raw -- add semicolon to each line to be able to parse the format in GF book+ (optCoding,parseds) <- parseSource opts pBNFCRules raws+ case parseds of+ Left (Pn l c,msg) -> do cwd <- getCurrentDirectory+ let location = makeRelative cwd fpath++":"++show l++":"++show c+ raise (location++":\n "++msg)+ Right rules -> return rules+ Right rules -> return rules++getEBNFRules :: Options -> FilePath -> IOE [ERule]+getEBNFRules opts fpath = do+ raw <- liftIO (BS.readFile fpath)+ (optCoding,parsed) <- parseSource opts pEBNFRules raw+ case parsed of+ Left (Pn l c,msg) -> do cwd <- getCurrentDirectory+ let location = makeRelative cwd fpath++":"++show l++":"++show c+ raise (location++":\n "++msg)+ Right rules -> return rules++runPreprocessor :: Temporary -> String -> IO Temporary+runPreprocessor tmp0 p =+ maybe external internal (lookup p builtin_preprocessors)+ where+ internal preproc = (Internal . preproc) `fmap` readTemp tmp0+ external =+ do file0 <- writeTemp tmp0+ -- FIXME: should use System.IO.openTempFile+ let file1a = "_gf_preproc.tmp"+ file1b = "_gf_preproc2.tmp"+ -- file0 and file1 must be different+ file1 = if file0==file1a then file1b else file1a+ cmd = p +++ file0 ++ ">" ++ file1+ system cmd+ return (Temp file1)++--------------------------------------------------------------------------------++builtin_preprocessors = [("mkPresent",mkPresent),("mkMinimal",mkMinimal)]++mkPresent = omit_lines "--# notpresent" -- grep -v "\-\-\# notpresent"+mkMinimal = omit_lines "--# notminimal" -- grep -v "\-\-\# notminimal"++omit_lines s = BS.unlines . filter (not . BS.isInfixOf bs) . BS.lines+ where bs = BS.pack s++--------------------------------------------------------------------------------++data Temporary = Source FilePath | Temp FilePath | Internal BS.ByteString++writeTemp tmp =+ case tmp of+ Source path -> return path+ Temp path -> return path+ Internal str -> do -- FIXME: should use System.IO.openTempFile+ let tmp = "_gf_preproc.tmp"+ BS.writeFile tmp str+ return tmp++readTemp tmp = do str <- keepTemp tmp+ removeTemp tmp+ return str++keepTemp tmp =+ case tmp of+ Source path -> BS.readFile path+ Temp path -> BS.readFile path+ Internal str -> return str++removeTemp (Temp path) = removeFile path+removeTemp _ = return ()
@@ -0,0 +1,308 @@+{-# LANGUAGE BangPatterns, FlexibleContexts #-}+module GF.Compile.GrammarToPGF (mkCanon2pgf) where++--import GF.Compile.Export+import GF.Compile.GeneratePMCFG+import GF.Compile.GenerateBC++import PGF(CId,mkCId,utf8CId)+import PGF.Internal(fidInt,fidFloat,fidString,fidVar)+import PGF.Internal(updateProductionIndices)+--import qualified PGF.Macros as CM+import qualified PGF.Internal as C+import qualified PGF.Internal as D+import GF.Grammar.Predef+--import GF.Grammar.Printer+import GF.Grammar.Grammar+import qualified GF.Grammar.Lookup as Look+import qualified GF.Grammar as A+import qualified GF.Grammar.Macros as GM+--import GF.Compile.GeneratePMCFG++import GF.Infra.Ident+import GF.Infra.Option+import GF.Infra.UseIO (IOE)+import GF.Data.Operations++import Data.List+import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import Data.Array.IArray++mkCanon2pgf :: Options -> SourceGrammar -> ModuleName -> IOE D.PGF+mkCanon2pgf opts gr am = do+ (an,abs) <- mkAbstr am+ cncs <- mapM mkConcr (allConcretes gr am)+ return $ updateProductionIndices (D.PGF Map.empty an abs (Map.fromList cncs))+ where+ cenv = resourceValues opts gr++ mkAbstr am = return (mi2i am, D.Abstr flags funs cats)+ where+ aflags = err (const noOptions) mflags (lookupModule gr am)++ adefs =+ [((cPredefAbs,c), AbsCat (Just (L NoLoc []))) | c <- [cFloat,cInt,cString]] ++ + Look.allOrigInfos gr am++ flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF aflags]++ funs = Map.fromList [(i2i f, (mkType [] ty, arity, mkDef gr arity mdef, 0)) | + ((m,f),AbsFun (Just (L _ ty)) ma mdef _) <- adefs,+ let arity = mkArity ma mdef ty]++ cats = Map.fromList [(i2i c, (snd (mkContext [] cont),catfuns c, 0)) |+ ((m,c),AbsCat (Just (L _ cont))) <- adefs]++ catfuns cat =+ [(0,i2i f) | ((m,f),AbsFun (Just (L _ ty)) _ _ (Just True)) <- adefs, snd (GM.valCat ty) == cat]++ mkConcr cm = do+ let cflags = err (const noOptions) mflags (lookupModule gr cm)++ (ex_seqs,cdefs) <- addMissingPMCFGs+ Map.empty + ([((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]] +++ Look.allOrigInfos gr cm)++ let flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF cflags]++ seqs = (mkSetArray . Set.fromList . concat) $+ (Map.keys ex_seqs : [maybe [] elems (mseqs mi) | (m,mi) <- allExtends gr cm])++ ex_seqs_arr = mkMapArray ex_seqs :: Array SeqId Sequence++ !(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs+ !(!fid_cnt2,!productions,!lindefs,!linrefs,!cncfuns)+ = genCncFuns gr am cm ex_seqs_arr seqs cdefs fid_cnt1 cnccats+ + printnames = genPrintNames cdefs+ return (mi2i cm, D.Concr flags+ printnames+ cncfuns+ lindefs+ linrefs+ seqs+ productions+ IntMap.empty+ Map.empty+ cnccats+ IntMap.empty+ fid_cnt2)+ where+ -- if some module was compiled with -no-pmcfg, then+ -- we have to create the PMCFG code just before linking+ addMissingPMCFGs seqs [] = return (seqs,[])+ addMissingPMCFGs seqs (((m,id), info):is) = do+ (seqs,info) <- addPMCFG opts gr cenv Nothing am cm seqs id info+ (seqs,is ) <- addMissingPMCFGs seqs is+ return (seqs, ((m,id), info) : is)++i2i :: Ident -> CId+i2i = utf8CId . ident2utf8++mi2i :: ModuleName -> CId+mi2i (MN i) = i2i i++mkType :: [Ident] -> A.Type -> C.Type+mkType scope t =+ case GM.typeForm t of+ (hyps,(_,cat),args) -> let (scope',hyps') = mkContext scope hyps+ in C.DTyp hyps' (i2i cat) (map (mkExp scope') args)++mkExp :: [Ident] -> A.Term -> C.Expr+mkExp scope t = + case t of+ Q (_,c) -> C.EFun (i2i c)+ QC (_,c) -> C.EFun (i2i c)+ Vr x -> case lookup x (zip scope [0..]) of+ Just i -> C.EVar i+ Nothing -> C.EMeta 0+ Abs b x t-> C.EAbs b (i2i x) (mkExp (x:scope) t)+ App t1 t2-> C.EApp (mkExp scope t1) (mkExp scope t2)+ EInt i -> C.ELit (C.LInt (fromIntegral i))+ EFloat f -> C.ELit (C.LFlt f)+ K s -> C.ELit (C.LStr s)+ Meta i -> C.EMeta i+ _ -> C.EMeta 0++mkPatt scope p = + case p of+ A.PP (_,c) ps->let (scope',ps') = mapAccumL mkPatt scope ps+ in (scope',C.PApp (i2i c) ps')+ A.PV x -> (x:scope,C.PVar (i2i x))+ A.PAs x p -> let (scope',p') = mkPatt scope p+ in (x:scope',C.PAs (i2i x) p')+ A.PW -> ( scope,C.PWild)+ A.PInt i -> ( scope,C.PLit (C.LInt (fromIntegral i)))+ A.PFloat f -> ( scope,C.PLit (C.LFlt f))+ A.PString s -> ( scope,C.PLit (C.LStr s))+ A.PImplArg p-> let (scope',p') = mkPatt scope p+ in (scope',C.PImplArg p')+ A.PTilde t -> ( scope,C.PTilde (mkExp scope t))++mkContext :: [Ident] -> A.Context -> ([Ident],[C.Hypo])+mkContext scope hyps = mapAccumL (\scope (bt,x,ty) -> let ty' = mkType scope ty+ in if x == identW+ then ( scope,(bt,i2i x,ty'))+ else (x:scope,(bt,i2i x,ty'))) scope hyps ++mkDef gr arity (Just eqs) = Just ([C.Equ ps' (mkExp scope' e) | L _ (ps,e) <- eqs, let (scope',ps') = mapAccumL mkPatt [] ps]+ ,generateByteCode gr arity eqs+ )+mkDef gr arity Nothing = Nothing++mkArity (Just a) _ ty = a -- known arity, i.e. defined function+mkArity Nothing (Just _) ty = 0 -- defined function with no arity - must be an axiom+mkArity Nothing _ ty = let (ctxt, _, _) = GM.typeForm ty -- constructor+ in length ctxt++genCncCats gr am cm cdefs =+ let (index,cats) = mkCncCats 0 cdefs+ in (index, Map.fromList cats)+ where+ mkCncCats index [] = (index,[])+ mkCncCats index (((m,id),CncCat (Just (L _ lincat)) _ _ _ _):cdefs) + | id == cInt = + let cc = pgfCncCat gr lincat fidInt+ (index',cats) = mkCncCats index cdefs+ in (index', (i2i id,cc) : cats)+ | id == cFloat = + let cc = pgfCncCat gr lincat fidFloat+ (index',cats) = mkCncCats index cdefs+ in (index', (i2i id,cc) : cats)+ | id == cString = + let cc = pgfCncCat gr lincat fidString+ (index',cats) = mkCncCats index cdefs+ in (index', (i2i id,cc) : cats)+ | otherwise =+ let cc@(C.CncCat _s e _) = pgfCncCat gr lincat index+ (index',cats) = mkCncCats (e+1) cdefs+ in (index', (i2i id,cc) : cats)+ mkCncCats index (_ :cdefs) = mkCncCats index cdefs++genCncFuns :: Grammar+ -> ModuleName+ -> ModuleName+ -> Array SeqId Sequence+ -> Array SeqId Sequence+ -> [(QIdent, Info)]+ -> FId+ -> Map.Map CId D.CncCat+ -> (FId,+ IntMap.IntMap (Set.Set D.Production),+ IntMap.IntMap [FunId],+ IntMap.IntMap [FunId],+ Array FunId D.CncFun)+genCncFuns gr am cm ex_seqs seqs cdefs fid_cnt cnccats =+ let (fid_cnt1,funs_cnt1,funs1,lindefs,linrefs) = mkCncCats cdefs fid_cnt 0 [] IntMap.empty IntMap.empty+ (fid_cnt2,funs_cnt2,funs2,prods) = mkCncFuns cdefs fid_cnt1 funs_cnt1 funs1 lindefs Map.empty IntMap.empty+ in (fid_cnt2,prods,lindefs,linrefs,array (0,funs_cnt2-1) funs2)+ where+ mkCncCats [] fid_cnt funs_cnt funs lindefs linrefs =+ (fid_cnt,funs_cnt,funs,lindefs,linrefs)+ mkCncCats (((m,id),CncCat _ _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs linrefs =+ let !funs_cnt' = let (s_funid, e_funid) = bounds funs0+ in funs_cnt+(e_funid-s_funid+1)+ lindefs' = foldl' (toLinDef (am,id) funs_cnt) lindefs prods0+ linrefs' = foldl' (toLinRef (am,id) funs_cnt) linrefs prods0+ funs' = foldl' (toCncFun funs_cnt (m,mkLinDefId id)) funs (assocs funs0)+ in mkCncCats cdefs fid_cnt funs_cnt' funs' lindefs' linrefs'+ mkCncCats (_ :cdefs) fid_cnt funs_cnt funs lindefs linrefs =+ mkCncCats cdefs fid_cnt funs_cnt funs lindefs linrefs++ mkCncFuns [] fid_cnt funs_cnt funs lindefs crc prods =+ (fid_cnt,funs_cnt,funs,prods)+ mkCncFuns (((m,id),CncFun _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs crc prods =+ let ---Ok ty_C = fmap GM.typeForm (Look.lookupFunType gr am id)+ ty_C = err error (\x -> x) $ fmap GM.typeForm (Look.lookupFunType gr am id)+ !funs_cnt' = let (s_funid, e_funid) = bounds funs0+ in funs_cnt+(e_funid-s_funid+1)+ !(fid_cnt',crc',prods') + = foldl' (toProd lindefs ty_C funs_cnt)+ (fid_cnt,crc,prods) prods0+ funs' = foldl' (toCncFun funs_cnt (m,id)) funs (assocs funs0)+ in mkCncFuns cdefs fid_cnt' funs_cnt' funs' lindefs crc' prods'+ mkCncFuns (_ :cdefs) fid_cnt funs_cnt funs lindefs crc prods = + mkCncFuns cdefs fid_cnt funs_cnt funs lindefs crc prods++ toProd lindefs (ctxt_C,res_C,_) offs st (Production fid0 funid0 args0) =+ let !((fid_cnt,crc,prods),args) = mapAccumL mkArg st (zip ctxt_C args0) + set0 = Set.fromList (map (C.PApply (offs+funid0)) (sequence args))+ fid = mkFId res_C fid0+ !prods' = case IntMap.lookup fid prods of+ Just set -> IntMap.insert fid (Set.union set0 set) prods+ Nothing -> IntMap.insert fid set0 prods+ in (fid_cnt,crc,prods')+ where+ mkArg st@(fid_cnt,crc,prods) ((_,_,ty),fid0s ) =+ case fid0s of+ [fid0] -> (st,map (flip C.PArg (mkFId arg_C fid0)) ctxt)+ fid0s -> case Map.lookup fids crc of+ Just fid -> (st,map (flip C.PArg fid) ctxt)+ Nothing -> let !crc' = Map.insert fids fid_cnt crc+ !prods' = IntMap.insert fid_cnt (Set.fromList (map C.PCoerce fids)) prods+ in ((fid_cnt+1,crc',prods'),map (flip C.PArg fid_cnt) ctxt)+ where+ (hargs_C,arg_C) = GM.catSkeleton ty+ ctxt = mapM (mkCtxt lindefs) hargs_C+ fids = map (mkFId arg_C) fid0s++ mkLinDefId id = prefixIdent "lindef " id++ toLinDef res offs lindefs (Production fid0 funid0 args) =+ if args == [[fidVar]]+ then IntMap.insertWith (++) fid [offs+funid0] lindefs+ else lindefs+ where+ fid = mkFId res fid0++ toLinRef res offs linrefs (Production fid0 funid0 [fargs]) =+ if fid0 == fidVar+ then foldr (\fid -> IntMap.insertWith (++) fid [offs+funid0]) linrefs fids+ else linrefs+ where+ fids = map (mkFId res) fargs++ mkFId (_,cat) fid0 =+ case Map.lookup (i2i cat) cnccats of+ Just (C.CncCat s e _) -> s+fid0+ Nothing -> error ("GrammarToPGF.mkFId: missing category "++showIdent cat)++ mkCtxt lindefs (_,cat) =+ case Map.lookup (i2i cat) cnccats of+ Just (C.CncCat s e _) -> [(C.fidVar,fid) | fid <- [s..e], Just _ <- [IntMap.lookup fid lindefs]]+ Nothing -> error "GrammarToPGF.mkCtxt failed"++ toCncFun offs (m,id) funs (funid0,lins0) =+ let mseqs = case lookupModule gr m of+ Ok (ModInfo{mseqs=Just mseqs}) -> mseqs+ _ -> ex_seqs+ in (offs+funid0,C.CncFun (i2i id) (amap (newIndex mseqs) lins0)):funs + where+ newIndex mseqs i = binSearch (mseqs ! i) seqs (bounds seqs)+ + binSearch v arr (i,j)+ | i <= j = case compare v (arr ! k) of+ LT -> binSearch v arr (i,k-1)+ EQ -> k+ GT -> binSearch v arr (k+1,j)+ | otherwise = error "binSearch"+ where+ k = (i+j) `div` 2++genPrintNames cdefs =+ Map.fromAscList [(i2i id, name) | ((m,id),info) <- cdefs, name <- prn info]+ where+ prn (CncFun _ _ (Just (L _ tr)) _) = [flatten tr]+ prn (CncCat _ _ _ (Just (L _ tr)) _) = [flatten tr]+ prn _ = []++ flatten (K s) = s+ flatten (Alts x _) = flatten x+ flatten (C x y) = flatten x +++ flatten y++--mkArray lst = listArray (0,length lst-1) lst+mkMapArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]+mkSetArray set = listArray (0,Set.size set-1) [v | v <- Set.toList set]
@@ -0,0 +1,143 @@+----------------------------------------------------------------------+-- |+-- Module : ModDeps+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.14 $+--+-- Check correctness of module dependencies. Incomplete.+--+-- AR 13\/5\/2003+-----------------------------------------------------------------------------++module GF.Compile.ModDeps (mkSourceGrammar,+ moduleDeps,+ openInterfaces,+ requiredCanModules+ ) where++import GF.Grammar.Grammar+import GF.Infra.Ident+import GF.Infra.Option+import GF.Grammar.Printer+import GF.Compile.Update+import GF.Grammar.Lookup+import GF.Infra.Modules++import GF.Data.Operations++import Control.Monad+import Data.List++-- | to check uniqueness of module names and import names, the+-- appropriateness of import and extend types,+-- to build a dependency graph of modules, and to sort them topologically+mkSourceGrammar :: [SourceModule] -> Err SourceGrammar+mkSourceGrammar ms = do+ let ns = map fst ms+ checkUniqueErr ns+ mapM (checkUniqueImportNames ns . snd) ms+ deps <- moduleDeps ms+ deplist <- either + return + (\ms -> Bad $ "circular modules" +++ unwords (map show ms)) $ + topoTest deps+ return $ MGrammar [(m, maybe undefined id $ lookup m ms) | IdentM m _ <- deplist]++checkUniqueErr :: (Show i, Eq i) => [i] -> Err ()+checkUniqueErr ms = do+ let msg = checkUnique ms+ if null msg then return () else Bad $ unlines msg++-- | check that import names don't clash with module names+checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err ()+checkUniqueImportNames ns mo = test [n | OQualif n v <- opens mo, n /= v]+ where+ test ms = testErr (all (`notElem` ns) ms)+ ("import names clashing with module names among" +++ unwords (map prt ms))++type Dependencies = [(IdentM Ident,[IdentM Ident])]++-- | to decide what modules immediately depend on what, and check if the+-- dependencies are appropriate+moduleDeps :: [SourceModule] -> Err Dependencies+moduleDeps ms = mapM deps ms where+ deps (c,m) = errIn ("checking dependencies of module" +++ prt c) $ case mtype m of+ MTConcrete a -> do+ am <- lookupModuleType gr a+ testErr (mtype am == MTAbstract) "the of-module is not an abstract syntax" + chDep (IdentM c (MTConcrete a)) + (extends m) (MTConcrete a) (opens m) MTResource+ t -> chDep (IdentM c t) (extends m) t (opens m) t++ chDep it es ety os oty = do+ ems <- mapM (lookupModuleType gr) es+ testErr (all (compatMType ety . mtype) ests) "inappropriate extension module type" + let ab = case it of+ IdentM _ (MTConcrete a) -> [IdentM a MTAbstract]+ _ -> [] ---- + return (it, ab +++ [IdentM e ety | e <- es] ++ + [IdentM (openedModule o) oty | o <- os])++ -- check for superficial compatibility, not submodule relation etc: what can be extended+ compatMType mt0 mt = case (mt0,mt) of+ (MTResource, MTConcrete _) -> True+ (MTInstance _, MTConcrete _) -> True+ (MTInterface, MTAbstract) -> True+ (MTConcrete _, MTConcrete _) -> True+ (MTInstance _, MTInstance _) -> True+ (MTInstance _, MTResource) -> True+ (MTResource, MTInstance _) -> True+ ---- some more?+ _ -> mt0 == mt+ -- in the same way; this defines what can be opened+ compatOType mt0 mt = case mt0 of+ MTAbstract -> mt == MTAbstract+ _ -> case mt of+ MTResource -> True+ MTInterface -> True+ MTInstance _ -> True+ _ -> False ++ gr = MGrammar ms --- hack++openInterfaces :: Dependencies -> Ident -> Err [Ident]+openInterfaces ds m = do+ let deps = [(i,ds) | (IdentM i _,ds) <- ds]+ let more (c,_) = [(i,mt) | Just is <- [lookup c deps], IdentM i mt <- is]+ let mods = iterFix (concatMap more) (more (m,undefined))+ return $ [i | (i,MTInterface) <- mods]++-- | this function finds out what modules are really needed in the canonical gr.+-- its argument is typically a concrete module name+requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i a -> i -> [i]+requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where+ exts = allExtends gr c+ ops = if isSingle + then map fst (modules gr)+ else iterFix (concatMap more) $ exts+ more i = errVal [] $ do+ m <- lookupModule gr i+ return $ extends m ++ [o | o <- map openedModule (opens m)]+ notReuse i = errVal True $ do+ m <- lookupModule gr i+ return $ isModRes m -- to exclude reused Cnc and Abs from required+++{-+-- to test+exampleDeps = [+ (ir "Nat",[ii "Gen", ir "Adj"]),+ (ir "Adj",[ii "Num", ii "Gen", ir "Nou"]),+ (ir "Nou",[ii "Cas"])+ ]++ii s = IdentM (IC s) MTInterface+ir s = IdentM (IC s) MTResource+-}+
@@ -0,0 +1,165 @@+module GF.Compile.Multi (readMulti) where++import Data.List+import Data.Char++-- AR 29 November 2010+-- quick way of writing a multilingual lexicon and (with some more work) a grammar+-- also several modules in one file+-- file suffix .gfm (GF Multi)+++{-+-- This multi-line comment is a possible file in the format.+-- comments are as in GF, one-liners++-- always start by declaring lang names as follows+> langs Eng Fin Swe++-- baseline rules: semicolon-separated line-by-line entries update abs and cncs, adding to S+cheers ; skål ; terveydeksi++-- alternatives within a language are comma-separated+cheers ; skål ; terveydeksi, kippis++-- more advanced: verbatim abstract rules prefixed by "> abs"+> abs cat Drink ;+> abs fun drink : Drink -> S ;++-- verbatim concrete rules prefixed by ">" and comma-separated language list+> Eng,Swe lin Gin = "gin" ; ++-- multiple modules: modules as usual. Each module has to start from a new line.+-- Should be UTF-8 encoded.++-}++{-+main = do+ xx <- getArgs+ if null xx then putStrLn usage else do + let (opts,file) = (init xx, last xx)+ (absn,cncns) <- readMulti opts file+ if elem "-pgf" xx + then do+ system ("gf -make -s -optimize-pgf " ++ unwords (map gfFile cncns))+ putStrLn $ "wrote " ++ absn ++ ".pgf"+ else return ()+-}++readMulti :: FilePath -> IO (FilePath,[FilePath])+readMulti file = do+ src <- readFile file+ let multi = getMulti (takeWhile (/='.') file) src+ absn = absName multi+ cncns = cncNames multi+ raws = rawModules multi+ writeFile (gfFile absn) (absCode multi)+ mapM_ (uncurry writeFile) + [(gfFile cncn, cncCode absn cncn cod) | + cncn <- cncNames multi, let cod = [r | (la,r) <- cncRules multi, la == cncn]]+ putStrLn $ "wrote " ++ unwords (map gfFile (absn:cncns))+ mapM_ (uncurry writeFile) [(gfFile n,s) | (n,s) <- raws] --- overwrites those above+ return (gfFile absn, map gfFile cncns)++data Multi = Multi {+ rawModules :: [(String,String)],+ absName :: String,+ cncNames :: [String],+ startCat :: String,+ absRules :: [String],+ cncRules :: [(String,String)] -- lang,lin+ }++emptyMulti :: Multi +emptyMulti = Multi {+ rawModules = [],+ absName = "Abs",+ cncNames = [],+ startCat = "S",+ absRules = [],+ cncRules = []+ }++absCode :: Multi -> String+absCode multi = unlines $ header : start ++ (reverse (absRules multi)) ++ ["}"] where+ header = "abstract " ++ absName multi ++ " = {"+ start = ["flags startcat = " ++ cat ++ " ;", "cat " ++ cat ++ " ;"]+ cat = startCat multi++cncCode :: String -> String -> [String] -> String+cncCode ab cnc rules = unlines $ header : (reverse rules ++ ["}"]) where+ header = "concrete " ++ cnc ++ " of " ++ ab ++ " = {"++getMulti :: String -> String -> Multi+getMulti m s = foldl (flip addMulti) (emptyMulti{absName = m}) (modlines (lines s))++addMulti :: String -> Multi -> Multi+addMulti line multi = case line of+ '-':'-':_ -> multi+ _ | all isSpace line -> multi+ '>':s -> case words s of+ "langs":ws -> let las = [absName multi ++ w | w <- ws] in multi {+ cncNames = las, + cncRules = concat [[(la,"lincat " ++ startCat multi ++ " = Str ;"),+ (la,"flags coding = utf8 ;")] | la <- las]+ }+ "startcat":c:ws -> multi {startCat = c}+ "abs":ws -> multi {+ absRules = unwords ws : absRules multi+ }+ langs:ws -> multi {+ cncRules = [(absName multi ++ la, unwords ws) | la <- chop ',' langs] ++ cncRules multi+ }+ _ -> case words line of+ m:name:_ | isModule m -> multi {+ rawModules = (name,line):rawModules multi+ } + _ -> let (cat,fun,lins) = getRules (startCat multi) line in + multi {+ absRules = ("fun " ++ fun ++ " : " ++ cat ++ " ;") : absRules multi,+ cncRules = zip (cncNames multi) lins ++ cncRules multi+ }++getRules :: String -> String -> (String,String,[String])+getRules cat line = (cat, fun, map lin rss) where+ rss = map (map unspace . chop ',') $ chop ';' line+ fun = map idChar (head (head rss)) ++ "_" ++ cat+ lin rs = "lin " ++ fun ++ " = " ++ unwords (intersperse "|" (map quote rs)) ++ " ;"++chop :: Eq c => c -> [c] -> [[c]]+chop c cs = case break (==c) cs of+ (w,_:cs2) -> w : chop c cs2+ ([],[]) -> []+ (w,_) -> [w]++-- remove spaces from beginning and end, leave them in the middle+unspace :: String -> String+unspace = unwords . words++quote :: String -> String+quote r = "\"" ++ r ++ "\""++-- to guarantee that the char can be used in an ident+idChar :: Char -> Char+idChar c = + if (n > 47 && n < 58) || (n > 64 && n < 91) || (n > 96 && n < 123) + then c+ else '_'+ where n = fromEnum c+++gfFile :: FilePath -> FilePath+gfFile f = f ++ ".gf"++isModule :: String -> Bool+isModule = flip elem + ["abstract","concrete","incomplete","instance","interface","resource"]++modlines :: [String] -> [String]+modlines ss = case ss of+ l:ls -> case words l of+ w:_ | isModule w -> case break (isModule . concat . take 1 . words) ls of+ (ms,rest) -> unlines (l:ms) : modlines rest+ _ -> l : modlines ls+ _ -> []
@@ -0,0 +1,239 @@+{-# LANGUAGE PatternGuards #-}+----------------------------------------------------------------------+-- |+-- Module : Optimize+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/09/16 13:56:13 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.18 $+--+-- Top-level partial evaluation for GF source modules.+-----------------------------------------------------------------------------++module GF.Compile.Optimize (optimizeModule) where++import GF.Grammar.Grammar+import GF.Infra.Ident+import GF.Grammar.Printer+import GF.Grammar.Macros+import GF.Grammar.Lookup+import GF.Grammar.Predef+--import GF.Compile.Refresh+--import GF.Compile.Compute.Concrete+import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues)+--import GF.Compile.CheckGrammar+--import GF.Compile.Update++import GF.Data.Operations+--import GF.Infra.CheckM+import GF.Infra.Option++import Control.Monad+--import Data.List+import qualified Data.Set as Set+import GF.Text.Pretty+import Debug.Trace+++-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.++optimizeModule :: Options -> SourceGrammar -> SourceModule -> Err SourceModule+optimizeModule opts sgr m@(name,mi)+ | mstatus mi == MSComplete = do+ ids <- topoSortJments m+ mi <- foldM updateEvalInfo mi ids+ return (name,mi)+ | otherwise = return m+ where+ oopts = opts `addOptions` mflags mi++ resenv = resourceValues oopts sgr++ updateEvalInfo mi (i,info) = do+ info <- evalInfo oopts resenv sgr (name,mi) i info+ return (mi{jments=updateTree (i,info) (jments mi)})++evalInfo :: Options -> GlobalEnv -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info+evalInfo opts resenv sgr m c info = do++ (if verbAtLeast opts Verbose then trace (" " ++ showIdent c) else id) return ()++ errIn ("optimizing " ++ showIdent c) $ case info of++ CncCat ptyp pde pre ppr mpmcfg -> do+ pde' <- case (ptyp,pde) of+ (Just (L _ typ), Just (L loc de)) -> do+ de <- partEval opts gr ([(Explicit, varStr, typeStr)], typ) de+ return (Just (L loc (factor param c 0 de)))+ (Just (L loc typ), Nothing) -> do+ de <- mkLinDefault gr typ+ de <- partEval opts gr ([(Explicit, varStr, typeStr)], typ) de+ return (Just (L loc (factor param c 0 de)))+ _ -> return pde -- indirection++ pre' <- case (ptyp,pre) of+ (Just (L _ typ), Just (L loc re)) -> do+ re <- partEval opts gr ([(Explicit, varStr, typ)], typeStr) re+ return (Just (L loc (factor param c 0 re)))+ (Just (L loc typ), Nothing) -> do+ re <- mkLinReference gr typ+ re <- partEval opts gr ([(Explicit, varStr, typ)], typeStr) re+ return (Just (L loc (factor param c 0 re)))+ _ -> return pre -- indirection++ let ppr' = fmap (evalPrintname resenv c) ppr++ return (CncCat ptyp pde' pre' ppr' mpmcfg)++ CncFun (mt@(Just (_,cont,val))) pde ppr mpmcfg -> --trace (prt c) $+ eIn ("linearization in type" <+> mkProd cont val [] $$ "of function") $ do+ pde' <- case pde of+ Just (L loc de) -> do de <- partEval opts gr (cont,val) de+ return (Just (L loc (factor param c 0 de)))+ Nothing -> return pde+ let ppr' = fmap (evalPrintname resenv c) ppr+ return $ CncFun mt pde' ppr' mpmcfg -- only cat in type actually needed+{-+ ResOper pty pde + | not new && OptExpand `Set.member` optim -> do+ pde' <- case pde of+ Just (L loc de) -> do de <- computeConcrete gr de+ return (Just (L loc (factor param c 0 de)))+ Nothing -> return Nothing+ return $ ResOper pty pde'+-}+ _ -> return info+ where+-- new = flag optNewComp opts -- computations moved to GF.Compile.GeneratePMCFG++ gr = prependModule sgr m+ optim = flag optOptimizations opts+ param = OptParametrize `Set.member` optim+ eIn cat = errIn (render ("Error optimizing" <+> cat <+> c <+> ':'))++-- | the main function for compiling linearizations+partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term+partEval opts = {-if flag optNewComp opts+ then-} partEvalNew opts+ {-else partEvalOld opts-}++partEvalNew opts gr (context, val) trm =+ errIn (render ("partial evaluation" <+> ppTerm Qualified 0 trm)) $+ checkPredefError trm+{-+partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $ do+ let vars = map (\(bt,x,t) -> x) context+ args = map Vr vars+ subst = [(v, Vr v) | v <- vars]+ trm1 = mkApp trm args+ trm2 <- computeTerm gr subst trm1+ trm3 <- if rightType trm2+ then computeTerm gr subst trm2 -- compute twice??+ else recordExpand val trm2 >>= computeTerm gr subst+ trm4 <- checkPredefError trm3+ return $ mkAbs [(Explicit,v) | v <- vars] trm4+ where+ -- don't eta expand records of right length (correct by type checking)+ rightType (R rs) = case val of+ RecType ts -> length rs == length ts+ _ -> False+ rightType _ = False+++-- here we must be careful not to reduce+-- variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}}+-- {s = variants {"Auto" ; "Wagen"} ; g = variants {N ; M}} ;++recordExpand :: Type -> Term -> Err Term+recordExpand typ trm = case typ of+ RecType tys -> case trm of+ FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs]+ _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys]+ _ -> return trm++-}+-- | auxiliaries for compiling the resource++mkLinDefault :: SourceGrammar -> Type -> Err Term+mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ+ where+ mkDefField typ = case typ of+ Table p t -> do+ t' <- mkDefField t+ let T _ cs = mkWildCases t'+ return $ T (TWild p) cs+ Sort s | s == cStr -> return $ Vr varStr+ QC p -> do vs <- lookupParamValues gr p+ case vs of+ v:_ -> return v+ _ -> Bad (render ("no parameter values given to type" <+> ppQIdent Qualified p))+ RecType r -> do+ let (ls,ts) = unzip r+ ts <- mapM mkDefField ts+ return $ R (zipWith assign ls ts)+ _ | Just _ <- isTypeInts typ -> return $ EInt 0 -- exists in all as first val+ _ -> Bad (render ("linearization type field cannot be" <+> typ))++mkLinReference :: SourceGrammar -> Type -> Err Term+mkLinReference gr typ = + liftM (Abs Explicit varStr) $ + case mkDefField typ (Vr varStr) of+ Bad "no string" -> return Empty+ x -> x+ where+ mkDefField ty trm = + case ty of+ Table pty ty -> do ps <- allParamValues gr pty+ case ps of+ [] -> Bad "no string"+ (p:ps) -> mkDefField ty (S trm p)+ Sort s | s == cStr -> return trm+ QC p -> Bad "no string"+ RecType [] -> Bad "no string"+ RecType rs -> do+ msum (map (\(l,ty) -> mkDefField ty (P trm l)) (sortRec rs))+ `mplus` Bad "no string"+ _ | Just _ <- isTypeInts typ -> Bad "no string"+ _ -> Bad (render ("linearization type field cannot be" <+> typ))++evalPrintname :: GlobalEnv -> Ident -> L Term -> L Term+evalPrintname resenv c (L loc pr) = L loc (normalForm resenv (L loc c) pr)++-- do even more: factor parametric branches++factor :: Bool -> Ident -> Int -> Term -> Term+factor param c i t =+ case t of+ T (TComp ty) cs -> factors ty [(p, factor param c (i+1) v) | (p, v) <- cs]+ _ -> composSafeOp (factor param c i) t+ where+ factors ty pvs0 + | not param = V ty (map snd pvs0)+ factors ty [] = V ty []+ factors ty pvs0@[(p,v)] = V ty [v]+ factors ty pvs0@(pv:pvs) =+ let t = mkFun pv+ ts = map mkFun pvs+ in if all (==t) ts+ then T (TTyped ty) (mkCases t)+ else V ty (map snd pvs0)++ --- we hope this will be fresh and don't check... in GFC would be safe+ qvar = identS ("q_" ++ showIdent c ++ "__" ++ show i)++ mkFun (patt, val) = replace (patt2term patt) (Vr qvar) val+ mkCases t = [(PV qvar, t)]++-- we need to replace subterms+replace :: Term -> Term -> Term -> Term+replace old new trm =+ case trm of+ -- these are the important cases, since they can correspond to patterns + QC _ | trm == old -> new+ App _ _ | trm == old -> new+ R _ | trm == old -> new+ App x y -> App (replace old new x) (replace old new y)+ _ -> composSafeOp (replace old new) trm
@@ -0,0 +1,332 @@+----------------------------------------------------------------------+-- |+-- Module : PGFtoHaskell+-- Maintainer : Aarne Ranta+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/06/17 12:39:07 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.8 $+--+-- to write a GF abstract grammar into a Haskell module with translations from+-- data objects into GF trees. Example: GSyntax for Agda.+-- AR 11/11/1999 -- 7/12/2000 -- 18/5/2004+-----------------------------------------------------------------------------++module GF.Compile.PGFtoHaskell (grammar2haskell) where++import PGF(showCId)+import PGF.Internal++import GF.Data.Operations+import GF.Infra.Option++import Data.List --(isPrefixOf, find, intersperse)+import qualified Data.Map as Map++type Prefix = String -> String++-- | the main function+grammar2haskell :: Options+ -> String -- ^ Module name.+ -> PGF+ -> String+grammar2haskell opts name gr = foldr (++++) [] $ + pragmas ++ haskPreamble gadt name ++ [types, gfinstances gId lexical gr'] ++ compos+ where gr' = hSkeleton gr+ gadt = haskellOption opts HaskellGADT+ lexical cat = haskellOption opts HaskellLexical && isLexicalCat opts cat+ gId | haskellOption opts HaskellNoPrefix = id+ | otherwise = ("G"++)+ pragmas | gadt = ["{-# OPTIONS_GHC -fglasgow-exts #-}","{-# LANGUAGE GADTs #-}"]+ | otherwise = []+ types | gadt = datatypesGADT gId lexical gr'+ | otherwise = datatypes gId lexical gr'+ compos | gadt = prCompos gId lexical gr' ++ composClass+ | otherwise = []++haskPreamble gadt name =+ [+ "module " ++ name ++ " where",+ ""+ ] +++ (if gadt then [+ "import Control.Monad.Identity",+ "import Data.Monoid"+ ] else []) +++ [+ "import PGF hiding (Tree)",+ "----------------------------------------------------",+ "-- automatic translation from GF to Haskell",+ "----------------------------------------------------",+ "", + "class Gf a where",+ " gf :: a -> Expr",+ " fg :: Expr -> a",+ "",+ predefInst gadt "GString" "String" "unStr" "mkStr",+ "",+ predefInst gadt "GInt" "Int" "unInt" "mkInt",+ "",+ predefInst gadt "GFloat" "Double" "unFloat" "mkFloat",+ "",+ "----------------------------------------------------",+ "-- below this line machine-generated",+ "----------------------------------------------------",+ ""+ ]++predefInst gadt gtyp typ destr consr = + (if gadt+ then [] + else ("newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show\n\n") + ) + +++ "instance Gf" +++ gtyp +++ "where" +++++ " gf (" ++ gtyp +++ "x) =" +++ consr +++ "x" +++++ " fg t =" +++++ " case "++destr++" t of" +++++ " Just x -> " +++ gtyp +++ "x" +++++ " Nothing -> error (\"no" +++ gtyp +++ "\" ++ show t)"++type OIdent = String++type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]++datatypes :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String+datatypes gId lexical = (foldr (+++++) "") . (filter (/="")) . (map (hDatatype gId lexical)) . snd++gfinstances :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String+gfinstances gId lexical (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (gfInstance gId lexical m)) g+++hDatatype :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> String+hDatatype _ _ ("Cn",_) = "" ---+hDatatype gId _ (cat,[]) = "data" +++ gId cat+hDatatype gId _ (cat,rules) | isListCat (cat,rules) = + "newtype" +++ gId cat +++ "=" +++ gId cat +++ "[" ++ gId (elemCat cat) ++ "]" + +++ "deriving Show"+hDatatype gId lexical (cat,rules) =+ "data" +++ gId cat +++ "=" +++ (if length rules == 1 then "" else "\n ") ++++ foldr1 (\x y -> x ++ "\n |" +++ y) constructors +++++ " deriving Show"+ where+ constructors = [gId f +++ foldr (+++) "" (map (gId) xx) | (f,xx) <- nonLexicalRules (lexical cat) rules]+ ++ if lexical cat then [lexicalConstructor cat +++ "String"] else []++nonLexicalRules :: Bool -> [(OIdent, [OIdent])] -> [(OIdent, [OIdent])]+nonLexicalRules False rules = rules+nonLexicalRules True rules = [r | r@(f,t) <- rules, not (null t)]++lexicalConstructor :: OIdent -> String+lexicalConstructor cat = "Lex" ++ cat++predefTypeSkel = [(c,[]) | c <- ["String", "Int", "Float"]]++-- GADT version of data types+datatypesGADT :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String+datatypesGADT gId lexical (_,skel) = unlines $ + concatMap (hCatTypeGADT gId) (skel ++ predefTypeSkel) +++ [ + "", + "data Tree :: * -> * where"+ ] ++ + concatMap (map (" "++) . hDatatypeGADT gId lexical) skel +++ [+ " GString :: String -> Tree GString_",+ " GInt :: Int -> Tree GInt_",+ " GFloat :: Double -> Tree GFloat_",+ "",+ "instance Eq (Tree a) where",+ " i == j = case (i,j) of"+ ] +++ concatMap (map (" "++) . hEqGADT gId lexical) skel +++ [+ " (GString x, GString y) -> x == y",+ " (GInt x, GInt y) -> x == y",+ " (GFloat x, GFloat y) -> x == y",+ " _ -> False"+ ]++hCatTypeGADT :: Prefix -> (OIdent, [(OIdent, [OIdent])]) -> [String]+hCatTypeGADT gId (cat,rules)+ = ["type"+++gId cat+++"="+++"Tree"+++gId cat++"_",+ "data"+++gId cat++"_"]++hDatatypeGADT :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> [String]+hDatatypeGADT gId lexical (cat, rules) + | isListCat (cat,rules) = [gId cat+++"::"+++"["++gId (elemCat cat)++"]" +++ "->" +++ t]+ | otherwise =+ [ gId f +++ "::" +++ concatMap (\a -> gId a +++ "-> ") args ++ t + | (f,args) <- nonLexicalRules (lexical cat) rules ]+ ++ if lexical cat then [lexicalConstructor cat +++ ":: String ->"+++ t] else []+ where t = "Tree" +++ gId cat ++ "_"++hEqGADT :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> [String]+hEqGADT gId lexical (cat, rules)+ | isListCat (cat,rules) = let r = listr cat in ["(" ++ patt "x" r ++ "," ++ patt "y" r ++ ") -> " ++ listeqs] + | otherwise = ["(" ++ patt "x" r ++ "," ++ patt "y" r ++ ") -> " ++ eqs r | r <- nonLexicalRules (lexical cat) rules]+ ++ if lexical cat then ["(" ++ lexicalConstructor cat +++ "x" ++ "," ++ lexicalConstructor cat +++ "y" ++ ") -> x == y"] else []++ where+ patt s (f,xs) = unwords (gId f : mkSVars s (length xs))+ eqs (_,xs) = unwords ("and" : "[" : intersperse "," [x ++ " == " ++ y | + (x,y) <- zip (mkSVars "x" (length xs)) (mkSVars "y" (length xs)) ] ++ ["]"])+ listr c = (c,["foo"]) -- foo just for length = 1+ listeqs = "and [x == y | (x,y) <- zip x1 y1]"++prCompos :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> [String]+prCompos gId lexical (_,catrules) =+ ["instance Compos Tree where",+ " compos r a f t = case t of"]+ ++ + [" " ++ prComposCons (gId f) xs | (c,rs) <- catrules, not (isListCat (c,rs)),+ (f,xs) <- rs, not (null xs)] + ++ + [" " ++ prComposCons (gId c) ["x1"] | (c,rs) <- catrules, isListCat (c,rs)]+ ++ + [" _ -> r t"]+ where+ prComposCons f xs = let vs = mkVars (length xs) in + f +++ unwords vs +++ "->" +++ rhs f (zip vs xs)+ rhs f vcs = "r" +++ f +++ unwords (map (prRec f) vcs)+ prRec f (v,c) + | isList f = "`a` foldr (a . a (r (:)) . f) (r [])" +++ v+ | otherwise = "`a`" +++ "f" +++ v+ isList f = (gId "List") `isPrefixOf` f++gfInstance :: Prefix -> (OIdent -> Bool) -> String -> (OIdent, [(OIdent, [OIdent])]) -> String+gfInstance gId lexical m crs = hInstance gId lexical m crs ++++ fInstance gId lexical m crs++----hInstance m ("Cn",_) = "" --- seems to belong to an old applic. AR 18/5/2004+hInstance gId _ m (cat,[]) = unlines [+ "instance Show" +++ gId cat,+ "",+ "instance Gf" +++ gId cat +++ "where",+ " gf _ = undefined",+ " fg _ = undefined"+ ]+hInstance gId lexical m (cat,rules) + | isListCat (cat,rules) =+ "instance Gf" +++ gId cat +++ "where" +++++ " gf (" ++ gId cat +++ "[" ++ concat (intersperse "," baseVars) ++ "])" + +++ "=" +++ mkRHS ("Base"++ec) baseVars +++++ " gf (" ++ gId cat +++ "(x:xs)) = " + ++ mkRHS ("Cons"++ec) ["x",prParenth (gId cat+++"xs")] +-- no show for GADTs+-- ++++ " gf (" ++ gId cat +++ "xs) = error (\"Bad " ++ cat ++ " value: \" ++ show xs)" + | otherwise =+ "instance Gf" +++ gId cat +++ "where\n" +++ unlines ([mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules]+ ++ if lexical cat then [" gf (" ++ lexicalConstructor cat +++ "x) = mkApp (mkCId x) []"] else [])+ where+ ec = elemCat cat+ baseVars = mkVars (baseSize (cat,rules))+ mkInst f xx = let xx' = mkVars (length xx) in " gf " +++ (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) ++++ "=" +++ mkRHS f xx'+ mkRHS f vars = "mkApp (mkCId \"" ++ f ++ "\")" +++ + "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"++mkVars = mkSVars "x"+mkSVars s n = [s ++ show i | i <- [1..n]]++----fInstance m ("Cn",_) = "" ---+fInstance _ _ m (cat,[]) = ""+fInstance gId lexical m (cat,rules) =+ " fg t =" +++++ (if isList + then " " ++ gId cat ++ " (fgs t) where\n fgs t = case unApp t of"+ else " case unApp t of") +++++ unlines [mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules] +++++ (if lexical cat then " Just (i,[]) -> " ++ lexicalConstructor cat +++ "(showCId i)" else "") +++++ " _ -> error (\"no" +++ cat ++ " \" ++ show t)"+ where+ isList = isListCat (cat,rules)+ mkInst f xx =+ " Just (i," +++ "[" ++ prTList "," xx' ++ "])" ++++ "| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx'+ where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]+ mkRHS f vars + | isList =+ if "Base" `isPrefixOf` f + then "[" ++ prTList ", " [ "fg" +++ x | x <- vars ] ++ "]"+ else "fg" +++ (vars !! 0) +++ ":" +++ "fgs" +++ (vars !! 1)+ | otherwise = + gId f +++ + prTList " " [prParenth ("fg" +++ x) | x <- vars]++--type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]+hSkeleton :: PGF -> (String,HSkeleton)+hSkeleton gr = + (showCId (absname gr), + let fs = + [(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) | + fs@((_, (_,c)):_) <- fns]+ in fs ++ [(sc, []) | c <- cts, let sc = showCId c, notElem sc (["Int", "Float", "String"] ++ map fst fs)]+ )+ where+ cts = Map.keys (cats (abstract gr)) + fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr)))))+ valtyps (_, (_,x)) (_, (_,y)) = compare x y+ valtypg (_, (_,x)) (_, (_,y)) = x == y+ jty (f,(ty,_,_,_)) = (f,catSkeleton ty)+{-+updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton+updateSkeleton cat skel rule =+ case skel of+ (cat0,rules):rr | cat0 == cat -> (cat0, rule:rules) : rr+ (cat0,rules):rr -> (cat0, rules) : updateSkeleton cat rr rule+-}+isListCat :: (OIdent, [(OIdent, [OIdent])]) -> Bool+isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2+ && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs+ where c = elemCat cat+ fs = map fst rules++-- | Gets the element category of a list category.+elemCat :: OIdent -> OIdent+elemCat = drop 4+{-+isBaseFun :: OIdent -> Bool+isBaseFun f = "Base" `isPrefixOf` f++isConsFun :: OIdent -> Bool+isConsFun f = "Cons" `isPrefixOf` f+-}+baseSize :: (OIdent, [(OIdent, [OIdent])]) -> Int+baseSize (_,rules) = length bs+ where Just (_,bs) = find (("Base" `isPrefixOf`) . fst) rules++composClass :: [String]+composClass = + [+ "",+ "class Compos t where",+ " compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)",+ " -> (forall a. t a -> m (t a)) -> t c -> m (t c)",+ "",+ "composOp :: Compos t => (forall a. t a -> t a) -> t c -> t c",+ "composOp f = runIdentity . composOpM (Identity . f)",+ "",+ "composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t c -> m (t c)",+ "composOpM = compos return ap",+ "",+ "composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t c -> m ()",+ "composOpM_ = composOpFold (return ()) (>>)",+ "",+ "composOpMonoid :: (Compos t, Monoid m) => (forall a. t a -> m) -> t c -> m",+ "composOpMonoid = composOpFold mempty mappend",+ "",+ "composOpMPlus :: (Compos t, MonadPlus m) => (forall a. t a -> m b) -> t c -> m b",+ "composOpMPlus = composOpFold mzero mplus",+ "",+ "composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b",+ "composOpFold z c f = unC . compos (\\_ -> C z) (\\(C x) (C y) -> C (c x y)) (C . f)",+ "",+ "newtype C b a = C { unC :: b }"+ ]+
@@ -0,0 +1,105 @@+module GF.Compile.PGFtoJS (pgf2js) where++import PGF(showCId)+import PGF.Internal as M+import qualified GF.JavaScript.AbsJS as JS+import qualified GF.JavaScript.PrintJS as JS++--import GF.Data.ErrM+--import GF.Infra.Option++--import Control.Monad (mplus)+--import Data.Array.Unboxed (UArray)+import qualified Data.Array.IArray as Array+--import Data.Maybe (fromMaybe)+import Data.Map (Map)+import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap++pgf2js :: PGF -> String+pgf2js pgf =+ JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]+ where+ n = showCId $ absname pgf+ as = abstract pgf+ cs = Map.assocs (concretes pgf)+ start = showCId $ M.lookStartCat pgf+ grammar = new "GFGrammar" [js_abstract, js_concrete]+ js_abstract = abstract2js start as+ js_concrete = JS.EObj $ map concrete2js cs++abstract2js :: String -> Abstr -> JS.Expr+abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]++absdef2js :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> JS.Property+absdef2js (f,(typ,_,_,_)) =+ let (args,cat) = M.catSkeleton typ in + JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])++lit2js (LStr s) = JS.EStr s+lit2js (LInt n) = JS.EInt n+lit2js (LFlt d) = JS.EDbl d++concrete2js :: (CId,Concr) -> JS.Property+concrete2js (c,cnc) =+ JS.Prop l (new "GFConcrete" [mapToJSObj (lit2js) $ cflags cnc,+ JS.EObj $ [JS.Prop (JS.IntPropName cat) (JS.EArray (map frule2js (Set.toList set))) | (cat,set) <- IntMap.toList (productions cnc)],+ JS.EArray $ (map ffun2js (Array.elems (cncfuns cnc))),+ JS.EArray $ (map seq2js (Array.elems (sequences cnc))),+ JS.EObj $ map cats (Map.assocs (cnccats cnc)),+ JS.EInt (totalCats cnc)])+ where + l = JS.IdentPropName (JS.Ident (showCId c))+{-+ litslins = [JS.Prop (JS.StringPropName "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), + JS.Prop (JS.StringPropName "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),+ JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])]+-}+ cats (c,CncCat start end _) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EObj [JS.Prop (JS.IdentPropName (JS.Ident "s")) (JS.EInt start)+ ,JS.Prop (JS.IdentPropName (JS.Ident "e")) (JS.EInt end)])+{-+mkStr :: String -> JS.Expr+mkStr s = new "Str" [JS.EStr s]++mkSeq :: [JS.Expr] -> JS.Expr+mkSeq [x] = x+mkSeq xs = new "Seq" xs++argIdent :: Integer -> JS.Ident+argIdent n = JS.Ident ("x" ++ show n)+-}+children :: JS.Ident+children = JS.Ident "cs"++frule2js :: Production -> JS.Expr+frule2js (PApply funid args) = new "Apply" [JS.EInt funid, JS.EArray (map farg2js args)]+frule2js (PCoerce arg) = new "Coerce" [JS.EInt arg]++farg2js (PArg hypos fid) = new "PArg" (map (JS.EInt . snd) hypos ++ [JS.EInt fid])++ffun2js (CncFun f lins) = new "CncFun" [JS.EStr (showCId f), JS.EArray (map JS.EInt (Array.elems lins))]++seq2js :: Array.Array DotPos Symbol -> JS.Expr+seq2js seq = JS.EArray [sym2js s | s <- Array.elems seq]++sym2js :: Symbol -> JS.Expr+sym2js (SymCat n l) = new "SymCat" [JS.EInt n, JS.EInt l]+sym2js (SymLit n l) = new "SymLit" [JS.EInt n, JS.EInt l]+sym2js (SymVar n l) = new "SymVar" [JS.EInt n, JS.EInt l]+sym2js (SymKS t) = new "SymKS" [JS.EStr t]+sym2js (SymKP ts alts) = new "SymKP" [JS.EArray (map sym2js ts), JS.EArray (map alt2js alts)]+sym2js SymBIND = new "SymKS" [JS.EStr "&+"]+sym2js SymSOFT_BIND = new "SymKS" [JS.EStr "&+"]+sym2js SymSOFT_SPACE = new "SymKS" [JS.EStr "&+"]+sym2js SymCAPIT = new "SymKS" [JS.EStr "&|"]+sym2js SymALL_CAPIT = new "SymKS" [JS.EStr "&|"]+sym2js SymNE = new "SymNE" []++alt2js (ps,ts) = new "Alt" [JS.EArray (map sym2js ps), JS.EArray (map JS.EStr ts)]++new :: String -> [JS.Expr] -> JS.Expr+new f xs = JS.ENew (JS.Ident f) xs++mapToJSObj :: (a -> JS.Expr) -> Map CId a -> JS.Expr+mapToJSObj f m = JS.EObj [ JS.Prop (JS.IdentPropName (JS.Ident (showCId k))) (f v) | (k,v) <- Map.toList m ]
@@ -0,0 +1,44 @@+module GF.Compile.PGFtoJava (grammar2java) where++import PGF+import Data.Maybe(maybe)+import Data.List(intercalate)+import GF.Infra.Option++-- | the main function+grammar2java :: Options+ -> String -- ^ Module name.+ -> PGF+ -> String+grammar2java opts name gr = unlines $ + javaPreamble name ++ methods ++ javaEnding+ where+ methods = [javaMethod gr fun | fun <- functions gr]++javaPreamble name =+ [+ "import org.grammaticalframework.pgf.*;",+ "",+ "public class " ++ name ++ " {",+ ""+ ]+ +javaMethod gr fun =+ " public static Expr "++name++"("++arg_decls++") { return new Expr("++show name++args++"); }"+ where+ name = showCId fun+ arity = maybe 0 getArrity (functionType gr fun)+ vars = ['e':show i | i <- [1..arity]]+ + arg_decls = intercalate "," ["Expr "++v | v <- vars]+ args = if null vars then ",new Expr[] {}" else ","++intercalate "," vars++ getArrity ty = length hypos+ where+ (hypos,_,_) = unType ty++javaEnding =+ [+ "",+ "}"+ ]
@@ -0,0 +1,262 @@+----------------------------------------------------------------------+-- |+-- Module : PGFtoProlog+-- Maintainer : Peter Ljunglöf+--+-- exports a GF grammar into a Prolog module+-----------------------------------------------------------------------------++module GF.Compile.PGFtoProlog (grammar2prolog) where++import PGF(mkCId,wildCId,showCId)+import PGF.Internal+--import PGF.Macros++import GF.Data.Operations++import qualified Data.Array.IArray as Array+import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import Data.Char (isAlphaNum, isAscii, isAsciiLower, isAsciiUpper, ord)+import Data.List (isPrefixOf, mapAccumL)++grammar2prolog :: PGF -> String+grammar2prolog pgf+ = ("%% This file was automatically generated by GF" ++++++ ":- style_check(-singleton)." ++++++ plFacts wildCId "abstract" 1 "(?AbstractName)"+ [[plp name]] +++++ plFacts wildCId "concrete" 2 "(?AbstractName, ?ConcreteName)" + [[plp name, plp cncname] | + cncname <- Map.keys (concretes pgf)] +++++ plFacts wildCId "flag" 2 "(?Flag, ?Value): global flags" + [[plp f, plp v] | + (f, v) <- Map.assocs (gflags pgf)] +++++ plAbstract name (abstract pgf) +++++ unlines (map plConcrete (Map.assocs (concretes pgf)))+ )+ where name = absname pgf++----------------------------------------------------------------------+-- abstract syntax++plAbstract :: CId -> Abstr -> String+plAbstract name abs + = (plHeader "Abstract syntax" +++++ plFacts name "flag" 2 "(?Flag, ?Value): flags for abstract syntax"+ [[plp f, plp v] | + (f, v) <- Map.assocs (aflags abs)] +++++ plFacts name "cat" 2 "(?Type, ?[X:Type,...])"+ [[plType cat args, plHypos hypos'] |+ (cat, (hypos,_,_)) <- Map.assocs (cats abs),+ let ((_, subst), hypos') = mapAccumL alphaConvertHypo emptyEnv hypos,+ let args = reverse [EFun x | (_,x) <- subst]] +++++ plFacts name "fun" 3 "(?Fun, ?Type, ?[X:Type,...])"+ [[plp fun, plType cat args, plHypos hypos] |+ (fun, (typ, _, _, _)) <- Map.assocs (funs abs),+ let (_, DTyp hypos cat args) = alphaConvert emptyEnv typ] +++++ plFacts name "def" 2 "(?Fun, ?Expr)" + [[plp fun, plp expr] |+ (fun, (_, _, Just (eqs,_), _)) <- Map.assocs (funs abs),+ let (_, expr) = alphaConvert emptyEnv eqs]+ )+ where plType cat args = plTerm (plp cat) (map plp args)+ plHypos hypos = plList [plOper ":" (plp x) (plp ty) | (_, x, ty) <- hypos]++----------------------------------------------------------------------+-- concrete syntax++plConcrete :: (CId, Concr) -> String+plConcrete (name, cnc) + = (plHeader ("Concrete syntax: " ++ plp name) +++++ plFacts name "flag" 2 "(?Flag, ?Value): flags for concrete syntax"+ [[plp f, plp v] | + (f, v) <- Map.assocs (cflags cnc)] +++++ plFacts name "printname" 2 "(?AbsFun/AbsCat, ?Atom)"+ [[plp f, plp n] | + (f, n) <- Map.assocs (printnames cnc)] +++++ plFacts name "lindef" 2 "(?CncCat, ?CncFun)"+ [[plCat cat, plFun fun] | + (cat, funs) <- IntMap.assocs (lindefs cnc),+ fun <- funs] +++++ plFacts name "prod" 3 "(?CncCat, ?CncFun, ?[CncCat])"+ [[plCat cat, fun, plTerm "c" (map plCat args)] |+ (cat, set) <- IntMap.toList (productions cnc),+ (fun, args) <- map plProduction (Set.toList set)] +++++ plFacts name "cncfun" 3 "(?CncFun, ?[Seq,...], ?AbsFun)"+ [[plFun fun, plTerm "s" (map plSeq (Array.elems lins)), plp absfun] |+ (fun, CncFun absfun lins) <- Array.assocs (cncfuns cnc)] +++++ plFacts name "seq" 2 "(?Seq, ?[Term])"+ [[plSeq seq, plp (Array.elems symbols)] |+ (seq, symbols) <- Array.assocs (sequences cnc)] +++++ plFacts name "cnccat" 2 "(?AbsCat, ?[CnCCat])" + [[plp cat, plList (map plCat [start..end])] |+ (cat, CncCat start end _) <- Map.assocs (cnccats cnc)]+ )+ where plProduction (PCoerce arg) = ("-", [arg])+ plProduction (PApply funid args) = (plFun funid, [fid | PArg hypos fid <- args])++----------------------------------------------------------------------+-- prolog-printing pgf datatypes++instance PLPrint Type where+ plp (DTyp hypos cat args) + | null hypos = result+ | otherwise = plOper " -> " plHypos result+ where result = plTerm (plp cat) (map plp args)+ plHypos = plList [plOper ":" (plp x) (plp ty) | (_,x,ty) <- hypos]++instance PLPrint Expr where+ plp (EFun x) = plp x+ plp (EAbs _ x e)= plOper "^" (plp x) (plp e)+ plp (EApp e e') = plOper " * " (plp e) (plp e')+ plp (ELit lit) = plp lit+ plp (EMeta n) = "Meta_" ++ show n++instance PLPrint Patt where+ plp (PVar x) = plp x+ plp (PApp f ps) = plOper " * " (plp f) (plp ps)+ plp (PLit lit) = plp lit++instance PLPrint Equation where+ plp (Equ patterns result) = plOper ":" (plp patterns) (plp result)++instance PLPrint CId where+ plp cid | isLogicalVariable str || cid == wildCId = plVar str+ | otherwise = plAtom str+ where str = showCId cid++instance PLPrint Literal where+ plp (LStr s) = plp s+ plp (LInt n) = plp (show n)+ plp (LFlt f) = plp (show f)++instance PLPrint Symbol where+ plp (SymCat n l) = plOper ":" (show n) (show l)+ plp (SymLit n l) = plTerm "lit" [show n, show l]+ plp (SymVar n l) = plTerm "var" [show n, show l]+ plp (SymKS t) = plAtom t+ plp (SymKP ts alts) = plTerm "pre" [plList (map plp ts), plList (map plAlt alts)]+ where plAlt (ps,ts) = plOper "/" (plList (map plp ps)) (plList (map plAtom ts))++class PLPrint a where+ plp :: a -> String+ plps :: [a] -> String+ plps = plList . map plp++instance PLPrint Char where+ plp c = plAtom [c]+ plps s = plAtom s++instance PLPrint a => PLPrint [a] where+ plp = plps++----------------------------------------------------------------------+-- other prolog-printing functions++plCat :: Int -> String+plCat n = plAtom ('c' : show n)++plFun :: Int -> String+plFun n = plAtom ('f' : show n)++plSeq :: Int -> String+plSeq n = plAtom ('s' : show n)++plHeader :: String -> String+plHeader hdr = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n%% " ++ hdr ++ "\n"++plFacts :: CId -> String -> Int -> String -> [[String]] -> String+plFacts mod pred arity comment facts = "%% " ++ pred ++ comment ++++ clauses+ where clauses = (if facts == [] then ":- dynamic " ++ pred ++ "/" ++ show arity ++ ".\n"+ else unlines [mod' ++ plTerm pred args ++ "." | args <- facts])+ mod' = if mod == wildCId then "" else plp mod ++ ": "++plTerm :: String -> [String] -> String+plTerm fun args = plAtom fun ++ prParenth (prTList ", " args)++plList :: [String] -> String+plList xs = prBracket (prTList "," xs)++plOper :: String -> String -> String -> String+plOper op a b = prParenth (a ++ op ++ b)++plVar :: String -> String+plVar = varPrefix . concatMap changeNonAlphaNum + where varPrefix var@(c:_) | isAsciiUpper c || c=='_' = var+ | otherwise = "_" ++ var+ changeNonAlphaNum c | isAlphaNumUnderscore c = [c]+ | otherwise = "_" ++ show (ord c) ++ "_"++plAtom :: String -> String+plAtom "" = "''"+plAtom atom@(c:cs) | isAsciiLower c && all isAlphaNumUnderscore cs + || c == '\'' && cs /= "" && last cs == '\'' = atom+ | otherwise = "'" ++ changeQuote atom ++ "'"+ where changeQuote ('\'':cs) = '\\' : '\'' : changeQuote cs+ changeQuote ('\\':cs) = '\\' : '\\' : changeQuote cs+ changeQuote (c:cs) = c : changeQuote cs+ changeQuote "" = ""++isAlphaNumUnderscore :: Char -> Bool+isAlphaNumUnderscore c = (isAscii c && isAlphaNum c) || c == '_'++----------------------------------------------------------------------+-- prolog variables ++createLogicalVariable :: Int -> CId+createLogicalVariable n = mkCId (logicalVariablePrefix ++ show n)++isLogicalVariable :: String -> Bool+isLogicalVariable = isPrefixOf logicalVariablePrefix ++logicalVariablePrefix :: String +logicalVariablePrefix = "X"++----------------------------------------------------------------------+-- alpha convert variables to (unique) logical variables+-- * this is needed if we want to translate variables to Prolog variables+-- * used for abstract syntax, not concrete+-- * not (yet?) used for variables bound in pattern equations++type ConvertEnv = (Int, [(CId,CId)])++emptyEnv :: ConvertEnv+emptyEnv = (0, [])++class AlphaConvert a where+ alphaConvert :: ConvertEnv -> a -> (ConvertEnv, a)++instance AlphaConvert a => AlphaConvert [a] where+ alphaConvert env [] = (env, [])+ alphaConvert env (a:as) = (env'', a':as')+ where (env', a') = alphaConvert env a+ (env'', as') = alphaConvert env' as++instance AlphaConvert Type where+ alphaConvert env@(_,subst) (DTyp hypos cat args) + = ((ctr,subst), DTyp hypos' cat args')+ where (env', hypos') = mapAccumL alphaConvertHypo env hypos+ ((ctr,_), args') = alphaConvert env' args++alphaConvertHypo env (b,x,typ) = ((ctr+1,(x,x'):subst), (b,x',typ'))+ where ((ctr,subst), typ') = alphaConvert env typ+ x' = createLogicalVariable ctr++instance AlphaConvert Expr where+ alphaConvert (ctr,subst) (EAbs b x e) = ((ctr',subst), EAbs b x' e')+ where ((ctr',_), e') = alphaConvert (ctr+1,(x,x'):subst) e+ x' = createLogicalVariable ctr+ alphaConvert env (EApp e1 e2) = (env'', EApp e1' e2')+ where (env', e1') = alphaConvert env e1+ (env'', e2') = alphaConvert env' e2+ alphaConvert env expr@(EFun i) = (env, maybe expr EFun (lookup i (snd env)))+ alphaConvert env expr = (env, expr)++-- pattern variables are not alpha converted+-- (but they probably should be...)+instance AlphaConvert Equation where+ alphaConvert env@(_,subst) (Equ patterns result)+ = ((ctr,subst), Equ patterns result')+ where ((ctr,_), result') = alphaConvert env result
@@ -0,0 +1,122 @@+----------------------------------------------------------------------+-- |+-- Module : PGFtoPython+-- Maintainer : Peter Ljunglöf+--+-- exports a GF grammar into a Python module+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+module GF.Compile.PGFtoPython (pgf2python) where++import PGF(showCId)+import PGF.Internal as M++import GF.Data.Operations++import qualified Data.Array.IArray as Array+import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+--import Data.List (intersperse)++pgf2python :: PGF -> String+pgf2python pgf = ("# -*- coding: utf-8 -*-" +++++ "# This file was automatically generated by GF" ++++++ showCId name +++ "=" +++ + pyDict 1 pyStr id [+ ("flags", pyDict 2 pyCId pyLiteral (Map.assocs (gflags pgf))),+ ("abstract", pyDict 2 pyStr id [+ ("name", pyCId name), + ("start", pyCId start), + ("flags", pyDict 3 pyCId pyLiteral (Map.assocs (aflags abs))),+ ("funs", pyDict 3 pyCId pyAbsdef (Map.assocs (funs abs)))+ ]),+ ("concretes", pyDict 2 pyCId pyConcrete (Map.assocs cncs))+ ] ++ "\n")+ where+ name = absname pgf+ start = M.lookStartCat pgf+ abs = abstract pgf+ cncs = concretes pgf++pyAbsdef :: (Type, Int, Maybe ([Equation], [[M.Instr]]), Double) -> String+pyAbsdef (typ, _, _, _) = pyTuple 0 id [pyCId cat, pyList 0 pyCId args]+ where (args, cat) = M.catSkeleton typ ++pyLiteral :: Literal -> String+pyLiteral (LStr s) = pyStr s+pyLiteral (LInt n) = show n+pyLiteral (LFlt d) = show d++pyConcrete :: Concr -> String+pyConcrete cnc = pyDict 3 pyStr id [+ ("flags", pyDict 0 pyCId pyLiteral (Map.assocs (cflags cnc))),+ ("printnames", pyDict 4 pyCId pyStr (Map.assocs (printnames cnc))),+ ("lindefs", pyDict 4 pyCat (pyList 0 pyFun) (IntMap.assocs (lindefs cnc))),+ ("productions", pyDict 4 pyCat pyProds (IntMap.assocs (productions cnc))),+ ("cncfuns", pyDict 4 pyFun pyCncFun (Array.assocs (cncfuns cnc))),+ ("sequences", pyDict 4 pySeq pySymbols (Array.assocs (sequences cnc))),+ ("cnccats", pyDict 4 pyCId pyCncCat (Map.assocs (cnccats cnc))),+ ("size", show (totalCats cnc))+ ]+ where pyProds prods = pyList 5 pyProduction (Set.toList prods)+ pyCncCat (CncCat start end _) = pyList 0 pyCat [start..end]+ pyCncFun (CncFun f lins) = pyTuple 0 id [pyList 0 pySeq (Array.elems lins), pyCId f]+ pySymbols syms = pyList 0 pySymbol (Array.elems syms)++pyProduction :: Production -> String+pyProduction (PCoerce arg) = pyTuple 0 id [pyStr "", pyList 0 pyCat [arg]]+pyProduction (PApply funid args) = pyTuple 0 id [pyFun funid, pyList 0 pyPArg args]+ where pyPArg (PArg [] fid) = pyCat fid+ pyPArg (PArg hypos fid) = pyTuple 0 pyCat (fid : map snd hypos)++pySymbol :: Symbol -> String+pySymbol (SymCat n l) = pyTuple 0 show [n, l]+pySymbol (SymLit n l) = pyDict 0 pyStr id [("lit", pyTuple 0 show [n, l])]+pySymbol (SymVar n l) = pyDict 0 pyStr id [("var", pyTuple 0 show [n, l])]+pySymbol (SymKS t) = pyStr t+pySymbol (SymKP ts alts) = pyDict 0 pyStr id [("pre", pyList 0 pySymbol ts), ("alts", pyList 0 alt2py alts)]+ where alt2py (ps,ts) = pyTuple 0 (pyList 0 pyStr) [map pySymbol ps, ts]+pySymbol SymBIND = pyStr "&+"+pySymbol SymSOFT_BIND = pyStr "&+"+pySymbol SymSOFT_SPACE = pyStr "&+"+pySymbol SymCAPIT = pyStr "&|"+pySymbol SymALL_CAPIT = pyStr "&|"+pySymbol SymNE = pyDict 0 pyStr id [("nonExist", pyTuple 0 id [])]++----------------------------------------------------------------------+-- python helpers ++pyDict :: Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String+pyDict n pk pv [] = "{}"+pyDict n pk pv kvlist = prCurly (pyIndent n ++ prTList ("," ++ pyIndent n) (map pyKV kvlist) ++ pyIndent n)+ where pyKV (k, v) = pk k ++ ":" ++ pv v++pyList :: Int -> (v -> String) -> [v] -> String+pyList n pv [] = "[]"+pyList n pv xs = prBracket (pyIndent n ++ prTList ("," ++ pyIndent n) (map pv xs) ++ pyIndent n)++pyTuple :: Int -> (v -> String) -> [v] -> String+pyTuple n pv [] = "()"+pyTuple n pv [x] = prParenth (pyIndent n ++ pv x ++ "," ++ pyIndent n)+pyTuple n pv xs = prParenth (pyIndent n ++ prTList ("," ++ pyIndent n) (map pv xs) ++ pyIndent n)++pyCat :: Int -> String+pyCat n = pyStr ('C' : show n)++pyFun :: Int -> String+pyFun n = pyStr ('F' : show n)++pySeq :: Int -> String+pySeq n = pyStr ('S' : show n)++pyStr :: String -> String+pyStr s = 'u' : prQuotedString s++pyCId :: CId -> String+pyCId = pyStr . showCId++pyIndent :: Int -> String+pyIndent n | n > 0 = "\n" ++ replicate n ' '+ | otherwise = ""
@@ -0,0 +1,277 @@+----------------------------------------------------------------------+-- |+-- Module : ReadFiles+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.26 $+--+-- Decide what files to read as function of dependencies and time stamps.+--+-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004+--+-- to find all files that have to be read, put them in dependency order, and+-- decide which files need recompilation. Name @file.gf@ is returned for them,+-- and @file.gfo@ otherwise.+-----------------------------------------------------------------------------++module GF.Compile.ReadFiles+ ( getAllFiles,ModName,ModEnv,importsOfModule,+ findFile,gfImports,gfoImports,VersionTagged(..),+ parseSource,getOptionsFromFile,getPragmas) where++import Prelude hiding (catch)+import GF.System.Catch+import GF.Infra.UseIO+import GF.Infra.Option+import GF.Infra.Ident+import GF.Data.Operations+import GF.Grammar.Lexer+import GF.Grammar.Parser+import GF.Grammar.Grammar+import GF.Grammar.Binary(VersionTagged(..),decodeModuleHeader)++import System.IO(mkTextEncoding)+import GF.Text.Coding(decodeUnicodeIO)++import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.ByteString.Char8 as BS++import Control.Monad+import Data.Maybe(isJust)+import Data.Char(isSpace)+import qualified Data.Map as Map+import Data.Time(UTCTime)+import GF.System.Directory(getModificationTime,doesFileExist,canonicalizePath)+import System.FilePath+import GF.Text.Pretty++type ModName = String+type ModEnv = Map.Map ModName (UTCTime,[ModName])+++-- | Returns a list of all files to be compiled in topological order i.e.+-- the low level (leaf) modules are first.+--getAllFiles :: (MonadIO m,ErrorMonad m) => Options -> [InitPath] -> ModEnv -> FileName -> m [FullPath]+getAllFiles opts ps env file = do+ -- read module headers from all files recursively+ ds <- reverse `fmap` get [] [] (justModuleName file)+ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_,_) <- ds]+ return $ paths ds+ where+ -- construct list of paths to read+ paths ds = concatMap mkFile ds+ where+ mkFile (f,st,time,has_src,imps,p) =+ case st of + CSComp -> [p </> gfFile f]+ CSRead | has_src -> [gf2gfo opts (p </> gfFile f)]+ | otherwise -> [p </> gfoFile f]+ CSEnv -> []++ -- | traverses the dependency graph and returns a topologicaly sorted+ -- list of ModuleInfo. An error is raised if there is circular dependency+ {- get :: [ModName] -- ^ keeps the current path in the dependency graph to avoid cycles+ -> [ModuleInfo] -- ^ a list of already traversed modules+ -> ModName -- ^ the current module+ -> IOE [ModuleInfo] -- ^ the final -}+ get trc ds name+ | name `elem` trc = raise $ "circular modules" +++ unwords trc+ | (not . null) [n | (n,_,_,_,_,_) <- ds, name == n] --- file already read+ = return ds+ | otherwise = do+ (name,st0,t0,has_src,imps,p) <- findModule name+ ds <- foldM (get (name:trc)) ds imps+ let (st,t) | has_src &&+ flag optRecomp opts == RecompIfNewer &&+ (not . null) [f | (f,st,t1,_,_,_) <- ds, elem f imps && liftM2 (>=) t0 t1 /= Just True]+ = (CSComp,Nothing)+ | otherwise = (st0,t0)+ return ((name,st,t,has_src,imps,p):ds)++ gfoDir = flag optGFODir opts++ -- searches for module in the search path and if it is found+ -- returns 'ModuleInfo'. It fails if there is no such module+ --findModule :: ModName -> IOE ModuleInfo+ findModule name = do+ (file,gfTime,gfoTime) <- findFile gfoDir ps name++ let mb_envmod = Map.lookup name env+ (st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime++ (st,(mname,imps)) <-+ case st of+ CSEnv -> return (st, (name, maybe [] snd mb_envmod))+ CSRead -> do let gfo = if isGFO file then file else gf2gfo opts file+ t_imps <- gfoImports gfo+ case t_imps of+ Tagged imps -> return (st,imps)+ WrongVersion+ | isGFO file -> raise (file ++ " is compiled with different GF version and I can't find the source file")+ | otherwise -> do imps <- gfImports opts file+ return (CSComp,imps)+ CSComp -> do imps <- gfImports opts file+ return (st,imps)+ testErr (mname == name)+ ("module name" +++ mname +++ "differs from file name" +++ name)+ return (name,st,t,isJust gfTime,imps,dropFileName file)+--------------------------------------------------------------------------------++findFile gfoDir ps name =+ maybe noSource haveSource =<< getFilePath ps (gfFile name)+ where+ haveSource gfFile =+ do gfTime <- getModificationTime gfFile+ mb_gfoTime <- maybeIO $ getModificationTime (gf2gfo' gfoDir gfFile)+ return (gfFile, Just gfTime, mb_gfoTime)++ noSource =+ maybe noGFO haveGFO =<< getFilePath gfoPath (gfoFile name)+ where+ gfoPath = maybe id (:) gfoDir ps++ haveGFO gfoFile =+ do gfoTime <- getModificationTime gfoFile+ return (gfoFile, Nothing, Just gfoTime)++ noGFO = raise (render ("File" <+> gfFile name <+> "does not exist." $$+ "searched in:" <+> vcat ps))++gfImports opts file = importsOfModule `fmap` parseModHeader opts file++gfoImports gfo = fmap importsOfModule `fmap` decodeModuleHeader gfo++--------------------------------------------------------------------------------++-- From the given Options and the time stamps computes+-- whether the module have to be computed, read from .gfo or+-- the environment version have to be used+selectFormat :: Options -> Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime -> (CompStatus,Maybe UTCTime)+selectFormat opts mtenv mtgf mtgfo =+ case (mtenv,mtgfo,mtgf) of+ (_,_,Just tgf) | fromSrc -> (CSComp,Nothing)+ (Just tenv,_,_) | fromComp -> (CSEnv, Just tenv)+ (_,Just tgfo,_) | fromComp -> (CSRead,Just tgfo)+ (Just tenv,_,Just tgf) | tenv > tgf -> (CSEnv, Just tenv)+ (_,Just tgfo,Just tgf) | tgfo > tgf -> (CSRead,Just tgfo)+ (Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist+ (_,Just tgfo,Nothing) -> (CSRead,Just tgfo) -- source does not exist+ _ -> (CSComp,Nothing)+ where+ fromComp = flag optRecomp opts == NeverRecomp+ fromSrc = flag optRecomp opts == AlwaysRecomp+++-- internal module dep information+++data CompStatus =+ CSComp -- compile: read gf+ | CSRead -- read gfo+ | CSEnv -- gfo is in env+ deriving Eq++type ModuleInfo = (ModName,CompStatus,Maybe UTCTime,Bool,[ModName],InitPath)++importsOfModule :: SourceModule -> (ModName,[ModName])+importsOfModule (m,mi) = (modName m,depModInfo mi [])+ where+ depModInfo mi =+ depModType (mtype mi) .+ depExtends (mextend mi) .+ depWith (mwith mi) .+ depExDeps (mexdeps mi).+ depOpens (mopens mi)++ depModType (MTAbstract) xs = xs+ depModType (MTResource) xs = xs+ depModType (MTInterface) xs = xs+ depModType (MTConcrete m2) xs = modName m2:xs+ depModType (MTInstance (m2,_)) xs = modName m2:xs++ depExtends es xs = foldr depInclude xs es++ depWith (Just (m,_,is)) xs = modName m : depInsts is xs+ depWith Nothing xs = xs++ depExDeps eds xs = map modName eds ++ xs++ depOpens os xs = foldr depOpen xs os++ depInsts is xs = foldr depInst xs is++ depInclude (m,_) xs = modName m:xs++ depOpen (OSimple n ) xs = modName n:xs+ depOpen (OQualif _ n) xs = modName n:xs++ depInst (m,n) xs = modName m:modName n:xs++ modName (MN m) = showIdent m+++parseModHeader opts file =+ do --ePutStrLn file+ (_,parsed) <- parseSource opts pModHeader =<< liftIO (BS.readFile file)+ case parsed of+ Right mo -> return mo+ Left (Pn l c,msg) ->+ raise (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg)++parseSource opts p raw =+ do (coding,utf8) <- toUTF8 opts raw+ return (coding,runP p utf8)++toUTF8 opts0 raw =+ do opts <- getPragmas raw+ let given = flag optEncoding opts -- explicitly given encoding+ coding = getEncoding $ opts0 `addOptions` opts+ utf8 <- if coding=="UTF-8"+ then return raw+ else if coding=="CP1252" -- Latin1+ then return . UTF8.fromString $ BS.unpack raw -- faster+ else do --ePutStrLn $ "toUTF8 from "++coding+ recodeToUTF8 coding raw+ return (given,utf8)++recodeToUTF8 coding raw =+ liftIO $+ do enc <- mkTextEncoding coding+ -- decodeUnicodeIO uses a lot of stack space,+ -- so we need to split the file into smaller pieces+ ls <- mapM (decodeUnicodeIO enc) (BS.lines raw)+ return $ UTF8.fromString (unlines ls)++-- | options can be passed to the compiler by comments in @--#@, in the main file+--getOptionsFromFile :: (MonadIO m,ErrorMonad m) => FilePath -> m Options+getOptionsFromFile file = do+ opts <- either failed getPragmas =<< (liftIO $ try $ BS.readFile file)+ -- The coding flag should not be inherited by other files+ return (addOptions opts (modifyFlags $ \ f -> f{optEncoding=Nothing}))+ where+ failed _ = raise $ "File " ++ file ++ " does not exist"+++getPragmas :: (ErrorMonad m) => BS.ByteString -> m Options+getPragmas = parseModuleOptions . + map (BS.unpack . BS.unwords . BS.words . BS.drop 3) .+ filter (BS.isPrefixOf (BS.pack "--#")) .+-- takeWhile (BS.isPrefixOf (BS.pack "--")) .+-- filter (not . BS.null) .+ map (BS.dropWhile isSpace) .+ BS.lines++getFilePath :: MonadIO m => [FilePath] -> String -> m (Maybe FilePath)+getFilePath paths file = get paths+ where+ get [] = return Nothing+ get (p:ps) = do let pfile = p </> file+ exist <- doesFileExist pfile+ if not exist+ then get ps+ else do pfile <- canonicalizePath pfile+ return (Just pfile)
@@ -0,0 +1,333 @@+----------------------------------------------------------------------+-- |+-- Module : Rename+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/05/30 18:39:44 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.19 $+--+-- AR 14\/5\/2003+-- The top-level function 'renameGrammar' does several things:+--+-- - extends each module symbol table by indirections to extended module+--+-- - changes unqualified and as-qualified imports to absolutely qualified+--+-- - goes through the definitions and resolves names+--+-- Dependency analysis between modules has been performed before this pass.+-- Hence we can proceed by @fold@ing "from left to right".+-----------------------------------------------------------------------------++module GF.Compile.Rename (+ renameSourceTerm,+ renameModule+ ) where++import GF.Grammar.Grammar+import GF.Grammar.Values+import GF.Grammar.Predef+import GF.Infra.Ident+import GF.Infra.CheckM+import GF.Grammar.Macros+import GF.Grammar.Printer+--import GF.Grammar.Lookup+--import GF.Grammar.Printer+import GF.Data.Operations++import Control.Monad+import Data.List (nub,(\\))+import GF.Text.Pretty++-- | this gives top-level access to renaming term input in the cc command+renameSourceTerm :: Grammar -> ModuleName -> Term -> Check Term+renameSourceTerm g m t = do+ mi <- lookupModule g m+ status <- buildStatus "" g (m,mi)+ renameTerm status [] t++renameModule :: FilePath -> Grammar -> Module -> Check Module+renameModule cwd gr mo@(m,mi) = do+ status <- buildStatus cwd gr mo+ js <- checkMapRecover (renameInfo cwd status mo) (jments mi)+ return (m, mi{jments = js})++type Status = (StatusTree, [(OpenSpec, StatusTree)])++type StatusTree = BinTree Ident StatusInfo++type StatusInfo = Ident -> Term++-- Delays errors, allowing many errors to be detected and reported+renameIdentTerm env = accumulateError (renameIdentTerm' env)++-- Fails immediately on error, makes it possible to try other possibilities+renameIdentTerm' :: Status -> Term -> Check Term+renameIdentTerm' env@(act,imps) t0 = + case t0 of+ Vr c -> ident predefAbs c+ Cn c -> ident (\_ s -> checkError s) c+ Q (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0+ Q (m',c) -> do+ m <- lookupErr m' qualifs+ f <- lookupTree showIdent c m+ return $ f c+ QC (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0+ QC (m',c) -> do+ m <- lookupErr m' qualifs+ f <- lookupTree showIdent c m+ return $ f c+ _ -> return t0+ where+ opens = [st | (OSimple _,st) <- imps]+ qualifs = [(m, st) | (OQualif m _, st) <- imps] ++ + [(m, st) | (OQualif _ m, st) <- imps] ++ + [(m, st) | (OSimple m, st) <- imps] -- qualif is always possible++ -- this facility is mainly for BWC with GF1: you need not import PredefAbs+ predefAbs c s+ | isPredefCat c = return (Q (cPredefAbs,c))+ | otherwise = checkError s++ ident alt c = + case lookupTree showIdent c act of+ Ok f -> return (f c)+ _ -> case lookupTreeManyAll showIdent opens c of+ [f] -> return (f c)+ [] -> alt c ("constant not found:" <+> c $$+ "given" <+> fsep (punctuate ',' (map fst qualifs)))+ fs -> case nub [f c | f <- fs] of+ [tr] -> return tr+{-+ ts -> return $ AdHocOverload ts + -- name conflicts resolved as overloading in TypeCheck.RConcrete AR 31/1/2014+ -- the old definition is below and still presupposed in TypeCheck.Concrete+-}+ ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$+ "conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$+ "given" <+> fsep (punctuate ',' (map fst qualifs)))+ return t++ -- a warning will be generated in CheckGrammar, and the head returned+ -- in next V: + -- Bad $ "conflicting imports:" +++ unwords (map prt ts) ++info2status :: Maybe ModuleName -> (Ident,Info) -> StatusInfo+info2status mq (c,i) = case i of+ AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq+ ResValue _ -> maybe Con (curry QC) mq+ ResParam _ _ -> maybe Con (curry QC) mq+ AnyInd True m -> maybe Con (const (curry QC m)) mq+ AnyInd False m -> maybe Cn (const (curry Q m)) mq+ _ -> maybe Cn (curry Q) mq++tree2status :: OpenSpec -> BinTree Ident Info -> BinTree Ident StatusInfo+tree2status o = case o of+ OSimple i -> mapTree (info2status (Just i))+ OQualif i j -> mapTree (info2status (Just j))++buildStatus :: FilePath -> Grammar -> Module -> Check Status+buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do+ let gr1 = prependModule gr mo+ exts = [(OSimple m,mi) | (m,mi) <- allExtends gr1 m]+ ops <- mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)+ let sts = map modInfo2status (exts++ops)+ return (if isModCnc mi+ then (emptyBinTree, reverse sts) -- the module itself does not define any names+ else (self2status m mi,reverse sts)) -- so the empty ident is not needed++modInfo2status :: (OpenSpec,ModuleInfo) -> (OpenSpec, StatusTree)+modInfo2status (o,mo) = (o,tree2status o (jments mo))++self2status :: ModuleName -> ModuleInfo -> StatusTree+self2status c m = mapTree (info2status (Just c)) (jments m)++ +renameInfo :: FilePath -> Status -> Module -> Ident -> Info -> Check Info+renameInfo cwd status (m,mi) i info =+ case info of+ AbsCat pco -> liftM AbsCat (renPerh (renameContext status) pco)+ AbsFun pty pa ptr poper -> liftM4 AbsFun (renTerm pty) (return pa) (renMaybe (mapM (renLoc (renEquation status))) ptr) (return poper)+ ResOper pty ptr -> liftM2 ResOper (renTerm pty) (renTerm ptr)+ ResOverload os tysts -> liftM (ResOverload os) (mapM (renPair (renameTerm status [])) tysts)+ ResParam (Just pp) m -> do+ pp' <- renLoc (mapM (renParam status)) pp+ return (ResParam (Just pp') m)+ ResValue t -> do+ t <- renLoc (renameTerm status []) t+ return (ResValue t)+ CncCat mcat mdef mref mpr mpmcfg -> liftM5 CncCat (renTerm mcat) (renTerm mdef) (renTerm mref) (renTerm mpr) (return mpmcfg)+ CncFun mty mtr mpr mpmcfg -> liftM3 (CncFun mty) (renTerm mtr) (renTerm mpr) (return mpmcfg)+ _ -> return info+ where+ renTerm = renPerh (renameTerm status [])++ renPerh ren = renMaybe (renLoc ren)++ renMaybe ren (Just x) = ren x >>= return . Just+ renMaybe ren Nothing = return Nothing++ renLoc ren (L loc x) =+ checkInModule cwd mi loc ("Happened in the renaming of" <+> i) $ do+ x <- ren x+ return (L loc x)++ renPair ren (x, y) = do x <- renLoc ren x+ y <- renLoc ren y+ return (x, y)++ renEquation :: Status -> Equation -> Check Equation+ renEquation b (ps,t) = do+ (ps',vs) <- liftM unzip $ mapM (renamePattern b) ps+ t' <- renameTerm b (concat vs) t+ return (ps',t')++ renParam :: Status -> Param -> Check Param+ renParam env (c,co) = do+ co' <- renameContext env co+ return (c,co')++renameTerm :: Status -> [Ident] -> Term -> Check Term+renameTerm env vars = ren vars where+ ren vs trm = case trm of+ Abs b x t -> liftM (Abs b x) (ren (x:vs) t)+ Prod bt x a b -> liftM2 (Prod bt x) (ren vs a) (ren (x:vs) b)+ Typed a b -> liftM2 Typed (ren vs a) (ren vs b)+ Vr x + | elem x vs -> return trm+ | otherwise -> renid trm+ Cn _ -> renid trm+ Con _ -> renid trm+ Q _ -> renid trm+ QC _ -> renid trm+ T i cs -> do+ i' <- case i of+ TTyped ty -> liftM TTyped $ ren vs ty -- the only annotation in source+ _ -> return i+ liftM (T i') $ mapM (renCase vs) cs ++ Let (x,(m,a)) b -> do+ m' <- case m of+ Just ty -> liftM Just $ ren vs ty+ _ -> return m+ a' <- ren vs a+ b' <- ren (x:vs) b+ return $ Let (x,(m',a')) b'++ P t@(Vr r) l -- Here we have $r.l$ and this is ambiguous it could be either + -- record projection from variable or constant $r$ or qualified expression with module $r$+ | elem r vs -> return trm -- try var proj first ..+ | otherwise -> checks [ renid' (Q (MN r,label2ident l)) -- .. and qualified expression second.+ , renid' t >>= \t -> return (P t l) -- try as a constant at the end+ , checkError ("unknown qualified constant" <+> trm)+ ]++ EPatt p -> do+ (p',_) <- renpatt p+ return $ EPatt p'++ _ -> composOp (ren vs) trm++ renid = renameIdentTerm env+ renid' = renameIdentTerm' env+ renCase vs (p,t) = do+ (p',vs') <- renpatt p+ t' <- ren (vs' ++ vs) t+ return (p',t')+ renpatt = renamePattern env++-- | vars not needed in env, since patterns always overshadow old vars+renamePattern :: Status -> Patt -> Check (Patt,[Ident])+renamePattern env patt =+ do r@(p',vs) <- renp patt+ let dupl = vs \\ nub vs+ unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear:") 4+ patt)+ return r+ where+ renp patt = case patt of+ PMacro c -> do+ c' <- renid $ Vr c+ case c' of+ Q d -> renp $ PM d+ _ -> checkError ("unresolved pattern" <+> patt)++ PC c ps -> do+ c' <- renid $ Cn c+ case c' of+ QC c -> do psvss <- mapM renp ps+ let (ps,vs) = unzip psvss+ return (PP c ps, concat vs)+ Q _ -> checkError ("data constructor expected but" <+> ppTerm Qualified 0 c' <+> "is found instead")+ _ -> checkError ("unresolved data constructor" <+> ppTerm Qualified 0 c')++ PP c ps -> do+ (QC c') <- renid (QC c)+ psvss <- mapM renp ps+ let (ps',vs) = unzip psvss+ return (PP c' ps', concat vs)++ PM c -> do+ x <- renid (Q c)+ c' <- case x of+ (Q c') -> return c'+ _ -> checkError ("not a pattern macro" <+> ppPatt Qualified 0 patt)+ return (PM c', [])++ PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of+ QC c -> return (PP c [],[])+ _ -> checkError (pp "not a constructor")+ , return (patt, [x])+ ]++ PR r -> do+ let (ls,ps) = unzip r+ psvss <- mapM renp ps+ let (ps',vs') = unzip psvss+ return (PR (zip ls ps'), concat vs')++ PAlt p q -> do+ (p',vs) <- renp p+ (q',ws) <- renp q+ return (PAlt p' q', vs ++ ws)++ PSeq p q -> do+ (p',vs) <- renp p+ (q',ws) <- renp q+ return (PSeq p' q', vs ++ ws)++ PRep p -> do+ (p',vs) <- renp p+ return (PRep p', vs)++ PNeg p -> do+ (p',vs) <- renp p+ return (PNeg p', vs)++ PAs x p -> do+ (p',vs) <- renp p+ return (PAs x p', x:vs)++ _ -> return (patt,[])++ renid = renameIdentTerm env+ renid' = renameIdentTerm' env++renameContext :: Status -> Context -> Check Context+renameContext b = renc [] where+ renc vs cont = case cont of+ (bt,x,t) : xts + | isWildIdent x -> do+ t' <- ren vs t+ xts' <- renc vs xts+ return $ (bt,x,t') : xts'+ | otherwise -> do+ t' <- ren vs t+ let vs' = x:vs+ xts' <- renc vs' xts+ return $ (bt,x,t') : xts'+ _ -> return cont+ ren = renameTerm b
@@ -0,0 +1,141 @@+----------------------------------------------------------------------+-- |+-- Module : SubExOpt+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- This module implements a simple common subexpression elimination+-- for .gfo grammars, to factor out shared subterms in lin rules.+-- It works in three phases: +-- +-- (1) collectSubterms collects recursively all subterms of forms table and (P x..y)+-- from lin definitions (experience shows that only these forms+-- tend to get shared) and counts how many times they occur+-- (2) addSubexpConsts takes those subterms t that occur more than once+-- and creates definitions of form "oper A''n = t" where n is a+-- fresh number; notice that we assume no ids of this form are in+-- scope otherwise+-- (3) elimSubtermsMod goes through lins and the created opers by replacing largest+-- possible subterms by the newly created identifiers+-- +-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+module GF.Compile.SubExOpt (subexpModule,unsubexpModule) where ++import GF.Grammar.Grammar+import GF.Grammar.Lookup(lookupResDef)+import GF.Infra.Ident+import qualified GF.Grammar.Macros as C+import GF.Data.ErrM(fromErr)++import Control.Monad.State.Strict(State,evalState,get,put)+import Data.Map (Map)+import qualified Data.Map as Map+++--subexpModule :: SourceModule -> SourceModule+subexpModule (n,mo) =+ let ljs = Map.toList (jments mo)+ tree = evalState (getSubtermsMod n ljs) (Map.empty,0)+ js2 = Map.fromList $ addSubexpConsts n tree $ ljs+ in (n,mo{jments=js2})++--unsubexpModule :: SourceModule -> SourceModule+unsubexpModule sm@(i,mo)+ | hasSub ljs = (i,mo{jments=rebuild (map unparInfo ljs)})+ | otherwise = sm+ where+ ljs = Map.toList (jments mo) ++ -- perform this iff the module has opers+ hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]+ unparInfo (c,info) = case info of+ CncFun xs (Just (L loc t)) m pf -> [(c, CncFun xs (Just (L loc (unparTerm t))) m pf)]+ ResOper (Just (L loc (EInt 8))) _ -> [] -- subexp-generated opers+ ResOper pty (Just (L loc t)) -> [(c, ResOper pty (Just (L loc (unparTerm t))))]+ _ -> [(c,info)]+ unparTerm t = case t of+ Q (m,c) | isOperIdent c -> --- name convention of subexp opers+ fromErr t $ fmap unparTerm $ lookupResDef gr (m,c)+ _ -> C.composSafeOp unparTerm t+ gr = mGrammar [sm]+ rebuild = Map.fromList . concat++-- implementation++type TermList = Map Term (Int,Int) -- number of occs, id+type TermM a = State (TermList,Int) a++addSubexpConsts :: + ModuleName -> Map Term (Int,Int) -> [(Ident,Info)] -> [(Ident,Info)]+addSubexpConsts mo tree lins = do+ let opers = [oper id trm | (trm,(_,id)) <- list]+ map mkOne $ opers ++ lins+ where+ mkOne (f,def) = case def of+ CncFun xs (Just (L loc trm)) pn pf ->+ let trm' = recomp f trm+ in (f,CncFun xs (Just (L loc trm')) pn pf)+ ResOper ty (Just (L loc trm)) ->+ let trm' = recomp f trm+ in (f,ResOper ty (Just (L loc trm')))+ _ -> (f,def)+ recomp f t = case Map.lookup t tree of+ Just (_,id) | operIdent id /= f -> Q (mo, operIdent id)+ _ -> C.composSafeOp (recomp f) t++ list = Map.toList tree++ oper id trm = (operIdent id, ResOper (Just (L NoLoc (EInt 8))) (Just (L NoLoc trm))) + --- impossible type encoding generated opers++getSubtermsMod :: ModuleName -> [(Ident,Info)] -> TermM (Map Term (Int,Int))+getSubtermsMod mo js = do+ mapM (getInfo (collectSubterms mo)) js+ (tree0,_) <- get+ return $ Map.filter (\ (nu,_) -> nu > 1) tree0+ where+ getInfo get fi@(f,i) = case i of+ CncFun xs (Just (L _ trm)) pn _ -> do+ get trm+ return $ fi+ ResOper ty (Just (L _ trm)) -> do+ get trm+ return $ fi+ _ -> return fi++collectSubterms :: ModuleName -> Term -> TermM Term+collectSubterms mo t = case t of+ App f a -> do+ collect f+ collect a+ add t + T ty cs -> do+ let (_,ts) = unzip cs+ mapM collect ts+ add t+ V ty ts -> do+ mapM collect ts+ add t+---- K (KP _ _) -> add t+ _ -> C.composOp (collectSubterms mo) t+ where+ collect = collectSubterms mo+ add t = do+ (ts,i) <- get+ let + ((count,id),next) = case Map.lookup t ts of+ Just (nu,id) -> ((nu+1,id), i)+ _ -> ((1, i ), i+1)+ put (Map.insert t (count,id) ts, next)+ return t --- only because of composOp++operIdent :: Int -> Ident+operIdent i = identC (operPrefix `prefixRawIdent` (rawIdentS (show i))) ---++isOperIdent :: Ident -> Bool+isOperIdent id = isPrefixOf operPrefix (ident2raw id)++operPrefix = rawIdentS ("A''")
@@ -0,0 +1,89 @@+module GF.Compile.Tags+ ( writeTags+ , gf2gftags+ ) where++import GF.Infra.Option+import GF.Infra.UseIO+import GF.Data.Operations+import GF.Grammar++--import Data.List+import qualified Data.Map as Map+import qualified Data.Set as Set+--import Control.Monad+import GF.Text.Pretty+import System.FilePath++writeTags opts gr file mo = do+ let imports = getImports opts gr mo+ locals = getLocalTags [] mo+ txt = unlines ((Set.toList . Set.fromList) (imports++locals))+ putPointE Normal opts (" write file" +++ file) $ liftIO $ writeFile file txt++getLocalTags x (m,mi) = + [showIdent i ++ "\t" ++ k ++ "\t" ++ l ++ "\t" ++ t + | (i,jment) <- Map.toList (jments mi),+ (k,l,t) <- getLocations jment] ++ x+ where+ getLocations :: Info -> [(String,String,String)]+ getLocations (AbsCat mb_ctxt) = maybe (loc "cat") mb_ctxt+ getLocations (AbsFun mb_type _ mb_eqs _) = maybe (ltype "fun") mb_type +++ maybe (list (loc "def")) mb_eqs + getLocations (ResParam mb_params _) = maybe (loc "param") mb_params+ getLocations (ResValue mb_type) = ltype "param-value" mb_type+ getLocations (ResOper mb_type mb_def) = maybe (ltype "oper-type") mb_type +++ maybe (loc "oper-def") mb_def+ getLocations (ResOverload _ defs) = list (\(x,y) -> ltype "overload-type" x ++ + loc "overload-def" y) defs+ getLocations (CncCat mty md mr mprn _) = maybe (loc "lincat") mty ++ + maybe (loc "lindef") md +++ maybe (loc "linref") mr +++ maybe (loc "printname") mprn+ getLocations (CncFun _ mlin mprn _) = maybe (loc "lin") mlin +++ maybe (loc "printname") mprn+ getLocations _ = []++ loc kind (L loc _) = [(kind,render (ppLocation (msrc mi) loc),"")]++ ltype kind (L loc ty) = [(kind,render (ppLocation (msrc mi) loc),render (ppTerm Unqualified 0 ty))]++ maybe f (Just x) = f x+ maybe f Nothing = []++ list f xs = concatMap f xs+ + render = renderStyle style{mode=OneLineMode}+++getImports opts gr mo@(m,mi) = concatMap toDep allOpens+ where+ allOpens = [(OSimple m,incl) | (m,incl) <- mextend mi] ++ + [(o,MIAll) | o <- mopens mi]++ toDep (OSimple m,incl) =+ let Ok mi = lookupModule gr m+ in [showIdent id ++ "\t" ++ "indir" ++ "\t" ++ render m ++ "\t\t" ++ gf2gftags opts (orig mi info)+ | (id,info) <- Map.toList (jments mi), filter incl id]+ toDep (OQualif m1 m2,incl) =+ let Ok mi = lookupModule gr m2+ in [showIdent id ++ "\t" ++ "indir" ++ "\t" ++ render m2 ++ "\t" ++ render m1 ++ "\t" ++ gf2gftags opts (orig mi info)+ | (id,info) <- Map.toList (jments mi), filter incl id]++ filter MIAll id = True+ filter (MIOnly ids) id = elem id ids+ filter (MIExcept ids) id = not (elem id ids)++ orig mi info =+ case info of+ AnyInd _ m0 -> let Ok mi0 = lookupModule gr m0+ in msrc mi0+ _ -> msrc mi ++gftagsFile :: FilePath -> FilePath+gftagsFile f = addExtension f "gf-tags"++gf2gftags :: Options -> FilePath -> FilePath+gf2gftags opts file = maybe (gftagsFile (dropExtension file))+ (\dir -> dir </> gftagsFile (dropExtension (takeFileName file)))+ (flag optOutputDir opts)
@@ -0,0 +1,214 @@+module GF.Compile.ToAPI + (stringToAPI,exprToAPI)+ where++import PGF.Internal+import PGF(showCId)+import Data.Maybe+--import System.IO+--import Control.Monad+--import Data.Set as Set (fromList,toList)+import Data.List+--import Data.Map(Map)+import qualified Data.Map as Map+++-- intermediate structure for representing the translated expression+data APIfunc = BasicFunc String | AppFunc String [APIfunc] | NoAPI + deriving (Show,Eq)+++++-- translates a GF expression/tree into an equivalent one which uses functions from the GF+-- API instead of the syntactic modules+exprToAPI :: Expr -> String+exprToAPI expr = + let ffs = exprToFunc expr + in printAPIfunc ffs+++++-- translates a GF expression/tree written as a string to its correspondent which uses API functions+-- the string is parsed into a GF expression/tree first+stringToAPI :: String -> String+stringToAPI expressionToRead = + case readExpr expressionToRead of+ Just ex -> exprToAPI ex + _ -> error "incorrect expression given as input "+++++-- function for translating an expression into APIFunc with type inference for +-- the type of the expression+exprToFunc :: Expr -> APIfunc+exprToFunc expr = + case unApp expr of+ Just (cid,l) -> + case Map.lookup (showCId cid) syntaxFuncs of + Just sig -> mkAPI True (fst sig,expr)+ _ -> case l of + [] -> BasicFunc (showCId cid) + _ -> let es = map exprToFunc l + in AppFunc (showCId cid) es+ _ -> BasicFunc (showExpr [] expr)++ + + ++-- main function for translating an expression along with its type into an APIFunc+-- the boolean controls the need to optimize the result+mkAPI :: Bool -> (String, Expr) -> APIfunc+mkAPI opt (ty,expr) = + if elem ty rephraseable then rephraseSentence ty expr + else if opt then if elem ty optimizable then optimize expr else computeAPI (ty,expr)+ else computeAPI (ty,expr) + where+ rephraseSentence ty expr = + case unApp expr of + Just (cid,es) -> if isPrefixOf "Use" (showCId cid) then + let newCat = drop 3 (showCId cid)+ afClause = mkAPI True (newCat, es !! 2)+ afPol = mkAPI True ("Pol",es !! 1) + lTense = mkAPI True ("Temp", head es) + in case lTense of + AppFunc _ [BasicFunc s1, BasicFunc s2] -> + let (r1,r2) = getTemporalParam s1 s2 in + AppFunc ("mk"++newCat) [r1,r2,afPol,afClause] + _ -> error "erroneous tense" + else (mkAPI False) (ty,expr)+ _ -> error $ "incorrect for for expression "++ showExpr [] expr+ + getTemporalParam s1 s2 = + let r1 = case s1 of + "TPres" -> NoAPI+ "TPast" -> BasicFunc "pastTense"+ "TFut" -> BasicFunc "futureTense" + "TCond" -> BasicFunc "conditionalTense"+ r2 = case s2 of+ "ASimul" -> NoAPI+ "AAnter" -> BasicFunc "anteriorAnt"+ in (r1,r2) ++++computeAPI :: (String,Expr) -> APIfunc+computeAPI (ty,expr) =+ case (unApp expr) of + Just (cid,[]) -> getSimpCat (showCId cid) ty+ Just (cid,es) -> + let p = specFunction (showCId cid) es + in if isJust p then fromJust p+ else case Map.lookup (show cid) syntaxFuncs of+ Nothing -> exprToFunc expr + Just (nameCat,typesExps) -> + if elem nameCat hiddenCats && length es == 1 then (mkAPI True) (head typesExps,head es)+ else if elem nameCat hiddenCats then error $ "incorrect coercion "++nameCat++" - "++show es + else let afs = map (mkAPI True) (zip typesExps es)+ in AppFunc ("mk" ++ nameCat) afs + _ -> error "error" + where + getSimpCat "IdRP" _ = BasicFunc "which_RP"+ getSimpCat "DefArt" _ = BasicFunc "the_Art"+ getSimpCat "IndefArt" _ = BasicFunc "a_Art"+ getSimpCat "NumSg" _ = NoAPI+ getSimpCat "NumPl" _ = BasicFunc "plNum"+ getSimpCat "PPos" _ = NoAPI+ getSimpCat "PNeg" _ = BasicFunc "negativePol"+ getSimpCat cid ty = if elem ty ["PConj","Voc"] && isInfixOf "No" cid+ then NoAPI + else BasicFunc cid++ specFunction "PassV2" es = rephraseUnary "passiveVP" "V2" es+ specFunction "ReflA2" es = rephraseUnary "reflAP" "A2" es+ specFunction "UseComparA" es = rephraseUnary "comparAP" "A" es+ specFunction "TFullStop" es = rephraseText "fullStopPunct" es+ specFunction "TExclMark" es = rephraseText "exclMarkPunct" es+ specFunction "TQuestMark" es = rephraseText "questMarkPunct" es+ specFunction _ _ = Nothing++ rephraseUnary ss ty es = + let afs = mkAPI True (ty,head es) + in Just (AppFunc ss [afs])++ rephraseText ss es = + let afs = map (mkAPI True) (zip ["Phr","Text"] es) in+ if afs !! 1 == BasicFunc "TEmpty" then Just (AppFunc "mkText" [head afs,BasicFunc ss])+ else Just (AppFunc "mkText" [head afs, BasicFunc ss, last afs])++++-- optimizations for the translation of some categories+optimize expr = optimizeNP expr++optimizeNP expr = + case unApp expr of+ Just (cid,es) -> + if showCId cid == "MassNP" then let afs = nounAsCN (head es)+ in AppFunc "mkNP" [afs]+ else if showCId cid == "DetCN" then let quants = quantAsDet (head es)+ ns = nounAsCN (head $ tail es)+ in AppFunc "mkNP" (quants ++ [ns])+ else mkAPI False ("NP",expr)+ _ -> error $ "incorrect expression " ++ (showExpr [] expr)+ where + nounAsCN expr = + case unApp expr of + Just (cid,es) -> if showCId cid == "UseN" then (mkAPI False) ("N",head es)+ else (mkAPI False) ("CN",expr)+ _ -> error $ "incorrect expression "++ (showExpr [] expr)++ quantAsDet expr =+ case unApp expr of+ Just (cid,es) -> if showCId cid == "DetQuant" then map (mkAPI False) [("Quant", head es),("Num",head $ tail es)]+ else [mkAPI False ("Det",expr)]+ + _ -> error $ "incorrect expression "++ (showExpr [] expr)+ ++ +-- categories not present in the API - rephrasing needed+hiddenCats :: [String]+hiddenCats = ["N2","V2","Comp","SC"]++++-- categories for which optimization of the translation is provided at the moment+optimizable :: [String]+optimizable = ["NP"]++++-- categories for which the compositional translation needs to be rephrased+rephraseable :: [String]+rephraseable = ["S","QS","RS"]++++-- converts the intermediate structure APIFunc to plain string+printAPIfunc :: APIfunc -> String +printAPIfunc (BasicFunc f) = f +printAPIfunc NoAPI = ""+printAPIfunc (AppFunc f es) = unwords (f : map (\x -> printAPIArgfunc x ) es) + where + printAPIArgfunc (BasicFunc f) = f+ printAPIArgfunc NoAPI = ""+ printAPIArgfunc f = "(" ++ printAPIfunc f ++ ")" +++++++--------------------------------------------------------------------------------+{-+constFuncs :: Map.Map String (String,[String])+constFuncs = Map.fromList [("AAnter",("Ant",[])),("ASimul",("Ant",[])),("D_0",("Dig",[])),("D_1",("Dig",[])),("D_2",("Dig",[])),("D_3",("Dig",[])),("D_4",("Dig",[])),("D_5",("Dig",[])),("D_6",("Dig",[])),("D_7",("Dig",[])),("D_8",("Dig",[])),("D_9",("Dig",[])),("DefArt",("Quant",[])),("IdRP",("RP",[])),("IndefArt",("Quant",[])),("NoPConj",("PConj",[])),("NoVoc",("Voc",[])),("NumPl",("Num",[])),("NumSg",("Num",[])),("PNeg",("Pol",[])),("PPos",("Pol",[])),("TCond",("Tense",[])),("TEmpty",("Text",[])),("TFut",("Tense",[])),("TPast",("Tense",[])),("TPres",("Tense",[])),("UseCopula",("VP",[])),("above_Prep",("Prep",[])),("after_Prep",("Prep",[])),("alas_Interj",("Interj",[])),("all_Predet",("Predet",[])),("almost_AdA",("AdA",[])),("almost_AdN",("AdN",[])),("already_Adv",("Adv",[])),("although_Subj",("Subj",[])),("always_AdV",("AdV",[])),("and_Conj",("Conj",[])),("answer_V2S",("V2S",[])),("as_CAdv",("CAdv",[])),("ask_V2Q",("V2Q",[])),("at_least_AdN",("AdN",[])),("at_most_AdN",("AdN",[])),("because_Subj",("Subj",[])),("before_Prep",("Prep",[])),("beg_V2V",("V2V",[])),("behind_Prep",("Prep",[])),("between_Prep",("Prep",[])),("both7and_DConj",("Conj",[])),("but_PConj",("PConj",[])),("by8agent_Prep",("Prep",[])),("by8means_Prep",("Prep",[])),("during_Prep",("Prep",[])),("either7or_DConj",("Conj",[])),("every_Det",("Det",[])),("everybody_NP",("NP",[])),("everything_NP",("NP",[])),("everywhere_Adv",("Adv",[])),("except_Prep",("Prep",[])),("far_Adv",("Adv",[])),("few_Det",("Det",[])),("for_Prep",("Prep",[])),("from_Prep",("Prep",[])),("he_Pron",("Pron",[])),("here7from_Adv",("Adv",[])),("here7to_Adv",("Adv",[])),("here_Adv",("Adv",[])),("how8many_IDet",("IDet",[])),("how8much_IAdv",("IAdv",[])),("how_IAdv",("IAdv",[])),("i_Pron",("Pron",[])),("if_Subj",("Subj",[])),("if_then_Conj",("Conj",[])),("in8front_Prep",("Prep",[])),("in_Prep",("Prep",[])),("it_Pron",("Pron",[])),("language_title_Utt",("Utt",[])),("left_Ord",("Ord",[])),("less_CAdv",("CAdv",[])),("many_Det",("Det",[])),("more_CAdv",("CAdv",[])),("most_Predet",("Predet",[])),("much_Det",("Det",[])),("n2",("Digit",[])),("n3",("Digit",[])),("n4",("Digit",[])),("n5",("Digit",[])),("n6",("Digit",[])),("n7",("Digit",[])),("n8",("Digit",[])),("n9",("Digit",[])),("no_Quant",("Quant",[])),("no_Utt",("Utt",[])),("nobody_NP",("NP",[])),("not_Predet",("Predet",[])),("nothing_NP",("NP",[])),("now_Adv",("Adv",[])),("on_Prep",("Prep",[])),("only_Predet",("Predet",[])),("or_Conj",("Conj",[])),("otherwise_PConj",("PConj",[])),("paint_V2A",("V2A",[])),("part_Prep",("Prep",[])),("please_Voc",("Voc",[])),("possess_Prep",("Prep",[])),("pot01",("Sub10",[])),("pot110",("Sub100",[])),("pot111",("Sub100",[])),("quite_Adv",("AdA",[])),("right_Ord",("Ord",[])),("she_Pron",("Pron",[])),("so_AdA",("AdA",[])),("somePl_Det",("Det",[])),("someSg_Det",("Det",[])),("somebody_NP",("NP",[])),("something_NP",("NP",[])),("somewhere_Adv",("Adv",[])),("that_Quant",("Quant",[])),("that_Subj",("Subj",[])),("there7from_Adv",("Adv",[])),("there7to_Adv",("Adv",[])),("there_Adv",("Adv",[])),("therefore_PConj",("PConj",[])),("they_Pron",("Pron",[])),("this_Quant",("Quant",[])),("through_Prep",("Prep",[])),("to_Prep",("Prep",[])),("today_Adv",("Adv",[])),("too_AdA",("AdA",[])),("under_Prep",("Prep",[])),("very_AdA",("AdA",[])),("we_Pron",("Pron",[])),("whatPl_IP",("IP",[])),("whatSg_IP",("IP",[])),("when_IAdv",("IAdv",[])),("when_Subj",("Subj",[])),("where_IAdv",("IAdv",[])),("which_IQuant",("IQuant",[])),("whoPl_IP",("IP",[])),("whoSg_IP",("IP",[])),("why_IAdv",("IAdv",[])),("with_Prep",("Prep",[])),("without_Prep",("Prep",[])),("yes_Utt",("Utt",[])),("youPl_Pron",("Pron",[])),("youPol_Pron",("Pron",[])),("youSg_Pron",("Pron",[]))]+-}+++syntaxFuncs :: Map.Map String (String,[String])+syntaxFuncs = Map.fromList [("AdAP",("AP",["AdA","AP"])),("AdAdv",("Adv",["AdA","Adv"])),("AdNum",("Card",["AdN","Card"])),("AdVVP",("VP",["AdV","VP"])),("AddAdvQVP",("QVP",["QVP","IAdv"])),("AdjCN",("CN",["AP","CN"])),("AdjOrd",("AP",["Ord"])),("AdnCAdv",("AdN",["CAdv"])),("AdvAP",("AP",["AP","Adv"])),("AdvCN",("CN",["CN","Adv"])),("AdvIAdv",("IAdv",["IAdv","Adv"])),("AdvIP",("IP",["IP","Adv"])),("AdvNP",("NP",["NP","Adv"])),("AdvQVP",("QVP",["VP","IAdv"])),("AdvS",("S",["Adv","S"])),("AdvSlash",("ClSlash",["ClSlash","Adv"])),("AdvVP",("VP",["VP","Adv"])),("ApposCN",("CN",["CN","NP"])),("BaseAP",("ListAP",["AP","AP"])),("BaseAdv",("ListAdv",["Adv","Adv"])),("BaseCN",("ListCN",["CN","CN"])),("BaseIAdv",("ListIAdv",["IAdv","IAdv"])),("BaseNP",("ListNP",["NP","NP"])),("BaseRS",("ListRS",["RS","RS"])),("BaseS",("ListS",["S","S"])),("CAdvAP",("AP",["CAdv","AP","NP"])),("CleftAdv",("Cl",["Adv","S"])),("CleftNP",("Cl",["NP","RS"])),("CompAP",("Comp",["AP"])),("CompAdv",("Comp",["Adv"])),("CompCN",("Comp",["CN"])),("CompIAdv",("IComp",["IAdv"])),("CompIP",("IComp",["IP"])),("CompNP",("Comp",["NP"])),("ComparA",("AP",["A","NP"])),("ComparAdvAdj",("Adv",["CAdv","A","NP"])),("ComparAdvAdjS",("Adv",["CAdv","A","S"])),("ComplA2",("AP",["A2","NP"])),("ComplN2",("CN",["N2","NP"])),("ComplN3",("N2",["N3","NP"])),("ComplSlash",("VP",["VPSlash","NP"])),("ComplSlashIP",("QVP",["VPSlash","IP"])),("ComplVA",("VP",["VA","AP"])),("ComplVQ",("VP",["VQ","QS"])),("ComplVS",("VP",["VS","S"])),("ComplVV",("VP",["VV","VP"])),("ConjAP",("AP",["Conj","ListAP"])),("ConjAdv",("Adv",["Conj","ListAdv"])),("ConjCN",("CN",["Conj","ListCN"])),("ConjIAdv",("IAdv",["Conj","ListIAdv"])),("ConjNP",("NP",["Conj","ListNP"])),("ConjRS",("RS",["Conj","ListRS"])),("ConjS",("S",["Conj","ListS"])),("ConsAP",("ListAP",["AP","ListAP"])),("ConsAdv",("ListAdv",["Adv","ListAdv"])),("ConsCN",("ListCN",["CN","ListCN"])),("ConsIAdv",("ListIAdv",["IAdv","ListIAdv"])),("ConsNP",("ListNP",["NP","ListNP"])),("ConsRS",("ListRS",["RS","ListRS"])),("ConsS",("ListS",["S","ListS"])),("DetCN",("NP",["Det","CN"])),("DetNP",("NP",["Det"])),("DetQuant",("Det",["Quant","Num"])),("DetQuantOrd",("Det",["Quant","Num","Ord"])),("EmbedQS",("SC",["QS"])),("EmbedS",("SC",["S"])),("EmbedVP",("SC",["VP"])),("ExistIP",("QCl",["IP"])),("ExistNP",("Cl",["NP"])),("FunRP",("RP",["Prep","NP","RP"])),("GenericCl",("Cl",["VP"])),("IDig",("Digits",["Dig"])),("IIDig",("Digits",["Dig","Digits"])),("IdetCN",("IP",["IDet","CN"])),("IdetIP",("IP",["IDet"])),("IdetQuant",("IDet",["IQuant","Num"])),("ImpP3",("Utt",["NP","VP"])),("ImpPl1",("Utt",["VP"])),("ImpVP",("Imp",["VP"])),("ImpersCl",("Cl",["VP"])),("MassNP",("NP",["CN"])),("NumCard",("Num",["Card"])),("NumDigits",("Card",["Digits"])),("NumNumeral",("Card",["Numeral"])),("OrdDigits",("Ord",["Digits"])),("OrdNumeral",("Ord",["Numeral"])),("OrdSuperl",("Ord",["A"])),("PConjConj",("PConj",["Conj"])),("PPartNP",("NP",["NP","V2"])),("PassV2",("VP",["V2"])),("PhrUtt",("Phr",["PConj","Utt","Voc"])),("PositA",("AP",["A"])),("PositAdAAdj",("AdA",["A"])),("PositAdvAdj",("Adv",["A"])),("PossPron",("Quant",["Pron"])),("PredSCVP",("Cl",["SC","VP"])),("PredVP",("Cl",["NP","VP"])),("PredetNP",("NP",["Predet","NP"])),("PrepIP",("IAdv",["Prep","IP"])),("PrepNP",("Adv",["Prep","NP"])),("ProgrVP",("VP",["VP"])),("QuestCl",("QCl",["Cl"])),("QuestIAdv",("QCl",["IAdv","Cl"])),("QuestIComp",("QCl",["IComp","NP"])),("QuestQVP",("QCl",["IP","QVP"])),("QuestSlash",("QCl",["IP","ClSlash"])),("QuestVP",("QCl",["IP","VP"])),("ReflA2",("AP",["A2"])),("ReflVP",("VP",["VPSlash"])),("RelCN",("CN",["CN","RS"])),("RelCl",("RCl",["Cl"])),("RelNP",("NP",["NP","RS"])),("RelS",("S",["S","RS"])),("RelSlash",("RCl",["RP","ClSlash"])),("RelVP",("RCl",["RP","VP"])),("SSubjS",("S",["S","Subj","S"])),("SentAP",("AP",["AP","SC"])),("SentCN",("CN",["CN","SC"])),("Slash2V3",("VPSlash",["V3","NP"])),("Slash3V3",("VPSlash",["V3","NP"])),("SlashPrep",("ClSlash",["Cl","Prep"])),("SlashV2A",("VPSlash",["V2A","AP"])),("SlashV2Q",("VPSlash",["V2Q","QS"])),("SlashV2S",("VPSlash",["V2S","S"])),("SlashV2V",("VPSlash",["V2V","VP"])),("SlashV2VNP",("VPSlash",["V2V","NP","VPSlash"])),("SlashV2a",("VPSlash",["V2"])),("SlashVP",("ClSlash",["NP","VPSlash"])),("SlashVS",("ClSlash",["NP","VS","SSlash"])),("SlashVV",("VPSlash",["VV","VPSlash"])),("SubjS",("Adv",["Subj","S"])),("TExclMark",("Text",["Phr","Text"])),("TFullStop",("Text",["Phr","Text"])),("TQuestMark",("Text",["Phr","Text"])),("TTAnt",("Temp",["Tense","Ant"])),("Use2N3",("N2",["N3"])),("Use3N3",("N2",["N3"])),("UseA2",("AP",["A2"])),("UseCl",("S",["Temp","Pol","Cl"])),("UseComp",("VP",["Comp"])),("UseComparA",("AP",["A"])),("UseN",("CN",["N"])),("UseN2",("CN",["N2"])),("UsePN",("NP",["PN"])),("UsePron",("NP",["Pron"])),("UseQCl",("QS",["Temp","Pol","QCl"])),("UseRCl",("RS",["Temp","Pol","RCl"])),("UseSlash",("SSlash",["Temp","Pol","ClSlash"])),("UseV",("VP",["V"])),("UttAP",("Utt",["AP"])),("UttAdv",("Utt",["Adv"])),("UttCN",("Utt",["CN"])),("UttCard",("Utt",["Card"])),("UttIAdv",("Utt",["IAdv"])),("UttIP",("Utt",["IP"])),("UttImpPl",("Utt",["Pol","Imp"])),("UttImpPol",("Utt",["Pol","Imp"])),("UttImpSg",("Utt",["Pol","Imp"])),("UttInterj",("Utt",["Interj"])),("UttNP",("Utt",["NP"])),("UttQS",("Utt",["QS"])),("UttS",("Utt",["S"])),("UttVP",("Utt",["VP"])),("VocNP",("Voc",["NP"])),("dconcat",("Digits",["Digits","Digits"])),("digits2num",("Numeral",["Digits"])),("dn",("Digit",["Dig"])),("dn10",("Sub10",["Dig"])),("dn100",("Sub100",["Dig","Dig"])),("dn1000",("Sub1000",["Dig","Dig","Dig"])),("dn1000000a",("Sub1000000",["Dig","Dig","Dig","Dig"])),("dn1000000b",("Sub1000000",["Dig","Dig","Dig","Dig","Dig"])),("dn1000000c",("Sub1000000",["Dig","Dig","Dig","Dig","Dig","Dig"])),("nd",("Dig",["Digit"])),("nd10",("Digits",["Sub10"])),("nd100",("Digits",["Sub100"])),("nd1000",("Digits",["Sub1000"])),("nd1000000",("Digits",["Sub1000000"])),("num",("Numeral",["Sub1000000"])),("num2digits",("Digits",["Numeral"])),("pot0",("Sub10",["Digit"])),("pot0as1",("Sub100",["Sub10"])),("pot1",("Sub100",["Digit"])),("pot1as2",("Sub1000",["Sub100"])),("pot1plus",("Sub100",["Digit","Sub10"])),("pot1to19",("Sub100",["Digit"])),("pot2",("Sub1000",["Sub10"])),("pot2as3",("Sub1000000",["Sub1000"])),("pot2plus",("Sub1000",["Sub10","Sub100"])),("pot3",("Sub1000000",["Sub1000"])),("pot3plus",("Sub1000000",["Sub1000","Sub1000"]))]
@@ -0,0 +1,82 @@+----------------------------------------------------------------------+-- |+-- Module : TypeCheck+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/09/15 16:22:02 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.16 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Compile.TypeCheck.Abstract (-- * top-level type checking functions; TC should not be called directly.+ checkContext,+ checkTyp,+ checkDef,+ checkConstrs,+ ) where++import GF.Data.Operations++import GF.Infra.CheckM+import GF.Grammar+import GF.Grammar.Lookup+import GF.Grammar.Unify+--import GF.Compile.Refresh+--import GF.Compile.Compute.Abstract+import GF.Compile.TypeCheck.TC++import GF.Text.Pretty+--import Control.Monad (foldM, liftM, liftM2)++-- | invariant way of creating TCEnv from context+initTCEnv gamma = + (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) ++-- interface to TC type checker++type2val :: Type -> Val+type2val = VClos []++cont2exp :: Context -> Term+cont2exp c = mkProd c eType [] -- to check a context++cont2val :: Context -> Val+cont2val = type2val . cont2exp++-- some top-level batch-mode checkers for the compiler++justTypeCheck :: SourceGrammar -> Term -> Val -> Err Constraints+justTypeCheck gr e v = do+ (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v+ (constrs1,_) <- unifyVal constrs0+ return $ filter notJustMeta constrs1++notJustMeta (c,k) = case (c,k) of+ (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False+ _ -> True++grammar2theory :: SourceGrammar -> Theory+grammar2theory gr (m,f) = case lookupFunType gr m f of+ Ok t -> return $ type2val t+ Bad s -> case lookupCatContext gr m f of+ Ok cont -> return $ cont2val cont+ _ -> Bad s++checkContext :: SourceGrammar -> Context -> [Message]+checkContext st = checkTyp st . cont2exp++checkTyp :: SourceGrammar -> Type -> [Message]+checkTyp gr typ = err (\x -> [pp x]) ppConstrs $ justTypeCheck gr typ vType++checkDef :: SourceGrammar -> Fun -> Type -> Equation -> [Message]+checkDef gr (m,fun) typ eq = err (\x -> [pp x]) ppConstrs $ do+ (b,cs) <- checkBranch (grammar2theory gr) (initTCEnv []) eq (type2val typ)+ (constrs,_) <- unifyVal cs+ return $ filter notJustMeta constrs++checkConstrs :: SourceGrammar -> Cat -> [Ident] -> [String]+checkConstrs gr cat _ = [] ---- check constructors!
@@ -0,0 +1,721 @@+{-# LANGUAGE PatternGuards #-}+module GF.Compile.TypeCheck.Concrete( {-checkLType, inferLType, computeLType, ppType-} ) where+{-+import GF.Infra.CheckM+import GF.Data.Operations++import GF.Grammar+import GF.Grammar.Lookup+import GF.Grammar.Predef+import GF.Grammar.PatternMatch+import GF.Grammar.Lockfield (isLockLabel, lockRecType, unlockRecord)+import GF.Compile.TypeCheck.Primitives++import Data.List+import Control.Monad+import GF.Text.Pretty++computeLType :: SourceGrammar -> Context -> Type -> Check Type+computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t+ where+ comp g ty = case ty of+ _ | Just _ <- isTypeInts ty -> return ty ---- shouldn't be needed+ | isPredefConstant ty -> return ty ---- shouldn't be needed++ Q (m,ident) -> checkIn (text "module" <+> ppIdent m) $ do+ ty' <- lookupResDef gr (m,ident)+ if ty' == ty then return ty else comp g ty' --- is this necessary to test?++ Vr ident -> checkLookup ident g -- never needed to compute!++ App f a -> do+ f' <- comp g f+ a' <- comp g a+ case f' of+ Abs b x t -> comp ((b,x,a'):g) t+ _ -> return $ App f' a'++ Prod bt x a b -> do+ a' <- comp g a+ b' <- comp ((bt,x,Vr x) : g) b+ return $ Prod bt x a' b'++ Abs bt x b -> do+ b' <- comp ((bt,x,Vr x):g) b+ return $ Abs bt x b'++ Let (x,(_,a)) b -> comp ((Explicit,x,a):g) b++ ExtR r s -> do+ r' <- comp g r+ s' <- comp g s+ case (r',s') of+ (RecType rs, RecType ss) -> plusRecType r' s' >>= comp g+ _ -> return $ ExtR r' s'++ RecType fs -> do+ let fs' = sortRec fs+ liftM RecType $ mapPairsM (comp g) fs'++ ELincat c t -> do+ t' <- comp g t+ lockRecType c t' ---- locking to be removed AR 20/6/2009++ _ | ty == typeTok -> return typeStr+ _ | isPredefConstant ty -> return ty++ _ -> composOp (comp g) ty++-- the underlying algorithms++inferLType :: SourceGrammar -> Context -> Term -> Check (Term, Type)+inferLType gr g trm = case trm of++ Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of+ Just ty -> return ty+ Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)++ Q ident -> checks [+ termWith trm $ lookupResType gr ident >>= computeLType gr g+ ,+ lookupResDef gr ident >>= inferLType gr g+ ,+ checkError (text "cannot infer type of constant" <+> ppTerm Unqualified 0 trm)+ ]++ QC (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of+ Just ty -> return ty+ Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)++ QC ident -> checks [+ termWith trm $ lookupResType gr ident >>= computeLType gr g+ ,+ lookupResDef gr ident >>= inferLType gr g+ ,+ checkError (text "cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)+ ]++ Vr ident -> termWith trm $ checkLookup ident g++ Typed e t -> do+ t' <- computeLType gr g t+ checkLType gr g e t'+ return (e,t')++ App f a -> do+ over <- getOverload gr g Nothing trm+ case over of+ Just trty -> return trty+ _ -> do+ (f',fty) <- inferLType gr g f+ fty' <- computeLType gr g fty+ case fty' of+ Prod bt z arg val -> do + a' <- justCheck g a arg+ ty <- if isWildIdent z + then return val+ else substituteLType [(bt,z,a')] val+ return (App f' a',ty) + _ -> checkError (text "A function type is expected for" <+> ppTerm Unqualified 0 f <+> text "instead of type" <+> ppType fty)++ S f x -> do+ (f', fty) <- inferLType gr g f+ case fty of+ Table arg val -> do+ x'<- justCheck g x arg+ return (S f' x', val)+ _ -> checkError (text "table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))++ P t i -> do+ (t',ty) <- inferLType gr g t --- ??+ ty' <- computeLType gr g ty+ let tr2 = P t' i+ termWith tr2 $ case ty' of+ RecType ts -> case lookup i ts of+ Nothing -> checkError (text "unknown label" <+> ppLabel i <+> text "in" $$ nest 2 (ppTerm Unqualified 0 ty'))+ Just x -> return x+ _ -> checkError (text "record type expected for:" <+> ppTerm Unqualified 0 t $$+ text " instead of the inferred:" <+> ppTerm Unqualified 0 ty')++ R r -> do+ let (ls,fs) = unzip r+ fsts <- mapM inferM fs+ let ts = [ty | (Just ty,_) <- fsts]+ checkCond (text "cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)+ return $ (R (zip ls fsts), RecType (zip ls ts))++ T (TTyped arg) pts -> do+ (_,val) <- checks $ map (inferCase (Just arg)) pts+ checkLType gr g trm (Table arg val)+ T (TComp arg) pts -> do+ (_,val) <- checks $ map (inferCase (Just arg)) pts+ checkLType gr g trm (Table arg val)+ T ti pts -> do -- tries to guess: good in oper type inference+ let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]+ case pts' of + [] -> checkError (text "cannot infer table type of" <+> ppTerm Unqualified 0 trm)+---- PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] + _ -> do + (arg,val) <- checks $ map (inferCase Nothing) pts'+ checkLType gr g trm (Table arg val)+ V arg pts -> do+ (_,val) <- checks $ map (inferLType gr g) pts+-- return (trm, Table arg val) -- old, caused issue 68+ checkLType gr g trm (Table arg val)++ K s -> do+ if elem ' ' s+ then do+ let ss = foldr C Empty (map K (words s)) + ----- removed irritating warning AR 24/5/2008+ ----- checkWarn ("token \"" ++ s ++ + ----- "\" converted to token list" ++ prt ss)+ return (ss, typeStr)+ else return (trm, typeStr)++ EInt i -> return (trm, typeInt)++ EFloat i -> return (trm, typeFloat)++ Empty -> return (trm, typeStr)++ C s1 s2 -> + check2 (flip (justCheck g) typeStr) C s1 s2 typeStr++ Glue s1 s2 -> + check2 (flip (justCheck g) typeStr) Glue s1 s2 typeStr ---- typeTok++---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007+ Strs (Cn c : ts) | c == cConflict -> do+ checkWarn (text "unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))+ inferLType gr g (head ts)++ Strs ts -> do+ ts' <- mapM (\t -> justCheck g t typeStr) ts + return (Strs ts', typeStrs)++ Alts t aa -> do+ t' <- justCheck g t typeStr+ aa' <- flip mapM aa (\ (c,v) -> do+ c' <- justCheck g c typeStr + v' <- checks $ map (justCheck g v) [typeStrs, EPattType typeStr]+ return (c',v'))+ return (Alts t' aa', typeStr)++ RecType r -> do+ let (ls,ts) = unzip r+ ts' <- mapM (flip (justCheck g) typeType) ts + return (RecType (zip ls ts'), typeType)++ ExtR r s -> do+ (r',rT) <- inferLType gr g r + rT' <- computeLType gr g rT+ (s',sT) <- inferLType gr g s+ sT' <- computeLType gr g sT++ let trm' = ExtR r' s'+ ---- trm' <- plusRecord r' s'+ case (rT', sT') of+ (RecType rs, RecType ss) -> do+ rt <- plusRecType rT' sT'+ checkLType gr g trm' rt ---- return (trm', rt)+ _ | rT' == typeType && sT' == typeType -> return (trm', typeType)+ _ -> checkError (text "records or record types expected in" <+> ppTerm Unqualified 0 trm)++ Sort _ -> + termWith trm $ return typeType++ Prod bt x a b -> do+ a' <- justCheck g a typeType+ b' <- justCheck ((bt,x,a'):g) b typeType+ return (Prod bt x a' b', typeType)++ Table p t -> do+ p' <- justCheck g p typeType --- check p partype! + t' <- justCheck g t typeType+ return $ (Table p' t', typeType)++ FV vs -> do+ (_,ty) <- checks $ map (inferLType gr g) vs+--- checkIfComplexVariantType trm ty+ checkLType gr g trm ty++ EPattType ty -> do+ ty' <- justCheck g ty typeType+ return (EPattType ty',typeType)+ EPatt p -> do+ ty <- inferPatt p+ return (trm, EPattType ty)++ ELin c trm -> do+ (trm',ty) <- inferLType gr g trm+ ty' <- lockRecType c ty ---- lookup c; remove lock AR 20/6/2009+ return $ (ELin c trm', ty') ++ _ -> checkError (text "cannot infer lintype of" <+> ppTerm Unqualified 0 trm)++ where+ isPredef m = elem m [cPredef,cPredefAbs]++ justCheck g ty te = checkLType gr g ty te >>= return . fst++ -- for record fields, which may be typed+ inferM (mty, t) = do+ (t', ty') <- case mty of+ Just ty -> checkLType gr g t ty+ _ -> inferLType gr g t+ return (Just ty',t')++ inferCase mty (patt,term) = do+ arg <- maybe (inferPatt patt) return mty+ cont <- pattContext gr g arg patt+ (_,val) <- inferLType gr (reverse cont ++ g) term+ return (arg,val)+ isConstPatt p = case p of+ PC _ ps -> True --- all isConstPatt ps+ PP _ ps -> True --- all isConstPatt ps+ PR ps -> all (isConstPatt . snd) ps+ PT _ p -> isConstPatt p+ PString _ -> True+ PInt _ -> True+ PFloat _ -> True+ PChar -> True+ PChars _ -> True+ PSeq p q -> isConstPatt p && isConstPatt q+ PAlt p q -> isConstPatt p && isConstPatt q+ PRep p -> isConstPatt p+ PNeg p -> isConstPatt p+ PAs _ p -> isConstPatt p+ _ -> False++ inferPatt p = case p of+ PP (q,c) ps | q /= cPredef -> liftM valTypeCnc (lookupResType gr (q,c))+ PAs _ p -> inferPatt p+ PNeg p -> inferPatt p+ PAlt p q -> checks [inferPatt p, inferPatt q]+ PSeq _ _ -> return $ typeStr+ PRep _ -> return $ typeStr+ PChar -> return $ typeStr+ PChars _ -> return $ typeStr+ _ -> inferLType gr g (patt2term p) >>= return . snd+++-- type inference: Nothing, type checking: Just t+-- the latter permits matching with value type+getOverload :: SourceGrammar -> Context -> Maybe Type -> Term -> Check (Maybe (Term,Type))+getOverload gr g mt ot = case appForm ot of+ (f@(Q c), ts) -> case lookupOverload gr c of+ Ok typs -> do+ ttys <- mapM (inferLType gr g) ts+ v <- matchOverload f typs ttys+ return $ Just v+ _ -> return Nothing+ _ -> return Nothing+ where+ matchOverload f typs ttys = do+ let (tts,tys) = unzip ttys+ let vfs = lookupOverloadInstance tys typs+ let matches = [vf | vf@((_,v,_),_) <- vfs, matchVal mt v]+ let showTypes ty = hsep (map ppType ty)++ + let (stys,styps) = (showTypes tys, [showTypes ty | (ty,_) <- typs])++ -- to avoid strange error msg e.g. in case of unmatch record extension, show whole types if needed AR 28/1/2013+ let (stysError,stypsError) = if elem (render stys) (map render styps)+ then (hsep (map (ppTerm Unqualified 0) tys), [hsep (map (ppTerm Unqualified 0) ty) | (ty,_) <- typs])+ else (stys,styps)++ case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of+ ([(_,val,fun)],_) -> return (mkApp fun tts, val)+ ([],[(pre,val,fun)]) -> do+ checkWarn $ text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$+ text "for" $$+ nest 2 (showTypes tys) $$+ text "using" $$+ nest 2 (showTypes pre)+ return (mkApp fun tts, val)+ ([],[]) -> do+ checkError $ text "no overload instance of" <+> ppTerm Unqualified 0 f $$+ text "for" $$+ nest 2 stysError $$+ text "among" $$+ nest 2 (vcat stypsError) $$+ maybe empty (\x -> text "with value type" <+> ppType x) mt++ (vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of+ ([(val,fun)],_) -> do+ return (mkApp fun tts, val)+ ([],[(val,fun)]) -> do+ checkWarn (text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot) + return (mkApp fun tts, val)++----- unsafely exclude irritating warning AR 24/5/2008+----- checkWarn $ "overloading of" +++ prt f +++ +----- "resolved by excluding partial applications:" +++++----- unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]+++ _ -> checkError $ text "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>+ text "for" <+> hsep (map ppType tys) $$ + text "with alternatives" $$+ nest 2 (vcat [ppType ty | (_,ty,_) <- if null vfs1 then vfs2 else vfs2])++ matchVal mt v = elem mt [Nothing,Just v,Just (unlocked v)]++ unlocked v = case v of+ RecType fs -> RecType $ filter (not . isLockLabel . fst) fs+ _ -> v+ ---- TODO: accept subtypes+ ---- TODO: use a trie+ lookupOverloadInstance tys typs = + [((pre,mkFunType rest val, t),isExact) | + let lt = length tys,+ (ty,(val,t)) <- typs, length ty >= lt,+ let (pre,rest) = splitAt lt ty, + let isExact = pre == tys,+ isExact || map unlocked pre == map unlocked tys+ ]++ noProds vfs = [(v,f) | (_,v,f) <- vfs, noProd v]++ noProd ty = case ty of+ Prod _ _ _ _ -> False+ _ -> True++checkLType :: SourceGrammar -> Context -> Term -> Type -> Check (Term, Type)+checkLType gr g trm typ0 = do++ typ <- computeLType gr g typ0++ case trm of++ Abs bt x c -> do+ case typ of+ Prod bt' z a b -> do + (c',b') <- if isWildIdent z+ then checkLType gr ((bt,x,a):g) c b+ else do b' <- checkIn (text "abs") $ substituteLType [(bt',z,Vr x)] b+ checkLType gr ((bt,x,a):g) c b'+ return $ (Abs bt x c', Prod bt' x a b')+ _ -> checkError $ text "function type expected instead of" <+> ppType typ++ App f a -> do+ over <- getOverload gr g (Just typ) trm+ case over of+ Just trty -> return trty+ _ -> do+ (trm',ty') <- inferLType gr g trm+ termWith trm' $ checkEqLType gr g typ ty' trm'++ Q _ -> do+ over <- getOverload gr g (Just typ) trm+ case over of+ Just trty -> return trty+ _ -> do+ (trm',ty') <- inferLType gr g trm+ termWith trm' $ checkEqLType gr g typ ty' trm'++ T _ [] ->+ checkError (text "found empty table in type" <+> ppTerm Unqualified 0 typ)+ T _ cs -> case typ of + Table arg val -> do + case allParamValues gr arg of+ Ok vs -> do+ let ps0 = map fst cs+ ps <- testOvershadow ps0 vs+ if null ps + then return () + else checkWarn (text "patterns never reached:" $$+ nest 2 (vcat (map (ppPatt Unqualified 0) ps)))+ _ -> return () -- happens with variable types+ cs' <- mapM (checkCase arg val) cs+ return (T (TTyped arg) cs', typ)+ _ -> checkError $ text "table type expected for table instead of" $$ nest 2 (ppType typ)+ V arg0 vs ->+ case typ of+ Table arg1 val ->+ do arg' <- checkEqLType gr g arg0 arg1 trm+ vs1 <- allParamValues gr arg1+ if length vs1 == length vs+ then return ()+ else checkError $ text "wrong number of values in table" <+> ppTerm Unqualified 0 trm+ vs' <- map fst `fmap` sequence [checkLType gr g v val|v<-vs]+ return (V arg' vs',typ)++ R r -> case typ of --- why needed? because inference may be too difficult+ RecType rr -> do+ let (ls,_) = unzip rr -- labels of expected type+ fsts <- mapM (checkM r) rr -- check that they are found in the record+ return $ (R fsts, typ) -- normalize record++ _ -> checkError (text "record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))++ ExtR r s -> case typ of+ _ | typ == typeType -> do+ trm' <- computeLType gr g trm+ case trm' of+ RecType _ -> termWith trm $ return typeType+ ExtR (Vr _) (RecType _) -> termWith trm $ return typeType + -- ext t = t ** ...+ _ -> checkError (text "invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))++ RecType rr -> do+ (r',ty,s') <- checks [+ do (r',ty) <- inferLType gr g r+ return (r',ty,s)+ ,+ do (s',ty) <- inferLType gr g s+ return (s',ty,r)+ ]++ case ty of+ RecType rr1 -> do+ let (rr0,rr2) = recParts rr rr1+ r2 <- justCheck g r' rr0+ s2 <- justCheck g s' rr2+ return $ (ExtR r2 s2, typ) + _ -> checkError (text "record type expected in extension of" <+> ppTerm Unqualified 0 r $$+ text "but found" <+> ppTerm Unqualified 0 ty)++ ExtR ty ex -> do+ r' <- justCheck g r ty+ s' <- justCheck g s ex+ return $ (ExtR r' s', typ) --- is this all? it assumes the same division in trm and typ++ _ -> checkError (text "record extension not meaningful for" <+> ppTerm Unqualified 0 typ)++ FV vs -> do+ ttys <- mapM (flip (checkLType gr g) typ) vs+--- checkIfComplexVariantType trm typ+ return (FV (map fst ttys), typ) --- typ' ?++ S tab arg -> checks [ do+ (tab',ty) <- inferLType gr g tab+ ty' <- computeLType gr g ty+ case ty' of+ Table p t -> do+ (arg',val) <- checkLType gr g arg p+ checkEqLType gr g typ t trm+ return (S tab' arg', t)+ _ -> checkError (text "table type expected for applied table instead of" <+> ppType ty')+ , do+ (arg',ty) <- inferLType gr g arg+ ty' <- computeLType gr g ty+ (tab',_) <- checkLType gr g tab (Table ty' typ)+ return (S tab' arg', typ)+ ]+ Let (x,(mty,def)) body -> case mty of+ Just ty -> do+ (def',ty') <- checkLType gr g def ty+ body' <- justCheck ((Explicit,x,ty'):g) body typ+ return (Let (x,(Just ty',def')) body', typ)+ _ -> do+ (def',ty) <- inferLType gr g def -- tries to infer type of local constant+ checkLType gr g (Let (x,(Just ty,def')) body) typ++ ELin c tr -> do+ tr1 <- unlockRecord c tr+ checkLType gr g tr1 typ++ _ -> do+ (trm',ty') <- inferLType gr g trm+ termWith trm' $ checkEqLType gr g typ ty' trm'+ where+ justCheck g ty te = checkLType gr g ty te >>= return . fst++ recParts rr t = (RecType rr1,RecType rr2) where + (rr1,rr2) = partition (flip elem (map fst t) . fst) rr ++ checkM rms (l,ty) = case lookup l rms of+ Just (Just ty0,t) -> do+ checkEqLType gr g ty ty0 t+ (t',ty') <- checkLType gr g t ty+ return (l,(Just ty',t'))+ Just (_,t) -> do+ (t',ty') <- checkLType gr g t ty+ return (l,(Just ty',t'))+ _ -> checkError $ + if isLockLabel l + then let cat = drop 5 (showIdent (label2ident l))+ in ppTerm Unqualified 0 (R rms) <+> text "is not in the lincat of" <+> text cat <> + text "; try wrapping it with lin" <+> text cat+ else text "cannot find value for label" <+> ppLabel l <+> text "in" <+> ppTerm Unqualified 0 (R rms)++ checkCase arg val (p,t) = do+ cont <- pattContext gr g arg p+ t' <- justCheck (reverse cont ++ g) t val+ return (p,t')++pattContext :: SourceGrammar -> Context -> Type -> Patt -> Check Context+pattContext env g typ p = case p of+ PV x -> return [(Explicit,x,typ)]+ PP (q,c) ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006+ t <- lookupResType env (q,c)+ let (cont,v) = typeFormCnc t+ checkCond (text "wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p) + (length cont == length ps)+ checkEqLType env g typ v (patt2term p)+ mapM (\((_,_,ty),p) -> pattContext env g ty p) (zip cont ps) >>= return . concat+ PR r -> do+ typ' <- computeLType env g typ+ case typ' of+ RecType t -> do+ let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]+ ----- checkWarn $ prt p ++++ show pts ----- debug+ mapM (uncurry (pattContext env g)) pts >>= return . concat+ _ -> checkError (text "record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')+ PT t p' -> do+ checkEqLType env g typ t (patt2term p')+ pattContext env g typ p'++ PAs x p -> do+ g' <- pattContext env g typ p+ return ((Explicit,x,typ):g')++ PAlt p' q -> do+ g1 <- pattContext env g typ p'+ g2 <- pattContext env g typ q+ let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])+ checkCond + (text "incompatible bindings of" <+>+ fsep (map ppIdent pts) <+> + text "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts) + return g1 -- must be g1 == g2+ PSeq p q -> do+ g1 <- pattContext env g typ p+ g2 <- pattContext env g typ q+ return $ g1 ++ g2+ PRep p' -> noBind typeStr p'+ PNeg p' -> noBind typ p'++ _ -> return [] ---- check types!+ where + noBind typ p' = do+ co <- pattContext env g typ p'+ if not (null co)+ then checkWarn (text "no variable bound inside pattern" <+> ppPatt Unqualified 0 p) + >> return []+ else return []++checkEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check Type+checkEqLType gr g t u trm = do+ (b,t',u',s) <- checkIfEqLType gr g t u trm+ case b of+ True -> return t'+ False -> checkError $ text s <+> text "type of" <+> ppTerm Unqualified 0 trm $$+ text "expected:" <+> ppType t $$+ text "inferred:" <+> ppType u++checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String)+checkIfEqLType gr g t u trm = do+ t' <- computeLType gr g t+ u' <- computeLType gr g u+ case t' == u' || alpha [] t' u' of+ True -> return (True,t',u',[])+ -- forgive missing lock fields by only generating a warning.+ --- better: use a flag to forgive? (AR 31/1/2006)+ _ -> case missingLock [] t' u' of+ Ok lo -> do+ checkWarn $ text "missing lock field" <+> fsep (map ppLabel lo)+ return (True,t',u',[])+ Bad s -> return (False,t',u',s)++ where++ -- t is a subtype of u + --- quick hack version of TC.eqVal+ alpha g t u = case (t,u) of ++ -- error (the empty type!) is subtype of any other type+ (_,u) | u == typeError -> True++ -- contravariance+ (Prod _ x a b, Prod _ y c d) -> alpha g c a && alpha ((x,y):g) b d + + -- record subtyping+ (RecType rs, RecType ts) -> all (\ (l,a) -> + any (\ (k,b) -> alpha g a b && l == k) ts) rs+ (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'+ (ExtR r s, t) -> alpha g r t || alpha g s t++ -- the following say that Ints n is a subset of Int and of Ints m >= n+ (t,u) | Just m <- isTypeInts t, Just n <- isTypeInts t -> m >= n+ | Just _ <- isTypeInts t, u == typeInt -> True ---- check size!+ | t == typeInt, Just _ <- isTypeInts u -> True ---- why this ???? AR 11/12/2005++ ---- this should be made in Rename+ (Q (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)+ || m == n --- for Predef+ (QC (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)+ (QC (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)+ (Q (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)++ (Table a b, Table c d) -> alpha g a c && alpha g b d+ (Vr x, Vr y) -> x == y || elem (x,y) g || elem (y,x) g+ _ -> t == u + --- the following should be one-way coercions only. AR 4/1/2001+ || elem t sTypes && elem u sTypes+ || (t == typeType && u == typePType) + || (u == typeType && t == typePType) ++ missingLock g t u = case (t,u) of + (RecType rs, RecType ts) -> + let + ls = [l | (l,a) <- rs, + not (any (\ (k,b) -> alpha g a b && l == k) ts)]+ (locks,others) = partition isLockLabel ls+ in case others of+ _:_ -> Bad $ render (text "missing record fields:" <+> fsep (punctuate comma (map ppLabel others)))+ _ -> return locks+ -- contravariance+ (Prod _ x a b, Prod _ y c d) -> do+ ls1 <- missingLock g c a+ ls2 <- missingLock g b d+ return $ ls1 ++ ls2++ _ -> Bad ""++ sTypes = [typeStr, typeTok, typeString]++-- auxiliaries++-- | light-weight substitution for dep. types+substituteLType :: Context -> Type -> Check Type+substituteLType g t = case t of+ Vr x -> return $ maybe t id $ lookup x [(x,t) | (_,x,t) <- g]+ _ -> composOp (substituteLType g) t++termWith :: Term -> Check Type -> Check (Term, Type)+termWith t ct = do+ ty <- ct+ return (t,ty)++-- | compositional check\/infer of binary operations+check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> + Term -> Term -> Type -> Check (Term,Type)+check2 chk con a b t = do+ a' <- chk a+ b' <- chk b+ return (con a' b', t)++-- printing a type with a lock field lock_C as C+ppType :: Type -> Doc+ppType ty =+ case ty of+ RecType fs -> case filter isLockLabel $ map fst fs of+ [lock] -> text (drop 5 (showIdent (label2ident lock)))+ _ -> ppTerm Unqualified 0 ty+ Prod _ x a b -> ppType a <+> text "->" <+> ppType b+ _ -> ppTerm Unqualified 0 ty++checkLookup :: Ident -> Context -> Check Type+checkLookup x g =+ case [ty | (b,y,ty) <- g, x == y] of+ [] -> checkError (text "unknown variable" <+> ppIdent x)+ (ty:_) -> return ty+-}
@@ -0,0 +1,792 @@+module GF.Compile.TypeCheck.ConcreteNew( checkLType, inferLType ) where++-- The code here is based on the paper:+-- Simon Peyton Jones, Dimitrios Vytiniotis, Stephanie Weirich.+-- Practical type inference for arbitrary-rank types.+-- 14 September 2011++import GF.Grammar hiding (Env, VGen, VApp, VRecType)+import GF.Grammar.Lookup+import GF.Grammar.Predef+import GF.Grammar.Lockfield+import GF.Compile.Compute.ConcreteNew+import GF.Compile.Compute.Predef(predef,predefName)+import GF.Infra.CheckM+import GF.Data.Operations+import Control.Applicative(Applicative(..))+import Control.Monad(ap,liftM,mplus)+import GF.Text.Pretty+import Data.List (nub, (\\), tails)+import qualified Data.IntMap as IntMap+import Data.Maybe(fromMaybe,isNothing)++checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type)+checkLType ge t ty = runTcM $ do+ vty <- liftErr (eval ge [] ty)+ (t,_) <- tcRho ge [] t (Just vty)+ t <- zonkTerm t+ return (t,ty)++inferLType :: GlobalEnv -> Term -> Check (Term, Type)+inferLType ge t = runTcM $ do+ (t,ty) <- inferSigma ge [] t+ t <- zonkTerm t+ ty <- zonkTerm =<< tc_value2term (geLoc ge) [] ty+ return (t,ty)++inferSigma :: GlobalEnv -> Scope -> Term -> TcM (Term,Sigma)+inferSigma ge scope t = do -- GEN1+ (t,ty) <- tcRho ge scope t Nothing+ env_tvs <- getMetaVars (geLoc ge) (scopeTypes scope)+ res_tvs <- getMetaVars (geLoc ge) [(scope,ty)]+ let forall_tvs = res_tvs \\ env_tvs+ quantify ge scope t forall_tvs ty++Just vtypeInt = fmap (flip VApp []) (predef cInt)+Just vtypeFloat = fmap (flip VApp []) (predef cFloat)+Just vtypeInts = fmap (\p i -> VApp p [VInt i]) (predef cInts)+vtypeStr = VSort cStr+vtypeStrs = VSort cStrs+vtypeType = VSort cType+vtypePType = VSort cPType++tcRho :: GlobalEnv -> Scope -> Term -> Maybe Rho -> TcM (Term, Rho)+tcRho ge scope t@(EInt i) mb_ty = instSigma ge scope t (vtypeInts i) mb_ty -- INT+tcRho ge scope t@(EFloat _) mb_ty = instSigma ge scope t vtypeFloat mb_ty -- FLOAT+tcRho ge scope t@(K _) mb_ty = instSigma ge scope t vtypeStr mb_ty -- STR+tcRho ge scope t@(Empty) mb_ty = instSigma ge scope t vtypeStr mb_ty+tcRho ge scope t@(Vr v) mb_ty = do -- VAR+ case lookup v scope of+ Just v_sigma -> instSigma ge scope t v_sigma mb_ty+ Nothing -> tcError ("Unknown variable" <+> v)+tcRho ge scope t@(Q id) mb_ty =+ runTcA (tcOverloadFailed t) $+ tcApp ge scope t `bindTcA` \(t,ty) ->+ instSigma ge scope t ty mb_ty+tcRho ge scope t@(QC id) mb_ty =+ runTcA (tcOverloadFailed t) $+ tcApp ge scope t `bindTcA` \(t,ty) ->+ instSigma ge scope t ty mb_ty+tcRho ge scope t@(App fun arg) mb_ty = do+ runTcA (tcOverloadFailed t) $+ tcApp ge scope t `bindTcA` \(t,ty) ->+ instSigma ge scope t ty mb_ty+tcRho ge scope (Abs bt var body) Nothing = do -- ABS1+ i <- newMeta scope vtypeType+ let arg_ty = VMeta i (scopeEnv scope) []+ (body,body_ty) <- tcRho ge ((var,arg_ty):scope) body Nothing+ return (Abs bt var body, (VProd bt arg_ty identW (Bind (const body_ty))))+tcRho ge scope t@(Abs Implicit var body) (Just ty) = do -- ABS2+ (bt, var_ty, body_ty) <- unifyFun ge scope ty+ if bt == Implicit+ then return ()+ else tcError (ppTerm Unqualified 0 t <+> "is an implicit function, but no implicit function is expected")+ (body, body_ty) <- tcRho ge ((var,var_ty):scope) body (Just (body_ty (VGen (length scope) [])))+ return (Abs Implicit var body,ty)+tcRho ge scope (Abs Explicit var body) (Just ty) = do -- ABS3+ (scope,f,ty') <- skolemise ge scope ty+ (_,var_ty,body_ty) <- unifyFun ge scope ty'+ (body, body_ty) <- tcRho ge ((var,var_ty):scope) body (Just (body_ty (VGen (length scope) [])))+ return (f (Abs Explicit var body),ty)+tcRho ge scope (Let (var, (mb_ann_ty, rhs)) body) mb_ty = do -- LET+ (rhs,var_ty) <- case mb_ann_ty of+ Nothing -> inferSigma ge scope rhs+ Just ann_ty -> do (ann_ty, _) <- tcRho ge scope ann_ty (Just vtypeType)+ v_ann_ty <- liftErr (eval ge (scopeEnv scope) ann_ty)+ (rhs,_) <- tcRho ge scope rhs (Just v_ann_ty)+ return (rhs, v_ann_ty)+ (body, body_ty) <- tcRho ge ((var,var_ty):scope) body mb_ty+ var_ty <- tc_value2term (geLoc ge) (scopeVars scope) var_ty+ return (Let (var, (Just var_ty, rhs)) body, body_ty)+tcRho ge scope (Typed body ann_ty) mb_ty = do -- ANNOT+ (ann_ty, _) <- tcRho ge scope ann_ty (Just vtypeType)+ v_ann_ty <- liftErr (eval ge (scopeEnv scope) ann_ty)+ (body,_) <- tcRho ge scope body (Just v_ann_ty)+ instSigma ge scope (Typed body ann_ty) v_ann_ty mb_ty+tcRho ge scope (FV ts) mb_ty = do+ case ts of+ [] -> do i <- newMeta scope vtypeType+ instSigma ge scope (FV []) (VMeta i (scopeEnv scope) []) mb_ty+ (t:ts) -> do (t,ty) <- tcRho ge scope t mb_ty++ let go [] ty = return ([],ty)+ go (t:ts) ty = do (t, ty) <- tcRho ge scope t (Just ty)+ (ts,ty) <- go ts ty+ return (t:ts,ty)++ (ts,ty) <- go ts ty+ return (FV (t:ts), ty)+tcRho ge scope t@(Sort s) mb_ty = do+ instSigma ge scope t vtypeType mb_ty+tcRho ge scope t@(RecType rs) Nothing = do+ (rs,mb_ty) <- tcRecTypeFields ge scope rs Nothing+ return (RecType rs,fromMaybe vtypePType mb_ty)+tcRho ge scope t@(RecType rs) (Just ty) = do+ (scope,f,ty') <- skolemise ge scope ty+ case ty' of+ VSort s+ | s == cType -> return ()+ | s == cPType -> return ()+ VMeta i env vs -> case rs of+ [] -> unifyVar ge scope i env vs vtypePType+ _ -> return ()+ ty -> do ty <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) ty+ tcError ("The record type" <+> ppTerm Unqualified 0 t $$ + "cannot be of type" <+> ppTerm Unqualified 0 ty)+ (rs,mb_ty) <- tcRecTypeFields ge scope rs (Just ty')+ return (f (RecType rs),ty)+tcRho ge scope t@(Table p res) mb_ty = do+ (p, p_ty) <- tcRho ge scope p (Just vtypePType)+ (res,res_ty) <- tcRho ge scope res (Just vtypeType)+ instSigma ge scope (Table p res) vtypeType mb_ty+tcRho ge scope (Prod bt x ty1 ty2) mb_ty = do+ (ty1,ty1_ty) <- tcRho ge scope ty1 (Just vtypeType)+ vty1 <- liftErr (eval ge (scopeEnv scope) ty1)+ (ty2,ty2_ty) <- tcRho ge ((x,vty1):scope) ty2 (Just vtypeType)+ instSigma ge scope (Prod bt x ty1 ty2) vtypeType mb_ty+tcRho ge scope (S t p) mb_ty = do+ p_ty <- fmap (\i -> VMeta i (scopeEnv scope) []) $ newMeta scope vtypePType+ res_ty <- case mb_ty of+ Nothing -> fmap (\i -> VMeta i (scopeEnv scope) []) $ newMeta scope vtypeType+ Just ty -> return ty+ let t_ty = VTblType p_ty res_ty+ (t,t_ty) <- tcRho ge scope t (Just t_ty)+ (p,_) <- tcRho ge scope p (Just p_ty)+ return (S t p, res_ty)+tcRho ge scope (T tt ps) Nothing = do -- ABS1/AABS1 for tables+ p_ty <- case tt of+ TRaw -> fmap (\i -> VMeta i (scopeEnv scope) []) $ newMeta scope vtypePType+ TTyped ty -> do (ty, _) <- tcRho ge scope ty (Just vtypeType)+ liftErr (eval ge (scopeEnv scope) ty)+ (ps,mb_res_ty) <- tcCases ge scope ps p_ty Nothing+ res_ty <- case mb_res_ty of+ Just res_ty -> return res_ty+ Nothing -> fmap (\i -> VMeta i (scopeEnv scope) []) $ newMeta scope vtypeType+ p_ty_t <- tc_value2term (geLoc ge) [] p_ty+ return (T (TTyped p_ty_t) ps, VTblType p_ty res_ty)+tcRho ge scope (T tt ps) (Just ty) = do -- ABS2/AABS2 for tables+ (scope,f,ty') <- skolemise ge scope ty+ (p_ty, res_ty) <- unifyTbl ge scope ty'+ case tt of+ TRaw -> return ()+ TTyped ty -> do (ty, _) <- tcRho ge scope ty (Just vtypeType)+ return ()--subsCheckRho ge scope -> Term ty res_ty+ (ps,Just res_ty) <- tcCases ge scope ps p_ty (Just res_ty)+ p_ty_t <- tc_value2term (geLoc ge) [] p_ty+ return (f (T (TTyped p_ty_t) ps), VTblType p_ty res_ty)+tcRho ge scope (R rs) Nothing = do+ lttys <- inferRecFields ge scope rs+ rs <- mapM (\(l,t,ty) -> tc_value2term (geLoc ge) (scopeVars scope) ty >>= \ty -> return (l, (Just ty, t))) lttys+ return (R rs,+ VRecType [(l, ty) | (l,t,ty) <- lttys]+ )+tcRho ge scope (R rs) (Just ty) = do+ (scope,f,ty') <- skolemise ge scope ty+ case ty' of+ (VRecType ltys) -> do lttys <- checkRecFields ge scope rs ltys+ rs <- mapM (\(l,t,ty) -> tc_value2term (geLoc ge) (scopeVars scope) ty >>= \ty -> return (l, (Just ty, t))) lttys+ return ((f . R) rs, + VRecType [(l, ty) | (l,t,ty) <- lttys]+ )+ ty -> do lttys <- inferRecFields ge scope rs+ t <- liftM (f . R) (mapM (\(l,t,ty) -> tc_value2term (geLoc ge) (scopeVars scope) ty >>= \ty -> return (l, (Just ty, t))) lttys)+ let ty' = VRecType [(l, ty) | (l,t,ty) <- lttys]+ t <- subsCheckRho ge scope t ty' ty+ return (t, ty')+tcRho ge scope (P t l) mb_ty = do+ l_ty <- case mb_ty of+ Just ty -> return ty+ Nothing -> do i <- newMeta scope vtypeType+ return (VMeta i (scopeEnv scope) [])+ (t,t_ty) <- tcRho ge scope t (Just (VRecType [(l,l_ty)]))+ return (P t l,l_ty)+tcRho ge scope (C t1 t2) mb_ty = do+ (t1,t1_ty) <- tcRho ge scope t1 (Just vtypeStr)+ (t2,t2_ty) <- tcRho ge scope t2 (Just vtypeStr)+ instSigma ge scope (C t1 t2) vtypeStr mb_ty+tcRho ge scope (Glue t1 t2) mb_ty = do+ (t1,t1_ty) <- tcRho ge scope t1 (Just vtypeStr)+ (t2,t2_ty) <- tcRho ge scope t2 (Just vtypeStr)+ instSigma ge scope (Glue t1 t2) vtypeStr mb_ty+tcRho ge scope t@(ExtR t1 t2) mb_ty = do+ (t1,t1_ty) <- tcRho ge scope t1 Nothing+ (t2,t2_ty) <- tcRho ge scope t2 Nothing+ case (t1_ty,t2_ty) of+ (VSort s1,VSort s2)+ | (s1 == cType || s1 == cPType) &&+ (s2 == cType || s2 == cPType) -> let sort | s1 == cPType && s2 == cPType = cPType+ | otherwise = cType+ in instSigma ge scope (ExtR t1 t2) (VSort sort) mb_ty+ (VRecType rs1, VRecType rs2) -> instSigma ge scope (ExtR t1 t2) (VRecType (rs2++rs1)) mb_ty+ _ -> tcError ("Cannot type check" <+> ppTerm Unqualified 0 t)+tcRho ge scope (ELin cat t) mb_ty = do -- this could be done earlier, i.e. in the parser+ tcRho ge scope (ExtR t (R [(lockLabel cat,(Just (RecType []),R []))])) mb_ty+tcRho ge scope (ELincat cat t) mb_ty = do -- this could be done earlier, i.e. in the parser+ tcRho ge scope (ExtR t (RecType [(lockLabel cat,RecType [])])) mb_ty+tcRho ge scope (Alts t ss) mb_ty = do+ (t,_) <- tcRho ge scope t (Just vtypeStr)+ ss <- flip mapM ss $ \(t1,t2) -> do+ (t1,_) <- tcRho ge scope t1 (Just vtypeStr)+ (t2,_) <- tcRho ge scope t2 (Just vtypeStrs)+ return (t1,t2)+ instSigma ge scope (Alts t ss) vtypeStr mb_ty+tcRho ge scope (Strs ss) mb_ty = do+ ss <- flip mapM ss $ \t -> do+ (t,_) <- tcRho ge scope t (Just vtypeStr)+ return t+ instSigma ge scope (Strs ss) vtypeStrs mb_ty+tcRho ge scope (EPattType ty) mb_ty = do+ (ty, _) <- tcRho ge scope ty (Just vtypeType)+ instSigma ge scope (EPattType ty) vtypeType mb_ty+tcRho ge scope t@(EPatt p) mb_ty = do+ (scope,f,ty) <- case mb_ty of+ Nothing -> do i <- newMeta scope vtypeType+ return (scope,id,VMeta i (scopeEnv scope) [])+ Just ty -> do (scope,f,ty) <- skolemise ge scope ty+ case ty of+ VPattType ty -> return (scope,f,ty)+ _ -> tcError (ppTerm Unqualified 0 t <+> "must be of pattern type but" <+> ppTerm Unqualified 0 t <+> "is expected")+ tcPatt ge scope p ty+ return (f (EPatt p), ty)+tcRho gr scope t _ = unimplemented ("tcRho "++show t)++tcCases ge scope [] p_ty mb_res_ty = return ([],mb_res_ty)+tcCases ge scope ((p,t):cs) p_ty mb_res_ty = do+ scope' <- tcPatt ge scope p p_ty+ (t,res_ty) <- tcRho ge scope' t mb_res_ty+ (cs,mb_res_ty) <- tcCases ge scope cs p_ty (Just res_ty)+ return ((p,t):cs,mb_res_ty)+++tcApp ge scope t@(App fun (ImplArg arg)) = do -- APP1+ tcApp ge scope fun `bindTcA` \(fun,fun_ty) ->+ do (bt, arg_ty, res_ty) <- unifyFun ge scope fun_ty+ if (bt == Implicit)+ then return ()+ else tcError (ppTerm Unqualified 0 t <+> "is an implicit argument application, but no implicit argument is expected")+ (arg,_) <- tcRho ge scope arg (Just arg_ty)+ varg <- liftErr (eval ge (scopeEnv scope) arg)+ return (App fun (ImplArg arg), res_ty varg)+tcApp ge scope (App fun arg) = -- APP2+ tcApp ge scope fun `bindTcA` \(fun,fun_ty) ->+ do (fun,fun_ty) <- instantiate scope fun fun_ty+ (_, arg_ty, res_ty) <- unifyFun ge scope fun_ty+ (arg,_) <- tcRho ge scope arg (Just arg_ty)+ varg <- liftErr (eval ge (scopeEnv scope) arg)+ return (App fun arg, res_ty varg)+tcApp ge scope (Q id) = -- VAR (global)+ mkTcA (lookupOverloadTypes (geGrammar ge) id) `bindTcA` \(t,ty) -> + do ty <- liftErr (eval ge [] ty)+ return (t,ty)+tcApp ge scope (QC id) = -- VAR (global)+ mkTcA (lookupOverloadTypes (geGrammar ge) id) `bindTcA` \(t,ty) -> + do ty <- liftErr (eval ge [] ty)+ return (t,ty)+tcApp ge scope t =+ singleTcA (tcRho ge scope t Nothing)+++tcOverloadFailed t ttys =+ tcError ("Overload resolution failed" $$+ "of term " <+> pp t $$+ "with types" <+> vcat [ppTerm Terse 0 ty | (_,ty) <- ttys])+++tcPatt ge scope PW ty0 =+ return scope+tcPatt ge scope (PV x) ty0 =+ return ((x,ty0):scope)+tcPatt ge scope (PP c ps) ty0 =+ case lookupResType (geGrammar ge) c of+ Ok ty -> do let go scope ty [] = return (scope,ty)+ go scope ty (p:ps) = do (_,arg_ty,res_ty) <- unifyFun ge scope ty+ scope <- tcPatt ge scope p arg_ty+ go scope (res_ty (VGen (length scope) [])) ps+ vty <- liftErr (eval ge [] ty)+ (scope,ty) <- go scope vty ps+ unify ge scope ty0 ty+ return scope+ Bad err -> tcError (pp err)+tcPatt ge scope (PInt i) ty0 = do+ subsCheckRho ge scope (EInt i) (vtypeInts i) ty0+ return scope+tcPatt ge scope (PString s) ty0 = do+ unify ge scope ty0 vtypeStr+ return scope+tcPatt ge scope PChar ty0 = do+ unify ge scope ty0 vtypeStr+ return scope+tcPatt ge scope (PSeq p1 p2) ty0 = do+ unify ge scope ty0 vtypeStr+ scope <- tcPatt ge scope p1 vtypeStr+ scope <- tcPatt ge scope p2 vtypeStr+ return scope+tcPatt ge scope (PAs x p) ty0 = do+ tcPatt ge ((x,ty0):scope) p ty0+tcPatt ge scope (PR rs) ty0 = do+ let mk_ltys [] = return []+ mk_ltys ((l,p):rs) = do i <- newMeta scope vtypePType+ ltys <- mk_ltys rs+ return ((l,p,VMeta i (scopeEnv scope) []) : ltys)+ go scope [] = return scope+ go scope ((l,p,ty):rs) = do scope <- tcPatt ge scope p ty+ go scope rs+ ltys <- mk_ltys rs+ subsCheckRho ge scope (EPatt (PR rs)) (VRecType [(l,ty) | (l,p,ty) <- ltys]) ty0+ go scope ltys+tcPatt ge scope (PAlt p1 p2) ty0 = do+ tcPatt ge scope p1 ty0+ tcPatt ge scope p2 ty0+ return scope+tcPatt ge scope (PM q) ty0 = do+ case lookupResType (geGrammar ge) q of+ Ok (EPattType ty)+ -> do vty <- liftErr (eval ge [] ty)+ unify ge scope ty0 vty+ return scope+ Ok ty -> tcError ("Pattern type expected but " <+> pp ty <+> " found.")+ Bad err -> tcError (pp err)+tcPatt ge scope p ty = unimplemented ("tcPatt "++show p)++inferRecFields ge scope rs = + mapM (\(l,r) -> tcRecField ge scope l r Nothing) rs++checkRecFields ge scope [] ltys+ | null ltys = return []+ | otherwise = tcError ("Missing fields:" <+> hsep (map fst ltys))+checkRecFields ge scope ((l,t):lts) ltys =+ case takeIt l ltys of+ (Just ty,ltys) -> do ltty <- tcRecField ge scope l t (Just ty)+ lttys <- checkRecFields ge scope lts ltys+ return (ltty : lttys)+ (Nothing,ltys) -> do tcWarn ("Discarded field:" <+> l)+ ltty <- tcRecField ge scope l t Nothing+ lttys <- checkRecFields ge scope lts ltys+ return lttys -- ignore the field+ where+ takeIt l1 [] = (Nothing, [])+ takeIt l1 (lty@(l2,ty):ltys)+ | l1 == l2 = (Just ty,ltys) + | otherwise = let (mb_ty,ltys') = takeIt l1 ltys+ in (mb_ty,lty:ltys')++tcRecField ge scope l (mb_ann_ty,t) mb_ty = do+ (t,ty) <- case mb_ann_ty of+ Just ann_ty -> do (ann_ty, _) <- tcRho ge scope ann_ty (Just vtypeType)+ v_ann_ty <- liftErr (eval ge (scopeEnv scope) ann_ty)+ (t,_) <- tcRho ge scope t (Just v_ann_ty)+ instSigma ge scope t v_ann_ty mb_ty+ Nothing -> tcRho ge scope t mb_ty+ return (l,t,ty)++tcRecTypeFields ge scope [] mb_ty = return ([],mb_ty)+tcRecTypeFields ge scope ((l,ty):rs) mb_ty = do+ (ty,sort) <- tcRho ge scope ty mb_ty+ mb_ty <- case sort of+ VSort s+ | s == cType -> return (Just sort)+ | s == cPType -> return mb_ty+ VMeta _ _ _ -> return mb_ty+ _ -> do sort <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) sort+ tcError ("The record type field" <+> l <+> ':' <+> ppTerm Unqualified 0 ty $$ + "cannot be of type" <+> ppTerm Unqualified 0 sort)+ (rs,mb_ty) <- tcRecTypeFields ge scope rs mb_ty+ return ((l,ty):rs,mb_ty)++-- | Invariant: if the third argument is (Just rho),+-- then rho is in weak-prenex form+instSigma :: GlobalEnv -> Scope -> Term -> Sigma -> Maybe Rho -> TcM (Term, Rho)+instSigma ge scope t ty1 Nothing = return (t,ty1) -- INST1+instSigma ge scope t ty1 (Just ty2) = do -- INST2+ t <- subsCheckRho ge scope t ty1 ty2+ return (t,ty2)++-- | Invariant: the second argument is in weak-prenex form+subsCheckRho :: GlobalEnv -> Scope -> Term -> Sigma -> Rho -> TcM Term+subsCheckRho ge scope t ty1@(VMeta i env vs) ty2 = do+ mv <- getMeta i+ case mv of+ Unbound _ _ -> do unify ge scope ty1 ty2+ return t+ Bound ty1 -> do vty1 <- liftErr (eval ge env ty1)+ subsCheckRho ge scope t (vapply (geLoc ge) vty1 vs) ty2+subsCheckRho ge scope t ty1 ty2@(VMeta i env vs) = do+ mv <- getMeta i+ case mv of+ Unbound _ _ -> do unify ge scope ty1 ty2+ return t+ Bound ty2 -> do vty2 <- liftErr (eval ge env ty2)+ subsCheckRho ge scope t ty1 (vapply (geLoc ge) vty2 vs)+subsCheckRho ge scope t (VProd Implicit ty1 x (Bind ty2)) rho2 = do -- Rule SPEC+ i <- newMeta scope ty1+ subsCheckRho ge scope (App t (ImplArg (Meta i))) (ty2 (VMeta i [] [])) rho2+subsCheckRho ge scope t rho1 (VProd Implicit ty1 x (Bind ty2)) = do -- Rule SKOL+ let v = newVar scope+ t <- subsCheckRho ge ((v,ty1):scope) t rho1 (ty2 (VGen (length scope) []))+ return (Abs Implicit v t)+subsCheckRho ge scope t rho1 (VProd Explicit a2 _ (Bind r2)) = do -- Rule FUN+ (_,a1,r1) <- unifyFun ge scope rho1+ subsCheckFun ge scope t a1 r1 a2 r2+subsCheckRho ge scope t (VProd Explicit a1 _ (Bind r1)) rho2 = do -- Rule FUN+ (bt,a2,r2) <- unifyFun ge scope rho2+ subsCheckFun ge scope t a1 r1 a2 r2+subsCheckRho ge scope t rho1 (VTblType p2 r2) = do -- Rule TABLE+ (p1,r1) <- unifyTbl ge scope rho1+ subsCheckTbl ge scope t p1 r1 p2 r2+subsCheckRho ge scope t (VTblType p1 r1) rho2 = do -- Rule TABLE+ (p2,r2) <- unifyTbl ge scope rho2+ subsCheckTbl ge scope t p1 r1 p2 r2+subsCheckRho ge scope t (VSort s1) (VSort s2) -- Rule PTYPE+ | s1 == cPType && s2 == cType = return t+subsCheckRho ge scope t (VApp p1 _) (VApp p2 _) -- Rule INT1+ | predefName p1 == cInts && predefName p2 == cInt = return t+subsCheckRho ge scope t (VApp p1 [VInt i]) (VApp p2 [VInt j]) -- Rule INT2+ | predefName p1 == cInts && predefName p2 == cInts =+ if i <= j + then return t+ else tcError ("Ints" <+> i <+> "is not a subtype of" <+> "Ints" <+> j)+subsCheckRho ge scope t ty1@(VRecType rs1) ty2@(VRecType rs2) = do -- Rule REC+ let mkAccess scope t = + case t of+ ExtR t1 t2 -> do (scope,mkProj1,mkWrap1) <- mkAccess scope t1+ (scope,mkProj2,mkWrap2) <- mkAccess scope t2+ return (scope+ ,\l -> mkProj2 l `mplus` mkProj1 l+ ,mkWrap1 . mkWrap2+ )+ R rs -> do sequence_ [tcWarn ("Discarded field:" <+> l) | (l,_) <- rs, isNothing (lookup l rs2)]+ return (scope+ ,\l -> lookup l rs+ ,id+ )+ Vr x -> do return (scope+ ,\l -> do VRecType rs <- lookup x scope+ ty <- lookup l rs+ return (Nothing,P t l)+ ,id+ )+ t -> let x = newVar scope+ in return (((x,ty1):scope)+ ,\l -> return (Nothing,P (Vr x) l)+ ,Let (x, (Nothing, t))+ )++ mkField scope l (mb_ty,t) ty1 ty2 = do+ t <- subsCheckRho ge scope t ty1 ty2+ return (l, (mb_ty,t))++ (scope,mkProj,mkWrap) <- mkAccess scope t++ let fields = [(l,ty2,lookup l rs1) | (l,ty2) <- rs2]+ case [l | (l,_,Nothing) <- fields] of+ [] -> return ()+ missing -> tcError ("In the term" <+> pp t $$+ "there are no values for fields:" <+> hsep missing)+ rs <- sequence [mkField scope l t ty1 ty2 | (l,ty2,Just ty1) <- fields, Just t <- [mkProj l]]+ return (mkWrap (R rs))+subsCheckRho ge scope t tau1 tau2 = do -- Rule EQ+ unify ge scope tau1 tau2 -- Revert to ordinary unification+ return t++subsCheckFun :: GlobalEnv -> Scope -> Term -> Sigma -> (Value -> Rho) -> Sigma -> (Value -> Rho) -> TcM Term+subsCheckFun ge scope t a1 r1 a2 r2 = do+ let v = newVar scope+ vt <- subsCheckRho ge ((v,a2):scope) (Vr v) a2 a1+ val1 <- liftErr (eval ge (scopeEnv ((v,vtypeType):scope)) vt)+ val2 <- return (VGen (length scope) [])+ t <- subsCheckRho ge ((v,vtypeType):scope) (App t vt) (r1 val1) (r2 val2)+ return (Abs Explicit v t)++subsCheckTbl :: GlobalEnv -> Scope -> Term -> Sigma -> Rho -> Sigma -> Rho -> TcM Term+subsCheckTbl ge scope t p1 r1 p2 r2 = do+ let x = newVar scope+ xt <- subsCheckRho ge scope (Vr x) p2 p1+ t <- subsCheckRho ge ((x,vtypePType):scope) (S t xt) r1 r2 ;+ p2 <- tc_value2term (geLoc ge) (scopeVars scope) p2+ return (T (TTyped p2) [(PV x,t)])++-----------------------------------------------------------------------+-- Unification+-----------------------------------------------------------------------++unifyFun :: GlobalEnv -> Scope -> Rho -> TcM (BindType, Sigma, Value -> Rho)+unifyFun ge scope (VProd bt arg x (Bind res)) =+ return (bt,arg,res)+unifyFun ge scope tau = do+ let mk_val ty = VMeta ty [] []+ arg <- fmap mk_val $ newMeta scope vtypeType+ res <- fmap mk_val $ newMeta scope vtypeType+ let bt = Explicit+ unify ge scope tau (VProd bt arg identW (Bind (const res)))+ return (bt,arg,const res)++unifyTbl :: GlobalEnv -> Scope -> Rho -> TcM (Sigma, Rho)+unifyTbl ge scope (VTblType arg res) =+ return (arg,res)+unifyTbl ge scope tau = do+ let mk_val ty = VMeta ty (scopeEnv scope) []+ arg <- fmap mk_val $ newMeta scope vtypePType+ res <- fmap mk_val $ newMeta scope vtypeType+ unify ge scope tau (VTblType arg res)+ return (arg,res)++unify ge scope (VApp f1 vs1) (VApp f2 vs2)+ | f1 == f2 = sequence_ (zipWith (unify ge scope) vs1 vs2)+unify ge scope (VCApp f1 vs1) (VCApp f2 vs2)+ | f1 == f2 = sequence_ (zipWith (unify ge scope) vs1 vs2)+unify ge scope (VSort s1) (VSort s2)+ | s1 == s2 = return ()+unify ge scope (VGen i vs1) (VGen j vs2)+ | i == j = sequence_ (zipWith (unify ge scope) vs1 vs2)+unify ge scope (VTblType p1 res1) (VTblType p2 res2) = do+ unify ge scope p1 p2+ unify ge scope res1 res2+unify ge scope (VMeta i env1 vs1) (VMeta j env2 vs2)+ | i == j = sequence_ (zipWith (unify ge scope) vs1 vs2)+ | otherwise = do mv <- getMeta j+ case mv of+ Bound t2 -> do v2 <- liftErr (eval ge env2 t2)+ unify ge scope (VMeta i env1 vs1) (vapply (geLoc ge) v2 vs2)+ Unbound _ _ -> setMeta i (Bound (Meta j))+unify ge scope (VInt i) (VInt j)+ | i == j = return ()+unify ge scope (VMeta i env vs) v = unifyVar ge scope i env vs v+unify ge scope v (VMeta i env vs) = unifyVar ge scope i env vs v+unify ge scope v1 v2 = do+ t1 <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) v1+ t2 <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) v2+ tcError ("Cannot unify terms:" <+> (ppTerm Unqualified 0 t1 $$ + ppTerm Unqualified 0 t2))++-- | Invariant: tv1 is a flexible type variable+unifyVar :: GlobalEnv -> Scope -> MetaId -> Env -> [Value] -> Tau -> TcM ()+unifyVar ge scope i env vs ty2 = do -- Check whether i is bound+ mv <- getMeta i+ case mv of+ Bound ty1 -> do v <- liftErr (eval ge env ty1)+ unify ge scope (vapply (geLoc ge) v vs) ty2+ Unbound scope' _ -> case value2term (geLoc ge) (scopeVars scope') ty2 of+ Left i -> let (v,_) = reverse scope !! i+ in tcError ("Variable" <+> pp v <+> "has escaped")+ Right ty2' -> do ms2 <- getMetaVars (geLoc ge) [(scope,ty2)]+ if i `elem` ms2+ then tcError ("Occurs check for" <+> ppMeta i <+> "in:" $$+ nest 2 (ppTerm Unqualified 0 ty2'))+ else setMeta i (Bound ty2')++-----------------------------------------------------------------------+-- Instantiation and quantification+-----------------------------------------------------------------------++-- | Instantiate the topmost implicit arguments with metavariables+instantiate :: Scope -> Term -> Sigma -> TcM (Term,Rho)+instantiate scope t (VProd Implicit ty1 x (Bind ty2)) = do+ i <- newMeta scope ty1+ instantiate scope (App t (ImplArg (Meta i))) (ty2 (VMeta i [] []))+instantiate scope t ty = do+ return (t,ty)++-- | Build fresh lambda abstractions for the topmost implicit arguments+skolemise :: GlobalEnv -> Scope -> Sigma -> TcM (Scope, Term->Term, Rho)+skolemise ge scope ty@(VMeta i env vs) = do+ mv <- getMeta i+ case mv of+ Unbound _ _ -> return (scope,id,ty) -- guarded constant?+ Bound ty -> do vty <- liftErr (eval ge env ty)+ skolemise ge scope (vapply (geLoc ge) vty vs)+skolemise ge scope (VProd Implicit ty1 x (Bind ty2)) = do+ let v = newVar scope+ (scope,f,ty2) <- skolemise ge ((v,ty1):scope) (ty2 (VGen (length scope) []))+ return (scope,Abs Implicit v . f,ty2)+skolemise ge scope ty = do+ return (scope,id,ty)++-- | Quantify over the specified type variables (all flexible)+quantify :: GlobalEnv -> Scope -> Term -> [MetaId] -> Rho -> TcM (Term,Sigma)+quantify ge scope t tvs ty0 = do+ ty <- tc_value2term (geLoc ge) (scopeVars scope) ty0+ let used_bndrs = nub (bndrs ty) -- Avoid quantified type variables in use+ new_bndrs = take (length tvs) (allBinders \\ used_bndrs)+ mapM_ bind (tvs `zip` new_bndrs) -- 'bind' is just a cunning way + ty <- zonkTerm ty -- of doing the substitution+ vty <- liftErr (eval ge [] (foldr (\v ty -> Prod Implicit v typeType ty) ty new_bndrs))+ return (foldr (Abs Implicit) t new_bndrs,vty)+ where+ bind (i, name) = setMeta i (Bound (Vr name))++ bndrs (Prod _ x t1 t2) = [x] ++ bndrs t1 ++ bndrs t2+ bndrs _ = []++allBinders :: [Ident] -- a,b,..z, a1, b1,... z1, a2, b2,... +allBinders = [ identS [x] | x <- ['a'..'z'] ] +++ [ identS (x : show i) | i <- [1 :: Integer ..], x <- ['a'..'z']]+++-----------------------------------------------------------------------+-- The Monad+-----------------------------------------------------------------------++type Scope = [(Ident,Value)]++type Sigma = Value+type Rho = Value -- No top-level ForAll+type Tau = Value -- No ForAlls anywhere++data MetaValue+ = Unbound Scope Sigma+ | Bound Term+type MetaStore = IntMap.IntMap MetaValue+data TcResult a+ = TcOk a MetaStore [Message]+ | TcFail [Message] -- First msg is error, the rest are warnings?+newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}++instance Monad TcM where+ return x = TcM (\ms msgs -> TcOk x ms msgs)+ f >>= g = TcM (\ms msgs -> case unTcM f ms msgs of+ TcOk x ms msgs -> unTcM (g x) ms msgs+ TcFail msgs -> TcFail msgs)+ fail = tcError . pp++instance Applicative TcM where+ pure = return+ (<*>) = ap++instance Functor TcM where+ fmap f g = TcM (\ms msgs -> case unTcM g ms msgs of+ TcOk x ms msgs -> TcOk (f x) ms msgs+ TcFail msgs -> TcFail msgs)++instance ErrorMonad TcM where+ raise = tcError . pp+ handle f g = TcM (\ms msgs -> case unTcM f ms msgs of+ TcFail (msg:msgs) -> unTcM (g (render msg)) ms msgs+ r -> r)++tcError :: Message -> TcM a+tcError msg = TcM (\ms msgs -> TcFail (msg : msgs))++tcWarn :: Message -> TcM ()+tcWarn msg = TcM (\ms msgs -> TcOk () ms (msg : msgs))++unimplemented str = fail ("Unimplemented: "++str)+++runTcM :: TcM a -> Check a+runTcM f = case unTcM f IntMap.empty [] of+ TcOk x _ msgs -> do checkWarnings msgs; return x+ TcFail (msg:msgs) -> do checkWarnings msgs; checkError msg++newMeta :: Scope -> Sigma -> TcM MetaId+newMeta scope ty = TcM (\ms msgs -> + let i = IntMap.size ms+ in TcOk i (IntMap.insert i (Unbound scope ty) ms) msgs)++getMeta :: MetaId -> TcM MetaValue+getMeta i = TcM (\ms msgs -> + case IntMap.lookup i ms of+ Just mv -> TcOk mv ms msgs+ Nothing -> TcFail (("Unknown metavariable" <+> ppMeta i) : msgs))++setMeta :: MetaId -> MetaValue -> TcM ()+setMeta i mv = TcM (\ms msgs -> TcOk () (IntMap.insert i mv ms) msgs)++newVar :: Scope -> Ident+newVar scope = head [x | i <- [1..], + let x = identS ('v':show i),+ isFree scope x]+ where+ isFree [] x = True+ isFree ((y,_):scope) x = x /= y && isFree scope x++scopeEnv scope = zipWith (\(x,ty) i -> (x,VGen i [])) (reverse scope) [0..]+scopeVars scope = map fst scope+scopeTypes scope = zipWith (\(_,ty) scope -> (scope,ty)) scope (tails scope)++-- | This function takes account of zonking, and returns a set+-- (no duplicates) of unbound meta-type variables+getMetaVars :: GLocation -> [(Scope,Sigma)] -> TcM [MetaId]+getMetaVars loc sc_tys = do+ tys <- mapM (\(scope,ty) -> zonkTerm =<< tc_value2term loc (scopeVars scope) ty) sc_tys+ return (foldr go [] tys)+ where+ -- Get the MetaIds from a term; no duplicates in result+ go (Vr tv) acc = acc + go (App x y) acc = go x (go y acc)+ go (Meta i) acc+ | i `elem` acc = acc+ | otherwise = i : acc+ go (Q _) acc = acc+ go (QC _) acc = acc+ go (Sort _) acc = acc+ go (Prod _ _ arg res) acc = go arg (go res acc)+ go (Table p t) acc = go p (go t acc)+ go (RecType rs) acc = foldl (\acc (l,ty) -> go ty acc) acc rs+ go t acc = unimplemented ("go "++show t)++-- | This function takes account of zonking, and returns a set+-- (no duplicates) of free type variables+getFreeVars :: GLocation -> [(Scope,Sigma)] -> TcM [Ident]+getFreeVars loc sc_tys = do+ tys <- mapM (\(scope,ty) -> zonkTerm =<< tc_value2term loc (scopeVars scope) ty) sc_tys+ return (foldr (go []) [] tys)+ where+ go bound (Vr tv) acc + | tv `elem` bound = acc+ | tv `elem` acc = acc+ | otherwise = tv : acc+ go bound (App x y) acc = go bound x (go bound y acc)+ go bound (Meta _) acc = acc+ go bound (Q _) acc = acc+ go bound (QC _) acc = acc+ go bound (Prod _ x arg res) acc = go bound arg (go (x : bound) res acc)+ go bound (RecType rs) acc = foldl (\acc (l,ty) -> go bound ty acc) acc rs+ go bound (Table p t) acc = go bound p (go bound t acc)++-- | Eliminate any substitutions in a term+zonkTerm :: Term -> TcM Term+zonkTerm (Meta i) = do+ mv <- getMeta i+ case mv of+ Unbound _ _ -> return (Meta i)+ Bound t -> do t <- zonkTerm t+ setMeta i (Bound t) -- "Short out" multiple hops+ return t+zonkTerm t = composOp zonkTerm t++tc_value2term loc xs v =+ case value2term loc xs v of+ Left i -> tcError ("Variable #" <+> pp i <+> "has escaped")+ Right t -> return t++++data TcA x a + = TcSingle (MetaStore -> [Message] -> TcResult a)+ | TcMany [x] (MetaStore -> [Message] -> [(a,MetaStore,[Message])])++mkTcA :: Err [a] -> TcA a a+mkTcA f = case f of+ Bad msg -> TcSingle (\ms msgs -> TcFail (pp msg : msgs))+ Ok [x] -> TcSingle (\ms msgs -> TcOk x ms msgs)+ Ok xs -> TcMany xs (\ms msgs -> [(x,ms,msgs) | x <- xs])++singleTcA :: TcM a -> TcA x a+singleTcA = TcSingle . unTcM++bindTcA :: TcA x a -> (a -> TcM b) -> TcA x b+bindTcA f g = case f of+ TcSingle f -> TcSingle (unTcM (TcM f >>= g))+ TcMany xs f -> TcMany xs (\ms msgs -> foldr add [] (f ms msgs))+ where+ add (y,ms,msgs) rs =+ case unTcM (g y) ms msgs of+ TcFail _ -> rs+ TcOk y ms msgs -> (y,ms,msgs):rs++runTcA :: ([x] -> TcM a) -> TcA x a -> TcM a+runTcA g f = TcM (\ms msgs -> case f of+ TcMany xs f -> case f ms msgs of+ [(x,ms,msgs)] -> TcOk x ms msgs+ rs -> unTcM (g xs) ms msgs+ TcSingle f -> f ms msgs)
@@ -0,0 +1,68 @@+module GF.Compile.TypeCheck.Primitives where++import GF.Grammar+import GF.Grammar.Predef+import qualified Data.Map as Map++typPredefined :: Ident -> Maybe Type+typPredefined f = case Map.lookup f primitives of+ Just (ResOper (Just (L _ ty)) _) -> Just ty+ Just (ResParam _ _) -> Just typePType+ Just (ResValue (L _ ty)) -> Just ty+ _ -> Nothing++primitives = Map.fromList+ [ (cErrorType, ResOper (Just (noLoc typeType)) Nothing)+ , (cInt , ResOper (Just (noLoc typePType)) Nothing)+ , (cFloat , ResOper (Just (noLoc typePType)) Nothing)+ , (cInts , fun [typeInt] typePType)+ , (cPBool , ResParam (Just (noLoc [(cPTrue,[]),(cPFalse,[])])) (Just [QC (cPredef,cPTrue), QC (cPredef,cPFalse)]))+ , (cPTrue , ResValue (noLoc typePBool))+ , (cPFalse , ResValue (noLoc typePBool))+ , (cError , fun [typeStr] typeError) -- non-can. of empty set+ , (cLength , fun [typeTok] typeInt)+ , (cDrop , fun [typeInt,typeTok] typeTok)+ , (cTake , fun [typeInt,typeTok] typeTok)+ , (cTk , fun [typeInt,typeTok] typeTok)+ , (cDp , fun [typeInt,typeTok] typeTok)+ , (cEqInt , fun [typeInt,typeInt] typePBool)+ , (cLessInt , fun [typeInt,typeInt] typePBool)+ , (cPlus , fun [typeInt,typeInt] typeInt)+ , (cEqStr , fun [typeTok,typeTok] typePBool)+ , (cOccur , fun [typeTok,typeTok] typePBool)+ , (cOccurs , fun [typeTok,typeTok] typePBool)++ , (cToUpper , fun [typeTok] typeTok)+ , (cToLower , fun [typeTok] typeTok)+ , (cIsUpper , fun [typeTok] typePBool)++---- "read" -> + , (cRead , ResOper (Just (noLoc (mkProd -- (P : Type) -> Tok -> P+ [(Explicit,varP,typePType),(Explicit,identW,typeStr)] (Vr varP) []))) Nothing)+ , (cShow , ResOper (Just (noLoc (mkProd -- (P : PType) -> P -> Tok+ [(Explicit,varP,typePType),(Explicit,identW,Vr varP)] typeStr []))) Nothing)+ , (cEqVal , ResOper (Just (noLoc (mkProd -- (P : PType) -> P -> P -> PBool+ [(Explicit,varP,typePType),(Explicit,identW,Vr varP),(Explicit,identW,Vr varP)] typePBool []))) Nothing)+ , (cToStr , ResOper (Just (noLoc (mkProd -- (L : Type) -> L -> Str+ [(Explicit,varL,typeType),(Explicit,identW,Vr varL)] typeStr []))) Nothing)+ , (cMapStr , ResOper (Just (noLoc (mkProd -- (L : Type) -> (Str -> Str) -> L -> L+ [(Explicit,varL,typeType),(Explicit,identW,mkFunType [typeStr] typeStr),(Explicit,identW,Vr varL)] (Vr varL) []))) Nothing)+ , (cNonExist , ResOper (Just (noLoc (mkProd -- Str+ [] typeStr []))) Nothing)+ , (cBIND , ResOper (Just (noLoc (mkProd -- Str+ [] typeStr []))) Nothing)+ , (cSOFT_BIND, ResOper (Just (noLoc (mkProd -- Str+ [] typeStr []))) Nothing)+ , (cSOFT_SPACE,ResOper (Just (noLoc (mkProd -- Str+ [] typeStr []))) Nothing)+ , (cCAPIT , ResOper (Just (noLoc (mkProd -- Str+ [] typeStr []))) Nothing)+ , (cALL_CAPIT, ResOper (Just (noLoc (mkProd -- Str+ [] typeStr []))) Nothing)+ ]+ where+ fun from to = oper (mkFunType from to)+ oper ty = ResOper (Just (noLoc ty)) Nothing++ varL = identS "L"+ varP = identS "P"
@@ -0,0 +1,761 @@+{-# LANGUAGE PatternGuards #-}+module GF.Compile.TypeCheck.RConcrete( checkLType, inferLType, computeLType, ppType ) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import GF.Infra.CheckM+import GF.Data.Operations++import GF.Grammar+import GF.Grammar.Lookup+import GF.Grammar.Predef+import GF.Grammar.PatternMatch+import GF.Grammar.Lockfield (isLockLabel, lockRecType, unlockRecord)+import GF.Compile.TypeCheck.Primitives++import Data.List+import Control.Monad+import GF.Text.Pretty++computeLType :: SourceGrammar -> Context -> Type -> Check Type+computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t+ where+ comp g ty = case ty of+ _ | Just _ <- isTypeInts ty -> return ty ---- shouldn't be needed+ | isPredefConstant ty -> return ty ---- shouldn't be needed++ Q (m,ident) -> checkIn ("module" <+> m) $ do+ ty' <- lookupResDef gr (m,ident)+ if ty' == ty then return ty else comp g ty' --- is this necessary to test?++ AdHocOverload ts -> do+ over <- getOverload gr g (Just typeType) t+ case over of+ Just (tr,_) -> return tr+ _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 t) ++ Vr ident -> checkLookup ident g -- never needed to compute!++ App f a -> do+ f' <- comp g f+ a' <- comp g a+ case f' of+ Abs b x t -> comp ((b,x,a'):g) t+ _ -> return $ App f' a'++ Prod bt x a b -> do+ a' <- comp g a+ b' <- comp ((bt,x,Vr x) : g) b+ return $ Prod bt x a' b'++ Abs bt x b -> do+ b' <- comp ((bt,x,Vr x):g) b+ return $ Abs bt x b'++ Let (x,(_,a)) b -> comp ((Explicit,x,a):g) b++ ExtR r s -> do+ r' <- comp g r+ s' <- comp g s+ case (r',s') of+ (RecType rs, RecType ss) -> plusRecType r' s' >>= comp g+ _ -> return $ ExtR r' s'++ RecType fs -> do+ let fs' = sortRec fs+ liftM RecType $ mapPairsM (comp g) fs'++ ELincat c t -> do+ t' <- comp g t+ lockRecType c t' ---- locking to be removed AR 20/6/2009++ _ | ty == typeTok -> return typeStr+ _ | isPredefConstant ty -> return ty++ _ -> composOp (comp g) ty++-- the underlying algorithms++inferLType :: SourceGrammar -> Context -> Term -> Check (Term, Type)+inferLType gr g trm = case trm of++ Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of+ Just ty -> return ty+ Nothing -> checkError ("unknown in Predef:" <+> ident)++ Q ident -> checks [+ termWith trm $ lookupResType gr ident >>= computeLType gr g+ ,+ lookupResDef gr ident >>= inferLType gr g+ ,+ checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)+ ]++ QC (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of+ Just ty -> return ty+ Nothing -> checkError ("unknown in Predef:" <+> ident)++ QC ident -> checks [+ termWith trm $ lookupResType gr ident >>= computeLType gr g+ ,+ lookupResDef gr ident >>= inferLType gr g+ ,+ checkError ("cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)+ ]++ Vr ident -> termWith trm $ checkLookup ident g++ Typed e t -> do+ t' <- computeLType gr g t+ checkLType gr g e t'++ AdHocOverload ts -> do+ over <- getOverload gr g Nothing trm+ case over of+ Just trty -> return trty+ _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm) ++ App f a -> do+ over <- getOverload gr g Nothing trm+ case over of+ Just trty -> return trty+ _ -> do+ (f',fty) <- inferLType gr g f+ fty' <- computeLType gr g fty+ case fty' of+ Prod bt z arg val -> do + a' <- justCheck g a arg+ ty <- if isWildIdent z + then return val+ else substituteLType [(bt,z,a')] val+ return (App f' a',ty) + _ -> checkError ("A function type is expected for" <+> ppTerm Unqualified 0 f <+> "instead of type" <+> ppType fty)++ S f x -> do+ (f', fty) <- inferLType gr g f+ case fty of+ Table arg val -> do+ x'<- justCheck g x arg+ return (S f' x', val)+ _ -> checkError ("table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))++ P t i -> do+ (t',ty) <- inferLType gr g t --- ??+ ty' <- computeLType gr g ty+ let tr2 = P t' i+ termWith tr2 $ case ty' of+ RecType ts -> case lookup i ts of+ Nothing -> checkError ("unknown label" <+> i <+> "in" $$ nest 2 (ppTerm Unqualified 0 ty'))+ Just x -> return x+ _ -> checkError ("record type expected for:" <+> ppTerm Unqualified 0 t $$+ " instead of the inferred:" <+> ppTerm Unqualified 0 ty')++ R r -> do+ let (ls,fs) = unzip r+ fsts <- mapM inferM fs+ let ts = [ty | (Just ty,_) <- fsts]+ checkCond ("cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)+ return $ (R (zip ls fsts), RecType (zip ls ts))++ T (TTyped arg) pts -> do+ (_,val) <- checks $ map (inferCase (Just arg)) pts+ checkLType gr g trm (Table arg val)+ T (TComp arg) pts -> do+ (_,val) <- checks $ map (inferCase (Just arg)) pts+ checkLType gr g trm (Table arg val)+ T ti pts -> do -- tries to guess: good in oper type inference+ let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]+ case pts' of + [] -> checkError ("cannot infer table type of" <+> ppTerm Unqualified 0 trm)+---- PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] + _ -> do + (arg,val) <- checks $ map (inferCase Nothing) pts'+ checkLType gr g trm (Table arg val)+ V arg pts -> do+ (_,val) <- checks $ map (inferLType gr g) pts+-- return (trm, Table arg val) -- old, caused issue 68+ checkLType gr g trm (Table arg val)++ K s -> do+ if elem ' ' s+ then do+ let ss = foldr C Empty (map K (words s)) + ----- removed irritating warning AR 24/5/2008+ ----- checkWarn ("token \"" ++ s ++ + ----- "\" converted to token list" ++ prt ss)+ return (ss, typeStr)+ else return (trm, typeStr)++ EInt i -> return (trm, typeInt)++ EFloat i -> return (trm, typeFloat)++ Empty -> return (trm, typeStr)++ C s1 s2 -> + check2 (flip (justCheck g) typeStr) C s1 s2 typeStr++ Glue s1 s2 -> + check2 (flip (justCheck g) typeStr) Glue s1 s2 typeStr ---- typeTok++---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007+ Strs (Cn c : ts) | c == cConflict -> do+ checkWarn ("unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))+ inferLType gr g (head ts)++ Strs ts -> do+ ts' <- mapM (\t -> justCheck g t typeStr) ts + return (Strs ts', typeStrs)++ Alts t aa -> do+ t' <- justCheck g t typeStr+ aa' <- flip mapM aa (\ (c,v) -> do+ c' <- justCheck g c typeStr + v' <- checks $ map (justCheck g v) [typeStrs, EPattType typeStr]+ return (c',v'))+ return (Alts t' aa', typeStr)++ RecType r -> do+ let (ls,ts) = unzip r+ ts' <- mapM (flip (justCheck g) typeType) ts + return (RecType (zip ls ts'), typeType)++ ExtR r s -> do+ (r',rT) <- inferLType gr g r + rT' <- computeLType gr g rT+ (s',sT) <- inferLType gr g s+ sT' <- computeLType gr g sT++ let trm' = ExtR r' s'+ case (rT', sT') of+ (RecType rs, RecType ss) -> do+ let rt = RecType ([field | field@(l,_) <- rs, notElem l (map fst ss)] ++ ss) -- select types of later fields + checkLType gr g trm' rt ---- return (trm', rt)+ _ | rT' == typeType && sT' == typeType -> do+ return (trm', typeType)+ _ -> checkError ("records or record types expected in" <+> ppTerm Unqualified 0 trm)++ Sort _ -> + termWith trm $ return typeType++ Prod bt x a b -> do+ a' <- justCheck g a typeType+ b' <- justCheck ((bt,x,a'):g) b typeType+ return (Prod bt x a' b', typeType)++ Table p t -> do+ p' <- justCheck g p typeType --- check p partype! + t' <- justCheck g t typeType+ return $ (Table p' t', typeType)++ FV vs -> do+ (_,ty) <- checks $ map (inferLType gr g) vs+--- checkIfComplexVariantType trm ty+ checkLType gr g trm ty++ EPattType ty -> do+ ty' <- justCheck g ty typeType+ return (EPattType ty',typeType)+ EPatt p -> do+ ty <- inferPatt p+ return (trm, EPattType ty)++ ELin c trm -> do+ (trm',ty) <- inferLType gr g trm+ ty' <- lockRecType c ty ---- lookup c; remove lock AR 20/6/2009+ return $ (ELin c trm', ty') ++ _ -> checkError ("cannot infer lintype of" <+> ppTerm Unqualified 0 trm)++ where+ isPredef m = elem m [cPredef,cPredefAbs]++ justCheck g ty te = checkLType gr g ty te >>= return . fst++ -- for record fields, which may be typed+ inferM (mty, t) = do+ (t', ty') <- case mty of+ Just ty -> checkLType gr g t ty+ _ -> inferLType gr g t+ return (Just ty',t')++ inferCase mty (patt,term) = do+ arg <- maybe (inferPatt patt) return mty+ cont <- pattContext gr g arg patt+ (_,val) <- inferLType gr (reverse cont ++ g) term+ return (arg,val)+ isConstPatt p = case p of+ PC _ ps -> True --- all isConstPatt ps+ PP _ ps -> True --- all isConstPatt ps+ PR ps -> all (isConstPatt . snd) ps+ PT _ p -> isConstPatt p+ PString _ -> True+ PInt _ -> True+ PFloat _ -> True+ PChar -> True+ PChars _ -> True+ PSeq p q -> isConstPatt p && isConstPatt q+ PAlt p q -> isConstPatt p && isConstPatt q+ PRep p -> isConstPatt p+ PNeg p -> isConstPatt p+ PAs _ p -> isConstPatt p+ _ -> False++ inferPatt p = case p of+ PP (q,c) ps | q /= cPredef -> liftM valTypeCnc (lookupResType gr (q,c))+ PAs _ p -> inferPatt p+ PNeg p -> inferPatt p+ PAlt p q -> checks [inferPatt p, inferPatt q]+ PSeq _ _ -> return $ typeStr+ PRep _ -> return $ typeStr+ PChar -> return $ typeStr+ PChars _ -> return $ typeStr+ _ -> inferLType gr g (patt2term p) >>= return . snd++-- type inference: Nothing, type checking: Just t+-- the latter permits matching with value type+getOverload :: SourceGrammar -> Context -> Maybe Type -> Term -> Check (Maybe (Term,Type))+getOverload gr g mt ot = case appForm ot of+ (f@(Q c), ts) -> case lookupOverload gr c of+ Ok typs -> do+ ttys <- mapM (inferLType gr g) ts+ v <- matchOverload f typs ttys+ return $ Just v+ _ -> return Nothing+ (AdHocOverload cs@(f:_), ts) -> do --- the function name f is only used in error messages+ let typs = concatMap collectOverloads cs+ ttys <- mapM (inferLType gr g) ts+ v <- matchOverload f typs ttys+ return $ Just v+ _ -> return Nothing++ where+ collectOverloads tr@(Q c) = case lookupOverload gr c of + Ok typs -> typs+ _ -> case lookupResType gr c of+ Ok ty -> let (args,val) = typeFormCnc ty in [(map (\(b,x,t) -> t) args,(val,tr))]+ _ -> []+ collectOverloads _ = [] --- constructors QC++ matchOverload f typs ttys = do+ let (tts,tys) = unzip ttys+ let vfs = lookupOverloadInstance tys typs+ let matches = [vf | vf@((_,v,_),_) <- vfs, matchVal mt v]+ let showTypes ty = hsep (map ppType ty)++ + let (stys,styps) = (showTypes tys, [showTypes ty | (ty,_) <- typs])++ -- to avoid strange error msg e.g. in case of unmatch record extension, show whole types if needed AR 28/1/2013+ let (stysError,stypsError) = if elem (render stys) (map render styps)+ then (hsep (map (ppTerm Unqualified 0) tys), [hsep (map (ppTerm Unqualified 0) ty) | (ty,_) <- typs])+ else (stys,styps)++ case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of+ ([(_,val,fun)],_) -> return (mkApp fun tts, val)+ ([],[(pre,val,fun)]) -> do+ checkWarn $ "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$+ "for" $$+ nest 2 (showTypes tys) $$+ "using" $$+ nest 2 (showTypes pre)+ return (mkApp fun tts, val)+ ([],[]) -> do+ checkError $ "no overload instance of" <+> ppTerm Unqualified 0 f $$+ "for" $$+ nest 2 stysError $$+ "among" $$+ nest 2 (vcat stypsError) $$+ maybe empty (\x -> "with value type" <+> ppType x) mt++ (vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of+ ([(val,fun)],_) -> do+ return (mkApp fun tts, val)+ ([],[(val,fun)]) -> do+ checkWarn ("ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot) + return (mkApp fun tts, val)++----- unsafely exclude irritating warning AR 24/5/2008+----- checkWarn $ "overloading of" +++ prt f +++ +----- "resolved by excluding partial applications:" +++++----- unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]++--- now forgiving ambiguity with a warning AR 1/2/2014+-- This gives ad hoc overloading the same behaviour as the choice of the first match in renaming did before. +-- But it also gives a chance to ambiguous overloadings that were banned before. + (nps1,nps2) -> do + checkWarn $ "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>+ ---- "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$ + "resolved by selecting the first of the alternatives" $$+ nest 2 (vcat [ppTerm Qualified 0 fun | (_,ty,fun) <- vfs1 ++ if null vfs1 then vfs2 else []])+ case [(mkApp fun tts,val) | (val,fun) <- nps1 ++ nps2] of+ [] -> checkError $ "no alternatives left when resolving" <+> ppTerm Unqualified 0 f+ h:_ -> return h++ matchVal mt v = elem mt [Nothing,Just v,Just (unlocked v)]++ unlocked v = case v of+ RecType fs -> RecType $ filter (not . isLockLabel . fst) fs+ _ -> v+ ---- TODO: accept subtypes+ ---- TODO: use a trie+ lookupOverloadInstance tys typs = + [((pre,mkFunType rest val, t),isExact) | + let lt = length tys,+ (ty,(val,t)) <- typs, length ty >= lt,+ let (pre,rest) = splitAt lt ty, + let isExact = pre == tys,+ isExact || map unlocked pre == map unlocked tys+ ]++ noProds vfs = [(v,f) | (_,v,f) <- vfs, noProd v]++ noProd ty = case ty of+ Prod _ _ _ _ -> False+ _ -> True++checkLType :: SourceGrammar -> Context -> Term -> Type -> Check (Term, Type)+checkLType gr g trm typ0 = do+ typ <- computeLType gr g typ0++ case trm of++ Abs bt x c -> do+ case typ of+ Prod bt' z a b -> do + (c',b') <- if isWildIdent z+ then checkLType gr ((bt,x,a):g) c b+ else do b' <- checkIn (pp "abs") $ substituteLType [(bt',z,Vr x)] b+ checkLType gr ((bt,x,a):g) c b'+ return $ (Abs bt x c', Prod bt' z a b')+ _ -> checkError $ "function type expected instead of" <+> ppType typ++ App f a -> do+ over <- getOverload gr g (Just typ) trm+ case over of+ Just trty -> return trty+ _ -> do+ (trm',ty') <- inferLType gr g trm+ termWith trm' $ checkEqLType gr g typ ty' trm'++ AdHocOverload ts -> do+ over <- getOverload gr g Nothing trm+ case over of+ Just trty -> return trty+ _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm) ++ Q _ -> do+ over <- getOverload gr g (Just typ) trm+ case over of+ Just trty -> return trty+ _ -> do+ (trm',ty') <- inferLType gr g trm+ termWith trm' $ checkEqLType gr g typ ty' trm'++ T _ [] ->+ checkError ("found empty table in type" <+> ppTerm Unqualified 0 typ)+ T _ cs -> case typ of + Table arg val -> do + case allParamValues gr arg of+ Ok vs -> do+ let ps0 = map fst cs+ ps <- testOvershadow ps0 vs+ if null ps + then return () + else checkWarn ("patterns never reached:" $$+ nest 2 (vcat (map (ppPatt Unqualified 0) ps)))+ _ -> return () -- happens with variable types+ cs' <- mapM (checkCase arg val) cs+ return (T (TTyped arg) cs', typ)+ _ -> checkError $ "table type expected for table instead of" $$ nest 2 (ppType typ)+ V arg0 vs ->+ case typ of+ Table arg1 val ->+ do arg' <- checkEqLType gr g arg0 arg1 trm+ vs1 <- allParamValues gr arg1+ if length vs1 == length vs+ then return ()+ else checkError $ "wrong number of values in table" <+> ppTerm Unqualified 0 trm+ vs' <- map fst `fmap` sequence [checkLType gr g v val|v<-vs]+ return (V arg' vs',typ)++ R r -> case typ of --- why needed? because inference may be too difficult+ RecType rr -> do+ --let (ls,_) = unzip rr -- labels of expected type+ fsts <- mapM (checkM r) rr -- check that they are found in the record+ return $ (R fsts, typ) -- normalize record++ _ -> checkError ("record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))++ ExtR r s -> case typ of+ _ | typ == typeType -> do+ trm' <- computeLType gr g trm+ case trm' of+ RecType _ -> termWith trm' $ return typeType+ ExtR (Vr _) (RecType _) -> termWith trm' $ return typeType + -- ext t = t ** ...+ _ -> checkError ("invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))++ RecType rr -> do++ ll2 <- case s of+ R ss -> return $ map fst ss+ _ -> do+ (s',typ2) <- inferLType gr g s+ case typ2 of+ RecType ss -> return $ map fst ss+ _ -> checkError ("cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))+ let ll1 = [l | (l,_) <- rr, notElem l ll2]+ (r',_) <- checkLType gr g r (RecType [field | field@(l,_) <- rr, elem l ll1])+ (s',_) <- checkLType gr g s (RecType [field | field@(l,_) <- rr, elem l ll2])++ let rec = R ([(l,(Nothing,P r' l)) | l <- ll1] ++ [(l,(Nothing,P s' l)) | l <- ll2])+ return (rec, typ)++ ExtR ty ex -> do+ r' <- justCheck g r ty+ s' <- justCheck g s ex+ return $ (ExtR r' s', typ) --- is this all? it assumes the same division in trm and typ++ _ -> checkError ("record extension not meaningful for" <+> ppTerm Unqualified 0 typ)++ FV vs -> do+ ttys <- mapM (flip (checkLType gr g) typ) vs+--- checkIfComplexVariantType trm typ+ return (FV (map fst ttys), typ) --- typ' ?++ S tab arg -> checks [ do+ (tab',ty) <- inferLType gr g tab+ ty' <- computeLType gr g ty+ case ty' of+ Table p t -> do+ (arg',val) <- checkLType gr g arg p+ checkEqLType gr g typ t trm+ return (S tab' arg', t)+ _ -> checkError ("table type expected for applied table instead of" <+> ppType ty')+ , do+ (arg',ty) <- inferLType gr g arg+ ty' <- computeLType gr g ty+ (tab',_) <- checkLType gr g tab (Table ty' typ)+ return (S tab' arg', typ)+ ]+ Let (x,(mty,def)) body -> case mty of+ Just ty -> do+ (ty0,_) <- checkLType gr g ty typeType+ (def',ty') <- checkLType gr g def ty0+ body' <- justCheck ((Explicit,x,ty'):g) body typ+ return (Let (x,(Just ty',def')) body', typ)+ _ -> do+ (def',ty) <- inferLType gr g def -- tries to infer type of local constant+ checkLType gr g (Let (x,(Just ty,def')) body) typ++ ELin c tr -> do+ tr1 <- unlockRecord c tr+ checkLType gr g tr1 typ++ _ -> do+ (trm',ty') <- inferLType gr g trm+ termWith trm' $ checkEqLType gr g typ ty' trm'+ where+ justCheck g ty te = checkLType gr g ty te >>= return . fst+{-+ recParts rr t = (RecType rr1,RecType rr2) where + (rr1,rr2) = partition (flip elem (map fst t) . fst) rr +-}+ checkM rms (l,ty) = case lookup l rms of+ Just (Just ty0,t) -> do+ checkEqLType gr g ty ty0 t+ (t',ty') <- checkLType gr g t ty+ return (l,(Just ty',t'))+ Just (_,t) -> do+ (t',ty') <- checkLType gr g t ty+ return (l,(Just ty',t'))+ _ -> checkError $ + if isLockLabel l + then let cat = drop 5 (showIdent (label2ident l))+ in ppTerm Unqualified 0 (R rms) <+> "is not in the lincat of" <+> cat <> + "; try wrapping it with lin" <+> cat+ else "cannot find value for label" <+> l <+> "in" <+> ppTerm Unqualified 0 (R rms)++ checkCase arg val (p,t) = do+ cont <- pattContext gr g arg p+ t' <- justCheck (reverse cont ++ g) t val+ return (p,t')++pattContext :: SourceGrammar -> Context -> Type -> Patt -> Check Context+pattContext env g typ p = case p of+ PV x -> return [(Explicit,x,typ)]+ PP (q,c) ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006+ t <- lookupResType env (q,c)+ let (cont,v) = typeFormCnc t+ checkCond ("wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p) + (length cont == length ps)+ checkEqLType env g typ v (patt2term p)+ mapM (\((_,_,ty),p) -> pattContext env g ty p) (zip cont ps) >>= return . concat+ PR r -> do+ typ' <- computeLType env g typ+ case typ' of+ RecType t -> do+ let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]+ ----- checkWarn $ prt p ++++ show pts ----- debug+ mapM (uncurry (pattContext env g)) pts >>= return . concat+ _ -> checkError ("record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')+ PT t p' -> do+ checkEqLType env g typ t (patt2term p')+ pattContext env g typ p'++ PAs x p -> do+ g' <- pattContext env g typ p+ return ((Explicit,x,typ):g')++ PAlt p' q -> do+ g1 <- pattContext env g typ p'+ g2 <- pattContext env g typ q+ let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])+ checkCond + ("incompatible bindings of" <+>+ fsep pts <+> + "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts) + return g1 -- must be g1 == g2+ PSeq p q -> do+ g1 <- pattContext env g typ p+ g2 <- pattContext env g typ q+ return $ g1 ++ g2+ PRep p' -> noBind typeStr p'+ PNeg p' -> noBind typ p'++ _ -> return [] ---- check types!+ where + noBind typ p' = do+ co <- pattContext env g typ p'+ if not (null co)+ then checkWarn ("no variable bound inside pattern" <+> ppPatt Unqualified 0 p) + >> return []+ else return []++checkEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check Type+checkEqLType gr g t u trm = do+ (b,t',u',s) <- checkIfEqLType gr g t u trm+ case b of+ True -> return t'+ False -> checkError $ s <+> "type of" <+> ppTerm Unqualified 0 trm $$+ "expected:" <+> ppTerm Qualified 0 t $$ -- ppqType t u $$+ "inferred:" <+> ppTerm Qualified 0 u -- ppqType u t++checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String)+checkIfEqLType gr g t u trm = do+ t' <- computeLType gr g t+ u' <- computeLType gr g u+ case t' == u' || alpha [] t' u' of+ True -> return (True,t',u',[])+ -- forgive missing lock fields by only generating a warning.+ --- better: use a flag to forgive? (AR 31/1/2006)+ _ -> case missingLock [] t' u' of+ Ok lo -> do+ checkWarn $ "missing lock field" <+> fsep lo+ return (True,t',u',[])+ Bad s -> return (False,t',u',s)++ where++ -- check that u is a subtype of t+ --- quick hack version of TC.eqVal+ alpha g t u = case (t,u) of ++ -- error (the empty type!) is subtype of any other type+ (_,u) | u == typeError -> True++ -- contravariance+ (Prod _ x a b, Prod _ y c d) -> alpha g c a && alpha ((x,y):g) b d + + -- record subtyping+ (RecType rs, RecType ts) -> all (\ (l,a) -> + any (\ (k,b) -> l == k && alpha g a b) ts) rs+ (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'+ (ExtR r s, t) -> alpha g r t || alpha g s t++ -- the following say that Ints n is a subset of Int and of Ints m >= n+ -- But why does it also allow Int as a subtype of Ints m? /TH 2014-04-04+ (t,u) | Just m <- isTypeInts t, Just n <- isTypeInts u -> m >= n+ | Just _ <- isTypeInts t, u == typeInt -> True ---- check size!+ | t == typeInt, Just _ <- isTypeInts u -> True ---- why this ???? AR 11/12/2005++ ---- this should be made in Rename+ (Q (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)+ || m == n --- for Predef+ (QC (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)+ (QC (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)+ (Q (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n) + || elem n (allExtendsPlus gr m)++ -- contravariance+ (Table a b, Table c d) -> alpha g c a && alpha g b d+ (Vr x, Vr y) -> x == y || elem (x,y) g || elem (y,x) g+ _ -> t == u + --- the following should be one-way coercions only. AR 4/1/2001+ || elem t sTypes && elem u sTypes+ || (t == typeType && u == typePType) + || (u == typeType && t == typePType) ++ missingLock g t u = case (t,u) of + (RecType rs, RecType ts) -> + let + ls = [l | (l,a) <- rs, + not (any (\ (k,b) -> alpha g a b && l == k) ts)]+ (locks,others) = partition isLockLabel ls+ in case others of+ _:_ -> Bad $ render ("missing record fields:" <+> fsep (punctuate ',' (others)))+ _ -> return locks+ -- contravariance+ (Prod _ x a b, Prod _ y c d) -> do+ ls1 <- missingLock g c a+ ls2 <- missingLock g b d+ return $ ls1 ++ ls2++ _ -> Bad ""++ sTypes = [typeStr, typeTok, typeString]++-- auxiliaries++-- | light-weight substitution for dep. types+substituteLType :: Context -> Type -> Check Type+substituteLType g t = case t of+ Vr x -> return $ maybe t id $ lookup x [(x,t) | (_,x,t) <- g]+ _ -> composOp (substituteLType g) t++termWith :: Term -> Check Type -> Check (Term, Type)+termWith t ct = do+ ty <- ct+ return (t,ty)++-- | compositional check\/infer of binary operations+check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> + Term -> Term -> Type -> Check (Term,Type)+check2 chk con a b t = do+ a' <- chk a+ b' <- chk b+ return (con a' b', t)++-- printing a type with a lock field lock_C as C+ppType :: Type -> Doc+ppType ty =+ case ty of+ RecType fs -> case filter isLockLabel $ map fst fs of+ [lock] -> pp (drop 5 (showIdent (label2ident lock)))+ _ -> ppTerm Unqualified 0 ty+ Prod _ x a b -> ppType a <+> "->" <+> ppType b+ _ -> ppTerm Unqualified 0 ty+{-+ppqType :: Type -> Type -> Doc+ppqType t u = case (ppType t, ppType u) of+ (pt,pu) | render pt == render pu -> ppTerm Qualified 0 t+ (pt,_) -> pt+-}+checkLookup :: Ident -> Context -> Check Type+checkLookup x g =+ case [ty | (b,y,ty) <- g, x == y] of+ [] -> checkError ("unknown variable" <+> x)+ (ty:_) -> return ty
@@ -0,0 +1,324 @@+----------------------------------------------------------------------+-- |+-- Module : TC+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/10/02 20:50:19 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.11 $+--+-- Thierry Coquand's type checking algorithm that creates a trace+-----------------------------------------------------------------------------++module GF.Compile.TypeCheck.TC (AExp(..),+ Theory,+ checkExp,+ inferExp,+ checkBranch,+ eqVal,+ whnf+ ) where++import GF.Data.Operations+import GF.Grammar+import GF.Grammar.Predef++import Control.Monad+--import Data.List (sortBy)+import Data.Maybe+import GF.Text.Pretty++data AExp =+ AVr Ident Val + | ACn QIdent Val+ | AType + | AInt Int + | AFloat Double+ | AStr String+ | AMeta MetaId Val+ | ALet (Ident,(Val,AExp)) AExp+ | AApp AExp AExp Val + | AAbs Ident Val AExp + | AProd Ident AExp AExp +-- -- | AEqs [([Exp],AExp)] --- not used+ | ARecType [ALabelling]+ | AR [AAssign]+ | AP AExp Label Val+ | AGlue AExp AExp+ | AData Val+ deriving (Eq,Show)++type ALabelling = (Label, AExp) +type AAssign = (Label, (Val, AExp))++type Theory = QIdent -> Err Val++lookupConst :: Theory -> QIdent -> Err Val+lookupConst th f = th f++lookupVar :: Env -> Ident -> Err Val+lookupVar g x = maybe (Bad (render ("unknown variable" <+> x))) return $ lookup x ((identW,VClos [] (Meta 0)):g)+-- wild card IW: no error produced, ?0 instead.++type TCEnv = (Int,Env,Env)++--emptyTCEnv :: TCEnv+--emptyTCEnv = (0,[],[])++whnf :: Val -> Err Val+whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug+ case v of+ VApp u w -> do+ u' <- whnf u + w' <- whnf w+ app u' w'+ VClos env e -> eval env e+ _ -> return v++app :: Val -> Val -> Err Val+app u v = case u of+ VClos env (Abs _ x e) -> eval ((x,v):env) e+ _ -> return $ VApp u v+ +eval :: Env -> Term -> Err Val+eval env e = ---- errIn ("eval" +++ prt e +++ "in" +++ prEnv env) $ + case e of+ Vr x -> lookupVar env x+ Q c -> return $ VCn c+ QC c -> return $ VCn c ---- == Q ?+ Sort c -> return $ VType --- the only sort is Type+ App f a -> join $ liftM2 app (eval env f) (eval env a)+ RecType xs -> do xs <- mapM (\(l,e) -> eval env e >>= \e -> return (l,e)) xs+ return (VRecType xs)+ _ -> return $ VClos env e++eqVal :: Int -> Val -> Val -> Err [(Val,Val)]+eqVal k u1 u2 = ---- errIn (prt u1 +++ "<>" +++ prBracket (show k) +++ prt u2) $ + do+ w1 <- whnf u1+ w2 <- whnf u2 + let v = VGen k+ case (w1,w2) of+ (VApp f1 a1, VApp f2 a2) -> liftM2 (++) (eqVal k f1 f2) (eqVal k a1 a2)+ (VClos env1 (Abs _ x1 e1), VClos env2 (Abs _ x2 e2)) ->+ eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2)+ (VClos env1 (Prod _ x1 a1 e1), VClos env2 (Prod _ x2 a2 e2)) ->+ liftM2 (++) + (eqVal k (VClos env1 a1) (VClos env2 a2))+ (eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2))+ (VGen i _, VGen j _) -> return [(w1,w2) | i /= j]+ (VCn (_, i), VCn (_,j)) -> return [(w1,w2) | i /= j] + --- thus ignore qualifications; valid because inheritance cannot+ --- be qualified. Simplifies annotation. AR 17/3/2005 + _ -> return [(w1,w2) | w1 /= w2]+-- invariant: constraints are in whnf++checkType :: Theory -> TCEnv -> Term -> Err (AExp,[(Val,Val)])+checkType th tenv e = checkExp th tenv e vType++checkExp :: Theory -> TCEnv -> Term -> Val -> Err (AExp, [(Val,Val)])+checkExp th tenv@(k,rho,gamma) e ty = do+ typ <- whnf ty+ let v = VGen k+ case e of+ Meta m -> return $ (AMeta m typ,[])++ Abs _ x t -> case typ of+ VClos env (Prod _ y a b) -> do+ a' <- whnf $ VClos env a ---+ (t',cs) <- checkExp th + (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)+ return (AAbs x a' t', cs)+ _ -> Bad (render ("function type expected for" <+> ppTerm Unqualified 0 e <+> "instead of" <+> ppValue Unqualified 0 typ))++ Let (x, (mb_typ, e1)) e2 -> do+ (val,e1,cs1) <- case mb_typ of+ Just typ -> do (_,cs1) <- checkType th tenv typ+ val <- eval rho typ+ (e1,cs2) <- checkExp th tenv e1 val+ return (val,e1,cs1++cs2)+ Nothing -> do (e1,val,cs) <- inferExp th tenv e1+ return (val,e1,cs)+ (e2,cs2) <- checkExp th (k,rho,(x,val):gamma) e2 typ+ return (ALet (x,(val,e1)) e2, cs1++cs2)++ Prod _ x a b -> do+ testErr (typ == vType) "expected Type"+ (a',csa) <- checkType th tenv a+ (b',csb) <- checkType th (k+1, (x,v x):rho, (x,VClos rho a):gamma) b+ return (AProd x a' b', csa ++ csb)++ R xs -> + case typ of+ VRecType ys -> do case [l | (l,_) <- ys, isNothing (lookup l xs)] of+ [] -> return ()+ ls -> fail (render ("no value given for label:" <+> fsep (punctuate ',' ls)))+ r <- mapM (checkAssign th tenv ys) xs+ let (xs,css) = unzip r+ return (AR xs, concat css)+ _ -> Bad (render ("record type expected for" <+> ppTerm Unqualified 0 e <+> "instead of" <+> ppValue Unqualified 0 typ))++ P r l -> do (r',cs) <- checkExp th tenv r (VRecType [(l,typ)])+ return (AP r' l typ,cs)++ Glue x y -> do cs1 <- eqVal k valAbsFloat typ+ (x,cs2) <- checkExp th tenv x typ+ (y,cs3) <- checkExp th tenv y typ+ return (AGlue x y,cs1++cs2++cs3)+ _ -> checkInferExp th tenv e typ++checkInferExp :: Theory -> TCEnv -> Term -> Val -> Err (AExp, [(Val,Val)])+checkInferExp th tenv@(k,_,_) e typ = do+ (e',w,cs1) <- inferExp th tenv e+ cs2 <- eqVal k w typ+ return (e',cs1 ++ cs2)+ +inferExp :: Theory -> TCEnv -> Term -> Err (AExp, Val, [(Val,Val)])+inferExp th tenv@(k,rho,gamma) e = case e of+ Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x+ Q (m,c) | m == cPredefAbs && isPredefCat c+ -> return (ACn (m,c) vType, vType, [])+ | otherwise -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)+ QC c -> mkAnnot (ACn c) $ noConstr $ lookupConst th c ----+ EInt i -> return (AInt i, valAbsInt, [])+ EFloat i -> return (AFloat i, valAbsFloat, [])+ K i -> return (AStr i, valAbsString, [])+ Sort _ -> return (AType, vType, [])+ RecType xs -> do r <- mapM (checkLabelling th tenv) xs+ let (xs,css) = unzip r+ return (ARecType xs, vType, concat css)+ Let (x, (mb_typ, e1)) e2 -> do+ (val1,e1,cs1) <- case mb_typ of+ Just typ -> do (_,cs1) <- checkType th tenv typ+ val <- eval rho typ+ (e1,cs2) <- checkExp th tenv e1 val+ return (val,e1,cs1++cs2)+ Nothing -> do (e1,val,cs) <- inferExp th tenv e1+ return (val,e1,cs)+ (e2,val2,cs2) <- inferExp th (k,rho,(x,val1):gamma) e2+ return (ALet (x,(val1,e1)) e2, val2, cs1++cs2)+ App f t -> do+ (f',w,csf) <- inferExp th tenv f + typ <- whnf w+ case typ of+ VClos env (Prod _ x a b) -> do+ (a',csa) <- checkExp th tenv t (VClos env a)+ b' <- whnf $ VClos ((x,VClos rho t):env) b+ return $ (AApp f' a' b', b', csf ++ csa)+ _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))+ _ -> Bad (render ("cannot infer type of expression" <+> ppTerm Unqualified 0 e))++checkLabelling :: Theory -> TCEnv -> Labelling -> Err (ALabelling, [(Val,Val)])+checkLabelling th tenv (lbl,typ) = do+ (atyp,cs) <- checkType th tenv typ+ return ((lbl,atyp),cs)++checkAssign :: Theory -> TCEnv -> [(Label,Val)] -> Assign -> Err (AAssign, [(Val,Val)])+checkAssign th tenv@(k,rho,gamma) typs (lbl,(Just typ,exp)) = do+ (atyp,cs1) <- checkType th tenv typ+ val <- eval rho typ+ cs2 <- case lookup lbl typs of+ Nothing -> return []+ Just val0 -> eqVal k val val0+ (aexp,cs3) <- checkExp th tenv exp val+ return ((lbl,(val,aexp)),cs1++cs2++cs3)+checkAssign th tenv@(k,rho,gamma) typs (lbl,(Nothing,exp)) = do+ case lookup lbl typs of+ Nothing -> do (aexp,val,cs) <- inferExp th tenv exp+ return ((lbl,(val,aexp)),cs)+ Just val -> do (aexp,cs) <- checkExp th tenv exp val+ return ((lbl,(val,aexp)),cs)++checkBranch :: Theory -> TCEnv -> Equation -> Val -> Err (([Term],AExp),[(Val,Val)])+checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $ + chB tenv' ps' ty + where ++ (ps',_,rho2,k') = ps2ts k ps+ tenv' = (k, rho2++rho, gamma) ---- k' ?+ (k,rho,gamma) = tenv++ chB tenv@(k,rho,gamma) ps ty = case ps of+ p:ps2 -> do+ typ <- whnf ty+ case typ of+ VClos env (Prod _ y a b) -> do+ a' <- whnf $ VClos env a+ (p', sigma, binds, cs1) <- checkP tenv p y a'+ let tenv' = (length binds, sigma ++ rho, binds ++ gamma)+ ((ps',exp),cs2) <- chB tenv' ps2 (VClos ((y,p'):env) b)+ return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt+ _ -> Bad (render ("Product expected for definiens" <+> ppTerm Unqualified 0 t <+> "instead of" <+> ppValue Unqualified 0 typ))+ [] -> do+ (e,cs) <- checkExp th tenv t ty+ return (([],e),cs)+ checkP env@(k,rho,gamma) t x a = do+ (delta,cs) <- checkPatt th env t a+ let sigma = [(x, VGen i x) | ((x,_),i) <- zip delta [k..]]+ return (VClos sigma t, sigma, delta, cs)++ ps2ts k = foldr p2t ([],0,[],k) + p2t p (ps,i,g,k) = case p of+ PW -> (Meta i : ps, i+1,g,k) + PV x -> (Vr x : ps, i, upd x k g,k+1)+ PAs x p -> p2t p (ps,i,g,k)+ PString s -> (K s : ps, i, g, k)+ PInt n -> (EInt n : ps, i, g, k)+ PFloat n -> (EFloat n : ps, i, g, k)+ PP c xs -> (mkApp (Q c) xss : ps, j, g',k') + where (xss,j,g',k') = foldr p2t ([],i,g,k) xs+ PImplArg p -> p2t p (ps,i,g,k)+ PTilde t -> (t : ps, i, g, k)+ _ -> error $ render ("undefined p2t case" <+> ppPatt Unqualified 0 p <+> "in checkBranch")++ upd x k g = (x, VGen k x) : g --- hack to recognize pattern variables+++checkPatt :: Theory -> TCEnv -> Term -> Val -> Err (Binds,[(Val,Val)])+checkPatt th tenv exp val = do+ (aexp,_,cs) <- checkExpP tenv exp val+ let binds = extrBinds aexp+ return (binds,cs)+ where+ extrBinds aexp = case aexp of+ AVr i v -> [(i,v)]+ AApp f a _ -> extrBinds f ++ extrBinds a+ _ -> [] -- no other cases are possible++--- ad hoc, to find types of variables+ checkExpP tenv@(k,rho,gamma) exp val = case exp of+ Meta m -> return $ (AMeta m val, val, [])+ Vr x -> return $ (AVr x val, val, [])+ EInt i -> return (AInt i, valAbsInt, [])+ EFloat i -> return (AFloat i, valAbsFloat, [])+ K s -> return (AStr s, valAbsString, [])++ Q c -> do+ typ <- lookupConst th c+ return $ (ACn c typ, typ, [])+ QC c -> do+ typ <- lookupConst th c+ return $ (ACn c typ, typ, []) ----+ App f t -> do+ (f',w,csf) <- checkExpP tenv f val+ typ <- whnf w+ case typ of+ VClos env (Prod _ x a b) -> do+ (a',_,csa) <- checkExpP tenv t (VClos env a)+ b' <- whnf $ VClos ((x,VClos rho t):env) b+ return $ (AApp f' a' b', b', csf ++ csa)+ _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))+ _ -> Bad (render ("cannot typecheck pattern" <+> ppTerm Unqualified 0 exp))++-- auxiliaries++noConstr :: Err Val -> Err (Val,[(Val,Val)])+noConstr er = er >>= (\v -> return (v,[]))++mkAnnot :: (Val -> AExp) -> Err (Val,[(Val,Val)]) -> Err (AExp,Val,[(Val,Val)])+mkAnnot a ti = do+ (v,cs) <- ti+ return (a v, v, cs)+
@@ -0,0 +1,229 @@+----------------------------------------------------------------------+-- |+-- Module : Update+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/05/30 18:39:44 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.8 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Compile.Update (buildAnyTree, extendModule, rebuildModule) where++import GF.Infra.Ident+import GF.Infra.Option+import GF.Infra.CheckM+import GF.Grammar.Grammar+import GF.Grammar.Printer+import GF.Grammar.Lookup++import GF.Data.Operations++import Data.List+import qualified Data.Map as Map+import Control.Monad+import GF.Text.Pretty++-- | combine a list of definitions into a balanced binary search tree+buildAnyTree :: Monad m => ModuleName -> [(Ident,Info)] -> m (BinTree Ident Info)+buildAnyTree m = go Map.empty+ where+ go map [] = return map+ go map ((c,j):is) = do+ case Map.lookup c map of+ Just i -> case unifyAnyInfo m i j of+ Ok k -> go (Map.insert c k map) is+ Bad _ -> fail $ render ("conflicting information in module"<+>m $$+ nest 4 (ppJudgement Qualified (c,i)) $$+ "and" $+$+ nest 4 (ppJudgement Qualified (c,j)))+ Nothing -> go (Map.insert c j map) is++extendModule :: FilePath -> SourceGrammar -> SourceModule -> Check SourceModule+extendModule cwd gr (name,m)+ ---- Just to allow inheritance in incomplete concrete (which are not+ ---- compiled anyway), extensions are not built for them.+ ---- Should be replaced by real control. AR 4/2/2005+ | mstatus m == MSIncomplete && isModCnc m = return (name,m)+ | otherwise = checkInModule cwd m NoLoc empty $ do+ m' <- foldM extOne m (mextend m) + return (name,m')+ where+ extOne mo (n,cond) = do+ m0 <- lookupModule gr n++ -- test that the module types match, and find out if the old is complete+ unless (sameMType (mtype m) (mtype mo)) + (checkError ("illegal extension type to module" <+> name))++ let isCompl = isCompleteModule m0++ -- build extension in a way depending on whether the old module is complete+ js1 <- extendMod gr isCompl ((n,m0), isInherited cond) name (jments mo)++ -- if incomplete, throw away extension information+ return $ + if isCompl+ then mo {jments = js1}+ else mo {mextend= filter ((/=n) . fst) (mextend mo)+ ,mexdeps= nub (n : mexdeps mo)+ ,jments = js1+ }++-- | rebuilding instance + interface, and "with" modules, prior to renaming. +-- AR 24/10/2003+rebuildModule :: FilePath -> SourceGrammar -> SourceModule -> Check SourceModule+rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js_)) =+ checkInModule cwd mi NoLoc empty $ do++---- deps <- moduleDeps ms+---- is <- openInterfaces deps i+ let is = [] ---- the method above is buggy: try "i -src" for two grs. AR 8/3/2005+ mi' <- case mw of++ -- add the information given in interface into an instance module+ Nothing -> do+ unless (null is || mstatus mi == MSIncomplete) + (checkError ("module" <+> i <+> + "has open interfaces and must therefore be declared incomplete"))+ case mt of+ MTInstance (i0,mincl) -> do+ m1 <- lookupModule gr i0+ unless (isModRes m1)+ (checkError ("interface expected instead of" <+> i0))+ js' <- extendMod gr False ((i0,m1), isInherited mincl) i (jments mi)+ --- to avoid double inclusions, in instance I of I0 = J0 ** ...+ case extends mi of+ [] -> return mi{jments=js'}+ j0s -> do+ m0s <- mapM (lookupModule gr) j0s+ let notInM0 c _ = all (not . isInBinTree c . jments) m0s+ let js2 = filterBinTree notInM0 js'+ return mi{jments=js2}+ _ -> return mi++ -- add the instance opens to an incomplete module "with" instances+ Just (ext,incl,ops) -> do+ let (infs,insts) = unzip ops+ let stat' = ifNull MSComplete (const MSIncomplete)+ [i | i <- is, notElem i infs]+ unless (stat' == MSComplete || stat == MSIncomplete) + (checkError ("module" <+> i <+> "remains incomplete"))+ ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext+ let ops1 = nub $+ ops_ ++ -- N.B. js has been name-resolved already+ [OQualif i j | (i,j) <- ops] +++ [o | o <- ops0, notElem (openedModule o) infs] +++ [OQualif i i | i <- insts] +++ [OSimple i | i <- insts]++ --- check if me is incomplete+ let fs1 = fs `addOptions` fs_ -- new flags have priority+ let js0 = [(c,globalizeLoc fpath j) | (c,j) <- tree2list js, isInherited incl c]+ let js1 = buildTree (tree2list js_ ++ js0)+ let med1= nub (ext : infs ++ insts ++ med_)+ return $ ModInfo mt0 stat' fs1 me Nothing ops1 med1 msrc_ env_ js1++ return (i,mi')++-- | When extending a complete module: new information is inserted,+-- and the process is interrupted if unification fails.+-- If the extended module is incomplete, its judgements are just copied.+extendMod :: Grammar ->+ Bool -> (Module,Ident -> Bool) -> ModuleName ->+ BinTree Ident Info -> Check (BinTree Ident Info)+extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jments mi) + where+ try new (c,i0)+ | not (cond c) = return new+ | otherwise = case Map.lookup c new of+ Just j -> case unifyAnyInfo name i j of+ Ok k -> return $ updateTree (c,k) new+ Bad _ -> do (base,j) <- case j of + AnyInd _ m -> lookupOrigInfo gr (m,c)+ _ -> return (base,j)+ (name,i) <- case i of + AnyInd _ m -> lookupOrigInfo gr (m,c)+ _ -> return (name,i)+ checkError ("cannot unify the information" $$ + nest 4 (ppJudgement Qualified (c,i)) $$+ "in module" <+> name <+> "with" $$+ nest 4 (ppJudgement Qualified (c,j)) $$+ "in module" <+> base)+ Nothing-> if isCompl+ then return $ updateTree (c,indirInfo name i) new+ else return $ updateTree (c,i) new+ where+ i = globalizeLoc (msrc mi) i0++ indirInfo :: ModuleName -> Info -> Info+ indirInfo n info = AnyInd b n' where + (b,n') = case info of+ ResValue _ -> (True,n)+ ResParam _ _ -> (True,n)+ AbsFun _ _ Nothing _ -> (True,n) + AnyInd b k -> (b,k)+ _ -> (False,n) ---- canonical in Abs++globalizeLoc fpath i =+ case i of+ AbsCat mc -> AbsCat (fmap gl mc)+ AbsFun mt ma md moper -> AbsFun (fmap gl mt) ma (fmap (fmap gl) md) moper+ ResParam mt mv -> ResParam (fmap gl mt) mv+ ResValue t -> ResValue (gl t)+ ResOper mt m -> ResOper (fmap gl mt) (fmap gl m)+ ResOverload ms os -> ResOverload ms (map (\(x,y) -> (gl x,gl y)) os)+ CncCat mc md mr mp mpmcfg-> CncCat (fmap gl mc) (fmap gl md) (fmap gl mr) (fmap gl mp) mpmcfg+ CncFun m mt md mpmcfg-> CncFun m (fmap gl mt) (fmap gl md) mpmcfg+ AnyInd b m -> AnyInd b m+ where+ gl (L loc0 x) = loc `seq` L (External fpath loc) x+ where+ loc = case loc0 of+ External _ loc -> loc+ loc -> loc++unifyAnyInfo :: ModuleName -> Info -> Info -> Err Info+unifyAnyInfo m i j = case (i,j) of+ (AbsCat mc1, AbsCat mc2) -> + liftM AbsCat (unifyMaybeL mc1 mc2)+ (AbsFun mt1 ma1 md1 moper1, AbsFun mt2 ma2 md2 moper2) -> + liftM4 AbsFun (unifyMaybeL mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) (unifyMaybe moper1 moper2) -- adding defs++ (ResParam mt1 mv1, ResParam mt2 mv2) ->+ liftM2 ResParam (unifyMaybeL mt1 mt2) (unifyMaybe mv1 mv2)+ (ResValue (L l1 t1), ResValue (L l2 t2)) + | t1==t2 -> return (ResValue (L l1 t1))+ | otherwise -> fail ""+ (_, ResOverload ms t) | elem m ms ->+ return $ ResOverload ms t+ (ResOper mt1 m1, ResOper mt2 m2) -> + liftM2 ResOper (unifyMaybeL mt1 mt2) (unifyMaybeL m1 m2)++ (CncCat mc1 md1 mr1 mp1 mpmcfg1, CncCat mc2 md2 mr2 mp2 mpmcfg2) -> + liftM5 CncCat (unifyMaybeL mc1 mc2) (unifyMaybeL md1 md2) (unifyMaybeL mr1 mr2) (unifyMaybeL mp1 mp2) (unifyMaybe mpmcfg1 mpmcfg2)+ (CncFun m mt1 md1 mpmcfg1, CncFun _ mt2 md2 mpmcfg2) -> + liftM3 (CncFun m) (unifyMaybeL mt1 mt2) (unifyMaybeL md1 md2) (unifyMaybe mpmcfg1 mpmcfg2)++ (AnyInd b1 m1, AnyInd b2 m2) -> do+ testErr (b1 == b2) $ "indirection status"+ testErr (m1 == m2) $ "different sources of indirection"+ return i++ _ -> fail "informations"++-- | this is what happens when matching two values in the same module+unifyMaybeL :: Eq a => Maybe (L a) -> Maybe (L a) -> Err (Maybe (L a))+unifyMaybeL = unifyMaybeBy unLoc++unifAbsArrity :: Maybe Int -> Maybe Int -> Err (Maybe Int)+unifAbsArrity = unifyMaybe++unifAbsDefs :: Maybe [L Equation] -> Maybe [L Equation] -> Err (Maybe [L Equation])+unifAbsDefs (Just xs) (Just ys) = return (Just (xs ++ ys))+unifAbsDefs Nothing Nothing = return Nothing+unifAbsDefs _ _ = fail ""
@@ -0,0 +1,261 @@+-- | Parallel grammar compilation+module GF.CompileInParallel(parallelBatchCompile) where+import Prelude hiding (catch,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint+import Control.Monad(join,ap,when,unless)+import Control.Applicative+import GF.Infra.Concurrency+import GF.System.Concurrency+import System.FilePath+import qualified GF.System.Directory as D+import GF.System.Catch(catch,try)+import Data.List(nub,isPrefixOf,intercalate,partition)+import qualified Data.Map as M+import GF.Compile.ReadFiles(getOptionsFromFile,findFile,gfImports,gfoImports,VersionTagged(..))+import GF.CompileOne(reuseGFO,useTheSource)+import GF.Infra.Option+import GF.Infra.UseIO+import GF.Data.Operations+import GF.Grammar.Grammar(emptyGrammar,prependModule)+import GF.Infra.Ident(moduleNameS)+import GF.Text.Pretty+import GF.System.Console(TermColors(..),getTermColors)+import qualified Data.ByteString.Lazy as BS++-- | Compile the given grammar files and everything they depend on,+-- like 'batchCompile'. This function compiles modules in parallel.+-- It keeps modules compiled in /present/ and /alltenses/ mode apart,+-- storing the @.gfo@ files in separate subdirectories to avoid creating+-- the broken PGF files that can result from mixing different modes in the+-- same concrete syntax.+--+-- The first argument controls the number of jobs to run in+-- parallel. This works if GF was compiled with GHC>=7.6, otherwise you have to+-- use the GHC run-time flag @+RTS -N -RTS@ to enable parallelism.+parallelBatchCompile jobs opts rootfiles0 =+ do setJobs jobs+ rootfiles <- mapM canonical rootfiles0+ lib_dirs1 <- getLibraryDirectory opts+ lib_dirs2 <- mapM canonical lib_dirs1+ let lib_dir = head lib_dirs2+ when (length lib_dirs2 >1) $ ePutStrLn ("GF_LIB_PATH defines more than one directory; using the first, " ++ show lib_dir)+ filepaths <- mapM (getPathFromFile [lib_dir] opts) rootfiles+ let groups = groupFiles lib_dir filepaths+ n = length groups+ when (n>1) $ ePutStrLn "Grammar mixes present and alltenses, dividing modules into two groups"+ (ts,sgrs) <- unzip <$> mapM (batchCompile1 lib_dir) groups+ return (maximum ts,sgrs)+ where+ groupFiles lib_dir filepaths =+ if length groups>1 then groups else [(opts,filepaths)]+ where+ groups = filter (not.null.snd) [(opts_p,present),(opts_a,alltenses)]+ (present,alltenses) = partition usesPresent filepaths+ gfoDir = flag optGFODir opts+ gfo = maybe "" id gfoDir+ opts_p = setGFO "present"+ opts_a = setGFO "alltenses"+ setGFO d = addOptions opts + (modifyFlags $ \ f->f{optGFODir=Just (gfo</>d)})++ usesPresent (_,paths) = take 1 libs==["present"]+ where+ libs = [p|path<-paths,+ let (d,p0) = splitAt n path+ p = dropSlash p0,+ d==lib_dir,p `elem` all_modes]+ n = length lib_dir ++ all_modes = ["alltenses","present"]++ dropSlash ('/':p) = p+ dropSlash ('\\':p) = p+ dropSlash p = p++setJobs opt_n =+ do ok <- setNumCapabilities opt_n+ when (not ok) $+ ePutStrLn $ "To set the number of concurrent threads"+ ++" you need to use +RTS -N"++maybe "" show opt_n+ ++"\n or recompile GF with ghc>=7.6"++batchCompile1 lib_dir (opts,filepaths) =+ do cwd <- D.getCurrentDirectory+ let rel = relativeTo lib_dir cwd+ prelude_dir = lib_dir</>"prelude"+ gfoDir = flag optGFODir opts+ maybe done (D.createDirectoryIfMissing True) gfoDir+{-+ liftIO $ writeFile (maybe "" id gfoDir</>"paths")+ (unlines . map (unwords . map rel) . nub $ map snd filepaths)+-}+ prelude_files <- maybe [] id <$> + maybeIO (D.getDirectoryContents prelude_dir)+ let fromPrelude f = lib_dir `isPrefixOf` f &&+ takeFileName f `elem` prelude_files+ ppPath ps = "-path="<>intercalate ":" (map rel ps)+ deps <- newMVar M.empty+ toLog <- newLog id+ term <- getTermColors+ let --logStrLn = toLog . ePutStrLn+ --ok :: CollectOutput IO a -> IO a+ ok (CO m) = err bad good =<< tryIOE m+ where+ good (o,r) = do toLog o; return r+ bad e = do toLog (redPutStrLn e); fail "failed"+ redPutStrLn s = do ePutStr (redFg term);ePutStr s+ ePutStrLn (restore term)+ sgr <- liftIO $ newMVar emptyGrammar+ let extendSgr sgr m =+ modifyMVar_ sgr $ \ gr ->+ do let gr' = prependModule gr m+-- logStrLn $ "Finished "++show (length (modules gr'))++" modules."+ return gr'+ fcache <- liftIO $ newIOCache $ \ _ (imp,Hide (f,ps)) ->+ do (file,_,_) <- findFile gfoDir ps imp+ return (file,(f,ps))+ let find f ps imp =+ do (file',(f',ps')) <- liftIO $ readIOCache fcache (imp,Hide (f,ps))+ when (ps'/=ps) $+ do (file,_,_) <- findFile gfoDir ps imp+ unless (file==file' || any fromPrelude [file,file']) $+ do eq <- liftIO $ (==) <$> BS.readFile file <*> BS.readFile file'+ unless eq $+ fail $ render $ + hang ("Ambiguous import of"<+>imp<>":") 4+ (hang (rel file<+>"from"<+>rel f) 4 (ppPath ps)+ $$+ hang (rel file'<+>"from"<+>rel f') 4 (ppPath ps'))+ return file'+ compile cache (file,paths) = readIOCache cache (file,Hide paths)+ compile' cache (f,Hide ps) =+ try $+ do let compileImport f = compile cache (f,ps)+ findImports (f,ps) = mapM (find f ps) . nub . snd+ =<< getImports opts f+ imps <- ok (findImports (f,ps))+ modifyMVar_ deps (return . M.insert f imps)+ ([],tis) <- splitEither <$> parMapM compileImport imps+ let reuse gfo = do t <- D.getModificationTime gfo+ gr <- readMVar sgr+ r <- lazyIO $ ok (reuseGFO opts gr gfo)+ return (t,snd r)+ compileSrc f =+ do gr <- readMVar sgr+ (Just gfo,mo) <- ok (useTheSource opts gr f)+ t <- D.getModificationTime gfo+ return (t,mo)+ (t,mo) <- if isGFO f+ then reuse f+ else do ts <- D.getModificationTime f+ let gfo = gf2gfo' gfoDir f+ to <- maybeIO (D.getModificationTime gfo)+ if to>=Just (maximum (ts:tis))+ then reuse gfo+ else compileSrc f+ extendSgr sgr mo+ return (maximum (t:tis))+ cache <- liftIO $ newIOCache compile'+ (es,ts) <- liftIO $ splitEither <$> parMapM (compile cache) filepaths+ gr <- readMVar sgr+ let cnc = moduleNameS (justModuleName (fst (last filepaths)))+ ds <- M.toList <$> readMVar deps+{-+ liftIO $ writeFile (maybe "" id gfoDir</>"dependencies")+ (unlines [rel f++": "++unwords (map rel imps)+ | (f,imps)<-ds])+-}+ putStrLnE $ render $+ length ds<+>"modules in"+ <+>length (nub (map (dropFileName.fst) ds))<+>"directories."+ let n = length es+ if n>0+ then fail $ "Errors prevented "++show n++" module"++['s'|n/=1]+++ " from being compiled."+ else return (maximum ts,(cnc,gr))++splitEither es = ([x|Left x<-es],[y|Right y<-es])++canonical path = liftIO $ D.canonicalizePath path `catch` const (return path)++getPathFromFile lib_dir cmdline_opts file =+ do --file <- getRealFile file+ file_opts <- getOptionsFromFile file+ let file_dir = dropFileName file+ opts = addOptions (fixRelativeLibPaths file_dir lib_dir file_opts)+ cmdline_opts+ paths <- mapM canonical . nub . (file_dir :) =<< extendPathEnv opts+ return (file,nub paths)++getImports opts file =+ if isGFO file then gfoImports' file else gfImports opts file+ where+ gfoImports' file = check =<< gfoImports file+ where+ check (Tagged imps) = return imps+ check WrongVersion = raise $ file++": .gfo file version mismatch"++relativeTo lib_dir cwd path =+ if length librel<length cwdrel then librel else cwdrel+ where+ librel = "%"</>makeRelative lib_dir path+ cwdrel = makeRelative cwd path++--------------------------------------------------------------------------------++data IOCache arg res+ = IOCache { op::arg->IO res,+ cache::MVar (M.Map arg (MVar res)) }++newIOCache op =+ do v <- newMVar M.empty+ let cache = IOCache (op cache) v+ return cache++readIOCache (IOCache op cacheVar) arg =+ join $ modifyMVar cacheVar $ \ cache ->+ case M.lookup arg cache of+ Nothing -> do v <- newEmptyMVar+ let doit = do res <- op arg+ putMVar v res+ return res+ return (M.insert arg v cache,doit)+ Just v -> do return (cache,readMVar v)+++newtype Hide a = Hide {reveal::a}+instance Eq (Hide a) where _ == _ = True+instance Ord (Hide a) where compare _ _ = EQ++--------------------------------------------------------------------------------+newtype CollectOutput m a = CO {unCO::m (m (),a)}+{-+runCO (CO m) = do (o,x) <- m+ o+ return x+-}+instance Functor m => Functor (CollectOutput m) where+ fmap f (CO m) = CO (fmap (fmap f) m)++instance (Functor m,Monad m) => Applicative (CollectOutput m) where + pure = return+ (<*>) = ap++instance Monad m => Monad (CollectOutput m) where+ return x = CO (return (done,x))+ CO m >>= f = CO $ do (o1,x) <- m+ let CO m2 = f x+ (o2,y) <- m2+ return (o1>>o2,y)+instance MonadIO m => MonadIO (CollectOutput m) where+ liftIO io = CO $ do x <- liftIO io+ return (done,x)++instance Output m => Output (CollectOutput m) where+ ePutStr s = CO (return (ePutStr s,()))+ ePutStrLn s = CO (return (ePutStrLn s,()))+ putStrLnE s = CO (return (putStrLnE s,()))+ putStrE s = CO (return (putStrE s,()))++instance ErrorMonad m => ErrorMonad (CollectOutput m) where+ raise e = CO (raise e)+ handle (CO m) h = CO $ handle m (unCO . h)
@@ -0,0 +1,172 @@+module GF.CompileOne(-- ** Compiling a single module+ OneOutput,CompiledModule,+ compileOne,reuseGFO,useTheSource+ --, CompileSource, compileSourceModule+ ) where++-- The main compiler passes+import GF.Compile.GetGrammar(getSourceModule)+import GF.Compile.Rename(renameModule)+import GF.Compile.CheckGrammar(checkModule)+import GF.Compile.Optimize(optimizeModule)+import GF.Compile.SubExOpt(subexpModule,unsubexpModule)+import GF.Compile.GeneratePMCFG(generatePMCFG)+import GF.Compile.Update(extendModule,rebuildModule)+import GF.Compile.Tags(writeTags,gf2gftags)++import GF.Grammar.Grammar+import GF.Grammar.Printer(ppModule,TermPrintQual(..))+import GF.Grammar.Binary(decodeModule,encodeModule)++import GF.Infra.Option+import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,MonadIO(..),Output(..),putPointE)+import GF.Infra.CheckM(runCheck')+import GF.Data.Operations(ErrorMonad,liftErr,(+++),done)++import GF.System.Directory(doesFileExist,getCurrentDirectory,renameFile)+import System.FilePath(makeRelative)+import System.Random(randomIO)+import qualified Data.Map as Map+import GF.Text.Pretty(render,(<+>),($$)) --Doc,+import GF.System.Console(TermColors(..),getTermColors)+import Control.Monad((<=<))++type OneOutput = (Maybe FullPath,CompiledModule)+type CompiledModule = Module++compileOne, reuseGFO, useTheSource ::+ (Output m,ErrorMonad m,MonadIO m) =>+ Options -> Grammar -> FullPath -> m OneOutput++-- | Compile a given source file (or just load a .gfo file),+-- given a 'Grammar' containing everything it depends on.+-- Calls 'reuseGFO' or 'useTheSource'.+compileOne opts srcgr file =+ if isGFO file+ then reuseGFO opts srcgr file+ else do b1 <- doesFileExist file+ if b1 then useTheSource opts srcgr file+ else reuseGFO opts srcgr (gf2gfo opts file)++-- | Read a compiled GF module.+-- Also undo common subexp optimization, to enable normal computations.+reuseGFO opts srcgr file =+ do cwd <- getCurrentDirectory+ let rfile = makeRelative cwd file+ sm00 <- putPointE Verbose opts ("+ reading" +++ rfile) $+ decodeModule file+ let sm0 = (fst sm00,(snd sm00){mflags=mflags (snd sm00) `addOptions` opts})++ idump opts Source sm0++ let sm1 = unsubexpModule sm0+ (sm,warnings) <- -- putPointE Normal opts "creating indirections" $ + runCheck' opts $ extendModule cwd srcgr sm1+ warnOut opts warnings++ if flag optTagsOnly opts+ then writeTags opts srcgr (gf2gftags opts file) sm1+ else done++ return (Just file,sm)++--useTheSource :: Options -> Grammar -> FullPath -> IOE OneOutput+-- | Compile GF module from source. It both returns the result and+-- stores it in a @.gfo@ file+-- (or a tags file, if running with the @-tags@ option)+useTheSource opts srcgr file =+ do cwd <- getCurrentDirectory+ let rfile = makeRelative cwd file+ sm <- putpOpt ("- parsing" +++ rfile)+ ("- compiling" +++ rfile ++ "... ")+ (getSourceModule opts file)+ idump opts Source sm+ compileSourceModule opts cwd (Just file) srcgr sm+ where+ putpOpt v m act+ | verbAtLeast opts Verbose = putPointE Normal opts v act+ | verbAtLeast opts Normal = putStrE m >> act+ | otherwise = putPointE Verbose opts v act++type CompileSource = Grammar -> Module -> IOE OneOutput++--compileSourceModule :: Options -> InitPath -> Maybe FilePath -> CompileSource+compileSourceModule opts cwd mb_gfFile gr =+ if flag optTagsOnly opts+ then generateTags <=< ifComplete middle <=< frontend+ else generateGFO <=< ifComplete (backend <=< middle) <=< frontend+ where+ -- Apply to all modules+ frontend = runPass Extend "" . extendModule cwd gr+ <=< runPass Rebuild "" . rebuildModule cwd gr++ -- Apply to complete modules+ middle = runPass TypeCheck "type checking" . checkModule opts cwd gr+ <=< runPass Rename "renaming" . renameModule cwd gr++ -- Apply to complete modules when not generating tags+ backend mo3 =+ do mo4 <- runPassE Optimize "optimizing" $ optimizeModule opts gr mo3+ if isModCnc (snd mo4) && flag optPMCFG opts+ then runPassI "generating PMCFG" $ generatePMCFG opts gr mb_gfFile mo4+ else runPassI "" $ return mo4++ ifComplete yes mo@(_,mi) =+ if isCompleteModule mi then yes mo else return mo++ generateGFO mo =+ do let mb_gfo = fmap (gf2gfo opts) mb_gfFile+ maybeM (flip (writeGFO opts cwd) mo) mb_gfo+ return (mb_gfo,mo)++ generateTags mo =+ do maybeM (flip (writeTags opts gr) mo . gf2gftags opts) mb_gfFile+ return (Nothing,mo)++ putpp s = if null s then id else putPointE Verbose opts (" "++s++" ")++ -- * Running a compiler pass, with impedance matching+ runPass = runPass' fst fst snd (liftErr . runCheck' opts)+ runPassE = runPass2e liftErr id+ runPassI = runPass2e id id Canon+ runPass2e lift dump = runPass' id dump (const "") lift++ runPass' ret dump warn lift pass pp m =+ do out <- putpp pp $ lift m+ warnOut opts (warn out)+ idump opts pass (dump out)+ return (ret out)++ maybeM f = maybe done f+++--writeGFO :: Options -> InitPath -> FilePath -> SourceModule -> IOE ()+writeGFO opts cwd file mo =+ putPointE Normal opts (" write file" +++ rfile) $+ do n <- liftIO randomIO --avoid name clashes when compiling with 'make -j'+ let tmp = file++".tmp" ++show (n::Int)+ encodeModule tmp mo2+ renameFile tmp file+ where+ rfile = makeRelative cwd file+ mo2 = (m,mi{jments=Map.filter notAnyInd (jments mi)})+ (m,mi) = subexpModule mo++ notAnyInd x = case x of AnyInd{} -> False; _ -> True++-- to output an intermediate stage+--intermOut :: Options -> Dump -> Doc -> IOE ()+intermOut opts d doc+ | dump opts d = ePutStrLn (render ("\n\n--#" <+> show d $$ doc))+ | otherwise = done++idump opts pass = intermOut opts (Dump pass) . ppModule Internal++warnOut opts warnings+ | null warnings = done+ | otherwise = do t <- getTermColors+ ePutStr (blueFg t);ePutStr ws;ePutStrLn (restore t)+ where+ ws = if flag optVerbosity opts == Normal+ then '\n':warnings+ else warnings
@@ -0,0 +1,171 @@+module GF.Compiler (mainGFC, linkGrammars, writePGF, writeOutputs) where++import PGF+import PGF.Internal(concretes,optimizePGF,unionPGF)+import PGF.Internal(putSplitAbs,encodeFile,runPut)+import GF.Compile as S(batchCompile,link,srcAbsName)+import GF.CompileInParallel as P(parallelBatchCompile)+import GF.Compile.Export+import GF.Compile.ConcreteToHaskell(concretes2haskell)+import GF.Compile.CFGtoPGF+import GF.Compile.GetGrammar+import GF.Grammar.BNFC+import GF.Grammar.CFG++--import GF.Infra.Ident(showIdent)+import GF.Infra.UseIO+import GF.Infra.Option+import GF.Data.ErrM+import GF.System.Directory+import GF.Text.Pretty(render)++import Data.Maybe+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.ByteString.Lazy as BSL+import System.FilePath+import Control.Monad(when,unless,forM_)++-- | Compile the given GF grammar files. The result is a number of @.gfo@ files+-- and, depending on the options, a @.pgf@ file. (@gf -batch@, @gf -make@)+mainGFC :: Options -> [FilePath] -> IO ()+mainGFC opts fs = do+ r <- tryIOE (case () of+ _ | null fs -> fail $ "No input files."+ _ | all (extensionIs ".cf") fs -> compileCFFiles opts fs+ _ | all (\f -> extensionIs ".gf" f || extensionIs ".gfo" f) fs -> compileSourceFiles opts fs+ _ | all (extensionIs ".pgf") fs -> unionPGFFiles opts fs+ _ -> fail $ "Don't know what to do with these input files: " ++ unwords fs)+ case r of+ Ok x -> return x+ Bad msg -> die $ if flag optVerbosity opts == Normal+ then ('\n':msg)+ else msg+ where+ extensionIs ext = (== ext) . takeExtension++compileSourceFiles :: Options -> [FilePath] -> IOE ()+compileSourceFiles opts fs = + do output <- batchCompile opts fs+ cncs2haskell output+ unless (flag optStopAfterPhase opts == Compile) $+ linkGrammars opts output+ where+ batchCompile = maybe batchCompile' parallelBatchCompile (flag optJobs opts)+ batchCompile' opts fs = do (t,cnc_gr) <- S.batchCompile opts fs+ return (t,[cnc_gr])++ cncs2haskell output =+ when (FmtHaskell `elem` flag optOutputFormats opts &&+ haskellOption opts HaskellConcrete) $+ mapM_ cnc2haskell (snd output)++ cnc2haskell (cnc,gr) =+ mapM_ writeHs $ concretes2haskell opts (srcAbsName gr cnc) gr++ writeHs (path,s) = writing opts path $ writeUTF8File path s+++-- | Create a @.pgf@ file (and possibly files in other formats, if specified+-- in the 'Options') from the output of 'parallelBatchCompile'.+-- If a @.pgf@ file by the same name already exists and it is newer than the+-- source grammar files (as indicated by the 'UTCTime' argument), it is not+-- recreated. Calls 'writePGF' and 'writeOutputs'.+linkGrammars opts (t_src,~cnc_grs@(~(cnc,gr):_)) =+ do let abs = render (srcAbsName gr cnc)+ pgfFile = outputPath opts (grammarName' opts abs<.>"pgf")+ t_pgf <- if outputJustPGF opts+ then maybeIO $ getModificationTime pgfFile+ else return Nothing+ if t_pgf >= Just t_src+ then putIfVerb opts $ pgfFile ++ " is up-to-date."+ else do pgfs <- mapM (link opts) cnc_grs+ let pgf = foldl1 unionPGF pgfs+ writePGF opts pgf+ writeOutputs opts pgf++compileCFFiles :: Options -> [FilePath] -> IOE ()+compileCFFiles opts fs = do+ bnfc_rules <- fmap concat $ mapM (getBNFCRules opts) fs+ let rules = bnfc2cf bnfc_rules+ startCat <- case rules of+ (Rule cat _ _ : _) -> return cat+ _ -> fail "empty CFG"+ let pgf = cf2pgf (last fs) (mkCFG startCat Set.empty rules)+ unless (flag optStopAfterPhase opts == Compile) $+ do probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)+ let pgf' = setProbabilities probs $ if flag optOptimizePGF opts then optimizePGF pgf else pgf+ writePGF opts pgf'+ writeOutputs opts pgf'++unionPGFFiles :: Options -> [FilePath] -> IOE ()+unionPGFFiles opts fs =+ if outputJustPGF opts+ then maybe doIt checkFirst (flag optName opts)+ else doIt+ where+ checkFirst name =+ do let pgfFile = outputPath opts (name <.> "pgf")+ sourceTime <- maximum `fmap` mapM getModificationTime fs+ targetTime <- maybeIO $ getModificationTime pgfFile+ if targetTime >= Just sourceTime+ then putIfVerb opts $ pgfFile ++ " is up-to-date."+ else doIt++ doIt =+ do pgfs <- mapM readPGFVerbose fs+ let pgf0 = foldl1 unionPGF pgfs+ pgf = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0+ pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")+ if pgfFile `elem` fs+ then putStrLnE $ "Refusing to overwrite " ++ pgfFile+ else writePGF opts pgf+ writeOutputs opts pgf++ readPGFVerbose f =+ putPointE Normal opts ("Reading " ++ f ++ "...") $ liftIO $ readPGF f++-- | Export the PGF to the 'OutputFormat's specified in the 'Options'.+-- Calls 'exportPGF'.+writeOutputs :: Options -> PGF -> IOE ()+writeOutputs opts pgf = do+ sequence_ [writeOutput opts name str + | fmt <- flag optOutputFormats opts,+ (name,str) <- exportPGF opts fmt pgf]++-- | Write the result of compiling a grammar (e.g. with 'compileToPGF' or+-- 'link') to a @.pgf@ file.+-- A split PGF file is output if the @-split-pgf@ option is used.+writePGF :: Options -> PGF -> IOE ()+writePGF opts pgf =+ if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF+ where+ writeNormalPGF =+ do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")+ writing opts outfile $ encodeFile outfile pgf++ writeSplitPGF =+ do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")+ writing opts outfile $ BSL.writeFile outfile (runPut (putSplitAbs pgf))+ --encodeFile_ outfile (putSplitAbs pgf)+ forM_ (Map.toList (concretes pgf)) $ \cnc -> do+ let outfile = outputPath opts (showCId (fst cnc) <.> "pgf_c")+ writing opts outfile $ encodeFile outfile cnc+++writeOutput :: Options -> FilePath-> String -> IOE ()+writeOutput opts file str = writing opts path $ writeUTF8File path str+ where path = outputPath opts file++-- * Useful helper functions++grammarName :: Options -> PGF -> String+grammarName opts pgf = grammarName' opts (showCId (abstractName pgf))+grammarName' opts abs = fromMaybe abs (flag optName opts)++outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)++outputPath opts file = maybe id (</>) (flag optOutputDir opts) file++writing opts path io =+ putPointE Normal opts ("Writing " ++ path ++ "...") $ liftIO io
@@ -0,0 +1,109 @@+module GF.CompilerAPI where++-- started by AR 28/1/2011 - STILL DUMMY++import GF.Compile+-- SHOULD IMPORT MUCH LESS++-- the main compiler passes+import GF.Compile.GetGrammar+import GF.Compile.Rename+import GF.Compile.CheckGrammar+import GF.Compile.Optimize+import GF.Compile.SubExOpt+import GF.Compile.GrammarToPGF+import GF.Compile.ReadFiles+import GF.Compile.Update+import GF.Compile.Refresh++import GF.Compile.Coding++import GF.Grammar.Grammar+import GF.Grammar.Lookup+import GF.Grammar.Printer+import GF.Grammar.Binary++import GF.Infra.Ident+import GF.Infra.Option+import GF.Infra.Modules+import GF.Infra.UseIO+import GF.Infra.CheckM++import GF.Data.Operations++import Control.Monad+import System.IO+import System.Directory+import System.FilePath+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.List(nub)+import Data.Maybe (isNothing)+import Data.Binary+import qualified Data.ByteString.Char8 as BS+import GF.Text.Pretty++import PGF.CId+import PGF.Data+import PGF.Macros+import PGF.Optimize+import PGF.Probabilistic++-- the main types++type GF = GF.Grammar.SourceGrammar+type PGF = PGF.PGF++-- some API functions - should take Options and perhaps some Env; return error msgs++exBasedGF :: FilePath -> IO GF++multiGF :: FilePath -> IO GF++getGF :: FilePath -> IO GF++cfGF :: FilePath -> IO GF++ebnfGF :: FilePath -> IO GF++emitGFO :: GF -> IO ()++readGFO :: FilePath -> IO GF++gf2pgf :: GF -> PGF++emitPGF :: PGF -> IO ()++readPGF :: FilePath -> IO PGF++emitJSGF :: PGF -> IO ()++emitSLF :: PGF -> IO ()++++exBasedGF = error "no exBasedGF"++multiGF = error "no multiGF"++getGF = error "no getGF"++cfGF = error "no cfGF"++ebnfGF = error "no ebnfGF"++emitGFO = error "no emitGFO"++readGFO = error "no readGFO"++gf2pgf = error "no gf2pgf" ++emitPGF = error "no emitPGF"++readPGF = error "no readPGF"++emitJSGF = error "no emitJSGF"++emitSLF = error "no emitSLF"++
@@ -0,0 +1,95 @@+----------------------------------------------------------------------+-- |+-- Module : BacktrackM+-- Maintainer : PL+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:00 $+-- > CVS $Author: bringert $+-- > CVS $Revision: 1.4 $+--+-- Backtracking state monad, with r\/o environment+-----------------------------------------------------------------------------++{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances #-}+module GF.Data.BacktrackM (+ -- * the backtracking state monad+ BacktrackM,+ -- * monad specific utilities+ member,+ cut,+ -- * running the monad+ foldBM, runBM,+ foldSolutions, solutions,+ foldFinalStates, finalStates,+ + -- * reexport the 'MonadState' class+ module Control.Monad.State.Class,+ ) where++import Data.List+import Control.Applicative+import Control.Monad+import Control.Monad.State.Class++----------------------------------------------------------------------+-- Combining endomorphisms and continuations+-- a la Ralf Hinze++-- BacktrackM = state monad transformer over the backtracking monad++newtype BacktrackM s a = BM (forall b . (a -> s -> b -> b) -> s -> b -> b)++-- * running the monad++runBM :: BacktrackM s a -> s -> [(s,a)]+runBM (BM m) s = m (\x s xs -> (s,x) : xs) s []++foldBM :: (a -> s -> b -> b) -> b -> BacktrackM s a -> s -> b+foldBM f b (BM m) s = m f s b++foldSolutions :: (a -> b -> b) -> b -> BacktrackM s a -> s -> b+foldSolutions f b (BM m) s = m (\x s b -> f x b) s b++solutions :: BacktrackM s a -> s -> [a]+solutions = foldSolutions (:) []++foldFinalStates :: (s -> b -> b) -> b -> BacktrackM s () -> s -> b+foldFinalStates f b (BM m) s = m (\x s b -> f s b) s b++finalStates :: BacktrackM s () -> s -> [s]+finalStates bm = map fst . runBM bm++instance Applicative (BacktrackM s) where+ pure = return+ (<*>) = ap++instance Monad (BacktrackM s) where+ return a = BM (\c s b -> c a s b)+ BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)+ where unBM (BM m) = m+ fail _ = mzero++instance Functor (BacktrackM s) where+ fmap f (BM m) = BM (\c s b -> m (\a s b -> c (f a) s b) s b)++instance Alternative (BacktrackM s) where+ empty = mzero+ (<|>) = mplus++instance MonadPlus (BacktrackM s) where+ mzero = BM (\c s b -> b)+ (BM f) `mplus` (BM g) = BM (\c s b -> g c s $! f c s b)++instance MonadState s (BacktrackM s) where+ get = BM (\c s b -> c s s b)+ put s = BM (\c _ b -> c () s b)++-- * specific functions on the backtracking monad++member :: [a] -> BacktrackM s a+member xs = BM (\c s b -> foldl' (\b x -> c x s b) b xs)++cut :: BacktrackM s a -> BacktrackM s [(s,a)]+cut f = BM (\c s b -> c (runBM f s) s b)
@@ -0,0 +1,57 @@+----------------------------------------------------------------------+-- |+-- Module : ErrM+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:00 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.5 $+--+-- hack for BNFC generated files. AR 21/9/2003+-----------------------------------------------------------------------------++module GF.Data.ErrM where++import Control.Monad (MonadPlus(..),ap)+import Control.Applicative++-- | Like 'Maybe' type with error msgs+data Err a = Ok a | Bad String+ deriving (Read, Show, Eq)++-- | 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++-- | Analogue of 'fromMaybe'+fromErr :: a -> Err a -> a+fromErr a = err (const a) id++instance Monad Err where+ return = Ok+ fail = Bad+ Ok a >>= f = f a+ Bad s >>= f = Bad s++-- | added 2\/10\/2003 by PEB+instance Functor Err where+ fmap f (Ok a) = Ok (f a)+ fmap f (Bad s) = Bad s++instance Applicative Err where+ pure = return+ (<*>) = ap++-- | added by KJ+instance MonadPlus Err where+ mzero = Bad "error (no reason given)"+ mplus (Ok a) _ = Ok a+ mplus (Bad s) b = b++instance Alternative Err where+ empty = mzero+ (<|>) = mplus
@@ -0,0 +1,178 @@+----------------------------------------------------------------------+-- |+-- Module : Graph+-- Maintainer : BB+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/10 16:43:44 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.2 $+--+-- A simple graph module.+-----------------------------------------------------------------------------+module GF.Data.Graph ( Graph(..), Node, Edge, NodeInfo+ , newGraph, nodes, edges+ , nmap, emap, newNode, newNodes, newEdge, newEdges+ , insertEdgeWith+ , removeNode, removeNodes+ , nodeInfo+ , getIncoming, getOutgoing, getNodeLabel+ , inDegree, outDegree+ , nodeLabel+ , edgeFrom, edgeTo, edgeLabel+ , reverseGraph, mergeGraphs, renameNodes+ ) where++--import GF.Data.Utilities++import Data.List+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++data Graph n a b = Graph [n] ![Node n a] ![Edge n b]+ deriving (Eq,Show)++type Node n a = (n,a)+type Edge n b = (n,n,b)++type NodeInfo n a b = Map n (a, [Edge n b], [Edge n b])++-- | Create a new empty graph.+newGraph :: [n] -> Graph n a b+newGraph ns = Graph ns [] []++-- | Get all the nodes in the graph.+nodes :: Graph n a b -> [Node n a]+nodes (Graph _ ns _) = ns++-- | Get all the edges in the graph.+edges :: Graph n a b -> [Edge n b]+edges (Graph _ _ es) = es++-- | Map a function over the node labels.+nmap :: (a -> c) -> Graph n a b -> Graph n c b+nmap f (Graph c ns es) = Graph c [(n,f l) | (n,l) <- ns] es++-- | Map a function over the edge labels.+emap :: (b -> c) -> Graph n a b -> Graph n a c+emap f (Graph c ns es) = Graph c ns [(x,y,f l) | (x,y,l) <- es]++-- | Add a node to the graph.+newNode :: a -- ^ Node label+ -> Graph n a b + -> (Graph n a b,n) -- ^ Node graph and name of new node+newNode l (Graph (c:cs) ns es) = (Graph cs ((c,l):ns) es, c)++newNodes :: [a] -> Graph n a b -> (Graph n a b,[Node n a])+newNodes ls g = (g', zip ns ls)+ where (g',ns) = mapAccumL (flip newNode) g ls+-- lazy version:+--newNodes ls (Graph cs ns es) = (Graph cs' (ns'++ns) es, ns')+-- where (xs,cs') = splitAt (length ls) cs+-- ns' = zip xs ls++newEdge :: Edge n b -> Graph n a b -> Graph n a b+newEdge e (Graph c ns es) = Graph c ns (e:es)++newEdges :: [Edge n b] -> Graph n a b -> Graph n a b+newEdges es g = foldl' (flip newEdge) g es+-- lazy version:+-- newEdges es' (Graph c ns es) = Graph c ns (es'++es)++insertEdgeWith :: Eq n => + (b -> b -> b) -> Edge n b -> Graph n a b -> Graph n a b+insertEdgeWith f e@(x,y,l) (Graph c ns es) = Graph c ns (h es)+ where h [] = [e]+ h (e'@(x',y',l'):es') | x' == x && y' == y = (x',y', f l l'):es'+ | otherwise = e':h es'++-- | Remove a node and all edges to and from that node.+removeNode :: Ord n => n -> Graph n a b -> Graph n a b+removeNode n = removeNodes (Set.singleton n)++-- | Remove a set of nodes and all edges to and from those nodes.+removeNodes :: Ord n => Set n -> Graph n a b -> Graph n a b+removeNodes xs (Graph c ns es) = Graph c ns' es'+ where + keepNode n = not (Set.member n xs)+ ns' = [ x | x@(n,_) <- ns, keepNode n ]+ es' = [ e | e@(f,t,_) <- es, keepNode f && keepNode t ]++-- | Get a map of node names to info about each node.+nodeInfo :: Ord n => Graph n a b -> NodeInfo n a b+nodeInfo g = Map.fromList [ (n, (x, fn inc n, fn out n)) | (n,x) <- nodes g ]+ where + inc = groupEdgesBy edgeTo g+ out = groupEdgesBy edgeFrom g+ fn m n = fromMaybe [] (Map.lookup n m)++groupEdgesBy :: (Ord n) => (Edge n b -> n) -- ^ Gets the node to group by+ -> Graph n a b -> Map n [Edge n b]+groupEdgesBy f g = Map.fromListWith (++) [(f e, [e]) | e <- edges g]++lookupNode :: Ord n => NodeInfo n a b -> n -> (a, [Edge n b], [Edge n b])+lookupNode i n = fromJust $ Map.lookup n i++getIncoming :: Ord n => NodeInfo n a b -> n -> [Edge n b]+getIncoming i n = let (_,inc,_) = lookupNode i n in inc++getOutgoing :: Ord n => NodeInfo n a b -> n -> [Edge n b]+getOutgoing i n = let (_,_,out) = lookupNode i n in out++inDegree :: Ord n => NodeInfo n a b -> n -> Int+inDegree i n = length $ getIncoming i n++outDegree :: Ord n => NodeInfo n a b -> n -> Int+outDegree i n = length $ getOutgoing i n++getNodeLabel :: Ord n => NodeInfo n a b -> n -> a+getNodeLabel i n = let (l,_,_) = lookupNode i n in l++nodeLabel :: Node n a -> a+nodeLabel = snd++edgeFrom :: Edge n b -> n+edgeFrom (f,_,_) = f++edgeTo :: Edge n b -> n+edgeTo (_,t,_) = t++edgeLabel :: Edge n b -> b+edgeLabel (_,_,l) = l++reverseGraph :: Graph n a b -> Graph n a b+reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ]++-- | Add the nodes from the second graph to the first graph.+-- The nodes in the second graph will be renamed using the name +-- supply in the first graph.+-- This function is more efficient when the second graph+-- is smaller than the first.+mergeGraphs :: Ord m => Graph n a b -> Graph m a b + -> (Graph n a b, m -> n) -- ^ The new graph and a function translating+ -- the old names of nodes in the second graph+ -- to names in the new graph.+mergeGraphs (Graph c ns1 es1) g2 = (Graph c' (ns2++ns1) (es2++es1), newName)+ where + (xs,c') = splitAt (length (nodes g2)) c+ newNames = Map.fromList (zip (map fst (nodes g2)) xs)+ newName n = fromJust $ Map.lookup n newNames+ Graph _ ns2 es2 = renameNodes newName undefined g2++-- | Rename the nodes in the graph.+renameNodes :: (n -> m) -- ^ renaming function+ -> [m] -- ^ infinite supply of fresh node names, to+ -- use when adding nodes in the future.+ -> Graph n a b -> Graph m a b+renameNodes newName c (Graph _ ns es) = Graph c ns' es'+ where ns' = map' (\ (n,x) -> (newName n,x)) ns+ es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es++-- | A strict 'map'+map' :: (a -> b) -> [a] -> [b]+map' _ [] = []+map' f (x:xs) = ((:) $! f x) $! map' f xs
@@ -0,0 +1,116 @@+----------------------------------------------------------------------+-- |+-- Module : Graphviz+-- Maintainer : BB+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/09/15 18:10:44 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.2 $+--+-- Graphviz DOT format representation and printing.+-----------------------------------------------------------------------------++module GF.Data.Graphviz (+ Graph(..), GraphType(..), + Node(..), Edge(..),+ Attr,+ addSubGraphs,+ setName,+ setAttr,+ prGraphviz+ ) where++import Data.Char++import GF.Data.Utilities++-- | Graph type, graph ID, graph attirbutes, graph nodes, graph edges, subgraphs+data Graph = Graph {+ gType :: GraphType,+ gId :: Maybe String,+ gAttrs :: [Attr],+ gNodes :: [Node],+ gEdges :: [Edge],+ gSubgraphs :: [Graph]+ }+ deriving (Show)++data GraphType = Directed | Undirected+ deriving (Show)++data Node = Node String [Attr]+ deriving Show++data Edge = Edge String String [Attr]+ deriving Show++type Attr = (String,String)++--+-- * Graph construction+--++addSubGraphs :: [Graph] -> Graph -> Graph+addSubGraphs gs g = g { gSubgraphs = gs ++ gSubgraphs g }++setName :: String -> Graph -> Graph+setName n g = g { gId = Just n }++setAttr :: String -> String -> Graph -> Graph+setAttr n v g = g { gAttrs = tableSet n v (gAttrs g) }++--+-- * Pretty-printing+--++prGraphviz :: Graph -> String+prGraphviz g@(Graph t i _ _ _ _) =+ graphtype t ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}\n"++prSubGraph :: Graph -> String+prSubGraph g@(Graph _ i _ _ _ _) = + "subgraph" ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}"++prGraph :: Graph -> String+prGraph (Graph t id at ns es ss) = + unlines $ map (++";") (map prAttr at+ ++ map prNode ns + ++ map (prEdge t) es+ ++ map prSubGraph ss)++graphtype :: GraphType -> String+graphtype Directed = "digraph"+graphtype Undirected = "graph"++prNode :: Node -> String+prNode (Node n at) = esc n ++ " " ++ prAttrList at++prEdge :: GraphType -> Edge -> String+prEdge t (Edge x y at) = esc x ++ " " ++ edgeop t ++ " " ++ esc y ++ " " ++ prAttrList at++edgeop :: GraphType -> String+edgeop Directed = "->"+edgeop Undirected = "--"++prAttrList :: [Attr] -> String+prAttrList [] = ""+prAttrList at = "[" ++ join "," (map prAttr at) ++ "]"++prAttr :: Attr -> String+prAttr (n,v) = esc n ++ " = " ++ esc v++esc :: String -> String+esc s | needEsc s = "\"" ++ concat [ if shouldEsc c then ['\\',c] else [c] | c <- s ] ++ "\""+ | otherwise = s+ where shouldEsc = (`elem` ['"', '\\'])++needEsc :: String -> Bool+needEsc [] = True+needEsc xs | all isDigit xs = False+needEsc (x:xs) = not (isIDFirst x && all isIDChar xs)++isIDFirst, isIDChar :: Char -> Bool+isIDFirst c = c `elem` (['_']++['a'..'z']++['A'..'Z'])+isIDChar c = isIDFirst c || isDigit c
@@ -0,0 +1,380 @@+----------------------------------------------------------------------+-- |+-- Module : Operations+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/11 16:12:41 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.22 $+--+-- some auxiliary GF operations. AR 19\/6\/1998 -- 6\/2\/2001+--+-- Copyright (c) Aarne Ranta 1998-2000, under GNU General Public License (see GPL)+-----------------------------------------------------------------------------++module GF.Data.Operations (+ -- ** The Error monad+ Err(..), err, maybeErr, testErr, fromErr, errIn, + lookupErr,++ -- ** Error monad class+ ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,+ liftErr,+ + -- ** Checking+ checkUnique, unifyMaybeBy, unifyMaybe,++ -- ** Monadic operations on lists and pairs+ mapPairListM, mapPairsM, pairM,++ -- ** Binary search trees; now with FiniteMap+ BinTree, emptyBinTree, isInBinTree, --justLookupTree,+ lookupTree, --lookupTreeMany,+ lookupTreeManyAll, updateTree,+ buildTree, filterBinTree,+ mapTree, --mapMTree,+ tree2list,+ + -- ** Printing+ indent, (+++), (++-), (++++), (+++-), (+++++),+ prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly, + prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,+ numberedParagraphs, prConjList, prIfEmpty, wrapLines,++ -- ** Topological sorting+ topoTest, topoTest2,++ -- ** Misc+ ifNull,+ combinations, done, readIntArg, --singleton,+ iterFix, chunks,+{-+ -- ** State monad with error; from Agda 6\/11\/2001+ STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM,+-}+ + ) where++import Data.Char (isSpace, toUpper, isSpace, isDigit)+import Data.List (nub, partition, (\\))+import qualified Data.Map as Map+import Data.Map (Map)+--import Control.Applicative(Applicative(..))+import Control.Monad (liftM,liftM2) --,ap++import GF.Data.ErrM+import GF.Data.Relation++infixr 5 ++++infixr 5 ++-+infixr 5 +++++infixr 5 +++++++ifNull :: b -> ([a] -> b) -> [a] -> b+ifNull b f xs = if null xs then b else f xs++-- the Error monad++-- | Add msg s to 'Maybe' failures+maybeErr :: ErrorMonad m => String -> Maybe a -> m a+maybeErr s = maybe (raise s) return++testErr :: ErrorMonad m => Bool -> String -> m ()+testErr cond msg = if cond then done else raise msg++errIn :: ErrorMonad m => String -> m a -> m a+errIn msg m = handle m (\s -> raise (s ++++ "OCCURRED IN" ++++ msg))++lookupErr :: (ErrorMonad m,Eq a,Show a) => a -> [(a,b)] -> m b+lookupErr a abs = maybeErr ("Unknown" +++ show a) (lookup a abs)++mapPairListM :: Monad m => ((a,b) -> m c) -> [(a,b)] -> m [(a,c)]+mapPairListM f xys = mapM (\ p@(x,_) -> liftM ((,) x) (f p)) xys++mapPairsM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]+mapPairsM f xys = mapM (\ (x,y) -> liftM ((,) x) (f y)) xys++pairM :: Monad m => (b -> m c) -> (b,b) -> m (c,c)+pairM op (t1,t2) = liftM2 (,) (op t1) (op t2)++-- checking++checkUnique :: (Show a, Eq a) => [a] -> [String]+checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where+ overloads = filter overloaded ss+ overloaded s = length (filter (==s) ss) > 1++-- | this is what happens when matching two values in the same module+unifyMaybe :: (Eq a, Monad m) => Maybe a -> Maybe a -> m (Maybe a)+unifyMaybe = unifyMaybeBy id++unifyMaybeBy :: (Eq b, Monad m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)+unifyMaybeBy f (Just p1) (Just p2)+ | f p1==f p2 = return (Just p1)+ | otherwise = fail ""+unifyMaybeBy _ Nothing mp2 = return mp2+unifyMaybeBy _ mp1 _ = return mp1++-- binary search trees++type BinTree a b = Map a b++emptyBinTree :: BinTree a b+emptyBinTree = Map.empty++isInBinTree :: (Ord a) => a -> BinTree a b -> Bool+isInBinTree = Map.member+{-+justLookupTree :: (ErrorMonad m,Ord a) => a -> BinTree a b -> m b+justLookupTree = lookupTree (const [])+-}+lookupTree :: (ErrorMonad m,Ord a) => (a -> String) -> a -> BinTree a b -> m b+lookupTree pr x = maybeErr no . Map.lookup x+ where no = "no occurrence of element" +++ pr x++lookupTreeManyAll :: Ord a => (a -> String) -> [BinTree a b] -> a -> [b]+lookupTreeManyAll pr (t:ts) x = case lookupTree pr x t of+ Ok v -> v : lookupTreeManyAll pr ts x+ _ -> lookupTreeManyAll pr ts x+lookupTreeManyAll pr [] x = []++updateTree :: (Ord a) => (a,b) -> BinTree a b -> BinTree a b+updateTree (a,b) = Map.insert a b++buildTree :: (Ord a) => [(a,b)] -> BinTree a b+buildTree = Map.fromList++mapTree :: ((a,b) -> c) -> BinTree a b -> BinTree a c+mapTree f = Map.mapWithKey (\k v -> f (k,v))++filterBinTree :: Ord a => (a -> b -> Bool) -> BinTree a b -> BinTree a b+filterBinTree = Map.filterWithKey++tree2list :: BinTree a b -> [(a,b)] -- inorder+tree2list = Map.toList++-- printing++indent :: Int -> String -> String+indent i s = replicate i ' ' ++ s++(+++), (++-), (++++), (+++-), (+++++) :: String -> String -> String+a +++ b = a ++ " " ++ b++a ++- "" = a +a ++- b = a +++ b++a ++++ b = a ++ "\n" ++ b++a +++- "" = a+a +++- b = a ++++ b++a +++++ b = a ++ "\n\n" ++ b+++prUpper :: String -> String+prUpper s = s1 ++ s2' where+ (s1,s2) = span isSpace s+ s2' = case s2 of+ c:t -> toUpper c : t+ _ -> s2++prReplicate :: Int -> String -> String+prReplicate n s = concat (replicate n s)++prTList :: String -> [String] -> String+prTList t ss = case ss of+ [] -> ""+ [s] -> s+ s:ss -> s ++ t ++ prTList t ss++prQuotedString :: String -> String+prQuotedString x = "\"" ++ restoreEscapes x ++ "\""++prParenth :: String -> String+prParenth s = if s == "" then "" else "(" ++ s ++ ")"++prCurly, prBracket :: String -> String+prCurly s = "{" ++ s ++ "}"+prBracket s = "[" ++ s ++ "]"++prArgList, prSemicList, prCurlyList :: [String] -> String+prArgList = prParenth . prTList "," +prSemicList = prTList " ; "+prCurlyList = prCurly . prSemicList++restoreEscapes :: String -> String+restoreEscapes s = + case s of + [] -> []+ '"' : t -> '\\' : '"' : restoreEscapes t+ '\\': t -> '\\' : '\\' : restoreEscapes t+ c : t -> c : restoreEscapes t++numberedParagraphs :: [[String]] -> [String]+numberedParagraphs t = case t of + [] -> []+ p:[] -> p+ _ -> concat [(show n ++ ".") : s | (n,s) <- zip [1..] t]++prConjList :: String -> [String] -> String+prConjList c [] = ""+prConjList c [s] = s+prConjList c [s,t] = s +++ c +++ t+prConjList c (s:tt) = s ++ "," +++ prConjList c tt++prIfEmpty :: String -> String -> String -> String -> String+prIfEmpty em _ _ [] = em+prIfEmpty em nem1 nem2 s = nem1 ++ s ++ nem2++-- | Thomas Hallgren's wrap lines+wrapLines :: Int -> String -> String+wrapLines n "" = ""+wrapLines n s@(c:cs) =+ if isSpace c+ then c:wrapLines (n+1) cs+ else case lex s of+ [(w,rest)] -> if n'>=76+ then '\n':w++wrapLines l rest+ else w++wrapLines n' rest+ where n' = n+l+ l = length w+ _ -> s -- give up!!++--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id++-- | 'combinations' is the same as 'sequence'!!!+-- peb 30\/5-04+combinations :: [[a]] -> [[a]]+combinations t = case t of + [] -> [[]]+ aa:uu -> [a:u | a <- aa, u <- combinations uu]++{-+-- | 'singleton' is the same as 'return'!!!+singleton :: a -> [a]+singleton = (:[])+-}++-- | Topological sorting with test of cyclicity+topoTest :: Ord a => [(a,[a])] -> Either [a] [[a]]+topoTest = topologicalSort . mkRel'++-- | Topological sorting with test of cyclicity, new version /TH 2012-06-26+topoTest2 :: Ord a => [(a,[a])] -> Either [[a]] [[a]]+topoTest2 g0 = maybe (Right cycles) Left (tsort g)+ where+ g = g0++[(n,[])|n<-nub (concatMap snd g0)\\map fst g0]++ cycles = findCycles (mkRel' g)++ tsort nes =+ case partition (null.snd) nes of+ ([],[]) -> Just []+ ([],_) -> Nothing+ (ns,rest) -> (leaves:) `fmap` tsort [(n,es \\ leaves) | (n,es)<-rest]+ where leaves = map fst ns+++-- | Fix point iterator (for computing e.g. transitive closures or reachability)+iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a]+iterFix more start = iter start start + where+ iter old new = if (null new')+ then old+ else iter (new' ++ old) new'+ where+ new' = filter (`notElem` old) (more new)++-- | chop into separator-separated parts+chunks :: Eq a => a -> [a] -> [[a]]+chunks sep ws = case span (/= sep) ws of+ (a,_:b) -> a : bs where bs = chunks sep b+ (a, []) -> if null a then [] else [a]++readIntArg :: String -> Int+readIntArg n = if (not (null n) && all isDigit n) then read n else 0++{-+-- 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 Functor (STM s) where fmap = liftM++instance Applicative (STM s) where+ pure = return+ (<*>) = ap++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))+-}+-- | @return ()@+done :: Monad m => m ()+done = return ()++class (Functor m,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++liftErr e = err raise return e+{-+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"+-}
@@ -0,0 +1,193 @@+----------------------------------------------------------------------+-- |+-- Module : Relation+-- Maintainer : BB+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/10/26 17:13:13 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.1 $+--+-- A simple module for relations.+-----------------------------------------------------------------------------++module GF.Data.Relation (Rel, mkRel, mkRel'+ , allRelated , isRelatedTo+ , transitiveClosure+ , reflexiveClosure, reflexiveClosure_+ , symmetricClosure+ , symmetricSubrelation, reflexiveSubrelation+ , reflexiveElements+ , equivalenceClasses+ , isTransitive, isReflexive, isSymmetric+ , isEquivalence+ , isSubRelationOf+ , topologicalSort, findCycles) where++import Data.Foldable (toList)+--import Data.List+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Set (Set)+import qualified Data.Set as Set++import GF.Data.Utilities++type Rel a = Map a (Set a)++-- | Creates a relation from a list of related pairs.+mkRel :: Ord a => [(a,a)] -> Rel a+mkRel ps = relates ps Map.empty++-- | Creates a relation from a list pairs of elements and the elements+-- related to them.+mkRel' :: Ord a => [(a,[a])] -> Rel a+mkRel' xs = Map.fromListWith Set.union [(x,Set.fromList ys) | (x,ys) <- xs]++relToList :: Ord a => Rel a -> [(a,a)]+relToList r = [ (x,y) | (x,ys) <- Map.toList r, y <- Set.toList ys ]++-- | Add a pair to the relation.+relate :: Ord a => a -> a -> Rel a -> Rel a+relate x y r = Map.insertWith Set.union x (Set.singleton y) r++-- | Add a list of pairs to the relation.+relates :: Ord a => [(a,a)] -> Rel a -> Rel a+relates ps r = foldl (\r' (x,y) -> relate x y r') r ps++-- | Checks if an element is related to another.+isRelatedTo :: Ord a => Rel a -> a -> a -> Bool+isRelatedTo r x y = maybe False (y `Set.member`) (Map.lookup x r)++-- | Get the set of elements to which a given element is related.+allRelated :: Ord a => Rel a -> a -> Set a+allRelated r x = fromMaybe Set.empty (Map.lookup x r)++-- | Get all elements in the relation.+domain :: Ord a => Rel a -> Set a+domain r = foldl Set.union (Map.keysSet r) (Map.elems r)++reverseRel :: Ord a => Rel a -> Rel a+reverseRel r = mkRel [(y,x) | (x,y) <- relToList r]++-- | Keep only pairs for which both elements are in the given set.+intersectSetRel :: Ord a => Set a -> Rel a -> Rel a+intersectSetRel s = filterRel (\x y -> x `Set.member` s && y `Set.member` s)++transitiveClosure :: Ord a => Rel a -> Rel a+transitiveClosure r = fix (Map.map growSet) r+ where growSet ys = foldl Set.union ys (map (allRelated r) $ Set.toList ys)++reflexiveClosure_ :: Ord a => [a] -- ^ The set over which the relation is defined.+ -> Rel a -> Rel a+reflexiveClosure_ u r = relates [(x,x) | x <- u] r++-- | Uses 'domain'+reflexiveClosure :: Ord a => Rel a -> Rel a+reflexiveClosure r = reflexiveClosure_ (Set.toList $ domain r) r++symmetricClosure :: Ord a => Rel a -> Rel a+symmetricClosure r = relates [ (y,x) | (x,y) <- relToList r ] r++symmetricSubrelation :: Ord a => Rel a -> Rel a+symmetricSubrelation r = filterRel (flip $ isRelatedTo r) r++reflexiveSubrelation :: Ord a => Rel a -> Rel a+reflexiveSubrelation r = intersectSetRel (reflexiveElements r) r++-- | Get the set of elements which are related to themselves.+reflexiveElements :: Ord a => Rel a -> Set a+reflexiveElements r = Set.fromList [ x | (x,ys) <- Map.toList r, x `Set.member` ys ]++-- | Keep the related pairs for which the predicate is true.+filterRel :: Ord a => (a -> a -> Bool) -> Rel a -> Rel a +filterRel p = fst . purgeEmpty . Map.mapWithKey (Set.filter . p)++-- | Remove keys that map to no elements.+purgeEmpty :: Ord a => Rel a -> (Rel a, Set a)+purgeEmpty r = let (r',r'') = Map.partition (not . Set.null) r+ in (r', Map.keysSet r'')++-- | Get the equivalence classes from an equivalence relation. +equivalenceClasses :: Ord a => Rel a -> [Set a]+equivalenceClasses r = equivalenceClasses_ (Map.keys r) r+ where equivalenceClasses_ [] _ = []+ equivalenceClasses_ (x:xs) r = ys:equivalenceClasses_ zs r+ where ys = allRelated r x+ zs = [x' | x' <- xs, not (x' `Set.member` ys)]++isTransitive :: Ord a => Rel a -> Bool+isTransitive r = and [z `Set.member` ys | (x,ys) <- Map.toList r, + y <- Set.toList ys, z <- Set.toList (allRelated r y)]++isReflexive :: Ord a => Rel a -> Bool+isReflexive r = all (\ (x,ys) -> x `Set.member` ys) (Map.toList r)++isSymmetric :: Ord a => Rel a -> Bool+isSymmetric r = and [isRelatedTo r y x | (x,y) <- relToList r]++isEquivalence :: Ord a => Rel a -> Bool+isEquivalence r = isReflexive r && isSymmetric r && isTransitive r++isSubRelationOf :: Ord a => Rel a -> Rel a -> Bool+isSubRelationOf r1 r2 = all (uncurry (isRelatedTo r2)) (relToList r1)++-- | Returns 'Left' if there are cycles, and 'Right' if there are cycles.+topologicalSort :: Ord a => Rel a -> Either [a] [[a]]+topologicalSort r = tsort r' noIncoming Seq.empty+ where r' = relToRel' r+ noIncoming = Seq.fromList [x | (x,(is,_)) <- Map.toList r', Set.null is]++tsort :: Ord a => Rel' a -> Seq a -> Seq a -> Either [a] [[a]]+tsort r xs l = case Seq.viewl xs of+ Seq.EmptyL | isEmpty' r -> Left (toList l)+ | otherwise -> Right (findCycles (rel'ToRel r))+ x Seq.:< xs -> tsort r' (xs Seq.>< Seq.fromList new) (l Seq.|> x)+ where (r',_,os) = remove x r+ new = [o | o <- Set.toList os, Set.null (incoming o r')]++findCycles :: Ord a => Rel a -> [[a]]+findCycles = map Set.toList . equivalenceClasses . reflexiveSubrelation . symmetricSubrelation . transitiveClosure++--+-- * Alternative representation that keeps both incoming and outgoing edges+--++-- | Keeps both incoming and outgoing edges.+type Rel' a = Map a (Set a, Set a)++isEmpty' :: Ord a => Rel' a -> Bool+isEmpty' = Map.null++relToRel' :: Ord a => Rel a -> Rel' a+relToRel' r = Map.unionWith (\ (i,_) (_,o) -> (i,o)) ir or+ where ir = Map.map (\s -> (s,Set.empty)) $ reverseRel r+ or = Map.map (\s -> (Set.empty,s)) $ r++rel'ToRel :: Ord a => Rel' a -> Rel a+rel'ToRel = Map.map snd++-- | Removes an element from a relation.+-- Returns the new relation, and the set of incoming and outgoing edges+-- of the removed element.+remove :: Ord a => a -> Rel' a -> (Rel' a, Set a, Set a)+remove x r = let (mss,r') = Map.updateLookupWithKey (\_ _ -> Nothing) x r+ in case mss of+ -- element was not in the relation+ Nothing -> (r', Set.empty, Set.empty)+ -- remove element from all incoming and outgoing sets+ -- of other elements+ Just (is,os) -> + let r'' = foldr (\i -> Map.adjust (\ (is',os') -> (is', Set.delete x os')) i) r' $ Set.toList is+ r''' = foldr (\o -> Map.adjust (\ (is',os') -> (Set.delete x is', os')) o) r'' $ Set.toList os+ in (r''', is, os)++incoming :: Ord a => a -> Rel' a -> Set a+incoming x r = maybe Set.empty fst $ Map.lookup x r++--outgoing :: Ord a => a -> Rel' a -> Set a+--outgoing x r = maybe Set.empty snd $ Map.lookup x r
@@ -0,0 +1,127 @@+----------------------------------------------------------------------+-- |+-- Maintainer : Peter Ljunglöf+-- Stability : stable+-- Portability : portable+--+-- > CVS $Date: 2005/04/21 16:22:08 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.3 $+--+-- Sets as sorted lists+--+-- * /O(n)/ union, difference and intersection +--+-- * /O(n log n)/ creating a set from a list (=sorting)+--+-- * /O(n^2)/ fixed point iteration+-----------------------------------------------------------------------------++module GF.Data.SortedList+ ( -- * type declarations+ SList, SMap,+ -- * set operations + nubsort, union, + (<++>), (<\\>), (<**>), + limit,+ hasCommonElements, subset, + -- * map operations+ groupPairs, groupUnion,+ unionMap, mergeMap+ ) where++import Data.List (groupBy)+import GF.Data.Utilities (split, foldMerge)++-- | The list must be sorted and contain no duplicates.+type SList a = [a]++-- | A sorted map also has unique keys, +-- i.e. 'map fst m :: SList a', if 'm :: SMap a b'+type SMap a b = SList (a, b)++-- | Group a set of key-value pairs into a sorted map+groupPairs :: Ord a => SList (a, b) -> SMap a (SList b)+groupPairs = map mapFst . groupBy eqFst+ where mapFst as = (fst (head as), map snd as)+ eqFst a b = fst a == fst b++-- | Group a set of key-(sets-of-values) pairs into a sorted map+groupUnion :: (Ord a, Ord b) => SList (a, SList b) -> SMap a (SList b)+groupUnion = map unionSnd . groupPairs+ where unionSnd (a, bs) = (a, union bs)++-- | True is the two sets has common elements+hasCommonElements :: Ord a => SList a -> SList a -> Bool+hasCommonElements as bs = not (null (as <**> bs))++-- | True if the first argument is a subset of the second argument+subset :: Ord a => SList a -> SList a -> Bool+xs `subset` ys = null (xs <\\> ys)++-- | Create a set from any list.+-- This function can also be used as an alternative to @nub@ in @List.hs@+nubsort :: Ord a => [a] -> SList a+nubsort = union . map return++-- | the union of a list of sorted maps+unionMap :: Ord a => (b -> b -> b) + -> [SMap a b] -> SMap a b+unionMap plus = foldMerge (mergeMap plus) []++-- | merging two sorted maps+mergeMap :: Ord a => (b -> b -> b) + -> SMap a b -> SMap a b -> SMap a b +mergeMap plus [] abs = abs+mergeMap plus abs [] = abs+mergeMap plus abs@(ab@(a,bs):abs') cds@(cd@(c,ds):cds')+ = case compare a c of+ EQ -> (a, plus bs ds) : mergeMap plus abs' cds'+ LT -> ab : mergeMap plus abs' cds+ GT -> cd : mergeMap plus abs cds'++-- | The union of a list of sets+union :: Ord a => [SList a] -> SList a+union = foldMerge (<++>) []++-- | The union of two sets+(<++>) :: Ord a => SList a -> SList a -> SList a +[] <++> bs = bs+as <++> [] = as+as@(a:as') <++> bs@(b:bs') = case compare a b of+ LT -> a : (as' <++> bs)+ GT -> b : (as <++> bs')+ EQ -> a : (as' <++> bs')++-- | The difference of two sets+(<\\>) :: Ord a => SList a -> SList a -> SList a +[] <\\> bs = []+as <\\> [] = as+as@(a:as') <\\> bs@(b:bs') = case compare a b of+ LT -> a : (as' <\\> bs)+ GT -> (as <\\> bs')+ EQ -> (as' <\\> bs')++-- | The intersection of two sets+(<**>) :: Ord a => SList a -> SList a -> SList a+[] <**> bs = []+as <**> [] = []+as@(a:as') <**> bs@(b:bs') = case compare a b of+ LT -> (as' <**> bs)+ GT -> (as <**> bs')+ EQ -> a : (as' <**> bs')++-- | A fixed point iteration +limit :: Ord a => (a -> SList a) -- ^ The iterator function+ -> SList a -- ^ The initial set+ -> SList a -- ^ The result of the iteration+limit more start = limit' start start+ where limit' chart agenda | null new' = chart+ | otherwise = limit' (chart <++> new') new'+ where new = union (map more agenda)+ new'= new <\\> chart+++++
@@ -0,0 +1,134 @@+----------------------------------------------------------------------+-- |+-- Module : Str+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:09 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.8 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Data.Str (+ Str, Tok, --- constructors no longer needed in PrGrammar+ str2strings, str, sstr, --sstrV, str2allStrings,+ plusStr, glueStr, --prStr, isZeroTok,+ strTok --, allItems+) where++--import GF.Data.Operations(prQuotedString)+import Data.List (isPrefixOf) --, intersperse, isSuffixOf++-- | abstract token list type. AR 2001, revised and simplified 20\/4\/2003+newtype Str = Str [Tok] deriving (Read, Show, Eq, Ord)++-- | notice that having both pre and post would leave to inconsistent situations:+--+-- > pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"}+--+-- always violates a condition expressed by the one or the other+data Tok = + TK String+ | TN Ss [(Ss, [String])] -- ^ variants depending on next string +--- | TP Ss [(Ss, [String])] -- variants depending on previous string+ deriving (Eq, Ord, Show, Read)+++-- | a variant can itself be a token list, but for simplicity only a list of strings+-- i.e. not itself containing variants+type Ss = [String]++-- matching functions in both ways++matchPrefix :: Ss -> [(Ss,[String])] -> [String] -> Ss+matchPrefix s vs t =+ head $ [u | t':_ <- [unmarkup t],+ (u,as) <- vs,+ any (`isPrefixOf` t') as]+ ++ [s]+{-+matchSuffix :: String -> Ss -> [(Ss,[String])] -> Ss+matchSuffix t s vs = + head ([u | (u,as) <- vs, any (\c -> isSuffixOf c t) as] ++ [s])+-}+unmarkup :: [String] -> [String]+unmarkup = filter (not . isXMLtag) where+ isXMLtag s = case s of+ '<':cs@(_:_) -> last cs == '>'+ _ -> False++str2strings :: Str -> Ss+str2strings (Str st) = alls st where + alls st = case st of+ TK s : ts -> s : alls ts+ TN ds vs : ts -> matchPrefix ds vs t ++ t where t = alls ts+---- u :TP ds vs: ts -> [u] ++ matchSuffix u ds vs ++ alls ts+ [] -> []+{-+str2allStrings :: Str -> [Ss]+str2allStrings (Str st) = alls st where + alls st = case st of+ TK s : ts -> [s : t | t <- alls ts]+ TN ds vs : [] -> [ds ++ v | v <- map fst vs]+ TN ds vs : ts -> [matchPrefix ds vs t ++ t | t <- alls ts]+ [] -> [[]]+-}+sstr :: Str -> String+sstr = unwords . str2strings+{-+-- | to handle a list of variants+sstrV :: [Str] -> String+sstrV ss = case ss of+ [] -> "*"+ _ -> unwords $ intersperse "/" $ map (unwords . str2strings) ss+-}+str :: String -> Str+str s = if null s then Str [] else Str [itS s]++itS :: String -> Tok+itS s = TK s+{-+isZeroTok :: Str -> Bool+isZeroTok t = case t of+ Str [] -> True+ Str [TK []] -> True+ _ -> False+-}+strTok :: Ss -> [(Ss,[String])] -> Str+strTok ds vs = Str [TN ds vs]+{-+prStr :: Str -> String+prStr = prQuotedString . sstr+-}+plusStr :: Str -> Str -> Str+plusStr (Str ss) (Str tt) = Str (ss ++ tt)++glueStr :: Str -> Str -> Str+glueStr (Str ss) (Str tt) = Str $ case (ss,tt) of+ ([],_) -> tt+ (_,[]) -> ss+ _ -> init ss ++ glueIt (last ss) (head tt) ++ tail tt+ where+ glueIt t u = case (t,u) of+ (TK s, TK s') -> return $ TK $ s ++ s'+ (TN ds vs, TN es ws) -> return $ TN (glues (matchPrefix ds vs es) es) + [(glues (matchPrefix ds vs w) w,cs) | (w,cs) <- ws]+ (TN ds vs, TK s) -> map TK $ glues (matchPrefix ds vs [s]) [s]+ (TK s, TN es ws) -> return $ TN (glues [s] es) [(glues [s] w, c) | (w,c) <- ws]++glues :: [[a]] -> [[a]] -> [[a]]+glues ss tt = case (ss,tt) of+ ([],_) -> tt+ (_,[]) -> ss+ _ -> init ss ++ [last ss ++ head tt] ++ tail tt+{-+-- | to create the list of all lexical items+allItems :: Str -> [String]+allItems (Str s) = concatMap allOne s where+ allOne t = case t of+ TK s -> [s]+ TN ds vs -> ds ++ concatMap fst vs+-}
@@ -0,0 +1,207 @@+----------------------------------------------------------------------+-- |+-- Maintainer : PL+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/10/26 18:47:16 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.6 $+--+-- Basic functions not in the standard libraries+-----------------------------------------------------------------------------+++module GF.Data.Utilities(module GF.Data.Utilities) where++import Data.Maybe+import Data.List+import Control.Monad (MonadPlus(..),liftM,when)+import qualified Data.Set as Set++-- * functions on lists++sameLength :: [a] -> [a] -> Bool+sameLength [] [] = True+sameLength (_:xs) (_:ys) = sameLength xs ys+sameLength _ _ = False++notLongerThan, longerThan :: Int -> [a] -> Bool+notLongerThan n = null . snd . splitAt n+longerThan n = not . notLongerThan n++lookupList :: Eq a => a -> [(a, b)] -> [b]+lookupList a [] = []+lookupList a (p:ps) | a == fst p = snd p : lookupList a ps+ | otherwise = lookupList a ps++split :: [a] -> ([a], [a])+split (x : y : as) = (x:xs, y:ys)+ where (xs, ys) = split as+split as = (as, [])++splitBy :: (a -> Bool) -> [a] -> ([a], [a])+splitBy p [] = ([], [])+splitBy p (a : as) = if p a then (a:xs, ys) else (xs, a:ys)+ where (xs, ys) = splitBy p as++foldMerge :: (a -> a -> a) -> a -> [a] -> a+foldMerge merge zero = fm+ where fm [] = zero+ fm [a] = a+ fm abs = let (as, bs) = split abs in fm as `merge` fm bs++select :: [a] -> [(a, [a])]+select [] = []+select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ]++updateNth :: (a -> a) -> Int -> [a] -> [a]+updateNth update 0 (a : as) = update a : as+updateNth update n (a : as) = a : updateNth update (n-1) as++updateNthM :: Monad m => (a -> m a) -> Int -> [a] -> m [a]+updateNthM update 0 (a : as) = liftM (:as) (update a)+updateNthM update n (a : as) = liftM (a:) (updateNthM update (n-1) as)++-- | Like 'init', but returns the empty list when the input is empty.+safeInit :: [a] -> [a]+safeInit [] = []+safeInit xs = init xs++-- | Sorts and then groups elements given an ordering of the +-- elements.+sortGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]]+sortGroupBy f = groupBy (compareEq f) . sortBy f++-- | Take the union of a list of lists.+unionAll :: Eq a => [[a]] -> [a]+unionAll = nub . concat++-- | Like 'lookup', but fails if the argument is not found,+-- instead of returning Nothing.+lookup' :: (Show a, Eq a) => a -> [(a,b)] -> b+lookup' x = fromMaybe (error $ "Not found: " ++ show x) . lookup x++-- | Like 'find', but fails if nothing is found.+find' :: (a -> Bool) -> [a] -> a+find' p = fromJust . find p++-- | Set a value in a lookup table.+tableSet :: Eq a => a -> b -> [(a,b)] -> [(a,b)]+tableSet x y [] = [(x,y)]+tableSet x y (p@(x',_):xs) | x' == x = (x,y):xs+ | otherwise = p:tableSet x y xs++-- | Group tuples by their first elements.+buildMultiMap :: Ord a => [(a,b)] -> [(a,[b])]+buildMultiMap = map (\g -> (fst (head g), map snd g) )+ . sortGroupBy (compareBy fst)++-- * equality functions++-- | Use an ordering function as an equality predicate.+compareEq :: (a -> a -> Ordering) -> a -> a -> Bool+compareEq f x y = case f x y of+ EQ -> True+ _ -> False++-- * ordering functions++compareBy :: Ord b => (a -> b) -> a -> a -> Ordering+compareBy f = both f compare++both :: (a -> b) -> (b -> b -> c) -> a -> a -> c+both f g x y = g (f x) (f y)++-- * functions on pairs++apFst :: (a -> a') -> (a, b) -> (a', b)+apFst f (a, b) = (f a, b)++apSnd :: (b -> b') -> (a, b) -> (a, b')+apSnd f (a, b) = (a, f b)++apBoth :: (a -> b) -> (a, a) -> (b, b)+apBoth f (x, y) = (f x, f y)++-- * functions on lists of pairs++mapFst = map . apFst+mapSnd = map . apSnd+mapBoth = map . apBoth++-- * functions on monads++-- | Return the given value if the boolean is true, els return 'mzero'.+whenMP :: MonadPlus m => Bool -> a -> m a+whenMP b x = if b then return x else mzero++whenM bm m = flip when m =<< bm++repeatM m = whenM m (repeatM m)++-- * functions on Maybes++-- | Returns true if the argument is Nothing or Just []+nothingOrNull :: Maybe [a] -> Bool+nothingOrNull = maybe True null++-- * functions on functions++-- | Apply all the functions in the list to the argument.+foldFuns :: [a -> a] -> a -> a+foldFuns fs x = foldl (flip ($)) x fs++-- | Fixpoint iteration.+fix :: Eq a => (a -> a) -> a -> a+fix f x = let x' = f x in if x' == x then x else fix f x'++-- * functions on strings++-- | Join a number of lists by using the given glue+-- between the lists.+join :: [a] -- ^ glue+ -> [[a]] -- ^ lists to join+ -> [a]+join g = concat . intersperse g++-- * ShowS-functions++nl :: ShowS+nl = showChar '\n'++sp :: ShowS+sp = showChar ' '++wrap :: String -> ShowS -> String -> ShowS+wrap o s c = showString o . s . showString c++concatS :: [ShowS] -> ShowS+concatS = foldr (.) id++unwordsS :: [ShowS] -> ShowS+unwordsS = joinS " "++unlinesS :: [ShowS] -> ShowS+unlinesS = joinS "\n"++joinS :: String -> [ShowS] -> ShowS+joinS glue = concatS . intersperse (showString glue)++++-- | Like 'Data.List.nub', but O(n log n) instead of O(n^2), since it uses a set to lookup previous things.+-- The result list is stable (the elements are returned in the order they occur), and lazy.+-- Requires that the list elements can be compared by Ord.+-- Code ruthlessly taken from <http://hpaste.org/54411>+nub' :: Ord a => [a] -> [a]+nub' = loop Set.empty+ where loop _ [] = []+ loop seen (x : xs)+ | Set.member x seen = loop seen xs+ | otherwise = x : loop (Set.insert x seen) xs+++-- | Replace all occurences of an element by another element.+replace :: Eq a => a -> a -> [a] -> [a]+replace x y = map (\z -> if z == x then y else z)
@@ -0,0 +1,57 @@+----------------------------------------------------------------------+-- |+-- Module : XML+--+-- Utilities for creating XML documents.+----------------------------------------------------------------------+module GF.Data.XML (XML(..), Attr, comments, showXMLDoc, showsXMLDoc, showsXML, bottomUpXML) where++import GF.Data.Utilities++data XML = Data String | CData String | Tag String [Attr] [XML] | ETag String [Attr] | Comment String | Empty+ deriving (Ord,Eq,Show)++type Attr = (String,String)++comments :: [String] -> [XML]+comments = map Comment++showXMLDoc :: XML -> String+showXMLDoc xml = showsXMLDoc xml ""++showsXMLDoc :: XML -> ShowS+showsXMLDoc xml = showString header . showsXML xml+ where header = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"++showsXML :: XML -> ShowS+showsXML = showsX 0 where+ showsX i x = ind i . case x of+ (Data s) -> showString s+ (CData s) -> showString "<![CDATA[" . showString s .showString "]]>"+ (ETag t as) -> showChar '<' . showString t . showsAttrs as . showString "/>"+ (Tag t as cs) -> + showChar '<' . showString t . showsAttrs as . showChar '>' . + concatS (map (showsX (i+1)) cs) . ind i . + showString "</" . showString t . showChar '>'+ (Comment c) -> showString "<!-- " . showString c . showString " -->"+ (Empty) -> id+ ind i = showString ("\n" ++ replicate (2*i) ' ')++showsAttrs :: [Attr] -> ShowS+showsAttrs = concatS . map (showChar ' ' .) . map showsAttr++showsAttr :: Attr -> ShowS+showsAttr (n,v) = showString n . showString "=\"" . showString (escape v) . showString "\""++escape :: String -> String+escape = concatMap escChar+ where+ escChar '<' = "<"+ escChar '>' = ">"+ escChar '&' = "&"+ escChar '"' = """+ escChar c = [c]++bottomUpXML :: (XML -> XML) -> XML -> XML+bottomUpXML f (Tag n attrs cs) = f (Tag n attrs (map (bottomUpXML f) cs))+bottomUpXML f x = f x
@@ -0,0 +1,257 @@+----------------------------------------------------------------------+-- |+-- Module : Zipper+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/06/11 20:27:05 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.9 $+--+-- Gérard Huet's zipper (JFP 7 (1997)). AR 10\/8\/2001+-----------------------------------------------------------------------------++module GF.Data.Zipper (-- * types+ Tr(..),+ Path(..),+ Loc(..),+ -- * basic (original) functions+ leaf,+ goLeft, goRight, goUp, goDown,+ changeLoc,+ changeNode,+ forgetNode,+ -- * added sequential representation+ goAhead,+ goBack,+ -- ** n-ary versions+ goAheadN,+ goBackN,+ -- * added mappings between locations and trees+ loc2tree,+ loc2treeMarked,+ tree2loc,+ goRoot,+ goLast,+ goPosition,+ getPosition,+ keepPosition,+ -- * added some utilities+ traverseCollect,+ scanTree,+ mapTr,+ mapTrM,+ mapPath,+ mapPathM,+ mapLoc,+ mapLocM,+ foldTr,+ foldTrM,+ mapSubtrees,+ mapSubtreesM,+ changeRoot,+ nthSubtree,+ arityTree+ ) where++import GF.Data.Operations++newtype Tr a = Tr (a,[Tr a]) deriving (Show,Eq)+ +data Path a = + Top + | Node ([Tr a], (Path a, a), [Tr a]) + deriving Show++leaf :: a -> Tr a+leaf a = Tr (a,[])++newtype Loc a = Loc (Tr a, Path a) deriving Show++goLeft, goRight, goUp, goDown :: Loc a -> Err (Loc a)+goLeft (Loc (t,p)) = case p of+ Top -> Bad "left of top"+ Node (l:left, upv, right) -> return $ Loc (l, Node (left,upv,t:right))+ Node _ -> Bad "left of first"+goRight (Loc (t,p)) = case p of+ Top -> Bad "right of top"+ Node (left, upv, r:right) -> return $ Loc (r, Node (t:left,upv,right))+ Node _ -> Bad "right of first"+goUp (Loc (t,p)) = case p of+ Top -> Bad "up of top"+ Node (left, (up,v), right) -> + return $ Loc (Tr (v, reverse left ++ (t:right)), up)+goDown (Loc (t,p)) = case t of+ Tr (v,(t1:trees)) -> return $ Loc (t1,Node ([],(p,v),trees))+ _ -> Bad "down of empty"++changeLoc :: Loc a -> Tr a -> Err (Loc a)+changeLoc (Loc (_,p)) t = return $ Loc (t,p)++changeNode :: (a -> a) -> Loc a -> Loc a+changeNode f (Loc (Tr (n,ts),p)) = Loc (Tr (f n, ts),p)++forgetNode :: Loc a -> Err (Loc a)+forgetNode (Loc (Tr (n,[t]),p)) = return $ Loc (t,p)+forgetNode _ = Bad $ "not a one-branch tree"++-- added sequential representation++-- | a successor function+goAhead :: Loc a -> Err (Loc a) +goAhead s@(Loc (t,p)) = case (t,p) of+ (Tr (_,_:_),Node (_,_,_:_)) -> goDown s+ (Tr (_,[]), _) -> upsRight s+ (_, _) -> goDown s+ where+ upsRight t = case goRight t of+ Ok t' -> return t'+ Bad _ -> goUp t >>= upsRight++-- | a predecessor function+goBack :: Loc a -> Err (Loc a) +goBack s@(Loc (t,p)) = case goLeft s of+ Ok s' -> downRight s'+ _ -> goUp s+ where+ downRight s = case goDown s of+ Ok s' -> case goRight s' of+ Ok s'' -> downRight s''+ _ -> downRight s' + _ -> return s++-- n-ary versions++goAheadN :: Int -> Loc a -> Err (Loc a)+goAheadN i st+ | i < 1 = return st+ | otherwise = goAhead st >>= goAheadN (i-1)++goBackN :: Int -> Loc a -> Err (Loc a)+goBackN i st+ | i < 1 = return st+ | otherwise = goBack st >>= goBackN (i-1)++-- added mappings between locations and trees++loc2tree :: Loc a -> Tr a+loc2tree (Loc (t,p)) = case p of+ Top -> t+ Node (left,(p',v),right) -> + loc2tree (Loc (Tr (v, reverse left ++ (t : right)),p'))++loc2treeMarked :: Loc a -> Tr (a, Bool)+loc2treeMarked (Loc (Tr (a,ts),p)) = + loc2tree (Loc (Tr (mark a, map (mapTr nomark) ts), mapPath nomark p)) + where + (mark, nomark) = (\a -> (a,True), \a -> (a, False))++tree2loc :: Tr a -> Loc a+tree2loc t = Loc (t,Top)++goRoot :: Loc a -> Loc a+goRoot = tree2loc . loc2tree++goLast :: Loc a -> Err (Loc a)+goLast = rep goAhead where+ rep f s = err (const (return s)) (rep f) (f s)++goPosition :: [Int] -> Loc a -> Err (Loc a)+goPosition p = go p . goRoot where+ go [] s = return s+ go (p:ps) s = goDown s >>= apply p goRight >>= go ps++getPosition :: Loc a -> [Int]+getPosition = reverse . getp where + getp (Loc (t,p)) = case p of+ Top -> []+ Node (left,(p',v),_) -> length left : getp (Loc (Tr (v, []),p'))++keepPosition :: (Loc a -> Err (Loc a)) -> (Loc a -> Err (Loc a))+keepPosition f s = do+ let p = getPosition s+ s' <- f s+ goPosition p s'++apply :: Monad m => Int -> (a -> m a) -> a -> m a+apply n f a = case n of+ 0 -> return a+ _ -> f a >>= apply (n-1) f++-- added some utilities++traverseCollect :: Path a -> [a]+traverseCollect p = reverse $ case p of+ Top -> []+ Node (_, (p',v), _) -> v : traverseCollect p'++scanTree :: Tr a -> [a]+scanTree (Tr (a,ts)) = a : concatMap scanTree ts++mapTr :: (a -> b) -> Tr a -> Tr b+mapTr f (Tr (x,ts)) = Tr (f x, map (mapTr f) ts)++mapTrM :: Monad m => (a -> m b) -> Tr a -> m (Tr b)+mapTrM f (Tr (x,ts)) = do+ fx <- f x+ fts <- mapM (mapTrM f) ts+ return $ Tr (fx,fts)++mapPath :: (a -> b) -> Path a -> Path b+mapPath f p = case p of+ Node (ts1, (p,v), ts2) -> + Node (map (mapTr f) ts1, (mapPath f p, f v), map (mapTr f) ts2)+ Top -> Top++mapPathM :: Monad m => (a -> m b) -> Path a -> m (Path b)+mapPathM f p = case p of+ Node (ts1, (p,v), ts2) -> do+ ts1' <- mapM (mapTrM f) ts1+ p' <- mapPathM f p+ v' <- f v + ts2' <- mapM (mapTrM f) ts2+ return $ Node (ts1', (p',v'), ts2')+ Top -> return Top++mapLoc :: (a -> b) -> Loc a -> Loc b+mapLoc f (Loc (t,p)) = Loc (mapTr f t, mapPath f p)++mapLocM :: Monad m => (a -> m b) -> Loc a -> m (Loc b)+mapLocM f (Loc (t,p)) = do+ t' <- mapTrM f t+ p' <- mapPathM f p+ return $ (Loc (t',p'))++foldTr :: (a -> [b] -> b) -> Tr a -> b+foldTr f (Tr (x,ts)) = f x (map (foldTr f) ts)++foldTrM :: Monad m => (a -> [b] -> m b) -> Tr a -> m b+foldTrM f (Tr (x,ts)) = do+ fts <- mapM (foldTrM f) ts+ f x fts++mapSubtrees :: (Tr a -> Tr a) -> Tr a -> Tr a+mapSubtrees f t = let Tr (x,ts) = f t in Tr (x, map (mapSubtrees f) ts)++mapSubtreesM :: Monad m => (Tr a -> m (Tr a)) -> Tr a -> m (Tr a)+mapSubtreesM f t = do+ Tr (x,ts) <- f t+ ts' <- mapM (mapSubtreesM f) ts+ return $ Tr (x, ts')++-- | change the root without moving the pointer+changeRoot :: (a -> a) -> Loc a -> Loc a+changeRoot f loc = case loc of+ Loc (Tr (a,ts),Top) -> Loc (Tr (f a,ts),Top)+ Loc (t, Node (left,pv,right)) -> Loc (t, Node (left,chPath pv,right))+ where+ chPath pv = case pv of + (Top,a) -> (Top, f a)+ (Node (left,pv,right),v) -> (Node (left, chPath pv,right),v)++nthSubtree :: Int -> Tr a -> Err (Tr a)+nthSubtree n (Tr (a,ts)) = ts !? n++arityTree :: Tr a -> Int+arityTree (Tr (_,ts)) = length ts
@@ -0,0 +1,27 @@+----------------------------------------------------------------------+-- |+-- Module : Abstract+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:18 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.4 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Grammar+ ( module GF.Grammar.Grammar,+ module GF.Grammar.Values,+ module GF.Grammar.Macros,+ module GF.Grammar.Printer,+ module GF.Infra.Ident+ ) where++import GF.Grammar.Grammar+import GF.Grammar.Values+import GF.Grammar.Macros+import GF.Grammar.Printer+import GF.Infra.Ident
@@ -0,0 +1,155 @@+module GF.Grammar.Analyse (+ stripSourceGrammar,+ constantDepsTerm,+ sizeTerm,+ sizeConstant,+ sizesModule,+ sizesGrammar,+ printSizesGrammar+ ) where++import GF.Grammar.Grammar+import GF.Infra.Ident+import GF.Text.Pretty(render)+--import GF.Infra.Option ---+import GF.Grammar.Macros+import GF.Grammar.Lookup++import GF.Data.Operations++import qualified Data.Map as Map+import Data.List (nub)+--import Debug.Trace++stripSourceGrammar :: Grammar -> Grammar+stripSourceGrammar sgr = mGrammar [(i, m{jments = Map.map stripInfo (jments m)}) | (i,m) <- modules sgr]++stripInfo :: Info -> Info+stripInfo i = case i of+ AbsCat _ -> i+ AbsFun mt mi me mb -> AbsFun mt mi Nothing mb+ ResParam mp mt -> ResParam mp Nothing+ ResValue lt -> i ----+ ResOper mt md -> ResOper mt Nothing+ ResOverload is fs -> ResOverload is [(lty, L loc (EInt 0)) | (lty,L loc _) <- fs]+ CncCat mty mte _ mtf mpmcfg -> CncCat mty Nothing Nothing Nothing Nothing+ CncFun mict mte mtf mpmcfg -> CncFun mict Nothing Nothing Nothing+ AnyInd b f -> i++constantsInTerm :: Term -> [QIdent]+constantsInTerm = nub . consts where+ consts t = case t of+ Q c -> [c]+ QC c -> [c]+ _ -> collectOp consts t++constantDeps :: Grammar -> QIdent -> Err [QIdent]+constantDeps sgr f = return $ nub $ iterFix more start where+ start = constants f+ more = concatMap constants+ constants c = (c :) $ fromErr [] $ do+ ts <- termsOfConstant sgr c+ return $ concatMap constantsInTerm ts++getIdTerm :: Term -> Err QIdent+getIdTerm t = case t of+ Q i -> return i+ QC i -> return i+ P (Vr r) l -> return (MN r,label2ident l) --- needed if term is received from parser+ _ -> Bad ("expected qualified constant, not " ++ show t)++constantDepsTerm :: Grammar -> Term -> Err [Term]+constantDepsTerm sgr t = do+ i <- getIdTerm t+ cs <- constantDeps sgr i+ return $ map Q cs --- losing distinction Q/QC++termsOfConstant :: Grammar -> QIdent -> Err [Term]+termsOfConstant sgr c = case lookupOverload sgr c of+ Ok tts -> return $ concat [[ty,tr] | (_,(ty,tr)) <- tts]+ _ -> return $+ [ty | Ok ty <- [lookupResType sgr c]] ++ -- type sig may be missing+ [ty | Ok ty <- [lookupResDef sgr c]]++sizeConstant :: Grammar -> Term -> Int+sizeConstant sgr t = err (const 0) id $ do+ c <- getIdTerm t+ fmap (sum . map sizeTerm) $ termsOfConstant sgr c++-- the number of constructors in a term, ignoring position information and unnecessary types+-- ground terms count as 1, i.e. as "one work" each+sizeTerm :: Term -> Int+sizeTerm t = case t of+ App c a -> sizeTerm c + sizeTerm a -- app nodes don't count + Abs _ _ b -> 2 + sizeTerm b+ Prod _ _ a b -> 2 + sizeTerm a + sizeTerm b + S c a -> 1 + sizeTerm c + sizeTerm a+ Table a c -> 1 + sizeTerm a + sizeTerm c+ ExtR a c -> 1 + sizeTerm a + sizeTerm c+ R r -> 1 + sum [1 + sizeTerm a | (_,(_,a)) <- r] -- label counts as 1, type ignored+ RecType r -> 1 + sum [1 + sizeTerm a | (_,a) <- r] -- label counts as 1+ P t i -> 2 + sizeTerm t+ T _ cc -> 1 + sum [1 + sizeTerm (patt2term p) + sizeTerm v | (p,v) <- cc]+ V ty cc -> 1 + sizeTerm ty + sum [1 + sizeTerm v | v <- cc]+ Let (x,(mt,a)) b -> 2 + maybe 0 sizeTerm mt + sizeTerm a + sizeTerm b+ C s1 s2 -> 1 + sizeTerm s1 + sizeTerm s2 + Glue s1 s2 -> 1 + sizeTerm s1 + sizeTerm s2 + Alts t aa -> 1 + sizeTerm t + sum [sizeTerm p + sizeTerm v | (p,v) <- aa]+ FV ts -> 1 + sum (map sizeTerm ts)+ Strs tt -> 1 + sum (map sizeTerm tt)+ _ -> 1+++-- the size of a judgement+sizeInfo :: Info -> Int+sizeInfo i = case i of+ AbsCat (Just (L _ co)) -> 1 + sum [1 + sizeTerm ty | (_,_,ty) <- co]+ AbsFun mt mi me mb -> 1 + msize mt + + sum [sum (map (sizeTerm . patt2term) ps) + sizeTerm t | Just es <- [me], L _ (ps,t) <- es]+ ResParam mp mt -> + 1 + sum [1 + sum [1 + sizeTerm ty | (_,_,ty) <- co] | Just (L _ ps) <- [mp], (_,co) <- ps]+ ResValue lt -> 0+ ResOper mt md -> 1 + msize mt + msize md+ ResOverload is fs -> 1 + sum [sizeTerm ty + sizeTerm tr | (L _ ty, L _ tr) <- fs]+ CncCat mty _ _ _ _ -> 1 + msize mty -- ignoring lindef, linref and printname+ CncFun mict mte mtf _ -> 1 + msize mte -- ignoring type and printname+ AnyInd b f -> -1 -- just to ignore these in the size+ _ -> 0+ where + msize mt = case mt of+ Just (L _ t) -> sizeTerm t+ _ -> 0+{-+-- the size of a module+sizeModule :: SourceModule -> Int+sizeModule = fst . sizesModule+-}+sizesModule :: SourceModule -> (Int, [(Ident,Int)])+sizesModule (_,m) = + let + js = Map.toList (jments m) + tb = [(i,k) | (i,j) <- js, let k = sizeInfo j, k >= 0]+ in (length tb + sum (map snd tb),tb)+{-+-- the size of a grammar+sizeGrammar :: Grammar -> Int+sizeGrammar = fst . sizesGrammar+-}+sizesGrammar :: Grammar -> (Int,[(ModuleName,(Int,[(Ident,Int)]))])+sizesGrammar g = + let + ms = modules g + mz = [(i,sizesModule m) | m@(i,j) <- ms]+ in (length mz + sum (map (fst . snd) mz), mz)++printSizesGrammar :: Grammar -> String+printSizesGrammar g = unlines $ + ("total" +++ show s):+ [render m +++ "total" +++ show i ++++ + unlines [indent 2 (showIdent j +++ show k) | (j,k) <- js]+ | (m,(i,js)) <- sg+ ]+ where+ (s,sg) = sizesGrammar g++
@@ -0,0 +1,110 @@+----------------------------------------------------------------------+-- |+-- Module : CFEG +-- Maintainer : Gleb Lobanov +-- Stability : (experimental)+-- Portability : (portable)+--+-- > CVS $Date: 2016/03/16 19:59:00 $ +-- > CVS $Author: Gleb Lobanov $+-- > CVS $Revision: 0.1 $+--+-- Contains a function to convert extended CF grammars to CF grammars. +-----------------------------------------------------------------------------++module GF.Grammar.BNFC(BNFCRule(..), BNFCSymbol, Symbol(..), CFTerm(..), bnfc2cf) where++import GF.Grammar.CFG+import PGF (Token, mkCId)+import Data.List (partition)++type IsList = Bool+type BNFCSymbol = Symbol (Cat, IsList) Token+data BNFCRule = BNFCRule {+ lhsCat :: Cat,+ ruleRhs :: [BNFCSymbol],+ ruleName :: CFTerm }+ | BNFCCoercions {+ coerCat :: Cat,+ coerNum :: Int }+ | BNFCTerminator {+ termNonEmpty :: Bool,+ termCat :: Cat,+ termSep :: String }+ | BNFCSeparator {+ sepNonEmpty :: Bool,+ sepCat :: Cat,+ sepSep :: String }+ deriving (Eq, Ord, Show)++type IsNonempty = Bool+type IsSeparator = Bool+type SepTermSymb = String +type SepMap = [(Cat, (IsNonempty, IsSeparator, SepTermSymb))]++bnfc2cf :: [BNFCRule] -> [ParamCFRule]+bnfc2cf rules = concatMap (transformRules (map makeSepTerm rules1)) rules2+ where (rules1,rules2) = partition isSepTerm rules+ makeSepTerm (BNFCTerminator ne c s) = (c, (ne, False, s))+ makeSepTerm (BNFCSeparator ne c s) = (c, (ne, True, s))++isSepTerm :: BNFCRule -> Bool+isSepTerm (BNFCTerminator {}) = True+isSepTerm (BNFCSeparator {}) = True+isSepTerm _ = False++transformRules :: SepMap -> BNFCRule -> [ParamCFRule]+transformRules sepMap (BNFCRule c smbs@(s:ss) r) = Rule (c,[0]) cfSmbs r : rls+ where smbs' = map (transformSymb sepMap) smbs+ cfSmbs = [snd s | s <- smbs']+ ids = filter (/= "") [fst s | s <- smbs']+ rls = concatMap (createListRules sepMap) ids+transformRules sepMap (BNFCCoercions c num) = rules ++ [lastRule]+ where rules = map (fRules c) [0..num-1]+ lastRule = Rule (c',[0]) ss rn+ where c' = c ++ show num+ ss = [Terminal "(", NonTerminal (c,[0]), Terminal ")"]+ rn = CFObj (mkCId $ "coercion_" ++ c) []++fRules c n = Rule (c',[0]) ss rn+ where c' = if n == 0 then c else c ++ show n+ ss = [NonTerminal (c ++ show (n+1),[0])]+ rn = CFObj (mkCId $ "coercion_" ++ c') []++transformSymb :: SepMap -> BNFCSymbol -> (String, ParamCFSymbol)+transformSymb sepMap s = case s of+ NonTerminal (c,False) -> ("", NonTerminal (c,[0]))+ NonTerminal (c,True ) -> let needsCoercion = + case lookup c sepMap of+ Just (ne, isSep, symb) -> isSep && symb /= "" && not ne+ Nothing -> False+ in (c , NonTerminal ("List" ++ c,if needsCoercion then [0,1] else [0]))+ Terminal t -> ("", Terminal t)++createListRules :: SepMap -> String -> [ParamCFRule]+createListRules sepMap c =+ case lookup c sepMap of+ Just (ne, isSep, symb) -> createListRules' ne isSep symb c+ Nothing -> createListRules' False True "" c++createListRules':: IsNonempty -> IsSeparator -> SepTermSymb -> String -> [ParamCFRule]+createListRules' ne isSep symb c = ruleBase : ruleCons+ where ruleBase = Rule ("List" ++ c,[0]) smbs rn+ where smbs = if isSep+ then [NonTerminal (c,[0]) | ne]+ else [NonTerminal (c,[0]) | ne] +++ [Terminal symb | symb /= "" && ne]+ rn = CFObj (mkCId $ "Base" ++ c) []+ ruleCons+ | isSep && symb /= "" && not ne = [Rule ("List" ++ c,[1]) smbs0 rn+ ,Rule ("List" ++ c,[1]) smbs1 rn]+ | otherwise = [Rule ("List" ++ c,[0]) smbs rn]+ where smbs0 =[NonTerminal (c,[0])] +++ [NonTerminal ("List" ++ c,[0])]+ smbs1 =[NonTerminal (c,[0])] +++ [Terminal symb] +++ [NonTerminal ("List" ++ c,[1])]+ smbs = [NonTerminal (c,[0])] +++ [Terminal symb | symb /= ""] +++ [NonTerminal ("List" ++ c,[0])]+ rn = CFObj (mkCId $ "Cons" ++ c) []
@@ -0,0 +1,349 @@+---------------------------------------------------------------------- +-- | +-- Module : GF.Grammar.Binary +-- Maintainer : Krasimir Angelov +-- Stability : (stable) +-- Portability : (portable) +-- +----------------------------------------------------------------------------- + +module GF.Grammar.Binary(VersionTagged(..),decodeModuleHeader,decodeModule,encodeModule) where + +import Prelude hiding (catch) +import Control.Exception(catch,ErrorCall(..),throwIO) + +import PGF.Internal(Binary(..),Word8,putWord8,getWord8,encodeFile,decodeFile) +import qualified Data.Map as Map(empty) +import qualified Data.ByteString.Char8 as BS + +import GF.Data.Operations +import GF.Infra.Ident +import GF.Infra.Option +import GF.Infra.UseIO(MonadIO(..)) +import GF.Grammar.Grammar + +import PGF() -- Binary instances +import PGF.Internal(Literal(..)) + +-- Please change this every time when the GFO format is changed +gfoVersion = "GF04" + +instance Binary Ident where + put id = put (ident2utf8 id) + get = do bs <- get + if bs == BS.pack "_" + then return identW + else return (identC (rawIdentC bs)) + +instance Binary ModuleName where + put (MN id) = put id + get = fmap MN get + +instance Binary Grammar where + put = put . modules + get = fmap mGrammar get + +instance Binary ModuleInfo where + put mi = do put (mtype mi,mstatus mi,mflags mi,mextend mi,mwith mi,mopens mi,mexdeps mi,msrc mi,mseqs mi,jments mi) + get = do (mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc,mseqs,jments) <- get + return (ModInfo mtype mstatus mflags mextend mwith mopens med msrc mseqs jments) + +instance Binary ModuleType where + put MTAbstract = putWord8 0 + put MTResource = putWord8 2 + put (MTConcrete i) = putWord8 3 >> put i + put MTInterface = putWord8 4 + put (MTInstance i) = putWord8 5 >> put i + get = do tag <- getWord8 + case tag of + 0 -> return MTAbstract + 2 -> return MTResource + 3 -> get >>= return . MTConcrete + 4 -> return MTInterface + 5 -> get >>= return . MTInstance + _ -> decodingError + +instance Binary MInclude where + put MIAll = putWord8 0 + put (MIOnly xs) = putWord8 1 >> put xs + put (MIExcept xs) = putWord8 2 >> put xs + get = do tag <- getWord8 + case tag of + 0 -> return MIAll + 1 -> fmap MIOnly get + 2 -> fmap MIExcept get + _ -> decodingError + +instance Binary OpenSpec where + put (OSimple i) = putWord8 0 >> put i + put (OQualif i j) = putWord8 1 >> put (i,j) + get = do tag <- getWord8 + case tag of + 0 -> get >>= return . OSimple + 1 -> get >>= \(i,j) -> return (OQualif i j) + _ -> decodingError + +instance Binary ModuleStatus where + put MSComplete = putWord8 0 + put MSIncomplete = putWord8 1 + get = do tag <- getWord8 + case tag of + 0 -> return MSComplete + 1 -> return MSIncomplete + _ -> decodingError + +instance Binary Options where + put = put . optionsGFO + get = do opts <- get + case parseModuleOptions ["--" ++ flag ++ "=" ++ toString value | (flag,value) <- opts] of + Ok x -> return x + Bad msg -> fail msg + where + toString (LStr s) = s + toString (LInt n) = show n + toString (LFlt d) = show d + +instance Binary Production where + put (Production res funid args) = put (res,funid,args) + get = do res <- get + funid <- get + args <- get + return (Production res funid args) + +instance Binary PMCFG where + put (PMCFG prods funs) = put (prods,funs) + get = do prods <- get + funs <- get + return (PMCFG prods funs) + +instance Binary Info where + put (AbsCat x) = putWord8 0 >> put x + put (AbsFun w x y z) = putWord8 1 >> put (w,x,y,z) + put (ResParam x y) = putWord8 2 >> put (x,y) + put (ResValue x) = putWord8 3 >> put x + put (ResOper x y) = putWord8 4 >> put (x,y) + put (ResOverload x y)= putWord8 5 >> put (x,y) + put (CncCat v w x y z)=putWord8 6 >> put (v,w,x,y,z) + put (CncFun w x y z) = putWord8 7 >> put (w,x,y,z) + put (AnyInd x y) = putWord8 8 >> put (x,y) + get = do tag <- getWord8 + case tag of + 0 -> get >>= \x -> return (AbsCat x) + 1 -> get >>= \(w,x,y,z) -> return (AbsFun w x y z) + 2 -> get >>= \(x,y) -> return (ResParam x y) + 3 -> get >>= \x -> return (ResValue x) + 4 -> get >>= \(x,y) -> return (ResOper x y) + 5 -> get >>= \(x,y) -> return (ResOverload x y) + 6 -> get >>= \(v,w,x,y,z)->return (CncCat v w x y z) + 7 -> get >>= \(w,x,y,z) -> return (CncFun w x y z) + 8 -> get >>= \(x,y) -> return (AnyInd x y) + _ -> decodingError + +instance Binary Location where + put NoLoc = putWord8 0 + put (Local x y) = putWord8 1 >> put (x,y) + put (External x y) = putWord8 2 >> put (x,y) + get = do tag <- getWord8 + case tag of + 0 -> return NoLoc + 1 -> get >>= \(x,y) -> return (Local x y) + 2 -> get >>= \(x,y) -> return (External x y) + +instance Binary a => Binary (L a) where + put (L x y) = put (x,y) + get = get >>= \(x,y) -> return (L x y) + +instance Binary Term where + put (Vr x) = putWord8 0 >> put x + put (Cn x) = putWord8 1 >> put x + put (Con x) = putWord8 2 >> put x + put (Sort x) = putWord8 3 >> put x + put (EInt x) = putWord8 4 >> put x + put (EFloat x) = putWord8 5 >> put x + put (K x) = putWord8 6 >> put x + put (Empty) = putWord8 7 + put (App x y) = putWord8 8 >> put (x,y) + put (Abs x y z) = putWord8 9 >> put (x,y,z) + put (Meta x) = putWord8 10 >> put x + put (ImplArg x) = putWord8 11 >> put x + put (Prod w x y z)= putWord8 12 >> put (w,x,y,z) + put (Typed x y) = putWord8 13 >> put (x,y) + put (Example x y) = putWord8 14 >> put (x,y) + put (RecType x) = putWord8 15 >> put x + put (R x) = putWord8 16 >> put x + put (P x y) = putWord8 17 >> put (x,y) + put (ExtR x y) = putWord8 18 >> put (x,y) + put (Table x y) = putWord8 19 >> put (x,y) + put (T x y) = putWord8 20 >> put (x,y) + put (V x y) = putWord8 21 >> put (x,y) + put (S x y) = putWord8 22 >> put (x,y) + put (Let x y) = putWord8 23 >> put (x,y) + put (Q x) = putWord8 24 >> put x + put (QC x) = putWord8 25 >> put x + put (C x y) = putWord8 26 >> put (x,y) + put (Glue x y) = putWord8 27 >> put (x,y) + put (EPatt x) = putWord8 28 >> put x + put (EPattType x) = putWord8 29 >> put x + put (ELincat x y) = putWord8 30 >> put (x,y) + put (ELin x y) = putWord8 31 >> put (x,y) + put (FV x) = putWord8 32 >> put x + put (Alts x y) = putWord8 33 >> put (x,y) + put (Strs x) = putWord8 34 >> put x + put (Error x) = putWord8 35 >> put x + + get = do tag <- getWord8 + case tag of + 0 -> get >>= \x -> return (Vr x) + 1 -> get >>= \x -> return (Cn x) + 2 -> get >>= \x -> return (Con x) + 3 -> get >>= \x -> return (Sort x) + 4 -> get >>= \x -> return (EInt x) + 5 -> get >>= \x -> return (EFloat x) + 6 -> get >>= \x -> return (K x) + 7 -> return (Empty) + 8 -> get >>= \(x,y) -> return (App x y) + 9 -> get >>= \(x,y,z) -> return (Abs x y z) + 10 -> get >>= \x -> return (Meta x) + 11 -> get >>= \x -> return (ImplArg x) + 12 -> get >>= \(w,x,y,z)->return (Prod w x y z) + 13 -> get >>= \(x,y) -> return (Typed x y) + 14 -> get >>= \(x,y) -> return (Example x y) + 15 -> get >>= \x -> return (RecType x) + 16 -> get >>= \x -> return (R x) + 17 -> get >>= \(x,y) -> return (P x y) + 18 -> get >>= \(x,y) -> return (ExtR x y) + 19 -> get >>= \(x,y) -> return (Table x y) + 20 -> get >>= \(x,y) -> return (T x y) + 21 -> get >>= \(x,y) -> return (V x y) + 22 -> get >>= \(x,y) -> return (S x y) + 23 -> get >>= \(x,y) -> return (Let x y) + 24 -> get >>= \x -> return (Q x) + 25 -> get >>= \x -> return (QC x) + 26 -> get >>= \(x,y) -> return (C x y) + 27 -> get >>= \(x,y) -> return (Glue x y) + 28 -> get >>= \x -> return (EPatt x) + 29 -> get >>= \x -> return (EPattType x) + 30 -> get >>= \(x,y) -> return (ELincat x y) + 31 -> get >>= \(x,y) -> return (ELin x y) + 32 -> get >>= \x -> return (FV x) + 33 -> get >>= \(x,y) -> return (Alts x y) + 34 -> get >>= \x -> return (Strs x) + 35 -> get >>= \x -> return (Error x) + _ -> decodingError + +instance Binary Patt where + put (PC x y) = putWord8 0 >> put (x,y) + put (PP x y) = putWord8 1 >> put (x,y) + put (PV x) = putWord8 2 >> put x + put (PW) = putWord8 3 + put (PR x) = putWord8 4 >> put x + put (PString x) = putWord8 5 >> put x + put (PInt x) = putWord8 6 >> put x + put (PFloat x) = putWord8 7 >> put x + put (PT x y) = putWord8 8 >> put (x,y) + put (PAs x y) = putWord8 10 >> put (x,y) + put (PNeg x) = putWord8 11 >> put x + put (PAlt x y) = putWord8 12 >> put (x,y) + put (PSeq x y) = putWord8 13 >> put (x,y) + put (PRep x) = putWord8 14 >> put x + put (PChar) = putWord8 15 + put (PChars x) = putWord8 16 >> put x + put (PMacro x) = putWord8 17 >> put x + put (PM x) = putWord8 18 >> put x + put (PTilde x) = putWord8 19 >> put x + put (PImplArg x) = putWord8 20 >> put x + get = do tag <- getWord8 + case tag of + 0 -> get >>= \(x,y) -> return (PC x y) + 1 -> get >>= \(x,y) -> return (PP x y) + 2 -> get >>= \x -> return (PV x) + 3 -> return (PW) + 4 -> get >>= \x -> return (PR x) + 5 -> get >>= \x -> return (PString x) + 6 -> get >>= \x -> return (PInt x) + 7 -> get >>= \x -> return (PFloat x) + 8 -> get >>= \(x,y) -> return (PT x y) + 10 -> get >>= \(x,y) -> return (PAs x y) + 11 -> get >>= \x -> return (PNeg x) + 12 -> get >>= \(x,y) -> return (PAlt x y) + 13 -> get >>= \(x,y) -> return (PSeq x y) + 14 -> get >>= \x -> return (PRep x) + 15 -> return (PChar) + 16 -> get >>= \x -> return (PChars x) + 17 -> get >>= \x -> return (PMacro x) + 18 -> get >>= \x -> return (PM x) + 19 -> get >>= \x -> return (PTilde x) + 20 -> get >>= \x -> return (PImplArg x) + _ -> decodingError + +instance Binary TInfo where + put TRaw = putWord8 0 + put (TTyped t) = putWord8 1 >> put t + put (TComp t) = putWord8 2 >> put t + put (TWild t) = putWord8 3 >> put t + get = do tag <- getWord8 + case tag of + 0 -> return TRaw + 1 -> fmap TTyped get + 2 -> fmap TComp get + 3 -> fmap TWild get + _ -> decodingError + +instance Binary Label where + put (LIdent bs) = putWord8 0 >> put bs + put (LVar i) = putWord8 1 >> put i + get = do tag <- getWord8 + case tag of + 0 -> fmap LIdent get + 1 -> fmap LVar get + _ -> decodingError + +--putGFOVersion = mapM_ (putWord8 . fromIntegral . ord) gfoVersion +--getGFOVersion = replicateM (length gfoVersion) (fmap (chr . fromIntegral) getWord8) +--putGFOVersion = put gfoVersion +--getGFOVersion = get :: Get VersionMagic + + +data VersionTagged a = Tagged {unV::a} | WrongVersion + +instance Binary a => Binary (VersionTagged a) where + put (Tagged a) = put (gfoBinVersion,a) + get = do ver <- get + if ver==gfoBinVersion + then fmap Tagged get + else return WrongVersion + +instance Functor VersionTagged where + fmap f (Tagged a) = Tagged (f a) + fmap f WrongVersion = WrongVersion + +gfoBinVersion = (b1,b2,b3,b4) + where [b1,b2,b3,b4] = map (toEnum.fromEnum) gfoVersion :: [Word8] + + +decodeModule :: MonadIO io => FilePath -> io SourceModule +decodeModule fpath = liftIO $ check =<< decodeFile' fpath + where + check (Tagged m) = return m + check _ = fail ".gfo file version mismatch" + +-- | Read just the module header, the returned 'Module' will have an empty body +decodeModuleHeader :: MonadIO io => FilePath -> io (VersionTagged Module) +decodeModuleHeader = liftIO . fmap (fmap conv) . decodeFile' + where + conv (m,mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc) = + (m,ModInfo mtype mstatus mflags mextend mwith mopens med msrc Nothing Map.empty) + +encodeModule :: MonadIO io => FilePath -> SourceModule -> io () +encodeModule fpath mo = liftIO $ encodeFile fpath (Tagged mo) + +-- | like 'decodeFile' but adds file name to error message if there was an error +decodeFile' fpath = addFPath fpath (decodeFile fpath) + +-- | Adds file name to error message if there was an error, +-- | but laziness can cause errors to slip through +addFPath fpath m = m `catch` handle + where + handle (ErrorCall msg) = throwIO (ErrorCall (fpath++": "++msg)) + +decodingError = fail "This file was compiled with different version of GF"
@@ -0,0 +1,386 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Grammar.CFG+--+-- Context-free grammar representation and manipulation.+----------------------------------------------------------------------+module GF.Grammar.CFG where++import GF.Data.Utilities+import PGF+import GF.Data.Relation++import Data.Map (Map)+import qualified Data.Map as Map+import Data.List+import Data.Set (Set)+import qualified Data.Set as Set++--+-- * Types+--++type Cat = String++data Symbol c t = NonTerminal c | Terminal t+ deriving (Eq, Ord, Show)++data Rule c t = Rule { + ruleLhs :: c,+ ruleRhs :: [Symbol c t],+ ruleName :: CFTerm + }+ deriving (Eq, Ord, Show)++data Grammar c t = Grammar { + cfgStartCat :: c,+ cfgExternalCats :: Set c,+ cfgRules :: Map c (Set (Rule c t)) }+ deriving (Eq, Ord, Show)++data CFTerm+ = CFObj CId [CFTerm] -- ^ an abstract syntax function with arguments+ | CFAbs Int CFTerm -- ^ A lambda abstraction. The Int is the variable id.+ | CFApp CFTerm CFTerm -- ^ Application+ | CFRes Int -- ^ The result of the n:th (0-based) non-terminal+ | CFVar Int -- ^ A lambda-bound variable+ | CFMeta CId -- ^ A metavariable+ deriving (Eq, Ord, Show)++type CFSymbol = Symbol Cat Token+type CFRule = Rule Cat Token+type CFG = Grammar Cat Token++type Param = Int+type ParamCFSymbol = Symbol (Cat,[Param]) Token+type ParamCFRule = Rule (Cat,[Param]) Token+type ParamCFG = Grammar (Cat,[Param]) Token++--+-- * Grammar filtering+--++-- | Removes all directly and indirectly cyclic productions.+-- FIXME: this may be too aggressive, only one production+-- needs to be removed to break a given cycle. But which+-- one should we pick?+-- FIXME: Does not (yet) remove productions which are cyclic+-- because of empty productions.+removeCycles :: (Ord c,Ord t) => Grammar c t -> Grammar c t+removeCycles = onRules f+ where f rs = filter (not . isCycle) rs+ where alias = transitiveClosure $ mkRel [(c,c') | Rule c [NonTerminal c'] _ <- rs]+ isCycle (Rule c [NonTerminal c'] _) = isRelatedTo alias c' c+ isCycle _ = False++-- | Better bottom-up filter that also removes categories which contain no finite+-- strings.+bottomUpFilter :: (Ord c,Ord t) => Grammar c t -> Grammar c t+bottomUpFilter gr = fix grow (gr { cfgRules = Map.empty })+ where grow g = g `unionCFG` filterCFG (all (okSym g) . ruleRhs) gr+ okSym g = symbol (`elem` allCats g) (const True)++-- | Removes categories which are not reachable from any external category.+topDownFilter :: (Ord c,Ord t) => Grammar c t -> Grammar c t+topDownFilter cfg = filterCFGCats (`Set.member` keep) cfg+ where+ rhsCats = [ (ruleLhs r, c') | r <- allRules cfg, c' <- filterCats (ruleRhs r) ]+ uses = reflexiveClosure_ (allCats cfg) $ transitiveClosure $ mkRel rhsCats+ keep = Set.unions $ map (allRelated uses) $ Set.toList $ cfgExternalCats cfg++-- | Merges categories with identical right-hand-sides.+-- FIXME: handle probabilities+mergeIdentical :: CFG -> CFG+mergeIdentical g = onRules (map subst) g+ where+ -- maps categories to their replacement+ m = Map.fromList [(y,concat (intersperse "+" xs)) + | (_,xs) <- buildMultiMap [(rulesKey rs,c) | (c,rs) <- Map.toList (cfgRules g)], y <- xs]+ -- build data to compare for each category: a set of name,rhs pairs+ rulesKey = Set.map (\ (Rule _ r n) -> (n,r))+ subst (Rule c r n) = Rule (substCat c) (map (mapSymbol substCat id) r) n+ substCat c = Map.findWithDefault (error $ "mergeIdentical: " ++ c) c m++-- | Keeps only the start category as an external category.+purgeExternalCats :: Grammar c t -> Grammar c t+purgeExternalCats cfg = cfg { cfgExternalCats = Set.singleton (cfgStartCat cfg) }++--+-- * Removing left recursion+--++-- The LC_LR algorithm from+-- http://research.microsoft.com/users/bobmoore/naacl2k-proc-rev.pdf+removeLeftRecursion :: CFG -> CFG+removeLeftRecursion gr + = gr { cfgRules = groupProds $ concat [scheme1, scheme2, scheme3, scheme4] }+ where+ scheme1 = [Rule a [x,NonTerminal a_x] n' | + a <- retainedLeftRecursive, + x <- properLeftCornersOf a,+ not (isLeftRecursive x),+ let a_x = mkCat (NonTerminal a) x,+ -- this is an extension of LC_LR to avoid generating+ -- A-X categories for which there are no productions:+ a_x `Set.member` newCats,+ let n' = symbol (\_ -> CFApp (CFRes 1) (CFRes 0))+ (\_ -> CFRes 0) x] + scheme2 = [Rule a_x (beta++[NonTerminal a_b]) n' | + a <- retainedLeftRecursive, + b@(NonTerminal b') <- properLeftCornersOf a,+ isLeftRecursive b,+ Rule _ (x:beta) n <- catRules gr b', + let a_x = mkCat (NonTerminal a) x,+ let a_b = mkCat (NonTerminal a) b,+ let i = length $ filterCats beta,+ let n' = symbol (\_ -> CFAbs 1 (CFApp (CFRes i) (shiftTerm n)))+ (\_ -> CFApp (CFRes i) n) x]+ scheme3 = [Rule a_x beta n' |+ a <- retainedLeftRecursive, + x <- properLeftCornersOf a,+ Rule _ (x':beta) n <- catRules gr a,+ x == x',+ let a_x = mkCat (NonTerminal a) x,+ let n' = symbol (\_ -> CFAbs 1 (shiftTerm n)) + (\_ -> n) x]+ scheme4 = catSetRules gr $ Set.fromList $ filter (not . isLeftRecursive . NonTerminal) cats++ newCats = Set.fromList (map ruleLhs (scheme2 ++ scheme3))++ shiftTerm :: CFTerm -> CFTerm+ shiftTerm (CFObj f ts) = CFObj f (map shiftTerm ts)+ shiftTerm (CFRes 0) = CFVar 1+ shiftTerm (CFRes n) = CFRes (n-1)+ shiftTerm t = t+ -- note: the rest don't occur in the original grammar++ cats = allCats gr+-- rules = allRules gr++ directLeftCorner = mkRel [(NonTerminal c,t) | Rule c (t:_) _ <- allRules gr]+-- leftCorner = reflexiveClosure_ (map NonTerminal cats) $ transitiveClosure directLeftCorner+ properLeftCorner = transitiveClosure directLeftCorner+ properLeftCornersOf = Set.toList . allRelated properLeftCorner . NonTerminal+-- isProperLeftCornerOf = flip (isRelatedTo properLeftCorner)++ leftRecursive = reflexiveElements properLeftCorner+ isLeftRecursive = (`Set.member` leftRecursive)++ retained = cfgStartCat gr `Set.insert`+ Set.fromList [a | r <- allRules (filterCFGCats (not . isLeftRecursive . NonTerminal) gr),+ NonTerminal a <- ruleRhs r]+-- isRetained = (`Set.member` retained)++ retainedLeftRecursive = filter (isLeftRecursive . NonTerminal) $ Set.toList retained++ mkCat :: CFSymbol -> CFSymbol -> Cat+ mkCat x y = showSymbol x ++ "-" ++ showSymbol y+ where showSymbol = symbol id show++-- | Get the sets of mutually recursive non-terminals for a grammar.+mutRecCats :: Ord c+ => Bool -- ^ If true, all categories will be in some set.+ -- If false, only recursive categories will be included.+ -> Grammar c t -> [Set c]+mutRecCats incAll g = equivalenceClasses $ refl $ symmetricSubrelation $ transitiveClosure r+ where r = mkRel [(c,c') | Rule c ss _ <- allRules g, NonTerminal c' <- ss]+ refl = if incAll then reflexiveClosure_ (allCats g) else reflexiveSubrelation++--+-- * Approximate context-free grammars with regular grammars.+--++makeSimpleRegular :: CFG -> CFG+makeSimpleRegular = makeRegular . topDownFilter . bottomUpFilter . removeCycles++-- Use the transformation algorithm from \"Regular Approximation of Context-free+-- Grammars through Approximation\", Mohri and Nederhof, 2000+-- to create an over-generating regular grammar for a context-free +-- grammar+makeRegular :: CFG -> CFG+makeRegular g = g { cfgRules = groupProds $ concatMap trSet (mutRecCats True g) }+ where trSet cs | allXLinear cs rs = rs+ | otherwise = concatMap handleCat (Set.toList cs)+ where rs = catSetRules g cs+ handleCat c = [Rule c' [] (mkCFTerm (c++"-empty"))] -- introduce A' -> e+ ++ concatMap (makeRightLinearRules c) (catRules g c)+ where c' = newCat c+ makeRightLinearRules b' (Rule c ss n) = + case ys of+ [] -> newRule b' (xs ++ [NonTerminal (newCat c)]) n -- no non-terminals left+ (NonTerminal b:zs) -> newRule b' (xs ++ [NonTerminal b]) n + ++ makeRightLinearRules (newCat b) (Rule c zs n)+ where (xs,ys) = break (`catElem` cs) ss+ -- don't add rules on the form A -> A+ newRule c rhs n | rhs == [NonTerminal c] = []+ | otherwise = [Rule c rhs n]+ newCat c = c ++ "$"++--+-- * CFG Utilities+--++mkCFG :: (Ord c,Ord t) => c -> Set c -> [Rule c t] -> Grammar c t+mkCFG start ext rs = Grammar { cfgStartCat = start, cfgExternalCats = ext, cfgRules = groupProds rs }++groupProds :: (Ord c,Ord t) => [Rule c t] -> Map c (Set (Rule c t))+groupProds = Map.fromListWith Set.union . map (\r -> (ruleLhs r,Set.singleton r))++uniqueFuns :: [Rule c t] -> [Rule c t]+uniqueFuns = snd . mapAccumL uniqueFun Set.empty+ where+ uniqueFun funs (Rule cat items (CFObj fun args)) = (Set.insert fun' funs,Rule cat items (CFObj fun' args))+ where+ fun' = head [fun'|suffix<-"":map show ([2..]::[Int]),+ let fun'=mkCId (showCId fun++suffix),+ not (fun' `Set.member` funs)]++-- | Gets all rules in a CFG.+allRules :: Grammar c t -> [Rule c t]+allRules = concatMap Set.toList . Map.elems . cfgRules++-- | Gets all rules in a CFG, grouped by their LHS categories.+allRulesGrouped :: Grammar c t -> [(c,[Rule c t])]+allRulesGrouped = Map.toList . Map.map Set.toList . cfgRules++-- | Gets all categories which have rules.+allCats :: Grammar c t -> [c]+allCats = Map.keys . cfgRules++-- | Gets all categories which have rules or occur in a RHS.+allCats' :: (Ord c,Ord t) => Grammar c t -> [c]+allCats' cfg = Set.toList (Map.keysSet (cfgRules cfg) `Set.union` + Set.fromList [c | rs <- Map.elems (cfgRules cfg), + r <- Set.toList rs, + NonTerminal c <- ruleRhs r])++-- | Gets all rules for the given category.+catRules :: Ord c => Grammar c t -> c -> [Rule c t]+catRules gr c = Set.toList $ Map.findWithDefault Set.empty c (cfgRules gr)++-- | Gets all rules for categories in the given set.+catSetRules :: CFG -> Set Cat -> [CFRule]+catSetRules gr cs = allRules $ filterCFGCats (`Set.member` cs) gr++mapCFGCats :: (Ord c,Ord c',Ord t) => (c -> c') -> Grammar c t -> Grammar c' t+mapCFGCats f cfg = Grammar (f (cfgStartCat cfg)) + (Set.map f (cfgExternalCats cfg))+ (groupProds [Rule (f lhs) (map (mapSymbol f id) rhs) t | Rule lhs rhs t <- allRules cfg])++onRules :: (Ord c,Ord t) => ([Rule c t] -> [Rule c t]) -> Grammar c t -> Grammar c t+onRules f cfg = cfg { cfgRules = groupProds $ f $ allRules cfg }++-- | Clean up CFG after rules have been removed.+cleanCFG :: Ord c => Grammar c t -> Grammar c t+cleanCFG cfg = cfg{ cfgRules = Map.filter (not . Set.null) (cfgRules cfg) }++-- | Combine two CFGs.+unionCFG :: (Ord c,Ord t) => Grammar c t -> Grammar c t -> Grammar c t+unionCFG x y = x { cfgRules = Map.unionWith Set.union (cfgRules x) (cfgRules y) }++filterCFG :: (Rule c t -> Bool) -> Grammar c t -> Grammar c t+filterCFG p cfg = cfg { cfgRules = Map.mapMaybe filterRules (cfgRules cfg) }+ where+ filterRules rules = + let rules' = Set.filter p rules+ in if Set.null rules' then Nothing else Just rules'++filterCFGCats :: (c -> Bool) -> Grammar c t -> Grammar c t+filterCFGCats p cfg = cfg { cfgRules = Map.filterWithKey (\c _ -> p c) (cfgRules cfg) }++countCats :: Ord c => Grammar c t -> Int+countCats = Map.size . cfgRules . cleanCFG++countRules :: Grammar c t -> Int+countRules = length . allRules++prCFG :: CFG -> String+prCFG = prProductions . map prRule . allRules+ where + prRule r = (ruleLhs r, unwords (map prSym (ruleRhs r)))+ prSym = symbol id (\t -> "\""++ t ++"\"")++prProductions :: [(Cat,String)] -> String+prProductions prods = + unlines [rpad maxLHSWidth lhs ++ " ::= " ++ rhs | (lhs,rhs) <- prods]+ where+ maxLHSWidth = maximum $ 0:(map (length . fst) prods)+ rpad n s = s ++ replicate (n - length s) ' '++prCFTerm :: CFTerm -> String+prCFTerm = pr 0+ where+ pr p (CFObj f args) = paren p (showCId f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")+ pr p (CFAbs i t) = paren p ("\\x" ++ show i ++ ". " ++ pr 0 t)+ pr p (CFApp t1 t2) = paren p (pr 1 t1 ++ "(" ++ pr 0 t2 ++ ")")+ pr _ (CFRes i) = "$" ++ show i+ pr _ (CFVar i) = "x" ++ show i+ pr _ (CFMeta c) = "?" ++ showCId c+ paren 0 x = x+ paren 1 x = "(" ++ x ++ ")"++--+-- * CFRule Utilities+--++ruleFun :: Rule c t -> CId+ruleFun (Rule _ _ t) = f t+ where f (CFObj n _) = n+ f (CFApp _ x) = f x+ f (CFAbs _ x) = f x+ f _ = mkCId ""++-- | Check if any of the categories used on the right-hand side+-- are in the given list of categories.+anyUsedBy :: Eq c => [c] -> Rule c t -> Bool+anyUsedBy cs (Rule _ ss _) = any (`elem` cs) (filterCats ss)++mkCFTerm :: String -> CFTerm+mkCFTerm n = CFObj (mkCId n) []++ruleIsNonRecursive :: Ord c => Set c -> Rule c t -> Bool+ruleIsNonRecursive cs = noCatsInSet cs . ruleRhs++-- | Check if all the rules are right-linear, or all the rules are+-- left-linear, with respect to given categories.+allXLinear :: Ord c => Set c -> [Rule c t] -> Bool+allXLinear cs rs = all (isRightLinear cs) rs || all (isLeftLinear cs) rs++-- | Checks if a context-free rule is right-linear.+isRightLinear :: Ord c+ => Set c -- ^ The categories to consider+ -> Rule c t -- ^ The rule to check for right-linearity+ -> Bool+isRightLinear cs = noCatsInSet cs . safeInit . ruleRhs++-- | Checks if a context-free rule is left-linear.+isLeftLinear :: Ord c+ => Set c -- ^ The categories to consider+ -> Rule c t -- ^ The rule to check for left-linearity+ -> Bool+isLeftLinear cs = noCatsInSet cs . drop 1 . ruleRhs+++--+-- * Symbol utilities+--++symbol :: (c -> a) -> (t -> a) -> Symbol c t -> a+symbol fc ft (NonTerminal cat) = fc cat+symbol fc ft (Terminal tok) = ft tok++mapSymbol :: (c -> c') -> (t -> t') -> Symbol c t -> Symbol c' t'+mapSymbol fc ft = symbol (NonTerminal . fc) (Terminal . ft)++filterCats :: [Symbol c t] -> [c]+filterCats syms = [ cat | NonTerminal cat <- syms ]++filterToks :: [Symbol c t] -> [t]+filterToks syms = [ tok | Terminal tok <- syms ]++-- | Checks if a symbol is a non-terminal of one of the given categories.+catElem :: Ord c => Symbol c t -> Set c -> Bool+catElem s cs = symbol (`Set.member` cs) (const False) s++noCatsInSet :: Ord c => Set c -> [Symbol c t] -> Bool+noCatsInSet cs = not . any (`catElem` cs)
@@ -0,0 +1,150 @@+----------------------------------------------------------------------+-- |+-- Module : EBNF+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:21:13 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.5 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Grammar.EBNF (EBNF, ERule, ERHS(..), ebnf2cf) where++import GF.Data.Operations+import GF.Grammar.CFG+import PGF (mkCId)++type EBNF = [ERule]+type ERule = (ECat, ERHS)+type ECat = (String,[Int])+type ETok = String++data ERHS =+ ETerm ETok+ | ENonTerm ECat+ | ESeq ERHS ERHS+ | EAlt ERHS ERHS+ | EStar ERHS+ | EPlus ERHS+ | EOpt ERHS+ | EEmpty++type CFRHS = [ParamCFSymbol]+type CFJustRule = ((Cat,[Param]), CFRHS)++ebnf2cf :: EBNF -> [ParamCFRule]+ebnf2cf ebnf = + [Rule cat items (mkCFF i cat) | (i,(cat,items)) <- zip [0..] (normEBNF ebnf)]+ where+ mkCFF i (c,_) = CFObj (mkCId ("Mk" ++ c ++ "_" ++ show i)) []++normEBNF :: EBNF -> [CFJustRule]+normEBNF erules = let+ erules1 = [normERule ([i],r) | (i,r) <- zip [0..] erules]+ erules2 = erules1 ---refreshECats erules1 --- this seems to be just bad !+ erules3 = concat (map pickERules erules2)+--erules4 = nubERules erules3+ in [(mkCFCatE cat, map eitem2cfitem its) | (cat,itss) <- erules3, its <- itss]+{-+refreshECats :: [NormERule] -> [NormERule]+refreshECats rules = [recas [i] rule | (i,rule) <- zip [0..] rules] where+ recas ii (cat,its) = (updECat ii cat, [recss ii 0 s | s <- its])+ recss ii n [] = []+ recss ii n (s:ss) = recit (ii ++ [n]) s : recss ii (n+1) ss+ recit ii it = case it of+ EINonTerm cat -> EINonTerm (updECat ii cat)+ EIStar (cat,t) -> EIStar (updECat ii cat, [recss ii 0 s | s <- t])+ EIPlus (cat,t) -> EIPlus (updECat ii cat, [recss ii 0 s | s <- t])+ EIOpt (cat,t) -> EIOpt (updECat ii cat, [recss ii 0 s | s <- t])+ _ -> it+-}+pickERules :: NormERule -> [NormERule]+pickERules rule@(cat,alts) = rule : concat (map pics (concat alts)) where+ pics it = case it of+ EIStar ru@(cat,t) -> mkEStarRules cat ++ pickERules ru+ EIPlus ru@(cat,t) -> mkEPlusRules cat ++ pickERules ru+ EIOpt ru@(cat,t) -> mkEOptRules cat ++ pickERules ru+ _ -> []+ mkEStarRules cat = [(cat', [[],[EINonTerm cat, EINonTerm cat']])] + where cat' = mkNewECat cat "Star"+ mkEPlusRules cat = [(cat', [[EINonTerm cat],[EINonTerm cat, EINonTerm cat']])] + where cat' = mkNewECat cat "Plus"+ mkEOptRules cat = [(cat', [[],[EINonTerm cat]])] + where cat' = mkNewECat cat "Opt"+{-+nubERules :: [NormERule] -> [NormERule]+nubERules rules = nub optim where + optim = map (substERules (map mkSubst replaces)) irreducibles+ (replaces,irreducibles) = partition reducible rules+ reducible (cat,[items]) = isNewCat cat && all isOldIt items+ reducible _ = False+ isNewCat (_,ints) = ints == []+ isOldIt (EITerm _) = True+ isOldIt (EINonTerm cat) = not (isNewCat cat)+ isOldIt _ = False+ mkSubst (cat,its) = (cat, head its) -- def of reducible: its must be singleton+--- the optimization assumes each cat has at most one EBNF rule.++substERules :: [(ECat,[EItem])] -> NormERule -> NormERule+substERules g (cat,itss) = (cat, map sub itss) where+ sub [] = []+ sub (i@(EINonTerm cat') : ii) = case lookup cat g of+ Just its -> its ++ sub ii + _ -> i : sub ii+ sub (EIStar r : ii) = EIStar (substERules g r) : ii+ sub (EIPlus r : ii) = EIPlus (substERules g r) : ii+ sub (EIOpt r : ii) = EIOpt (substERules g r) : ii+-}+eitem2cfitem :: EItem -> ParamCFSymbol+eitem2cfitem it = case it of+ EITerm a -> Terminal a+ EINonTerm cat -> NonTerminal (mkCFCatE cat)+ EIStar (cat,_) -> NonTerminal (mkCFCatE (mkNewECat cat "Star"))+ EIPlus (cat,_) -> NonTerminal (mkCFCatE (mkNewECat cat "Plus"))+ EIOpt (cat,_) -> NonTerminal (mkCFCatE (mkNewECat cat "Opt"))++type NormERule = (ECat,[[EItem]]) -- disjunction of sequences of items++data EItem =+ EITerm String+ | EINonTerm ECat+ | EIStar NormERule+ | EIPlus NormERule+ | EIOpt NormERule+ deriving Eq++normERule :: ([Int],ERule) -> NormERule+normERule (ii,(cat,rhs)) = + (cat,[map (mkEItem (ii ++ [i])) r' | (i,r') <- zip [0..] (disjNorm rhs)]) where+ disjNorm r = case r of+ ESeq r1 r2 -> [x ++ y | x <- disjNorm r1, y <- disjNorm r2]+ EAlt r1 r2 -> disjNorm r1 ++ disjNorm r2+ EEmpty -> [[]]+ _ -> [[r]]++mkEItem :: [Int] -> ERHS -> EItem+mkEItem ii rhs = case rhs of+ ETerm a -> EITerm a+ ENonTerm cat -> EINonTerm cat+ EStar r -> EIStar (normERule (ii,(mkECat ii, r)))+ EPlus r -> EIPlus (normERule (ii,(mkECat ii, r)))+ EOpt r -> EIOpt (normERule (ii,(mkECat ii, r)))+ _ -> EINonTerm ("?????",[])+-- _ -> error "should not happen in ebnf" ---++mkECat ints = ("C", ints)++prECat (c,[]) = c+prECat (c,ints) = c ++ "_" ++ prTList "_" (map show ints)++mkCFCatE :: ECat -> (Cat,[Param])+mkCFCatE c = (prECat c,[0])+{-+updECat _ (c,[]) = (c,[])+updECat ii (c,_) = (c,ii)+-}+mkNewECat (c,ii) str = (c ++ str,ii)
@@ -0,0 +1,481 @@+----------------------------------------------------------------------+-- |+-- Module : Grammar+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:20 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.8 $+--+-- GF source abstract syntax used internally in compilation.+--+-- AR 23\/1\/2000 -- 30\/5\/2001 -- 4\/5\/2003+-----------------------------------------------------------------------------++module GF.Grammar.Grammar (+ -- ** Grammar modules+ Grammar, ModuleName, Module, ModuleInfo(..),+ SourceGrammar, SourceModInfo, SourceModule,+ ModuleType(..),+ emptyGrammar, mGrammar, modules, prependModule, moduleMap,++ MInclude (..), OpenSpec(..),+ extends, isInherited, inheritAll,+ openedModule, allDepsModule, partOfGrammar, depPathModule,+ allExtends, allExtendsPlus, --searchPathModule,+ + lookupModule,+ isModAbs, isModRes, isModCnc,+ sameMType, isCompilableModule, isCompleteModule,+ allAbstracts, greatestAbstract, allResources,+ greatestResource, allConcretes, allConcreteModules,+ abstractOfConcrete,++ ModuleStatus(..),++ -- ** Judgements+ Info(..),+ -- ** Terms+ Term(..),+ Type,+ Cat,+ Fun,+ QIdent,+ BindType(..),+ Patt(..),+ TInfo(..),+ Label(..),+ MetaId,+ Hypo,+ Context,+ Equation,+ Labelling,+ Assign,+ Case,+ LocalDef,+ Param,+ Altern,+ Substitution,+ varLabel, tupleLabel, linLabel, theLinLabel,+ ident2label, label2ident,+ -- ** Source locations+ Location(..), L(..), unLoc, noLoc, ppLocation, ppL,++ -- ** PMCFG + PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence+ ) where++import GF.Infra.Ident+import GF.Infra.Option ---+import GF.Infra.Location++import GF.Data.Operations++import PGF.Internal (FId, FunId, SeqId, LIndex, Sequence, BindType(..))++import Data.Array.IArray(Array)+import Data.Array.Unboxed(UArray)+import qualified Data.Map as Map+import GF.Text.Pretty+++-- | A grammar is a self-contained collection of grammar modules+data Grammar = MGrammar { + moduleMap :: Map.Map ModuleName ModuleInfo,+ modules :: [Module]+ }++-- | Modules+type Module = (ModuleName, ModuleInfo)++data ModuleInfo = ModInfo {+ mtype :: ModuleType,+ mstatus :: ModuleStatus,+ mflags :: Options,+ mextend :: [(ModuleName,MInclude)],+ mwith :: Maybe (ModuleName,MInclude,[(ModuleName,ModuleName)]),+ mopens :: [OpenSpec],+ mexdeps :: [ModuleName],+ msrc :: FilePath,+ mseqs :: Maybe (Array SeqId Sequence),+ jments :: Map.Map Ident Info+ }++type SourceGrammar = Grammar+type SourceModule = Module+type SourceModInfo = ModuleInfo++instance HasSourcePath ModuleInfo where sourcePath = msrc++-- | encoding the type of the module+data ModuleType = + MTAbstract + | MTResource+ | MTConcrete ModuleName+ | MTInterface+ | MTInstance (ModuleName,MInclude)+ deriving (Eq,Show)++data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]+ deriving (Eq,Show)++extends :: ModuleInfo -> [ModuleName]+extends = map fst . mextend++isInherited :: MInclude -> Ident -> Bool+isInherited c i = case c of+ MIAll -> True+ MIOnly is -> elem i is+ MIExcept is -> notElem i is++inheritAll :: ModuleName -> (ModuleName,MInclude)+inheritAll i = (i,MIAll)++data OpenSpec = + OSimple ModuleName+ | OQualif ModuleName ModuleName+ deriving (Eq,Show)++data ModuleStatus = + MSComplete + | MSIncomplete + deriving (Eq,Ord,Show)++openedModule :: OpenSpec -> ModuleName+openedModule o = case o of+ OSimple m -> m+ OQualif _ m -> m++-- | initial dependency list+depPathModule :: ModuleInfo -> [OpenSpec]+depPathModule m = fors m ++ exts m ++ mopens m+ where+ fors m = + case mtype m of+ MTConcrete i -> [OSimple i]+ MTInstance (i,_) -> [OSimple i]+ _ -> []+ exts m = map OSimple (extends m)++-- | all dependencies+allDepsModule :: Grammar -> ModuleInfo -> [OpenSpec]+allDepsModule gr m = iterFix add os0 where+ os0 = depPathModule m+ add os = [m | o <- os, Just n <- [lookup (openedModule o) mods], + m <- depPathModule n]+ mods = modules gr++-- | select just those modules that a given one depends on, including itself+partOfGrammar :: Grammar -> Module -> Grammar+partOfGrammar gr (i,m) = mGrammar [mo | mo@(j,_) <- mods, elem j modsFor]+ where+ mods = modules gr+ modsFor = (i:) $ map openedModule $ allDepsModule gr m++-- | all modules that a module extends, directly or indirectly, with restricts+allExtends :: Grammar -> ModuleName -> [Module]+allExtends gr m =+ case lookupModule gr m of+ Ok mi -> (m,mi) : concatMap (allExtends gr . fst) (mextend mi)+ _ -> []++-- | the same as 'allExtends' plus that an instance extends its interface+allExtendsPlus :: Grammar -> ModuleName -> [ModuleName]+allExtendsPlus gr i =+ case lookupModule gr i of+ Ok m -> i : concatMap (allExtendsPlus gr) (exts m)+ _ -> []+ where+ exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]++-- -- | initial search path: the nonqualified dependencies+-- searchPathModule :: ModuleInfo -> [ModuleName]+-- searchPathModule m = [i | OSimple i <- depPathModule m]++prependModule :: Grammar -> Module -> Grammar+prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms)++emptyGrammar = mGrammar []++mGrammar :: [Module] -> Grammar+mGrammar ms = MGrammar (Map.fromList ms) ms+++-- | we store the module type with the identifier++abstractOfConcrete :: ErrorMonad m => Grammar -> ModuleName -> m ModuleName+abstractOfConcrete gr c = do+ n <- lookupModule gr c+ case mtype n of+ MTConcrete a -> return a+ _ -> raise $ render ("expected concrete" <+> c)++lookupModule :: ErrorMonad m => Grammar -> ModuleName -> m ModuleInfo+lookupModule gr m = case Map.lookup m (moduleMap gr) of+ Just i -> return i+ Nothing -> raise $ render ("unknown module" <+> m <+> "among" <+> hsep (map fst (modules gr)))++isModAbs :: ModuleInfo -> Bool+isModAbs m =+ case mtype m of+ MTAbstract -> True+ _ -> False++isModRes :: ModuleInfo -> Bool+isModRes m =+ case mtype m of+ MTResource -> True+ MTInterface -> True ---+ MTInstance _ -> True+ _ -> False++isModCnc :: ModuleInfo -> Bool+isModCnc m =+ case mtype m of+ MTConcrete _ -> True+ _ -> False++sameMType :: ModuleType -> ModuleType -> Bool+sameMType m n =+ case (n,m) of+ (MTConcrete _, MTConcrete _) -> True++ (MTInstance _, MTInstance _) -> True+ (MTInstance _, MTResource) -> True+ (MTInstance _, MTConcrete _) -> True++ (MTInterface, MTInstance _) -> True+ (MTInterface, MTResource) -> True -- for reuse+ (MTInterface, MTAbstract) -> True -- for reuse+ (MTInterface, MTConcrete _) -> True -- for reuse++ (MTResource, MTInstance _) -> True+ (MTResource, MTConcrete _) -> True -- for reuse++ _ -> m == n++-- | don't generate code for interfaces and for incomplete modules+isCompilableModule :: ModuleInfo -> Bool+isCompilableModule m =+ case mtype m of+ MTInterface -> False+ _ -> mstatus m == MSComplete++-- | interface and "incomplete M" are not complete+isCompleteModule :: ModuleInfo -> Bool+isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface+++-- | all abstract modules sorted from least to most dependent+allAbstracts :: Grammar -> [ModuleName]+allAbstracts gr = + case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of+ Left is -> is+ Right cycles -> error $ render ("Cyclic abstract modules:" <+> vcat (map hsep cycles))++-- | the last abstract in dependency order (head of list)+greatestAbstract :: Grammar -> Maybe ModuleName+greatestAbstract gr =+ case allAbstracts gr of+ [] -> Nothing+ as -> return $ last as++-- | all resource modules+allResources :: Grammar -> [ModuleName]+allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m]++-- | the greatest resource in dependency order+greatestResource :: Grammar -> Maybe ModuleName+greatestResource gr =+ case allResources gr of+ [] -> Nothing+ mo:_ -> Just mo ---- why not last as in Abstract? works though AR 24/5/2008++-- | all concretes for a given abstract+allConcretes :: Grammar -> ModuleName -> [ModuleName]+allConcretes gr a =+ [i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]++-- | all concrete modules for any abstract+allConcreteModules :: Grammar -> [ModuleName]+allConcreteModules gr =+ [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]+++data Production = Production {-# UNPACK #-} !FId+ {-# UNPACK #-} !FunId+ [[FId]]+ deriving (Eq,Ord,Show)++data PMCFG = PMCFG [Production]+ (Array FunId (UArray LIndex SeqId)) + deriving (Eq,Show)++-- | the constructors are judgements in +--+-- - abstract syntax (/ABS/)+-- +-- - resource (/RES/)+--+-- - concrete syntax (/CNC/)+--+-- and indirection to module (/INDIR/)+data Info =+-- judgements in abstract syntax+ AbsCat (Maybe (L Context)) -- ^ (/ABS/) context of a category+ | AbsFun (Maybe (L Type)) (Maybe Int) (Maybe [L Equation]) (Maybe Bool) -- ^ (/ABS/) type, arrity and definition of a function++-- judgements in resource+ | ResParam (Maybe (L [Param])) (Maybe [Term]) -- ^ (/RES/) the second parameter is list of all possible values+ | ResValue (L Type) -- ^ (/RES/) to mark parameter constructors for lookup+ | ResOper (Maybe (L Type)) (Maybe (L Term)) -- ^ (/RES/)++ | ResOverload [ModuleName] [(L Type,L Term)] -- ^ (/RES/) idents: modules inherited++-- judgements in concrete syntax+ | CncCat (Maybe (L Type)) (Maybe (L Term)) (Maybe (L Term)) (Maybe (L Term)) (Maybe PMCFG) -- ^ (/CNC/) lindef ini'zed, + | CncFun (Maybe (Ident,Context,Type)) (Maybe (L Term)) (Maybe (L Term)) (Maybe PMCFG) -- ^ (/CNC/) type info added at 'TC'++-- indirection to module Ident+ | AnyInd Bool ModuleName -- ^ (/INDIR/) the 'Bool' says if canonical+ deriving Show++type Type = Term+type Cat = QIdent+type Fun = QIdent++type QIdent = (ModuleName,Ident)++data Term =+ Vr Ident -- ^ variable+ | Cn Ident -- ^ constant+ | Con Ident -- ^ constructor+ | Sort Ident -- ^ basic type+ | EInt Int -- ^ integer literal+ | EFloat Double -- ^ floating point literal+ | K String -- ^ string literal or token: @\"foo\"@+ | Empty -- ^ the empty string @[]@++ | App Term Term -- ^ application: @f a@+ | Abs BindType Ident Term -- ^ abstraction: @\x -> b@+ | Meta {-# UNPACK #-} !MetaId -- ^ metavariable: @?i@ (only parsable: ? = ?0)+ | ImplArg Term -- ^ placeholder for implicit argument @{t}@+ | Prod BindType Ident Term Term -- ^ function type: @(x : A) -> B@, @A -> B@, @({x} : A) -> B@+ | Typed Term Term -- ^ type-annotated term+--+-- /below this, the constructors are only for concrete syntax/+ | Example Term String -- ^ example-based term: @in M.C "foo"+ | RecType [Labelling] -- ^ record type: @{ p : A ; ...}@+ | R [Assign] -- ^ record: @{ p = a ; ...}@+ | P Term Label -- ^ projection: @r.p@+ | ExtR Term Term -- ^ extension: @R ** {x : A}@ (both types and terms)+ + | Table Term Term -- ^ table type: @P => A@+ | T TInfo [Case] -- ^ table: @table {p => c ; ...}@+ | V Type [Term] -- ^ table given as course of values: @table T [c1 ; ... ; cn]@+ | S Term Term -- ^ selection: @t ! p@++ | Let LocalDef Term -- ^ local definition: @let {t : T = a} in b@++ | Q QIdent -- ^ qualified constant from a package+ | QC QIdent -- ^ qualified constructor from a package++ | C Term Term -- ^ concatenation: @s ++ t@+ | Glue Term Term -- ^ agglutination: @s + t@++ | EPatt Patt -- ^ pattern (in macro definition): # p+ | EPattType Term -- ^ pattern type: pattern T++ | ELincat Ident Term -- ^ boxed linearization type of Ident+ | ELin Ident Term -- ^ boxed linearization of type Ident++ | AdHocOverload [Term] -- ^ ad hoc overloading generated in Rename++ | FV [Term] -- ^ alternatives in free variation: @variants { s ; ... }@++ | Alts Term [(Term, Term)] -- ^ alternatives by prefix: @pre {t ; s\/c ; ...}@+ | Strs [Term] -- ^ conditioning prefix strings: @strs {s ; ...}@+ | Error String -- ^ error values returned by Predef.error+ deriving (Show, Eq, Ord)++-- | Patterns+data Patt =+ PC Ident [Patt] -- ^ constructor pattern: @C p1 ... pn@ @C@ + | PP QIdent [Patt] -- ^ package constructor pattern: @P.C p1 ... pn@ @P.C@ + | PV Ident -- ^ variable pattern: @x@+ | PW -- ^ wild card pattern: @_@+ | PR [(Label,Patt)] -- ^ record pattern: @{r = p ; ...}@ -- only concrete+ | PString String -- ^ string literal pattern: @\"foo\"@ -- only abstract+ | PInt Int -- ^ integer literal pattern: @12@ -- only abstract+ | PFloat Double -- ^ float literal pattern: @1.2@ -- only abstract+ | PT Type Patt -- ^ type-annotated pattern++ | PAs Ident Patt -- ^ as-pattern: x@p+ + | PImplArg Patt -- ^ placeholder for pattern for implicit argument @{p}@+ | PTilde Term -- ^ inaccessible pattern++ -- regular expression patterns+ | PNeg Patt -- ^ negated pattern: -p+ | PAlt Patt Patt -- ^ disjunctive pattern: p1 | p2+ | PSeq Patt Patt -- ^ sequence of token parts: p + q+ | PMSeq MPatt MPatt -- ^ sequence of token parts: p + q+ | PRep Patt -- ^ repetition of token part: p*+ | PChar -- ^ string of length one: ?+ | PChars [Char] -- ^ character list: ["aeiou"]+ | PMacro Ident -- #p+ | PM QIdent -- #m.p+ deriving (Show, Eq, Ord)++-- | Measured pattern (paired with the min & max matching length)+type MPatt = ((Int,Int),Patt)++-- | to guide computation and type checking of tables+data TInfo = + TRaw -- ^ received from parser; can be anything+ | TTyped Type -- ^ type annontated, but can be anything+ | TComp Type -- ^ expanded+ | TWild Type -- ^ just one wild card pattern, no need to expand + deriving (Show, Eq, Ord)++-- | record label+data Label = + LIdent RawIdent+ | LVar Int+ deriving (Show, Eq, Ord)++type MetaId = Int++type Hypo = (BindType,Ident,Term) -- (x:A) (_:A) A ({x}:A)+type Context = [Hypo] -- (x:A)(y:B) (x,y:A) (_,_:A)+type Equation = ([Patt],Term) ++type Labelling = (Label, Type) +type Assign = (Label, (Maybe Type, Term)) +type Case = (Patt, Term) +--type Cases = ([Patt], Term) +type LocalDef = (Ident, (Maybe Type, Term))++type Param = (Ident, Context) +type Altern = (Term, [(Term, Term)])++type Substitution = [(Ident, Term)]++varLabel :: Int -> Label+varLabel = LVar++tupleLabel, linLabel :: Int -> Label+tupleLabel i = LIdent $! rawIdentS ('p':show i)+linLabel i = LIdent $! rawIdentS ('s':show i)++theLinLabel :: Label+theLinLabel = LIdent (rawIdentS "s")++ident2label :: Ident -> Label+ident2label c = LIdent (ident2raw c)++label2ident :: Label -> Ident+label2ident (LIdent s) = identC s+label2ident (LVar i) = identS ('$':show i)
@@ -0,0 +1,320 @@+-- -*- haskell -*-+{+module GF.Grammar.Lexer+ ( Token(..), Posn(..)+ , P, runP, runPartial, token, lexer, getPosn, failLoc+ , isReservedWord+ ) where++import Control.Applicative+import Control.Monad(ap)+import GF.Infra.Ident+--import GF.Data.Operations+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString as WBS+import qualified Data.ByteString.Internal as BS(w2c)+import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.Map as Map+import Data.Word(Word8)+import Data.Char(readLitChar)+--import Debug.Trace(trace)+}+++$l = [a-zA-Z\192 - \255] # [\215 \247]+$c = [A-Z\192-\221] # [\215]+$s = [a-z\222-\255] # [\247]+$d = [0-9] -- digit+$i = [$l $d _ '] -- identifier character+$u = [.\n] -- universal: any character++@rsyms = -- symbols and non-identifier-like reserved words+ \; | \= | \{ | \} | \( | \) | \~ | \* \* | \: | \- \> | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \# | \! | \* | \+ | \+ \+ | \\ | \\\\ | \= \> | \_ | \$ | \/ | \: \= | \: \: \=++:-+"--" [.]* ; -- Toss single line comments+"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; ++$white+ ;+@rsyms { tok ident }+\' ([. # [\' \\ \n]] | (\\ (\' | \\)))+ \' { tok (T_Ident . identS . unescapeInitTail . unpack) }+(\_ | $l)($l | $d | \_ | \')* { tok ident }++\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t | $d+)))* \" { tok (T_String . unescapeInitTail . unpack) }++(\-)? $d+ { tok (T_Integer . read . unpack) }+(\-)? $d+ \. $d+ (e (\-)? $d+)? { tok (T_Double . read . unpack) }++{+unpack = UTF8.toString+--unpack = id++ident = res T_Ident . identC . rawIdentC++tok f p s = f s++data Token+ = T_exclmark+ | T_patt+ | T_int_label+ | T_oparen+ | T_cparen+ | T_tilde+ | T_star+ | T_starstar+ | T_plus+ | T_plusplus+ | T_comma+ | T_minus+ | T_rarrow+ | T_dot+ | T_alt+ | T_colon+ | T_semicolon+ | T_less+ | T_equal+ | T_big_rarrow+ | T_great+ | T_questmark+ | T_obrack+ | T_lam+ | T_lamlam+ | T_cbrack+ | T_ocurly+ | T_bar+ | T_ccurly+ | T_underscore+ | T_at+ | T_cfarrow+ | T_PType+ | T_Str+ | T_Strs+ | T_Tok+ | T_Type+ | T_abstract+ | T_case+ | T_cat+ | T_concrete+ | T_data+ | T_def+ | T_flags+ | T_fn+ | T_fun+ | T_in+ | T_incomplete+ | T_instance+ | T_interface+ | T_let+ | T_lin+ | T_lincat+ | T_lindef+ | T_linref+ | T_of+ | T_open+ | T_oper+ | T_param+ | T_pattern+ | T_pre+ | T_printname+ | T_resource+ | T_strs+ | T_table+ | T_transfer+ | T_variants+ | T_where+ | T_with+ | T_coercions+ | T_terminator+ | T_separator+ | T_nonempty+ | T_String String -- string literals+ | T_Integer Int -- integer literals+ | T_Double Double -- double precision float literals+ | T_Ident Ident+ | T_EOF+-- deriving Show -- debug++res = eitherResIdent+eitherResIdent :: (Ident -> Token) -> Ident -> Token+eitherResIdent tv s = + case Map.lookup s resWords of+ Just t -> t+ Nothing -> tv s++isReservedWord :: Ident -> Bool+isReservedWord ident = Map.member ident resWords++resWords = Map.fromList+ [ b "!" T_exclmark+ , b "#" T_patt+ , b "$" T_int_label+ , b "(" T_oparen+ , b ")" T_cparen+ , b "~" T_tilde+ , b "*" T_star+ , b "**" T_starstar+ , b "+" T_plus+ , b "++" T_plusplus+ , b "," T_comma+ , b "-" T_minus+ , b "->" T_rarrow+ , b "." T_dot+ , b "/" T_alt+ , b ":" T_colon+ , b ";" T_semicolon+ , b "<" T_less+ , b "=" T_equal+ , b "=>" T_big_rarrow+ , b ">" T_great+ , b "?" T_questmark+ , b "[" T_obrack+ , b "]" T_cbrack+ , b "\\" T_lam+ , b "\\\\" T_lamlam+ , b "{" T_ocurly+ , b "}" T_ccurly+ , b "|" T_bar+ , b "_" T_underscore+ , b "@" T_at+ , b "::=" T_cfarrow+ , b ":=" T_cfarrow+ , b "PType" T_PType+ , b "Str" T_Str+ , b "Strs" T_Strs+ , b "Tok" T_Tok+ , b "Type" T_Type+ , b "abstract" T_abstract+ , b "case" T_case+ , b "cat" T_cat+ , b "concrete" T_concrete+ , b "data" T_data+ , b "def" T_def+ , b "flags" T_flags+ , b "fn" T_fn+ , b "fun" T_fun+ , b "in" T_in+ , b "incomplete" T_incomplete+ , b "instance" T_instance+ , b "interface" T_interface+ , b "let" T_let+ , b "lin" T_lin+ , b "lincat" T_lincat+ , b "lindef" T_lindef+ , b "linref" T_linref+ , b "of" T_of+ , b "open" T_open+ , b "oper" T_oper+ , b "param" T_param+ , b "pattern" T_pattern+ , b "pre" T_pre+ , b "printname" T_printname+ , b "resource" T_resource+ , b "strs" T_strs+ , b "table" T_table+ , b "transfer" T_transfer+ , b "variants" T_variants+ , b "where" T_where+ , b "with" T_with+ , b "coercions" T_coercions+ , b "terminator" T_terminator+ , b "separator" T_separator+ , b "nonempty" T_nonempty+ ]+ where b s t = (identS s, t)++unescapeInitTail :: String -> String+unescapeInitTail = unesc . tail where+ unesc s = case s of+ [] -> []+ '\"':[] -> []+ '\'':[] -> []+ _ -> case readLitChar s of+ [(c,cs)] -> c:unesc cs++-------------------------------------------------------------------+-- Alex wrapper code.+-- A modified "posn" wrapper.+-------------------------------------------------------------------++data Posn = Pn {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ deriving (Eq,Show)++alexMove :: Posn -> Char -> Posn+alexMove (Pn l c) '\n' = Pn (l+1) 1+alexMove (Pn l c) _ = Pn l (c+1)++alexGetByte :: AlexInput -> Maybe (Word8,AlexInput)+alexGetByte (AI p _ s) =+ case WBS.uncons s of+ Nothing -> Nothing+ Just (w,s) ->+ let p' = alexMove p c+ c = BS.w2c w+ in p' `seq` Just (w, (AI p' c s))+{-+-- Not used by this lexer:+alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (AI p c s) = c+-}+data AlexInput = AI {-# UNPACK #-} !Posn -- current position,+ {-# UNPACK #-} !Char -- previous char+ {-# UNPACK #-} !BS.ByteString -- current input string++type AlexInput2 = (AlexInput,AlexInput)++data ParseResult a+ = POk AlexInput2 a+ | PFailed Posn -- The position of the error+ String -- The error message++newtype P a = P { unP :: AlexInput2 -> ParseResult a }++instance Functor P where+ fmap = liftA++instance Applicative P where+ pure = return+ (<*>) = ap++instance Monad P where+ return a = a `seq` (P $ \s -> POk s a)+ (P m) >>= k = P $ \ s -> case m s of+ POk s a -> unP (k a) s+ PFailed posn err -> PFailed posn err+ fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg++runP :: P a -> BS.ByteString -> Either (Posn,String) a+runP p bs = snd <$> runP' p (Pn 1 0,bs)++runPartial p s = conv <$> runP' p (Pn 1 0,UTF8.fromString s)+ where conv ((pos,rest),x) = (UTF8.toString rest,x)++runP' (P f) (pos,txt) =+ case f (dup (AI pos ' ' txt)) of+ POk (AI pos _ rest,_) x -> Right ((pos,rest),x)+ PFailed pos msg -> Left (pos,msg)++dup x = (x,x)++failLoc :: Posn -> String -> P a+failLoc pos msg = P $ \_ -> PFailed pos msg++lexer :: (Token -> P a) -> P a+lexer cont = cont=<<token++token :: P Token+token = P go+ where+ --cont' t = trace (show t) (cont t)+ go ai2@(_,inp@(AI pos _ str)) =+ case alexScan inp 0 of+ AlexEOF -> POk (inp,inp) T_EOF+ AlexError (AI pos _ _) -> PFailed pos "lexical error"+ AlexSkip inp' len -> {-trace (show len) $-} go (inp,inp')+ AlexToken inp' len act -> POk (inp,inp') (act pos ({-UTF8.toString-} (UTF8.take len str)))++getPosn :: P Posn+getPosn = P $ \ai2@(_,inp@(AI pos _ _)) -> POk ai2 pos++}
@@ -0,0 +1,50 @@+----------------------------------------------------------------------+-- |+-- Module : Lockfield+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.7 $+--+-- Creating and using lock fields in reused resource grammars.+--+-- AR 8\/2\/2005 detached from 'compile/MkResource'+-----------------------------------------------------------------------------++module GF.Grammar.Lockfield (lockRecType, unlockRecord, lockLabel, isLockLabel) where++import GF.Infra.Ident+import GF.Grammar.Grammar+import GF.Grammar.Macros++import GF.Data.Operations(ErrorMonad,Err(..))++lockRecType :: ErrorMonad m => Ident -> Type -> m Type+lockRecType c t@(RecType rs) = + let lab = lockLabel c in+ return $ if elem lab (map fst rs) || elem (showIdent c) ["String","Int"]+ then t --- don't add an extra copy of lock field, nor predef cats+ else RecType (rs ++ [(lockLabel c, RecType [])])+lockRecType c t = plusRecType t $ RecType [(lockLabel c, RecType [])]++unlockRecord :: Monad m => Ident -> Term -> m Term+unlockRecord c ft = do+ let (xs,t) = termFormCnc ft+ let lock = R [(lockLabel c, (Just (RecType []),R []))]+ case plusRecord t lock of+ Ok t' -> return $ mkAbs xs t'+ _ -> return $ mkAbs xs (ExtR t lock)++lockLabel :: Ident -> Label+lockLabel c = LIdent $! prefixRawIdent lockPrefix (ident2raw c)++isLockLabel :: Label -> Bool+isLockLabel l = case l of+ LIdent c -> isPrefixOf lockPrefix c+ _ -> False+++lockPrefix = rawIdentS "lock_"
@@ -0,0 +1,247 @@+{-# LANGUAGE PatternGuards #-}+----------------------------------------------------------------------+-- |+-- Module : Lookup+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/10/27 13:21:53 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.15 $+--+-- Lookup in source (concrete and resource) when compiling.+--+-- lookup in resource and concrete in compiling; for abstract, use 'Look'+-----------------------------------------------------------------------------++module GF.Grammar.Lookup (+ lookupIdent,+ lookupOrigInfo,+ allOrigInfos,+ lookupResDef, lookupResDefLoc,+ lookupResType, + lookupOverload,+ lookupOverloadTypes,+ lookupParamValues, + allParamValues,+ lookupAbsDef, + lookupLincat, + lookupFunType,+ lookupCatContext,+ allOpers, allOpersTo+ ) where++import GF.Data.Operations+import GF.Infra.Ident+import GF.Grammar.Macros+import GF.Grammar.Grammar+import GF.Grammar.Printer+import GF.Grammar.Predef+import GF.Grammar.Lockfield++import Data.List (sortBy)+--import Data.Maybe (maybe)+--import Control.Monad+import GF.Text.Pretty+import qualified Data.Map as Map++-- whether lock fields are added in reuse+lock c = lockRecType c -- return+unlock c = unlockRecord c -- return++-- to look up a constant etc in a search tree --- why here? AR 29/5/2008+lookupIdent :: ErrorMonad m => Ident -> BinTree Ident b -> m b+lookupIdent c t =+ case lookupTree showIdent c t of+ Ok v -> return v+ Bad _ -> raise ("unknown identifier" +++ showIdent c)++lookupIdentInfo :: ErrorMonad m => SourceModInfo -> Ident -> m Info+lookupIdentInfo mo i = lookupIdent i (jments mo)++lookupQIdentInfo :: ErrorMonad m => Grammar -> QIdent -> m Info+lookupQIdentInfo gr (m,c) = flip lookupIdentInfo c =<< lookupModule gr m++lookupResDef :: ErrorMonad m => Grammar -> QIdent -> m Term+lookupResDef gr x = fmap unLoc (lookupResDefLoc gr x)++lookupResDefLoc gr (m,c)+ | isPredefCat c = fmap noLoc (lock c defLinType)+ | otherwise = look m c+ where + look m c = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ ResOper _ (Just lt) -> return lt+ ResOper _ Nothing -> return (noLoc (Q (m,c)))+ CncCat (Just (L l ty)) _ _ _ _ -> fmap (L l) (lock c ty)+ CncCat _ _ _ _ _ -> fmap noLoc (lock c defLinType)+ + CncFun (Just (cat,_,_)) (Just (L l tr)) _ _ -> fmap (L l) (unlock cat tr)+ CncFun _ (Just ltr) _ _ -> return ltr++ AnyInd _ n -> look n c+ ResParam _ _ -> return (noLoc (QC (m,c)))+ ResValue _ -> return (noLoc (QC (m,c)))+ _ -> raise $ render (c <+> "is not defined in resource" <+> m)++lookupResType :: ErrorMonad m => Grammar -> QIdent -> m Type+lookupResType gr (m,c) = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ ResOper (Just (L _ t)) _ -> return t++ -- used in reused concrete+ CncCat _ _ _ _ _ -> return typeType+ CncFun (Just (cat,cont,val)) _ _ _ -> do+ val' <- lock cat val + return $ mkProd cont val' []+ AnyInd _ n -> lookupResType gr (n,c)+ ResParam _ _ -> return typePType+ ResValue (L _ t) -> return t+ _ -> raise $ render (c <+> "has no type defined in resource" <+> m)++lookupOverloadTypes :: ErrorMonad m => Grammar -> QIdent -> m [(Term,Type)]+lookupOverloadTypes gr id@(m,c) = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ ResOper (Just (L _ ty)) _ -> ret ty++ -- used in reused concrete+ CncCat _ _ _ _ _ -> ret typeType+ CncFun (Just (cat,cont,val)) _ _ _ -> do+ val' <- lock cat val + ret $ mkProd cont val' []+ ResParam _ _ -> ret typePType+ ResValue (L _ t) -> ret t+ ResOverload os tysts -> do+ tss <- mapM (\x -> lookupOverloadTypes gr (x,c)) os+ return $ [(tr,ty) | (L _ ty,L _ tr) <- tysts] +++ concat tss+ AnyInd _ n -> lookupOverloadTypes gr (n,c)+ _ -> raise $ render (c <+> "has no types defined in resource" <+> m)+ where+ ret ty = return [(Q id,ty)]++lookupOverload :: ErrorMonad m => Grammar -> QIdent -> m [([Type],(Type,Term))]+lookupOverload gr (m,c) = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ ResOverload os tysts -> do+ tss <- mapM (\x -> lookupOverload gr (x,c)) os+ return $ [let (args,val) = typeFormCnc ty in (map (\(b,x,t) -> t) args,(val,tr)) | + (L _ ty,L _ tr) <- tysts] ++ + concat tss++ AnyInd _ n -> lookupOverload gr (n,c)+ _ -> raise $ render (c <+> "is not an overloaded operation")++-- | returns the original 'Info' and the module where it was found+lookupOrigInfo :: ErrorMonad m => Grammar -> QIdent -> m (ModuleName,Info)+lookupOrigInfo gr (m,c) = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ AnyInd _ n -> lookupOrigInfo gr (n,c)+ i -> return (m,i)++allOrigInfos :: Grammar -> ModuleName -> [(QIdent,Info)]+allOrigInfos gr m = fromErr [] $ do+ mo <- lookupModule gr m+ return [((m,c),i) | (c,_) <- tree2list (jments mo), Ok (m,i) <- [lookupOrigInfo gr (m,c)]]++lookupParamValues :: ErrorMonad m => Grammar -> QIdent -> m [Term]+lookupParamValues gr c = do+ (_,info) <- lookupOrigInfo gr c+ case info of+ ResParam _ (Just pvs) -> return pvs+ _ -> raise $ render (ppQIdent Qualified c <+> "has no parameter values defined")++allParamValues :: ErrorMonad m => Grammar -> Type -> m [Term]+allParamValues cnc ptyp =+ case ptyp of+ _ | Just n <- isTypeInts ptyp -> return [EInt i | i <- [0..n]]+ QC c -> lookupParamValues cnc c+ Q c -> lookupResDef cnc c >>= allParamValues cnc+ RecType r -> do+ let (ls,tys) = unzip $ sortByFst r+ tss <- mapM (allParamValues cnc) tys+ return [R (zipAssign ls ts) | ts <- combinations tss]+ Table pt vt -> do+ pvs <- allParamValues cnc pt+ vvs <- allParamValues cnc vt+ return [V pt ts | ts <- combinations (replicate (length pvs) vvs)]+ _ -> raise (render ("cannot find parameter values for" <+> ptyp))+ where+ -- to normalize records and record types+ sortByFst = sortBy (\ x y -> compare (fst x) (fst y))++lookupAbsDef :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m (Maybe Int,Maybe [Equation])+lookupAbsDef gr m c = errIn (render ("looking up absdef of" <+> c)) $ do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ AbsFun _ a d _ -> return (a,fmap (map unLoc) d)+ AnyInd _ n -> lookupAbsDef gr n c+ _ -> return (Nothing,Nothing)++lookupLincat :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m Type+lookupLincat gr m c | isPredefCat c = return defLinType --- ad hoc; not needed?+lookupLincat gr m c = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ CncCat (Just (L _ t)) _ _ _ _ -> return t+ AnyInd _ n -> lookupLincat gr n c+ _ -> raise (render (c <+> "has no linearization type in" <+> m))++-- | this is needed at compile time+lookupFunType :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m Type+lookupFunType gr m c = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ AbsFun (Just (L _ t)) _ _ _ -> return t+ AnyInd _ n -> lookupFunType gr n c+ _ -> raise (render ("cannot find type of" <+> c))++-- | this is needed at compile time+lookupCatContext :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m Context+lookupCatContext gr m c = do+ info <- lookupQIdentInfo gr (m,c)+ case info of+ AbsCat (Just (L _ co)) -> return co+ AnyInd _ n -> lookupCatContext gr n c+ _ -> raise (render ("unknown category" <+> c))+++-- this gives all opers and param constructors, also overloaded opers and funs, and the types, and locations+-- notice that it only gives the modules that are reachable and the opers that are included++allOpers :: Grammar -> [(QIdent,Type,Location)]+allOpers gr = + [((m,op),typ,loc) |+ (m,mi) <- maybe [] (allExtends gr) (greatestResource gr),+ (op,info) <- Map.toList (jments mi),+ L loc typ <- typesIn info+ ]+ where+ typesIn info = case info of+ AbsFun (Just ltyp) _ _ _ -> [ltyp]+ ResOper (Just ltyp) _ -> [ltyp]+ ResValue ltyp -> [ltyp]+ ResOverload _ tytrs -> [ltyp | (ltyp,_) <- tytrs]+ CncFun (Just (i,ctx,typ)) _ _ _ ->+ [L NoLoc (mkProdSimple ctx (lock' i typ))]+ _ -> []++ lock' i typ = case lock i typ of+ Ok t -> t+ _ -> typ++--- not for dependent types+allOpersTo :: Grammar -> Type -> [(QIdent,Type,Location)]+allOpersTo gr ty = [op | op@(_,typ,_) <- allOpers gr, isProdTo ty typ] where+ isProdTo t typ = eqProd typ t || case typ of+ Prod _ _ a b -> isProdTo t b+ _ -> False+ eqProd f g = case (f,g) of+ (Prod _ _ a1 b1, Prod _ _ a2 b2) -> eqProd a1 a2 && eqProd b1 b2+ _ -> f == g
@@ -0,0 +1,647 @@+----------------------------------------------------------------------+-- |+-- Module : Macros+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/11 16:38:00 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.24 $+--+-- Macros for constructing and analysing source code terms.+--+-- operations on terms and types not involving lookup in or reference to grammars+--+-- AR 7\/12\/1999 - 9\/5\/2000 -- 4\/6\/2001+-----------------------------------------------------------------------------++module GF.Grammar.Macros where++import GF.Data.Operations+import GF.Data.Str+import GF.Infra.Ident+import GF.Grammar.Grammar+--import GF.Grammar.Values+import GF.Grammar.Predef+import GF.Grammar.Printer++import Control.Monad.Identity(Identity(..))+import qualified Data.Traversable as T(mapM)+import Control.Monad (liftM, liftM2, liftM3)+--import Data.Char (isDigit)+import Data.List (sortBy,nub)+import Data.Monoid+import GF.Text.Pretty(render,(<+>),hsep,fsep)++-- ** Functions for constructing and analysing source code terms.++typeForm :: Type -> (Context, Cat, [Term])+typeForm t =+ case t of+ Prod b x a t ->+ let (x', cat, args) = typeForm t+ in ((b,x,a):x', cat, args)+ App c a ->+ let (_, cat, args) = typeForm c+ in ([],cat,args ++ [a])+ Q c -> ([],c,[])+ QC c -> ([],c,[])+ Sort c -> ([],(MN identW, c),[])+ _ -> error (render ("no normal form of type" <+> ppTerm Unqualified 0 t))++typeFormCnc :: Type -> (Context, Type)+typeFormCnc t = + case t of+ Prod b x a t -> let (x', v) = typeFormCnc t+ in ((b,x,a):x',v)+ _ -> ([],t)++valCat :: Type -> Cat+valCat typ = + let (_,cat,_) = typeForm typ+ in cat++valType :: Type -> Type+valType typ =+ let (_,cat,xx) = typeForm typ --- not optimal to do in this way+ in mkApp (Q cat) xx++valTypeCnc :: Type -> Type+valTypeCnc typ = snd (typeFormCnc typ)++typeSkeleton :: Type -> ([(Int,Cat)],Cat)+typeSkeleton typ =+ let (ctxt,cat,_) = typeForm typ+ in ([(length c, v) | (b,x,t) <- ctxt, let (c,v) = typeSkeleton t], cat)++catSkeleton :: Type -> ([Cat],Cat)+catSkeleton typ =+ let (args,val) = typeSkeleton typ+ in (map snd args, val)++funsToAndFrom :: Type -> (Cat, [(Cat,[Int])])+funsToAndFrom t =+ let (cs,v) = catSkeleton t+ cis = zip cs [0..]+ in (v, [(c,[i | (c',i) <- cis, c' == c]) | c <- cs])++isRecursiveType :: Type -> Bool+isRecursiveType t =+ let (cc,c) = catSkeleton t -- thus recursivity on Cat level+ in any (== c) cc++isHigherOrderType :: Type -> Bool+isHigherOrderType t = fromErr True $ do -- pessimistic choice+ co <- contextOfType t+ return $ not $ null [x | (_,x,Prod _ _ _ _) <- co]++contextOfType :: Monad m => Type -> m Context+contextOfType typ = case typ of+ Prod b x a t -> liftM ((b,x,a):) $ contextOfType t+ _ -> return [] ++termForm :: Monad m => Term -> m ([(BindType,Ident)], Term, [Term])+termForm t = case t of+ Abs b x t ->+ do (x', fun, args) <- termForm t+ return ((b,x):x', fun, args)+ App c a ->+ do (_,fun, args) <- termForm c+ return ([],fun,args ++ [a]) + _ -> + return ([],t,[])++termFormCnc :: Term -> ([(BindType,Ident)], Term)+termFormCnc t = case t of+ Abs b x t -> ((b,x):xs, t') where (xs,t') = termFormCnc t+ _ -> ([],t)++appForm :: Term -> (Term, [Term])+appForm t = case t of+ App c a -> (fun, args ++ [a]) where (fun, args) = appForm c+ Typed t _ -> appForm t+ _ -> (t,[])++mkProdSimple :: Context -> Term -> Term+mkProdSimple c t = mkProd c t []++mkProd :: Context -> Term -> [Term] -> Term+mkProd [] typ args = mkApp typ args+mkProd ((b,x,a):dd) typ args = Prod b x a (mkProd dd typ args)++mkTerm :: ([(BindType,Ident)], Term, [Term]) -> Term+mkTerm (xx,t,aa) = mkAbs xx (mkApp t aa)++mkApp :: Term -> [Term] -> Term+mkApp = foldl App++mkAbs :: [(BindType,Ident)] -> Term -> Term+mkAbs xx t = foldr (uncurry Abs) t xx++appCons :: Ident -> [Term] -> Term+appCons = mkApp . Cn++mkLet :: [LocalDef] -> Term -> Term+mkLet defs t = foldr Let t defs++mkLetUntyped :: Context -> Term -> Term+mkLetUntyped defs = mkLet [(x,(Nothing,t)) | (_,x,t) <- defs]++isVariable :: Term -> Bool+isVariable (Vr _ ) = True+isVariable _ = False++--eqIdent :: Ident -> Ident -> Bool+--eqIdent = (==)++uType :: Type+uType = Cn cUndefinedType++-- *** Assignment++assign :: Label -> Term -> Assign+assign l t = (l,(Nothing,t))++assignT :: Label -> Type -> Term -> Assign+assignT l a t = (l,(Just a,t))++unzipR :: [Assign] -> ([Label],[Term])+unzipR r = (ls, map snd ts) where (ls,ts) = unzip r++mkAssign :: [(Label,Term)] -> [Assign]+mkAssign lts = [assign l t | (l,t) <- lts]++projectRec :: Label -> [Assign] -> Term+projectRec l rs =+ case lookup l rs of+ Just (_,t) -> t+ Nothing -> error (render ("no value for label" <+> l))++zipAssign :: [Label] -> [Term] -> [Assign]+zipAssign ls ts = [assign l t | (l,t) <- zip ls ts]++mapAssignM :: Monad m => (Term -> m c) -> [Assign] -> m [(Label,(Maybe c,c))]+mapAssignM f = mapM (\ (ls,tv) -> liftM ((,) ls) (g tv))+ where g (t,v) = liftM2 (,) (maybe (return Nothing) (liftM Just . f) t) (f v)++-- *** Records++mkRecordN :: Int -> (Int -> Label) -> [Term] -> Term+mkRecordN int lab typs = R [ assign (lab i) t | (i,t) <- zip [int..] typs]++mkRecord :: (Int -> Label) -> [Term] -> Term+mkRecord = mkRecordN 0++mkRecTypeN :: Int -> (Int -> Label) -> [Type] -> Type+mkRecTypeN int lab typs = RecType [ (lab i, t) | (i,t) <- zip [int..] typs]++mkRecType :: (Int -> Label) -> [Type] -> Type+mkRecType = mkRecTypeN 0++record2subst :: Term -> Err Substitution+record2subst t = case t of+ R fs -> return [(identC x, t) | (LIdent x,(_,t)) <- fs]+ _ -> Bad (render ("record expected, found" <+> ppTerm Unqualified 0 t))+++-- *** Types++typeType, typePType, typeStr, typeTok, typeStrs :: Type++typeType = Sort cType+typePType = Sort cPType+typeStr = Sort cStr+typeTok = Sort cTok+typeStrs = Sort cStrs++typeString, typeFloat, typeInt :: Type+typeInts :: Int -> Type+typePBool :: Type+typeError :: Type++typeString = cnPredef cString+typeInt = cnPredef cInt+typeFloat = cnPredef cFloat+typeInts i = App (cnPredef cInts) (EInt i)+typePBool = cnPredef cPBool+typeError = cnPredef cErrorType++isTypeInts :: Type -> Maybe Int+isTypeInts (App c (EInt i)) | c == cnPredef cInts = Just i+isTypeInts _ = Nothing++-- *** Terms++isPredefConstant :: Term -> Bool+isPredefConstant t = case t of+ Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True+ _ -> False++checkPredefError :: Monad m => Term -> m Term+checkPredefError t =+ case t of+ Error s -> fail ("Error: "++s)+ _ -> return t++cnPredef :: Ident -> Term+cnPredef f = Q (cPredef,f)++mkSelects :: Term -> [Term] -> Term+mkSelects t tt = foldl S t tt++mkTable :: [Term] -> Term -> Term+mkTable tt t = foldr Table t tt++mkCTable :: [(BindType,Ident)] -> Term -> Term+mkCTable ids v = foldr ccase v ids where + ccase (_,x) t = T TRaw [(PV x,t)]++mkHypo :: Term -> Hypo+mkHypo typ = (Explicit,identW, typ)++eqStrIdent :: Ident -> Ident -> Bool+eqStrIdent = (==)++tuple2record :: [Term] -> [Assign]+tuple2record ts = [assign (tupleLabel i) t | (i,t) <- zip [1..] ts]++tuple2recordType :: [Term] -> [Labelling]+tuple2recordType ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts]++tuple2recordPatt :: [Patt] -> [(Label,Patt)]+tuple2recordPatt ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts]++mkCases :: Ident -> Term -> Term+mkCases x t = T TRaw [(PV x, t)]++mkWildCases :: Term -> Term+mkWildCases = mkCases identW++mkFunType :: [Type] -> Type -> Type+mkFunType tt t = mkProd [(Explicit,identW, ty) | ty <- tt] t [] -- nondep prod++--plusRecType :: Type -> Type -> Err Type+plusRecType t1 t2 = case (t1, t2) of+ (RecType r1, RecType r2) -> case+ filter (`elem` (map fst r1)) (map fst r2) of+ [] -> return (RecType (r1 ++ r2))+ ls -> raise $ render ("clashing labels" <+> hsep ls)+ _ -> raise $ render ("cannot add record types" <+> ppTerm Unqualified 0 t1 <+> "and" <+> ppTerm Unqualified 0 t2) ++--plusRecord :: Term -> Term -> Err Term+plusRecord t1 t2 =+ case (t1,t2) of+ (R r1, R r2 ) -> return (R ([(l,v) | -- overshadowing of old fields+ (l,v) <- r1, not (elem l (map fst r2)) ] ++ r2))+ (_, FV rs) -> mapM (plusRecord t1) rs >>= return . FV+ (FV rs,_ ) -> mapM (`plusRecord` t2) rs >>= return . FV+ _ -> raise $ render ("cannot add records" <+> ppTerm Unqualified 0 t1 <+> "and" <+> ppTerm Unqualified 0 t2)++-- | default linearization type+defLinType :: Type+defLinType = RecType [(theLinLabel, typeStr)]++-- | refreshing variables+mkFreshVar :: [Ident] -> Ident+mkFreshVar olds = varX (maxVarIndex olds + 1) ++-- | trying to preserve a given symbol+mkFreshVarX :: [Ident] -> Ident -> Ident+mkFreshVarX olds x = if (elem x olds) then (varX (maxVarIndex olds + 1)) else x++maxVarIndex :: [Ident] -> Int+maxVarIndex = maximum . ((-1):) . map varIndex++mkFreshVars :: Int -> [Ident] -> [Ident] +mkFreshVars n olds = [varX (maxVarIndex olds + i) | i <- [1..n]]++-- | quick hack for refining with var in editor+freshAsTerm :: String -> Term+freshAsTerm s = Vr (varX (readIntArg s))++-- | create a terminal for concrete syntax+string2term :: String -> Term+string2term = K++int2term :: Int -> Term+int2term = EInt++float2term :: Double -> Term+float2term = EFloat++-- | create a terminal from identifier+ident2terminal :: Ident -> Term+ident2terminal = K . showIdent++symbolOfIdent :: Ident -> String+symbolOfIdent = showIdent++symid :: Ident -> String+symid = symbolOfIdent++justIdentOf :: Term -> Maybe Ident+justIdentOf (Vr x) = Just x+justIdentOf (Cn x) = Just x+justIdentOf _ = Nothing++linTypeStr :: Type+linTypeStr = mkRecType linLabel [typeStr] -- default lintype {s :: Str}++linAsStr :: String -> Term+linAsStr s = mkRecord linLabel [K s] -- default linearization {s = s}++-- *** Term and pattern conversion++term2patt :: Term -> Err Patt+term2patt trm = case termForm trm of+ Ok ([], Vr x, []) | x == identW -> return PW+ | otherwise -> return (PV x)+ Ok ([], Con c, aa) -> do+ aa' <- mapM term2patt aa+ return (PC c aa')+ Ok ([], QC c, aa) -> do+ aa' <- mapM term2patt aa+ return (PP c aa')++ Ok ([], Q c, []) -> do+ return (PM c)++ Ok ([], R r, []) -> do+ let (ll,aa) = unzipR r+ aa' <- mapM term2patt aa+ return (PR (zip ll aa'))+ Ok ([],EInt i,[]) -> return $ PInt i+ Ok ([],EFloat i,[]) -> return $ PFloat i+ Ok ([],K s, []) -> return $ PString s++--- encodings due to excessive use of term-patt convs. AR 7/1/2005+ Ok ([], Cn id, [Vr a,b]) | id == cAs -> do+ b' <- term2patt b+ return (PAs a b')+ Ok ([], Cn id, [a]) | id == cNeg -> do+ a' <- term2patt a+ return (PNeg a')+ Ok ([], Cn id, [a]) | id == cRep -> do+ a' <- term2patt a+ return (PRep a')+ Ok ([], Cn id, []) | id == cRep -> do+ return PChar+ Ok ([], Cn id,[K s]) | id == cChars -> do+ return $ PChars s+ Ok ([], Cn id, [a,b]) | id == cSeq -> do+ a' <- term2patt a+ b' <- term2patt b+ return (PSeq a' b')+ Ok ([], Cn id, [a,b]) | id == cAlt -> do+ a' <- term2patt a+ b' <- term2patt b+ return (PAlt a' b')++ Ok ([], Cn c, []) -> do+ return (PMacro c)++ _ -> Bad $ render ("no pattern corresponds to term" <+> ppTerm Unqualified 0 trm)++patt2term :: Patt -> Term+patt2term pt = case pt of+ PV x -> Vr x+ PW -> Vr identW --- not parsable, should not occur+ PMacro c -> Cn c+ PM c -> Q c++ PC c pp -> mkApp (Con c) (map patt2term pp)+ PP c pp -> mkApp (QC c) (map patt2term pp)++ PR r -> R [assign l (patt2term p) | (l,p) <- r] + PT _ p -> patt2term p+ PInt i -> EInt i+ PFloat i -> EFloat i+ PString s -> K s ++ PAs x p -> appCons cAs [Vr x, patt2term p] --- an encoding+ PChar -> appCons cChar [] --- an encoding+ PChars s -> appCons cChars [K s] --- an encoding+ PSeq a b -> appCons cSeq [(patt2term a), (patt2term b)] --- an encoding+ PAlt a b -> appCons cAlt [(patt2term a), (patt2term b)] --- an encoding+ PRep a -> appCons cRep [(patt2term a)] --- an encoding+ PNeg a -> appCons cNeg [(patt2term a)] --- an encoding+++-- *** Almost compositional++-- | to define compositional term functions+composSafeOp :: (Term -> Term) -> Term -> Term+composSafeOp op = runIdentity . composOp (return . op)++-- | to define compositional term functions+composOp :: Monad m => (Term -> m Term) -> Term -> m Term+composOp co trm = + case trm of+ App c a -> liftM2 App (co c) (co a)+ Abs b x t -> liftM (Abs b x) (co t)+ Prod b x a t -> liftM2 (Prod b x) (co a) (co t)+ S c a -> liftM2 S (co c) (co a)+ Table a c -> liftM2 Table (co a) (co c)+ R r -> liftM R (mapAssignM co r)+ RecType r -> liftM RecType (mapPairsM co r)+ P t i -> liftM2 P (co t) (return i)+ ExtR a c -> liftM2 ExtR (co a) (co c)+ T i cc -> liftM2 (flip T) (mapPairsM co cc) (changeTableType co i)+ V ty vs -> liftM2 V (co ty) (mapM co vs)+ Let (x,(mt,a)) b -> liftM3 let' (co a) (T.mapM co mt) (co b)+ where let' a' mt' b' = Let (x,(mt',a')) b'+ C s1 s2 -> liftM2 C (co s1) (co s2)+ Glue s1 s2 -> liftM2 Glue (co s1) (co s2)+ Alts t aa -> liftM2 Alts (co t) (mapM (pairM co) aa)+ FV ts -> liftM FV (mapM co ts)+ Strs tt -> liftM Strs (mapM co tt)+ EPattType ty -> liftM EPattType (co ty)+ ELincat c ty -> liftM (ELincat c) (co ty)+ ELin c ty -> liftM (ELin c) (co ty)+ ImplArg t -> liftM ImplArg (co t)+ _ -> return trm -- covers K, Vr, Cn, Sort, EPatt++composSafePattOp op = runIdentity . composPattOp (return . op)++composPattOp :: Monad m => (Patt -> m Patt) -> Patt -> m Patt+composPattOp op patt =+ case patt of+ PC c ps -> liftM (PC c) (mapM op ps)+ PP qc ps -> liftM (PP qc) (mapM op ps)+ PR as -> liftM PR (mapPairsM op as)+ PT ty p -> liftM (PT ty) (op p)+ PAs x p -> liftM (PAs x) (op p)+ PImplArg p -> liftM PImplArg (op p)+ PNeg p -> liftM PNeg (op p)+ PAlt p1 p2 -> liftM2 PAlt (op p1) (op p2)+ PSeq p1 p2 -> liftM2 PSeq (op p1) (op p2)+ PMSeq (_,p1) (_,p2) -> liftM2 PSeq (op p1) (op p2) -- information loss+ PRep p -> liftM PRep (op p)+ _ -> return patt -- covers cases without subpatterns++collectOp :: Monoid m => (Term -> m) -> Term -> m+collectOp co trm = case trm of+ App c a -> co c <> co a+ Abs _ _ b -> co b+ Prod _ _ a b -> co a <> co b+ S c a -> co c <> co a+ Table a c -> co a <> co c+ ExtR a c -> co a <> co c+ R r -> mconcatMap (\ (_,(mt,a)) -> maybe mempty co mt <> co a) r+ RecType r -> mconcatMap (co . snd) r+ P t i -> co t+ T _ cc -> mconcatMap (co . snd) cc -- not from patterns --- nor from type annot+ V _ cc -> mconcatMap co cc --- nor from type annot+ Let (x,(mt,a)) b -> maybe mempty co mt <> co a <> co b+ C s1 s2 -> co s1 <> co s2+ Glue s1 s2 -> co s1 <> co s2+ Alts t aa -> let (x,y) = unzip aa in co t <> mconcatMap co (x <> y)+ FV ts -> mconcatMap co ts+ Strs tt -> mconcatMap co tt+ _ -> mempty -- covers K, Vr, Cn, Sort++mconcatMap f = mconcat . map f++collectPattOp :: (Patt -> [a]) -> Patt -> [a]+collectPattOp op patt =+ case patt of+ PC c ps -> concatMap op ps+ PP qc ps -> concatMap op ps+ PR as -> concatMap (op.snd) as+ PT ty p -> op p+ PAs x p -> op p+ PImplArg p -> op p+ PNeg p -> op p+ PAlt p1 p2 -> op p1++op p2+ PSeq p1 p2 -> op p1++op p2+ PMSeq (_,p1) (_,p2) -> op p1++op p2+ PRep p -> op p+ _ -> [] -- covers cases without subpatterns+++-- *** Misc++redirectTerm :: ModuleName -> Term -> Term+redirectTerm n t = case t of+ QC (_,f) -> QC (n,f)+ Q (_,f) -> Q (n,f)+ _ -> composSafeOp (redirectTerm n) t++-- | to gather ultimate cases in a table; preserves pattern list+allCaseValues :: Term -> [([Patt],Term)]+allCaseValues trm = case trm of+ T _ cs -> [(p:ps, t) | (p,t0) <- cs, (ps,t) <- allCaseValues t0]+ _ -> [([],trm)]++-- | to get a string from a term that represents a sequence of terminals+strsFromTerm :: Term -> Err [Str]+strsFromTerm t = case t of+ K s -> return [str s]+ Empty -> return [str []]+ C s t -> do+ s' <- strsFromTerm s+ t' <- strsFromTerm t+ return [plusStr x y | x <- s', y <- t']+ Glue s t -> do+ s' <- strsFromTerm s+ t' <- strsFromTerm t+ return [glueStr x y | x <- s', y <- t']+ Alts d vs -> do+ d0 <- strsFromTerm d+ v0 <- mapM (strsFromTerm . fst) vs+ c0 <- mapM (strsFromTerm . snd) vs+ --let vs' = zip v0 c0+ return [strTok (str2strings def) vars | + def <- d0,+ vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | + vv <- combinations v0]+ ]+ FV ts -> mapM strsFromTerm ts >>= return . concat+ Strs ts -> mapM strsFromTerm ts >>= return . concat + _ -> raise (render ("cannot get Str from term" <+> ppTerm Unqualified 0 t))++-- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg+stringFromTerm :: Term -> String+stringFromTerm = err id (ifNull "" (sstr . head)) . strsFromTerm++getTableType :: TInfo -> Err Type+getTableType i = case i of+ TTyped ty -> return ty+ TComp ty -> return ty+ TWild ty -> return ty+ _ -> Bad "the table is untyped"++changeTableType :: Monad m => (Type -> m Type) -> TInfo -> m TInfo+changeTableType co i = case i of+ TTyped ty -> co ty >>= return . TTyped+ TComp ty -> co ty >>= return . TComp+ TWild ty -> co ty >>= return . TWild+ _ -> return i++-- | to find the word items in a term+wordsInTerm :: Term -> [String]+wordsInTerm trm = filter (not . null) $ case trm of+ K s -> [s]+ S c _ -> wo c+ Alts t aa -> wo t ++ concatMap (wo . fst) aa+ _ -> collectOp wo trm+ where wo = wordsInTerm++noExist :: Term+noExist = FV []++defaultLinType :: Type+defaultLinType = mkRecType linLabel [typeStr]++-- normalize records and record types; put s first++sortRec :: [(Label,a)] -> [(Label,a)]+sortRec = sortBy ordLabel where+ ordLabel (r1,_) (r2,_) = + case (showIdent (label2ident r1), showIdent (label2ident r2)) of+ ("s",_) -> LT+ (_,"s") -> GT+ (s1,s2) -> compare s1 s2++-- *** Dependencies++-- | dependency check, detecting circularities and returning topo-sorted list++allDependencies :: (ModuleName -> Bool) -> BinTree Ident Info -> [(Ident,[Ident])]+allDependencies ism b = + [(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b]+ where+ opersIn t = case t of+ Q (n,c) | ism n -> [c]+ QC (n,c) | ism n -> [c]+ _ -> collectOp opersIn t+ opty (Just (L _ ty)) = opersIn ty+ opty _ = []+ pts i = case i of+ ResOper pty pt -> [pty,pt]+ ResOverload _ tyts -> concat [[Just ty, Just tr] | (ty,tr) <- tyts]+ ResParam (Just (L loc ps)) _ -> [Just (L loc t) | (_,cont) <- ps, (_,_,t) <- cont]+ CncCat pty _ _ _ _ -> [pty]+ CncFun _ pt _ _ -> [pt] ---- (Maybe (Ident,(Context,Type))+ AbsFun pty _ ptr _ -> [pty] --- ptr is def, which can be mutual+ AbsCat (Just (L loc co)) -> [Just (L loc ty) | (_,_,ty) <- co]+ _ -> []++topoSortJments :: ErrorMonad m => SourceModule -> m [(Ident,Info)]+topoSortJments (m,mi) = do+ is <- either+ return+ (\cyc -> raise (render ("circular definitions:" <+> fsep (head cyc))))+ (topoTest (allDependencies (==m) (jments mi)))+ return (reverse [(i,info) | i <- is, Ok info <- [lookupTree showIdent i (jments mi)]])++topoSortJments2 :: ErrorMonad m => SourceModule -> m [[(Ident,Info)]]+topoSortJments2 (m,mi) = do+ iss <- either+ return+ (\cyc -> raise (render ("circular definitions:"+ <+> fsep (head cyc))))+ (topoTest2 (allDependencies (==m) (jments mi)))+ return+ [[(i,info) | i<-is,Ok info<-[lookupTree showIdent i (jments mi)]] | is<-iss]
@@ -0,0 +1,828 @@+-- -*- haskell -*-+{+{-# OPTIONS -fno-warn-overlapping-patterns #-}+module GF.Grammar.Parser+ ( P, runP, runPartial+ , pModDef+ , pModHeader+ , pTerm+ , pExp+ , pTopDef+ , pBNFCRules+ , pEBNFRules+ ) where++import GF.Infra.Ident+import GF.Infra.Option+import GF.Data.Operations+import GF.Grammar.Predef+import GF.Grammar.Grammar+import GF.Grammar.BNFC+import GF.Grammar.EBNF+import GF.Grammar.Macros+import GF.Grammar.Lexer+import GF.Compile.Update (buildAnyTree)+import Data.List(intersperse)+import Data.Char(isAlphaNum)+import PGF(mkCId)++}++%name pModDef ModDef+%name pTopDef TopDef+%partial pModHeader ModHeader+%partial pTerm Exp1+%name pExp Exp+%name pBNFCRules ListCFRule+%name pEBNFRules ListEBNFRule++-- no lexer declaration+%monad { P } { >>= } { return }+%lexer { lexer } { T_EOF }+%tokentype { Token }+++%token + '!' { T_exclmark }+ '#' { T_patt }+ '$' { T_int_label }+ '(' { T_oparen }+ ')' { T_cparen }+ '~' { T_tilde }+ '*' { T_star }+ '**' { T_starstar }+ '+' { T_plus }+ '++' { T_plusplus }+ ',' { T_comma }+ '-' { T_minus }+ '->' { T_rarrow }+ '.' { T_dot }+ '/' { T_alt }+ ':' { T_colon }+ ';' { T_semicolon }+ '<' { T_less }+ '=' { T_equal }+ '=>' { T_big_rarrow}+ '>' { T_great }+ '?' { T_questmark }+ '@' { T_at }+ '[' { T_obrack }+ ']' { T_cbrack }+ '{' { T_ocurly }+ '}' { T_ccurly }+ '\\' { T_lam }+ '\\\\' { T_lamlam }+ '_' { T_underscore}+ '|' { T_bar }+ '::=' { T_cfarrow }+ 'PType' { T_PType }+ 'Str' { T_Str }+ 'Strs' { T_Strs }+ 'Tok' { T_Tok }+ 'Type' { T_Type }+ 'abstract' { T_abstract }+ 'case' { T_case }+ 'cat' { T_cat }+ 'concrete' { T_concrete }+ 'data' { T_data }+ 'def' { T_def }+ 'flags' { T_flags }+ 'fun' { T_fun }+ 'in' { T_in }+ 'incomplete' { T_incomplete}+ 'instance' { T_instance }+ 'interface' { T_interface }+ 'let' { T_let }+ 'lin' { T_lin }+ 'lincat' { T_lincat }+ 'lindef' { T_lindef }+ 'linref' { T_linref }+ 'of' { T_of }+ 'open' { T_open }+ 'oper' { T_oper }+ 'param' { T_param }+ 'pattern' { T_pattern }+ 'pre' { T_pre }+ 'printname' { T_printname }+ 'resource' { T_resource }+ 'strs' { T_strs }+ 'table' { T_table }+ 'variants' { T_variants }+ 'where' { T_where }+ 'with' { T_with }+ 'coercions' { T_coercions }+ 'terminator' { T_terminator }+ 'separator' { T_separator }+ 'nonempty' { T_nonempty }++Integer { (T_Integer $$) }+Double { (T_Double $$) }+String { (T_String $$) }+Ident { (T_Ident $$) }+++%%++ModDef :: { SourceModule }+ModDef+ : ComplMod ModType '=' ModBody {%+ do let mstat = $1+ (mtype,id) = $2+ (extends,with,content) = $4+ (opens,jments,opts) = case content of { Just c -> c; Nothing -> ([],[],noOptions) }+ jments <- mapM (checkInfoType mtype) jments+ defs <- buildAnyTree id jments+ return (id, ModInfo mtype mstat opts extends with opens [] "" Nothing defs) }++ModHeader :: { SourceModule }+ModHeader+ : ComplMod ModType '=' ModHeaderBody { let { mstat = $1 ;+ (mtype,id) = $2 ;+ (extends,with,opens) = $4 }+ in (id, ModInfo mtype mstat noOptions extends with opens [] "" Nothing emptyBinTree) }++ComplMod :: { ModuleStatus }+ComplMod + : {- empty -} { MSComplete } + | 'incomplete' { MSIncomplete }++ModType :: { (ModuleType,ModuleName) }+ModType+ : 'abstract' ModuleName { (MTAbstract, $2) }+ | 'resource' ModuleName { (MTResource, $2) }+ | 'interface' ModuleName { (MTInterface, $2) }+ | 'concrete' ModuleName 'of' ModuleName { (MTConcrete $4, $2) }+ | 'instance' ModuleName 'of' Included { (MTInstance $4, $2) }++ModHeaderBody :: { ( [(ModuleName,MInclude)]+ , Maybe (ModuleName,MInclude,[(ModuleName,ModuleName)])+ , [OpenSpec]+ ) }+ModHeaderBody+ : ListIncluded '**' Included 'with' ListInst '**' ModOpen { ($1, Just (fst $3,snd $3,$5), $7) }+ | ListIncluded '**' Included 'with' ListInst { ($1, Just (fst $3,snd $3,$5), []) }+ | ListIncluded '**' ModOpen { ($1, Nothing, $3) }+ | ListIncluded { ($1, Nothing, []) }+ | Included 'with' ListInst '**' ModOpen { ([], Just (fst $1,snd $1,$3), $5) }+ | Included 'with' ListInst { ([], Just (fst $1,snd $1,$3), []) }+ | ModOpen { ([], Nothing, $1) }++ModOpen :: { [OpenSpec] }+ModOpen+ : { [] }+ | 'open' ListOpen { $2 }++ModBody :: { ( [(ModuleName,MInclude)]+ , Maybe (ModuleName,MInclude,[(ModuleName,ModuleName)])+ , Maybe ([OpenSpec],[(Ident,Info)],Options)+ ) }+ModBody+ : ListIncluded '**' Included 'with' ListInst '**' ModContent { ($1, Just (fst $3,snd $3,$5), Just $7) }+ | ListIncluded '**' Included 'with' ListInst { ($1, Just (fst $3,snd $3,$5), Nothing) }+ | ListIncluded '**' ModContent { ($1, Nothing, Just $3) }+ | ListIncluded { ($1, Nothing, Nothing) }+ | Included 'with' ListInst '**' ModContent { ([], Just (fst $1,snd $1,$3), Just $5) }+ | Included 'with' ListInst { ([], Just (fst $1,snd $1,$3), Nothing) }+ | ModContent { ([], Nothing, Just $1) }+ | ModBody ';' { $1 }++ModContent :: { ([OpenSpec],[(Ident,Info)],Options) }+ModContent+ : '{' ListTopDef '}' { ([],[d | Left ds <- $2, d <- ds],concatOptions [o | Right o <- $2]) }+ | 'open' ListOpen 'in' '{' ListTopDef '}' { ($2,[d | Left ds <- $5, d <- ds],concatOptions [o | Right o <- $5]) }++ListTopDef :: { [Either [(Ident,Info)] Options] }+ListTopDef+ : {- empty -} { [] } + | TopDef ListTopDef { $1 : $2 }++ListOpen :: { [OpenSpec] }+ListOpen+ : Open { [$1] }+ | Open ',' ListOpen { $1 : $3 }++Open :: { OpenSpec }+Open+ : ModuleName { OSimple $1 }+ | '(' ModuleName '=' ModuleName ')' { OQualif $2 $4 }++ListInst :: { [(ModuleName,ModuleName)] }+ListInst+ : Inst { [$1] }+ | Inst ',' ListInst { $1 : $3 }++Inst :: { (ModuleName,ModuleName) }+Inst+ : '(' ModuleName '=' ModuleName ')' { ($2,$4) }++ListIncluded :: { [(ModuleName,MInclude)] }+ListIncluded+ : Included { [$1] }+ | Included ',' ListIncluded { $1 : $3 }++Included :: { (ModuleName,MInclude) }+Included + : ModuleName { ($1,MIAll ) }+ | ModuleName '[' ListIdent ']' { ($1,MIOnly $3) }+ | ModuleName '-' '[' ListIdent ']' { ($1,MIExcept $4) }++TopDef :: { Either [(Ident,Info)] Options }+TopDef+ : 'cat' ListCatDef { Left $2 }+ | 'fun' ListFunDef { Left $2 }+ | 'def' ListDefDef { Left $2 }+ | 'data' ListDataDef { Left $2 }+ | 'param' ListParamDef { Left $2 }+ | 'oper' ListOperDef { Left $2 }+ | 'lincat' ListTermDef { Left [(f, CncCat (Just e) Nothing Nothing Nothing Nothing) | (f,e) <- $2] }+ | 'lindef' ListTermDef { Left [(f, CncCat Nothing (Just e) Nothing Nothing Nothing) | (f,e) <- $2] }+ | 'linref' ListTermDef { Left [(f, CncCat Nothing Nothing (Just e) Nothing Nothing) | (f,e) <- $2] }+ | 'lin' ListLinDef { Left $2 }+ | 'printname' 'cat' ListTermDef { Left [(f, CncCat Nothing Nothing Nothing (Just e) Nothing) | (f,e) <- $3] }+ | 'printname' 'fun' ListTermDef { Left [(f, CncFun Nothing Nothing (Just e) Nothing) | (f,e) <- $3] }+ | 'flags' ListFlagDef { Right $2 }++CatDef :: { [(Ident,Info)] }+CatDef+ : Posn Ident ListDDecl Posn { [($2, AbsCat (Just (mkL $1 $4 $3)))] }+ | Posn '[' Ident ListDDecl ']' Posn { listCatDef (mkL $1 $6 ($3,$4,0)) }+ | Posn '[' Ident ListDDecl ']' '{' Integer '}' Posn { listCatDef (mkL $1 $9 ($3,$4,fromIntegral $7)) }++FunDef :: { [(Ident,Info)] }+FunDef+ : Posn ListIdent ':' Exp Posn { [(fun, AbsFun (Just (mkL $1 $5 $4)) Nothing (Just []) (Just True)) | fun <- $2] } ++DefDef :: { [(Ident,Info)] }+DefDef+ : Posn LhsNames '=' Exp Posn { [(f, AbsFun Nothing (Just 0) (Just [mkL $1 $5 ([],$4)]) Nothing) | f <- $2] }+ | Posn LhsName ListPatt '=' Exp Posn { [($2,AbsFun Nothing (Just (length $3)) (Just [mkL $1 $6 ($3,$5)]) Nothing)] }++DataDef :: { [(Ident,Info)] }+DataDef+ : Posn Ident '=' ListDataConstr Posn { ($2, AbsCat Nothing) :+ [(fun, AbsFun Nothing Nothing Nothing (Just True)) | fun <- $4] }+ | Posn ListIdent ':' Exp Posn { -- (snd (valCat $4), AbsCat Nothing) :+ [(fun, AbsFun (Just (mkL $1 $5 $4)) Nothing Nothing (Just True)) | fun <- $2] } ++ParamDef :: { [(Ident,Info)] }+ParamDef+ : Posn LhsIdent '=' ListParConstr Posn { ($2, ResParam (Just (mkL $1 $5 [param | L loc param <- $4])) Nothing) :+ [(f, ResValue (L loc (mkProdSimple co (Cn $2)))) | L loc (f,co) <- $4] }+ | Posn LhsIdent Posn { [($2, ResParam Nothing Nothing)] }++OperDef :: { [(Ident,Info)] }+OperDef+ : Posn LhsNames ':' Exp Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $5 $4)) Nothing ] }+ | Posn LhsNames '=' Exp Posn { [(i, info) | i <- $2, info <- mkOverload Nothing (Just (mkL $1 $5 $4))] }+ | Posn LhsName ListArg '=' Exp Posn { [(i, info) | i <- [$2], info <- mkOverload Nothing (Just (mkL $1 $6 (mkAbs $3 $5)))] }+ | Posn LhsNames ':' Exp '=' Exp Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $7 $4)) (Just (mkL $1 $7 $6))] }++LinDef :: { [(Ident,Info)] }+LinDef+ : Posn LhsNames '=' Exp Posn { [(f, CncFun Nothing (Just (mkL $1 $5 $4)) Nothing Nothing) | f <- $2] }+ | Posn LhsName ListArg '=' Exp Posn { [($2, CncFun Nothing (Just (mkL $1 $6 (mkAbs $3 $5))) Nothing Nothing)] }++TermDef :: { [(Ident,L Term)] }+TermDef+ : Posn LhsNames '=' Exp Posn { [(i,mkL $1 $5 $4) | i <- $2] }++FlagDef :: { Options }+FlagDef+ : Posn Ident '=' Ident Posn {% case parseModuleOptions ["--" ++ showIdent $2 ++ "=" ++ showIdent $4] of+ Ok x -> return x+ Bad msg -> failLoc $1 msg } + | Posn Ident '=' Double Posn {% case parseModuleOptions ["--" ++ showIdent $2 ++ "=" ++ show $4] of+ Ok x -> return x+ Bad msg -> failLoc $1 msg } ++ListDataConstr :: { [Ident] }+ListDataConstr+ : Ident { [$1] }+ | Ident '|' ListDataConstr { $1 : $3 }++ParConstr :: { L Param }+ParConstr+ : Posn Ident ListDDecl Posn { mkL $1 $4 ($2,$3) } ++ListLinDef :: { [(Ident,Info)] }+ListLinDef+ : LinDef ';' { $1 } + | LinDef ';' ListLinDef { $1 ++ $3 }++ListDefDef :: { [(Ident,Info)] }+ListDefDef+ : DefDef ';' { $1 } + | DefDef ';' ListDefDef { $1 ++ $3 }++ListOperDef :: { [(Ident,Info)] }+ListOperDef+ : OperDef ';' { $1 } + | OperDef ';' ListOperDef { $1 ++ $3 }++ListCatDef :: { [(Ident,Info)] }+ListCatDef+ : CatDef ';' { $1 } + | CatDef ';' ListCatDef { $1 ++ $3 }++ListFunDef :: { [(Ident,Info)] }+ListFunDef+ : FunDef ';' { $1 }+ | FunDef ';' ListFunDef { $1 ++ $3 }++ListDataDef :: { [(Ident,Info)] }+ListDataDef+ : DataDef ';' { $1 } + | DataDef ';' ListDataDef { $1 ++ $3 }++ListParamDef :: { [(Ident,Info)] }+ListParamDef+ : ParamDef ';' { $1 } + | ParamDef ';' ListParamDef { $1 ++ $3 }++ListTermDef :: { [(Ident,L Term)] }+ListTermDef+ : TermDef ';' { $1 } + | TermDef ';' ListTermDef { $1 ++ $3 }++ListFlagDef :: { Options }+ListFlagDef+ : FlagDef ';' { $1 } + | FlagDef ';' ListFlagDef { addOptions $1 $3 }++ListParConstr :: { [L Param] }+ListParConstr+ : ParConstr { [$1] }+ | ParConstr '|' ListParConstr { $1 : $3 }++ListIdent :: { [Ident] }+ListIdent+ : Ident { [$1] } + | Ident ',' ListIdent { $1 : $3 }++ListIdent2 :: { [Ident] }+ListIdent2 + : Ident { [$1] } + | Ident ListIdent2 { $1 : $2 }++LhsIdent :: { Ident }+ : Ident { $1 }+ | Posn Sort {% failLoc $1 (showIdent $2++ " is a predefined constant, it can not be redefined") }++LhsName :: { Ident }+LhsName+ : LhsIdent { $1 }+ | '[' LhsIdent ']' { mkListId $2 }++LhsNames :: { [Ident] }+LhsNames+ : LhsName { [$1] }+ | LhsName ',' LhsNames { $1 : $3 }++LocDef :: { [(Ident, Maybe Type, Maybe Term)] }+LocDef+ : ListIdent ':' Exp { [(lab,Just $3,Nothing) | lab <- $1] } + | ListIdent '=' Exp { [(lab,Nothing,Just $3) | lab <- $1] }+ | ListIdent ':' Exp '=' Exp { [(lab,Just $3,Just $5) | lab <- $1] }++ListLocDef :: { [(Ident, Maybe Type, Maybe Term)] }+ListLocDef+ : {- empty -} { [] } + | LocDef { $1 }+ | LocDef ';' ListLocDef { $1 ++ $3 }++Exp :: { Term }+Exp+ : Exp1 '|' Exp { FV [$1,$3] } + | '\\' ListBind '->' Exp { mkAbs $2 $4 }+ | '\\\\' ListBind '=>' Exp { mkCTable $2 $4 }+ | Decl '->' Exp { mkProdSimple $1 $3 }+ | Exp3 '=>' Exp { Table $1 $3 }+ | 'let' '{' ListLocDef '}' 'in' Exp {%+ do defs <- mapM tryLoc $3+ return $ mkLet defs $6 }+ | 'let' ListLocDef 'in' Exp {%+ do defs <- mapM tryLoc $2+ return $ mkLet defs $4 }+ | Exp3 'where' '{' ListLocDef '}' {%+ do defs <- mapM tryLoc $4+ return $ mkLet defs $1 }+ | 'in' Exp5 String { Example $2 $3 }+ | Exp1 { $1 }++Exp1 :: { Term }+Exp1+ : Exp2 '++' Exp1 { C $1 $3 } + | Exp2 { $1 }++Exp2 :: { Term }+Exp2+ : Exp3 '+' Exp2 { Glue $1 $3 } + | Exp3 { $1 }++Exp3 :: { Term }+Exp3+ : Exp3 '!' Exp4 { S $1 $3 } + | 'table' '{' ListCase '}' { T TRaw $3 }+ | 'table' Exp6 '{' ListCase '}' { T (TTyped $2) $4 }+ | 'table' Exp6 '[' ListExp ']' { V $2 $4 }+ | Exp3 '*' Exp4 { case $1 of+ RecType xs -> RecType (xs ++ [(tupleLabel (length xs+1),$3)])+ t -> RecType [(tupleLabel 1,$1), (tupleLabel 2,$3)] }+ | Exp3 '**' Exp4 { ExtR $1 $3 }+ | Exp4 { $1 }++Exp4 :: { Term }+Exp4+ : Exp4 Exp5 { App $1 $2 }+ | Exp4 '{' Exp '}' { App $1 (ImplArg $3) } + | 'case' Exp 'of' '{' ListCase '}' { let annot = case $2 of+ Typed _ t -> TTyped t+ _ -> TRaw+ in S (T annot $5) $2 }+ | 'variants' '{' ListExp '}' { FV $3 }+ | 'pre' '{' ListCase '}' {% mkAlts $3 }+ | 'pre' '{' String ';' ListAltern '}' { Alts (K $3) $5 }+ | 'pre' '{' Ident ';' ListAltern '}' { Alts (Vr $3) $5 }+ | 'strs' '{' ListExp '}' { Strs $3 }+ | '#' Patt3 { EPatt $2 }+ | 'pattern' Exp5 { EPattType $2 }+ | 'lincat' Ident Exp5 { ELincat $2 $3 }+ | 'lin' Ident Exp5 { ELin $2 $3 }+ | Exp5 { $1 }++Exp5 :: { Term }+Exp5+ : Exp5 '.' Label { P $1 $3 } + | Exp6 { $1 }++Exp6 :: { Term }+Exp6 + : Ident { Vr $1 } + | Sort { Sort $1 }+ | String { K $1 }+ | Integer { EInt $1 }+ | Double { EFloat $1 }+ | '?' { Meta 0 }+ | '[' ']' { Empty }+ | '[' Ident Exps ']' { foldl App (Vr (mkListId $2)) $3 }+ | '[' String ']' { K $2 }+ | '{' ListLocDef '}' {% mkR $2 }+ | '<' ListTupleComp '>' { R (tuple2record $2) }+ | '<' Exp ':' Exp '>' { Typed $2 $4 }+ | '(' Exp ')' { $2 }++ListExp :: { [Term] }+ListExp+ : {- empty -} { [] } + | Exp { [$1] }+ | Exp ';' ListExp { $1 : $3 }++Exps :: { [Term] }+Exps+ : {- empty -} { [] } + | Exp6 Exps { $1 : $2 }++Patt :: { Patt }+Patt+ : Patt '|' Patt1 { PAlt $1 $3 } + | Patt '+' Patt1 { PSeq $1 $3 }+ | Patt1 { $1 }++Patt1 :: { Patt }+Patt1+ : Ident ListPatt { PC $1 $2 } + | ModuleName '.' Ident ListPatt { PP ($1,$3) $4 }+ | Patt3 '*' { PRep $1 }+ | Patt2 { $1 }++Patt2 :: { Patt }+Patt2+ : Ident '@' Patt3 { PAs $1 $3 }+ | '-' Patt3 { PNeg $2 }+ | '~' Exp6 { PTilde $2 }+ | Patt3 { $1 } ++Patt3 :: { Patt }+Patt3+ : '?' { PChar } + | '[' String ']' { PChars $2 }+ | '#' Ident { PMacro $2 }+ | '#' ModuleName '.' Ident { PM ($2,$4) }+ | '_' { PW }+ | Ident { PV $1 }+ | ModuleName '.' Ident { PP ($1,$3) [] }+ | Integer { PInt $1 }+ | Double { PFloat $1 }+ | String { PString $1 }+ | '{' ListPattAss '}' { PR $2 }+ | '<' ListPattTupleComp '>' { (PR . tuple2recordPatt) $2 }+ | '(' Patt ')' { $2 }++PattAss :: { [(Label,Patt)] }+PattAss+ : ListIdent '=' Patt { [(LIdent (ident2raw i),$3) | i <- $1] } ++Label :: { Label }+Label+ : Ident { LIdent (ident2raw $1) } + | '$' Integer { LVar (fromIntegral $2) }++Sort :: { Ident }+Sort+ : 'Type' { cType } + | 'PType' { cPType }+ | 'Tok' { cTok }+ | 'Str' { cStr }+ | 'Strs' { cStrs }++ListPattAss :: { [(Label,Patt)] }+ListPattAss+ : {- empty -} { [] }+ | PattAss { $1 }+ | PattAss ';' ListPattAss { $1 ++ $3 }++ListPatt :: { [Patt] }+ListPatt+ : PattArg { [$1] } + | PattArg ListPatt { $1 : $2 }++PattArg :: { Patt }+ : Patt2 { $1 }+ | '{' Patt '}' { PImplArg $2 }++Arg :: { [(BindType,Ident)] }+Arg + : Ident { [(Explicit,$1 )] }+ | '_' { [(Explicit,identW)] }+ | '{' ListIdent2 '}' { [(Implicit,v) | v <- $2] }+ +ListArg :: { [(BindType,Ident)] }+ListArg+ : Arg { $1 } + | Arg ListArg { $1 ++ $2 }++Bind :: { [(BindType,Ident)] }+Bind+ : Ident { [(Explicit,$1 )] } + | '_' { [(Explicit,identW)] }+ | '{' ListIdent '}' { [(Implicit,v) | v <- $2] }++ListBind :: { [(BindType,Ident)] }+ListBind+ : Bind { $1 }+ | Bind ',' ListBind { $1 ++ $3 }++Decl :: { [Hypo] }+Decl+ : '(' ListBind ':' Exp ')' { [(b,x,$4) | (b,x) <- $2] } + | Exp3 { [mkHypo $1] }++ListTupleComp :: { [Term] }+ListTupleComp+ : {- empty -} { [] } + | Exp { [$1] }+ | Exp ',' ListTupleComp { $1 : $3 }++ListPattTupleComp :: { [Patt] }+ListPattTupleComp+ : {- empty -} { [] } + | Patt { [$1] }+ | Patt ',' ListPattTupleComp { $1 : $3 }++Case :: { Case }+Case+ : Patt '=>' Exp { ($1,$3) } ++ListCase :: { [Case] }+ListCase+ : Case { [$1] } + | Case ';' ListCase { $1 : $3 }++Altern :: { (Term,Term) }+Altern+ : Exp '/' Exp { ($1,$3) } ++ListAltern :: { [(Term,Term)] }+ListAltern+ : Altern { [$1] }+ | Altern ';' ListAltern { $1 : $3 }++DDecl :: { [Hypo] }+DDecl+ : '(' ListBind ':' Exp ')' { [(b,x,$4) | (b,x) <- $2] } + | Exp6 { [mkHypo $1] }++ListDDecl :: { [Hypo] }+ListDDecl+ : {- empty -} { [] } + | DDecl ListDDecl { $1 ++ $2 }++ListCFRule :: { [BNFCRule] }+ListCFRule+ : CFRule { $1 }+ | CFRule ListCFRule { $1 ++ $2 }++CFRule :: { [BNFCRule] }+CFRule+ : Ident '.' Ident '::=' ListCFSymbol ';' { [BNFCRule (showIdent $3) $5 (CFObj (mkCId (showIdent $1)) [])]+ }+ | Ident '::=' ListCFRHS ';' { let { cat = showIdent $1;+ mkFun cat its =+ case its of {+ [] -> cat ++ "_";+ _ -> concat $ intersperse "_" (cat : filter (not . null) (map clean its)) -- CLE style+ };+ clean sym = + case sym of {+ Terminal c -> filter isAlphaNum c;+ NonTerminal (t,_) -> t+ }+ } in map (\rhs -> BNFCRule cat rhs (CFObj (mkCId (mkFun cat rhs)) [])) $3+ }+ | 'coercions' Ident Integer ';' { [BNFCCoercions (showIdent $2) $3]}+ | 'terminator' NonEmpty Ident String ';' { [BNFCTerminator $2 (showIdent $3) $4] }+ | 'separator' NonEmpty Ident String ';' { [BNFCSeparator $2 (showIdent $3) $4] }++ListCFRHS :: { [[BNFCSymbol]] }+ListCFRHS+ : ListCFSymbol { [$1] }+ | ListCFSymbol '|' ListCFRHS { $1 : $3 }++ListCFSymbol :: { [BNFCSymbol] }+ListCFSymbol+ : {- empty -} { [] } + | CFSymbol ListCFSymbol { $1 : $2 }++CFSymbol :: { BNFCSymbol }+ : String { Terminal $1 }+ | Ident { NonTerminal (showIdent $1, False) }+ | '[' Ident ']' { NonTerminal (showIdent $2, True) }++NonEmpty :: { Bool }+NonEmpty : 'nonempty' { True }+ | {-empty-} { False }+++ListEBNFRule :: { [ERule] }+ListEBNFRule+ : EBNFRule { [$1] }+ | EBNFRule ListEBNFRule { $1 : $2 }++EBNFRule :: { ERule }+ : Ident '::=' ERHS0 ';' { ((showIdent $1,[]),$3) }++ERHS0 :: { ERHS }+ : ERHS1 { $1 }+ | ERHS1 '|' ERHS0 { EAlt $1 $3 }++ERHS1 :: { ERHS }+ : ERHS2 { $1 }+ | ERHS2 ERHS1 { ESeq $1 $2 }++ERHS2 :: { ERHS }+ : ERHS3 '*' { EStar $1 }+ | ERHS3 '+' { EPlus $1 }+ | ERHS3 '?' { EOpt $1 }+ | ERHS3 { $1 }++ERHS3 :: { ERHS }+ : String { ETerm $1 }+ | Ident { ENonTerm (showIdent $1,[]) }+ | '(' ERHS0 ')' { $2 }++ModuleName :: { ModuleName }+ : Ident { MN $1 }++Posn :: { Posn }+Posn+ : {- empty -} {% getPosn } +++{++happyError :: P a+happyError = fail "syntax error"++mkListId,mkConsId,mkBaseId :: Ident -> Ident+mkListId = prefixIdent "List"+mkConsId = prefixIdent "Cons"+mkBaseId = prefixIdent "Base"++listCatDef :: L (Ident, Context, Int) -> [(Ident,Info)]+listCatDef (L loc (id,cont,size)) = [catd,nilfund,consfund]+ where+ listId = mkListId id+ baseId = mkBaseId id+ consId = mkConsId id++ catd = (listId, AbsCat (Just (L loc cont')))+ nilfund = (baseId, AbsFun (Just (L loc niltyp)) Nothing Nothing (Just True))+ consfund = (consId, AbsFun (Just (L loc constyp)) Nothing Nothing (Just True))++ cont' = [(b,mkId x i,ty) | (i,(b,x,ty)) <- zip [0..] cont]+ xs = map (\(b,x,t) -> Vr x) cont'+ cd = mkHypo (mkApp (Vr id) xs)+ lc = mkApp (Vr listId) xs++ niltyp = mkProdSimple (cont' ++ replicate size cd) lc+ constyp = mkProdSimple (cont' ++ [cd, mkHypo lc]) lc++ mkId x i = if isWildIdent x then (varX i) else x++tryLoc (c,mty,Just e) = return (c,(mty,e))+tryLoc (c,_ ,_ ) = fail ("local definition of" +++ showIdent c +++ "without value")++mkR [] = return $ RecType [] --- empty record always interpreted as record type+mkR fs@(f:_) =+ case f of+ (lab,Just ty,Nothing) -> mapM tryRT fs >>= return . RecType+ _ -> mapM tryR fs >>= return . R+ where+ tryRT (lab,Just ty,Nothing) = return (ident2label lab,ty)+ tryRT (lab,_ ,_ ) = fail $ "illegal record type field" +++ showIdent lab --- manifest fields ?!++ tryR (lab,mty,Just t) = return (ident2label lab,(mty,t))+ tryR (lab,_ ,_ ) = fail $ "illegal record field" +++ showIdent lab++mkOverload pdt pdf@(Just (L loc df)) =+ case appForm df of+ (keyw, ts@(_:_)) | isOverloading keyw -> + case last ts of+ R fs -> [ResOverload [MN m | Vr m <- ts] [(L loc ty,L loc fu) | (_,(Just ty,fu)) <- fs]]+ _ -> [ResOper pdt pdf]+ _ -> [ResOper pdt pdf]++ -- to enable separare type signature --- not type-checked+mkOverload pdt@(Just (L _ df)) pdf =+ case appForm df of+ (keyw, ts@(_:_)) | isOverloading keyw ->+ case last ts of+ RecType _ -> [] + _ -> [ResOper pdt pdf]+ _ -> [ResOper pdt pdf]+mkOverload pdt pdf = [ResOper pdt pdf]++isOverloading t =+ case t of+ Vr keyw | showIdent keyw == "overload" -> True -- overload is a "soft keyword"+ _ -> False++checkInfoType mt jment@(id,info) =+ case info of+ AbsCat pcont -> ifAbstract mt (locPerh pcont)+ AbsFun pty _ pde _ -> ifAbstract mt (locPerh pty ++ maybe [] locAll pde)+ CncCat pty pd pr ppn _->ifConcrete mt (locPerh pty ++ locPerh pd ++ locPerh pr ++ locPerh ppn)+ CncFun _ pd ppn _ -> ifConcrete mt (locPerh pd ++ locPerh ppn)+ ResParam pparam _ -> ifResource mt (locPerh pparam)+ ResValue ty -> ifResource mt (locL ty)+ ResOper pty pt -> ifOper mt pty pt+ ResOverload _ xs -> ifResource mt (concat [[loc1,loc2] | (L loc1 _,L loc2 _) <- xs])+ where+ locPerh = maybe [] locL+ locAll xs = [loc | L loc x <- xs]+ locL (L loc x) = [loc]+ + illegal (Local s e:_) = failLoc (Pn s 0) "illegal definition"+ illegal _ = return jment++ ifAbstract MTAbstract locs = return jment+ ifAbstract _ locs = illegal locs++ ifConcrete (MTConcrete _) locs = return jment+ ifConcrete _ locs = illegal locs++ ifResource (MTConcrete _) locs = return jment+ ifResource (MTInstance _) locs = return jment+ ifResource MTInterface locs = return jment+ ifResource MTResource locs = return jment+ ifResource _ locs = illegal locs+ + ifOper MTAbstract pty pt = return (id,AbsFun pty (fmap (const 0) pt) (Just (maybe [] (\(L l t) -> [L l ([],t)]) pt)) (Just False))+ ifOper _ pty pt = return jment++mkAlts cs = case cs of+ _:_ -> do+ def <- mkDef (last cs)+ alts <- mapM mkAlt (init cs)+ return (Alts def alts)+ _ -> fail "empty alts"+ where+ mkDef (_,t) = return t+ mkAlt (p,t) = do+ ss <- mkStrs p+ return (t,ss)+ mkStrs p = case p of+ PAlt a b -> do+ Strs as <- mkStrs a+ Strs bs <- mkStrs b+ return $ Strs $ as ++ bs+ PString s -> return $ Strs [K s]+ PV x -> return (Vr x) --- for macros; not yet complete+ PMacro x -> return (Vr x) --- for macros; not yet complete+ PM c -> return (Q c) --- for macros; not yet complete+ _ -> fail "no strs from pattern"++mkL :: Posn -> Posn -> x -> L x+mkL (Pn l1 _) (Pn l2 _) x = L (Local l1 l2) x++}
@@ -0,0 +1,212 @@+----------------------------------------------------------------------+-- |+-- Module : PatternMatch+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/10/12 12:38:29 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.7 $+--+-- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003+-----------------------------------------------------------------------------++module GF.Grammar.PatternMatch (matchPattern,+ testOvershadow, + findMatch,+ measurePatt+ ) where++import GF.Data.Operations+import GF.Grammar.Grammar+import GF.Infra.Ident+import GF.Grammar.Macros+--import GF.Grammar.Printer++--import Data.List+import Control.Monad+import GF.Text.Pretty+--import Debug.Trace++matchPattern :: ErrorMonad m => [(Patt,rhs)] -> Term -> m (rhs, Substitution)+matchPattern pts term = + if not (isInConstantForm term)+ then raise (render ("variables occur in" <+> pp term))+ else do+ term' <- mkK term+ errIn (render ("trying patterns" <+> hsep (punctuate ',' (map fst pts)))) $+ findMatch [([p],t) | (p,t) <- pts] [term']+ where+ -- to capture all Str with string pattern matching+ mkK s = case s of+ C _ _ -> do+ s' <- getS s+ return (K (unwords s'))+ _ -> return s++ getS s = case s of+ K w -> return [w]+ C v w -> liftM2 (++) (getS v) (getS w)+ Empty -> return []+ _ -> raise (render ("cannot get string from" <+> s))++testOvershadow :: ErrorMonad m => [Patt] -> [Term] -> m [Patt]+testOvershadow pts vs = do+ let numpts = zip pts [0..]+ let cases = [(p,EInt i) | (p,i) <- numpts]+ ts <- mapM (liftM fst . matchPattern cases) vs+ return [p | (p,i) <- numpts, notElem i [i | EInt i <- ts] ]++findMatch :: ErrorMonad m => [([Patt],rhs)] -> [Term] -> m (rhs, Substitution)+findMatch cases terms = case cases of+ [] -> raise (render ("no applicable case for" <+> hsep (punctuate ',' terms)))+ (patts,_):_ | length patts /= length terms -> + raise (render ("wrong number of args for patterns :" <+> hsep patts <+> + "cannot take" <+> hsep terms))+ (patts,val):cc -> case mapM tryMatch (zip patts terms) of+ Ok substs -> return (val, concat substs)+ _ -> findMatch cc terms++tryMatch :: (Patt, Term) -> Err [(Ident, Term)]+tryMatch (p,t) = do + t' <- termForm t+ trym p t'+ where++ isInConstantFormt = True -- tested already in matchPattern+ trym p t' =+ case (p,t') of+-- (_,(x,Typed e ty,y)) -> trym p (x,e,y) -- Add this? /TH 2013-09-05+ (_,(x,Empty,y)) -> trym p (x,K [],y) -- because "" = [""] = []+ (PW, _) | isInConstantFormt -> return [] -- optimization with wildcard+ (PV x, _) | isInConstantFormt -> return [(x,t)]+ (PString s, ([],K i,[])) | s==i -> return []+ (PInt s, ([],EInt i,[])) | s==i -> return []+ (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?+ (PC p pp, ([], Con f, tt)) | + p `eqStrIdent` f && length pp == length tt ->+ do matches <- mapM tryMatch (zip pp tt)+ return (concat matches)++ (PP (q,p) pp, ([], QC (r,f), tt)) | + -- q `eqStrIdent` r && --- not for inherited AR 10/10/2005+ p `eqStrIdent` f && length pp == length tt ->+ do matches <- mapM tryMatch (zip pp tt)+ return (concat matches)+ ---- hack for AppPredef bug+ (PP (q,p) pp, ([], Q (r,f), tt)) | + -- q `eqStrIdent` r && --- + p `eqStrIdent` f && length pp == length tt ->+ do matches <- mapM tryMatch (zip pp tt)+ return (concat matches)++ (PR r, ([],R r',[])) |+ all (`elem` map fst r') (map fst r) ->+ do matches <- mapM tryMatch + [(p,snd a) | (l,p) <- r, let Just a = lookup l r']+ return (concat matches)+ (PT _ p',_) -> trym p' t'++ (PAs x p',_) -> do+ subst <- trym p' t'+ return $ (x,t) : subst++ (PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t']++ (PNeg p',_) -> case tryMatch (p',t) of+ Bad _ -> return []+ _ -> raise (render ("no match with negative pattern" <+> p))++ (PSeq p1 p2, ([],K s, [])) -> matchPSeq p1 p2 s+ (PMSeq mp1 mp2, ([],K s, [])) -> matchPMSeq mp1 mp2 s++ (PRep p1, ([],K s, [])) -> checks [+ trym (foldr (const (PSeq p1)) (PString "") + [1..n]) t' | n <- [0 .. length s]+ ] >>+ return []++ (PChar, ([],K [_], [])) -> return []+ (PChars cs, ([],K [c], [])) | elem c cs -> return []++ _ -> raise (render ("no match in case expr for" <+> t))++matchPMSeq (m1,p1) (m2,p2) s = matchPSeq' m1 p1 m2 p2 s+--matchPSeq p1 p2 s = matchPSeq' (0,maxBound::Int) p1 (0,maxBound::Int) p2 s+matchPSeq p1 p2 s = matchPSeq' (lengthBounds p1) p1 (lengthBounds p2) p2 s++matchPSeq' b1@(min1,max1) p1 b2@(min2,max2) p2 s =+ do let n = length s+ lo = min1 `max` (n-max2)+ hi = (n-min2) `min` max1+ cuts = [splitAt i s | i <- [lo..hi]]+ matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]+ return (concat matches)++-- | Estimate the minimal length of the string that a pattern will match+minLength = matchLength 0 id (+) min -- safe underestimate++-- | Estimate the maximal length of the string that a pattern will match+maxLength =+ maybe maxBound id . matchLength Nothing Just (liftM2 (+)) (liftM2 max)+ -- safe overestimate++matchLength unknown known seq alt = len+ where+ len p =+ case p of+ PString s -> known (length s)+ PSeq p1 p2 -> seq (len p1) (len p2)+ PAlt p1 p2 -> alt (len p1) (len p2)+ PChar -> known 1+ PChars _ -> known 1+ PAs x p' -> len p'+ PT t p' -> len p'+ _ -> unknown++lengthBounds p = (minLength p,maxLength p)++mPatt p = (lengthBounds p,measurePatt p)++measurePatt p =+ case p of+ PSeq p1 p2 -> PMSeq (mPatt p1) (mPatt p2)+ _ -> composSafePattOp measurePatt p+++isInConstantForm :: Term -> Bool+isInConstantForm trm = case trm of+ Cn _ -> True+ Con _ -> True+ Q _ -> True+ QC _ -> True+ Abs _ _ _ -> True+ C c a -> isInConstantForm c && isInConstantForm a+ App c a -> isInConstantForm c && isInConstantForm a+ R r -> all (isInConstantForm . snd . snd) r+ K _ -> True+ Empty -> True+ EInt _ -> True+ V ty ts -> isInConstantForm ty && all isInConstantForm ts -- TH 2013-09-05+-- Typed e t-> isInConstantForm e && isInConstantForm t -- Add this? TH 2013-09-05++ _ -> False ---- isInArgVarForm trm+{- -- unused and suspicuous, see contP in GF.Compile.Compute.Concrete instead+varsOfPatt :: Patt -> [Ident]+varsOfPatt p = case p of+ PV x -> [x]+ PC _ ps -> concat $ map varsOfPatt ps+ PP _ ps -> concat $ map varsOfPatt ps+ PR r -> concat $ map (varsOfPatt . snd) r+ PT _ q -> varsOfPatt q+ _ -> []++-- | to search matching parameter combinations in tables+isMatchingForms :: [Patt] -> [Term] -> Bool+isMatchingForms ps ts = all match (zip ps ts') where+ match (PC c cs, (Cn d, ds)) = c == d && isMatchingForms cs ds+ match _ = True+ ts' = map appForm ts++-}
@@ -0,0 +1,78 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Grammar.Predef+-- Maintainer : kr.angelov+-- Stability : (stable)+-- Portability : (portable)+--+-- Predefined identifiers and labels which the compiler knows+----------------------------------------------------------------------++module GF.Grammar.Predef where++import GF.Infra.Ident(Ident,identS,moduleNameS)++cType = identS "Type"+cPType = identS "PType"+cTok = identS "Tok"+cStr = identS "Str"+cStrs = identS "Strs"+cPredefAbs = moduleNameS "PredefAbs"+cPredefCnc = moduleNameS "PredefCnc"+cPredef = moduleNameS "Predef"+cInt = identS "Int"+cFloat = identS "Float"+cString = identS "String"+cVar = identS "__gfVar"+cInts = identS "Ints"+cPBool = identS "PBool"+cErrorType = identS "Error"+cOverload = identS "overload"+cUndefinedType = identS "UndefinedType"+cNonExist = identS "nonExist"+cBIND = identS "BIND"+cSOFT_BIND = identS "SOFT_BIND"+cSOFT_SPACE = identS "SOFT_SPACE"+cCAPIT = identS "CAPIT"+cALL_CAPIT = identS "ALL_CAPIT"++isPredefCat :: Ident -> Bool+isPredefCat c = elem c [cInt,cString,cFloat]++cPTrue = identS "PTrue"+cPFalse = identS "PFalse"+cLength = identS "length"+cDrop = identS "drop"+cTake = identS "take"+cTk = identS "tk"+cDp = identS "dp"+cToUpper = identS "toUpper"+cToLower = identS "toLower"+cIsUpper = identS "isUpper"+cEqStr = identS "eqStr"+cEqVal = identS "eqVal"+cOccur = identS "occur"+cOccurs = identS "occurs"+cEqInt = identS "eqInt"+cLessInt = identS "lessInt"+cPlus = identS "plus"+cShow = identS "show"+cRead = identS "read"+cToStr = identS "toStr"+cMapStr = identS "mapStr"+cError = identS "error"+cTrace = identS "trace"++-- * Hacks: dummy identifiers used in various places.+-- Not very nice!++cMeta = identS "?"+cAs = identS "@"+cChar = identS "?"+cChars = identS "[]"+cSeq = identS "+"+cAlt = identS "|"+cRep = identS "*"+cNeg = identS "-"+cCNC = identS "CNC"+cConflict = identS "#conflict"
@@ -0,0 +1,365 @@+---------------------------------------------------------------------- +-- | +-- Module : GF.Grammar.Printer +-- Maintainer : Krasimir Angelov +-- Stability : (stable) +-- Portability : (portable) +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE FlexibleContexts #-} +module GF.Grammar.Printer + ( -- ** Pretty printing + TermPrintQual(..) + , ppModule + , ppJudgement + , ppParams + , ppTerm + , ppPatt + , ppValue + , ppConstrs + , ppQIdent + , ppMeta + , getAbs + ) where +import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint + +import GF.Infra.Ident +import GF.Infra.Option +import GF.Grammar.Values +import GF.Grammar.Grammar + +import PGF.Internal (ppMeta, ppLit, ppFId, ppFunId, ppSeqId, ppSeq) + +import GF.Text.Pretty +import Data.Maybe (isNothing) +import Data.List (intersperse) +import qualified Data.Map as Map +--import qualified Data.IntMap as IntMap +--import qualified Data.Set as Set +import qualified Data.Array.IArray as Array + +data TermPrintQual + = Terse | Unqualified | Qualified | Internal + deriving Eq + +instance Pretty Grammar where + pp = vcat . map (ppModule Qualified) . modules + +ppModule :: TermPrintQual -> SourceModule -> Doc +ppModule q (mn, ModInfo mtype mstat opts exts with opens _ _ mseqs jments) = + hdr $$ + nest 2 (ppOptions opts $$ + vcat (map (ppJudgement q) (Map.toList jments)) $$ + maybe empty (ppSequences q) mseqs) $$ + ftr + where + hdr = complModDoc <+> modTypeDoc <+> '=' <+> + hsep (intersperse (pp "**") $ + filter (not . isEmpty) $ [ commaPunct ppExtends exts + , maybe empty ppWith with + , if null opens + then pp '{' + else "open" <+> commaPunct ppOpenSpec opens <+> "in" <+> '{' + ]) + + ftr = '}' + + complModDoc = + case mstat of + MSComplete -> empty + MSIncomplete -> pp "incomplete" + + modTypeDoc = + case mtype of + MTAbstract -> "abstract" <+> mn + MTResource -> "resource" <+> mn + MTConcrete abs -> "concrete" <+> mn <+> "of" <+> abs + MTInterface -> "interface" <+> mn + MTInstance ie -> "instance" <+> mn <+> "of" <+> ppExtends ie + + ppExtends (id,MIAll ) = pp id + ppExtends (id,MIOnly incs) = id <+> brackets (commaPunct pp incs) + ppExtends (id,MIExcept incs) = id <+> '-' <+> brackets (commaPunct pp incs) + + ppWith (id,ext,opens) = ppExtends (id,ext) <+> "with" <+> commaPunct ppInstSpec opens + +ppOptions opts = + "flags" $$ + nest 2 (vcat [option <+> '=' <+> ppLit value <+> ';' | (option,value) <- optionsGFO opts]) + +ppJudgement q (id, AbsCat pcont ) = + "cat" <+> id <+> + (case pcont of + Just (L _ cont) -> hsep (map (ppDecl q) cont) + Nothing -> empty) <+> ';' +ppJudgement q (id, AbsFun ptype _ pexp poper) = + let kind | isNothing pexp = "data" + | poper == Just False = "oper" + | otherwise = "fun" + in + (case ptype of + Just (L _ typ) -> kind <+> id <+> ':' <+> ppTerm q 0 typ <+> ';' + Nothing -> empty) $$ + (case pexp of + Just [] -> empty + Just eqs -> "def" <+> vcat [id <+> hsep (map (ppPatt q 2) ps) <+> '=' <+> ppTerm q 0 e <+> ';' | L _ (ps,e) <- eqs] + Nothing -> empty) +ppJudgement q (id, ResParam pparams _) = + "param" <+> id <+> + (case pparams of + Just (L _ ps) -> '=' <+> ppParams q ps + _ -> empty) <+> ';' +ppJudgement q (id, ResValue pvalue) = + "-- param constructor" <+> id <+> ':' <+> + (case pvalue of + (L _ ty) -> ppTerm q 0 ty) <+> ';' +ppJudgement q (id, ResOper ptype pexp) = + "oper" <+> id <+> + (case ptype of {Just (L _ t) -> ':' <+> ppTerm q 0 t; Nothing -> empty} $$ + case pexp of {Just (L _ e) -> '=' <+> ppTerm q 0 e; Nothing -> empty}) <+> ';' +ppJudgement q (id, ResOverload ids defs) = + "oper" <+> id <+> '=' <+> + ("overload" <+> '{' $$ + nest 2 (vcat [id <+> (':' <+> ppTerm q 0 ty $$ '=' <+> ppTerm q 0 e <+> ';') | (L _ ty,L _ e) <- defs]) $$ + '}') <+> ';' +ppJudgement q (id, CncCat pcat pdef pref pprn mpmcfg) = + (case pcat of + Just (L _ typ) -> "lincat" <+> id <+> '=' <+> ppTerm q 0 typ <+> ';' + Nothing -> empty) $$ + (case pdef of + Just (L _ exp) -> "lindef" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';' + Nothing -> empty) $$ + (case pref of + Just (L _ exp) -> "linref" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';' + Nothing -> empty) $$ + (case pprn of + Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';' + Nothing -> empty) $$ + (case (mpmcfg,q) of + (Just (PMCFG prods funs),Internal) + -> "pmcfg" <+> id <+> '=' <+> '{' $$ + nest 2 (vcat (map ppProduction prods) $$ + ' ' $$ + vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+> + parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr))))) + (Array.assocs funs))) $$ + '}' + _ -> empty) +ppJudgement q (id, CncFun ptype pdef pprn mpmcfg) = + (case pdef of + Just (L _ e) -> let (xs,e') = getAbs e + in "lin" <+> id <+> hsep (map ppBind xs) <+> '=' <+> ppTerm q 0 e' <+> ';' + Nothing -> empty) $$ + (case pprn of + Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';' + Nothing -> empty) $$ + (case (mpmcfg,q) of + (Just (PMCFG prods funs),Internal) + -> "pmcfg" <+> id <+> '=' <+> '{' $$ + nest 2 (vcat (map ppProduction prods) $$ + ' ' $$ + vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+> + parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr))))) + (Array.assocs funs))) $$ + '}' + _ -> empty) +ppJudgement q (id, AnyInd cann mid) = + case q of + Internal -> "ind" <+> id <+> '=' <+> (if cann then pp "canonical" else empty) <+> mid <+> ';' + _ -> empty + +instance Pretty Term where pp = ppTerm Unqualified 0 + +ppTerm q d (Abs b v e) = let (xs,e') = getAbs (Abs b v e) + in prec d 0 ('\\' <> commaPunct ppBind xs <+> "->" <+> ppTerm q 0 e') +ppTerm q d (T TRaw xs) = case getCTable (T TRaw xs) of + ([],_) -> "table" <+> '{' $$ + nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$ + '}' + (vs,e) -> prec d 0 ("\\\\" <> commaPunct pp vs <+> "=>" <+> ppTerm q 0 e) +ppTerm q d (T (TTyped t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$ + nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$ + '}' +ppTerm q d (T (TComp t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$ + nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$ + '}' +ppTerm q d (T (TWild t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$ + nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$ + '}' +ppTerm q d (Prod bt x a b)= if x == identW && bt == Explicit + then prec d 0 (ppTerm q 4 a <+> "->" <+> ppTerm q 0 b) + else prec d 0 (parens (ppBind (bt,x) <+> ':' <+> ppTerm q 0 a) <+> "->" <+> ppTerm q 0 b) +ppTerm q d (Table kt vt)=prec d 0 (ppTerm q 3 kt <+> "=>" <+> ppTerm q 0 vt) +ppTerm q d (Let l e) = let (ls,e') = getLet e + in prec d 0 ("let" <+> vcat (map (ppLocDef q) (l:ls)) $$ "in" <+> ppTerm q 0 e') +ppTerm q d (Example e s)=prec d 0 ("in" <+> ppTerm q 5 e <+> str s) +ppTerm q d (C e1 e2) =prec d 1 (hang (ppTerm q 2 e1) 2 ("++" <+> ppTerm q 1 e2)) +ppTerm q d (Glue e1 e2) =prec d 2 (ppTerm q 3 e1 <+> '+' <+> ppTerm q 2 e2) +ppTerm q d (S x y) = case x of + T annot xs -> let e = case annot of + TRaw -> y + TTyped t -> Typed y t + TComp t -> Typed y t + TWild t -> Typed y t + in "case" <+> ppTerm q 0 e <+>"of" <+> '{' $$ + nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$ + '}' + _ -> prec d 3 (hang (ppTerm q 3 x) 2 ("!" <+> ppTerm q 4 y)) +ppTerm q d (ExtR x y) = prec d 3 (ppTerm q 3 x <+> "**" <+> ppTerm q 4 y) +ppTerm q d (App x y) = prec d 4 (ppTerm q 4 x <+> ppTerm q 5 y) +ppTerm q d (V e es) = hang "table" 2 (sep [ppTerm q 6 e,brackets (fsep (punctuate ';' (map (ppTerm q 0) es)))]) +ppTerm q d (FV es) = "variants" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es))) +ppTerm q d (AdHocOverload es) = "overload" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es))) +ppTerm q d (Alts e xs) = prec d 4 ("pre" <+> braces (ppTerm q 0 e <> ';' <+> fsep (punctuate ';' (map (ppAltern q) xs)))) +ppTerm q d (Strs es) = "strs" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es))) +ppTerm q d (EPatt p) = prec d 4 ('#' <+> ppPatt q 2 p) +ppTerm q d (EPattType t)=prec d 4 ("pattern" <+> ppTerm q 0 t) +ppTerm q d (P t l) = prec d 5 (ppTerm q 5 t <> '.' <> l) +ppTerm q d (Cn id) = pp id +ppTerm q d (Vr id) = pp id +ppTerm q d (Q id) = ppQIdent q id +ppTerm q d (QC id) = ppQIdent q id +ppTerm q d (Sort id) = pp id +ppTerm q d (K s) = str s +ppTerm q d (EInt n) = pp n +ppTerm q d (EFloat f) = pp f +ppTerm q d (Meta i) = ppMeta i +ppTerm q d (Empty) = pp "[]" +ppTerm q d (R []) = pp "<>" -- to distinguish from {} empty RecType +ppTerm q d (R xs) = braces (fsep (punctuate ';' [l <+> + fsep [case mb_t of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty}, + '=' <+> ppTerm q 0 e] | (l,(mb_t,e)) <- xs])) +ppTerm q d (RecType xs) + | q == Terse = case [cat | (l,_) <- xs, let (p,cat) = splitAt 5 (showIdent (label2ident l)), p == "lock_"] of + [cat] -> pp cat + _ -> doc + | otherwise = doc + where + doc = braces (fsep (punctuate ';' [l <+> ':' <+> ppTerm q 0 t | (l,t) <- xs])) +ppTerm q d (Typed e t) = '<' <> ppTerm q 0 e <+> ':' <+> ppTerm q 0 t <> '>' +ppTerm q d (ImplArg e) = braces (ppTerm q 0 e) +ppTerm q d (ELincat cat t) = prec d 4 ("lincat" <+> cat <+> ppTerm q 5 t) +ppTerm q d (ELin cat t) = prec d 4 ("lin" <+> cat <+> ppTerm q 5 t) +ppTerm q d (Error s) = prec d 4 ("Predef.error" <+> str s) + +ppEquation q (ps,e) = hcat (map (ppPatt q 2) ps) <+> "->" <+> ppTerm q 0 e + +ppCase q (p,e) = ppPatt q 0 p <+> "=>" <+> ppTerm q 0 e + +instance Pretty Patt where pp = ppPatt Unqualified 0 + +ppPatt q d (PAlt p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '|' <+> ppPatt q 1 p2) +ppPatt q d (PSeq p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2) +ppPatt q d (PMSeq (_,p1) (_,p2)) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2) +ppPatt q d (PC f ps) = if null ps + then pp f + else prec d 1 (f <+> hsep (map (ppPatt q 3) ps)) +ppPatt q d (PP f ps) = if null ps + then ppQIdent q f + else prec d 1 (ppQIdent q f <+> hsep (map (ppPatt q 3) ps)) +ppPatt q d (PRep p) = prec d 1 (ppPatt q 3 p <> '*') +ppPatt q d (PAs f p) = prec d 2 (f <> '@' <> ppPatt q 3 p) +ppPatt q d (PNeg p) = prec d 2 ('-' <> ppPatt q 3 p) +ppPatt q d (PChar) = pp '?' +ppPatt q d (PChars s) = brackets (str s) +ppPatt q d (PMacro id) = '#' <> id +ppPatt q d (PM id) = '#' <> ppQIdent q id +ppPatt q d PW = pp '_' +ppPatt q d (PV id) = pp id +ppPatt q d (PInt n) = pp n +ppPatt q d (PFloat f) = pp f +ppPatt q d (PString s) = str s +ppPatt q d (PR xs) = braces (hsep (punctuate ';' [l <+> '=' <+> ppPatt q 0 e | (l,e) <- xs])) +ppPatt q d (PImplArg p) = braces (ppPatt q 0 p) +ppPatt q d (PTilde t) = prec d 2 ('~' <> ppTerm q 6 t) + +ppValue :: TermPrintQual -> Int -> Val -> Doc +ppValue q d (VGen i x) = x <> "{-" <> i <> "-}" ---- latter part for debugging +ppValue q d (VApp u v) = prec d 4 (ppValue q 4 u <+> ppValue q 5 v) +ppValue q d (VCn (_,c)) = pp c +ppValue q d (VClos env e) = case e of + Meta _ -> ppTerm q d e <> ppEnv env + _ -> ppTerm q d e ---- ++ prEnv env ---- for debugging +ppValue q d (VRecType xs) = braces (hsep (punctuate ',' [l <> '=' <> ppValue q 0 v | (l,v) <- xs])) +ppValue q d VType = pp "Type" + +ppConstrs :: Constraints -> [Doc] +ppConstrs = map (\(v,w) -> braces (ppValue Unqualified 0 v <+> "<>" <+> ppValue Unqualified 0 w)) + +ppEnv :: Env -> Doc +ppEnv e = hcat (map (\(x,t) -> braces (x <> ":=" <> ppValue Unqualified 0 t)) e) + +str s = doubleQuotes s + +ppDecl q (_,id,typ) + | id == identW = ppTerm q 3 typ + | otherwise = parens (id <+> ':' <+> ppTerm q 0 typ) + +ppDDecl q (_,id,typ) + | id == identW = ppTerm q 6 typ + | otherwise = parens (id <+> ':' <+> ppTerm q 0 typ) + +ppQIdent :: TermPrintQual -> QIdent -> Doc +ppQIdent q (m,id) = + case q of + Terse -> pp id + Unqualified -> pp id + Qualified -> m <> '.' <> id + Internal -> m <> '.' <> id + + +instance Pretty Label where pp = pp . label2ident + +ppOpenSpec (OSimple id) = pp id +ppOpenSpec (OQualif id n) = parens (id <+> '=' <+> n) + +ppInstSpec (id,n) = parens (id <+> '=' <+> n) + +ppLocDef q (id, (mbt, e)) = + id <+> + (case mbt of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty} <+> '=' <+> ppTerm q 0 e) <+> ';' + +ppBind (Explicit,v) = pp v +ppBind (Implicit,v) = braces v + +ppAltern q (x,y) = ppTerm q 0 x <+> '/' <+> ppTerm q 0 y + +ppParams q ps = fsep (intersperse (pp '|') (map (ppParam q) ps)) +ppParam q (id,cxt) = id <+> hsep (map (ppDDecl q) cxt) + +ppProduction (Production fid funid args) = + ppFId fid <+> "->" <+> ppFunId funid <> + brackets (hcat (punctuate "," (map (hsep . intersperse (pp '|') . map ppFId) args))) + +ppSequences q seqsArr + | null seqs || q /= Internal = empty + | otherwise = "sequences" <+> '{' $$ + nest 2 (vcat (map ppSeq seqs)) $$ + '}' + where + seqs = Array.assocs seqsArr + +commaPunct f ds = (hcat (punctuate "," (map f ds))) + +prec d1 d2 doc + | d1 > d2 = parens doc + | otherwise = doc + +getAbs :: Term -> ([(BindType,Ident)], Term) +getAbs (Abs bt v e) = let (xs,e') = getAbs e + in ((bt,v):xs,e') +getAbs e = ([],e) + +getCTable :: Term -> ([Ident], Term) +getCTable (T TRaw [(PV v,e)]) = let (vs,e') = getCTable e + in (v:vs,e') +getCTable (T TRaw [(PW, e)]) = let (vs,e') = getCTable e + in (identW:vs,e') +getCTable e = ([],e) + +getLet :: Term -> ([LocalDef], Term) +getLet (Let l e) = let (ls,e') = getLet e + in (l:ls,e') +getLet e = ([],e) +
@@ -0,0 +1,44 @@+module GF.Grammar.ShowTerm where++import GF.Grammar.Grammar+import GF.Grammar.Printer+import GF.Grammar.Lookup+import GF.Data.Operations++import GF.Text.Pretty+import Data.List (intersperse)++showTerm :: SourceGrammar -> TermPrintStyle -> TermPrintQual -> Term -> String+showTerm gr sty q t = case sty of+ TermPrintTable -> render $ vcat [p <+> s | (p,s) <- ppTermTabular gr q t]+ TermPrintAll -> render $ vcat [ s | (p,s) <- ppTermTabular gr q t]+ TermPrintList -> renderStyle (style{mode = OneLineMode}) $ + vcat (punctuate ',' [s | (p,s) <- ppTermTabular gr q t])+ TermPrintOne -> render $ vcat [ s | (p,s) <- take 1 (ppTermTabular gr q t)]+ TermPrintDefault -> render $ ppTerm q 0 t++ppTermTabular :: SourceGrammar -> TermPrintQual -> Term -> [(Doc,Doc)]+ppTermTabular gr q = pr where+ pr t = case t of+ R rs -> + [(lab <+> '.' <+> path, str) | (lab,(_,val)) <- rs, (path,str) <- pr val]+ T _ cs -> + [(ppPatt q 0 patt <+> "=>" <+> path, str) | (patt, val ) <- cs, (path,str) <- pr val]+ V ty cs -> + let pvals = case allParamValues gr ty of+ Ok pvals -> pvals+ Bad _ -> map Meta [1..]+ in [(ppTerm q 0 pval <+> "=>" <+> path, str) | (pval, val) <- zip pvals cs, (path,str) <- pr val]+ _ -> [(empty,ps t)]+ ps t = case t of+ K s -> pp s+ C s u -> ps s <+> ps u+ FV ts -> hsep (intersperse (pp '/') (map ps ts))+ _ -> ppTerm q 0 t++data TermPrintStyle+ = TermPrintTable+ | TermPrintAll+ | TermPrintList+ | TermPrintOne+ | TermPrintDefault
@@ -0,0 +1,115 @@+----------------------------------------------------------------------+-- |+-- Module : Unify+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:31 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.4 $+--+-- (c) Petri Mäenpää & Aarne Ranta, 1998--2001+--+-- brute-force adaptation of the old-GF program AR 21\/12\/2001 ---+-- the only use is in 'TypeCheck.splitConstraints'+-----------------------------------------------------------------------------++module GF.Grammar.Unify (unifyVal) where++import GF.Grammar+import GF.Data.Operations++import GF.Text.Pretty+import Data.List (partition)++unifyVal :: Constraints -> Err (Constraints,MetaSubst)+unifyVal cs0 = do+ let (cs1,cs2) = partition notSolvable cs0 + let (us,vs) = unzip cs2+ let us' = map val2term us+ let vs' = map val2term vs+ let (ms,cs) = unifyAll (zip us' vs') []+ return (cs1 ++ [(VClos [] t, VClos [] u) | (t,u) <- cs], + [(m, VClos [] t) | (m,t) <- ms])+ where+ notSolvable (v,w) = case (v,w) of -- don't consider nonempty closures+ (VClos (_:_) _,_) -> True+ (_,VClos (_:_) _) -> True+ _ -> False++type Unifier = [(MetaId, Term)]+type Constrs = [(Term, Term)]++unifyAll :: Constrs -> Unifier -> (Unifier,Constrs)+unifyAll [] g = (g, [])+unifyAll ((a@(s, t)) : l) g =+ let (g1, c) = unifyAll l g+ in case unify s t g1 of+ Ok g2 -> (g2, c)+ _ -> (g1, a : c)++unify :: Term -> Term -> Unifier -> Err Unifier+unify e1 e2 g = + case (e1, e2) of + (Meta s, t) -> do+ tg <- subst_all g t+ let sg = maybe e1 id (lookup s g)+ if (sg == Meta s) then extend g s tg else unify sg tg g + (t, Meta s) -> unify e2 e1 g+ (Q (_,a), Q (_,b)) | (a == b) -> return g ---- qualif?+ (QC (_,a), QC (_,b)) | (a == b)-> return g ----+ (Vr x, Vr y) | (x == y) -> return g + (Abs _ x b, Abs _ y c) -> do let c' = substTerm [x] [(y,Vr x)] c + unify b c' g+ (App c a, App d b) -> case unify c d g of + Ok g1 -> unify a b g1 + _ -> Bad (render ("fail unify" <+> ppTerm Unqualified 0 e1))+ (RecType xs,RecType ys) | xs == ys -> return g+ _ -> Bad (render ("fail unify" <+> ppTerm Unqualified 0 e1))++extend :: Unifier -> MetaId -> Term -> Err Unifier+extend g s t | (t == Meta s) = return g + | occCheck s t = Bad (render ("occurs check" <+> ppTerm Unqualified 0 t))+ | True = return ((s, t) : g) ++subst_all :: Unifier -> Term -> Err Term+subst_all s u =+ case (s,u) of+ ([], t) -> return t+ (a : l, t) -> do+ t' <- (subst_all l t) --- successive substs - why ?+ return $ substMetas [a] t'++substMetas :: [(MetaId,Term)] -> Term -> Term+substMetas subst trm = case trm of+ Meta x -> case lookup x subst of+ Just t -> t+ _ -> trm+ _ -> composSafeOp (substMetas subst) trm++substTerm :: [Ident] -> Substitution -> Term -> Term+substTerm ss g c = case c of+ Vr x -> maybe c id $ lookup x g+ App f a -> App (substTerm ss g f) (substTerm ss g a)+ Abs b x t -> let y = mkFreshVarX ss x in + Abs b y (substTerm (y:ss) ((x, Vr y):g) t)+ Prod b x a t -> let y = mkFreshVarX ss x in + Prod b y (substTerm ss g a) (substTerm (y:ss) ((x,Vr y):g) t)+ _ -> c++occCheck :: MetaId -> Term -> Bool+occCheck s u = case u of+ Meta v -> s == v+ App c a -> occCheck s c || occCheck s a+ Abs _ x b -> occCheck s b+ _ -> False++val2term :: Val -> Term+val2term v = case v of+ VClos g e -> substTerm [] (map (\(x,v) -> (x,val2term v)) g) e+ VApp f c -> App (val2term f) (val2term c)+ VCn c -> Q c+ VGen i x -> Vr x+ VRecType xs -> RecType (map (\(l,v) -> (l,val2term v)) xs)+ VType -> typeType
@@ -0,0 +1,56 @@+----------------------------------------------------------------------+-- |+-- Module : Values+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:32 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.7 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Grammar.Values (-- ** Values used in TC type checking+ Val(..), Env,+ -- ** Annotated tree used in editing+ Binds, Constraints, MetaSubst,+ -- ** For TC+ valAbsInt, valAbsFloat, valAbsString, vType,+ isPredefCat,+ eType, + ) where++import GF.Infra.Ident+import GF.Grammar.Grammar+import GF.Grammar.Predef++-- values used in TC type checking++data Val = VGen Int Ident | VApp Val Val | VCn QIdent | VRecType [(Label,Val)] | VType | VClos Env Term+ deriving (Eq,Show)++type Env = [(Ident,Val)]++type Binds = [(Ident,Val)]+type Constraints = [(Val,Val)]+type MetaSubst = [(MetaId,Val)]+++-- for TC++valAbsInt :: Val+valAbsInt = VCn (cPredefAbs, cInt)++valAbsFloat :: Val+valAbsFloat = VCn (cPredefAbs, cFloat)++valAbsString :: Val+valAbsString = VCn (cPredefAbs, cString)++vType :: Val+vType = VType++eType :: Term+eType = Sort cType
@@ -0,0 +1,147 @@+-- | Abstract syntax and a pretty printer for a subset of Haskell+{-# LANGUAGE DeriveFunctor #-}+module GF.Haskell where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint+import GF.Infra.Ident(Ident,identS)+import GF.Text.Pretty++-- | Top-level declarations+data Dec = Comment String+ | Type (ConAp Ident) Ty+ | Data (ConAp Ident) [ConAp Ty] Deriving+ | Class [ConAp Ident] (ConAp Ident) FunDeps [(Ident,Ty)]+ | Instance [Ty] Ty [(Lhs,Exp)]+ | TypeSig Ident Ty+ | Eqn Lhs Exp++-- | A type constructor applied to some arguments+data ConAp a = ConAp Ident [a] deriving Functor+conap0 n = ConAp n []+tsyn0 = Type . conap0++type Deriving = [Const]+type FunDeps = [([Ident],[Ident])]+type Lhs = (Ident,[Pat])+lhs0 s = (identS s,[])++-- | Type expressions+data Ty = TId Ident | TAp Ty Ty | Fun Ty Ty | ListT Ty++-- | Expressions+data Exp = Var Ident | Const Const | Ap Exp Exp | Op Exp Const Exp+ | List [Exp] | Pair Exp Exp+ | Lets [(Ident,Exp)] Exp | LambdaCase [(Pat,Exp)]+type Const = String++-- | Patterns+data Pat = WildP | VarP Ident | Lit String | ConP Ident [Pat] | AsP Ident Pat++tvar = TId+tcon0 = TId+tcon c = foldl TAp (TId c)++let1 x xe e = Lets [(x,xe)] e+single x = List [x]++plusplus (List ts1) (List ts2) = List (ts1++ts2)+plusplus (List [t]) t2 = Op t ":" t2+plusplus t1 t2 = Op t1 "++" t2++-- | Pretty print atomically (i.e. wrap it in parentheses if necessary)+class Pretty a => PPA a where ppA :: a -> Doc++instance PPA Ident where ppA = pp++instance Pretty Dec where+ ppList = vcat+ pp d =+ case d of+ Comment s -> pp s+ Type lhs rhs -> hang ("type"<+>lhs<+>"=") 4 rhs+ Data lhs cons ds ->+ hang ("data"<+>lhs) 4+ (sep (zipWith (<+>) ("=":repeat "|") cons+++ ["deriving"<+>parens (punctuate "," ds)|not (null ds)]))+ Class ctx cls fds sigs ->+ hang ("class"<+>sep [ppctx ctx,pp cls]<+>ppfds fds <+>"where") 4+ (vcat (map ppSig sigs))+ Instance ctx inst eqns ->+ hang ("instance"<+>sep [ppctx ctx,pp inst]<+>"where") 4+ (vcat (map ppEqn eqns))+ TypeSig f ty -> hang (f<+>"::") 4 ty+ Eqn lhs rhs -> ppEqn (lhs,rhs)+ where+ ppctx ctx = case ctx of+ [] -> empty+ [p] -> p <+> "=>"+ ps -> parens (fsep (punctuate "," ps)) <+> "=>"++ ppfds [] = empty+ ppfds fds = "|"<+>fsep (punctuate "," [hsep as<+>"->"<+>bs|(as,bs)<-fds])++ ppEqn ((f,ps),e) = hang (f<+>fsep (map ppA ps)<+>"=") 4 e++ ppSig (f,ty) = f<+>"::"<+>ty++instance PPA a => Pretty (ConAp a) where+ pp (ConAp c as) = c<+>fsep (map ppA as)++instance Pretty Ty where+ pp = ppT+ where+ ppT t = case flatFun t of t:ts -> sep (ppB t:["->"<+>ppB t|t<-ts])+ ppB t = case flatTAp t of t:ts -> ppA t<+>sep (map ppA ts)++ flatFun (Fun t1 t2) = t1:flatFun t2 -- right associative+ flatFun t = [t]++ flatTAp (TAp t1 t2) = flatTAp t1++[t2] -- left associative+ flatTAp t = [t]++instance PPA Ty where+ ppA t =+ case t of+ TId c -> pp c+ ListT t -> brackets t+ _ -> parens t++instance Pretty Exp where+ pp = ppT+ where+ ppT e =+ case e of+ Op e1 op e2 -> hang (ppB e1<+>op) 2 (ppB e2)+ Lets bs e -> sep ["let"<+>vcat [hang (x<+>"=") 2 xe|(x,xe)<-bs],+ "in" <+>e]+ LambdaCase alts -> hang "\\case" 4 (vcat [p<+>"->"<+>e|(p,e)<-alts])+ _ -> ppB e++ ppB e = case flatAp e of f:as -> hang (ppA f) 2 (sep (map ppA as))++ flatAp (Ap t1 t2) = flatAp t1++[t2] -- left associative+ flatAp t = [t]++instance PPA Exp where+ ppA e =+ case e of+ Var x -> pp x+ Const n -> pp n+ Pair e1 e2 -> parens (e1<>","<>e2)+ List es -> brackets (fsep (punctuate "," es))+ _ -> parens e++instance Pretty Pat where+ pp p =+ case p of+ ConP c ps -> c<+>fsep (map ppA ps)+ _ -> ppA p++instance PPA Pat where+ ppA p =+ case p of+ WildP -> pp "_"+ VarP x -> pp x+ Lit s -> pp s+ ConP c [] -> pp c+ AsP x p -> x<>"@"<>ppA p+ _ -> parens p
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}+module GF.Infra.BuildInfo where+import System.Info+import Data.Version(showVersion)++{-# NOINLINE buildInfo #-}+buildInfo =+ "Built on "++os++"/"++arch+ ++" with "++compilerName++"-"++showVersion compilerVersion+ ++", flags:"+#ifdef USE_INTERRUPT+ ++" interrupt"+#endif+#ifdef SERVER_MODE+ ++" server"+#endif+#ifdef NEW_COMP+ ++" new-comp"+#endif+#ifdef C_RUNTIME+ ++" c-runtime"+#endif
@@ -0,0 +1,167 @@+----------------------------------------------------------------------+-- |+-- Module : CheckM+-- Maintainer : (Maintainer)+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:22:33 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.5 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Infra.CheckM+ (Check, CheckResult, Message, runCheck, runCheck',+ checkError, checkCond, checkWarn, checkWarnings, checkAccumError,+ checkIn, checkInModule, checkMap, checkMapRecover,+ parallelCheck, accumulateError, commitCheck,+ ) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import GF.Data.Operations+--import GF.Infra.Ident+--import GF.Grammar.Grammar(msrc) -- ,Context+import GF.Infra.Location(ppLocation,sourcePath)+import GF.Infra.Option(Options,noOptions,verbAtLeast,Verbosity(..))++import qualified Data.Map as Map+import GF.Text.Pretty+import System.FilePath(makeRelative)+import Control.Parallel.Strategies(parList,rseq,using)+import Control.Monad(liftM,ap)+import Control.Applicative(Applicative(..))++type Message = Doc+type Error = Message+type Warning = Message+--data Severity = Warning | Error+--type NonFatal = ([Severity,Message]) -- preserves order+type NonFatal = ([Error],[Warning])+type Accumulate acc ans = acc -> (acc,ans)+data CheckResult a = Fail Error | Success a+newtype Check a+ = Check {unCheck :: {-Context ->-} Accumulate NonFatal (CheckResult a)}++instance Functor Check where fmap = liftM++instance Monad Check where+ return x = Check $ \{-ctxt-} ws -> (ws,Success x)+ f >>= g = Check $ \{-ctxt-} ws ->+ case unCheck f {-ctxt-} ws of+ (ws,Success x) -> unCheck (g x) {-ctxt-} ws+ (ws,Fail msg) -> (ws,Fail msg)++instance Applicative Check where+ pure = return+ (<*>) = ap++instance ErrorMonad Check where+ raise s = checkError (pp s)+ handle f h = handle' f (h . render)++handle' f h = Check (\{-ctxt-} msgs -> case unCheck f {-ctxt-} msgs of+ (ws,Success x) -> (ws,Success x)+ (ws,Fail msg) -> unCheck (h msg) {-ctxt-} ws)++-- | Report a fatal error+checkError :: Message -> Check a+checkError msg = Check (\{-ctxt-} ws -> (ws,Fail msg))++checkCond :: Message -> Bool -> Check ()+checkCond s b = if b then return () else checkError s++-- | warnings should be reversed in the end+checkWarn :: Message -> Check ()+checkWarn msg = Check $ \{-ctxt-} (es,ws) -> ((es,("Warning:" <+> msg) : ws),Success ())++checkWarnings ms = mapM_ checkWarn ms++-- | Report a nonfatal (accumulated) error+checkAccumError :: Message -> Check ()+checkAccumError msg = Check $ \{-ctxt-} (es,ws) -> ((msg:es,ws),Success ())++-- | Turn a fatal error into a nonfatal (accumulated) error+accumulateError :: (a -> Check a) -> a -> Check a+accumulateError chk a =+ handle' (chk a) $ \ msg -> do checkAccumError msg; return a++-- | Turn accumulated errors into a fatal error+commitCheck :: Check a -> Check a+commitCheck c =+ Check $ \ {-ctxt-} msgs0@(es0,ws0) ->+ case unCheck c {-ctxt-} ([],[]) of+ (([],ws),Success v) -> ((es0,ws++ws0),Success v)+ (msgs ,Success _) -> bad msgs0 msgs+ ((es,ws),Fail e) -> bad msgs0 ((e:es),ws)+ where+ bad (es0,ws0) (es,ws) = ((es0,ws++ws0),Fail (list es))+ list = vcat . reverse++-- | Run an error check, report errors and warnings+runCheck c = runCheck' noOptions c++-- | Run an error check, report errors and (optionally) warnings+runCheck' :: ErrorMonad m => Options -> Check a -> m (a,String)+runCheck' opts c =+ case unCheck c {-[]-} ([],[]) of+ (([],ws),Success v) -> return (v,render (wlist ws))+ (msgs ,Success v) -> bad msgs+ ((es,ws),Fail e) -> bad ((e:es),ws)+ where+ bad (es,ws) = raise (render $ wlist ws $$ list es)+ list = vcat . reverse+ wlist ws = if verbAtLeast opts Normal then list ws else empty++parallelCheck :: [Check a] -> Check [a]+parallelCheck cs =+ Check $ \ {-ctxt-} (es0,ws0) ->+ let os = [unCheck c {-[]-} ([],[])|c<-cs] `using` parList rseq+ (msgs1,crs) = unzip os+ (ess,wss) = unzip msgs1+ rs = [r | Success r<-crs]+ fs = [f | Fail f<-crs]+ msgs = (concat ess++es0,concat wss++ws0)+ in if null fs+ then (msgs,Success rs)+ else (msgs,Fail (vcat $ reverse fs))++checkMap :: (Ord a) => (a -> b -> Check b) -> Map.Map a b -> Check (Map.Map a b)+checkMap f map = do xs <- mapM (\(k,v) -> do v <- f k v+ return (k,v)) (Map.toList map)+ return (Map.fromAscList xs)++checkMapRecover :: (Ord a) => (a -> b -> Check b) -> Map.Map a b -> Check (Map.Map a b)+checkMapRecover f = fmap Map.fromList . parallelCheck . map f' . Map.toList+ where f' (k,v) = fmap ((,)k) (f k v)++{-+checkMapRecover f mp = do + let xs = map (\ (k,v) -> (k,runCheck (f k v))) (Map.toList mp)+ case [s | (_,Bad s) <- xs] of+ ss@(_:_) -> checkError (text (unlines ss)) + _ -> do+ let (kx,ss) = unzip [((k,x),s) | (k, Ok (x,s)) <- xs]+ if not (all null ss) then checkWarn (text (unlines ss)) else return ()+ return (Map.fromAscList kx)+-}++checkIn :: Doc -> Check a -> Check a+checkIn msg c = Check $ \{-ctxt-} msgs0 ->+ case unCheck c {-ctxt-} ([],[]) of+ (msgs,Fail msg) -> (augment msgs0 msgs,Fail (augment1 msg))+ (msgs,Success v) -> (augment msgs0 msgs,Success v)+ where+ augment (es0,ws0) (es,ws) = (augment' es0 es,augment' ws0 ws)+ augment' msgs0 [] = msgs0+ augment' msgs0 msgs' = (msg $$ nest 3 (vcat (reverse msgs'))):msgs0++ augment1 msg' = msg $$ nest 3 msg'++-- | Augment error messages with a relative path to the source module and+-- an contextual hint (which can be left 'empty')+checkInModule cwd mi loc context =+ checkIn (ppLocation relpath loc <> ':' $$ nest 2 context)+ where+ relpath = makeRelative cwd (sourcePath mi)
@@ -0,0 +1,22 @@+module GF.Infra.CompactPrint where+import Data.Char++compactPrint = compactPrintCustom keywordGF (const False)++compactPrintGFCC = compactPrintCustom (const False) keywordGFCC++compactPrintCustom pre post = dps . concat . map (spaceIf pre post) . words ++dps = dropWhile isSpace++spaceIf pre post w = case w of+ _ | pre w -> "\n" ++ w+ _ | post w -> w ++ "\n"+ c:_ | isAlpha c || isDigit c -> " " ++ w+ '_':_ -> " " ++ w+ _ -> w++keywordGF w = elem w ["cat","fun","lin","lincat","lindef","oper","param"]+keywordGFCC w = + last w == ';' || + elem w ["flags","fun","cat","lin","oper","lincat","lindef","printname","param"]
@@ -0,0 +1,48 @@+-- | Lifted concurrency operators and a some useful concurrency abstractions+module GF.Infra.Concurrency(+ module GF.Infra.Concurrency,+ C.forkIO,+ C.MVar,C.modifyMVar,C.modifyMVar_,+ C.Chan+ ) where+import qualified Control.Concurrent as C+import System.IO.Unsafe(unsafeInterleaveIO)+import Control.Monad((<=<))+import Control.Monad.Trans(MonadIO(..))++-- * Futures++newtype Future a = Future {now::IO a}++spawn io = do v <- newEmptyMVar+ C.forkIO $ putMVar v =<< io+ return (Future (readMVar v))++parMapM f = mapM now <=< mapM (spawn . f)++-- * Single-threaded logging++newLog put =+ do logchan <- newChan+ liftIO $ C.forkIO (mapM_ put =<< getChanContents logchan)+ return (writeChan logchan)++-- * Lifted concurrency operators++newMVar x = liftIO $ C.newMVar x+readMVar v = liftIO $ C.readMVar v+putMVar v = liftIO . C.putMVar v++newEmptyMVar :: MonadIO io => io (C.MVar a)+newEmptyMVar = liftIO C.newEmptyMVar++newChan :: MonadIO io => io (C.Chan a)+newChan = liftIO C.newChan++getChanContents ch = liftIO $ C.getChanContents ch+writeChan ch = liftIO . C.writeChan ch+++-- * Delayed IO++lazyIO = unsafeInterleaveIO
@@ -0,0 +1,74 @@+module GF.Infra.Dependencies (+ depGraph+ ) where++import GF.Grammar.Grammar+--import GF.Infra.Ident(Ident)+import GF.Text.Pretty(render)++import Data.List (nub,isPrefixOf)++-- the list gives the only modules to show, e.g. to hide the library details+depGraph :: Maybe [String] -> Grammar -> String+depGraph only = prDepGraph . grammar2moddeps only++prDepGraph :: [(ModuleName,ModDeps)] -> String+prDepGraph deps = unlines $ [+ "digraph {"+ ] +++ map mkNode deps +++ concatMap mkArrows deps ++ [+ "}"+ ]+ where+ mkNode (i,dep) = unwords [render i, "[",nodeAttr (modtype dep),"]"]+ nodeAttr ty = case ty of+ MTAbstract -> "style = \"solid\", shape = \"box\""+ MTConcrete _ -> "style = \"solid\", shape = \"ellipse\""+ _ -> "style = \"dashed\", shape = \"ellipse\""+ mkArrows (i,dep) = + [unwords [render i,"->",render j,"[",arrowAttr "of","]"] | j <- ofs dep] +++ [unwords [render i,"->",render j,"[",arrowAttr "ex","]"] | j <- extendeds dep] +++ [unwords [render i,"->",render j,"[",arrowAttr "op","]"] | j <- openeds dep] +++ [unwords [render i,"->",render j,"[",arrowAttr "ed","]"] | j <- extrads dep]+ arrowAttr s = case s of+ "of" -> "style = \"solid\", arrowhead = \"empty\""+ "ex" -> "style = \"solid\""+ "op" -> "style = \"dashed\""+ "ed" -> "style = \"dotted\""++data ModDeps = ModDeps {+ modtype :: ModuleType,+ ofs :: [ModuleName],+ extendeds :: [ModuleName],+ openeds :: [ModuleName],+ extrads :: [ModuleName],+ functors :: [ModuleName],+ interfaces :: [ModuleName],+ instances :: [ModuleName]+ }++noModDeps = ModDeps MTAbstract [] [] [] [] [] [] []++grammar2moddeps :: Maybe [String] -> Grammar -> [(ModuleName,ModDeps)]+grammar2moddeps monly gr = [(i,depMod i m) | (i,m) <- modules gr, yes i]+ where+ depMod i m = + noModDeps{+ modtype = mtype m,+ ofs = case mtype m of + MTConcrete i -> [i | yes i]+ MTInstance (i,_) -> [i | yes i]+ _ -> [],+ extendeds = nub $ filter yes $ map fst (mextend m),+ openeds = nub $ filter yes $ map openedModule (mopens m),+ extrads = nub $ filter yes $ mexdeps m+ }+ yes i = case monly of + Just only -> match (render i) only+ _ -> True+ match s os = any (\x -> doMatch x s) os+ doMatch x s = case last x of + '*' -> isPrefixOf (init x) s+ _ -> x == s+
@@ -0,0 +1,381 @@+-- This is a version of System.Console.GetOpt which has been hacked to+-- support long options with a single dash. Since we don't want the annoying+-- clash with short options that start with the same character as a long+-- one, we don't allow short options to be given together (e.g. -zxf),+-- nor do we allow options to be given as any unique prefix.++-----------------------------------------------------------------------------+-- |+-- Module : System.Console.GetOpt+-- Copyright : (c) Sven Panne 2002-2005+-- License : BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer : libraries@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- This library provides facilities for parsing the command-line options+-- in a standalone program. It is essentially a Haskell port of the GNU +-- @getopt@ library.+--+-----------------------------------------------------------------------------++{-+Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small+changes Dec. 1997)++Two rather obscure features are missing: The Bash 2.0 non-option hack+(if you don't already know it, you probably don't want to hear about+it...) and the recognition of long options with a single dash+(e.g. '-help' is recognised as '--help', as long as there is no short+option 'h').++Other differences between GNU's getopt and this implementation:++* To enforce a coherent description of options and arguments, there+ are explanation fields in the option/argument descriptor.++* Error messages are now more informative, but no longer POSIX+ compliant... :-(++And a final Haskell advertisement: The GNU C implementation uses well+over 1100 lines, we need only 195 here, including a 46 line example! +:-)+-}++--module System.Console.GetOpt (+module GF.Infra.GetOpt (+ -- * GetOpt+ getOpt, getOpt',+ usageInfo,+ ArgOrder(..),+ OptDescr(..),+ ArgDescr(..),++ -- * Examples++ -- |To hopefully illuminate the role of the different data structures,+ -- here are the command-line options for a (very simple) compiler,+ -- done in two different ways.+ -- The difference arises because the type of 'getOpt' is+ -- parameterized by the type of values derived from flags.++ -- ** Interpreting flags as concrete values+ -- $example1++ -- ** Interpreting flags as transformations of an options record+ -- $example2+) where++import Prelude -- necessary to get dependencies right++--import Data.List ( isPrefixOf, find )++-- |What to do with options following non-options+data ArgOrder a+ = RequireOrder -- ^ no option processing after first non-option+ | Permute -- ^ freely intersperse options and non-options+ | ReturnInOrder (String -> a) -- ^ wrap non-options into options++{-|+Each 'OptDescr' describes a single option.++The arguments to 'Option' are:++* list of short option characters++* list of long option strings (without \"--\")++* argument descriptor++* explanation of option for user+-}+data OptDescr a = -- description of a single options:+ Option [Char] -- list of short option characters+ [String] -- list of long option strings (without "--")+ (ArgDescr a) -- argument descriptor+ String -- explanation of option for user++-- |Describes whether an option takes an argument or not, and if so+-- how the argument is injected into a value of type @a@.+data ArgDescr a+ = NoArg a -- ^ no argument expected+ | ReqArg (String -> a) String -- ^ option requires argument+ | OptArg (Maybe String -> a) String -- ^ optional argument++data OptKind a -- kind of cmd line arg (internal use only):+ = Opt a -- an option+ | UnreqOpt String -- an un-recognized option+ | NonOpt String -- a non-option+ | EndOfOpts -- end-of-options marker (i.e. "--")+ | OptErr String -- something went wrong...++-- | Return a string describing the usage of a command, derived from+-- the header (first argument) and the options described by the +-- second argument.+usageInfo :: String -- header+ -> [OptDescr a] -- option descriptors+ -> String -- nicely formatted decription of options+usageInfo header optDescr = unlines (header:table)+ where (ss,ls,ds) = (unzip3 . concatMap fmtOpt) optDescr+ table = zipWith3 paste (sameLen ss) (sameLen ls) ds+ paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z+ sameLen xs = flushLeft ((maximum . map length) xs) xs+ flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]++fmtOpt :: OptDescr a -> [(String,String,String)]+fmtOpt (Option sos los ad descr) =+ case lines descr of+ [] -> [(sosFmt,losFmt,"")]+ (d:ds) -> (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ]+ where sepBy _ [] = ""+ sepBy _ [x] = x+ sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs+ sosFmt = sepBy ',' (map (fmtShort ad) sos)+ losFmt = sepBy ',' (map (fmtLong ad) los)++fmtShort :: ArgDescr a -> Char -> String+fmtShort (NoArg _ ) so = "-" ++ [so]+fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad+fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]"++fmtLong :: ArgDescr a -> String -> String+fmtLong (NoArg _ ) lo = "--" ++ lo+fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad+fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]"++{-|+Process the command-line, and return the list of values that matched+(and those that didn\'t). The arguments are:++* The order requirements (see 'ArgOrder')++* The option descriptions (see 'OptDescr')++* The actual command line arguments (presumably got from + 'System.Environment.getArgs').++'getOpt' returns a triple consisting of the option arguments, a list+of non-options, and a list of error messages.+-}+getOpt :: ArgOrder a -- non-option handling+ -> [OptDescr a] -- option descriptors+ -> [String] -- the command-line arguments+ -> ([a],[String],[String]) -- (options,non-options,error messages)+getOpt ordering optDescr args = (os,xs,es ++ map errUnrec us)+ where (os,xs,us,es) = getOpt' ordering optDescr args++{-|+This is almost the same as 'getOpt', but returns a quadruple+consisting of the option arguments, a list of non-options, a list of+unrecognized options, and a list of error messages.+-}+getOpt' :: ArgOrder a -- non-option handling+ -> [OptDescr a] -- option descriptors+ -> [String] -- the command-line arguments+ -> ([a],[String], [String] ,[String]) -- (options,non-options,unrecognized,error messages)+getOpt' _ _ [] = ([],[],[],[])+getOpt' ordering optDescr (arg:args) = procNextOpt opt ordering+ where procNextOpt (Opt o) _ = (o:os,xs,us,es)+ procNextOpt (UnreqOpt u) _ = (os,xs,u:us,es)+ procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[],[])+ procNextOpt (NonOpt x) Permute = (os,x:xs,us,es)+ procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,us,es)+ procNextOpt EndOfOpts RequireOrder = ([],rest,[],[])+ procNextOpt EndOfOpts Permute = ([],rest,[],[])+ procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[],[])+ procNextOpt (OptErr e) _ = (os,xs,us,e:es)++ (opt,rest) = getNext arg args optDescr+ (os,xs,us,es) = getOpt' ordering optDescr rest++-- take a look at the next cmd line arg and decide what to do with it+getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])+getNext ('-':'-':[]) rest _ = (EndOfOpts,rest)+getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr+getNext ('-' :xs) rest optDescr = longOpt xs rest optDescr+getNext a rest _ = (NonOpt a,rest)++-- handle long option+longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])+longOpt ls rs optDescr = long ads arg rs+ where (opt,arg) = break (=='=') ls+ options = [ o | o@(Option ss xs _ _) <- optDescr+ , opt `elem` map (:[]) ss || opt `elem` xs ]+ ads = [ ad | Option _ _ ad _ <- options ]+ optStr = ("--"++opt)++ long (_:_:_) _ rest = (errAmbig options optStr,rest)+ long [NoArg a ] [] rest = (Opt a,rest)+ long [NoArg _ ] ('=':_) rest = (errNoArg optStr,rest)+ long [ReqArg _ d] [] [] = (errReq d optStr,[])+ long [ReqArg f _] [] (r:rest) = (Opt (f r),rest)+ long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest)+ long [OptArg f _] [] rest = (Opt (f Nothing),rest)+ long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest)+ long _ _ rest = (UnreqOpt ("--"++ls),rest)+++-- miscellaneous error formatting++errAmbig :: [OptDescr a] -> String -> OptKind a+errAmbig ods optStr = OptErr (usageInfo header ods)+ where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:"++errReq :: String -> String -> OptKind a+errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n")++errUnrec :: String -> String+errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n"++errNoArg :: String -> OptKind a+errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")++{-+-----------------------------------------------------------------------------------------+-- and here a small and hopefully enlightening example:++data Flag = Verbose | Version | Name String | Output String | Arg String deriving Show++options :: [OptDescr Flag]+options =+ [Option ['v'] ["verbose"] (NoArg Verbose) "verbosely list files",+ Option ['V','?'] ["version","release"] (NoArg Version) "show version info",+ Option ['o'] ["output"] (OptArg out "FILE") "use FILE for dump",+ Option ['n'] ["name"] (ReqArg Name "USER") "only dump USER's files"]++out :: Maybe String -> Flag+out Nothing = Output "stdout"+out (Just o) = Output o++test :: ArgOrder Flag -> [String] -> String+test order cmdline = case getOpt order options cmdline of+ (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n ++ "\n"+ (_,_,errs) -> concat errs ++ usageInfo header options+ where header = "Usage: foobar [OPTION...] files..."++-- example runs:+-- putStr (test RequireOrder ["foo","-v"])+-- ==> options=[] args=["foo", "-v"]+-- putStr (test Permute ["foo","-v"])+-- ==> options=[Verbose] args=["foo"]+-- putStr (test (ReturnInOrder Arg) ["foo","-v"])+-- ==> options=[Arg "foo", Verbose] args=[]+-- putStr (test Permute ["foo","--","-v"])+-- ==> options=[] args=["foo", "-v"]+-- putStr (test Permute ["-?o","--name","bar","--na=baz"])+-- ==> options=[Version, Output "stdout", Name "bar", Name "baz"] args=[]+-- putStr (test Permute ["--ver","foo"])+-- ==> option `--ver' is ambiguous; could be one of:+-- -v --verbose verbosely list files+-- -V, -? --version, --release show version info +-- Usage: foobar [OPTION...] files...+-- -v --verbose verbosely list files +-- -V, -? --version, --release show version info +-- -o[FILE] --output[=FILE] use FILE for dump +-- -n USER --name=USER only dump USER's files+-----------------------------------------------------------------------------------------+-}++{- $example1++A simple choice for the type associated with flags is to define a type+@Flag@ as an algebraic type representing the possible flags and their+arguments:++> module Opts1 where+> +> import System.Console.GetOpt+> import Data.Maybe ( fromMaybe )+> +> data Flag +> = Verbose | Version +> | Input String | Output String | LibDir String+> deriving Show+> +> options :: [OptDescr Flag]+> options =+> [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr"+> , Option ['V','?'] ["version"] (NoArg Version) "show version number"+> , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE"+> , Option ['c'] [] (OptArg inp "FILE") "input FILE"+> , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory"+> ]+> +> inp,outp :: Maybe String -> Flag+> outp = Output . fromMaybe "stdout"+> inp = Input . fromMaybe "stdin"+> +> compilerOpts :: [String] -> IO ([Flag], [String])+> compilerOpts argv = +> case getOpt Permute options argv of+> (o,n,[] ) -> return (o,n)+> (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+> where header = "Usage: ic [OPTION...] files..."++Then the rest of the program will use the constructed list of flags+to determine it\'s behaviour.++-}++{- $example2++A different approach is to group the option values in a record of type+@Options@, and have each flag yield a function of type+@Options -> Options@ transforming this record.++> module Opts2 where+>+> import System.Console.GetOpt+> import Data.Maybe ( fromMaybe )+>+> data Options = Options+> { optVerbose :: Bool+> , optShowVersion :: Bool+> , optOutput :: Maybe FilePath+> , optInput :: Maybe FilePath+> , optLibDirs :: [FilePath]+> } deriving Show+>+> defaultOptions = Options+> { optVerbose = False+> , optShowVersion = False+> , optOutput = Nothing+> , optInput = Nothing+> , optLibDirs = []+> }+>+> options :: [OptDescr (Options -> Options)]+> options =+> [ Option ['v'] ["verbose"]+> (NoArg (\ opts -> opts { optVerbose = True }))+> "chatty output on stderr"+> , Option ['V','?'] ["version"]+> (NoArg (\ opts -> opts { optShowVersion = True }))+> "show version number"+> , Option ['o'] ["output"]+> (OptArg ((\ f opts -> opts { optOutput = Just f }) . fromMaybe "output")+> "FILE")+> "output FILE"+> , Option ['c'] []+> (OptArg ((\ f opts -> opts { optInput = Just f }) . fromMaybe "input")+> "FILE")+> "input FILE"+> , Option ['L'] ["libdir"]+> (ReqArg (\ d opts -> opts { optLibDirs = optLibDirs opts ++ [d] }) "DIR")+> "library directory"+> ]+>+> compilerOpts :: [String] -> IO (Options, [String])+> compilerOpts argv =+> case getOpt Permute options argv of+> (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n)+> (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+> where header = "Usage: ic [OPTION...] files..."++Similarly, each flag could yield a monadic function transforming a record,+of type @Options -> IO Options@ (or any other monad), allowing option+processing to perform actions of the chosen monad, e.g. printing help or+version messages, checking that file arguments exist, etc.++-}
@@ -0,0 +1,154 @@+----------------------------------------------------------------------+-- |+-- Module : Ident+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/15 11:43:33 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.8 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Infra.Ident (-- ** Identifiers+ ModuleName(..), moduleNameS,+ Ident, ident2utf8, showIdent, prefixIdent,+ -- *** Normal identifiers (returned by the parser)+ identS, identC, identW,+ -- *** Special identifiers for internal use+ identV, identA, identAV,+ argIdent, isArgIdent, getArgIndex,+ varStr, varX, isWildIdent, varIndex,+ -- *** Raw identifiers+ RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,+ isPrefixOf, showRawIdent+ ) where++import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)+ -- Limit use of BS functions to the ones that work correctly on+ -- UTF-8-encoded bytestrings!+import Data.Char(isDigit)+import PGF.Internal(Binary(..))+import GF.Text.Pretty+++-- | Module names+newtype ModuleName = MN Ident deriving (Eq,Ord)++moduleNameS = MN . identS++instance Show ModuleName where showsPrec d (MN m) = showsPrec d m+instance Pretty ModuleName where pp (MN m) = pp m+++-- | the constructors labelled /INTERNAL/ are+-- internal representation never returned by the parser+data Ident = + IC {-# UNPACK #-} !RawIdent -- ^ raw identifier after parsing, resolved in Rename+ | IW -- ^ wildcard+--+-- below this constructor: internal representation never returned by the parser+ | IV {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int -- ^ /INTERNAL/ variable+ | IA {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat at position+ | IAV {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat with bindings at position+-- + deriving (Eq, Ord, Show, Read)++-- | Identifiers are stored as UTF-8-encoded bytestrings.+-- (It is also possible to use regular Haskell 'String's, with somewhat+-- reduced performance and increased memory use.)+newtype RawIdent = Id { rawId2utf8 :: UTF8.ByteString }+ deriving (Eq, Ord, Show, Read)++pack = UTF8.fromString+unpack = UTF8.toString++rawIdentS = Id . pack+rawIdentC = Id+showRawIdent = unpack . rawId2utf8++prefixRawIdent (Id x) (Id y) = Id (BS.append x y) +isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y++instance Binary RawIdent where+ put = put . rawId2utf8+ get = fmap rawIdentC get+++-- | This function should be used with care, since the returned ByteString is+-- UTF-8-encoded.+ident2utf8 :: Ident -> UTF8.ByteString+ident2utf8 i = case i of+ IC (Id s) -> s+ IV (Id s) n -> BS.append s (pack ('_':show n))+ IA (Id s) j -> BS.append s (pack ('_':show j))+ IAV (Id s) b j -> BS.append s (pack ('_':show b ++ '_':show j))+ IW -> pack "_"++ident2raw = Id . ident2utf8++showIdent :: Ident -> String+showIdent i = unpack $! ident2utf8 i++instance Pretty Ident where pp = pp . showIdent++identS :: String -> Ident+identS = identC . rawIdentS++identC :: RawIdent -> Ident+identW :: Ident+++prefixIdent :: String -> Ident -> Ident+prefixIdent pref = identC . Id . BS.append (pack pref) . ident2utf8++-- normal identifier+-- ident s = IC s++identV :: RawIdent -> Int -> Ident+identA :: RawIdent -> Int -> Ident+identAV:: RawIdent -> Int -> Int -> Ident++(identC, identV, identA, identAV, identW) = + (IC, IV, IA, IAV, IW)++-- | to mark argument variables+argIdent :: Int -> Ident -> Int -> Ident+argIdent 0 (IC c) i = identA c i+argIdent b (IC c) i = identAV c b i++isArgIdent IA{} = True+isArgIdent IAV{} = True+isArgIdent _ = False++getArgIndex (IA _ i) = Just i+getArgIndex (IAV _ _ i) = Just i+getArgIndex (IC (Id bs))+ | isDigit c =+ -- (Just . read . unpack . snd . BS.spanEnd isDigit) bs -- not ok with UTF-8+ (Just . read . reverse . takeWhile isDigit) s+ where s@(c:_) = reverse (unpack bs)+getArgIndex x = Nothing++-- | used in lin defaults+varStr :: Ident+varStr = identA (rawIdentS "str") 0++-- | refreshing variables+varX :: Int -> Ident+varX = identV (rawIdentS "x")++isWildIdent :: Ident -> Bool+isWildIdent x = case x of+ IW -> True+ IC s | s == wild -> True+ _ -> False++wild = Id (pack "_")++varIndex :: Ident -> Int+varIndex (IV _ n) = n+varIndex _ = -1 --- other than IV should not count
@@ -0,0 +1,41 @@+-- | Source locations+module GF.Infra.Location where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint+import GF.Text.Pretty++-- ** Source locations++class HasSourcePath a where sourcePath :: a -> FilePath++data Location + = NoLoc+ | Local Int Int+ | External FilePath Location+ deriving (Show,Eq,Ord)++-- | Attaching location information+data L a = L Location a deriving Show++instance Functor L where fmap f (L loc x) = L loc (f x)++unLoc :: L a -> a+unLoc (L _ x) = x++noLoc = L NoLoc++ppLocation :: FilePath -> Location -> Doc+ppLocation fpath NoLoc = pp fpath+ppLocation fpath (External p l) = ppLocation p l+ppLocation fpath (Local b e) =+ opt (fpath/="") (fpath <> ":") <> b <> opt (b/=e) ("-" <> e)+ where+ opt False x = empty+ opt True x = x++ppL (L loc x) msg = hang (loc<>":") 4 ("In"<+>x<>":"<+>msg)+++instance Pretty Location where pp = ppLocation ""++instance Pretty a => Pretty (L a) where pp (L loc x) = loc<>":"<>x+
@@ -0,0 +1,634 @@+module GF.Infra.Option+ (+ -- ** Command line options+ -- *** Option types+ Options, + Flags(..), + Mode(..), Phase(..), Verbosity(..), + OutputFormat(..), + SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..),+ Dump(..), Pass(..), Recomp(..),+ outputFormatsExpl, + -- *** Option parsing+ parseOptions, parseModuleOptions, fixRelativeLibPaths,+ -- *** Option pretty-printing+ optionsGFO,+ optionsPGF,+ -- *** Option manipulation+ addOptions, concatOptions, noOptions,+ modifyFlags,+ helpMessage,+ -- *** Checking specific options+ flag, cfgTransform, haskellOption, readOutputFormat,+ isLexicalCat, isLiteralCat, renameEncoding, getEncoding, defaultEncoding,+ -- *** Setting specific options+ setOptimization, setCFGTransform,+ -- *** Convenience methods for checking options+ verbAtLeast, dump+ ) where++import Control.Monad+import Data.Char (toLower, isDigit)+import Data.List+import Data.Maybe+import GF.Infra.Ident+import GF.Infra.GetOpt+import GF.Grammar.Predef+--import System.Console.GetOpt+import System.FilePath+--import System.IO++import GF.Data.Operations(Err,ErrorMonad(..),liftErr)++import Data.Set (Set)+import qualified Data.Set as Set++import PGF.Internal(Literal(..))++usageHeader :: String+usageHeader = unlines + ["Usage: gf [OPTIONS] [FILE [...]]",+ "",+ "How each FILE is handled depends on the file name suffix:",+ "",+ ".gf Normal or old GF source, will be compiled.",+ ".gfo Compiled GF source, will be loaded as is.",+ ".gfe Example-based GF source, will be converted to .gf and compiled.",+ ".ebnf Extended BNF format, will be converted to .gf and compiled.",+ ".cf Context-free (BNF) format, will be converted to .gf and compiled.",+ "",+ "If multiple FILES are given, they must be normal GF source, .gfo or .gfe files.",+ "For the other input formats, only one file can be given.",+ "",+ "Command-line options:"]+++helpMessage :: String+helpMessage = usageInfo usageHeader optDescr+++-- FIXME: do we really want multi-line errors?+errors :: ErrorMonad err => [String] -> err a+errors = raise . unlines++-- Types++data Mode = ModeVersion | ModeHelp+ | ModeInteractive | ModeRun+ | ModeInteractive2 | ModeRun2+ | ModeCompiler+ | ModeServer {-port::-}Int+ deriving (Show,Eq,Ord)++data Verbosity = Quiet | Normal | Verbose | Debug+ deriving (Show,Eq,Ord,Enum,Bounded)++data Phase = Preproc | Convert | Compile | Link+ deriving (Show,Eq,Ord)++data OutputFormat = FmtPGFPretty+ | FmtJavaScript + | FmtPython + | FmtHaskell + | FmtJava+ | FmtProlog+ | FmtBNF+ | FmtEBNF+ | FmtRegular+ | FmtNoLR+ | FmtSRGS_XML+ | FmtSRGS_XML_NonRec+ | FmtSRGS_ABNF + | FmtSRGS_ABNF_NonRec+ | FmtJSGF + | FmtGSL + | FmtVoiceXML+ | FmtSLF+ | FmtRegExp+ | FmtFA+ deriving (Eq,Ord)++data SISRFormat = + -- | SISR Working draft 1 April 2003+ -- <http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/>+ SISR_WD20030401 + | SISR_1_0+ deriving (Show,Eq,Ord)++data Optimization = OptStem | OptCSE | OptExpand | OptParametrize+ deriving (Show,Eq,Ord)++data CFGTransform = CFGNoLR + | CFGRegular+ | CFGTopDownFilter + | CFGBottomUpFilter + | CFGStartCatOnly+ | CFGMergeIdentical+ | CFGRemoveCycles+ deriving (Show,Eq,Ord)++data HaskellOption = HaskellNoPrefix | HaskellGADT | HaskellLexical+ | HaskellConcrete | HaskellVariants+ deriving (Show,Eq,Ord)++data Warning = WarnMissingLincat+ deriving (Show,Eq,Ord)++newtype Dump = Dump Pass deriving (Show,Eq,Ord)+data Pass = Source | Rebuild | Extend | Rename | TypeCheck | Refresh | Optimize | Canon+ deriving (Show,Eq,Ord)++data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp+ deriving (Show,Eq,Ord)++data Flags = Flags {+ optMode :: Mode,+ optStopAfterPhase :: Phase,+ optVerbosity :: Verbosity,+ optShowCPUTime :: Bool,+ optOutputFormats :: [OutputFormat],+ optSISR :: Maybe SISRFormat,+ optHaskellOptions :: Set HaskellOption,+ optLexicalCats :: Set String,+ optLiteralCats :: Set Ident,+ optGFODir :: Maybe FilePath,+ optOutputDir :: Maybe FilePath,+ optGFLibPath :: Maybe [FilePath],+ optDocumentRoot :: Maybe FilePath, -- For --server mode+ optRecomp :: Recomp,+ optProbsFile :: Maybe FilePath,+ optRetainResource :: Bool,+ optName :: Maybe String,+ optPreprocessors :: [String],+ optEncoding :: Maybe String,+ optPMCFG :: Bool,+ optOptimizations :: Set Optimization,+ optOptimizePGF :: Bool,+ optSplitPGF :: Bool,+ optCFGTransforms :: Set CFGTransform,+ optLibraryPath :: [FilePath],+ optStartCat :: Maybe String,+ optSpeechLanguage :: Maybe String,+ optLexer :: Maybe String,+ optUnlexer :: Maybe String,+ optWarnings :: [Warning],+ optDump :: [Dump],+ optTagsOnly :: Bool,+ optHeuristicFactor :: Maybe Double,+ optCaseSensitive :: Bool,+ optPlusAsBind :: Bool,+ optJobs :: Maybe (Maybe Int),+ optTrace :: Bool+ }+ deriving (Show)++newtype Options = Options (Flags -> Flags)++instance Show Options where+ show (Options o) = show (o defaultFlags)++-- Option parsing++parseOptions :: ErrorMonad err =>+ [String] -- ^ list of string arguments+ -> err (Options, [FilePath])+parseOptions args + | not (null errs) = errors errs+ | otherwise = do opts <- concatOptions `fmap` liftErr (sequence optss)+ return (opts, files)+ where+ (optss, files, errs) = getOpt RequireOrder optDescr args++parseModuleOptions :: ErrorMonad err =>+ [String] -- ^ list of string arguments+ -> err Options+parseModuleOptions args = do+ (opts,nonopts) <- parseOptions args+ if null nonopts + then return opts+ else errors $ map ("Non-option among module options: " ++) nonopts++fixRelativeLibPaths curr_dir lib_dirs (Options o) = Options (fixPathFlags . o)+ where+ fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [parent </> dir+ | parent <- curr_dir : lib_dirs]) path}++-- Showing options++-- | Pretty-print the options that are preserved in .gfo files.+optionsGFO :: Options -> [(String,Literal)]+optionsGFO opts = optionsPGF opts+ ++ [("coding", LStr (getEncoding opts))]++-- | Pretty-print the options that are preserved in .pgf files.+optionsPGF :: Options -> [(String,Literal)]+optionsPGF opts =+ maybe [] (\x -> [("language",LStr x)]) (flag optSpeechLanguage opts)+ ++ maybe [] (\x -> [("startcat",LStr x)]) (flag optStartCat opts)+ ++ maybe [] (\x -> [("heuristic_search_factor",LFlt x)]) (flag optHeuristicFactor opts)+ ++ (if flag optCaseSensitive opts then [] else [("case_sensitive",LStr "off")])++-- Option manipulation++flag :: (Flags -> a) -> Options -> a+flag f (Options o) = f (o defaultFlags)++addOptions :: Options -> Options -> Options+addOptions (Options o1) (Options o2) = Options (o2 . o1)++noOptions :: Options+noOptions = Options id++concatOptions :: [Options] -> Options+concatOptions = foldr addOptions noOptions++modifyFlags :: (Flags -> Flags) -> Options+modifyFlags = Options++getEncoding :: Options -> String+getEncoding = renameEncoding . maybe defaultEncoding id . flag optEncoding+defaultEncoding = "UTF-8"++-- Default options++defaultFlags :: Flags+defaultFlags = Flags {+ optMode = ModeInteractive,+ optStopAfterPhase = Compile,+ optVerbosity = Normal,+ optShowCPUTime = False,+ optOutputFormats = [],+ optSISR = Nothing,+ optHaskellOptions = Set.empty,+ optLiteralCats = Set.fromList [cString,cInt,cFloat,cVar],+ optLexicalCats = Set.empty,+ optGFODir = Nothing,+ optOutputDir = Nothing,+ optGFLibPath = Nothing,+ optDocumentRoot = Nothing,+ optRecomp = RecompIfNewer,+ optProbsFile = Nothing,+ optRetainResource = False,++ optName = Nothing,+ optPreprocessors = [],+ optEncoding = Nothing,+ optPMCFG = True,+ optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize],+ optOptimizePGF = False,+ optSplitPGF = False,+ optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter, + CFGTopDownFilter, CFGMergeIdentical],+ optLibraryPath = [],+ optStartCat = Nothing,+ optSpeechLanguage = Nothing,+ optLexer = Nothing,+ optUnlexer = Nothing,+ optWarnings = [],+ optDump = [],+ optTagsOnly = False,+ optHeuristicFactor = Nothing,+ optCaseSensitive = True,+ optPlusAsBind = False,+ optJobs = Nothing,+ optTrace = False+ }++-- | Option descriptions+{-# NOINLINE optDescr #-}+optDescr :: [OptDescr (Err Options)]+optDescr = + [+ Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.",+ Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.",+ Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 2.",+ Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",+ Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.",+ Option ['j'] ["jobs"] (OptArg jobs "N") "Compile N modules in parallel with -batch (default 1).",+ Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",+ Option [] ["run"] (NoArg (mode ModeRun)) "Run in interactive mode, showing output only (no other messages).",+ Option [] ["cshell"] (NoArg (mode ModeInteractive2)) "Start the C run-time shell.",+ Option [] ["crun"] (NoArg (mode ModeRun2)) "Start the C run-time shell, showing output only (no other messages).",+ Option [] ["server"] (OptArg modeServer "port") $+ "Run in HTTP server mode on given port (default "++show defaultPort++").",+ Option [] ["document-root"] (ReqArg gfDocuRoot "DIR")+ "Overrides the default document root for --server mode.",+ Option [] ["tags"] (NoArg (set $ \o -> o{optMode = ModeCompiler, optTagsOnly = True})) "Build TAGS file and exit.",+ Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).",+ Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.",+ Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .",+ Option [] ["make"] (NoArg (liftM2 addOptions (mode ModeCompiler) (phase Link))) "Build .pgf file and other output files and exit.",+ Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.",+ Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).",+-- Option ['t'] ["trace"] (NoArg (trace True)) "Trace computations",+-- Option [] ["no-trace"] (NoArg (trace False)) "Don't trace computations",+ Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').",+ Option ['f'] ["output-format"] (ReqArg outFmt "FMT") + (unlines ["Output format. FMT can be one of:",+ "Multiple concrete: pgf (default), js, pgf_pretty, prolog, python, ...", -- gar,+ "Single concrete only: bnf, ebnf, fa, gsl, jsgf, regexp, slf, srgs_xml, srgs_abnf, vxml, ....", -- cf, lbnf,+ "Abstract only: haskell, ..."]), -- prolog_abs,+ Option [] ["sisr"] (ReqArg sisrFmt "FMT") + (unlines ["Include SISR tags in generated speech recognition grammars.",+ "FMT can be one of: old, 1.0"]),+ Option [] ["haskell"] (ReqArg hsOption "OPTION") + ("Turn on an optional feature when generating Haskell data types. OPTION = " + ++ concat (intersperse " | " (map fst haskellOptionNames))),+ Option [] ["lexical"] (ReqArg lexicalCat "CAT[,CAT[...]]") + "Treat CAT as a lexical category.",+ Option [] ["literal"] (ReqArg literalCat "CAT[,CAT[...]]") + "Treat CAT as a literal category.",+ Option ['D'] ["output-dir"] (ReqArg outDir "DIR") + "Save output files (other than .gfo files) in DIR.",+ Option [] ["gf-lib-path"] (ReqArg gfLibPath "DIR") + "Overrides the value of GF_LIB_PATH.",+ Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp)) + "Always recompile from source.",+ Option [] ["gfo","recomp-if-newer"] (NoArg (recomp RecompIfNewer)) + "(default) Recompile from source if the source is newer than the .gfo file.",+ Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp)) + "Never recompile from source, if there is already .gfo file.",+ Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.",+ Option [] ["probs"] (ReqArg probsFile "file.probs") "Read probabilities from file.",+ Option ['n'] ["name"] (ReqArg name "NAME") + (unlines ["Use NAME as the name of the output. This is used in the output file names, ",+ "with suffixes depending on the formats, and, when relevant, ",+ "internally in the output."]),+ Option ['i'] [] (ReqArg addLibDir "DIR") "Add DIR to the library search path.",+ Option [] ["path"] (ReqArg setLibPath "DIR:DIR:...") "Set the library search path.",+ Option [] ["preproc"] (ReqArg preproc "CMD") + (unlines ["Use CMD to preprocess input files.",+ "Multiple preprocessors can be used by giving this option multiple times."]),+ Option [] ["coding"] (ReqArg coding "ENCODING") + ("Character encoding of the source grammar, ENCODING = utf8, latin1, cp1251, ..."),+ Option [] ["startcat"] (ReqArg startcat "CAT") "Grammar start category.",+ Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar.",+ Option [] ["lexer"] (ReqArg lexer "LEXER") "Use lexer LEXER.",+ Option [] ["unlexer"] (ReqArg unlexer "UNLEXER") "Use unlexer UNLEXER.",+ Option [] ["pmcfg"] (NoArg (pmcfg True)) "Generate PMCFG (default).",+ Option [] ["no-pmcfg"] (NoArg (pmcfg False)) "Don't generate PMCFG (useful for libraries).",+ Option [] ["optimize"] (ReqArg optimize "OPT") + "Select an optimization package. OPT = all | values | parametrize | none",+ Option [] ["optimize-pgf"] (NoArg (optimize_pgf True))+ "Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file",+ Option [] ["split-pgf"] (NoArg (splitPGF True))+ "Split the PGF into one file per language. This allows the runtime to load only individual languages",+ Option [] ["cfg"] (ReqArg cfgTransform "TRANS") "Enable or disable specific CFG transformations. TRANS = merge, no-merge, bottomup, no-bottomup, ...",+ Option [] ["heuristic_search_factor"] (ReqArg (readDouble (\d o -> o { optHeuristicFactor = Just d })) "FACTOR") "Set the heuristic search factor for statistical parsing",+ Option [] ["case_sensitive"] (onOff (\v -> set $ \o -> o{optCaseSensitive=v}) True) "Set the parser in case-sensitive/insensitive mode [sensitive by default]",+ Option [] ["plus-as-bind"] (NoArg (set $ \o -> o{optPlusAsBind=True})) "Uses of (+) with runtime variables automatically generate BIND (experimental feature).",+ dumpOption "source" Source,+ dumpOption "rebuild" Rebuild,+ dumpOption "extend" Extend,+ dumpOption "rename" Rename,+ dumpOption "tc" TypeCheck,+ dumpOption "refresh" Refresh,+ dumpOption "opt" Optimize,+ dumpOption "canon" Canon+ ]+ where phase x = set $ \o -> o { optStopAfterPhase = x }+ mode x = set $ \o -> o { optMode = x }+ defaultPort = 41296+ modeServer = maybe (ms defaultPort) readPort+ where+ ms = mode . ModeServer+ readPort p = maybe err ms (readMaybe p)+ where err = fail $ "Bad server port: "++p++ jobs = maybe (setjobs Nothing) number+ where+ number s = maybe err (setjobs . Just) (readMaybe s)+ where err = fail $ "Bad number of jobs: " ++ s+ setjobs j = set $ \ o -> o { optJobs = Just j }++ verbosity mv = case mv of+ Nothing -> set $ \o -> o { optVerbosity = Verbose }+ Just v -> case readMaybe v >>= toEnumBounded of+ Just i -> set $ \o -> o { optVerbosity = i }+ Nothing -> fail $ "Bad verbosity: " ++ show v+ cpu x = set $ \o -> o { optShowCPUTime = x }+-- trace x = set $ \o -> o { optTrace = x }+ gfoDir x = set $ \o -> o { optGFODir = Just x }+ outFmt x = readOutputFormat x >>= \f ->+ set $ \o -> o { optOutputFormats = optOutputFormats o ++ [f] }+ sisrFmt x = case x of+ "old" -> set $ \o -> o { optSISR = Just SISR_WD20030401 }+ "1.0" -> set $ \o -> o { optSISR = Just SISR_1_0 }+ _ -> fail $ "Unknown SISR format: " ++ show x+ hsOption x = case lookup x haskellOptionNames of+ Just p -> set $ \o -> o { optHaskellOptions = Set.insert p (optHaskellOptions o) }+ Nothing -> fail $ "Unknown Haskell option: " ++ x+ ++ " Known: " ++ show (map fst haskellOptionNames)+ literalCat x = set $ \o -> o { optLiteralCats = foldr Set.insert (optLiteralCats o) ((map identS . splitBy (==',')) x) }+ lexicalCat x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) }+ outDir x = set $ \o -> o { optOutputDir = Just x }+ gfLibPath x = set $ \o -> o { optGFLibPath = Just $ splitInModuleSearchPath x }+ gfDocuRoot x = set $ \o -> o { optDocumentRoot = Just x }+ recomp x = set $ \o -> o { optRecomp = x }+ probsFile x = set $ \o -> o { optProbsFile = Just x }++ name x = set $ \o -> o { optName = Just x }+ addLibDir x = set $ \o -> o { optLibraryPath = x:optLibraryPath o }+ setLibPath x = set $ \o -> o { optLibraryPath = splitInModuleSearchPath x }+ preproc x = set $ \o -> o { optPreprocessors = optPreprocessors o ++ [x] }+ coding x = set $ \o -> o { optEncoding = Just x }+ startcat x = set $ \o -> o { optStartCat = Just x }+ language x = set $ \o -> o { optSpeechLanguage = Just x }+ lexer x = set $ \o -> o { optLexer = Just x }+ unlexer x = set $ \o -> o { optUnlexer = Just x }++ pmcfg x = set $ \o -> o { optPMCFG = x }++ optimize x = case lookup x optimizationPackages of+ Just p -> set $ \o -> o { optOptimizations = p }+ Nothing -> fail $ "Unknown optimization package: " ++ x+ + optimize_pgf x = set $ \o -> o { optOptimizePGF = x }+ splitPGF x = set $ \o -> o { optSplitPGF = x }++ cfgTransform x = let (x', b) = case x of+ 'n':'o':'-':rest -> (rest, False)+ _ -> (x, True)+ in case lookup x' cfgTransformNames of+ Just t -> set $ setCFGTransform' t b+ Nothing -> fail $ "Unknown CFG transformation: " ++ x'+ ++ " Known: " ++ show (map fst cfgTransformNames)++ readDouble f x = case reads x of+ [(d,"")] -> set $ f d+ _ -> fail "A floating point number is expected"++ dumpOption s d = Option [] ["dump-"++s] (NoArg (set $ \o -> o { optDump = Dump d:optDump o})) ("Dump output of the " ++ s ++ " phase.")++ set = return . Options++outputFormats :: [(String,OutputFormat)]+outputFormats = map fst outputFormatsExpl++outputFormatsExpl :: [((String,OutputFormat),String)]+outputFormatsExpl = + [(("pgf_pretty", FmtPGFPretty),"human-readable pgf"),+ (("js", FmtJavaScript),"JavaScript (whole grammar)"),+ (("python", FmtPython),"Python (whole grammar)"),+ (("haskell", FmtHaskell),"Haskell (abstract syntax)"),+ (("java", FmtJava),"Java (abstract syntax)"),+ (("prolog", FmtProlog),"Prolog (whole grammar)"),+ (("bnf", FmtBNF),"BNF (context-free grammar)"),+ (("ebnf", FmtEBNF),"Extended BNF"),+ (("regular", FmtRegular),"* regular grammar"),+ (("nolr", FmtNoLR),"* context-free with no left recursion"),+ (("srgs_xml", FmtSRGS_XML),"SRGS speech recognition format in XML"),+ (("srgs_xml_nonrec", FmtSRGS_XML_NonRec),"SRGS XML, recursion eliminated"),+ (("srgs_abnf", FmtSRGS_ABNF),"SRGS speech recognition format in ABNF"),+ (("srgs_abnf_nonrec", FmtSRGS_ABNF_NonRec),"SRGS ABNF, recursion eliminated"),+ (("jsgf", FmtJSGF),"JSGF speech recognition format"),+ (("gsl", FmtGSL),"Nuance speech recognition format"),+ (("vxml", FmtVoiceXML),"Voice XML based on abstract syntax"),+ (("slf", FmtSLF),"SLF speech recognition format"),+ (("regexp", FmtRegExp),"regular expression"),+ (("fa", FmtFA),"finite automaton in graphviz format")+ ]++instance Show OutputFormat where+ show = lookupShow outputFormats++instance Read OutputFormat where+ readsPrec = lookupReadsPrec outputFormats++optimizationPackages :: [(String, Set Optimization)]+optimizationPackages = + [("all", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),+ ("values", Set.fromList [OptStem,OptCSE,OptExpand]),+ ("noexpand", Set.fromList [OptStem,OptCSE]),+ + -- deprecated+ ("all_subs", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),+ ("parametrize", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),+ ("none", Set.fromList [OptStem,OptCSE,OptExpand])+ ]++cfgTransformNames :: [(String, CFGTransform)]+cfgTransformNames = + [("nolr", CFGNoLR),+ ("regular", CFGRegular),+ ("topdown", CFGTopDownFilter),+ ("bottomup", CFGBottomUpFilter),+ ("startcatonly", CFGStartCatOnly),+ ("merge", CFGMergeIdentical),+ ("removecycles", CFGRemoveCycles)]++haskellOptionNames :: [(String, HaskellOption)]+haskellOptionNames =+ [("noprefix", HaskellNoPrefix),+ ("gadt", HaskellGADT),+ ("lexical", HaskellLexical),+ ("concrete", HaskellConcrete),+ ("variants", HaskellVariants)]++-- | This is for bacward compatibility. Since GHC 6.12 we+-- started using the native Unicode support in GHC but it+-- uses different names for the code pages.+renameEncoding :: String -> String+renameEncoding "utf8" = "UTF-8"+renameEncoding "latin1" = "CP1252"+renameEncoding ('c':'p':s) | all isDigit s = 'C':'P':s+renameEncoding s = s++lookupShow :: Eq a => [(String,a)] -> a -> String+lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs]++lookupReadsPrec :: [(String,a)] -> Int -> ReadS a+lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x]++onOff :: Monad m => (Bool -> m a) -> Bool -> ArgDescr (m a)+onOff f def = OptArg g "[on,off]"+ where g ma = maybe (return def) readOnOff ma >>= f+ readOnOff x = case map toLower x of+ "on" -> return True+ "off" -> return False+ _ -> fail $ "Expected [on,off], got: " ++ show x++readOutputFormat :: Monad m => String -> m OutputFormat+readOutputFormat s = + maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats++-- FIXME: this is a copy of the function in GF.Devel.UseIO.+splitInModuleSearchPath :: String -> [FilePath]+splitInModuleSearchPath s = case break isPathSep s of+ (f,_:cs) -> f : splitInModuleSearchPath cs+ (f,_) -> [f]+ where+ isPathSep :: Char -> Bool+ isPathSep c = c == ':' || c == ';'++-- +-- * Convenience functions for checking options+--++verbAtLeast :: Options -> Verbosity -> Bool+verbAtLeast opts v = flag optVerbosity opts >= v++dump :: Options -> Dump -> Bool+dump opts d = flag ((d `elem`) . optDump) opts++cfgTransform :: Options -> CFGTransform -> Bool+cfgTransform opts t = Set.member t (flag optCFGTransforms opts)++haskellOption :: Options -> HaskellOption -> Bool+haskellOption opts o = Set.member o (flag optHaskellOptions opts)++isLiteralCat :: Options -> Ident -> Bool+isLiteralCat opts c = Set.member c (flag optLiteralCats opts)++isLexicalCat :: Options -> String -> Bool+isLexicalCat opts c = Set.member c (flag optLexicalCats opts)++-- +-- * Convenience functions for setting options+--++setOptimization :: Optimization -> Bool -> Options+setOptimization o b = modifyFlags (setOptimization' o b)++setOptimization' :: Optimization -> Bool -> Flags -> Flags+setOptimization' o b f = f { optOptimizations = toggle o b (optOptimizations f)}++setCFGTransform :: CFGTransform -> Bool -> Options+setCFGTransform t b = modifyFlags (setCFGTransform' t b)++setCFGTransform' :: CFGTransform -> Bool -> Flags -> Flags+setCFGTransform' t b f = f { optCFGTransforms = toggle t b (optCFGTransforms f) }++toggle :: Ord a => a -> Bool -> Set a -> Set a+toggle o True = Set.insert o+toggle o False = Set.delete o++--+-- * General utilities+--++readMaybe :: Read a => String -> Maybe a+readMaybe s = case reads s of+ [(x,"")] -> Just x+ _ -> Nothing++toEnumBounded :: (Bounded a, Enum a, Ord a) => Int -> Maybe a+toEnumBounded i = let mi = minBound+ ma = maxBound `asTypeOf` mi + in if i >= fromEnum mi && i <= fromEnum ma + then Just (toEnum i `asTypeOf` mi)+ else Nothing++splitBy :: (a -> Bool) -> [a] -> [[a]]+splitBy _ [] = []+splitBy p s = case break p s of+ (l, _ : t@(_ : _)) -> l : splitBy p t+ (l, _) -> [l]++instance Functor OptDescr where+ fmap f (Option cs ss d s) = Option cs ss (fmap f d) s++instance Functor ArgDescr where+ fmap f (NoArg x) = NoArg (f x)+ fmap f (ReqArg g s) = ReqArg (f . g) s+ fmap f (OptArg g s) = OptArg (f . g) s
@@ -0,0 +1,129 @@+-- | Shell IO: a monad that can restrict acesss to arbitrary IO and has the+-- ability to capture output that normally would be sent to stdout.+{-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts #-}+module GF.Infra.SIO(+ -- * The SIO monad+ SIO,MonadSIO(..),+ -- * Running SIO operations+ runSIO,hRunSIO,captureSIO,+ -- * Unrestricted, safe operations+ -- ** From the standard libraries+ getCPUTime,getCurrentDirectory,getLibraryDirectory,+ newStdGen,print,putStr,putStrLn,+ -- ** Specific to GF+ importGrammar,importSource,+#ifdef C_RUNTIME+ readPGF2,+#endif+ putStrLnFlush,runInterruptibly,lazySIO,+ -- * Restricted accesss to arbitrary (potentially unsafe) IO operations+ -- | If the environment variable GF_RESTRICTED is defined, these+ -- operations will fail. Otherwise, they will be executed normally.+ -- Output to stdout will /not/ be captured or redirected.+ restricted,restrictedSystem+ ) where+import Prelude hiding (putStr,putStrLn,print)+import Control.Applicative(Applicative(..))+import Control.Monad(liftM,ap)+import Control.Monad.Trans(MonadTrans(..))+import System.IO(hPutStr,hFlush,stdout)+import GF.System.Catch(try)+import System.Process(system)+import System.Environment(getEnv)+import Control.Concurrent.Chan(newChan,writeChan,getChanContents)+import GF.Infra.Concurrency(lazyIO)+import GF.Infra.UseIO(Output(..))+import qualified System.CPUTime as IO(getCPUTime)+import qualified System.Directory as IO(getCurrentDirectory)+import qualified System.Random as IO(newStdGen)+import qualified GF.Infra.UseIO as IO(getLibraryDirectory)+import qualified GF.System.Signal as IO(runInterruptibly)+import qualified GF.Command.Importing as GF(importGrammar, importSource)+#ifdef C_RUNTIME+import qualified PGF2+#endif++-- * The SIO monad++type PutStr = String -> IO ()+newtype SIO a = SIO {unS::PutStr->IO a}++instance Functor SIO where fmap = liftM++instance Applicative SIO where+ pure = return+ (<*>) = ap++instance Monad SIO where+ return x = SIO (const (return x))+ SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h++instance Output SIO where+ ePutStr = lift0 . ePutStr+ ePutStrLn = lift0 . ePutStrLn+ putStrLnE = putStrLnFlush+ putStrE = putStr++class {- Monad m => -} MonadSIO m where liftSIO :: SIO a -> m a+-- ^ If the Monad m superclass is included, then the generic instance+-- for monad transformers below would require UndecidableInstances++instance MonadSIO SIO where liftSIO = id++instance (MonadTrans t,Monad m,MonadSIO m) => MonadSIO (t m) where+ liftSIO = lift . liftSIO++-- * Running SIO operations++-- | Run normally+runSIO = hRunSIO stdout++-- | Redirect 'stdout' to the given handle+hRunSIO h sio = unS sio (\s->hPutStr h s>>hFlush h)++-- | Capture 'stdout'+captureSIO :: SIO a -> IO (String,a)+captureSIO sio = do ch <- newChan+ result <- unS sio (writeChan ch . Just)+ writeChan ch Nothing+ output <- fmap takeJust (getChanContents ch)+ return (output,result)+ where+ takeJust (Just xs:ys) = xs++takeJust ys+ takeJust _ = []++-- * Restricted accesss to arbitrary (potentially unsafe) IO operations++restricted io = SIO (const (restrictedIO io))+restrictedSystem = restricted . system++restrictedIO io =+ either (const io) (const $ fail message) =<< try (getEnv "GF_RESTRICTED")+ where+ message =+ "This operation is not allowed when GF is running in restricted mode."++-- * Unrestricted, safe IO operations++lift0 io = SIO $ const io+lift1 f io = SIO $ f . unS io++putStr = putStrFlush+putStrFlush s = SIO ($ s)+putStrLn = putStrLnFlush+putStrLnFlush s = putStr s >> putStrFlush "\n"+print x = putStrLn (show x)++getCPUTime = lift0 IO.getCPUTime+getCurrentDirectory = lift0 IO.getCurrentDirectory+getLibraryDirectory = lift0 . IO.getLibraryDirectory+newStdGen = lift0 IO.newStdGen+runInterruptibly = lift1 IO.runInterruptibly+lazySIO = lift1 lazyIO++importGrammar pgf opts files = lift0 $ GF.importGrammar pgf opts files+importSource opts files = lift0 $ GF.importSource opts files++#ifdef C_RUNTIME+readPGF2 = lift0 . PGF2.readPGF+#endif
@@ -0,0 +1,256 @@+----------------------------------------------------------------------+-- |+-- Module : UseIO+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/08/08 09:01:25 $ +-- > CVS $Author: peb $+-- > CVS $Revision: 1.17 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module GF.Infra.UseIO(-- ** Files and IO+ module GF.Infra.UseIO,+ -- *** Reused+ MonadIO(..),liftErr) where++import Prelude hiding (catch)++import GF.Data.Operations+import GF.Infra.Option+import GF.System.Catch+import Paths_gf(getDataDir)++import GF.System.Directory+import System.FilePath+import System.IO+import System.IO.Error(isUserError,ioeGetErrorString)+import System.Environment+import System.Exit+import System.CPUTime+--import System.Cmd+import Text.Printf+--import Control.Applicative(Applicative(..))+import Control.Monad(when,liftM,foldM)+import Control.Monad.Trans(MonadIO(..))+import Control.Monad.State(StateT,lift)+import Control.Exception(evaluate)+import Data.List (nub)++--putIfVerb :: MonadIO io => Options -> String -> io ()+putIfVerb opts msg = when (verbAtLeast opts Verbose) $ putStrLnE msg++-- *** GF files path and library path manipulation++type FileName = String+type InitPath = String -- ^ the directory portion of a pathname+type FullPath = String++gfLibraryPath = "GF_LIB_PATH"+gfGrammarPathVar = "GF_GRAMMAR_PATH"++getLibraryDirectory :: MonadIO io => Options -> io [FilePath]+getLibraryDirectory opts =+ case flag optGFLibPath opts of+ Just path -> return path+ Nothing -> liftM splitSearchPath $ liftIO (catch (getEnv gfLibraryPath)+ (\ex -> fmap (</> "lib") getDataDir))++getGrammarPath :: MonadIO io => [FilePath] -> io [FilePath]+getGrammarPath lib_dirs = liftIO $ do+ catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) + (\_ -> return $ concat [[lib_dir </> "alltenses", lib_dir </> "prelude"]+ | lib_dir <- lib_dirs ]) -- e.g. GF_GRAMMAR_PATH++-- | extends the search path with the+-- 'gfLibraryPath' and 'gfGrammarPathVar'+-- environment variables. Returns only existing paths.+extendPathEnv :: MonadIO io => Options -> io [FilePath]+extendPathEnv opts = liftIO $ do+ let opt_path = nub $ flag optLibraryPath opts -- e.g. paths given as options+ lib_dirs <- getLibraryDirectory opts -- e.g. GF_LIB_PATH+ grm_path <- getGrammarPath lib_dirs -- e.g. GF_GRAMMAR_PATH+ let paths = opt_path ++ lib_dirs ++ grm_path+ when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: opt_path is "++ show opt_path)+ when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: lib_dirs is "++ show lib_dirs)+ when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: grm_path is "++ show grm_path)+ ps <- liftM (nub . concat) $ mapM allSubdirs (nub paths)+ mapM canonicalizePath ps+ where+ allSubdirs :: FilePath -> IO [FilePath]+ allSubdirs [] = return [[]]+ allSubdirs p = case last p of+ '*' -> do let path = init p+ fs <- getSubdirs path+ let starpaths = [path </> f | f <- fs]+ when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: * found "++show starpaths)+ return starpaths+ _ -> do exists <- doesDirectoryExist p+ if exists+ then do+ when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: found path "++show p)+ return [p]+ else do when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: ignore path "++ show p)+ return []++getSubdirs :: FilePath -> IO [FilePath]+getSubdirs dir = do+ fs <- catch (getDirectoryContents dir) (const $ return [])+ foldM (\fs f -> do let fpath = dir </> f+ p <- getPermissions fpath+ if searchable p && not (take 1 f==".")+ then return (fpath:fs)+ else return fs ) [] fs++--------------------------------------------------------------------------------+justModuleName :: FilePath -> String+justModuleName = dropExtension . takeFileName++isGF,isGFO :: FilePath -> Bool+isGF = (== ".gf") . takeExtensions+isGFO = (== ".gfo") . takeExtensions++gfFile,gfoFile :: FilePath -> FilePath+gfFile f = addExtension f "gf"+gfoFile f = addExtension f "gfo"++gf2gfo :: Options -> FilePath -> FilePath+gf2gfo = gf2gfo' . flag optGFODir++gf2gfo' gfoDir file = maybe (gfoFile (dropExtension file))+ (\dir -> dir </> gfoFile (takeBaseName file))+ gfoDir+--------------------------------------------------------------------------------+splitInModuleSearchPath :: String -> [FilePath]+splitInModuleSearchPath s = case break isPathSep s of+ (f,_:cs) -> f : splitInModuleSearchPath cs+ (f,_) -> [f]+ where+ isPathSep :: Char -> Bool+ isPathSep c = c == ':' || c == ';'++--++-- *** Error handling in the IO monad++-- | Was: @newtype IOE a = IOE { appIOE :: IO (Err a) }@+type IOE a = IO a++--ioe :: IO (Err a) -> IOE a+--ioe io = err fail return =<< io++-- | Catch exceptions caused by calls to 'raise' or 'fail' in the 'IO' monad.+-- To catch all 'IO' exceptions, use 'try' instead.+tryIOE :: IOE a -> IO (Err a)+tryIOE ioe = handle (fmap Ok ioe) (return . Bad)++--runIOE :: IOE a -> IO a+--runIOE = id++-- instance MonadIO IOE where liftIO io = ioe (io >>= return . return)++-- | Make raise and handle mimic behaviour of the old IOE monad+instance ErrorMonad IO where+ raise = fail+ handle m h = catch m $ \ e -> if isUserError e+ then h (ioeGetErrorString e)+ else ioError e+{-+instance Functor IOE where fmap = liftM++instance Applicative IOE where+ pure = return+ (<*>) = ap++instance Monad IOE where+ return a = ioe (return (return a))+ IOE c >>= f = IOE $ do + x <- c -- Err a+ appIOE $ err raise f x -- f :: a -> IOE a+ fail = raise+-}++-- | Print the error message and return a default value if the IO operation 'fail's+useIOE :: a -> IOE a -> IO a+useIOE a ioe = handle ioe (\s -> putStrLn s >> return a)++maybeIO io = either (const Nothing) Just `fmap` liftIO (try io)+{-+--foldIOE :: (a -> b -> IOE a) -> a -> [b] -> IOE (a, Maybe String)+foldIOE f s xs = case xs of+ [] -> return (s,Nothing)+ x:xx -> do+ ev <- liftIO $ appIOE (f s x) + case ev of + Ok v -> foldIOE f v xx+ Bad m -> return $ (s, Just m)+-}+die :: String -> IO a+die s = do hPutStrLn stderr s+ exitFailure++-- *** Diagnostic output++class Monad m => Output m where+ ePutStr, ePutStrLn, putStrE, putStrLnE :: String -> m ()++instance Output IO where+ ePutStr s = hPutStr stderr s `catch` oops+ where oops _ = return () -- prevent crash on character encoding problem+ ePutStrLn s = hPutStrLn stderr s `catch` oops+ where oops _ = ePutStrLn "" -- prevent crash on character encoding problem+ putStrLnE s = putStrLn s >> hFlush stdout+ putStrE s = putStr s >> hFlush stdout+{-+instance Output IOE where+ ePutStr = liftIO . ePutStr+ ePutStrLn = liftIO . ePutStrLn+ putStrLnE = liftIO . putStrLnE+ putStrE = liftIO . putStrE+-}++instance Output m => Output (StateT s m) where+ ePutStr = lift . ePutStr+ ePutStrLn = lift . ePutStrLn+ putStrE = lift . putStrE+ putStrLnE = lift . putStrLnE++--putPointE :: Verbosity -> Options -> String -> IO a -> IO a+putPointE v opts msg act = do+ when (verbAtLeast opts v) $ putStrE msg++ (t,a) <- timeIt act++ if flag optShowCPUTime opts+ then do let msec = t `div` 1000000000+ putStrLnE (printf " %5d msec" msec)+ else when (verbAtLeast opts v) $ putStrLnE ""++ return a++-- | Because GHC adds the confusing text "user error" for failures caused by+-- calls to 'fail'.+ioErrorText e = if isUserError e+ then ioeGetErrorString e+ else show e++-- *** Timing++timeIt act =+ do t1 <- liftIO $ getCPUTime+ a <- liftIO . evaluate =<< act+ t2 <- liftIO $ getCPUTime+ return (t2-t1,a)++-- *** File IO++writeUTF8File :: FilePath -> String -> IO ()+writeUTF8File fpath content =+ withFile fpath WriteMode $ \ h -> do hSetEncoding h utf8+ hPutStr h content++readBinaryFile path = hGetContents =<< openBinaryFile path ReadMode+writeBinaryFile path s = withBinaryFile path WriteMode (flip hPutStr s)
@@ -0,0 +1,439 @@+{-# LANGUAGE CPP, ScopedTypeVariables, FlexibleInstances #-}+-- | GF interactive mode+module GF.Interactive (mainGFI,mainRunGFI,mainServerGFI) where+import Prelude hiding (putStrLn,print)+import qualified Prelude as P(putStrLn)+import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine)+--import GF.Command.Importing(importSource,importGrammar)+import GF.Command.Commands(PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands)+import GF.Command.CommonCommands(commonCommands,extend)+import GF.Command.SourceCommands+import GF.Command.CommandInfo+import GF.Command.Help(helpCommand)+import GF.Command.Abstract+import GF.Command.Parse(readCommandLine,pCommand)+import GF.Data.Operations (Err(..),done)+import GF.Data.Utilities(whenM,repeatM)+import GF.Grammar hiding (Ident,isPrefixOf)+import GF.Infra.UseIO(ioErrorText,putStrLnE)+import GF.Infra.SIO+import GF.Infra.Option+import qualified System.Console.Haskeline as Haskeline+--import GF.Text.Coding(decodeUnicode,encodeUnicode)++--import GF.Compile.Coding(codeTerm)++import PGF+import PGF.Internal(abstract,funs,lookStartCat,emptyPGF)++import Data.Char+import Data.List(isPrefixOf)+import qualified Data.Map as Map+import qualified Text.ParserCombinators.ReadP as RP+--import System.IO(utf8)+--import System.CPUTime(getCPUTime)+import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)+import Control.Exception(SomeException,fromException,evaluate,try)+import Control.Monad.State hiding (void)+import qualified GF.System.Signal as IO(runInterruptibly)+#ifdef SERVER_MODE+import GF.Server(server)+#endif++import GF.Command.Messages(welcome)++-- | Run the GF Shell in quiet mode (@gf -run@).+mainRunGFI :: Options -> [FilePath] -> IO ()+mainRunGFI opts files = shell (beQuiet opts) files++beQuiet = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet}))++-- | Run the interactive GF Shell+mainGFI :: Options -> [FilePath] -> IO ()+mainGFI opts files = do+ P.putStrLn welcome+ shell opts files++shell opts files = flip evalStateT (emptyGFEnv opts) $+ do mapStateT runSIO $ importInEnv opts files+ loop++#ifdef SERVER_MODE+-- | Run the GF Server (@gf -server@).+-- The 'Int' argument is the port number for the HTTP service.+mainServerGFI opts0 port files =+ server jobs port root execute1' . snd+ =<< runSIO (runStateT (importInEnv opts files) (emptyGFEnv opts))+ where+ root = flag optDocumentRoot opts+ opts = beQuiet opts0+ jobs = join (flag optJobs opts)++ execute1' gfenv0 cmd =+ do (continue,gfenv) <- runStateT (execute1 cmd) gfenv0+ return $ if continue then Just gfenv else Nothing+#else+mainServerGFI opts port files =+ error "GF has not been compiled with server mode support"+#endif++-- | Read end execute commands until it is time to quit+loop :: StateT GFEnv IO ()+loop = repeatM readAndExecute1++-- | Read and execute one command, returning 'True' to continue execution,+-- | 'False' when it is time to quit+readAndExecute1 :: StateT GFEnv IO Bool+readAndExecute1 = mapStateT runSIO . execute1 =<< readCommand++-- | Read a command+readCommand :: StateT GFEnv IO String+readCommand =+ do opts <- gets startOpts+ case flag optMode opts of+ ModeRun -> lift tryGetLine+ _ -> lift . fetchCommand =<< get++timeIt act =+ do t1 <- liftSIO $ getCPUTime+ a <- act+ t2 <- liftSIO $ getCPUTime+ return (t2-t1,a)++-- | Optionally show how much CPU time was used to run an IO action+optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a+optionallyShowCPUTime opts act + | not (verbAtLeast opts Normal) = act+ | otherwise = do (dt,r) <- timeIt act+ liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"+ return r+++type ShellM = StateT GFEnv SIO++-- | Execute a given command line, returning 'True' to continue execution,+-- | 'False' when it is time to quit+execute1, execute1' :: String -> ShellM Bool+execute1 s0 =+ do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0}+ execute1' s0++-- | Execute a given command line, without adding it to the history+execute1' s0 =+ do opts <- gets startOpts+ interruptible $ optionallyShowCPUTime opts $+ case pwords s0 of+ -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands+ -- special commands+ "q" :_ -> quit+ "!" :ws -> system_command ws+ "eh":ws -> execute_history ws+ "i" :ws -> do import_ ws; continue+ -- other special commands, working on GFEnv+ "dc":ws -> define_command ws+ "dt":ws -> define_tree ws+ -- ordinary commands+ _ -> do env <- gets commandenv+ interpretCommandLine env s0+ continue+ where+ continue,stop :: ShellM Bool+ continue = return True+ stop = return False++ interruptible :: ShellM Bool -> ShellM Bool+ interruptible act =+ do gfenv <- get+ mapStateT (+ either (\e -> printException e >> return (True,gfenv)) return+ <=< runInterruptibly) act++ -- Special commands:++ quit = do opts <- gets startOpts+ when (verbAtLeast opts Normal) $ putStrLnE "See you."+ stop++ system_command ws = do lift $ restrictedSystem $ unwords ws ; continue+++ {-"eh":w:_ -> do+ cs <- readFile w >>= return . map words . lines+ gfenv' <- foldM (flip (process False benv)) gfenv cs+ loopNewCPU gfenv' -}+ execute_history [w] =+ do execute . lines =<< lift (restricted (readFile w))+ continue+ where+ execute [] = done+ execute (line:lines) = whenM (execute1' line) (execute lines)++ execute_history _ =+ do putStrLnE "eh command not parsed"+ continue++ define_command (f:ws) =+ case readCommandLine (unwords ws) of+ Just comm ->+ do modify $+ \ gfenv ->+ let env = commandenv gfenv+ in gfenv {+ commandenv = env {+ commandmacros = Map.insert f comm (commandmacros env)+ }+ }+ continue+ _ -> dc_not_parsed+ define_command _ = dc_not_parsed++ dc_not_parsed = putStrLnE "command definition not parsed" >> continue++ define_tree (f:ws) =+ case readExpr (unwords ws) of+ Just exp ->+ do modify $+ \ gfenv ->+ let env = commandenv gfenv+ in gfenv { commandenv = env {+ expmacros = Map.insert f exp (expmacros env) } }+ continue+ _ -> dt_not_parsed+ define_tree _ = dt_not_parsed++ dt_not_parsed = putStrLnE "value definition not parsed" >> continue++pwords s = case words s of+ w:ws -> getCommandOp w :ws+ ws -> ws++import_ args =+ do case parseOptions args of+ Ok (opts',files) -> do+ opts <- gets startOpts+ curr_dir <- lift getCurrentDirectory+ lib_dir <- lift $ getLibraryDirectory (addOptions opts opts')+ importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files+ Bad err -> putStrLnE $ "Command parse error: " ++ err++-- | Commands that work on 'GFEnv'+moreCommands = [+ ("e", emptyCommandInfo {+ longname = "empty",+ synopsis = "empty the environment (except the command history)",+ exec = \ _ _ ->+ do modify $ \ gfenv -> (emptyGFEnv (startOpts gfenv))+ { history=history gfenv }+ return void+ }),+ ("ph", emptyCommandInfo {+ longname = "print_history",+ synopsis = "print command history",+ explanation = unlines [+ "Prints the commands issued during the GF session.",+ "The result is readable by the eh command.",+ "The result can be used as a script when starting GF."+ ],+ examples = [+ mkEx "ph | wf -file=foo.gfs -- save the history into a file"+ ],+ exec = \ _ _ ->+ fmap (fromString . unlines . reverse . drop 1 . history) get+ }),+ ("r", emptyCommandInfo {+ longname = "reload",+ synopsis = "repeat the latest import command",+ exec = \ _ _ ->+ do gfenv0 <- get+ let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]+ case imports of+ (s,ws):_ -> do+ putStrLnE $ "repeating latest import: " ++ s+ import_ ws+ return void+ _ -> do putStrLnE $ "no import in history"+ return void+ })+ ]+++printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)++fetchCommand :: GFEnv -> IO String+fetchCommand gfenv = do+ path <- getAppUserDataDirectory "gf_history"+ let settings =+ Haskeline.Settings {+ Haskeline.complete = wordCompletion gfenv,+ Haskeline.historyFile = Just path,+ Haskeline.autoAddHistory = True+ }+ res <- IO.runInterruptibly $ Haskeline.runInputT settings (Haskeline.getInputLine (prompt gfenv))+ case res of+ Left _ -> return ""+ Right Nothing -> return "q"+ Right (Just s) -> return s++importInEnv :: Options -> [FilePath] -> ShellM ()+importInEnv opts files =+ do pgf0 <- gets multigrammar+ if flag optRetainResource opts+ then do src <- lift $ importSource opts files+ pgf <- lift . lazySIO $ importPGF pgf0 -- duplicates some work, better to link src+ modify $ \ gfenv -> gfenv {retain=True, pgfenv = (src,pgfEnv pgf)}+ else do pgf1 <- lift $ importPGF pgf0+ modify $ \ gfenv->gfenv { retain=False,+ pgfenv = (emptyGrammar,pgfEnv pgf1) }+ where+ importPGF pgf0 =+ do let opts' = addOptions (setOptimization OptCSE False) opts+ pgf1 <- importGrammar pgf0 opts' files+ if (verbAtLeast opts Normal)+ then putStrLnFlush $+ unwords $ "\nLanguages:" : map showCId (languages pgf1)+ else done+ return pgf1++tryGetLine = do+ res <- try getLine+ case res of+ Left (e :: SomeException) -> return "q"+ Right l -> return l++prompt env+ | retain env || abs == wildCId = "> "+ | otherwise = showCId abs ++ "> "+ where+ abs = abstractName (multigrammar env)++type CmdEnv = (Grammar,PGFEnv)++data GFEnv = GFEnv {+ startOpts :: Options,+ retain :: Bool, -- grammar was imported with -retain flag+ pgfenv :: CmdEnv,+ commandenv :: CommandEnv ShellM,+ history :: [String]+ }++emptyGFEnv opts = GFEnv opts False emptyCmdEnv emptyCommandEnv []++emptyCmdEnv = (emptyGrammar,pgfEnv emptyPGF)++emptyCommandEnv = mkCommandEnv allCommands+multigrammar = pgf . snd . pgfenv++allCommands =+ extend pgfCommands (helpCommand allCommands:moreCommands)+ `Map.union` sourceCommands+ `Map.union` commonCommands++instance HasGrammar ShellM where getGrammar = gets (fst . pgfenv)+instance HasPGFEnv ShellM where getPGFEnv = gets (snd . pgfenv)++wordCompletion gfenv (left,right) = do+ case wc_type (reverse left) of+ CmplCmd pref+ -> ret (length pref) [Haskeline.simpleCompletion name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]+ CmplStr (Just (Command _ opts _)) s0+ -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optType opts)))+ case mb_state0 of+ Right state0 -> let (rprefix,rs) = break isSpace (reverse s0)+ s = reverse rs+ prefix = reverse rprefix+ ws = words s+ in case loop state0 ws of+ Nothing -> ret 0 []+ Just state -> let compls = getCompletions state prefix+ in ret (length prefix) (map (\x -> Haskeline.simpleCompletion x) (Map.keys compls))+ Left (_ :: SomeException) -> ret 0 []+ CmplOpt (Just (Command n _ _)) pref+ -> case Map.lookup n (commands cmdEnv) of+ Just inf -> do let flg_compls = [Haskeline.Completion ('-':flg++"=") ('-':flg) False | (flg,_) <- flags inf, isPrefixOf pref flg]+ opt_compls = [Haskeline.Completion ('-':opt) ('-':opt) True | (opt,_) <- options inf, isPrefixOf pref opt]+ ret (length pref+1)+ (flg_compls++opt_compls)+ Nothing -> ret (length pref) []+ CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i+ -> Haskeline.completeFilename (left,right)+ CmplIdent _ pref+ -> do mb_abs <- try (evaluate (abstract pgf))+ case mb_abs of+ Right abs -> ret (length pref) [Haskeline.simpleCompletion name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name]+ Left (_ :: SomeException) -> ret (length pref) []+ _ -> ret 0 []+ where+ pgf = multigrammar gfenv+ cmdEnv = commandenv gfenv+ optLang opts = valCIdOpts "lang" (head (languages pgf)) opts+ optType opts = + let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts+ in case readType str of+ Just ty -> ty+ Nothing -> error ("Can't parse '"++str++"' as type")++ loop ps [] = Just ps+ loop ps (t:ts) = case nextState ps (simpleParseInput t) of+ Left es -> Nothing+ Right ps -> loop ps ts++ ret len xs = return (drop len left,xs)+++data CompletionType+ = CmplCmd Ident+ | CmplStr (Maybe Command) String+ | CmplOpt (Maybe Command) Ident+ | CmplIdent (Maybe Command) Ident+ deriving Show++wc_type :: String -> CompletionType+wc_type = cmd_name+ where+ cmd_name cs =+ let cs1 = dropWhile isSpace cs+ in go cs1 cs1+ where+ go x [] = CmplCmd x+ go x (c:cs)+ | isIdent c = go x cs+ | otherwise = cmd x cs++ cmd x [] = ret CmplIdent x "" 0+ cmd _ ('|':cs) = cmd_name cs+ cmd _ (';':cs) = cmd_name cs+ cmd x ('"':cs) = str x cs cs+ cmd x ('-':cs) = option x cs cs+ cmd x (c :cs)+ | isIdent c = ident x (c:cs) cs+ | otherwise = cmd x cs++ option x y [] = ret CmplOpt x y 1+ option x y ('=':cs) = optValue x y cs+ option x y (c :cs)+ | isIdent c = option x y cs+ | otherwise = cmd x cs+ + optValue x y ('"':cs) = str x y cs+ optValue x y cs = cmd x cs++ ident x y [] = ret CmplIdent x y 0+ ident x y (c:cs)+ | isIdent c = ident x y cs+ | otherwise = cmd x cs++ str x y [] = ret CmplStr x y 1+ str x y ('\"':cs) = cmd x cs+ str x y ('\\':c:cs) = str x y cs+ str x y (c:cs) = str x y cs++ ret f x y d = f cmd y+ where+ x1 = take (length x - length y - d) x+ x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1+ + cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of+ [x] -> Just x+ _ -> Nothing++ isIdent c = c == '_' || c == '\'' || isAlphaNum c
@@ -0,0 +1,445 @@+{-# LANGUAGE CPP, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}+-- | GF interactive mode (with the C run-time system)+module GF.Interactive2 (mainGFI,mainRunGFI{-,mainServerGFI-}) where+import Prelude hiding (putStrLn,print)+import qualified Prelude as P(putStrLn)+import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,interpretCommandLine)+import GF.Command.Commands2(PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands)+import GF.Command.CommonCommands+import GF.Command.CommandInfo+import GF.Command.Help(helpCommand)+import GF.Command.Abstract+import GF.Command.Parse(readCommandLine,pCommand)+import GF.Data.Operations (Err(..),done)+import GF.Data.Utilities(whenM,repeatM)++import GF.Infra.UseIO(ioErrorText,putStrLnE)+import GF.Infra.SIO+import GF.Infra.Option+import qualified System.Console.Haskeline as Haskeline+--import GF.Text.Coding(decodeUnicode,encodeUnicode)++--import GF.Compile.Coding(codeTerm)++import qualified PGF2 as C+import qualified PGF as H++import Data.Char+import Data.List(isPrefixOf)+import qualified Data.Map as Map++import qualified Text.ParserCombinators.ReadP as RP+--import System.IO(utf8)+--import System.CPUTime(getCPUTime)+import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)+import System.FilePath(takeExtensions)+import Control.Exception(SomeException,fromException,try)+--import Control.Monad+import Control.Monad.State hiding (void)++import qualified GF.System.Signal as IO(runInterruptibly)+{-+#ifdef SERVER_MODE+import GF.Server(server)+#endif+-}++import GF.Command.Messages(welcome)++-- | Run the GF Shell in quiet mode (@gf -run@).+mainRunGFI :: Options -> [FilePath] -> IO ()+mainRunGFI opts files = shell (beQuiet opts) files++beQuiet = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet}))++-- | Run the interactive GF Shell+mainGFI :: Options -> [FilePath] -> IO ()+mainGFI opts files = do+ P.putStrLn welcome+ P.putStrLn "This shell uses the C run-time system. See help for available commands."+ shell opts files++shell opts files = flip evalStateT (emptyGFEnv opts) $+ do mapStateT runSIO $ importInEnv opts files+ loop++{-+#ifdef SERVER_MODE+-- | Run the GF Server (@gf -server@).+-- The 'Int' argument is the port number for the HTTP service.+mainServerGFI opts0 port files =+ server jobs port root (execute1 opts)+ =<< runSIO (importInEnv (emptyGFEnv opts) opts files)+ where+ root = flag optDocumentRoot opts+ opts = beQuiet opts0+ jobs = join (flag optJobs opts)+#else+mainServerGFI opts port files =+ error "GF has not been compiled with server mode support"+#endif+-}+-- | Read end execute commands until it is time to quit+loop :: StateT GFEnv IO ()+loop = repeatM readAndExecute1++-- | Read and execute one command, returning 'True' to continue execution,+-- | 'False' when it is time to quit+readAndExecute1 :: StateT GFEnv IO Bool+readAndExecute1 = mapStateT runSIO . execute1 =<< readCommand++-- | Read a command+readCommand :: StateT GFEnv IO String+readCommand =+ do opts <- gets startOpts+ case flag optMode opts of+ ModeRun -> lift tryGetLine+ _ -> lift . fetchCommand =<< get++timeIt act =+ do t1 <- liftSIO $ getCPUTime+ a <- act+ t2 <- liftSIO $ getCPUTime+ return (t2-t1,a)++-- | Optionally show how much CPU time was used to run an IO action+optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a+optionallyShowCPUTime opts act + | not (verbAtLeast opts Normal) = act+ | otherwise = do (dt,r) <- timeIt act+ liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"+ return r++type ShellM = StateT GFEnv SIO++-- | Execute a given command line, returning 'True' to continue execution,+-- | 'False' when it is time to quit+execute1 :: String -> ShellM Bool+execute1 s0 =+ do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0}+ execute1' s0++-- | Execute a given command line, without adding it to the history+execute1' s0 =+ do opts <- gets startOpts+ interruptible $ optionallyShowCPUTime opts $+ case pwords s0 of+ -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands+ -- special commands+ "q" :_ -> quit+ "!" :ws -> system_command ws+ "eh":ws -> execute_history ws+ "i" :ws -> do import_ ws; continue+ -- other special commands, working on GFEnv+ "dc":ws -> define_command ws+ "dt":ws -> define_tree ws+ -- ordinary commands+ _ -> do env <- gets commandenv+ interpretCommandLine env s0+ continue+ where+ continue,stop :: ShellM Bool+ continue = return True+ stop = return False++ interruptible :: ShellM Bool -> ShellM Bool+ interruptible act =+ do gfenv <- get+ mapStateT (+ either (\e -> printException e >> return (True,gfenv)) return+ <=< runInterruptibly) act++ -- Special commands:++ quit = do opts <- gets startOpts+ when (verbAtLeast opts Normal) $ putStrLnE "See you."+ stop++ system_command ws = do lift $ restrictedSystem $ unwords ws ; continue+++ {-"eh":w:_ -> do+ cs <- readFile w >>= return . map words . lines+ gfenv' <- foldM (flip (process False benv)) gfenv cs+ loopNewCPU gfenv' -}+ execute_history [w] =+ do execute . lines =<< lift (restricted (readFile w))+ continue+ where+ execute :: [String] -> ShellM ()+ execute [] = done+ execute (line:lines) = whenM (execute1' line) (execute lines)++ execute_history _ =+ do putStrLnE "eh command not parsed"+ continue++ define_command (f:ws) =+ case readCommandLine (unwords ws) of+ Just comm ->+ do modify $+ \ gfenv ->+ let env = commandenv gfenv+ in gfenv {+ commandenv = env {+ commandmacros = Map.insert f comm (commandmacros env)+ }+ }+ continue+ _ -> dc_not_parsed+ define_command _ = dc_not_parsed++ dc_not_parsed = putStrLnE "command definition not parsed" >> continue++ define_tree (f:ws) =+ case H.readExpr (unwords ws) of+ Just exp ->+ do modify $+ \ gfenv ->+ let env = commandenv gfenv+ in gfenv { commandenv = env {+ expmacros = Map.insert f exp (expmacros env) } }+ continue+ _ -> dt_not_parsed+ define_tree _ = dt_not_parsed++ dt_not_parsed = putStrLnE "value definition not parsed" >> continue++pwords s = case words s of+ w:ws -> getCommandOp w :ws+ ws -> ws+import_ args =+ do case parseOptions args of+ Ok (opts',files) -> do+ opts <- gets startOpts+ curr_dir <- lift getCurrentDirectory+ lib_dir <- lift $ getLibraryDirectory (addOptions opts opts')+ importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files+ Bad err ->+ do putStrLnE $ "Command parse error: " ++ err++-- | Commands that work on 'GFEnv'+moreCommands = [+ ("e", emptyCommandInfo {+ longname = "empty",+ synopsis = "empty the environment (except the command history)",+ exec = \ _ _ ->+ do modify $ \ gfenv -> (emptyGFEnv (startOpts gfenv))+ { history=history gfenv }+ return void+ }),+ ("ph", emptyCommandInfo {+ longname = "print_history",+ synopsis = "print command history",+ explanation = unlines [+ "Prints the commands issued during the GF session.",+ "The result is readable by the eh command.",+ "The result can be used as a script when starting GF."+ ],+ examples = [+ mkEx "ph | wf -file=foo.gfs -- save the history into a file"+ ],+ exec = \ _ _ ->+ fmap (fromString . unlines . reverse . drop 1 . history) get+ }),+ ("r", emptyCommandInfo {+ longname = "reload",+ synopsis = "repeat the latest import command",+ exec = \ _ _ ->+ do gfenv0 <- get+ let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]+ case imports of+ (s,ws):_ -> do+ putStrLnE $ "repeating latest import: " ++ s+ import_ ws+ _ -> do+ putStrLnE $ "no import in history"+ return void+ })+ ]+++printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)++fetchCommand :: GFEnv -> IO String+fetchCommand gfenv = do+ path <- getAppUserDataDirectory "gf_history"+ let settings =+ Haskeline.Settings {+ Haskeline.complete = wordCompletion gfenv,+ Haskeline.historyFile = Just path,+ Haskeline.autoAddHistory = True+ }+ res <- IO.runInterruptibly $ Haskeline.runInputT settings (Haskeline.getInputLine (prompt gfenv))+ case res of+ Left _ -> return ""+ Right Nothing -> return "q"+ Right (Just s) -> return s++importInEnv :: Options -> [FilePath] -> ShellM ()+importInEnv opts files =+ case files of+ _ | flag optRetainResource opts ->+ putStrLnE "Flag -retain is not supported in this shell"+ [file] | takeExtensions file == ".pgf" -> importPGF file+ [] -> done+ _ -> do putStrLnE "Can only import one .pgf file"+ where+ importPGF file =+ do gfenv <- get+ case multigrammar gfenv of+ Just _ -> putStrLnE "Discarding previous grammar"+ _ -> done+ pgf1 <- lift $ readPGF2 file+ let gfenv' = gfenv { pgfenv = pgfEnv pgf1 }+ when (verbAtLeast opts Normal) $+ let langs = Map.keys . concretes $ gfenv'+ in putStrLnE . unwords $ "\nLanguages:":langs+ put gfenv'++tryGetLine = do+ res <- try getLine+ case res of+ Left (e :: SomeException) -> return "q"+ Right l -> return l++prompt env = abs ++ "> "+ where+ abs = maybe "" C.abstractName (multigrammar env)++data GFEnv = GFEnv {+ startOpts :: Options,+ --grammar :: (), -- gfo grammar -retain+ --retain :: (), -- grammar was imported with -retain flag+ pgfenv :: PGFEnv,+ commandenv :: CommandEnv ShellM,+ history :: [String]+ }++emptyGFEnv opts = GFEnv opts {-() ()-} emptyPGFEnv emptyCommandEnv []++emptyCommandEnv = mkCommandEnv allCommands+multigrammar = pgf . pgfenv+concretes = concs . pgfenv++allCommands =+ extend pgfCommands (helpCommand allCommands:moreCommands)+ `Map.union` commonCommands++instance HasPGFEnv ShellM where getPGFEnv = gets pgfenv++-- ** Completion++wordCompletion gfenv (left,right) = do+ case wc_type (reverse left) of+ CmplCmd pref+ -> ret (length pref) [Haskeline.simpleCompletion name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]+{-+ CmplStr (Just (Command _ opts _)) s0+ -> do mb_state0 <- try (evaluate (H.initState pgf (optLang opts) (optType opts)))+ case mb_state0 of+ Right state0 -> let (rprefix,rs) = break isSpace (reverse s0)+ s = reverse rs+ prefix = reverse rprefix+ ws = words s+ in case loop state0 ws of+ Nothing -> ret 0 []+ Just state -> let compls = H.getCompletions state prefix+ in ret (length prefix) (map (\x -> Haskeline.simpleCompletion x) (Map.keys compls))+ Left (_ :: SomeException) -> ret 0 []+-}+ CmplOpt (Just (Command n _ _)) pref+ -> case Map.lookup n (commands cmdEnv) of+ Just inf -> do let flg_compls = [Haskeline.Completion ('-':flg++"=") ('-':flg) False | (flg,_) <- flags inf, isPrefixOf pref flg]+ opt_compls = [Haskeline.Completion ('-':opt) ('-':opt) True | (opt,_) <- options inf, isPrefixOf pref opt]+ ret (length pref+1)+ (flg_compls++opt_compls)+ Nothing -> ret (length pref) []+ CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i+ -> Haskeline.completeFilename (left,right)++ CmplIdent _ pref+ -> case mb_pgf of+ Just pgf -> ret (length pref)+ [Haskeline.simpleCompletion name + | name <- C.functions pgf,+ isPrefixOf pref name]+ _ -> ret (length pref) []++ _ -> ret 0 []+ where+ mb_pgf = multigrammar gfenv+ cmdEnv = commandenv gfenv+{-+ optLang opts = valStrOpts "lang" (head $ Map.keys (concretes cmdEnv)) opts+ optType opts = + let str = valStrOpts "cat" (H.showCId $ H.lookStartCat pgf) opts+ in case H.readType str of+ Just ty -> ty+ Nothing -> error ("Can't parse '"++str++"' as type")++ loop ps [] = Just ps+ loop ps (t:ts) = case H.nextState ps (H.simpleParseInput t) of+ Left es -> Nothing+ Right ps -> loop ps ts+-}+ ret len xs = return (drop len left,xs)+++data CompletionType+ = CmplCmd Ident+ | CmplStr (Maybe Command) String+ | CmplOpt (Maybe Command) Ident+ | CmplIdent (Maybe Command) Ident+ deriving Show++wc_type :: String -> CompletionType+wc_type = cmd_name+ where+ cmd_name cs =+ let cs1 = dropWhile isSpace cs+ in go cs1 cs1+ where+ go x [] = CmplCmd x+ go x (c:cs)+ | isIdent c = go x cs+ | otherwise = cmd x cs++ cmd x [] = ret CmplIdent x "" 0+ cmd _ ('|':cs) = cmd_name cs+ cmd _ (';':cs) = cmd_name cs+ cmd x ('"':cs) = str x cs cs+ cmd x ('-':cs) = option x cs cs+ cmd x (c :cs)+ | isIdent c = ident x (c:cs) cs+ | otherwise = cmd x cs++ option x y [] = ret CmplOpt x y 1+ option x y ('=':cs) = optValue x y cs+ option x y (c :cs)+ | isIdent c = option x y cs+ | otherwise = cmd x cs+ + optValue x y ('"':cs) = str x y cs+ optValue x y cs = cmd x cs++ ident x y [] = ret CmplIdent x y 0+ ident x y (c:cs)+ | isIdent c = ident x y cs+ | otherwise = cmd x cs++ str x y [] = ret CmplStr x y 1+ str x y ('\"':cs) = cmd x cs+ str x y ('\\':c:cs) = str x y cs+ str x y (c:cs) = str x y cs++ ret f x y d = f cmd y+ where+ x1 = take (length x - length y - d) x+ x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1+ + cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of+ [x] -> Just x+ _ -> Nothing++ isIdent c = c == '_' || c == '\'' || isAlphaNum c
@@ -0,0 +1,61 @@+module GF.JavaScript.AbsJS where++-- Haskell module generated by the BNF converter++newtype Ident = Ident String deriving (Eq,Ord,Show)+data Program =+ Program [Element]+ deriving (Eq,Ord,Show)++data Element =+ FunDef Ident [Ident] [Stmt]+ | ElStmt Stmt+ deriving (Eq,Ord,Show)++data Stmt =+ SCompound [Stmt]+ | SReturnVoid+ | SReturn Expr+ | SDeclOrExpr DeclOrExpr+ deriving (Eq,Ord,Show)++data DeclOrExpr =+ Decl [DeclVar]+ | DExpr Expr+ deriving (Eq,Ord,Show)++data DeclVar =+ DVar Ident+ | DInit Ident Expr+ deriving (Eq,Ord,Show)++data Expr =+ EAssign Expr Expr+ | ENew Ident [Expr]+ | EMember Expr Ident+ | EIndex Expr Expr+ | ECall Expr [Expr]+ | EVar Ident+ | EInt Int+ | EDbl Double+ | EStr String+ | ETrue+ | EFalse+ | ENull+ | EThis+ | EFun [Ident] [Stmt]+ | EArray [Expr]+ | EObj [Property]+ | ESeq [Expr]+ deriving (Eq,Ord,Show)++data Property =+ Prop PropertyName Expr+ deriving (Eq,Ord,Show)++data PropertyName =+ IdentPropName Ident+ | StringPropName String+ | IntPropName Int+ deriving (Eq,Ord,Show)+
@@ -0,0 +1,55 @@+entrypoints Program;++Program. Program ::= [Element];++FunDef. Element ::= "function" Ident "(" [Ident] ")" "{" [Stmt] "}" ;+ElStmt. Element ::= Stmt;+separator Element "" ;++separator Ident "," ;++SCompound. Stmt ::= "{" [Stmt] "}" ;+SReturnVoid. Stmt ::= "return" ";" ;+SReturn. Stmt ::= "return" Expr ";" ;+SDeclOrExpr. Stmt ::= DeclOrExpr ";" ;+separator Stmt "" ;++Decl. DeclOrExpr ::= "var" [DeclVar];+DExpr. DeclOrExpr ::= Expr1 ;++DVar. DeclVar ::= Ident ;+DInit. DeclVar ::= Ident "=" Expr ;+separator DeclVar "," ;++EAssign. Expr13 ::= Expr14 "=" Expr13 ;++ENew. Expr14 ::= "new" Ident "(" [Expr] ")" ;++EMember. Expr15 ::= Expr15 "." Ident ;+EIndex. Expr15 ::= Expr15 "[" Expr "]" ;+ECall. Expr15 ::= Expr15 "(" [Expr] ")" ;++EVar. Expr16 ::= Ident ;+EInt. Expr16 ::= Integer ;+EDbl. Expr16 ::= Double ;+EStr. Expr16 ::= String ;+ETrue. Expr16 ::= "true" ;+EFalse. Expr16 ::= "false" ;+ENull. Expr16 ::= "null" ;+EThis. Expr16 ::= "this" ;+EFun. Expr16 ::= "function" "(" [Ident] ")" "{" [Stmt] "}" ;+EArray. Expr16 ::= "[" [Expr] "]" ;+EObj. Expr16 ::= "{" [Property] "}" ;++eseq1. Expr16 ::= "(" Expr "," [Expr] ")";+internal ESeq. Expr16 ::= "(" [Expr] ")" ;+define eseq1 x xs = ESeq (x:xs); ++separator Expr "," ;+coercions Expr 16 ;++Prop. Property ::= PropertyName ":" Expr ;+separator Property "," ;++IdentPropName. PropertyName ::= Ident ;+StringPropName. PropertyName ::= String ;
@@ -0,0 +1,132 @@+-- -*- haskell -*-+-- This Alex file was machine-generated by the BNF converter+{+{-# OPTIONS -fno-warn-incomplete-patterns #-}+module GF.JavaScript.LexJS where+++}+++$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME+$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME+$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME+$d = [0-9] -- digit+$i = [$l $d _ '] -- identifier character+$u = [\0-\255] -- universal: any character++@rsyms = -- symbols and non-identifier-like reserved words+ \( | \) | \{ | \} | \, | \; | \= | \. | \[ | \] | \:++:-++$white+ ;+@rsyms { tok (\p s -> PT p (TS $ share s)) }++$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }++$d+ { tok (\p s -> PT p (TI $ share s)) }+$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }++{++tok f p s = f p s++share :: String -> String+share = id++data Tok =+ TS !String -- reserved words and symbols+ | TL !String -- string literals+ | TI !String -- integer literals+ | TV !String -- identifiers+ | TD !String -- double precision float literals+ | TC !String -- character literals++ deriving (Eq,Show,Ord)++data Token = + PT Posn Tok+ | Err Posn+ deriving (Eq,Show,Ord)++tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l+tokenPos _ = "end of file"++posLineCol (Pn _ l c) = (l,c)+mkPosToken t@(PT p _) = (posLineCol p, prToken t)++prToken t = case t of+ PT _ (TS s) -> s+ PT _ (TI s) -> s+ PT _ (TV s) -> s+ PT _ (TD s) -> s+ PT _ (TC s) -> s++ _ -> show t++data BTree = N | B String Tok BTree BTree deriving (Show)++eitherResIdent :: (String -> Tok) -> String -> Tok+eitherResIdent tv s = treeFind resWords+ where+ treeFind N = tv s+ treeFind (B a t left right) | s < a = treeFind left+ | s > a = treeFind right+ | s == a = t++resWords = b "return" (b "new" (b "function" (b "false" N N) N) (b "null" N N)) (b "true" (b "this" N N) (b "var" N N))+ where b s = B s (TS s)++unescapeInitTail :: String -> String+unescapeInitTail = unesc . tail where+ unesc s = case s of+ '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs+ '\\':'n':cs -> '\n' : unesc cs+ '\\':'t':cs -> '\t' : unesc cs+ '"':[] -> []+ c:cs -> c : unesc cs+ _ -> []++-------------------------------------------------------------------+-- Alex wrapper code.+-- A modified "posn" wrapper.+-------------------------------------------------------------------++data Posn = Pn !Int !Int !Int+ deriving (Eq, Show,Ord)++alexStartPos :: Posn+alexStartPos = Pn 0 1 1++alexMove :: Posn -> Char -> Posn+alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1+alexMove (Pn a l c) _ = Pn (a+1) l (c+1)++type AlexInput = (Posn, -- current position,+ Char, -- previous char+ String) -- current input string++tokens :: String -> [Token]+tokens str = go (alexStartPos, '\n', str)+ where+ go :: (Posn, Char, String) -> [Token]+ go inp@(pos, _, str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError (pos, _, _) -> [Err pos]+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act pos (take len str) : (go inp')++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p, c, []) = Nothing+alexGetChar (p, _, (c:s)) =+ let p' = alexMove p c+ in p' `seq` Just (c, (p', c, s))++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p, c, s) = c+}
@@ -0,0 +1,14 @@+all:+ happy -gca ParJS.y+ alex -g LexJS.x++bnfc:+ (cd ../.. && bnfc -p GF.JavaScript GF/JavaScript/JS.cf)+ -rm -f *.bak++clean:+ -rm -f *.log *.aux *.hi *.o *.dvi+ -rm -f DocJS.ps+distclean: clean+ -rm -f DocJS.* LexJS.* ParJS.* LayoutJS.* SkelJS.* PrintJS.* TestJS.* AbsJS.* TestJS ErrM.* SharedString.* JS.dtd XMLJS.* Makefile*+
@@ -0,0 +1,225 @@+-- This Happy file was machine-generated by the BNF converter+{+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}+module GF.JavaScript.ParJS where+import GF.JavaScript.AbsJS+import GF.JavaScript.LexJS+import GF.Data.ErrM+}++%name pProgram Program++-- no lexer declaration+%monad { Err } { thenM } { returnM }+%tokentype { Token }++%token + '(' { PT _ (TS "(") }+ ')' { PT _ (TS ")") }+ '{' { PT _ (TS "{") }+ '}' { PT _ (TS "}") }+ ',' { PT _ (TS ",") }+ ';' { PT _ (TS ";") }+ '=' { PT _ (TS "=") }+ '.' { PT _ (TS ".") }+ '[' { PT _ (TS "[") }+ ']' { PT _ (TS "]") }+ ':' { PT _ (TS ":") }+ 'false' { PT _ (TS "false") }+ 'function' { PT _ (TS "function") }+ 'new' { PT _ (TS "new") }+ 'null' { PT _ (TS "null") }+ 'return' { PT _ (TS "return") }+ 'this' { PT _ (TS "this") }+ 'true' { PT _ (TS "true") }+ 'var' { PT _ (TS "var") }++L_ident { PT _ (TV $$) }+L_integ { PT _ (TI $$) }+L_doubl { PT _ (TD $$) }+L_quoted { PT _ (TL $$) }+L_err { _ }+++%%++Ident :: { Ident } : L_ident { Ident $1 }+Integer :: { Integer } : L_integ { (read $1) :: Integer }+Double :: { Double } : L_doubl { (read $1) :: Double }+String :: { String } : L_quoted { $1 }++Program :: { Program }+Program : ListElement { Program (reverse $1) } +++Element :: { Element }+Element : 'function' Ident '(' ListIdent ')' '{' ListStmt '}' { FunDef $2 $4 (reverse $7) } + | Stmt { ElStmt $1 }+++ListElement :: { [Element] }+ListElement : {- empty -} { [] } + | ListElement Element { flip (:) $1 $2 }+++ListIdent :: { [Ident] }+ListIdent : {- empty -} { [] } + | Ident { (:[]) $1 }+ | Ident ',' ListIdent { (:) $1 $3 }+++Stmt :: { Stmt }+Stmt : '{' ListStmt '}' { SCompound (reverse $2) } + | 'return' ';' { SReturnVoid }+ | 'return' Expr ';' { SReturn $2 }+ | DeclOrExpr ';' { SDeclOrExpr $1 }+++ListStmt :: { [Stmt] }+ListStmt : {- empty -} { [] } + | ListStmt Stmt { flip (:) $1 $2 }+++DeclOrExpr :: { DeclOrExpr }+DeclOrExpr : 'var' ListDeclVar { Decl $2 } + | Expr1 { DExpr $1 }+++DeclVar :: { DeclVar }+DeclVar : Ident { DVar $1 } + | Ident '=' Expr { DInit $1 $3 }+++ListDeclVar :: { [DeclVar] }+ListDeclVar : {- empty -} { [] } + | DeclVar { (:[]) $1 }+ | DeclVar ',' ListDeclVar { (:) $1 $3 }+++Expr13 :: { Expr }+Expr13 : Expr14 '=' Expr13 { EAssign $1 $3 } + | Expr14 { $1 }+++Expr14 :: { Expr }+Expr14 : 'new' Ident '(' ListExpr ')' { ENew $2 $4 } + | Expr15 { $1 }+++Expr15 :: { Expr }+Expr15 : Expr15 '.' Ident { EMember $1 $3 } + | Expr15 '[' Expr ']' { EIndex $1 $3 }+ | Expr15 '(' ListExpr ')' { ECall $1 $3 }+ | Expr16 { $1 }+++Expr16 :: { Expr }+Expr16 : Ident { EVar $1 } + | Integer { EInt $1 }+ | Double { EDbl $1 }+ | String { EStr $1 }+ | 'true' { ETrue }+ | 'false' { EFalse }+ | 'null' { ENull }+ | 'this' { EThis }+ | 'function' '(' ListIdent ')' '{' ListStmt '}' { EFun $3 (reverse $6) }+ | '[' ListExpr ']' { EArray $2 }+ | '{' ListProperty '}' { EObj $2 }+ | '(' Expr ',' ListExpr ')' { eseq1_ $2 $4 }+ | '(' Expr ')' { $2 }+++ListExpr :: { [Expr] }+ListExpr : {- empty -} { [] } + | Expr { (:[]) $1 }+ | Expr ',' ListExpr { (:) $1 $3 }+++Expr :: { Expr }+Expr : Expr1 { $1 } +++Expr1 :: { Expr }+Expr1 : Expr2 { $1 } +++Expr2 :: { Expr }+Expr2 : Expr3 { $1 } +++Expr3 :: { Expr }+Expr3 : Expr4 { $1 } +++Expr4 :: { Expr }+Expr4 : Expr5 { $1 } +++Expr5 :: { Expr }+Expr5 : Expr6 { $1 } +++Expr6 :: { Expr }+Expr6 : Expr7 { $1 } +++Expr7 :: { Expr }+Expr7 : Expr8 { $1 } +++Expr8 :: { Expr }+Expr8 : Expr9 { $1 } +++Expr9 :: { Expr }+Expr9 : Expr10 { $1 } +++Expr10 :: { Expr }+Expr10 : Expr11 { $1 } +++Expr11 :: { Expr }+Expr11 : Expr12 { $1 } +++Expr12 :: { Expr }+Expr12 : Expr13 { $1 } +++Property :: { Property }+Property : PropertyName ':' Expr { Prop $1 $3 } +++ListProperty :: { [Property] }+ListProperty : {- empty -} { [] } + | Property { (:[]) $1 }+ | Property ',' ListProperty { (:) $1 $3 }+++PropertyName :: { PropertyName }+PropertyName : Ident { IdentPropName $1 } + | String { StringPropName $1 }++++{++returnM :: a -> Err a+returnM = return++thenM :: Err a -> (a -> Err b) -> Err b+thenM = (>>=)++happyError :: [Token] -> Err a+happyError ts =+ Bad $ "syntax error at " ++ tokenPos ts ++ + case ts of+ [] -> []+ [Err _] -> " due to lexer error"+ _ -> " before " ++ unwords (map prToken (take 4 ts))++myLexer = tokens+eseq1_ x_ xs_ = ESeq (x_ : xs_)+}+
@@ -0,0 +1,167 @@+{-# OPTIONS -fno-warn-incomplete-patterns #-}+module GF.JavaScript.PrintJS (printTree, Doc, Print(..)) where++-- pretty-printer generated by the BNF converter++import GF.JavaScript.AbsJS+import Data.Char++-- the top-level printing method+printTree :: Print a => a -> String+printTree = render . prt 0++type Doc = [ShowS] -> [ShowS]++doc :: ShowS -> Doc+doc = (:)++render :: Doc -> String+render d = rend 0 (map ($ "") $ d []) "" where+ rend i ss = case ss of+ t:ts | not (spaceAfter t) -> showString t . rend i ts+ t:ts@(t':_) | not (spaceBefore t') -> showString t . rend i ts+ t:ts -> space t . rend i ts+ [] -> id+--new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace+ space t = showString t . (\s -> if null s then "" else (' ':s))++spaceAfter :: String -> Bool+spaceAfter = (`notElem` [".","(","[","{","\n"])++spaceBefore :: String -> Bool+spaceBefore = (`notElem` [",",".",":",";","(",")","[","]","{","}","\n"])++parenth :: Doc -> Doc+parenth ss = doc (showChar '(') . ss . doc (showChar ')')++concatS :: [ShowS] -> ShowS+concatS = foldr (.) id++concatD :: [Doc] -> Doc+concatD = foldr (.) id+{-+replicateS :: Int -> ShowS -> ShowS+replicateS n f = concatS (replicate n f)+-}+-- the printer class does the job+class Print a where+ prt :: Int -> a -> Doc+ prtList :: [a] -> Doc+ prtList = concatD . map (prt 0)++instance Print a => Print [a] where+ prt _ = prtList++instance Print Char where+ prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')+ prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')++mkEsc :: Char -> Char -> ShowS+mkEsc q s = case s of+ _ | s == q -> showChar '\\' . showChar s+ '\\'-> showString "\\\\"+ '\n' -> showString "\\n"+ '\t' -> showString "\\t"+ _ -> showChar s++prPrec :: Int -> Int -> Doc -> Doc+prPrec i j = if j<i then parenth else id+++instance Print Int where+ prt _ x = doc (shows x)+++instance Print Double where+ prt _ x = doc (shows x)+++instance Print Ident where+ prt _ (Ident i) = doc (showString i)+ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])++++instance Print Program where+ prt i e = case e of+ Program elements -> prPrec i 0 (concatD [prt 0 elements])+++instance Print Element where+ prt i e = case e of+ FunDef id ids stmts -> prPrec i 0 (concatD [doc (showString "function") , prt 0 id , doc (showString "(") , prt 0 ids , doc (showString ")") , doc (showString "{") , prt 0 stmts , doc (showString "}")])+ ElStmt stmt -> prPrec i 0 (concatD [prt 0 stmt])++ prtList es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , doc (showString "\n"), prt 0 xs]) -- HACKED!++instance Print Stmt where+ prt i e = case e of+ SCompound stmts -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stmts , doc (showString "}")])+ SReturnVoid -> prPrec i 0 (concatD [doc (showString "return") , doc (showString ";")])+ SReturn expr -> prPrec i 0 (concatD [doc (showString "return") , prt 0 expr , doc (showString ";")])+ SDeclOrExpr declorexpr -> prPrec i 0 (concatD [prt 0 declorexpr , doc (showString ";")])++ prtList es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , prt 0 xs])++instance Print DeclOrExpr where+ prt i e = case e of+ Decl declvars -> prPrec i 0 (concatD [doc (showString "var") , prt 0 declvars])+ DExpr expr -> prPrec i 0 (concatD [prt 1 expr])+++instance Print DeclVar where+ prt i e = case e of+ DVar id -> prPrec i 0 (concatD [prt 0 id])+ DInit id expr -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 expr])++ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])++instance Print Expr where+ prt i e = case e of+ EAssign expr0 expr -> prPrec i 13 (concatD [prt 14 expr0 , doc (showString "=") , prt 13 expr])+ ENew id exprs -> prPrec i 14 (concatD [doc (showString "new") , prt 0 id , doc (showString "(") , prt 0 exprs , doc (showString ")")])+ EMember expr id -> prPrec i 15 (concatD [prt 15 expr , doc (showString ".") , prt 0 id])+ EIndex expr0 expr -> prPrec i 15 (concatD [prt 15 expr0 , doc (showString "[") , prt 0 expr , doc (showString "]")])+ ECall expr exprs -> prPrec i 15 (concatD [prt 15 expr , doc (showString "(") , prt 0 exprs , doc (showString ")")])+ EVar id -> prPrec i 16 (concatD [prt 0 id])+ EInt n -> prPrec i 16 (concatD [prt 0 n])+ EDbl d -> prPrec i 16 (concatD [prt 0 d])+ EStr str -> prPrec i 16 (concatD [prt 0 str])+ ETrue -> prPrec i 16 (concatD [doc (showString "true")])+ EFalse -> prPrec i 16 (concatD [doc (showString "false")])+ ENull -> prPrec i 16 (concatD [doc (showString "null")])+ EThis -> prPrec i 16 (concatD [doc (showString "this")])+ EFun ids stmts -> prPrec i 16 (concatD [doc (showString "function") , doc (showString "(") , prt 0 ids , doc (showString ")") , doc (showString "{") , prt 0 stmts , doc (showString "}")])+ EArray exprs -> prPrec i 16 (concatD [doc (showString "[") , prt 0 exprs , doc (showString "]")])+ EObj propertys -> prPrec i 16 (concatD [doc (showString "{") , prt 0 propertys , doc (showString "}")])+ ESeq exprs -> prPrec i 16 (concatD [doc (showString "(") , prt 0 exprs , doc (showString ")")])++ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])++instance Print Property where+ prt i e = case e of+ Prop propertyname expr -> prPrec i 0 (concatD [prt 0 propertyname , doc (showString ":") , prt 0 expr])++ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])++instance Print PropertyName where+ prt i e = case e of+ IdentPropName id -> prPrec i 0 (concatD [prt 0 id])+ StringPropName str -> prPrec i 0 (concatD [prt 0 str])+ IntPropName n -> prPrec i 0 (concatD [prt 0 n])
@@ -0,0 +1,63 @@+-- | GF main program (grammar compiler, interactive shell, http server)+{-# LANGUAGE CPP #-}+module GF.Main where+import GF.Compiler+import qualified GF.Interactive as GFI1+#ifdef C_RUNTIME+import qualified GF.Interactive2 as GFI2+#endif+import GF.Data.ErrM+import GF.Infra.Option+import GF.Infra.UseIO+import GF.Infra.BuildInfo (buildInfo)+import Paths_gf++import Data.Version+import System.Directory+import System.Environment (getArgs)+import System.Exit+import GF.System.Console (setConsoleEncoding)++-- | Run the GF main program, taking arguments from the command line.+-- (It calls 'setConsoleEncoding' and 'getOptions', then 'mainOpts'.)+-- Run @gf --help@ for usage info.+main :: IO ()+main = do+ --setConsoleEncoding+ uncurry mainOpts =<< getOptions++-- | Get and parse GF command line arguments. Fix relative paths.+-- Calls 'getArgs' and 'parseOptions'.+getOptions = do+ args <- getArgs+ case parseOptions args of+ Ok (opts,files) -> do curr_dir <- getCurrentDirectory+ lib_dir <- getLibraryDirectory opts+ return (fixRelativeLibPaths curr_dir lib_dir opts, files)+ Bad err -> do ePutStrLn err+ ePutStrLn "You may want to try --help."+ exitFailure+++-- | Run the GF main program with the given options and files. Depending on+-- the options it invokes 'mainGFC', 'mainGFI', 'mainRunGFI', 'mainServerGFI',+-- or it just prints version/usage info.+mainOpts :: Options -> [FilePath] -> IO ()+mainOpts opts files = + case flag optMode opts of+ ModeVersion -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ buildInfo+ ModeHelp -> putStrLn helpMessage+ ModeServer port -> GFI1.mainServerGFI opts port files+ ModeCompiler -> mainGFC opts files+ ModeInteractive -> GFI1.mainGFI opts files+ ModeRun -> GFI1.mainRunGFI opts files+#ifdef C_RUNTIME+ ModeInteractive2 -> GFI2.mainGFI opts files+ ModeRun2 -> GFI2.mainRunGFI opts files+#else+ ModeInteractive2 -> noCruntime+ ModeRun2 -> noCruntime+ where+ noCruntime = do ePutStrLn "GF configured without C run-time support"+ exitFailure+#endif
@@ -0,0 +1,104 @@+----------------------------------------------------------------------+-- |+-- Module : TeachYourself+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/21 16:46:13 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.7 $+--+-- translation and morphology quiz. AR 10\/5\/2000 -- 12\/4\/2002 -- 14\/6\/2008+--------------------------------------------------------------------------------++module GF.Quiz (+ mkQuiz,+ translationList,+ morphologyList+ ) where++import PGF+--import PGF.Linearize+import GF.Data.Operations+--import GF.Infra.UseIO+--import GF.Infra.Option+--import PGF.Probabilistic++import System.Random+import Data.List (nub)++-- translation and morphology quiz. AR 10/5/2000 -- 12/4/2002++-- generic quiz function++mkQuiz :: String -> [(String,[String])] -> IO ()+mkQuiz msg tts = do+ let qas = [(q, mkAnswer as) | (q,as) <- tts]+ teachDialogue qas msg++translationList :: + Maybe Expr -> PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]+translationList mex pgf ig og typ number = do+ gen <- newStdGen+ let ts = take number $ case mex of+ Just ex -> generateRandomFrom gen pgf ex+ Nothing -> generateRandom gen pgf typ+ return $ map mkOne $ ts+ where+ mkOne t = (norml (linearize pgf ig t), + map norml (concatMap lins (homonyms t)))+ homonyms = parse pgf ig typ . linearize pgf ig+ lins = nub . concatMap (map snd) . tabularLinearizes pgf og++morphologyList :: + Maybe Expr -> PGF -> Language -> Type -> Int -> IO [(String,[String])]+morphologyList mex pgf ig typ number = do+ gen <- newStdGen+ let ts = take (max 1 number) $ case mex of+ Just ex -> generateRandomFrom gen pgf ex+ Nothing -> generateRandom gen pgf typ+ let ss = map (tabularLinearizes pgf ig) ts+ let size = length (head (head ss))+ let forms = take number $ randomRs (0,size-1) gen+ return [(snd (head pws0) +++ fst (pws0 !! i), ws) | + (pwss@(pws0:_),i) <- zip ss forms, let ws = map (\pws -> snd (pws !! i)) pwss]++-- | compare answer to the list of right answers, increase score and give feedback +mkAnswer :: [String] -> String -> (Integer, String) +mkAnswer as s = + if (elem (norm s) as) + then (1,"Yes.") + else (0,"No, not" +++ s ++ ", but" ++++ unlines as)+ where+ norm = unwords . words++norml = unwords . words+++-- * a generic quiz session++type QuestionsAndAnswers = [(String, String -> (Integer,String))]++teachDialogue :: QuestionsAndAnswers -> String -> IO ()+teachDialogue qas welc = do+ putStrLn $ welc ++++ genericTeachWelcome+ teach (0,0) qas+ where + teach _ [] = do putStrLn "Sorry, ran out of problems"+ teach (score,total) ((question,grade):quas) = do+ putStr ("\n" ++ question ++ "\n> ") + answer <- getLine+ if (answer == ".") then return () else do+ let (result, feedback) = grade answer+ score' = score + result + total' = total + 1+ putStr (feedback ++++ "Score" +++ show score' ++ "/" ++ show total')+ if (total' > 9 && fromInteger score' / fromInteger total' >= 0.75)+ then do putStrLn "\nCongratulations - you passed!"+ else teach (score',total') quas++ genericTeachWelcome = + "The quiz is over when you have done at least 10 examples" +++++ "with at least 75 % success." ++++++ "You can interrupt the quiz by entering a line consisting of a dot ('.').\n"
@@ -0,0 +1,522 @@+-- | GF server mode+{-# LANGUAGE CPP #-}+module GF.Server(server) where+import Data.List(partition,stripPrefix,isInfixOf)+import qualified Data.Map as M+import Control.Applicative -- for GHC<7.10+import Control.Monad(when)+import Control.Monad.State(StateT(..),get,gets,put)+import Control.Monad.Error(ErrorT(..),Error(..))+import System.Random(randomRIO)+--import System.IO(stderr,hPutStrLn)+import GF.System.Catch(try)+import Control.Exception(bracket_)+import System.IO.Error(isAlreadyExistsError)+import GF.System.Directory(doesDirectoryExist,doesFileExist,createDirectory,+ setCurrentDirectory,getCurrentDirectory,+ getDirectoryContents,removeFile,removeDirectory,+ getModificationTime)+import Data.Time (getCurrentTime,formatTime)+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format(defaultTimeLocale,rfc822DateFormat)+#else+import System.Locale(defaultTimeLocale,rfc822DateFormat)+#endif+import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory,+ (</>),makeRelative)+#ifndef mingw32_HOST_OS+import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink,+ createSymbolicLink)+#endif+import GF.Infra.Concurrency(newMVar,modifyMVar,newLog)+import Network.URI(URI(..))+import Network.Shed.Httpd(initServer,Request(..),Response(..),noCache)+--import qualified Network.FastCGI as FCGI -- from hackage direct-fastcgi+import Network.CGI(handleErrors,liftIO)+import CGIUtils(handleCGIErrors)--,outputJSONP,stderrToFile+import Text.JSON(JSValue(..),Result(..),valFromObj,encode,decode,showJSON,makeObj)+--import System.IO.Silently(hCapture)+import System.Process(readProcessWithExitCode)+import System.Exit(ExitCode(..))+import Codec.Binary.UTF8.String(decodeString,encodeString)+import GF.Infra.UseIO(readBinaryFile,writeBinaryFile,ePutStrLn)+import GF.Infra.SIO(captureSIO)+import GF.Data.Utilities(apSnd,mapSnd)+import qualified PGFService as PS+import qualified ExampleService as ES+import Data.Version(showVersion)+import Paths_gf(getDataDir,version)+import GF.Infra.BuildInfo (buildInfo)+import SimpleEditor.Convert(parseModule)+import RunHTTP(cgiHandler)+import URLEncoding(decodeQuery)++--logFile :: FilePath+--logFile = "pgf-error.log"++debug s = logPutStrLn s++-- | Combined FastCGI and HTTP server+server jobs port optroot execute1 state0 =+ do --stderrToFile logFile+ state <- newMVar M.empty+ cache <- PS.newPGFCache jobs+ datadir <- getDataDir+ let root = maybe (datadir</>"www") id optroot+-- debug $ "document root="++root+ setDir root+-- FCGI.acceptLoop forkIO (handle_fcgi execute1 state0 state cache)+ -- if acceptLoop returns, then GF was not invoked as a FastCGI script+ http_server execute1 state0 state cache root+ where+ -- | HTTP server+ http_server execute1 state0 state cache root =+ do logLn <- newLog ePutStrLn -- to avoid intertwined log messages+ logLn gf_version+ logLn $ "Document root = "++root+ logLn $ "Starting HTTP server, open http://localhost:"+ ++show port++"/ in your web browser."+ initServer port (handle logLn root state0 cache execute1 state)++gf_version = "This is GF version "++showVersion version++".\n"++buildInfo++{-+-- | FastCGI request handler+handle_fcgi execute1 state0 stateM cache =+ do Just method <- FCGI.getRequestMethod+ debug $ "request method="++method+ Just path <- FCGI.getPathInfo+-- debug $ "path info="++path+ query <- maybe (return "") return =<< FCGI.getQueryString+-- debug $ "query string="++query+ let uri = URI "" Nothing path query ""+ headers <- fmap (mapFst show) FCGI.getAllRequestHeaders+ body <- fmap BS.unpack FCGI.fGetContents+ let req = Request method uri headers body+-- debug (show req)+ (output,resp) <- liftIO $ hCapture [stdout] $ modifyMVar stateM $ handle state0 cache execute1 req+ let Response code headers body = resp+-- debug output+ debug $ " "++show code++" "++show headers+ FCGI.setResponseStatus code+ mapM_ (uncurry (FCGI.setResponseHeader . toHeader)) headers+ let pbody = BS.pack body+ n = BS.length pbody+ FCGI.fPut pbody+ debug $ "done "++show n+-}++-- * Request handler+-- | Handler monad+type HM s a = StateT (Q,s) (ErrorT Response IO) a+run :: HM s Response -> (Q,s) -> IO (s,Response)+run m s = either bad ok =<< runErrorT (runStateT m s)+ where+ bad resp = return (snd s,resp)+ ok (resp,(qs,state)) = return (state,resp)++get_qs :: HM s Q+get_qs = gets fst+get_state :: HM s s+get_state = gets snd+put_qs qs = do state <- get_state; put (qs,state)+put_state state = do qs <- get_qs; put (qs,state)++err :: Response -> HM s a+err e = StateT $ \ s -> ErrorT $ return $ Left e++hmbracket_ :: IO () -> IO () -> HM s a -> HM s a+hmbracket_ pre post m =+ do s <- get+ e <- liftIO $ bracket_ pre post $ runErrorT $ runStateT m s+ case e of+ Left resp -> err resp+ Right (a,s) -> do put s;return a++-- | HTTP request handler+handle logLn documentroot state0 cache execute1 stateVar+ rq@(Request method URI{uriPath=upath,uriQuery=q} hdrs body) =+ addDate $+ case method of+ "POST" -> normal_request (utf8inputs body)+ "GET" -> normal_request (utf8inputs q)+ _ -> return (resp501 $ "method "++method)+ where+ logPutStrLn msg = liftIO $ logLn msg+-- debug msg = logPutStrLn msg++ addDate m =+ do t <- getCurrentTime+ r <- m+ let fmt = formatTime defaultTimeLocale rfc822DateFormat t+ return r{resHeaders=("Date",fmt):resHeaders r}++ normal_request qs =+ do logPutStrLn $ method++" "++upath++" "++show (mapSnd (take 500.fst) qs)+ let stateful m = modifyMVar stateVar $ \ s -> run m (qs,s)+ -- stateful ensures mutual exclusion, so you can use/change the cwd+ case upath of+ "/new" -> stateful $ new+ "/gfshell" -> stateful $ inDir command+ "/cloud" -> stateful $ inDir cloud+-- "/stop" ->+-- "/start" ->+ "/parse" -> parse (decoded qs)+ "/version" -> versionInfo `fmap` PS.listPGFCache cache+ "/flush" -> do PS.flushPGFCache cache; return (ok200 "flushed")+ '/':rpath ->+ -- This code runs without mutual exclusion, so it must *not*+ -- use/change the cwd. Access files by absolute paths only.+ case (takeDirectory path,takeFileName path,takeExtension path) of+ (_ ,_ ,".pgf") -> do --debug $ "PGF service: "++path+ wrapCGI $ PS.cgiMain' cache path+ (dir,"grammars.cgi",_ ) -> grammarList dir (decoded qs)+ (dir ,"exb.fcgi" ,_ ) -> wrapCGI $ ES.cgiMain' root dir (PS.pgfCache cache)+ _ -> serveStaticFile rpath path+ where path = translatePath rpath+ _ -> return $ resp400 upath++ root = documentroot++ translatePath rpath = root</>rpath -- hmm, check for ".."++ versionInfo (c1,c2) =+ html200 . unlines $+ "<!DOCTYPE html>":+ "<meta name = \"viewport\" content = \"width = device-width\">":+ "<link rel=\"stylesheet\" type=\"text/css\" href=\"cloud.css\" title=\"Cloud\">":+ "":+ ("<h2>"++hdr++"</h2>"):+ (zipWith (++) ("<p>":repeat "<br>") buildinfo)+++ sh "Haskell run-time system" c1+++ sh "C run-time system" c2+ where+ hdr:buildinfo = lines gf_version+ rel = makeRelative documentroot+ sh1 (path,t) = "<tr><td>"++rel path++"<td>"++show t+ sh _ [] = []+ sh hdr gs =+ "":("<h3>"++hdr++"</h3>"):+ "<table class=loaded_grammars><tr><th>Grammar<th>Last modified":+ map sh1 gs+++ ["</table>"]++ wrapCGI cgi = cgiHandler root (handleErrors . handleCGIErrors $ cgi) rq++ look field =+ do qs <- get_qs+ case partition ((==field).fst) qs of+ ((_,(value,_)):qs1,qs2) -> do put_qs (qs1++qs2)+ return value+ _ -> err $ resp400 $ "no "++field++" in request"+ + inDir ok = cd =<< look "dir"+ where+ cd ('/':dir@('t':'m':'p':_)) =+ do cwd <- getCurrentDirectory+ b <- doesDirectoryExist dir+ case b of+ False -> do b <- liftIO $ try $ readFile dir -- poor man's symbolic links+ case b of+ Left _ -> err $ resp404 dir+ Right dir' -> cd dir'+ True -> do --logPutStrLn $ "cd "++dir+ hmInDir dir (ok dir)+ cd dir = err $ resp400 $ "unacceptable directory "++dir++ -- First ensure that only one thread that depends on the cwd is running!+ hmInDir dir = hmbracket_ (setDir dir) (setDir documentroot)++ new = fmap ok200 $ liftIO $ newDirectory++ command dir =+ do cmd <- look "command"+ state <- get_state+ let st = maybe state0 id $ M.lookup dir state+ (output,st') <- liftIO $ captureSIO $ execute1 st cmd+ let state' = maybe state (flip (M.insert dir) state) st'+ put_state state'+ return $ ok200 output++ parse qs = return $ json200 (makeObj(map parseModule qs))++ cloud dir =+ do cmd <- look "command"+ case cmd of+ "make" -> make id dir . raw =<< get_qs+ "remake" -> make skip_empty dir . raw =<< get_qs+ "upload" -> upload id . raw =<< get_qs+ "ls" -> jsonList . maybe ".json" fst . lookup "ext" =<< get_qs+ "ls-l" -> jsonListLong . maybe ".json" fst . lookup "ext" =<< get_qs+ "rm" -> rm =<< look_file+ "download" -> download =<< look_file+ "link_directories" -> link_directories dir =<< look "newdir"+ _ -> err $ resp400 $ "cloud command "++cmd++ look_file = check =<< look "file"+ where+ check path =+ if ok_access path+ then return path+ else err $ resp400 $ "unacceptable path "++path++ make skip dir args =+ do let (flags,files) = partition ((=="-").take 1.fst) args+ _ <- upload skip files+ let args = "-s":"-make":map flag flags++map fst files+ flag (n,"") = n+ flag (n,v) = n++"="++v+ cmd = unwords ("gf":args)+ logPutStrLn cmd+ out@(ecode,_,_) <- liftIO $ readProcessWithExitCode "gf" args ""+ logPutStrLn $ show ecode+ cwd <- getCurrentDirectory+ return $ json200 (jsonresult cwd ('/':dir++"/") cmd out files)++ upload skip files =+ if null badpaths+ then do liftIO $ mapM_ (uncurry updateFile) (skip okfiles)+ return resp204+ else err $ resp404 $ "unacceptable path(s) "++unwords badpaths+ where+ (okfiles,badpaths) = apSnd (map fst) $ partition (ok_access.fst) files++ skip_empty = filter (not.null.snd)++ jsonList = jsonList' return+ jsonListLong ext = jsonList' (mapM (addTime ext)) ext+ jsonList' details ext = fmap (json200) (details =<< ls_ext "." ext)++ addTime ext path =+ do t <- getModificationTime path+ if ext==".json"+ then addComment (time t) <$> liftIO (try $ getComment path)+ else return . makeObj $ time t+ where+ addComment t = makeObj . either (const t) (\c->t++["comment".=c])+ time t = ["path".=path,"time".=format t]+ format = formatTime defaultTimeLocale rfc822DateFormat++ rm path | takeExtension path `elem` ok_to_delete =+ do b <- doesFileExist path+ if b+ then do removeFile path+ return $ ok200 ""+ else err $ resp404 path+ rm path = err $ resp400 $ "unacceptable extension "++path++ download path = liftIO $ serveStaticFile' path++ link_directories olddir newdir@('/':'t':'m':'p':'/':_) | old/=new =+ hmInDir ".." $ liftIO $+ do logPutStrLn =<< getCurrentDirectory+ logPutStrLn $ "link_dirs new="++new++", old="++old+#ifdef mingw32_HOST_OS+ isDir <- doesDirectoryExist old+ if isDir then removeDir old else removeFile old+ writeFile old new -- poor man's symbolic links+#else+ isLink <- isSymbolicLink `fmap` getSymbolicLinkStatus old+ logPutStrLn $ "old is link: "++show isLink+ if isLink then removeLink old else removeDir old+ createSymbolicLink new old+#endif+ return $ ok200 ""+ where+ old = takeFileName olddir+ new = takeFileName newdir+ link_directories olddir newdir =+ err $ resp400 $ "unacceptable directories "++olddir++" "++newdir++ grammarList dir qs =+ do pgfs <- ls_ext dir ".pgf"+ return $ jsonp qs pgfs++ ls_ext dir ext =+ do paths <- getDirectoryContents dir+ return [path | path<-paths, takeExtension path==ext]++ getComment path =+ do Ok (JSObject obj) <- decode <$> readFile path+ Ok cmnt <- return (valFromObj "comment" obj)+ return (cmnt::String)++-- * Dynamic content++jsonresult cwd dir cmd (ecode,stdout,stderr) files =+ makeObj [+ "errorcode" .= if ecode==ExitSuccess then "OK" else "Error",+ "command" .= cmd,+ "output" .= unlines [rel stderr,rel stdout],+ "minibar_url" .= "/minibar/minibar.html?"++dir++pgf]+ where+ pgf = case files of+ (abstract,_):_ -> "%20"++dropExtension abstract++".pgf"+ _ -> ""++ rel = unlines . map relative . lines++ -- remove absolute file paths from error messages:+ relative s = case stripPrefix cwd s of+ Just ('/':rest) -> rest+ _ -> s++-- * Static content++serveStaticFile rpath path =+ do --logPutStrLn $ "Serving static file "++path+ b <- doesDirectoryExist path+ if b+ then if rpath `elem` ["","."] || last path=='/'+ then serveStaticFile' (path </> "index.html")+ else return (resp301 ('/':rpath++"/"))+ else serveStaticFile' path++serveStaticFile' path =+ do let ext = takeExtension path+ (t,rdFile) = contentTypeFromExt ext+ if ext `elem` [".cgi",".fcgi",".sh",".php"]+ then return $ resp400 $ "Unsupported file type: "++ext+ else do b <- doesFileExist path+ if b then fmap (ok200' (ct t "")) $ rdFile path+ else do cwd <- getCurrentDirectory+ logPutStrLn $ "Not found: "++path++" cwd="++cwd+ return (resp404 path)++-- * Logging+logPutStrLn s = ePutStrLn s++-- * JSONP output++jsonp qs = maybe json200 apply (lookup "jsonp" qs)+ where+ apply f = jsonp200' $ \ json -> f++"("++json++")"++-- * Standard HTTP responses+ok200 = Response 200 [plainUTF8,noCache,xo] . encodeString+ok200' t = Response 200 [t,xo]+json200 x = json200' id x+json200' f = ok200' jsonUTF8 . encodeString . f . encode+jsonp200' f = ok200' jsonpUTF8 . encodeString . f . encode+html200 = ok200' htmlUTF8 . encodeString+resp204 = Response 204 [xo] "" -- no content+resp301 url = Response 301 [plain,xo,location url] $+ "Moved permanently to "++url+resp400 msg = Response 400 [plain,xo] $ "Bad request: "++msg++"\n"+resp404 path = Response 404 [plain,xo] $ "Not found: "++path++"\n"+resp500 msg = Response 500 [plain,xo] $ "Internal error: "++msg++"\n"+resp501 msg = Response 501 [plain,xo] $ "Not implemented: "++msg++"\n"++instance Error Response where+ noMsg = resp500 "no message"+ strMsg = resp500++-- * Content types+plain = ct "text/plain" ""+plainUTF8 = ct "text/plain" csutf8+jsonUTF8 = ct "application/json" csutf8 -- http://www.ietf.org/rfc/rfc4627.txt+jsonpUTF8 = ct "application/javascript" csutf8+htmlUTF8 = ct "text/html" csutf8++ct t cs = ("Content-Type",t++cs)+csutf8 = "; charset=UTF-8"+xo = ("Access-Control-Allow-Origin","*") -- Allow cross origin requests+ -- https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS+location url = ("Location",url)++contentTypeFromExt ext =+ case ext of+ ".html" -> text "html"+ ".htm" -> text "html"+ ".xml" -> text "xml"+ ".txt" -> text "plain"+ ".css" -> text "css"+ ".js" -> text "javascript"+ ".png" -> bin "image/png"+ ".jpg" -> bin "image/jpg"+ _ -> bin "application/octet-stream"+ where+ text subtype = ("text/"++subtype++"; charset=UTF-8",+ fmap encodeString . readFile)+ bin t = (t,readBinaryFile)++-- * IO utilities+updateFile path new =+ do old <- try $ readBinaryFile path+-- let new = encodeString new0+ when (Right new/=old) $ do logPutStrLn $ "Updating "++path+ seq (either (const 0) length old) $+ writeBinaryFile path new++-- | Check that a path is not outside the current directory+ok_access path =+ case path of+ '/':_ -> False+ '.':'.':'/':_ -> False+ _ -> not ("/../" `isInfixOf` path)++-- | Only delete files with these extensions+ok_to_delete = [".json",".gfstdoc",".gfo",".gf",".pgf"]++newDirectory =+ do debug "newDirectory"+ loop 10+ where+ loop 0 = fail "Failed to create a new directory"+ loop n = maybe (loop (n-1)) return =<< once++ once =+ do k <- randomRIO (1,maxBound::Int)+ let path = "tmp/gfse."++show k+ b <- try $ createDirectory path+ case b of+ Left err -> do debug (show err) ;+ if isAlreadyExistsError err+ then return Nothing+ else ioError err+ Right _ -> return (Just ('/':path))++-- | Remove a directory and the files in it, but not recursively+removeDir dir =+ do files <- filter (`notElem` [".",".."]) `fmap` getDirectoryContents dir+ mapM (removeFile . (dir</>)) files+ removeDirectory dir++setDir path =+ do --logPutStrLn $ "cd "++show path+ setCurrentDirectory path++{-+-- * direct-fastcgi deficiency workaround++--toHeader = FCGI.toHeader -- not exported, unfortuntately++toHeader "Content-Type" = FCGI.HttpContentType -- to avoid duplicate headers+toHeader s = FCGI.HttpExtensionHeader s -- cheating a bit+-}++-- * misc utils++--utf8inputs = mapBoth decodeString . inputs+type Q = [(String,(String,String))]+utf8inputs :: String -> Q+utf8inputs q = [(decodeString k,(decodeString v,v))|(k,v)<-inputs q]+decoded = mapSnd fst+raw = mapSnd snd++inputs ('?':q) = decodeQuery q+inputs q = decodeQuery q++{-+-- Stay clear of queryToArgument, which uses unEscapeString, which had+-- backward incompatible changes in network-2.4.1.1, see+-- https://github.com/haskell/network/commit/f2168b1f8978b4ad9c504e545755f0795ac869ce+inputs = queryToArguments . fixplus+ where+ fixplus = concatMap decode+ decode '+' = "%20" -- httpd-shed bug workaround+ decode c = [c]+-}++infix 1 .=+n .= v = (n,showJSON v)
@@ -0,0 +1,243 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.CFGToFA+--+-- Approximates CFGs with finite state networks.+----------------------------------------------------------------------+module GF.Speech.CFGToFA (cfgToFA, makeSimpleRegular,+ MFA(..), cfgToMFA, cfgToFA') where++import Data.List+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++import PGF.Internal+import GF.Data.Utilities+import GF.Grammar.CFG+--import GF.Speech.PGFToCFG+--import GF.Infra.Ident (Ident)++import GF.Data.Graph+--import GF.Data.Relation+import GF.Speech.FiniteState+--import GF.Speech.CFG++data Recursivity = RightR | LeftR | NotR++data MutRecSet = MutRecSet {+ mrCats :: Set Cat,+ mrNonRecRules :: [CFRule],+ mrRecRules :: [CFRule],+ mrRec :: Recursivity+ }+++type MutRecSets = Map Cat MutRecSet++--+-- * Multiple DFA type+--++data MFA = MFA Cat [(Cat,DFA CFSymbol)]++++cfgToFA :: CFG -> DFA Token+cfgToFA = minimize . compileAutomaton . makeSimpleRegular+++--+-- * Compile strongly regular grammars to NFAs+--++-- Convert a strongly regular grammar to a finite automaton.+compileAutomaton :: CFG -> NFA Token+compileAutomaton g = make_fa (g,ns) s [NonTerminal (cfgStartCat g)] f fa+ where + (fa,s,f) = newFA_+ ns = mutRecSets g $ mutRecCats False g++-- | The make_fa algorithm from \"Regular approximation of CFLs: a grammatical view\",+-- Mark-Jan Nederhof, Advances in Probabilistic and other Parsing Technologies, 2000.+make_fa :: (CFG,MutRecSets) -> State -> [CFSymbol] -> State + -> NFA Token -> NFA Token+make_fa c@(g,ns) q0 alpha q1 fa = + case alpha of+ [] -> newTransition q0 q1 Nothing fa+ [Terminal t] -> newTransition q0 q1 (Just t) fa+ [NonTerminal a] -> + case Map.lookup a ns of+ -- a is recursive+ Just n@(MutRecSet { mrCats = ni, mrNonRecRules = nrs, mrRecRules = rs} ) -> + case mrRec n of+ -- the set Ni is right-recursive or cyclic+ RightR ->+ let new = [(getState c, xs, q1) | Rule c xs _ <- nrs]+ ++ [(getState c, xs, getState d) | Rule c ss _ <- rs, + let (xs,NonTerminal d) = (init ss,last ss)]+ in make_fas new $ newTransition q0 (getState a) Nothing fa'+ -- the set Ni is left-recursive + LeftR ->+ let new = [(q0, xs, getState c) | Rule c xs _ <- nrs]+ ++ [(getState d, xs, getState c) | Rule c (NonTerminal d:xs) _ <- rs]+ in make_fas new $ newTransition (getState a) q1 Nothing fa'+ where+ (fa',stateMap) = addStatesForCats ni fa+ getState x = Map.findWithDefault + (error $ "CFGToFiniteState: No state for " ++ x) + x stateMap+ -- a is not recursive+ Nothing -> let rs = catRules g a+ in foldl' (\f (Rule _ b _) -> make_fa_ q0 b q1 f) fa rs+ (x:beta) -> let (fa',q) = newState () fa+ in make_fa_ q beta q1 $ make_fa_ q0 [x] q fa'+ where+ make_fa_ = make_fa c+ make_fas xs fa = foldl' (\f' (s1,xs,s2) -> make_fa_ s1 xs s2 f') fa xs++--+-- * Compile a strongly regular grammar to a DFA with sub-automata+--++cfgToMFA :: CFG -> MFA+cfgToMFA = buildMFA . makeSimpleRegular++-- | Build a DFA by building and expanding an MFA+cfgToFA' :: CFG -> DFA Token+cfgToFA' = mfaToDFA . cfgToMFA++buildMFA :: CFG -> MFA+buildMFA g = sortSubLats $ removeUnusedSubLats mfa+ where fas = compileAutomata g+ mfa = MFA (cfgStartCat g) [(c, minimize fa) | (c,fa) <- fas]++mfaStartDFA :: MFA -> DFA CFSymbol+mfaStartDFA (MFA start subs) = + fromMaybe (error $ "Bad start MFA: " ++ start) $ lookup start subs++mfaToDFA :: MFA -> DFA Token+mfaToDFA mfa@(MFA _ subs) = minimize $ expand $ dfa2nfa $ mfaStartDFA mfa+ where+ subs' = Map.fromList [(c, dfa2nfa n) | (c,n) <- subs]+ getSub l = fromJust $ Map.lookup l subs'+ expand (FA (Graph c ns es) s f) + = foldl' expandEdge (FA (Graph c ns []) s f) es+ expandEdge fa (f,t,x) = + case x of+ Nothing -> newTransition f t Nothing fa+ Just (Terminal s) -> newTransition f t (Just s) fa+ Just (NonTerminal l) -> insertNFA fa (f,t) (expand $ getSub l)++removeUnusedSubLats :: MFA -> MFA+removeUnusedSubLats mfa@(MFA start subs) = MFA start [(c,s) | (c,s) <- subs, isUsed c]+ where+ usedMap = subLatUseMap mfa+ used = growUsedSet (Set.singleton start)+ isUsed c = c `Set.member` used+ growUsedSet = fix (\s -> foldl Set.union s $ mapMaybe (flip Map.lookup usedMap) $ Set.toList s)++subLatUseMap :: MFA -> Map Cat (Set Cat)+subLatUseMap (MFA _ subs) = Map.fromList [(c,usedSubLats n) | (c,n) <- subs]++usedSubLats :: DFA CFSymbol -> Set Cat+usedSubLats fa = Set.fromList [s | (_,_,NonTerminal s) <- transitions fa]++-- | Sort sub-networks topologically.+sortSubLats :: MFA -> MFA+sortSubLats mfa@(MFA main subs) = MFA main (reverse $ sortLats usedByMap subs)+ where+ usedByMap = revMultiMap (subLatUseMap mfa)+ sortLats _ [] = []+ sortLats ub ls = xs ++ sortLats ub' ys+ where (xs,ys) = partition ((==0) . indeg) ls+ ub' = Map.map (Set.\\ Set.fromList (map fst xs)) ub+ indeg (c,_) = maybe 0 Set.size $ Map.lookup c ub++-- | Convert a strongly regular grammar to a number of finite automata,+-- one for each non-terminal.+-- The edges in the automata accept tokens, or name another automaton to use.+compileAutomata :: CFG+ -> [(Cat,NFA CFSymbol)]+ -- ^ A map of non-terminals and their automata.+compileAutomata g = [(c, makeOneFA c) | c <- allCats g]+ where+ mrs = mutRecSets g $ mutRecCats True g+ makeOneFA c = make_fa1 mr s [NonTerminal c] f fa + where (fa,s,f) = newFA_+ mr = fromJust (Map.lookup c mrs)+++-- | The make_fa algorithm from \"Regular approximation of CFLs: a grammatical view\",+-- Mark-Jan Nederhof, Advances in Probabilistic and other Parsing Technologies, 2000,+-- adapted to build a finite automaton for a single (mutually recursive) set only.+-- Categories not in the set will result in category-labelled edges.+make_fa1 :: MutRecSet -- ^ The set of (mutually recursive) categories for which+ -- we are building the automaton.+ -> State -- ^ State to come from+ -> [CFSymbol] -- ^ Symbols to accept+ -> State -- ^ State to end up in+ -> NFA CFSymbol -- ^ FA to add to.+ -> NFA CFSymbol+make_fa1 mr q0 alpha q1 fa = + case alpha of+ [] -> newTransition q0 q1 Nothing fa+ [t@(Terminal _)] -> newTransition q0 q1 (Just t) fa+ [c@(NonTerminal a)] | not (a `Set.member` mrCats mr) -> newTransition q0 q1 (Just c) fa+ [NonTerminal a] ->+ case mrRec mr of+ NotR -> -- the set is a non-recursive (always singleton) set of categories+ -- so the set of category rules is the set of rules for the whole set+ make_fas [(q0, b, q1) | Rule _ b _ <- mrNonRecRules mr] fa+ RightR -> -- the set is right-recursive or cyclic+ let new = [(getState c, xs, q1) | Rule c xs _ <- mrNonRecRules mr]+ ++ [(getState c, xs, getState d) | Rule c ss _ <- mrRecRules mr, + let (xs,NonTerminal d) = (init ss,last ss)]+ in make_fas new $ newTransition q0 (getState a) Nothing fa'+ LeftR -> -- the set is left-recursive+ let new = [(q0, xs, getState c) | Rule c xs _ <- mrNonRecRules mr]+ ++ [(getState d, xs, getState c) | Rule c (NonTerminal d:xs) _ <- mrRecRules mr]+ in make_fas new $ newTransition (getState a) q1 Nothing fa'+ where+ (fa',stateMap) = addStatesForCats (mrCats mr) fa+ getState x = Map.findWithDefault + (error $ "CFGToFiniteState: No state for " ++ x) + x stateMap+ (x:beta) -> let (fa',q) = newState () fa+ in make_fas [(q0,[x],q),(q,beta,q1)] fa'+ where+ make_fas xs fa = foldl' (\f' (s1,xs,s2) -> make_fa1 mr s1 xs s2 f') fa xs++mutRecSets :: CFG -> [Set Cat] -> MutRecSets+mutRecSets g = Map.fromList . concatMap mkMutRecSet+ where + mkMutRecSet cs = [ (c,ms) | c <- csl ]+ where csl = Set.toList cs+ rs = catSetRules g cs+ (nrs,rrs) = partition (ruleIsNonRecursive cs) rs+ ms = MutRecSet {+ mrCats = cs,+ mrNonRecRules = nrs,+ mrRecRules = rrs,+ mrRec = rec+ }+ rec | null rrs = NotR+ | all (isRightLinear cs) rrs = RightR+ | otherwise = LeftR++--+-- * Utilities+--++-- | Add a state for the given NFA for each of the categories+-- in the given set. Returns a map of categories to their+-- corresponding states.+addStatesForCats :: Set Cat -> NFA t -> (NFA t, Map Cat State)+addStatesForCats cs fa = (fa', m)+ where (fa', ns) = newStates (replicate (Set.size cs) ()) fa+ m = Map.fromList (zip (Set.toList cs) (map fst ns))++revMultiMap :: (Ord a, Ord b) => Map a (Set b) -> Map b (Set a)+revMultiMap m = Map.fromListWith Set.union [ (y,Set.singleton x) | (x,s) <- Map.toList m, y <- Set.toList s]
@@ -0,0 +1,329 @@+----------------------------------------------------------------------+-- |+-- Module : FiniteState+-- Maintainer : BB+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/10 16:43:44 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.16 $+--+-- A simple finite state network module.+-----------------------------------------------------------------------------+module GF.Speech.FiniteState (FA(..), State, NFA, DFA,+ startState, finalStates,+ states, transitions,+ isInternal,+ newFA, newFA_,+ addFinalState,+ newState, newStates,+ newTransition, newTransitions,+ insertTransitionWith, insertTransitionsWith,+ mapStates, mapTransitions,+ modifyTransitions,+ nonLoopTransitionsTo, nonLoopTransitionsFrom, + loops,+ removeState,+ oneFinalState,+ insertNFA,+ onGraph,+ moveLabelsToNodes, removeTrivialEmptyNodes,+ minimize,+ dfa2nfa,+ unusedNames, renameStates,+ prFAGraphviz, faToGraphviz) where++import Data.List+import Data.Maybe +--import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++--import GF.Data.Utilities+import GF.Data.Graph+import qualified GF.Data.Graphviz as Dot++type State = Int++-- | Type parameters: node id type, state label type, edge label type+-- Data constructor arguments: nodes and edges, start state, final states+data FA n a b = FA !(Graph n a b) !n ![n]++type NFA a = FA State () (Maybe a)++type DFA a = FA State () a+++startState :: FA n a b -> n+startState (FA _ s _) = s++finalStates :: FA n a b -> [n]+finalStates (FA _ _ ss) = ss++states :: FA n a b -> [(n,a)]+states (FA g _ _) = nodes g++transitions :: FA n a b -> [(n,n,b)]+transitions (FA g _ _) = edges g++newFA :: Enum n => a -- ^ Start node label+ -> FA n a b+newFA l = FA g s []+ where (g,s) = newNode l (newGraph [toEnum 0..])++-- | Create a new finite automaton with an initial and a final state.+newFA_ :: Enum n => (FA n () b, n, n)+newFA_ = (fa'', s, f)+ where fa = newFA ()+ s = startState fa+ (fa',f) = newState () fa+ fa'' = addFinalState f fa'++addFinalState :: n -> FA n a b -> FA n a b+addFinalState f (FA g s ss) = FA g s (f:ss)++newState :: a -> FA n a b -> (FA n a b, n)+newState x (FA g s ss) = (FA g' s ss, n)+ where (g',n) = newNode x g++newStates :: [a] -> FA n a b -> (FA n a b, [(n,a)])+newStates xs (FA g s ss) = (FA g' s ss, ns)+ where (g',ns) = newNodes xs g++newTransition :: n -> n -> b -> FA n a b -> FA n a b+newTransition f t l = onGraph (newEdge (f,t,l))++newTransitions :: [(n, n, b)] -> FA n a b -> FA n a b+newTransitions es = onGraph (newEdges es)++insertTransitionWith :: Eq n => + (b -> b -> b) -> (n, n, b) -> FA n a b -> FA n a b+insertTransitionWith f t = onGraph (insertEdgeWith f t)++insertTransitionsWith :: Eq n => + (b -> b -> b) -> [(n, n, b)] -> FA n a b -> FA n a b+insertTransitionsWith f ts fa = + foldl' (flip (insertTransitionWith f)) fa ts++mapStates :: (a -> c) -> FA n a b -> FA n c b+mapStates f = onGraph (nmap f)++mapTransitions :: (b -> c) -> FA n a b -> FA n a c+mapTransitions f = onGraph (emap f)++modifyTransitions :: ([(n,n,b)] -> [(n,n,b)]) -> FA n a b -> FA n a b+modifyTransitions f = onGraph (\ (Graph r ns es) -> Graph r ns (f es))++removeState :: Ord n => n -> FA n a b -> FA n a b+removeState n = onGraph (removeNode n)++minimize :: Ord a => NFA a -> DFA a+minimize = determinize . reverseNFA . dfa2nfa . determinize . reverseNFA++unusedNames :: FA n a b -> [n]+unusedNames (FA (Graph names _ _) _ _) = names++-- | Gets all incoming transitions to a given state, excluding+-- transtions from the state itself.+nonLoopTransitionsTo :: Eq n => n -> FA n a b -> [(n,b)]+nonLoopTransitionsTo s fa = + [(f,l) | (f,t,l) <- transitions fa, t == s && f /= s]++nonLoopTransitionsFrom :: Eq n => n -> FA n a b -> [(n,b)]+nonLoopTransitionsFrom s fa = + [(t,l) | (f,t,l) <- transitions fa, f == s && t /= s]++loops :: Eq n => n -> FA n a b -> [b]+loops s fa = [l | (f,t,l) <- transitions fa, f == s && t == s]++-- | Give new names to all nodes.+renameStates :: Ord x => [y] -- ^ Infinite supply of new names+ -> FA x a b+ -> FA y a b+renameStates supply (FA g s fs) = FA (renameNodes newName rest g) s' fs'+ where (ns,rest) = splitAt (length (nodes g)) supply+ newNodes = Map.fromList (zip (map fst (nodes g)) ns)+ newName n = Map.findWithDefault (error "FiniteState.newName") n newNodes+ s' = newName s+ fs' = map newName fs++-- | Insert an NFA into another+insertNFA :: NFA a -- ^ NFA to insert into+ -> (State, State) -- ^ States to insert between+ -> NFA a -- ^ NFA to insert.+ -> NFA a+insertNFA (FA g1 s1 fs1) (f,t) (FA g2 s2 fs2) + = FA (newEdges es g') s1 fs1+ where + es = (f,ren s2,Nothing):[(ren f2,t,Nothing) | f2 <- fs2]+ (g',ren) = mergeGraphs g1 g2++onGraph :: (Graph n a b -> Graph n c d) -> FA n a b -> FA n c d+onGraph f (FA g s ss) = FA (f g) s ss+++-- | Make the finite automaton have a single final state+-- by adding a new final state and adding an edge+-- from the old final states to the new state.+oneFinalState :: a -- ^ Label to give the new node+ -> b -- ^ Label to give the new edges+ -> FA n a b -- ^ The old network+ -> FA n a b -- ^ The new network+oneFinalState nl el fa =+ let (FA g s fs,nf) = newState nl fa+ es = [ (f,nf,el) | f <- fs ]+ in FA (newEdges es g) s [nf]++-- | Transform a standard finite automaton with labelled edges+-- to one where the labels are on the nodes instead. This can add+-- up to one extra node per edge.+moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) ()+moveLabelsToNodes = onGraph f+ where f g@(Graph c _ _) = Graph c' ns (concat ess)+ where is = [ ((n,l),inc) | (n, (l,inc,_)) <- Map.toList (nodeInfo g)]+ (c',is') = mapAccumL fixIncoming c is+ (ns,ess) = unzip (concat is')+++-- | Remove empty nodes which are not start or final, and have+-- exactly one outgoing edge or exactly one incoming edge.+removeTrivialEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()+removeTrivialEmptyNodes = pruneUnusable . skipSimpleEmptyNodes++-- | Move edges to empty nodes to point to the next node(s).+-- This is not done if the pointed-to node is a final node.+skipSimpleEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()+skipSimpleEmptyNodes fa = onGraph og fa+ where + og g@(Graph c ns es) = if es' == es then g else og (Graph c ns es')+ where+ es' = concatMap changeEdge es+ info = nodeInfo g+ changeEdge e@(f,t,()) + | isNothing (getNodeLabel info t)+ -- && (i * o <= i + o)+ && not (isFinal fa t)+ = [ (f,t',()) | (_,t',()) <- getOutgoing info t]+ | otherwise = [e]+-- where i = inDegree info t+-- o = outDegree info t++isInternal :: Eq n => FA n a b -> n -> Bool+isInternal (FA _ start final) n = n /= start && n `notElem` final++isFinal :: Eq n => FA n a b -> n -> Bool+isFinal (FA _ _ final) n = n `elem` final++-- | Remove all internal nodes with no incoming edges+-- or no outgoing edges.+pruneUnusable :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) ()+pruneUnusable fa = onGraph f fa+ where+ f g = if Set.null rns then g else f (removeNodes rns g)+ where info = nodeInfo g+ rns = Set.fromList [ n | (n,_) <- nodes g, + isInternal fa n,+ inDegree info n == 0 + || outDegree info n == 0]++fixIncoming :: (Ord n, Eq a) => [n] + -> (Node n (),[Edge n (Maybe a)]) -- ^ A node and its incoming edges+ -> ([n],[(Node n (Maybe a),[Edge n ()])]) -- ^ Replacement nodes with their+ -- incoming edges.+fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)+ where ls = nub $ map edgeLabel es+ (cs',cs'') = splitAt (length ls) cs+ newNodes = zip cs' ls+ es' = [ (x,n,()) | x <- map fst newNodes ]+ -- separate cyclic and non-cyclic edges+ (cyc,ncyc) = partition (\ (f,_,_) -> f == n) es+ -- keep all incoming non-cyclic edges with the right label+ to (x,l) = [ (f,x,()) | (f,_,l') <- ncyc, l == l']+ -- for each cyclic edge with the right label, + -- add an edge from each of the new nodes (including this one)+ ++ [ (y,x,()) | (f,_,l') <- cyc, l == l', (y,_) <- newNodes]+ newContexts = [ (v, to v) | v <- newNodes ]++--alphabet :: Eq b => Graph n a (Maybe b) -> [b]+--alphabet = nub . catMaybes . map edgeLabel . edges++determinize :: Ord a => NFA a -> DFA a+determinize (FA g s f) = let (ns,es) = h (Set.singleton start) Set.empty Set.empty+ (ns',es') = (Set.toList ns, Set.toList es)+ final = filter isDFAFinal ns'+ fa = FA (Graph undefined [(n,()) | n <- ns'] es') start final+ in renameStates [0..] fa+ where info = nodeInfo g+-- reach = nodesReachable out+ start = closure info $ Set.singleton s+ isDFAFinal n = not (Set.null (Set.fromList f `Set.intersection` n))+ h currentStates oldStates es+ | Set.null currentStates = (oldStates,es)+ | otherwise = ((h $! uniqueNewStates) $! allOldStates) $! es'+ where + allOldStates = oldStates `Set.union` currentStates+ (newStates,es') = new (Set.toList currentStates) Set.empty es+ uniqueNewStates = newStates Set.\\ allOldStates+ -- Get the sets of states reachable from the given states + -- by consuming one symbol, and the associated edges.+ new [] rs es = (rs,es)+ new (n:ns) rs es = new ns rs' es'+ where cs = reachable info n --reachable reach n+ rs' = rs `Set.union` Set.fromList (map snd cs)+ es' = es `Set.union` Set.fromList [(n,s,c) | (c,s) <- cs]+++-- | Get all the nodes reachable from a list of nodes by only empty edges.+closure :: Ord n => NodeInfo n a (Maybe b) -> Set n -> Set n+closure info x = closure_ x x+ where closure_ acc check | Set.null check = acc+ | otherwise = closure_ acc' check'+ where+ reach = Set.fromList [y | x <- Set.toList check, + (_,y,Nothing) <- getOutgoing info x]+ acc' = acc `Set.union` reach+ check' = reach Set.\\ acc++-- | Get a map of labels to sets of all nodes reachable+-- from a the set of nodes by one edge with the given+-- label and then any number of empty edges.+reachable :: (Ord n,Ord b) => NodeInfo n a (Maybe b) -> Set n -> [(b,Set n)]+reachable info ns = Map.toList $ Map.map (closure info . Set.fromList) $ reachable1 info ns+reachable1 info ns = Map.fromListWith (++) [(c, [y]) | n <- Set.toList ns, (_,y,Just c) <- getOutgoing info n]++reverseNFA :: NFA a -> NFA a+reverseNFA (FA g s fs) = FA g''' s' [s]+ where g' = reverseGraph g+ (g'',s') = newNode () g'+ g''' = newEdges [(s',f,Nothing) | f <- fs] g''++dfa2nfa :: DFA a -> NFA a+dfa2nfa = mapTransitions Just++--+-- * Visualization+--++prFAGraphviz :: (Eq n,Show n) => FA n String String -> String+prFAGraphviz = Dot.prGraphviz . faToGraphviz++--prFAGraphviz_ :: (Eq n,Show n,Show a, Show b) => FA n a b -> String+--prFAGraphviz_ = Dot.prGraphviz . faToGraphviz . mapStates show . mapTransitions show++faToGraphviz :: (Eq n,Show n) => FA n String String -> Dot.Graph+faToGraphviz (FA (Graph _ ns es) s f) + = Dot.Graph Dot.Directed Nothing [] (map mkNode ns) (map mkEdge es) []+ where mkNode (n,l) = Dot.Node (show n) attrs+ where attrs = [("label",l)]+ ++ if n == s then [("shape","box")] else []+ ++ if n `elem` f then [("style","bold")] else []+ mkEdge (x,y,l) = Dot.Edge (show x) (show y) [("label",l)]++--+-- * Utilities+--++--lookups :: Ord k => [k] -> Map k a -> [a]+--lookups xs m = mapMaybe (flip Map.lookup m) xs
@@ -0,0 +1,95 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.GSL+--+-- This module prints a CFG as a Nuance GSL 2.0 grammar.+--+-----------------------------------------------------------------------------++module GF.Speech.GSL (gslPrinter) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++--import GF.Data.Utilities+import GF.Grammar.CFG+import GF.Speech.SRG+import GF.Speech.RegExp+import GF.Infra.Option+--import GF.Infra.Ident+import PGF++import Data.Char (toUpper,toLower)+import Data.List (partition)+import GF.Text.Pretty++width :: Int+width = 75++gslPrinter :: Options -> PGF -> CId -> String+gslPrinter opts pgf cnc = renderStyle st $ prGSL $ makeNonLeftRecursiveSRG opts pgf cnc+ where st = style { lineLength = width } ++prGSL :: SRG -> Doc+prGSL srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg))+ where+ header = ";GSL2.0" $$+ comment ("Nuance speech recognition grammar for " ++ srgName srg) $$+ comment ("Generated by GF") + mainCat = ".MAIN" <+> prCat (srgStartCat srg)+ prRule (SRGRule cat rhs) = prCat cat <+> union (map prAlt rhs)+ -- FIXME: use the probability+ prAlt (SRGAlt mp _ rhs) = prItem rhs+++prItem :: SRGItem -> Doc+prItem = f+ where+ f (REUnion xs) = (if null es then empty else pp "?") <> union (map f nes)+ where (es,nes) = partition isEpsilon xs+ f (REConcat [x]) = f x+ f (REConcat xs) = "(" <> fsep (map f xs) <> ")"+ f (RERepeat x) = "*" <> f x+ f (RESymbol s) = prSymbol s++union :: [Doc] -> Doc+union [x] = x+union xs = "[" <> fsep xs <> "]"++prSymbol :: Symbol SRGNT Token -> Doc+prSymbol = symbol (prCat . fst) (doubleQuotes . showToken)++-- GSL requires an upper case letter in category names+prCat :: Cat -> Doc+prCat = pp . firstToUpper+++firstToUpper :: String -> String+firstToUpper [] = []+firstToUpper (x:xs) = toUpper x : xs++{-+rmPunctCFG :: CGrammar -> CGrammar+rmPunctCFG g = [CFRule c (filter keepSymbol ss) n | CFRule c ss n <- g]++keepSymbol :: Symbol c Token -> Bool+keepSymbol (Tok t) = not (all isPunct (prt t))+keepSymbol _ = True+-}++-- Nuance does not like upper case characters in tokens+showToken :: Token -> Doc+showToken = pp . map toLower++--isPunct :: Char -> Bool+--isPunct c = c `elem` "-_.:;.,?!()[]{}"++comment :: String -> Doc+comment s = ";" <+> s+++-- Pretty-printing utilities++emptyLine :: Doc+emptyLine = pp ""++($++$) :: Doc -> Doc -> Doc+x $++$ y = x $$ emptyLine $$ y
@@ -0,0 +1,113 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.JSGF+--+-- This module prints a CFG as a JSGF grammar.+--+-- FIXME: remove \/ warn \/ fail if there are int \/ string literal+-- categories in the grammar+--+-- FIXME: convert to UTF-8+-----------------------------------------------------------------------------++module GF.Speech.JSGF (jsgfPrinter) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++--import GF.Data.Utilities+import GF.Infra.Option+import GF.Grammar.CFG+import GF.Speech.RegExp+import GF.Speech.SISR+import GF.Speech.SRG+import PGF++import Data.Char+import Data.List+--import Data.Maybe+import GF.Text.Pretty+--import Debug.Trace++width :: Int+width = 75++jsgfPrinter :: Options+ -> PGF + -> CId -> String+jsgfPrinter opts pgf cnc = renderStyle st $ prJSGF sisr $ makeNonLeftRecursiveSRG opts pgf cnc+ where st = style { lineLength = width }+ sisr = flag optSISR opts++prJSGF :: Maybe SISRFormat -> SRG -> Doc+prJSGF sisr srg+ = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg))+ where+ header = "#JSGF" <+> "V1.0" <+> "UTF-8" <+> lang <> ';' $$+ comment ("JSGF speech recognition grammar for " ++ srgName srg) $$+ comment "Generated by GF" $$+ ("grammar " ++ srgName srg ++ ";") + lang = maybe empty pp (srgLanguage srg)+ mainCat = rule True "MAIN" [prCat (srgStartCat srg)]+ prRule (SRGRule cat rhs) = rule (isExternalCat srg cat) cat (map prAlt rhs)+ prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag]+ where initTag | isEmpty t = empty+ | otherwise = "<NULL>" <+> t+ where t = tag sisr (profileInitSISR n)+ finalTag = tag sisr (profileFinalSISR n)+ p = if isEmpty initTag && isEmpty finalTag then id else parens++prCat :: Cat -> Doc+prCat c = '<' <> c <> '>'++prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc+prItem sisr t = f 0+ where+ f _ (REUnion []) = pp "<VOID>"+ f p (REUnion xs) + | not (null es) = brackets (f 0 (REUnion nes))+ | otherwise = (if p >= 1 then parens else id) (alts (map (f 1) xs))+ where (es,nes) = partition isEpsilon xs+ f _ (REConcat []) = pp "<NULL>"+ f p (REConcat xs) = (if p >= 3 then parens else id) (fsep (map (f 2) xs))+ f p (RERepeat x) = f 3 x <> '*'+ f _ (RESymbol s) = prSymbol sisr t s++prSymbol :: Maybe SISRFormat -> CFTerm -> SRGSymbol -> Doc+prSymbol sisr cn (NonTerminal n@(c,_)) = prCat c <+> tag sisr (catSISR cn n)+prSymbol _ cn (Terminal t) | all isPunct t = empty -- removes punctuation+ | otherwise = pp t -- FIXME: quote if there is whitespace or odd chars++tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> Doc+tag Nothing _ = empty+tag (Just fmt) t = case t fmt of+ [] -> empty+ ts -> '{' <+> (e $ prSISR ts) <+> '}'+ where e [] = []+ e ('}':xs) = '\\':'}':e xs+ e ('\n':xs) = ' ' : e (dropWhile isSpace xs)+ e (x:xs) = x:e xs++isPunct :: Char -> Bool+isPunct c = c `elem` "-_.;.,?!"++comment :: String -> Doc+comment s = "//" <+> s++alts :: [Doc] -> Doc+alts = fsep . prepunctuate ("| ")++rule :: Bool -> Cat -> [Doc] -> Doc+rule pub c xs = p <+> prCat c <+> '=' <+> nest 2 (alts xs) <+> ';'+ where p = if pub then pp "public" else empty++-- Pretty-printing utilities++emptyLine :: Doc+emptyLine = pp ""++--prepunctuate :: Doc -> [Doc] -> [Doc]+prepunctuate _ [] = []+prepunctuate p (x:xs) = x : map (p <>) xs++($++$) :: Doc -> Doc -> Doc+x $++$ y = x $$ emptyLine $$ y+
@@ -0,0 +1,123 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.PGFToCFG+--+-- Approximates PGF grammars with context-free grammars.+----------------------------------------------------------------------+module GF.Speech.PGFToCFG (bnfPrinter, pgfToCFG) where++import PGF(showCId)+import PGF.Internal as PGF+--import GF.Infra.Ident+import GF.Grammar.CFG hiding (Symbol)++import Data.Array.IArray as Array+--import Data.List+import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+--import Data.Maybe+import Data.Set (Set)+import qualified Data.Set as Set++bnfPrinter :: PGF -> CId -> String+bnfPrinter = toBNF id++toBNF :: (CFG -> CFG) -> PGF -> CId -> String+toBNF f pgf cnc = prCFG $ f $ pgfToCFG pgf cnc++type Profile = [Int]++pgfToCFG :: PGF + -> CId -- ^ Concrete syntax name+ -> CFG+pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ concatMap ruleToCFRule rules)+ where+ cnc = lookConcr pgf lang++ rules :: [(FId,Production)]+ rules = [(fcat,prod) | (fcat,set) <- IntMap.toList (PGF.productions cnc)+ , prod <- Set.toList set]++ fcatCats :: Map FId Cat+ fcatCats = Map.fromList [(fc, showCId c ++ "_" ++ show i) + | (c,CncCat s e lbls) <- Map.toList (cnccats cnc), + (fc,i) <- zip (range (s,e)) [1..]]++ fcatCat :: FId -> Cat+ fcatCat c = Map.findWithDefault ("Unknown_" ++ show c) c fcatCats++ fcatToCat :: FId -> LIndex -> Cat+ fcatToCat c l = fcatCat c ++ row+ where row = if catLinArity c == 1 then "" else "_" ++ show l++ -- gets the number of fields in the lincat for the given category+ catLinArity :: FId -> Int+ catLinArity c = maximum (1:[rangeSize (bounds rhs) | (CncFun _ rhs, _) <- topdownRules c])++ topdownRules cat = f cat []+ where+ f cat rules = maybe rules (Set.foldr g rules) (IntMap.lookup cat (productions cnc))+ + g (PApply funid args) rules = (cncfuns cnc ! funid,args) : rules+ g (PCoerce cat) rules = f cat rules+++ extCats :: Set Cat+ extCats = Set.fromList $ map ruleLhs startRules++ startRules :: [CFRule]+ startRules = [Rule (showCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0) + | (c,CncCat s e lbls) <- Map.toList (cnccats cnc), + fc <- range (s,e), not (isPredefFId fc),+ r <- [0..catLinArity fc-1]]++ ruleToCFRule :: (FId,Production) -> [CFRule]+ ruleToCFRule (c,PApply funid args) = + [Rule (fcatToCat c l) (mkRhs row) (profilesToTerm [fixProfile row n | n <- [0..length args-1]])+ | (l,seqid) <- Array.assocs rhs+ , let row = sequences cnc ! seqid+ , not (containsLiterals row)]+ where+ CncFun f rhs = cncfuns cnc ! funid++ mkRhs :: Array DotPos Symbol -> [CFSymbol]+ mkRhs = concatMap symbolToCFSymbol . Array.elems++ containsLiterals :: Array DotPos Symbol -> Bool+ containsLiterals row = not (null ([n | SymLit n _ <- Array.elems row] +++ [n | SymVar n _ <- Array.elems row]))++ symbolToCFSymbol :: Symbol -> [CFSymbol]+ symbolToCFSymbol (SymCat n l) = [let PArg _ fid = args!!n in NonTerminal (fcatToCat fid l)]+ symbolToCFSymbol (SymKS t) = [Terminal t]+ symbolToCFSymbol (SymKP syms as) = concatMap symbolToCFSymbol syms+ ---- ++ [t | Alt ss _ <- as, t <- ss]+ ---- should be alternatives in [[CFSymbol]]+ ---- AR 3/6/2010+ symbolToCFSymbol SymBIND = [Terminal "&+"]+ symbolToCFSymbol SymSOFT_BIND = []+ symbolToCFSymbol SymSOFT_SPACE = []+ symbolToCFSymbol SymCAPIT = [Terminal "&|"]+ symbolToCFSymbol SymALL_CAPIT = [Terminal "&|"]+ symbolToCFSymbol SymNE = []++ fixProfile :: Array DotPos Symbol -> Int -> Profile+ fixProfile row i = [k | (k,j) <- nts, j == i]+ where+ nts = zip [0..] [j | nt <- Array.elems row, j <- getPos nt]+ + getPos (SymCat j _) = [j]+ getPos (SymLit j _) = [j]+ getPos _ = []++ profilesToTerm :: [Profile] -> CFTerm+ profilesToTerm ps = CFObj f (zipWith profileToTerm argTypes ps)+ where (argTypes,_) = catSkeleton $ lookType (abstract pgf) f++ profileToTerm :: CId -> Profile -> CFTerm+ profileToTerm t [] = CFMeta t+ profileToTerm _ xs = CFRes (last xs) -- FIXME: unify+ ruleToCFRule (c,PCoerce c') =+ [Rule (fcatToCat c l) [NonTerminal (fcatToCat c' l)] (CFRes 0)+ | l <- [0..catLinArity c-1]]
@@ -0,0 +1,27 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.PrRegExp+--+-- This module prints a grammar as a regular expression.+-----------------------------------------------------------------------------++module GF.Speech.PrRegExp (regexpPrinter,multiRegexpPrinter) where++import GF.Grammar.CFG+import GF.Speech.CFGToFA+import GF.Speech.PGFToCFG+import GF.Speech.RegExp+import PGF++regexpPrinter :: PGF -> CId -> String+regexpPrinter pgf cnc = (++"\n") $ prRE id $ dfa2re $ cfgToFA $ pgfToCFG pgf cnc++multiRegexpPrinter :: PGF -> CId -> String+multiRegexpPrinter pgf cnc = prREs $ mfa2res $ cfgToMFA $ pgfToCFG pgf cnc++prREs :: [(String,RE CFSymbol)] -> String+prREs res = unlines [l ++ " = " ++ prRE id (mapRE showLabel re) | (l,re) <- res]+ where showLabel = symbol (\l -> "<" ++ l ++ ">") id++mfa2res :: MFA -> [(String,RE CFSymbol)]+mfa2res (MFA _ dfas) = [(l, minimizeRE (dfa2re dfa)) | (l,dfa) <- dfas]
@@ -0,0 +1,144 @@+module GF.Speech.RegExp (RE(..), + epsilonRE, nullRE, + isEpsilon, isNull,+ unionRE, concatRE, seqRE,+ repeatRE, minimizeRE,+ mapRE, mapRE', joinRE,+ symbolsRE,+ dfa2re, prRE) where++import Data.List++import GF.Data.Utilities+import GF.Speech.FiniteState++data RE a = + REUnion [RE a] -- ^ REUnion [] is null+ | REConcat [RE a] -- ^ REConcat [] is epsilon+ | RERepeat (RE a)+ | RESymbol a+ deriving (Eq,Ord,Show)+++dfa2re :: (Ord a) => DFA a -> RE a+dfa2re = finalRE . elimStates . modifyTransitions merge . addLoops+ . oneFinalState () epsilonRE . mapTransitions RESymbol + where addLoops fa = newTransitions [(s,s,nullRE) | (s,_) <- states fa] fa+ merge es = [(f,t,unionRE ls) + | ((f,t),ls) <- buildMultiMap [((f,t),l) | (f,t,l) <- es]]++elimStates :: (Ord a) => DFA (RE a) -> DFA (RE a)+elimStates fa =+ case [s | (s,_) <- states fa, isInternal fa s] of+ [] -> fa+ sE:_ -> elimStates $ insertTransitionsWith (\x y -> unionRE [x,y]) ts $ removeState sE fa+ where sAs = nonLoopTransitionsTo sE fa+ sBs = nonLoopTransitionsFrom sE fa+ r2 = unionRE $ loops sE fa+ ts = [(sA, sB, r r1 r3) | (sA,r1) <- sAs, (sB,r3) <- sBs]+ r r1 r3 = concatRE [r1, repeatRE r2, r3]++epsilonRE :: RE a+epsilonRE = REConcat []++nullRE :: RE a+nullRE = REUnion []++isNull :: RE a -> Bool+isNull (REUnion []) = True+isNull _ = False++isEpsilon :: RE a -> Bool+isEpsilon (REConcat []) = True+isEpsilon _ = False++unionRE :: Ord a => [RE a] -> RE a+unionRE = unionOrId . nub' . concatMap toList + where + toList (REUnion xs) = xs+ toList x = [x]+ unionOrId [r] = r+ unionOrId rs = REUnion rs++concatRE :: [RE a] -> RE a+concatRE xs | any isNull xs = nullRE+ | otherwise = case concatMap toList xs of+ [r] -> r+ rs -> REConcat rs+ where+ toList (REConcat xs) = xs+ toList x = [x]++seqRE :: [a] -> RE a+seqRE = concatRE . map RESymbol++repeatRE :: RE a -> RE a+repeatRE x | isNull x || isEpsilon x = epsilonRE+ | otherwise = RERepeat x++finalRE :: Ord a => DFA (RE a) -> RE a+finalRE fa = concatRE [repeatRE r1, r2, + repeatRE (unionRE [r3, concatRE [r4, repeatRE r1, r2]])]+ where + s0 = startState fa+ [sF] = finalStates fa+ r1 = unionRE $ loops s0 fa+ r2 = unionRE $ map snd $ nonLoopTransitionsTo sF fa+ r3 = unionRE $ loops sF fa+ r4 = unionRE $ map snd $ nonLoopTransitionsFrom sF fa++reverseRE :: RE a -> RE a+reverseRE (REConcat xs) = REConcat $ map reverseRE $ reverse xs+reverseRE (REUnion xs) = REUnion (map reverseRE xs)+reverseRE (RERepeat x) = RERepeat (reverseRE x)+reverseRE x = x++minimizeRE :: Ord a => RE a -> RE a+minimizeRE = reverseRE . mergeForward . reverseRE . mergeForward++mergeForward :: Ord a => RE a -> RE a+mergeForward (REUnion xs) = + unionRE [concatRE [mergeForward y,mergeForward (unionRE rs)] | (y,rs) <- buildMultiMap (map firstRE xs)]+mergeForward (REConcat (x:xs)) = concatRE [mergeForward x,mergeForward (REConcat xs)]+mergeForward (RERepeat r) = repeatRE (mergeForward r)+mergeForward r = r++firstRE :: RE a -> (RE a, RE a)+firstRE (REConcat (x:xs)) = (x, REConcat xs)+firstRE r = (r,epsilonRE)++mapRE :: (a -> b) -> RE a -> RE b+mapRE f = mapRE' (RESymbol . f)++mapRE' :: (a -> RE b) -> RE a -> RE b+mapRE' f (REConcat xs) = REConcat (map (mapRE' f) xs)+mapRE' f (REUnion xs) = REUnion (map (mapRE' f) xs)+mapRE' f (RERepeat x) = RERepeat (mapRE' f x)+mapRE' f (RESymbol s) = f s++joinRE :: RE (RE a) -> RE a+joinRE (REConcat xs) = REConcat (map joinRE xs)+joinRE (REUnion xs) = REUnion (map joinRE xs)+joinRE (RERepeat xs) = RERepeat (joinRE xs)+joinRE (RESymbol ss) = ss++symbolsRE :: RE a -> [a]+symbolsRE (REConcat xs) = concatMap symbolsRE xs+symbolsRE (REUnion xs) = concatMap symbolsRE xs+symbolsRE (RERepeat x) = symbolsRE x+symbolsRE (RESymbol x) = [x]++-- Debugging++prRE :: (a -> String) -> RE a -> String+prRE = prRE' 0++prRE' :: Int -> (a -> String) -> RE a -> String+prRE' _ _ (REUnion []) = "<NULL>"+prRE' n f (REUnion xs) = p n 1 (concat (intersperse " | " (map (prRE' 1 f) xs)))+prRE' n f (REConcat xs) = p n 2 (unwords (map (prRE' 2 f) xs))+prRE' n f (RERepeat x) = p n 3 (prRE' 3 f x) ++ "*"+prRE' _ f (RESymbol s) = f s++p n m s | n >= m = "(" ++ s ++ ")"+ | True = s
@@ -0,0 +1,77 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.SISR+--+-- Abstract syntax and pretty printer for SISR,+-- (Semantic Interpretation for Speech Recognition)+----------------------------------------------------------------------+module GF.Speech.SISR (SISRFormat(..), SISRTag, prSISR, + topCatSISR, profileInitSISR, catSISR, profileFinalSISR) where++import Data.List++--import GF.Data.Utilities+--import GF.Infra.Ident+import GF.Infra.Option (SISRFormat(..))+import GF.Grammar.CFG+import GF.Speech.SRG (SRGNT)+import PGF(showCId)++import qualified GF.JavaScript.AbsJS as JS+import qualified GF.JavaScript.PrintJS as JS++type SISRTag = [JS.DeclOrExpr]+++prSISR :: SISRTag -> String+prSISR = JS.printTree++topCatSISR :: String -> SISRFormat -> SISRTag+topCatSISR c fmt = map JS.DExpr [fmtOut fmt `ass` fmtRef fmt c]++profileInitSISR :: CFTerm -> SISRFormat -> SISRTag+profileInitSISR t fmt + | null (usedArgs t) = []+ | otherwise = [JS.Decl [JS.DInit args (JS.EArray [])]]++usedArgs :: CFTerm -> [Int]+usedArgs (CFObj _ ts) = foldr union [] (map usedArgs ts)+usedArgs (CFAbs _ x) = usedArgs x+usedArgs (CFApp x y) = usedArgs x `union` usedArgs y+usedArgs (CFRes i) = [i]+usedArgs _ = []++catSISR :: CFTerm -> SRGNT -> SISRFormat -> SISRTag+catSISR t (c,i) fmt+ | i `elem` usedArgs t = map JS.DExpr + [JS.EIndex (JS.EVar args) (JS.EInt (fromIntegral i)) `ass` fmtRef fmt c]+ | otherwise = []++profileFinalSISR :: CFTerm -> SISRFormat -> SISRTag+profileFinalSISR term fmt = [JS.DExpr $ fmtOut fmt `ass` f term]+ where + f (CFObj n ts) = tree (showCId n) (map f ts)+ f (CFAbs v x) = JS.EFun [var v] [JS.SReturn (f x)]+ f (CFApp x y) = JS.ECall (f x) [f y]+ f (CFRes i) = JS.EIndex (JS.EVar args) (JS.EInt (fromIntegral i))+ f (CFVar v) = JS.EVar (var v)+ f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (showCId typ))]++fmtOut SISR_WD20030401 = JS.EVar (JS.Ident "$")+fmtOut SISR_1_0 = JS.EVar (JS.Ident "out")++fmtRef SISR_WD20030401 c = JS.EVar (JS.Ident ("$" ++ c))+fmtRef SISR_1_0 c = field (JS.EVar (JS.Ident "rules")) c++args = JS.Ident "a"++var v = JS.Ident ("x" ++ show v)++field x y = JS.EMember x (JS.Ident y)++ass = JS.EAssign++tree n xs = obj [("name", JS.EStr n), ("args", JS.EArray xs)]++obj ps = JS.EObj [JS.Prop (JS.StringPropName x) y | (x,y) <- ps]+
@@ -0,0 +1,179 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.SLF+--+-- This module converts a CFG to an SLF finite-state network+-- for use with the ATK recognizer. The SLF format is described+-- in the HTK manual, and an example for use in ATK is shown+-- in the ATK manual.+--+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+module GF.Speech.SLF (slfPrinter,slfGraphvizPrinter,+ slfSubPrinter,slfSubGraphvizPrinter) where++import GF.Data.Utilities+import GF.Grammar.CFG+import GF.Speech.FiniteState+--import GF.Speech.CFG+import GF.Speech.CFGToFA+import GF.Speech.PGFToCFG+import qualified GF.Data.Graphviz as Dot+import PGF+--import PGF.CId++import Control.Monad+import qualified Control.Monad.State as STM+import Data.Char (toUpper)+--import Data.List+import Data.Maybe++data SLFs = SLFs [(String,SLF)] SLF++data SLF = SLF { slfNodes :: [SLFNode], slfEdges :: [SLFEdge] }++data SLFNode = SLFNode { nId :: Int, nWord :: SLFWord, nTag :: Maybe String }+ | SLFSubLat { nId :: Int, nLat :: String }++-- | An SLF word is a word, or the empty string.+type SLFWord = Maybe String++data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }++type SLF_FA = FA State (Maybe CFSymbol) ()++mkFAs :: PGF -> CId -> (SLF_FA, [(String,SLF_FA)])+mkFAs pgf cnc = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])+ where MFA start subs = {- renameSubs $ -} cfgToMFA $ pgfToCFG pgf cnc+ main = let (fa,s,f) = newFA_ in newTransition s f (NonTerminal start) fa++slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()+slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()+ . moveLabelsToNodes . dfa2nfa+{-+-- | Give sequential names to subnetworks.+renameSubs :: MFA -> MFA+renameSubs (MFA start subs) = MFA (newName start) subs'+ where newNames = zip (map fst subs) ["sub"++show n | n <- [0..]]+ newName s = lookup' s newNames+ subs' = [(newName s,renameLabels n) | (s,n) <- subs]+ renameLabels = mapTransitions (mapSymbol newName id)+-}+--+-- * SLF graphviz printing (without sub-networks)+--++slfGraphvizPrinter :: PGF -> CId -> String+slfGraphvizPrinter pgf cnc+ = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc+ where + gvFA = mapStates (fromMaybe "") . mapTransitions (const "")++--+-- * SLF graphviz printing (with sub-networks)+--++slfSubGraphvizPrinter :: PGF -> CId -> String+slfSubGraphvizPrinter pgf cnc = Dot.prGraphviz g+ where (main, subs) = mkFAs pgf cnc+ g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..] + ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs+ m = gvSLFFA Nothing main++gvSLFFA :: Maybe String -> SLF_FA -> STM.State [State] Dot.Graph+gvSLFFA n fa = + liftM (mkCluster n . faToGraphviz . mapStates (maybe "" mfaLabelToGv) + . mapTransitions (const "")) (rename fa)+ where mfaLabelToGv = symbol ("#"++) id+ mkCluster Nothing = id+ mkCluster (Just x) + = Dot.setName ("cluster_"++x) . Dot.setAttr "label" x+ rename fa = do+ names <- STM.get+ let fa' = renameStates names fa+ names' = unusedNames fa'+ STM.put names'+ return fa'++--+-- * SLF printing (without sub-networks)+--++slfPrinter :: PGF -> CId -> String+slfPrinter pgf cnc+ = prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc++--+-- * SLF printing (with sub-networks)+--++-- | Make a network with subnetworks in SLF+slfSubPrinter :: PGF -> CId -> String+slfSubPrinter pgf cnc = prSLFs slfs+ where + (main,subs) = mkFAs pgf cnc+ slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main)+ faToSLF = automatonToSLF mfaNodeToSLFNode++automatonToSLF :: (Int -> a -> SLFNode) -> FA State a () -> SLF+automatonToSLF mkNode fa = SLF { slfNodes = ns, slfEdges = es }+ where ns = map (uncurry mkNode) (states fa)+ es = zipWith (\i (f,t,()) -> mkSLFEdge i (f,t)) [0..] (transitions fa)++mfaNodeToSLFNode :: Int -> Maybe CFSymbol -> SLFNode+mfaNodeToSLFNode i l = case l of+ Nothing -> mkSLFNode i Nothing+ Just (Terminal x) -> mkSLFNode i (Just x)+ Just (NonTerminal s) -> mkSLFSubLat i s++mkSLFNode :: Int -> Maybe String -> SLFNode+mkSLFNode i Nothing = SLFNode { nId = i, nWord = Nothing, nTag = Nothing }+mkSLFNode i (Just w)+ | isNonWord w = SLFNode { nId = i, + nWord = Nothing, + nTag = Just w }+ | otherwise = SLFNode { nId = i, + nWord = Just (map toUpper w), + nTag = Just w }++mkSLFSubLat :: Int -> String -> SLFNode+mkSLFSubLat i sub = SLFSubLat { nId = i, nLat = sub }++mkSLFEdge :: Int -> (Int,Int) -> SLFEdge+mkSLFEdge i (f,t) = SLFEdge { eId = i, eStart = f, eEnd = t }++prSLFs :: SLFs -> String+prSLFs (SLFs subs main) = unlinesS (map prSub subs ++ [prOneSLF main]) ""+ where prSub (n,s) = showString "SUBLAT=" . shows n + . nl . prOneSLF s . showString "." . nl++prSLF :: SLF -> String+prSLF slf = prOneSLF slf ""++prOneSLF :: SLF -> ShowS+prOneSLF (SLF { slfNodes = ns, slfEdges = es}) + = header . unlinesS (map prNode ns) . nl . unlinesS (map prEdge es) . nl+ where+ header = prFields [("N",show (length ns)),("L", show (length es))] . nl+ prNode (SLFNode { nId = i, nWord = w, nTag = t })+ = prFields $ [("I",show i),("W",showWord w)] + ++ maybe [] (\t -> [("s",t)]) t+ prNode (SLFSubLat { nId = i, nLat = l }) + = prFields [("I",show i),("L",show l)]+ prEdge e = prFields [("J",show (eId e)),("S",show (eStart e)),("E",show (eEnd e))]++-- | Check if a word should not correspond to a word in the SLF file.+isNonWord :: String -> Bool+isNonWord = any isPunct++isPunct :: Char -> Bool+isPunct c = c `elem` "-_.;.,?!()[]{}"++showWord :: SLFWord -> String+showWord Nothing = "!NULL"+showWord (Just w) | null w = "!NULL"+ | otherwise = w++prFields :: [(String,String)] -> ShowS+prFields fs = unwordsS [ showString l . showChar '=' . showString v | (l,v) <- fs ]
@@ -0,0 +1,199 @@+----------------------------------------------------------------------+-- |+-- Module : SRG+--+-- Representation of, conversion to, and utilities for +-- printing of a general Speech Recognition Grammar. +--+-- FIXME: remove \/ warn \/ fail if there are int \/ string literal+-- categories in the grammar+----------------------------------------------------------------------+module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol+ , SRGNT, CFTerm+ , ebnfPrinter+ , makeNonLeftRecursiveSRG+ , makeNonRecursiveSRG+ , isExternalCat+ , lookupFM_+ ) where++--import GF.Data.Operations+import GF.Data.Utilities+--import GF.Infra.Ident+import GF.Infra.Option+import GF.Grammar.CFG+import GF.Speech.PGFToCFG+--import GF.Data.Relation+--import GF.Speech.FiniteState+import GF.Speech.RegExp+import GF.Speech.CFGToFA+--import GF.Infra.Option+import PGF++import Data.List+--import Data.Maybe (fromMaybe, maybeToList)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++--import Debug.Trace++data SRG = SRG { srgName :: String -- ^ grammar name+ , srgStartCat :: Cat -- ^ start category name+ , srgExternalCats :: Set Cat+ , srgLanguage :: Maybe String -- ^ The language for which the grammar + -- is intended, e.g. en-UK+ , srgRules :: [SRGRule] + }+ deriving (Eq,Show)++data SRGRule = SRGRule Cat [SRGAlt]+ deriving (Eq,Show)++-- | maybe a probability, a rule name and an EBNF right-hand side+data SRGAlt = SRGAlt (Maybe Double) CFTerm SRGItem+ deriving (Eq,Show)++type SRGItem = RE SRGSymbol++type SRGSymbol = Symbol SRGNT Token++-- | An SRG non-terminal. Category name and its number in the profile.+type SRGNT = (Cat, Int)++ebnfPrinter :: Options -> PGF -> CId -> String+ebnfPrinter opts pgf cnc = prSRG opts $ makeSRG opts pgf cnc++-- | Create a compact filtered non-left-recursive SRG. +makeNonLeftRecursiveSRG :: Options -> PGF -> CId -> SRG+makeNonLeftRecursiveSRG opts = makeSRG opts'+ where+ opts' = setDefaultCFGTransform opts CFGNoLR True++makeSRG :: Options -> PGF -> CId -> SRG+makeSRG opts = mkSRG cfgToSRG preprocess+ where+ cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]+ preprocess = maybeTransform opts CFGMergeIdentical mergeIdentical+ . maybeTransform opts CFGNoLR removeLeftRecursion + . maybeTransform opts CFGRegular makeRegular+ . maybeTransform opts CFGTopDownFilter topDownFilter+ . maybeTransform opts CFGBottomUpFilter bottomUpFilter+ . maybeTransform opts CFGRemoveCycles removeCycles + . maybeTransform opts CFGStartCatOnly purgeExternalCats++setDefaultCFGTransform :: Options -> CFGTransform -> Bool -> Options+setDefaultCFGTransform opts t b = setCFGTransform t b `addOptions` opts++maybeTransform :: Options -> CFGTransform -> (CFG -> CFG) -> (CFG -> CFG)+maybeTransform opts t f = if cfgTransform opts t then f else id+{-+traceStats s g = trace ("---- " ++ s ++ ": " ++ stats g {- ++ "\n" ++ prCFRules g ++ "----" -}) g++stats g = "Categories: " ++ show (countCats g)+ ++ ", External categories: " ++ show (Set.size (cfgExternalCats g))+ ++ ", Rules: " ++ show (countRules g)+-}+makeNonRecursiveSRG :: Options + -> PGF+ -> CId -- ^ Concrete syntax name.+ -> SRG+makeNonRecursiveSRG opts = mkSRG cfgToSRG id+ where+ cfgToSRG cfg = [SRGRule l [SRGAlt Nothing dummyCFTerm (dfaToSRGItem dfa)] | (l,dfa) <- dfas]+ where+ MFA _ dfas = cfgToMFA cfg+ dfaToSRGItem = mapRE dummySRGNT . minimizeRE . dfa2re+ dummyCFTerm = CFMeta (mkCId "dummy")+ dummySRGNT = mapSymbol (\c -> (c,0)) id++mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG+mkSRG mkRules preprocess pgf cnc =+ SRG { srgName = showCId cnc,+ srgStartCat = cfgStartCat cfg,+ srgExternalCats = cfgExternalCats cfg,+ srgLanguage = languageCode pgf cnc,+ srgRules = mkRules cfg }+ where cfg = renameCats (showCId cnc) $ preprocess $ pgfToCFG pgf cnc++-- | Renames all external cats C to C_cat, and all internal cats C_X (where X is any string), +-- to C_N where N is an integer.+renameCats :: String -> CFG -> CFG+renameCats prefix cfg = mapCFGCats renameCat cfg+ where renameCat c | isExternal c = c ++ "_cat"+ | otherwise = Map.findWithDefault (badCat c) c names+ isExternal c = c `Set.member` cfgExternalCats cfg + catsByPrefix = buildMultiMap [(takeWhile (/='_') cat, cat) | cat <- allCats' cfg, not (isExternal cat)]+ names = Map.fromList [(c,pref++"_"++show i) | (pref,cs) <- catsByPrefix, (c,i) <- zip cs [1..]]+ badCat c = error ("GF.Speech.SRG.renameCats: " ++ c ++ "\n" ++ prCFG cfg)++cfRulesToSRGRule :: [CFRule] -> SRGRule+cfRulesToSRGRule rs@(r:_) = SRGRule (ruleLhs r) rhs+ where + alts = [((n,Nothing),mkSRGSymbols 0 ss) | Rule c ss n <- rs]+ rhs = [SRGAlt p n (srgItem sss) | ((n,p),sss) <- buildMultiMap alts ]++ mkSRGSymbols _ [] = []+ mkSRGSymbols i (NonTerminal c:ss) = NonTerminal (c,i) : mkSRGSymbols (i+1) ss+ mkSRGSymbols i (Terminal t:ss) = Terminal t : mkSRGSymbols i ss++srgLHSCat :: SRGRule -> Cat+srgLHSCat (SRGRule c _) = c++isExternalCat :: SRG -> Cat -> Bool+isExternalCat srg c = c `Set.member` srgExternalCats srg++--+-- * Size-optimized EBNF SRGs+--++srgItem :: [[SRGSymbol]] -> SRGItem+srgItem = unionRE . map mergeItems . sortGroupBy (compareBy filterCats)+-- non-optimizing version:+--srgItem = unionRE . map seqRE++-- | Merges a list of right-hand sides which all have the same +-- sequence of non-terminals.+mergeItems :: [[SRGSymbol]] -> SRGItem+mergeItems = minimizeRE . ungroupTokens . minimizeRE . unionRE . map seqRE . map groupTokens++groupTokens :: [SRGSymbol] -> [Symbol SRGNT [Token]]+groupTokens [] = []+groupTokens (Terminal t:ss) = case groupTokens ss of+ Terminal ts:ss' -> Terminal (t:ts):ss'+ ss' -> Terminal [t]:ss'+groupTokens (NonTerminal c:ss) = NonTerminal c : groupTokens ss++ungroupTokens :: RE (Symbol SRGNT [Token]) -> RE SRGSymbol+ungroupTokens = joinRE . mapRE (symbol (RESymbol . NonTerminal) (REConcat . map (RESymbol . Terminal)))++--+-- * Utilities for building and printing SRGs+--++prSRG :: Options -> SRG -> String+prSRG opts srg = prProductions $ map prRule $ ext ++ int+ where + sisr = flag optSISR opts+ (ext,int) = partition (isExternalCat srg . srgLHSCat) (srgRules srg)+ prRule (SRGRule c alts) = (c,unwords (intersperse "|" (concatMap prAlt alts)))+ prAlt (SRGAlt _ t rhs) = + -- FIXME: hack: we high-jack the --sisr flag to add + -- a simple lambda calculus format for semantic interpretation+ -- Maybe the --sisr flag should be renamed.+ case sisr of+ Just _ -> + -- copy tags to each part of a top-level union,+ -- to get simpler output+ case rhs of+ REUnion xs -> map prOneAlt xs+ _ -> [prOneAlt rhs]+ where prOneAlt a = prRE prSym a ++ " { " ++ prCFTerm t ++ " }"+ Nothing -> [prRE prSym rhs]+ prSym = symbol fst (\t -> "\""++ t ++"\"")++lookupFM_ :: (Ord key, Show key) => Map key elt -> key -> elt+lookupFM_ fm k = Map.findWithDefault err k fm+ where err = error $ "Key not found: " ++ show k+ ++ "\namong " ++ show (Map.keys fm)
@@ -0,0 +1,128 @@+----------------------------------------------------------------------+-- |+-- Module : PrJSRGS_ABNF+-- Maintainer : BB+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/11/01 20:09:04 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.16 $+--+-- This module prints a CFG as a JSGF grammar.+--+-- FIXME: remove \/ warn \/ fail if there are int \/ string literal+-- categories in the grammar+--+-- FIXME: convert to UTF-8+-----------------------------------------------------------------------------++module GF.Speech.SRGS_ABNF (srgsAbnfPrinter, srgsAbnfNonRecursivePrinter) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++--import GF.Data.Utilities+import GF.Infra.Option+import GF.Grammar.CFG+import GF.Speech.SISR as SISR+import GF.Speech.SRG+import GF.Speech.RegExp+import PGF (PGF, CId)++--import Data.Char+import Data.List+import Data.Maybe+import GF.Text.Pretty+--import Debug.Trace++width :: Int+width = 75++srgsAbnfPrinter :: Options+ -> PGF -> CId -> String+srgsAbnfPrinter opts pgf cnc = showDoc $ prABNF sisr $ makeNonLeftRecursiveSRG opts pgf cnc+ where sisr = flag optSISR opts++srgsAbnfNonRecursivePrinter :: Options -> PGF -> CId -> String+srgsAbnfNonRecursivePrinter opts pgf cnc = showDoc $ prABNF Nothing $ makeNonRecursiveSRG opts pgf cnc++showDoc = renderStyle (style { lineLength = width })++prABNF :: Maybe SISRFormat -> SRG -> Doc+prABNF sisr srg+ = header $++$ foldr ($++$) empty (map prRule (srgRules srg))+ where+ header = "#ABNF 1.0 UTF-8;" $$+ meta "description" ("Speech recognition grammar for " ++ srgName srg) $$+ meta "generator" "Grammatical Framework" $$+ language $$ tagFormat $$ mainCat+ language = maybe empty (\l -> "language" <+> l <> ';') (srgLanguage srg)+ tagFormat | isJust sisr = "tag-format" <+> "<semantics/1.0>" <> ';'+ | otherwise = empty+ mainCat = "root" <+> prCat (srgStartCat srg) <> ';'+ prRule (SRGRule cat alts) = rule (isExternalCat srg cat) cat (map prAlt alts)+ prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag]+ where initTag = tag sisr (profileInitSISR n)+ finalTag = tag sisr (profileFinalSISR n)+ p = if isEmpty initTag && isEmpty finalTag then id else parens++prCat :: Cat -> Doc+prCat c = '$' <> c++prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc+prItem sisr t = f 0+ where+ f _ (REUnion []) = pp "$VOID"+ f p (REUnion xs) + | not (null es) = brackets (f 0 (REUnion nes))+ | otherwise = (if p >= 1 then parens else id) (alts (map (f 1) xs))+ where (es,nes) = partition isEpsilon xs+ f _ (REConcat []) = pp "$NULL"+ f p (REConcat xs) = (if p >= 3 then parens else id) (fsep (map (f 2) xs))+ f p (RERepeat x) = f 3 x <> "<0->"+ f _ (RESymbol s) = prSymbol sisr t s+++prSymbol :: Maybe SISRFormat -> CFTerm -> SRGSymbol -> Doc+prSymbol sisr cn (NonTerminal n@(c,_)) = prCat c <+> tag sisr (catSISR cn n)+prSymbol _ cn (Terminal t) + | all isPunct t = empty -- removes punctuation+ | otherwise = pp t -- FIXME: quote if there is whitespace or odd chars++tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> Doc+tag Nothing _ = empty+tag (Just fmt) t = + case t fmt of+ [] -> empty+ -- grr, silly SRGS ABNF does not have an escaping mechanism+ ts | '{' `elem` x || '}' `elem` x -> "{!{" <+> x <+> "}!}"+ | otherwise -> "{" <+> x <+> "}"+ where x = prSISR ts++isPunct :: Char -> Bool+isPunct c = c `elem` "-_.;.,?!"+{-+comment :: String -> Doc+comment s = "//" <+> s+-}+alts :: [Doc] -> Doc+alts = fsep . prepunctuate ("| ")++rule :: Bool -> Cat -> [Doc] -> Doc+rule pub c xs = p <+> prCat c <+> '=' <+> nest 2 (alts xs) <+> ';'+ where p = if pub then pp "public" else empty++meta :: String -> String -> Doc+meta n v = "meta" <+> show n <+> "is" <+> show v <> ';'++-- Pretty-printing utilities++emptyLine :: Doc+emptyLine = pp ""++--prepunctuate :: Doc -> [Doc] -> [Doc]+prepunctuate _ [] = []+prepunctuate p (x:xs) = x : map (p <>) xs++($++$) :: Doc -> Doc -> Doc+x $++$ y = x $$ emptyLine $$ y+
@@ -0,0 +1,105 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.SRGS_XML+--+-- Prints an SRGS XML speech recognition grammars.+----------------------------------------------------------------------+module GF.Speech.SRGS_XML (srgsXmlPrinter, srgsXmlNonRecursivePrinter) where++--import GF.Data.Utilities+import GF.Data.XML+import GF.Infra.Option+import GF.Grammar.CFG+import GF.Speech.RegExp+import GF.Speech.SISR as SISR+import GF.Speech.SRG+import PGF (PGF, CId, Token)++--import Control.Monad+--import Data.Char (toUpper,toLower)+import Data.List+import Data.Maybe+--import qualified Data.Map as Map++srgsXmlPrinter :: Options+ -> PGF -> CId -> String+srgsXmlPrinter opts pgf cnc = prSrgsXml sisr $ makeNonLeftRecursiveSRG opts pgf cnc+ where sisr = flag optSISR opts++srgsXmlNonRecursivePrinter :: Options -> PGF -> CId -> String+srgsXmlNonRecursivePrinter opts pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG opts pgf cnc+++prSrgsXml :: Maybe SISRFormat -> SRG -> String+prSrgsXml sisr srg = showXMLDoc (optimizeSRGS xmlGr)+ where+ xmlGr = grammar sisr (srgStartCat srg) (srgLanguage srg) $+ [meta "description" + ("SRGS XML speech recognition grammar for " ++ srgName srg ++ "."),+ meta "generator" "Grammatical Framework"]+ ++ map ruleToXML (srgRules srg)+ ruleToXML (SRGRule cat alts) = Tag "rule" ([("id",cat)]++pub) (prRhs alts)+ where pub = if isExternalCat srg cat then [("scope","public")] else []+ prRhs rhss = [oneOf (map (mkProd sisr) rhss)] ++mkProd :: Maybe SISRFormat -> SRGAlt -> XML+mkProd sisr (SRGAlt mp n rhs) = Tag "item" [] (ti ++ [x] ++ tf)+ where x = mkItem sisr n rhs+ ti = tag sisr (profileInitSISR n)+ tf = tag sisr (profileFinalSISR n)++mkItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> XML+mkItem sisr cn = f+ where + f (REUnion []) = ETag "ruleref" [("special","VOID")]+ f (REUnion xs) + | not (null es) = Tag "item" [("repeat","0-1")] [f (REUnion nes)]+ | otherwise = oneOf (map f xs)+ where (es,nes) = partition isEpsilon xs+ f (REConcat []) = ETag "ruleref" [("special","NULL")]+ f (REConcat xs) = Tag "item" [] (map f xs)+ f (RERepeat x) = Tag "item" [("repeat","0-")] [f x]+ f (RESymbol s) = symItem sisr cn s++symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML+symItem sisr cn (NonTerminal n@(c,_)) = + Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)]] ++ tag sisr (catSISR cn n)+symItem _ _ (Terminal t) = Tag "item" [] [Data (showToken t)]++tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> [XML]+tag Nothing _ = []+tag (Just fmt) t = case t fmt of+ [] -> []+ ts -> [Tag "tag" [] [Data (prSISR ts)]]++showToken :: Token -> String+showToken t = t++oneOf :: [XML] -> XML+oneOf = Tag "one-of" []++grammar :: Maybe SISRFormat+ -> String -- ^ root+ -> Maybe String -- ^language+ -> [XML] -> XML+grammar sisr root ml = + Tag "grammar" $ [("xmlns","http://www.w3.org/2001/06/grammar"),+ ("version","1.0"),+ ("mode","voice"),+ ("root",root)]+ ++ (if isJust sisr then [("tag-format","semantics/1.0")] else [])+ ++ maybe [] (\l -> [("xml:lang", l)]) ml++meta :: String -> String -> XML+meta n c = ETag "meta" [("name",n),("content",c)]++optimizeSRGS :: XML -> XML+optimizeSRGS = bottomUpXML f + where f (Tag "item" [] [x@(Tag "item" _ _)]) = x+ f (Tag "item" [] [x@(Tag "one-of" _ _)]) = x+ f (Tag "item" as [Tag "item" [] xs]) = Tag "item" as xs+ f (Tag "item" as xs) = Tag "item" as (map g xs)+ where g (Tag "item" [] [x@(ETag "ruleref" _)]) = x+ g x = x+ f (Tag "one-of" [] [x]) = x+ f x = x
@@ -0,0 +1,238 @@+----------------------------------------------------------------------+-- |+-- Module : GF.Speech.VoiceXML+--+-- Creates VoiceXML dialogue systems from PGF grammars.+-----------------------------------------------------------------------------+module GF.Speech.VoiceXML (grammar2vxml) where++--import GF.Data.Operations+--import GF.Data.Str (sstrV)+--import GF.Data.Utilities+import GF.Data.XML+--import GF.Infra.Ident+import PGF+import PGF.Internal++--import Control.Monad (liftM)+import Data.List (intersperse) -- isPrefixOf, find+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)++--import Debug.Trace++-- | the main function+grammar2vxml :: PGF -> CId -> String+grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) ""+ where skel = pgfSkeleton pgf+ name = showCId cnc+ qs = catQuestions pgf cnc (map fst skel)+ language = languageCode pgf cnc+ start = lookStartCat pgf++--+-- * VSkeleton: a simple description of the abstract syntax.+--++type Skeleton = [(CId, [(CId, [CId])])]++pgfSkeleton :: PGF -> Skeleton+pgfSkeleton pgf = [(c,[(f,fst (catSkeleton (lookType (abstract pgf) f))) | (_,f) <- fs]) + | (c,(_,fs,_)) <- Map.toList (cats (abstract pgf))]++--+-- * Questions to ask +--++type CatQuestions = [(CId,String)]++catQuestions :: PGF -> CId -> [CId] -> CatQuestions+catQuestions pgf cnc cats = [(c,catQuestion pgf cnc c) | c <- cats]++catQuestion :: PGF -> CId -> CId -> String+catQuestion pgf cnc cat = showPrintName pgf cnc cat+++{-+lin :: StateGrammar -> String -> Err String+lin gr fun = do+ tree <- string2treeErr gr fun+ let ls = map unt $ linTree2strings noMark g c tree+ case ls of+ [] -> fail $ "No linearization of " ++ fun+ l:_ -> return l+ where c = cncId gr+ g = stateGrammarST gr+ unt = formatAsText +-}++getCatQuestion :: CId -> CatQuestions -> String+getCatQuestion c qs = + fromMaybe (error "No question for category " ++ showCId c) (lookup c qs)++--+-- * Generate VoiceXML+--++skel2vxml :: String -> Maybe String -> CId -> Skeleton -> CatQuestions -> XML+skel2vxml name language start skel qs = + vxml language ([startForm] ++ concatMap (uncurry (catForms gr qs)) skel)+ where + gr = grammarURI name+ startForm = Tag "form" [] [subdialog "sub" [("src", "#"++catFormId start)] + [param "old" "{ name : '?' }"]]++grammarURI :: String -> String+grammarURI name = name ++ ".grxml"+++catForms :: String -> CatQuestions -> CId -> [(CId, [CId])] -> [XML]+catForms gr qs cat fs = + comments [showCId cat ++ " category."]+ ++ [cat2form gr qs cat fs] ++cat2form :: String -> CatQuestions -> CId -> [(CId, [CId])] -> XML+cat2form gr qs cat fs = + form (catFormId cat) $ + [var "old" Nothing, + blockCond "old.name != '?'" [assign "term" "old"],+ field "term" []+ [promptString (getCatQuestion cat qs), + vxmlGrammar (gr++"#"++catFormId cat)+ ]+ ]+ ++ concatMap (uncurry (fun2sub gr cat)) fs+ ++ [block [return_ ["term"]{-]-}]]++fun2sub :: String -> CId -> CId -> [CId] -> [XML]+fun2sub gr cat fun args = + comments [showCId fun ++ " : (" + ++ concat (intersperse ", " (map showCId args))+ ++ ") " ++ showCId cat] ++ ss+ where + ss = zipWith mkSub [0..] args+ mkSub n t = subdialog s [("src","#"++catFormId t),+ ("cond","term.name == "++string (showCId fun))] + [param "old" v,+ filled [] [assign v (s++".term")]]+ where s = showCId fun ++ "_" ++ show n+ v = "term.args["++show n++"]"++catFormId :: CId -> String+catFormId c = showCId c ++ "_cat"+++--+-- * VoiceXML stuff+--++vxml :: Maybe String -> [XML] -> XML+vxml ml = Tag "vxml" $ [("version","2.0"),+ ("xmlns","http://www.w3.org/2001/vxml")]+ ++ maybe [] (\l -> [("xml:lang", l)]) ml++form :: String -> [XML] -> XML+form id xs = Tag "form" [("id", id)] xs++field :: String -> [(String,String)] -> [XML] -> XML+field name attrs = Tag "field" ([("name",name)]++attrs)++subdialog :: String -> [(String,String)] -> [XML] -> XML+subdialog name attrs = Tag "subdialog" ([("name",name)]++attrs)++filled :: [(String,String)] -> [XML] -> XML+filled = Tag "filled"++vxmlGrammar :: String -> XML+vxmlGrammar uri = ETag "grammar" [("src",uri)]++prompt :: [XML] -> XML+prompt = Tag "prompt" []++promptString :: String -> XML+promptString p = prompt [Data p]+{-+reprompt :: XML+reprompt = ETag "reprompt" []+-}+assign :: String -> String -> XML+assign n e = ETag "assign" [("name",n),("expr",e)]+{-+value :: String -> XML+value expr = ETag "value" [("expr",expr)]++if_ :: String -> [XML] -> XML+if_ c b = if_else c b []++if_else :: String -> [XML] -> [XML] -> XML+if_else c t f = cond [(c,t)] f++cond :: [(String,[XML])] -> [XML] -> XML+cond ((c,b):rest) els = Tag "if" [("cond",c)] (b ++ es)+ where es = [Tag "elseif" [("cond",c')] b' | (c',b') <- rest] + ++ if null els then [] else (Tag "else" [] []:els)++goto_item :: String -> XML+goto_item nextitem = ETag "goto" [("nextitem",nextitem)]+-}+return_ :: [String] -> XML+return_ names = ETag "return" [("namelist", unwords names)]++block :: [XML] -> XML+block = Tag "block" []++blockCond :: String -> [XML] -> XML+blockCond cond = Tag "block" [("cond", cond)]+{-+throw :: String -> String -> XML+throw event msg = Tag "throw" [("event",event),("message",msg)] []++nomatch :: [XML] -> XML+nomatch = Tag "nomatch" []++help :: [XML] -> XML+help = Tag "help" []+-}+param :: String -> String -> XML+param name expr = ETag "param" [("name",name),("expr",expr)]++var :: String -> Maybe String -> XML+var name expr = ETag "var" ([("name",name)]++e)+ where e = maybe [] ((:[]) . (,) "expr") expr+{-+script :: String -> XML+script s = Tag "script" [] [CData s]++scriptURI :: String -> XML+scriptURI uri = Tag "script" [("uri", uri)] []+-}+--+-- * ECMAScript stuff+--++string :: String -> String+string s = "'" ++ concatMap esc s ++ "'"+ where esc '\'' = "\\'"+ esc c = [c]++{-+--+-- * List stuff+--++isListCat :: (CId, [(CId, [CId])]) -> Bool+isListCat (cat,rules) = "List" `isPrefixOf` showIdent cat && length rules == 2+ && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs+ where c = drop 4 (showIdent cat)+ fs = map (showIdent . fst) rules++isBaseFun :: CId -> Bool+isBaseFun f = "Base" `isPrefixOf` showIdent f++isConsFun :: CId -> Bool+isConsFun f = "Cons" `isPrefixOf` showIdent f++baseSize :: (CId, [(CId, [CId])]) -> Int+baseSize (_,rules) = length bs+ where Just (_,bs) = find (isBaseFun . fst) rules+-}
@@ -0,0 +1,19 @@+module GF.Support(+ -- * Supporting infrastructure and system utilities+ module GF.Infra.Location,+ module GF.Infra.Option,+ module GF.Data.Operations,+ module GF.Infra.UseIO,+ module GF.System.Catch,+ module GF.System.Console,+ -- ** Binary serialisation+ Binary,encode,decode,encodeFile,decodeFile+ ) where++import GF.Infra.Location+import GF.Data.Operations+import GF.Infra.Option+import GF.Infra.UseIO+import GF.System.Catch+import GF.System.Console+import Data.Binary
@@ -0,0 +1,7 @@+-- | Backwards compatible 'catch' and 'try'+module GF.System.Catch where+import qualified System.IO.Error as S++-- ** Backwards compatible try and catch+catch = S.catchIOError+try = S.tryIOError
@@ -0,0 +1,26 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- | A variant of 'Control.Concurrent.setNumCapabilities' that automatically+-- detects the number of processors in the system.+module GF.System.Concurrency(+ -- * Controlling parallelism+ setNumCapabilities,getNumberOfProcessors) where+import qualified Control.Concurrent as C+import Foreign.C.Types(CInt(..))+++++-- | Set parallelism to a given number, or use the number of processors.+-- Returns 'False' if compiled with GHC<7.6 and the desired number of threads+-- hasn't already been set with @+RTS -N/n/ -RTS@.+setNumCapabilities opt_n =+ do n <- maybe getNumberOfProcessors return opt_n+ C.setNumCapabilities n+ return True++-- | Returns the number of processors in the system.+getNumberOfProcessors = fmap fromEnum c_getNumberOfProcessors++-- | According to comments in cabal-install cbits/getnumprocessors.c+-- this function is part of the RTS of GHC>=6.12.+foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt
@@ -0,0 +1,71 @@+{-# LANGUAGE CPP #-}+module GF.System.Console(+ -- ** Console IO+ -- *** Changing which character encoding to use for console IO+ setConsoleEncoding,changeConsoleEncoding,+ -- *** Console colors+ TermColors(..),getTermColors+) where+import System.IO+import Control.Monad(guard)+import Control.Monad.Trans(MonadIO(..))+#ifdef mingw32_HOST_OS+import System.Win32.Console+import System.Win32.NLS+#else+import System.Console.Terminfo+#endif++-- | Set the console encoding (for Windows, has no effect on Unix-like systems)+setConsoleEncoding =+#ifdef mingw32_HOST_OS+ do codepage <- getACP+ setCP codepage+ setEncoding ("CP"++show codepage)+#endif+ return () :: IO ()++changeConsoleEncoding code =+ do+#ifdef mingw32_HOST_OS+ maybe (return ()) setCP (readCP code)+#endif+ setEncoding code++setEncoding code =+ do enc <- mkTextEncoding code+ hSetEncoding stdin enc+ hSetEncoding stdout enc+ hSetEncoding stderr enc++#ifdef mingw32_HOST_OS+setCP codepage =+ do setConsoleCP codepage+ setConsoleOutputCP codepage++readCP code =+ case code of+ 'C':'P':c -> case reads c of+ [(cp,"")] -> Just cp+ _ -> Nothing+ "UTF-8" -> Just 65001+ _ -> Nothing+#endif++data TermColors = TermColors { redFg,blueFg,restore :: String } deriving Show+noTermColors = TermColors "" "" ""++getTermColors :: MonadIO m => m TermColors+#ifdef mingw32_HOST_OS+getTermColors = return noTermColors+#else+getTermColors =+ liftIO $+ do term <- setupTermFromEnv+ return $ maybe noTermColors id $ getCapability term $+ do n <- termColors+ guard (n>=8)+ fg <- setForegroundColor+ restore <- restoreDefaultColors+ return $ TermColors (fg Red) (fg Blue) restore+#endif
@@ -0,0 +1,25 @@+-- | Isolate backwards incompatible library changes to 'getModificationTime'+-- and provide lifted versions of some directory operations+module GF.System.Directory(module GF.System.Directory,module D) where+import Control.Monad.Trans(MonadIO(..))+import qualified System.Directory as D+import System.Directory as D+ hiding (canonicalizePath,createDirectoryIfMissing,+ doesDirectoryExist,doesFileExist,getModificationTime,+ getCurrentDirectory,getDirectoryContents,getPermissions,+ removeFile,renameFile)+import Data.Time.Compat++canonicalizePath path = liftIO $ D.canonicalizePath path+createDirectoryIfMissing b = liftIO . D.createDirectoryIfMissing b+doesDirectoryExist path = liftIO $ D.doesDirectoryExist path+doesFileExist path = liftIO $ D.doesFileExist path+getModificationTime path = liftIO $ fmap toUTCTime (D.getModificationTime path)+getDirectoryContents path = liftIO $ D.getDirectoryContents path++getCurrentDirectory :: MonadIO io => io FilePath+getCurrentDirectory = liftIO D.getCurrentDirectory+getPermissions path = liftIO $ D.getPermissions path++removeFile path = liftIO $ D.removeFile path+renameFile path = liftIO . D.renameFile path
@@ -0,0 +1,29 @@+----------------------------------------------------------------------+-- |+-- Module : GF.System.NoSignal+-- Maintainer : Bjorn Bringert+-- Stability : (stability)+-- Portability : (portability)+--+-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.1 $+--+-- Dummy implementation of signal handling.+-----------------------------------------------------------------------------++module GF.System.NoSignal where++import Control.Exception (Exception,catch)+import Prelude hiding (catch)++{-# NOINLINE runInterruptibly #-}+runInterruptibly :: IO a -> IO (Either Exception a)+--runInterruptibly = fmap Right+runInterruptibly a = + p `catch` h+ where p = a >>= \x -> return $! Right $! x+ h e = return $ Left e++blockInterrupt :: IO a -> IO a+blockInterrupt = id
@@ -0,0 +1,18 @@+module GF.System.Process where+import System.Process+import System.IO(hGetContents,hClose,hPutStr)+import Control.Concurrent(forkIO)+import GF.System.Catch(try)++-- | Feed some input to a shell process and read the output lazily+readShellProcess :: String -- ^ shell command+ -> String -- ^ input to shell command+ -> IO String -- ^ output from shell command+readShellProcess cmd input =+ do (Just stdin,Just stdout,Nothing,ph) <-+ createProcess (shell cmd){std_in=CreatePipe,std_out=CreatePipe}+ forkIO $ do try $ hPutStr stdin input+ try $ hClose stdin+ waitForProcess ph+ return ()+ hGetContents stdout
@@ -0,0 +1,27 @@+{-# OPTIONS -cpp #-}++----------------------------------------------------------------------+-- |+-- Module : GF.System.Signal+-- Maintainer : Bjorn Bringert+-- Stability : (stability)+-- Portability : (portability)+--+-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.3 $+--+-- Import the right singal handling module.+-----------------------------------------------------------------------------++module GF.System.Signal (runInterruptibly,blockInterrupt) where++#ifdef USE_INTERRUPT++import GF.System.UseSignal (runInterruptibly,blockInterrupt)++#else++import GF.System.NoSignal (runInterruptibly,blockInterrupt)++#endif
@@ -0,0 +1,72 @@+{-# OPTIONS -cpp #-}+----------------------------------------------------------------------+-- |+-- Module : GF.System.UseSignal+-- Maintainer : Bjorn Bringert+-- Stability : (stability)+-- Portability : (portability)+--+-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $+-- > CVS $Revision: 1.1 $+--+-- Allows SIGINT (Ctrl-C) to interrupt computations.+-----------------------------------------------------------------------------++module GF.System.UseSignal where++import Control.Concurrent (myThreadId, killThread)+import Control.Exception (SomeException,catch)+import Prelude hiding (catch)+--import System.IO++#ifdef mingw32_HOST_OS+import GHC.ConsoleHandler++myInstallHandler handler = installHandler handler+myCatch = Catch . const+myIgnore = Ignore+#else+import System.Posix.Signals++myInstallHandler handler = installHandler sigINT handler Nothing+myCatch = Catch+myIgnore = Ignore+#endif++{-# NOINLINE runInterruptibly #-}++-- | Run an IO action, and allow it to be interrupted+-- by a SIGINT to the current process. Returns+-- an exception if the process did not complete +-- normally.+-- NOTES: +-- * This will replace any existing SIGINT+-- handler during the action. After the computation +-- has completed the existing handler will be restored.+-- * If the IO action is lazy (e.g. using readFile,+-- unsafeInterleaveIO etc.) the lazy computation will+-- not be interruptible, as it will be performed+-- after the signal handler has been removed.+runInterruptibly :: IO a -> IO (Either SomeException a)+runInterruptibly a = + do t <- myThreadId+ oldH <- myInstallHandler (myCatch (killThread t))+ x <- p `catch` h+ myInstallHandler oldH+ return x+ where p = a >>= \x -> return $! Right $! x+ h e = return $ Left e++-- | Like 'runInterruptibly', but always returns (), whether+-- the computation fails or not.+runInterruptibly_ :: IO () -> IO ()+runInterruptibly_ = fmap (either (const ()) id) . runInterruptibly++-- | Run an action with SIGINT blocked.+blockInterrupt :: IO a -> IO a+blockInterrupt a = + do oldH <- myInstallHandler myIgnore+ x <- a+ myInstallHandler oldH+ return x
@@ -0,0 +1,40 @@+module GF.Text.Clitics (getClitics,getCliticsText) where++import Data.List++-- AR 6/2/2011+-- Analyse word as stem+clitic whenever +-- (1) clitic is in clitic list+-- (2) either +-- (a) stem is in Lexicon+-- (b) stem can be analysed as stem0+clitic0+-- +-- Examples: +-- Italian amarmi = amar+mi+-- Finnish autossanikohan = autossa+ni+kohan+--+-- The analysis gives all results, including the case where the whole word is in Lexicon.+-- +-- The clitics in the list are expected to be reversed.++getClitics :: (String -> Bool) -> [String] -> String -> [[String]]+getClitics isLex rclitics = map (reverse . map reverse) . clits . reverse where+ clits rword = ifLex rword [rclit:more | + rclit <- rclitics, stem <- splits rclit rword, more <- clits stem]+ splits c = maybe [] return . stripPrefix c++ ifLex w ws = if isLex (reverse w) then [w] : ws else ws+++getCliticsText :: (String -> Bool) -> [String] -> [String] -> [String]+getCliticsText isLex rclitics = + map unwords . sequence . map (map render . getClitics isLex rclitics) + where+ render = unwords . intersperse "&+"+++-- example++--getClitics1 = getClitics exlex1 exclits1+--exlex1 = flip elem ["auto", "naise", "rahan","maa","maahan","maahankaan"]+--exclits1 = map reverse ["ni","ko","han","pas","nsa","kin","kaan"]
@@ -0,0 +1,75 @@+module GF.Text.Coding where++import qualified Data.ByteString as BS+import Data.ByteString.Internal+import GHC.IO+import GHC.IO.Buffer+import GHC.IO.Encoding+import GHC.IO.Exception+import Control.Monad++encodeUnicode :: TextEncoding -> String -> ByteString+encodeUnicode enc s =+ unsafePerformIO $ do+ let len = length s+ cbuf0 <- newCharBuffer (len*4) ReadBuffer+ foldM (\i c -> writeCharBuf (bufRaw cbuf0) i c) 0 s+ let cbuf = cbuf0{bufR=len}+ case enc of+ TextEncoding {mkTextEncoder=mk} -> do encoder <- mk+ bss <- translate (encode encoder) cbuf+ close encoder+ return (BS.concat bss)+ where+ translate cod cbuf+ | i < w = do bbuf <- newByteBuffer 128 WriteBuffer+ (_,cbuf,bbuf) <- cod cbuf bbuf+ if isEmptyBuffer bbuf+ then ioe_invalidCharacter1+ else do let bs = PS (bufRaw bbuf) (bufL bbuf) (bufR bbuf-bufL bbuf)+ bss <- translate cod cbuf+ return (bs:bss)+ | otherwise = return []+ where+ i = bufL cbuf+ w = bufR cbuf++decodeUnicode :: TextEncoding -> ByteString -> String+decodeUnicode enc bs = unsafePerformIO $ decodeUnicodeIO enc bs++decodeUnicodeIO enc (PS fptr l len) = do+ let bbuf = Buffer{bufRaw=fptr, bufState=ReadBuffer, bufSize=len, bufL=l, bufR=l+len}+ cbuf <- newCharBuffer 128 WriteBuffer+ case enc of+ TextEncoding {mkTextDecoder=mk} -> do decoder <- mk+ s <- translate (encode decoder) bbuf cbuf+ close decoder+ return s+ where+ translate cod bbuf cbuf+ | i < w = do+ (_,bbuf,cbuf) <- cod bbuf cbuf+ if isEmptyBuffer cbuf+ then ioe_invalidCharacter2+ else unpack cod bbuf cbuf+ | otherwise = return []+ where+ i = bufL bbuf+ w = bufR bbuf+ + unpack cod bbuf cbuf+ | i < w = do (c,i') <- readCharBuf (bufRaw cbuf) i+ cs <- unpack cod bbuf cbuf{bufL=i'}+ return (c:cs)+ | otherwise = translate cod bbuf cbuf{bufL=0,bufR=0}+ where+ i = bufL cbuf+ w = bufR cbuf++ioe_invalidCharacter1 = ioException+ (IOError Nothing InvalidArgument ""+ ("invalid byte sequence for this encoding") Nothing Nothing)++ioe_invalidCharacter2 = ioException+ (IOError Nothing InvalidArgument ""+ ("invalid byte sequence for this decoding") Nothing Nothing)
@@ -0,0 +1,449 @@+-- | Lexers and unlexers - they work on space-separated word strings+module GF.Text.Lexing (stringOp,opInEnv) where++import GF.Text.Transliterations++import Data.Char (isSpace,toUpper,toLower)+import Data.List (intersperse)++stringOp :: (String -> Bool) -> String -> Maybe (String -> String)+stringOp good name = case name of+ "chars" -> Just $ appLexer (filter (not . all isSpace) . map return)+ "lextext" -> Just $ appLexer (lexText good)+ "lexcode" -> Just $ appLexer lexCode+ "lexmixed" -> Just $ appLexer (lexMixed good)+ "lexgreek" -> Just $ appLexer lexAGreek+ "lexgreek2" -> Just $ appLexer lexAGreek2+ "words" -> Just $ appLexer words+ "bind" -> Just $ appUnlexer (unwords . bindTok)+ "unchars" -> Just $ appUnlexer concat+ "unlextext" -> Just $ appUnlexer (unlexText . unquote . bindTok)+ "unlexcode" -> Just $ appUnlexer unlexCode+ "unlexmixed" -> Just $ appUnlexer (unlexMixed good . unquote . bindTok)+ "unlexgreek" -> Just $ appUnlexer unlexAGreek+ "unlexnone" -> Just id+ "unlexid" -> Just id+ "unwords" -> Just $ appUnlexer unwords+ "to_html" -> Just wrapHTML+ _ -> transliterate name++-- perform op in environments beg--end, t.ex. between "--"+--- suboptimal implementation+opInEnv :: String -> String -> (String -> String) -> (String -> String)+opInEnv beg end op = concat . altern False . chop (lbeg, beg) [] where+ chop mk@(lg, mark) s0 s = + let (tag,rest) = splitAt lg s in+ if tag==mark then (reverse s0) : mark : chop (switch mk) [] rest + else case s of+ c:cs -> chop mk (c:s0) cs+ [] -> [reverse s0]+ switch (lg,mark) = if mark==beg then (lend,end) else (lbeg,beg)+ (lbeg,lend) = (length beg, length end)+ altern m ts = case ts of+ t:ws | not m && t==beg -> t : altern True ws+ t:ws | m && t==end -> t : altern False ws+ t:ws -> (if m then op t else t) : altern m ws+ [] -> []++appLexer :: (String -> [String]) -> String -> String+appLexer f = unwords . filter (not . null) . f++appUnlexer :: ([String] -> String) -> String -> String+----appUnlexer f = unlines . map (f . words) . lines+appUnlexer f = f . words++wrapHTML :: String -> String+wrapHTML = unlines . tag . intersperse "<br>" . lines where+ tag ss = "<html>":"<head>":"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />":"</head>":"<body>" : ss ++ ["</body>","</html>"]+++-- * Text lexing+-- | Text lexing with standard word capitalization of the first word of every sentence+lexText :: (String -> Bool) -> String -> [String]+lexText good = lexText' (uncapitInit good)++-- | Text lexing with custom treatment of the first word of every sentence.+lexText' :: (String->String) -> String -> [String]+lexText' uncap1 = uncap . lext where+ lext s = case s of+ c:cs | isMajorPunct c -> [c] : uncap (lext cs)+ c:cs | isMinorPunct c -> [c] : lext cs+ c:cs | isSpace c -> lext cs+ _:_ -> let (w,cs) = break (\x -> isSpace x || isPunct x) s in w : lext cs+ _ -> [s]+ uncap s = case s of+ w:ws -> uncap1 w:ws+ _ -> s++unlexText :: [String] -> String+unlexText = capitInit . unlext where+ unlext s = case s of+ w:[] -> w+ w:[c]:[] | isPunct c -> w ++ [c]+ w:[c]:cs | isMajorPunct c -> w ++ [c] ++ " " ++ capitInit (unlext cs)+ w:[c]:cs | isMinorPunct c -> w ++ [c] ++ " " ++ unlext cs+ w:ws -> w ++ " " ++ unlext ws+ _ -> []++-- | Bind tokens separated by Prelude.BIND, i.e. &++bindTok :: [String] -> [String]+bindTok ws = case ws of+ w1:"&+":w2:ws -> bindTok ((w1++w2):ws)+ "&+":ws -> bindTok ws+ "&|":(c:cs):ws-> bindTok ((toUpper c:cs) : ws)+ "&|":ws -> bindTok ws+ w:ws -> w:bindTok ws+ [] -> []++-- * Code lexing++-- | Haskell lexer, usable for much code+lexCode :: String -> [String]+lexCode ss = case lex ss of+ [(w@(_:_),ws)] -> w : lexCode ws+ _ -> []+ ++-- * Ancient Greek lexing++lexTextAGreek :: String -> [String]+lexTextAGreek s = lext s where+ lext s = case s of+ c:cs | isAGreekPunct c -> [c] : (lext cs)+ c:cs | isSpace c -> lext cs+ _:_ -> let (w,cs) = break (\x -> isSpace x || isAGreekPunct x) s + in w : lext cs+ [] -> []++-- Philological greek text may use vowel length indicators. Then '.' is not a sentence +-- separator, nor is 'v. ' for vowel v. Sentence ends at 'v..' or 'c. ' with non-vowel c.++lexTextAGreek2 :: String -> [String]+lexTextAGreek2 s = lext s where+ lext s = case s of+ c:cs | isAGreekPunct c -> [c] : (lext cs)+ c:cs | isSpace c -> lext cs+ _:_ -> let (w,cs) = break (\x -> isSpace x || isAGreekPunct x) s + in case cs of + '.':'.':d:ds | isSpace d + -> (w++['.']) : lext ('.':d:ds)+ '.':d:ds | isAGreekPunct d || isSpace d + -> (w++['.']) : lext (d:ds)+ '.':d:ds | not (isSpace d) + -> case lext (d:ds) of+ e:es -> (w++['.']++e) : es+ es -> (w++['.']) : es + '.':[] -> (w++['.']) : []+ _ -> w : lext cs + [] -> []++unlexTextAGreek :: [String] -> String+unlexTextAGreek = unlext where+ unlext s = case s of+ w:[] -> w+ w:[c]:[] | isAGreekPunct c -> w ++ [c]+ w:[c]:cs | isAGreekPunct c -> w ++ [c] ++ " " ++ unlext cs+ w:ws -> w ++ " " ++ unlext ws+ [] -> []++isAGreekPunct = flip elem ".,;··" -- colon: first version · not in charset,+ -- second version · = 00B7 standard code point++-- * Text lexing and unlexing for Ancient Greek: +-- 1. no capitalization of initial word, +-- 2. grave/acute accent switch on final syllables of words not followed by punctuation, +-- 3. accent move from/to support word to/from following clitic words (iterated).++lexAGreek :: String -> [String]+lexAGreek = fromAGreek . lexTextAGreek++lexAGreek2 :: String -> [String]+lexAGreek2 = fromAGreek . lexTextAGreek2++unlexAGreek :: [String] -> String+unlexAGreek = unlexTextAGreek . toAGreek++-- Note: unlexAGreek does not glue punctuation with the previous word, so that short+-- vowel indication (like a.) differs from sentence end (a .). ++-- | normalize = change grave accent on sentence internal words to acute, +-- and shift inherited acutes to the following enclitic (where they are+-- visible only as shown in the list of enclitics above)++normalize :: String -> String+normalize = (unlexTextAGreek . fromAGreek . lexTextAGreek) ++fromAGreek :: [String] -> [String]+fromAGreek s = case s of+ w:[]:vs -> w:[]:(fromAGreek vs)+ w:(v:vs) | isAGreekPunct (head v) -> w:v:(fromAGreek vs)+ w:v:vs | wasEnclitic v && wasEnclitic w ->+ getEnclitic w : fromAGreek (v:vs)+ w:v:vs | wasEnclitic v && wasProclitic w -> -- "ei)' tines*"+ getProclitic w : getEnclitic v : fromAGreek vs+ w:v:vs | wasEnclitic v && (hasEndCircum w || + (hasEndAcute w && hasSingleAccent w)) -> + w : getEnclitic v : fromAGreek vs -- ok "sofoi' tines*"+ w:v:vs | wasEnclitic v && hasPrefinalAcute w ->+ w : getEnclitic v : fromAGreek vs+ w:v:vs | wasEnclitic v && hasEndAcute w -> -- ok "a)'nvrwpoi' tines*"+ dropLastAccent w : getEnclitic v : fromAGreek vs+ w:v:vs | wasEnclitic w ->+ getEnclitic w : fromAGreek (v:vs)+ w:ws -> (toAcute w) : (fromAGreek ws)+ ws -> ws ++-- | de-normalize = change acute accent of end syllables in sentence internal +-- (non-enclitic) words to grave accent, and move accents of enclitics to the +-- previous word to produce ordinary ancient greek++denormalize :: String -> String+denormalize = (unlexTextAGreek . toAGreek . lexTextAGreek) ++toAGreek :: [String] -> [String]+toAGreek s = case s of+ w:[]:vs -> w:[]:(toAGreek vs)+ w:v:vs | isAGreekPunct (head v) -> w:[]:v:(toAGreek vs) -- w:[] for following -to_ancientgreek+ w:v:vs | isEnclitic v && isEnclitic w -> + addAcute w : toAGreek (dropAccent v:vs) -- BR 11 Anm.2+ w:v:vs | isEnclitic v && isProclitic w -> -- BR 11 a.beta+ addAcute w: (toAGreek (dropAccent v:vs))+ w:v:vs | isEnclitic v && (hasEndCircum w || hasEndAcute w) -> + w:(toAGreek (dropAccent v:vs)) -- BR 11 a.alpha,beta+ w:v:vs | isEnclitic v && hasPrefinalAcute w -> + w:v: toAGreek vs -- bisyllabic v keeps its accent BR 11 b.+ w:v:vs | isEnclitic v -> + (addAcute w):(toAGreek (dropAccent v:vs)) -- BR 11 a.gamma+ w:v:vs | isEnclitic w -> w:(toAGreek (v:vs))+ w:ws -> (toGrave w) : (toAGreek ws)+ ws -> ws ++-- | Change accent on the final syllable of a word++toGrave :: String -> String +toGrave = reverse . grave . reverse where+ grave s = case s of+ '\'':cs -> '`':cs + c:cs | isAGreekVowel c -> c:cs + c:cs -> c: grave cs+ _ -> s++toAcute :: String -> String +toAcute = reverse . acute . reverse where+ acute s = case s of+ '`':cs -> '\'':cs+ c:cs | isAGreekVowel c -> c:cs + c:cs -> c: acute cs+ _ -> s++isAGreekVowel = flip elem "aeioyhw"++-- | Accent moves for enclitics and proclitics (atona)++enclitics = [+ "moy","moi","me", -- personal pronouns+ "soy","soi","se",+ "oy(","oi(","e(",+ "tis*","ti","tina'", -- indefinite pronoun + "tino's*","tini'",+ "tine's*","tina's*",+ "tinw~n","tisi'","tisi'n",+ "poy","poi", -- indefinite adverbs+ "pove'n","pws*",+ "ph|","pote'",+ "ge","te","toi", -- particles+ "nyn","per","pw" + -- suffix -"de"+ -- praes.indik. of fhmi', ei)mi' (except fh's*, ei)~)+ ] -- and more, BR 11++proclitics = [+ "o(","h(","oi(","ai(", -- articles+ "e)n","ei)s*","e)x","e)k", -- prepositions+ "ei)","w(s*", -- conjunctions+ "oy)","oy)k","oy)c" -- negation+ ]++isEnclitic = flip elem enclitics+isProclitic = flip elem proclitics++-- Check if a word is an enclitic or accented enclitic and extract the enclitic++wasEnclitic = let unaccented = (filter (not . hasAccent) enclitics) + ++ (map dropAccent (filter hasAccent enclitics))+ accented = (filter hasAccent enclitics) + ++ map addAcute (filter (not . hasAccent) enclitics) + in flip elem (accented ++ unaccented)++wasProclitic = flip elem (map addAcute proclitics)++getEnclitic = + let pairs = zip (enclitics ++ (map dropAccent (filter hasAccent enclitics))+ ++ (map addAcute (filter (not . hasAccent) enclitics)))+ (enclitics ++ (filter hasAccent enclitics)+ ++ (filter (not . hasAccent) enclitics))+ find = \v -> lookup v pairs+ in \v -> case (find v) of + Just x -> x + _ -> v+getProclitic = + let pairs = zip (map addAcute proclitics) proclitics + find = \v -> lookup v pairs+ in \v -> case (find v) of + Just x -> x + _ -> v++-- | Accent manipulation++dropAccent = reverse . drop . reverse where + drop s = case s of+ [] -> []+ '\'':cs -> cs+ '`':cs -> cs+ '~':cs -> cs+ c:cs -> c:drop cs++dropLastAccent = reverse . drop . reverse where + drop s = case s of+ [] -> []+ '\'':cs -> cs+ '`':cs -> cs+ '~':cs -> cs+ c:cs -> c:drop cs++addAcute :: String -> String+addAcute = reverse . acu . reverse where+ acu w = case w of + c:cs | c == '\'' -> c:cs+ c:cs | c == '(' -> '\'':c:cs+ c:cs | c == ')' -> '\'':c:cs+ c:cs | isAGreekVowel c -> '\'':c:cs+ c:cs -> c : acu cs+ _ -> w++-- | Accent checking on end syllables++hasEndAcute = find . reverse where+ find s = case s of+ [] -> False+ '\'':cs -> True+ '`':cs -> False+ '~':cs -> False+ c:cs | isAGreekVowel c -> False+ _:cs -> find cs++hasEndCircum = find . reverse where+ find s = case s of+ [] -> False+ '\'':cs -> False+ '`':cs -> False+ '~':cs -> True+ c:cs | isAGreekVowel c -> False+ _:cs -> find cs++hasPrefinalAcute = find . reverse where+ find s = case s of+ [] -> False+ '\'':cs -> False -- final acute+ '`':cs -> False+ '~':cs -> False+ c:d:cs | isAGreekVowel c && isAGreekVowel d -> findNext cs+ c:cs | isAGreekVowel c -> findNext cs+ _:cs -> find cs where+ findNext s = case s of + [] -> False+ '\'':cs -> True -- prefinal acute+ '`':cs -> False+ '~':cs -> False+ c:cs | isAGreekVowel c -> False+ _:cs -> findNext cs where+ +hasSingleAccent v = + hasAccent v && not (hasAccent (dropLastAccent v))++hasAccent v = case v of + [] -> False+ c:cs -> elem c ['\'','`','~'] || hasAccent cs++{- Tests: ++-- denormalization. Examples in BR 11 work: +-}+enclitics_expls = -- normalized+ "sofw~n tis*":"sofw~n tine's*":"sof~n tinw~n": -- a.alpha+ "sofo's tis*":"sofoi' tine's*": -- a.beta+ "ei) tis*":"ei) tine's*":+ "a)'nvrwpos* tis*":"a)'nvrwpoi tine's*": -- a.gamma+ "doy~los* tis*":"doy~loi tine's*":+ "lo'gos* tis*":"lo'goi tine's*":"lo'gwn tinw~n": -- b.+ "ei) poy tis* tina' i)'doi": -- Anm. 2.+ [] +++unlexCode :: [String] -> String+unlexCode s = case s of+ w:[] -> w+ [c]:cs | isParen c -> [c] ++ unlexCode cs+ w:cs@([c]:_) | isClosing c -> w ++ unlexCode cs+ w:ws -> w ++ " " ++ unlexCode ws+ _ -> []+++-- | LaTeX lexer in the math mode: \ should not be separated from the next word++lexLatexCode :: String -> [String]+lexLatexCode = restoreBackslash . lexCode where --- quick hack: postprocess Haskell's lex+ restoreBackslash ws = case ws of+ "\\":w:ww -> ("\\" ++ w) : restoreBackslash ww+ w:ww -> w:restoreBackslash ww+ _ -> ws++-- * Mixed lexing++-- | LaTeX style lexer, with "math" environment using Code between $...$+lexMixed :: (String -> Bool) -> String -> [String]+lexMixed good = concat . alternate False [] where+ alternate env t s = case s of+ '$':cs -> lex env (reverse t) : ["$"] : alternate (not env) [] cs+ '\\':c:cs | elem c "()[]" -> lex env (reverse t) : [['\\',c]] : alternate (not env) [] cs+ c:cs -> alternate env (c:t) cs+ _ -> [lex env (reverse t)]+ lex env = if env then lexLatexCode else lexText good++unlexMixed :: (String -> Bool) -> [String] -> String+unlexMixed good = capitInit . concat . alternate False where+ alternate env s = case s of+ _:_ -> case break (flip elem ["$","\\[","\\]","\\(","\\)"]) s of+ (t,[]) -> unlex env t : []+ (t,c:m) -> unlex env t : sep env c m : alternate (not env) m+ _ -> []+ unlex env = if env then unlexCode else (uncapitInit good . unlexText)+ sep env c m = case (m,env) of+ ([p]:_,True) | isPunct p -> c -- closing $ glued to next punct + (_, True) -> c ++ " " -- closing $ otherwise separated by space from what follows+ _ -> " " ++ c -- put space before opening $++-- * Additional lexing uitilties++-- | Capitalize first letter+capitInit s = case s of+ c:cs -> toUpper c : cs+ _ -> s++-- | Uncapitalize first letter+uncapitInit good s = + case s of+ c:cs | not (good s) -> toLower c : cs+ _ -> s++-- | Unquote each string wrapped in double quotes+unquote = map unq where + unq s = case s of+ '"':cs@(_:_) | last cs == '"' -> init cs+ _ -> s++isPunct = flip elem ".?!,:;"+isMajorPunct = flip elem ".?!"+isMinorPunct = flip elem ",:;"+isParen = flip elem "()[]{}"+isClosing = flip elem ")]}"
@@ -0,0 +1,47 @@+-- | Pretty printing with class+module GF.Text.Pretty(module GF.Text.Pretty,module PP) where+import qualified Text.PrettyPrint as PP+import Text.PrettyPrint as PP(Doc,Style(..),Mode(..),style,empty,isEmpty)++class Pretty a where+ pp :: a -> Doc+ ppList :: [a] -> Doc+ ppList = fsep . map pp -- hmm++instance Pretty Doc where pp = id+instance Pretty Int where pp = PP.int+instance Pretty Integer where pp = PP.integer+instance Pretty Float where pp = PP.float+instance Pretty Double where pp = PP.double+instance Pretty Char where pp = PP.char; ppList = PP.text++instance Pretty a => Pretty [a] where+ pp = ppList+ ppList = fsep . map pp -- hmm++render x = PP.render (pp x)+renderStyle s x = PP.renderStyle s (pp x)++infixl 5 $$,$+$+infixl 6 <>,<+>++x $$ y = pp x PP.$$ pp y+x $+$ y = pp x PP.$+$ pp y+x <+> y = pp x PP.<+> pp y+x <> y = pp x PP.<> pp y++braces x = PP.braces (pp x)+brackets x = PP.brackets (pp x)+cat xs = PP.cat (map pp xs)+doubleQuotes x = PP.doubleQuotes (pp x)+fcat xs = PP.fcat (map pp xs)+fsep xs = PP.fsep (map pp xs)+hang x d y = PP.hang (pp x) d (pp y)+hcat xs = PP.hcat (map pp xs)+hsep xs = PP.hsep (map pp xs)+nest d x = PP.nest d (pp x)+parens x = PP.parens (pp x)+punctuate x ys = PP.punctuate (pp x) (map pp ys)+quotes x = PP.quotes (pp x)+sep xs = PP.sep (map pp xs)+vcat xs = PP.vcat (map pp xs)
@@ -0,0 +1,341 @@+module GF.Text.Transliterations (+ transliterate,+ transliterateWithFile,+ transliteration,+ characterTable,+ transliterationPrintNames+ ) where++import Data.Char+import Numeric+import qualified Data.Map as Map++-- transliterations between ASCII and a Unicode character set++-- current transliterations: devanagari, thai++-- to add a new one: define the Unicode range and the corresponding ASCII strings,+-- which may be one or more characters long++-- conventions to be followed: +-- each character is either [letter] or [letter+nonletters]+-- when using a sparse range of unicodes, mark missing codes as "-" in transliterations+-- characters can be invisible: ignored in translation to unicode++transliterate :: String -> Maybe (String -> String)+transliterate s = case s of+ 'f':'r':'o':'m':'_':t -> fmap appTransFromUnicode $ transliteration t+ 't':'o':'_':t -> fmap appTransToUnicode $ transliteration t+ _ -> Nothing++transliterateWithFile :: String -> String -> Bool -> (String -> String)+transliterateWithFile name src isFrom =+ (if isFrom then appTransFromUnicode else appTransToUnicode) (getTransliterationFile name src)++transliteration :: String -> Maybe Transliteration+transliteration s = Map.lookup s allTransliterations ++allTransliterations = Map.fromList [+ ("amharic",transAmharic),+ ("ancientgreek", transAncientGreek),+ ("arabic", transArabic),+ ("arabic_unvocalized", transArabicUnvoc),+ ("devanagari", transDevanagari),+ ("greek", transGreek),+ ("hebrew", transHebrew),+ ("persian", transPersian),+ ("sanskrit", transSanskrit),+ ("sindhi", transSindhi),+ ("nepali", transNepali),+ ("telugu", transTelugu),+ ("thai", transThai),+ ("urdu", transUrdu)+ ]++-- used in command options and help+transliterationPrintNames = [(t,printname p) | (t,p) <- Map.toList allTransliterations]++characterTable :: Transliteration -> String+characterTable = unlines . map prOne . Map.assocs . trans_from_unicode where+ prOne (i,s) = unwords ["|", showHex i "", "|", [toEnum i], "|", s, "|"]++data Transliteration = Trans {+ trans_to_unicode :: Map.Map String Int,+ trans_from_unicode :: Map.Map Int String,+ invisible_chars :: [String],+ printname :: String+ }++appTransToUnicode :: Transliteration -> String -> String+appTransToUnicode trans = + concat .+ map (\c -> maybe c (return . toEnum) $+ Map.lookup c (trans_to_unicode trans)+ ) . + filter (flip notElem (invisible_chars trans)) . + unchar++appTransFromUnicode :: Transliteration -> String -> String+appTransFromUnicode trans = + concat .+ map (\c -> maybe [toEnum c] id $ + Map.lookup c (trans_from_unicode trans)+ ) . + map fromEnum+++mkTransliteration :: String -> [String] -> [Int] -> Transliteration+mkTransliteration name ts us = + Trans (Map.fromList (tzip ts us)) (Map.fromList (uzip us ts)) [] name+ where+ tzip ts us = [(t,u) | (t,u) <- zip ts us, t /= "-"]+ uzip us ts = [(u,t) | (u,t) <- zip us ts, t /= "-"]++getTransliterationFile :: String -> String -> Transliteration+getTransliterationFile name = uncurry (mkTransliteration name) . codes+ where+ codes = unzip . map (mkOne . words) . filter (not . all isSpace) . lines+ mkOne ws = case ws of+ [c]:t:_ -> (t,fromEnum c) -- ä a:+ u:t:_ -> (t,read u) -- 228 a: OR 0xe4+ _ -> error $ "not a valid transliteration:" ++ unwords ws++unchar :: String -> [String]+unchar s = case s of+ c:d:cs + | isAlpha d -> [c] : unchar (d:cs)+ | isSpace d -> [c]:[d]: unchar cs+ | otherwise -> let (ds,cs2) = break (\x -> isAlpha x || isSpace x) cs in+ (c:d:ds) : unchar cs2+ [_] -> [s]+ _ -> []++transThai :: Transliteration+transThai = mkTransliteration "Thai" allTrans allCodes where+ allTrans = words $+ "- k k1 - k2 - k3 g c c1 c2 s' c3 y' d' t' " +++ "t1 t2 t3 n' d t t4 t5 t6 n b p p1 f p2 f' " +++ "p3 m y r - l - w s- s. s h l' O h' - " +++ "a. a a: a+ i i: v v: u u: - - - - - - " +++ "e e' o: a% a& L R S T1 T2 T3 T4 K - - - " +++ "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 - - - - - - "+ allCodes = [0x0e00 .. 0x0e7f]++transDevanagari :: Transliteration+transDevanagari = + (mkTransliteration "Devanagari" + allTransUrduHindi allCodes){invisible_chars = ["a"]} where+ allCodes = [0x0900 .. 0x095f] ++ [0x0966 .. 0x096f]++allTransUrduHindi = words $+ "- n~ m. h. - A A: I I: U U: r.- l.- - - E: " +++ "E+ - - O: O+ k k' g g' n- c c' j j' n* T " +++ "T' D D' N t t' d d' n - p p' b b' m y " +++ "r - l L - v s* S s h - - X~ - a: i " +++ "i: u u: r. l. - - e: e+ - - o: o+ X, - - " +++ "- - - - - - - - q x g. z R R' f - " +++ "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 "++ +transUrdu :: Transliteration+transUrdu = + (mkTransliteration "Urdu" allTrans allCodes) where+ allCodes = [0x0622 .. 0x062f] ++ [0x0630 .. 0x063a] ++ [0x0641,0x0642] ++ [0x06A9] ++ [0x0644 .. 0x0648] ++ + [0x0654,0x0658,0x0679,0x067e,0x0686,0x0688,0x0691,0x0698,0x06af,0x06c1,0x06c3,0x06cc,0x06ba,0x06be,0x06d2] +++ [0x06f0 .. 0x06f9] ++ [0x061f,0x06D4]+ allTrans = words $+ "A - w^ - y^ a b - t C j H K d " ++ -- 0622 - 062f+ "Z r z s X S Z- t- z- e G " ++ -- 0630 - 063a+ "f q k l m n - w " ++ -- 0641, 0642, 0643 - 0648+ "$ n- T p c D R x g h t: y N h' E " ++ -- 0654,658,679,67e,686,688,698,6af,6c1,6c3,6cc,6ba,6be,6d2+ "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 " ++ "? ."++transSindhi :: Transliteration+transSindhi = + (mkTransliteration "Sindhi" allTrans allCodes) where+ allCodes = [0x062e] ++ [0x0627 .. 0x062f] ++ [0x0630 .. 0x063a] ++ [0x0641 .. 0x0648] +++ [0x067a,0x067b,0x067d,0x067e,0x067f] ++ [0x0680 .. 0x068f] +++ [0x0699,0x0918,0x06a6,0x061d,0x06a9,0x06af,0x06b3,0x06bb,0x06be,0x06f6,0x064a,0x06b1, 0x06aa, 0x06fd, 0x06fe] +++ [0x06f0 .. 0x06f9] ++ [0x061f,0x06D4]+ allTrans = words $+ "K a b - t C j H - d " ++ -- 0626 - 062f+ "Z r z s X S Z- t- z- e G " ++ -- 0630 - 063a+ "f q - L m n - W " ++ -- 0641 - 0648+ "T! B T p T' " ++ -- 067a,067b,067d,067e,067f+ "B' - - Y' J' - c c' - - d! - d' D - D' " ++ -- 0680 - 068f+ "R - F' - k' g G' t' h' e' y c! k A M " ++ -- 0699, 0918, 06a6, 061d, 06a9,06af,06b3,06bb,06be,06f6,06cc,06b1 + "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 " ++ "? ."++ ++transArabic :: Transliteration+transArabic = mkTransliteration "Arabic" allTrans allCodes where+ allTrans = words $+ " V A: A? w? A- y? A b t. t v g H K d " ++ -- 0621 - 062f+ "W r z s C S D T Z c G " ++ -- 0630 - 063a+ " f q k l m n h w y. y a. u. i. a u " ++ -- 0641 - 064f+ "i v2 o a: V+ V- i: a+ " ++ -- 0650 - 0657+ "A* q?" -- 0671 (used by AED) + allCodes = [0x0621..0x062f] ++ [0x0630..0x063a] ++ + [0x0641..0x064f] ++ [0x0650..0x0657] ++ [0x0671,0x061f]+++transArabicUnvoc :: Transliteration+transArabicUnvoc = transArabic{+ invisible_chars = ["a","u","i","v2","o","V+","V-","a:"],+ printname = "unvocalized Arabic"+ }++transPersian :: Transliteration+transPersian = (mkTransliteration "Persian/Farsi" allTrans allCodes)+ {invisible_chars = ["a","u","i"]} where+ allTrans = words $+ " V A: A? w? A- y? A b t. t t- j H K d " ++ -- 0621 - 062f+ "W r z s C S D T Z c G " ++ -- 0630 - 063a+ " f q - l m n h v - y. a. u. i. a u " ++ -- 0640 - 064f+ "i v2 o a: V+ V- i: a+ " ++ -- 0650 - 0657 + "p c^ J k g y q? Z0"+ allCodes = [0x0621..0x062f] ++ [0x0630..0x063a] ++ + [0x0641..0x064f] ++ [0x0650..0x0657] ++ + [0x067e,0x0686,0x0698,0x06a9,0x06af,0x06cc,0x061f,0x200c]++transNepali :: Transliteration+transNepali = mkTransliteration "Nepali" allTrans allCodes where+ allTrans = words $+ "z+ z= " ++ + "- V M h: - H A i: I: f F Z - - - e: " +++ "E: - - O W k K g G n: C c j J Y q " +++ "Q x X N t T d D n - p P b B m y " +++ "r - l L - v S z s h - - ~ ` a i " +++ "I u U R - - - e E - - o w x: - - " +++ "O: - _ - - - - - - - - - - - - - " +++ "- - - - . > 0 1 2 3 4 5 6 7 8 9 " +++ "- - - - - - - - - - - - - - - - "+ allCodes = [0x200c,0x200d] ++ [0x0900 .. 0x097f]+++transHebrew :: Transliteration+transHebrew = mkTransliteration "unvocalized Hebrew" allTrans allCodes where+ allTrans = words $+ "A b g d h w z H T y K k l M m N " +++ "n S O P p Z. Z q r s t - - - - - " +++ "w2 w3 y2 g1 g2"+ allCodes = [0x05d0..0x05f4]++transTelugu :: Transliteration+transTelugu = mkTransliteration "Telugu" allTrans allCodes where+ allTrans = words $+ "- c1 c2 c3 - A A: I I: U U: R_ L_ - E E: " +++ "A' - O O: A_ k k. g g. n. c c. j j. n' T " +++ "T. d d. N t t. d d. n - p p. b b. m y " +++ "r R l L - v s' S s h - - - c5 a: i " +++ "i: u u: r_ r. - e e: a' - o o: a_ c6 - - " +++ "- - - - - c7 c8 z Z - - - - - - - " +++ "R+ L+ l+ l* - - n0 n1 n2 n3 n4 n5 n6 n7 n8 n9 "+ allCodes = [0x0c00 .. 0x0c7f]++transGreek :: Transliteration+transGreek = mkTransliteration "modern Greek" allTrans allCodes where+ allTrans = words $+ "- - - - - - A' - E' H' I' - O' - Y' W' " +++ "i= A B G D E Z H V I K L M N X O " +++ "P R - S T Y F C Q W I- Y- a' e' h' i' " +++ "y= a b g d e z h v i k l m n x o " +++ "p r s* s t y f c q w i- y- o' y' w' - " + allCodes = [0x0380 .. 0x03cf]++transAncientGreek :: Transliteration+transAncientGreek = mkTransliteration "ancient Greek" allTrans allCodes where+ allTrans = words $+-- "- - - - - - - c: - - - - - - - - " ++ -- standard code point for colon: 00B7+ "- - - - - - - - - - - - - - - - " +++ "i= A B G D E Z H V I K L M N X O " +++ "P R - S T Y F C Q W I- Y- - - - - " +++ "y= a b g d e z h v i k l m n x o " +++ "p r s* s t y f c q w i- y- - - - - " +++ "a) a( a)` a(` a)' a(' a)~ a(~ A) A( A)` A(` A)' A(' A)~ A(~ " ++ -- 1f00-1f09,1f0a-1f0f+ "e) e( e)` e(` e)' e(' - - E) E( E)` E(` E)' E(' - - " +++ "h) h( h)` h(` h)' h(' h)~ h(~ H) H( H)` H(` H)' H(' H)~ H(~ " +++ "i) i( i)` i(` i)' i(' i)~ i(~ I) I( I)` I(` I)' I(' I)~ I(~ " +++ "o) o( o)` o(` o)' o(' - - O) O( O)` O(` O)' O(' - - " +++ "y) y( y)` y(` y)' y(' y)~ y(~ - Y( - Y(` - Y(' - Y(~ " +++ "w) w( w)` w(` w)' w(' w)~ w(~ W) W( W)` W(` W)' W(' W)~ W(~ " +++ "a` a' e` e' h` h' i` i' o` o' y` y' w` w' - - " +++ "a|) a|( a|)` a|(` a|)' a|(' a|)~ a|(~ - - - - - - - - " ++ -- 1f80- + "h|) h|( h|)` h|(` h|)' h|(' h|)~ h|(~ - - - - - - - - " ++ -- 1f90- + "w|) w|( w|)` w|(` w|)' w|(' w|)~ w|(~ - - - - - - - - " ++ -- 1fa0- + "a. a_ a|` a| a|' - a~ a|~ - - - - - - - - " ++ -- 1fb0-+ "- - h|` h| h|' - h~ h|~ - - - - - - - - " ++ -- 1fc0-+ "i. i_ i=` i=' - - i~ i=~ - - - - - - - - " ++ -- 1fd0-+ "y. y_ y=` y=' r) r( y~ y=~ - - - - - - - - " ++ -- 1fe0- + "- - w|` w| w|' - w~ w|~ - - - - - - - - " ++ -- 1ff0-+ -- HL, Private Use Area Code Points (New Athena Unicode, Cardo, ALPHABETUM, Antioch)+ -- see: http://apagreekkeys.org/technicalDetails.html+ -- GreekKeys Support by Donald Mastronarde+ "- - - - - - - - - e. o. R) Y) Y)` Y)' Y)~ " ++ -- e1a0-e1af + "e~ e)~ e(~ e_ e_' e_` e_) e_( e_)` e_(` e_)' e_(' E)~ E(~ E_ E. " ++ -- e1b0-e1bf+ "o~ o)~ o(~ o_ o_' o_` o_) o_( o_)` o_(` o_)' o_(' O)~ O(~ O_ O. " ++ -- e1c0-e1cf+ "a_` - a_~ a_)` a_(` a_)~ a_(~ - a.` a.) a.)` a.(' a.(` - - - " ++ -- eaf0-eaff + "a_' - - - a_) a_( - a_)' - a_(' a.' a.( a.)' - - - " ++ -- eb00-eb0f + "e_)~ e_(~ - - - - - e_~ - - - - - - - - " ++ -- eb20-eb2f+ "- - - - - - i_~ - i_` i_' - - i_) i_)' i_( i_(' " ++ -- eb30-eb3f + "i.' i.) i.)' i.( i.` i.)` - i.(' i.(` - - - - - - - " ++ -- eb40-eb4f+ "- - - - i_)` i_(` - i_)~ i_(~ - o_~ o_)~ o_(~ - - - " ++ -- eb50-eb5f+ "y_` " ++ -- eb6f+ "y_~ y_)` - - - y_(` - y_)~ y_(~ - y_' - - y_) y_( y_)' " ++ -- eb70-eb7f+ "y_(' y.' y.( y.` y.) y.)' - - y.)` y.(' y.(` - - - - - " -- eb80-eb8f+ allCodes = -- [0x00B0 .. 0x00Bf] + [0x0380 .. 0x03cf] ++ [0x1f00 .. 0x1fff] + ++ [0xe1a0 .. 0xe1af] + ++ [0xe1b0 .. 0xe1bf]+ ++ [0xe1c0 .. 0xe1cf]+ ++ [0xeaf0 .. 0xeaff]+ ++ [0xeb00 .. 0xeb0f]+ ++ [0xeb20 .. 0xeb2f]+ ++ [0xeb30 .. 0xeb3f]+ ++ [0xeb40 .. 0xeb4f]+ ++ [0xeb50 .. 0xeb5f] ++ [0xeb6f]+ ++ [0xeb70 .. 0xeb7f]+ ++ [0xeb80 .. 0xeb8f]+ +transAmharic :: Transliteration +transAmharic = mkTransliteration "Amharic" allTrans allCodes where+ +allTrans = words $+ + " h. h- h' h( h) h h? h* l. l- l' l( l) l l? l* "++ + " H. H- H' H( H) H H? H* m. m- m' m( m) m m? m* "++ + " s. s- s' s( s) s s? s* r. r- r' r( r) r r? r* "++ + " - - - - - - - - x. x- x' x( x) x x? x* "++ + " q. q- q' q( q) q q? q* - - - - - - - - "++ + " - - - - - - - - - - - - - - - - "++ + " b. b- b' b( b) b b? b* v. v- v' v( v) v v? v* "++ + " t. t- t' t( t) t t? t* c. c- c' c( c) c c? c* "++ + " X. X- X' X( X) X X? - - - - X* - - - - "++ + " n. n- n' n( n) n n? n* N. N- N' N( N) N N? N* "++ + " a u i A E e o e* k. k- k' k( k) k k? - "++ + " - - - k* - - - - - - - - - - - - "++ + " - - - - - - - - w. w- w' w( w) w w? w* "++ + " - - - - - - - - z. z- z' z( z) z z? z* "++ + " Z. Z- Z' Z( Z) Z Z? Z* y. y- y' y( y) y y? y* "++ + " d. d- d' d( d) d d? d* - - - - - - - - "++ + " j. j- j' j( j) j j? j* g. g- g' g( g) g g? - "++ + " - - - g* - - - - - - - - - - - - "++ + " T. T- T' T( T) T T? T* C. C- C' C( C) C C? C* "++ + " P. P- P' P( P) P P? P* S. S- S' S( S) S S? S* "++ + " - - - - - - - - f. f- f' f( f) f f? f*"++ + " p. p- p' p( p) p p? p*" +allCodes = [0x1200..0x1357]+ +-- by Prasad 31/5/2013+transSanskrit :: Transliteration+transSanskrit = (mkTransliteration "Sanskrit" allTrans allCodes) {invisible_chars = ["a"]} where+ allTrans = words $+ "- n~ m. h. - A A: I I: U U: R. L. - - E: " +++ "E+ - O O: O+ k k' g g' n- c c' j j' n* T " +++ "T' D D' N t t' d d' n - p p' b b' m y " +++ "r - l L - v s* S s h - - - v- a: i " +++ "i: u u: r. r.: - e e: e+ - o o: o+ a_ - - " +++ "o~ - - - - - - - q x G z R R' f - " +++ "R.: L.: l. l.: p, p. N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 "+ allCodes = [0x0900 .. 0x097f]
@@ -0,0 +1,161 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+module SimpleEditor.Convert where++import Control.Monad(unless,foldM,ap,mplus)+import Data.List(sortBy)+import Data.Function(on)+import qualified Data.Map as Map+import Text.JSON(makeObj) --encode+import GF.Text.Pretty(render,(<+>))++import qualified Data.ByteString.UTF8 as UTF8(fromString)++import GF.Infra.Option(optionsGFO)+import GF.Infra.Ident(showIdent,ModuleName(..))+import GF.Grammar.Grammar+import GF.Grammar.Printer(ppParams,ppTerm,getAbs,TermPrintQual(..))+import GF.Grammar.Parser(runP,pModDef)+import GF.Grammar.Lexer(Posn(..))+import GF.Data.ErrM+import PGF.Internal(Literal(LStr))++import SimpleEditor.Syntax as S+import SimpleEditor.JSON+++parseModule (path,source) =+ (path.=) $+ case runP pModDef (UTF8.fromString source) of+ Left (Pn l c,msg) ->+ makeObj ["error".=msg, "location".= show l++":"++show c]+ Right mod -> case convModule mod of+ Ok g -> makeObj ["converted".=g]+ Bad msg -> makeObj ["parsed".=msg]++{-+convAbstractFile path =+ appIOE (fmap encode . convAbstract =<< getSourceModule noOptions path)+-}++convModule m@(modid,src) =+ if isModAbs src+ then convAbstract m+ else if isModCnc src+ then convConcrete m+ else fail "An abstract or concrete syntax module was expected"++convAbstract (modid,src) =+ do unless (isModAbs src) $ fail "Abstract syntax expected"+ unless (isCompleteModule src) $ fail "A complete abstract syntax expected"+ extends <- convExtends (mextend src)+ (cats0,funs0) <- convAbsJments (jments src)+ let cats = reverse cats0+ funs = reverse funs0+ flags = optionsGFO (mflags src)+ startcat =+ case lookup "startcat" flags of+ Just (LStr cat) -> cat+ _ -> "-"+ return $ Grammar (convModId modid) extends (Abstract startcat cats funs) []++convExtends = mapM convExtend+convExtend (modid,MIAll) = return (convModId modid)+convExtend _ = fail "unsupported module extension"++convAbsJments jments = foldM convAbsJment ([],[]) (jmentList jments)++convAbsJment (cats,funs) (name,jment) =+ case jment of+ AbsCat octx -> do unless (null (maybe [] unLoc octx)) $+ fail "category with context"+ let cat = convId name+ return (cat:cats,funs)+ AbsFun (Just lt) _ oeqns _ -> do unless (null (maybe [] id oeqns)) $+ fail "function with equations"+ let f = convId name+ typ <- convType (unLoc lt)+ let fun = Fun f typ+ return (cats,fun:funs)+ _ -> fail $ "unsupported judgement form: "++show jment++convType (Prod _ _ t1 t2) = (:) `fmap` convSimpleType t1 `ap` convType t2+convType t = (:[]) `fmap` convSimpleType t+++convSimpleType (Vr id) = return (convId id)+convSimpleType t = fail "unsupported type"++convId = showIdent+convModId (MN m) = convId m++convConcrete (modid,src) =+ do unless (isModCnc src) $ fail "Concrete syntax expected"+ unless (isCompleteModule src) $ fail "A complete concrete syntax expected"+ extends <- convExtends (mextend src)+ opens <- convOpens (mopens src)+ js <- convCncJments (jments src)+ let ps = [p | Pa p <-js]+ lcs = [lc | LC lc<-js]+ os = [o | Op o <-js]+ ls = [l | Li l <-js]+ langcode = "" -- !!!+ conc = Concrete langcode opens ps lcs os ls+ abs = Abstract "-" [] [] -- dummy+ return $ Grammar (convModId modid) extends abs [conc]++convOpens = mapM convOpen++convOpen o =+ case o of+ OSimple id -> return (convModId id)+ _ -> fail "unsupported module open"+++data CncJment = Pa S.Param | LC Lincat | Op Oper | Li Lin | Ignored++convCncJments = mapM convCncJment . jmentList++convCncJment (name,jment) =+ case jment of+ ResParam ops _ ->+ return $ Pa $ Param i (maybe "" (render . ppParams q . unLoc) ops)+ ResValue _ -> return Ignored+ CncCat (Just (L _ typ)) Nothing Nothing pprn _ -> -- ignores printname !!+ return $ LC $ Lincat i (render $ ppTerm q 0 typ)+ ResOper oltyp (Just lterm) -> return $ Op $ Oper lhs rhs+ where+ lhs = i++maybe "" ((" : "++) . render . ppTerm q 0 . unLoc) oltyp+ rhs = render (" ="<+>ppTerm q 0 (unLoc lterm))+ ResOverload [] defs -> return $ Op $ Oper lhs rhs+ where+ lhs = i+ rhs = render $ " = overload"<+>ppTerm q 0 r+ r = R [(lab,(Just ty,fu)) | (L _ ty,L _ fu) <-defs]+ lab = ident2label name+ CncFun _ (Just ldef) pprn _ -> -- ignores printname !!+ do let (xs,e') = getAbs (unLoc ldef)+ lin = render $ ppTerm q 0 e'+ args <- mapM convBind xs+ return $ Li $ Lin i args lin+ _ -> fail $ "unsupported judgement form: "++show jment+ where+ i = convId name+ q = Unqualified++convBind (Explicit,v) = return $ convId v+convBind (Implicit,v) = fail "implicit binding not supported"++jmentList = sortBy (compare `on` (jmentLocation.snd)) . Map.toList++jmentLocation jment =+ case jment of+ AbsCat ctxt -> fmap loc ctxt+ AbsFun ty _ _ _ -> fmap loc ty+ ResParam ops _ -> fmap loc ops+ CncCat ty _ _ _ _ ->fmap loc ty+ ResOper ty rhs -> fmap loc rhs `mplus` fmap loc ty+ CncFun _ rhs _ _ -> fmap loc rhs+ _ -> Nothing+++loc (L l _) = l
@@ -0,0 +1,37 @@+module SimpleEditor.JSON where++import Text.JSON++import SimpleEditor.Syntax+++instance JSON Grammar where+ showJSON (Grammar name extends abstract concretes) =+ makeObj ["basename".=name, "extends".=extends,+ "abstract".=abstract, "concretes".=concretes]++instance JSON Abstract where+ showJSON (Abstract startcat cats funs) =+ makeObj ["startcat".=startcat, "cats".=cats, "funs".=funs]++instance JSON Fun where showJSON (Fun name typ) = signature name typ+instance JSON Param where showJSON (Param name rhs) = definition name rhs+instance JSON Oper where showJSON (Oper name rhs) = definition name rhs++signature name typ = makeObj ["name".=name,"type".=typ]+definition name rhs = makeObj ["name".=name,"rhs".=rhs]++instance JSON Concrete where+ showJSON (Concrete langcode opens params lincats opers lins) =+ makeObj ["langcode".=langcode, "opens".=opens,+ "params".=params, "opers".=opers,+ "lincats".=lincats, "lins".=lins]++instance JSON Lincat where+ showJSON (Lincat cat lintype) = makeObj ["cat".=cat, "type".=lintype]++instance JSON Lin where+ showJSON (Lin fun args lin) = makeObj ["fun".=fun, "args".=args, "lin".=lin]++infix 1 .=+name .= v = (name,showJSON v)
@@ -0,0 +1,39 @@+{-+Abstract syntax for the small subset of GF grammars supported+in gfse, the JavaScript-based simple grammar editor.+-}+module SimpleEditor.Syntax where++type Id = String -- all sorts of identifiers+type ModId = Id -- module name+type Cat = Id -- category name+type FunId = Id -- function name+type Type = [Cat] -- [Cat_1,...,Cat_n] means Cat_1 -> ... -> Cat_n++data Grammar = Grammar { basename :: ModId,+ extends :: [ModId],+ abstract :: Abstract,+ concretes:: [Concrete] }+ deriving Show++data Abstract = Abstract { startcat:: Cat, cats:: [Cat], funs:: [Fun] }+ deriving Show+data Fun = Fun { fname:: FunId, ftype:: Type }+ deriving Show++data Concrete = Concrete { langcode:: Id,+ opens:: [ModId],+ params:: [Param],+ lincats:: [Lincat],+ opers:: [Oper],+ lins:: [Lin] }+ deriving Show++data Param = Param {pname:: Id, prhs:: String} deriving Show+data Lincat = Lincat {cat :: Cat, lintype:: Term} deriving Show+data Oper = Oper {oname:: Lhs, orhs:: Term} deriving Show+data Lin = Lin {fun :: FunId, args:: [Id], lin:: Term} deriving Show++type Lhs = String -- name and type of oper,+ -- e.g "regN : Str -> { s:Str,g:Gender} ="+type Term = String -- arbitrary GF term (not parsed by the editor)
@@ -0,0 +1,553 @@+module ExampleDemo (Environ,initial,getNext, provideExample, testThis,mkFuncWithArg,searchGoodTree,isMeta)+ where++import PGF+--import System.IO+import Data.List+--import Control.Monad+import qualified Data.Map as Map+--import qualified Data.IntMap as IntMap+import qualified Data.Set as Set+import Data.Maybe+--import System.Environment (getArgs)+import System.Random (RandomGen) --newStdGen+++type MyType = CId -- name of the categories from the program+type ConcType = CId -- categories from the resource grammar, that we parse on+type MyFunc = CId -- functions that we need to implement+--type FuncWithArg = ((MyFunc, MyType), Expr) -- function with arguments +type InterInstr = [String] -- lincats that were generated but not written to the file++++data FuncWithArg = FuncWithArg + {getName :: MyFunc, -- name of the function to generate+ getType :: MyType, -- return type of the function+ getTypeArgs :: [MyType] -- types of arguments + }+ deriving (Show,Eq,Ord)++-- we assume that it's for English for the moment+++type TypeMap = Map.Map MyType ConcType -- mapping found from a file++type ConcMap = Map.Map MyFunc Expr -- concrete expression after parsing++data Environ = Env {getTypeMap :: TypeMap, -- mapping between a category in the grammar and a concrete type from RGL+ getConcMap :: ConcMap, -- concrete expression after parsing + getSigs :: Map.Map MyType [FuncWithArg], -- functions for which we have the concrete syntax already with args + getAll :: [FuncWithArg] -- all the functions with arguments + }+++getNext :: Environ -> Environ -> ([MyFunc],[MyFunc])+getNext env example_env = + let sgs = getSigs env+ allfuncs = getAll env+ names = Set.fromList $ map getName $ concat $ Map.elems sgs+ exampleable = filter (\x -> (isJust $ getNameExpr x env) + &&+ (not $ Set.member x names) -- maybe drop this if you want to also rewrite from examples...+ ) $ map getName allfuncs+ testeable = filter (\x -> (isJust $ getNameExpr x env ) + && + (Set.member x names)+ ) $ map getName allfuncs ++ in (exampleable,testeable)+++provideExample :: RandomGen gen => gen -> Environ -> MyFunc -> PGF -> PGF -> Language -> Maybe (Expr,String)+provideExample gen env myfunc parsePGF pgfFile lang = + fmap giveExample $ getNameExpr myfunc env+ where + giveExample e_ = + let newexpr = head $ generateRandomFromDepth gen pgfFile e_ (Just 5) -- change here with the new random generator+ ty = getType $ head $ filter (\x -> getName x == myfunc) $ getAll env+ embeddedExpr = maybe "" (\x -> ", as in: " ++ q (linearize pgfFile lang x)) (embedInStart (getAll env) (Map.fromList [(ty,e_)]))+ lexpr = linearize pgfFile lang newexpr + q s = sq++s++sq+ sq = "\""+ in (newexpr,q lexpr ++ embeddedExpr)+-- question, you need the IO monad for the random generator, how to do otherwise ??+-- question can you make the expression bold/italic - somehow distinguishable from the rest ?++++testThis :: Environ -> MyFunc -> PGF -> Language -> Maybe String +testThis env myfunc parsePGF lang = + fmap (linearize parsePGF lang . mapToResource env . llin env) $+ getNameExpr myfunc env +++-- we assume that even the functions linearized by the user will still be in getSigs along with their linearization +++-- fill in the blancs of an expression that we want to linearize for testing purposes+---------------------------------------------------------------------------++llin :: Environ -> Expr -> Expr +llin env expr = + let + (id,args) = fromJust $ unApp expr+ --cexpr = fromJust $ Map.lookup id (getConcMap env)+ in + if any isMeta args + then let + sigs = concat $ Map.elems $ getSigs env+ tys = findExprWhich sigs id+ in replaceConcArg 1 tys expr env + else mkApp id $ map (llin env) args+++-- argument of the meta variable to replace, list of arguments left, expression to replace, environment, current replace expression +replaceConcArg :: Int -> [MyType] -> Expr -> Environ -> Expr+replaceConcArg i [] expr env = expr+replaceConcArg i (t:ts) expr env = -- TO DO : insert randomness here !!+ let ss = fromJust $ Map.lookup t $ getSigs env + args = filter (null . getTypeArgs) ss + finArg = if null args then let l = last ss in llin env (mkApp (getName l) [mkMeta j | j <- [1..(length $ getTypeArgs l)]]) + else mkApp (getName $ last args) [] + in + let newe = replaceOne i finArg expr+ in replaceConcArg (i+1) ts newe env + +-- replace a certain metavariable with a certain expression in another expression - return updated expression+replaceOne :: Int -> Expr -> Expr -> Expr +replaceOne i erep expr = + if isMeta expr && ((fromJust $ unMeta expr) == i) + then erep+ else if isMeta expr then expr+ else let (id,args) = fromJust $ unApp expr+ in + mkApp id $ map (replaceOne i erep) args+++findExprWhich :: [FuncWithArg] -> MyFunc -> [MyType]+findExprWhich lst f = getTypeArgs $ head $ filter (\x -> getName x == f) lst +++mapToResource :: Environ -> Expr -> Expr +mapToResource env expr = + let (id,args) = maybe (error $ "tried to unwrap " ++ showExpr [] expr) (\x -> x) (unApp expr)+ cmap = getConcMap env+ cexp = maybe (error $ "didn't find " ++ showCId id ++ " in "++ show cmap) (\x -> x) (Map.lookup id cmap)+ in + if null args then cexp+ else let newargs = map (mapToResource env) args+ in replaceAllArgs cexp 1 newargs+ where + replaceAllArgs expr i [] = expr + replaceAllArgs expr i (x:xs) = replaceAllArgs (replaceOne i x expr) (i+1) xs + + ++-----------------------------------------------++-- embed expression in another one from the start category++embedInStart :: [FuncWithArg] -> Map.Map MyType Expr -> Maybe Expr +embedInStart fss cs =+ let currset = Map.toList cs + nextset = Map.fromList $ concat [ if elem myt (getTypeArgs farg) + then connectWithArg (myt,exp) farg else [] + | (myt,exp) <- currset, farg <- fss]+ nextmap = Map.union cs nextset+ maybeExpr = Map.lookup startCateg nextset+ in if isNothing maybeExpr then + if Map.size nextmap == Map.size cs then Nothing --error $ "could't build " ++ show startCateg ++ "with " ++ show fss + else embedInStart fss nextmap+ else return $ fromJust maybeExpr+ where + connectWithArg (myt,exp) farg = + let ind = head $ elemIndices myt (getTypeArgs farg)+ in [(getType farg, mkApp (getName farg) $ [mkMeta i | i <- [1..ind]] ++ [exp] ++ [mkMeta i | i <- [(ind + 1)..((length $ getTypeArgs farg) - 1)]])]+ +++++-----------------------------------------------+{-+updateConcMap :: Environ -> MyFunc -> Expr -> Environ+updateConcMap env myf expr = + Env (getTypeMap env) (Map.insert myf expr (getConcMap env)) (getSigs env) (getAll env)++ +updateInterInstr :: Environ -> MyType -> FuncWithArg -> Environ+updateInterInstr env myt myf = + let ii = getSigs env+ newInterInstr = + maybe (Map.insert myt [myf] ii) (\x -> Map.insert myt (myf:x) ii) $ Map.lookup myt ii+ in Env (getTypeMap env) (getConcMap env) newInterInstr (getAll env)+++putSignatures :: Environ -> [FuncWithArg] -> Environ+putSignatures env fss = + Env (getTypeMap env) (getConcMap env) (mkSigs fss) (getAll env)+ + +updateEnv :: Environ -> FuncWithArg -> MyType -> Expr -> Environ +updateEnv env myf myt expr = + let ii = getSigs env+ nn = getName myf+ newInterInstr = + maybe (Map.insert myt [myf] ii) (\x -> Map.insert myt (myf:x) ii) $ Map.lookup myt ii+ in Env (getTypeMap env) (Map.insert nn expr (getConcMap env)) newInterInstr (getAll env)+-}++mkSigs :: [FuncWithArg] -> Map.Map MyType [FuncWithArg]+mkSigs fss = Map.fromListWith (++) $ zip (map getType fss) (map (\x -> [x]) fss)++++{------------------------------------+lang :: String +lang = "Eng"+++parseLang :: Language+parseLang = fromJust $ readLanguage "ParseEng"+++parsePGFfile :: String+parsePGFfile = "ParseEngAbs.pgf"+------------------------------------}+++++ +searchGoodTree :: Environ -> Expr -> [Expr] -> IO (Maybe (Expr,Expr))+searchGoodTree env expr [] = return Nothing+searchGoodTree env expr (e:es) = + do val <- debugReplaceArgs expr e env+ maybe (searchGoodTree env expr es) (\x -> return $ Just (x,e)) val ++++getNameExpr :: MyFunc -> Environ -> Maybe Expr+getNameExpr myfunc env = + let allfunc = filter (\x -> getName x == myfunc) $ getAll env+ in + if null allfunc then Nothing+ else getExpr (head allfunc) env++-- find an expression to generate where we have all the other elements available+getExpr :: FuncWithArg -> Environ -> Maybe Expr +getExpr farg env = + let tys = getTypeArgs farg+ ctx = getSigs env + lst = getConcTypes ctx tys 1+ in if (all isJust lst) then Just $ mkApp (getName farg) (map fromJust lst)+ else Nothing + where getConcTypes context [] i = []+ getConcTypes context (ty:types) i = + let pos = Map.lookup ty context+ in + if isNothing pos || (null $ fromJust pos) then [Nothing] + else + let mm = last $ fromJust pos+ mmargs = getTypeArgs mm+ newi = i + length mmargs - 1 + lst = getConcTypes (Map.insert ty (init $ (fromJust pos)) context) types (newi+1)+ in + if (all isJust lst) then -- i..newi+ (Just $ mkApp (getName mm) [mkMeta j | j <- [1..(length mmargs)]]) : lst + else [Nothing]+ +++++-- only covers simple expressions with meta variables, not the rest...+isGeneralizationOf :: Expr -> Expr -> Bool+isGeneralizationOf genExpr testExpr = + if isMeta genExpr then True+ else if isMeta testExpr then False+ else let genUnwrap = unApp genExpr + testUnwrap = unApp testExpr+ in if isNothing genUnwrap || isNothing testUnwrap then False -- see if you can generalize here+ else let (gencid, genargs) = fromJust genUnwrap + (testcid, testargs) = fromJust testUnwrap+ in + (gencid == testcid) && (length genargs == length testargs) + && (and [isGeneralizationOf g t | (g,t) <- (zip genargs testargs)])++{-do lst <- getConcTypes context types (i+1)+ return $ mkMeta i : lst -} ++debugReplaceArgs :: Expr -> Expr -> Environ -> IO (Maybe Expr)+debugReplaceArgs aexpr cexpr env = + if isNothing $ unApp aexpr then return Nothing+ else if any isNothing $ map unApp $ snd $ fromJust $ unApp aexpr then return Nothing+ else+ let args = map (fst.fromJust.unApp) $ snd $ fromJust $ unApp aexpr+ concExprs = map (\x -> fromJust $ Map.lookup x $ getConcMap env) args+ in startReplace 1 cexpr concExprs+ where + startReplace i cex [] = return $ Just cex+ startReplace i cex (a:as) = do val <- debugReplaceConc cex i a+ maybe ( --do putStrLn $ "didn't find "++ showExpr [] a ++ " in " ++showExpr [] cexpr+ return Nothing) + (\x -> --do putStrLn $ "found it, the current expression is "++ showExpr [] x+ startReplace (i+1) x as) + val + +debugReplaceConc :: Expr -> Int -> Expr -> IO (Maybe Expr)+debugReplaceConc expr i e = + let (newe,isThere) = searchArg expr + in if isThere then return $ Just newe else return $ Nothing + where + searchArg e_ = + if isGeneralizationOf e e_ then (mkMeta i, True)+ else maybe (e_,False) (\(cid,args) -> let repargs = map searchArg args+ in (mkApp cid (map fst repargs), or $ map snd repargs)) $ unApp e_ + ++{-+-- replaceArgs : Original expression to parse (from abstract syntax) -> Concrete expression (parsed) +replaceArgs :: Expr -> Expr -> Environ -> Maybe Expr+replaceArgs aexpr cexpr env =+ if isNothing $ unApp aexpr then error $ "could't unwrap this "++ show aexpr + else if any isNothing $ map unApp $ snd $ fromJust $ unApp aexpr then error $ "couldn't unwrap more this : "++ show aexpr+ else + let args = map (fst.fromJust.unApp) $ snd $ fromJust $ unApp aexpr+ concExprs = map (\x -> fromJust $ Map.lookup x $ getConcMap env) args+ in startReplace 1 cexpr concExprs+ where + startReplace i cex [] = return cex + startReplace i cex (a:as) = maybe Nothing (\x -> startReplace (i+1) x as) $ replaceConc cex i a++++replaceConc :: Expr -> Int -> Expr -> Maybe Expr+replaceConc expr i e = + let (newe,isThere) = searchArg expr + in if isThere then return newe else Nothing + where + searchArg e_ = + if isGeneralizationOf e e_ then (mkMeta i, True)+ else maybe (e_,False) (\(cid,args) -> let repargs = map searchArg args+ in (mkApp cid (map fst repargs), or $ map snd repargs)) $ unApp e_ ++++writeResults :: Environ -> String -> IO ()+writeResults env fileName = + let cmap = getConcMap env+ lincats = unlines $ map (\(x,y) -> "lincat " ++ showCId x ++ " = " ++ showCId y ++ " ; " ) $ Map.toList $ getTypeMap env + sigs = unlines $ map + (\x -> let n = getName x + no = length $ getTypeArgs x+ oargs = unwords $ ("lin " ++ showCId n) : ["o"++show i | i <- [1..no]] + in (oargs ++ " = " ++ (simpleReplace $ showExpr [] $ fromJust $ Map.lookup n cmap) ++ " ; ")) $ concat $ Map.elems $ getSigs env+ in + writeFile fileName ("\n" ++ lincats ++ "\n\n" ++ sigs) + ++simpleReplace :: String -> String +simpleReplace [] = []+simpleReplace ('?':xs) = 'o' : simpleReplace xs+simpleReplace (x:xs) = x : simpleReplace xs+-}++isMeta :: Expr -> Bool+isMeta = isJust.unMeta ++-- works with utf-8 characters also, as it seems+++mkFuncWithArg :: ((CId,CId),[CId]) -> FuncWithArg+mkFuncWithArg ((c1,c2),cids) = FuncWithArg c1 c2 cids+++---------------------------------------------------------------------------------++initial :: TypeMap -> ConcMap -> [FuncWithArg] -> [FuncWithArg] -> Environ+initial tm cm fss allfs = Env tm cm (mkSigs fss) allfs+{-+testInit :: [FuncWithArg] -> Environ+testInit allfs = initial lTypes Map.empty [] allfs++lTypes = Map.fromList [(mkCId "Comment", mkCId "S"),(mkCId "Item", mkCId "NP"), (mkCId "Kind", mkCId "CN"), (mkCId "Quality", mkCId "AP")]+-}+startCateg = mkCId "Comment"+-- question about either to give the startcat or not ...++++++----------------------------------------------------------------------------------------------------------+{-+main = + do args <- getArgs+ case args of + [pgfFile] -> + do pgf <- readPGF pgfFile+ parsePGF <- readPGF parsePGFfile+ fsWithArg <- forExample pgf+ let funcsWithArg = map (map mkFuncWithArg) fsWithArg+ let morpho = buildMorpho parsePGF parseLang+ let fss = concat funcsWithArg+ let fileName = takeWhile (/='.') pgfFile ++ lang ++ ".gf"+ env <- start parsePGF pgf morpho (testInit fss) fss+ putStrLn $ "Should I write the results to a file ? yes/no"+ ans <-getLine + if ans == "yes" then do writeResults env fileName+ putStrLn $ "Wrote file " ++ fileName+ else return () + _ -> fail "usage : Testing <path-to-pgf> "+++ +start :: PGF -> PGF -> Morpho -> Environ -> [FuncWithArg] -> IO Environ+start parsePGF pgfFile morpho env lst = + do putStrLn "Do you want examples from another language ? (no/concrete syntax name otherwise)"+ ans1 <- getLine+ putStrLn "Do you want testing mode ? (yes/no)"+ ans2 <- getLine+ case (ans1,ans2) of+ ("no","no") -> do putStrLn "no extra language, just the abstract syntax tree"+ interact env lst False Nothing + (_,"no") -> interact env lst False (readLanguage ans1)+ ("no","yes") -> do putStrLn "no extra language, just the abstract syntax tree"+ interact env lst True Nothing+ (_,"yes") -> interact env lst True (readLanguage ans1)+ ("no",_) -> do putStrLn "no extra language, just the abstract syntax tree"+ putStrLn $ "I assume you don't want the testing mode ... " + interact env lst False Nothing+ (_,_) -> do putStrLn $ "I assume you don't want the testing mode ... " + interact env lst False (readLanguage ans1) + where ++ interact environ [] func _ = return environ+ interact environ (farg:fargs) boo otherLang = + do + maybeEnv <- basicInter farg otherLang environ boo+ if isNothing maybeEnv then return environ+ else interact (fromJust maybeEnv) fargs boo otherLang ++ basicInter farg js environ False = + let e_ = getExpr farg environ in + if isNothing e_ then return $ Just environ+ else parseAndBuild farg js environ (getType farg) e_ Nothing + basicInter farg js environ True = + let (e_,e_test) = get2Expr farg environ in + if isNothing e_ then return $ Just environ + else if isNothing e_test then do putStrLn $ "not enough arguments "++ (showCId $ getName farg)+ parseAndBuild farg js environ (getType farg) e_ Nothing + else parseAndBuild farg js environ (getType farg) e_ e_test++-- . head . generateRandomFrom gen2 pgfFile+ parseAndBuild farg js environ ty e_ e_test =+ do let expr = fromJust e_+ gen1 <- newStdGen+ gen2 <- newStdGen+ let newexpr = head $ generateRandomFrom gen1 pgfFile expr+ let embeddedExpr = maybe "***" (showExpr [] ) (embedInStart (getAll environ) (Map.fromList [(ty,expr)])) + let lexpr = if isNothing js then "" else "\n-- " ++ linearize pgfFile (fromJust js) newexpr ++ " --" + putStrLn $ "Give an example for " ++ (showExpr [] expr) + ++ lexpr ++ "and now"+ ++ "\n\nas in " ++ embeddedExpr ++ "\n\n"+ --+ ex <- getLine + if (ex == ":q") then return Nothing + else + let ctype = fromJust $ Map.lookup (getType farg) (getTypeMap environ) in+ do env' <- decypher farg ex expr environ (fromJust $ readType $ showCId ctype) e_test+ return (Just env')+ + decypher farg ex expr environ ty e_test = + --do putStrLn $ "We need to parse " ++ ex ++ " as " ++ show ctype+ let pTrees = parse parsePGF (fromJust $ readLanguage "ParseEng") ty ex in + pickTree farg expr environ ex e_test pTrees + + -- putStrLn $ "And now for testing, \n is this also correct yes/no \n ## " ++ (linearize parsePGF parseLang $ mapToResource newenv $ llin newenv e_test) ++ " ##"+ + -- select the right tree among the options given by the parser + pickTree farg expr environ ex e_test [] = + let miswords = morphoMissing morpho (words ex) + in + if null miswords then do putStrLn $ "all words known, but some syntactic construction is not covered by the grammar..."+ return environ+ else do putStrLn $ "the following words are unknown, please add them to the lexicon: " ++ show miswords+ return environ+ pickTree farg expr environ ex e_test [tree] = + do val <- searchGoodTree environ expr [tree] -- maybe order here after the probabilities for better precision+ maybe (do putStrLn $ "none of the trees is consistent with the rest of the grammar, please check arguments "+ return environ) + (\(x,newtree) -> let newenv = updateEnv environ farg (getType farg) x in+ do putStrLn $ "the result is "++showExpr [] x+ newtestenv <- testTest newenv e_test -- question ? should it belong there - there is just one possibility of a tree... + return newenv) val+ pickTree farg expr environ ex e_test parseTrees = + do putStrLn $ "There is more than one possibility, do you want to choose the right tree yourself ? yes/no "+ putStr " >"+ ans <- getLine+ if ans == "yes" then do pTree <- chooseRightTree parseTrees+ processTree farg environ expr pTree e_test+ else processTree farg environ expr parseTrees e_test++ -- introduce testing function, if it doesn't work, then reparse, take that tree+ testTree envv e_test = return envv -- TO DO - add testing here+ + testTest envv Nothing = return envv+ testTest envv (Just exxpr) = testTree envv exxpr + ++ -- allows the user to pick his own tree+ chooseRightTree trees = return trees -- TO DO - add something clever here + + -- selects the tree from where one can abstract over the original arguments + processTree farg environ expr lsTrees e_test =+ let trmes = if length lsTrees == 1 then "the tree is not consistent " else "none of the trees is consistent " in+ do val <- searchGoodTree environ expr lsTrees+ maybe (do putStrLn $ trmes ++ "with the rest of the grammar, please check arguments! "+ return environ) + (\(x,newtree) -> let newenv = updateEnv environ farg (getType farg) x in+ do putStrLn $ "the result is "++showExpr [] x+ newtestenv <- testTest newenv e_test + return newenv) val++++-------------------------------++get2Expr :: FuncWithArg -> Environ -> (Maybe Expr, Maybe Expr)+get2Expr farg env =+ let tys = getTypeArgs farg+ ctx = getSigs env+ (lst1,lst2) = getConcTypes2 ctx tys 1+ arg1 = if (all isJust lst1) then Just $ mkApp (getName farg) (map fromJust lst1) else Nothing+ arg2 = if (all isJust lst2) then Just $ mkApp (getName farg) (map fromJust lst2) else Nothing+ in if arg1 == arg2 then (arg1, Nothing)+ else (arg1,arg2)+ where + getConcTypes2 context [] i = ([],[])+ getConcTypes2 context (ty:types) i = + let pos = Map.lookup ty context+ in + if isNothing pos || (null $ fromJust pos) then ([Nothing],[Nothing]) + else + let (mm,tt) = (last $ fromJust pos, head $ fromJust pos)+ mmargs = getTypeArgs mm+ newi = i + length mmargs - 1 + (lst1,lst2) = getConcTypes2 (Map.insert ty (init (fromJust pos)) context) types (newi+1)+ ttargs = getTypeArgs tt+ newtti = i + length ttargs - 1+ fstArg = if (all isJust lst1) then -- i..newi + (Just $ mkApp (getName mm) [mkMeta j | j <- [1..(length mmargs)]]) : lst1 + else [Nothing]+ sndArg = if (all isJust lst2) then + (Just $ mkApp (getName tt) [mkMeta j | j <- [1..(length ttargs)]]) : lst2+ else [Nothing]+ in + (fstArg,sndArg) +++-}+
@@ -0,0 +1,128 @@+module ExampleService(cgiMain,cgiMain',newPGFCache) where+import System.Random(newStdGen)+import System.FilePath((</>),makeRelative)+import Data.Map(fromList)+import Data.Char(isDigit)+import Data.Maybe(fromJust)+import qualified Codec.Binary.UTF8.String as UTF8 (decodeString)+import PGF+import GF.Compile.ToAPI+import Network.CGI+import Text.JSON+import CGIUtils+import Cache+import qualified ExampleDemo as E++newPGFCache = newCache readPGF+++cgiMain :: Cache PGF -> CGI CGIResult+cgiMain = handleErrors . handleCGIErrors . cgiMain' "." "."++cgiMain' root cwd cache =+ do command <- getInp "command"+ environ <- parseEnviron =<< getInp "state"+ case command of+ "possibilities" -> doPossibilities environ+ "provide_example" -> doProvideExample root cwd cache environ+ "abstract_example" -> doAbstractExample cwd cache environ+ "test_function" -> doTestFunction cwd cache environ+ _ -> throwCGIError 400 ("Unknown command: "++command) []++doPossibilities environ =+ do example_environ <- parseEnviron =<< getInp "example_state"+ outputJSONP (E.getNext environ example_environ)++doProvideExample root cwd cache environ =+ do Just lang <- readInput "lang"+ fun <- getCId "fun"+ parsePGF <- readParsePGF cwd cache+ let adjpath path = root</>makeRelative "/" (makeRelative root cwd</>path)+ pgf <- liftIO . readCache cache . adjpath =<< getInp "grammar"+ gen <- liftIO newStdGen+ let Just (e,s) = E.provideExample gen environ fun parsePGF pgf lang+ res = (showExpr [] e,s)+ liftIO $ logError $ "proveExample ... = "++show res+ outputJSONP res++doAbstractExample cwd cache environ =+ do example <- getInp "input"+ Just params <- readInput "params"+ absstr <- getInp "abstract"+ Just abs <- return $ readExpr absstr+ liftIO $ logError $ "abstract = "++showExpr [] abs+ Just cat <- readInput "cat"+ let t = mkType [] cat []+ parsePGF <- readParsePGF cwd cache+ let lang:_ = languages parsePGF+ ae <- liftIO $ abstractExample parsePGF environ lang t abs example+ outputJSONP (fmap (\(e,_)->(exprToAPI (instExpMeta params e),e)) ae)++abstractExample parsePGF env lang cat abs example =+ E.searchGoodTree env abs (parse parsePGF lang cat example)++doTestFunction cwd cache environ =+ do fun <- getCId "fun"+ parsePGF <- readParsePGF cwd cache+ let lang:_ = languages parsePGF+ Just txt <- return (E.testThis environ fun parsePGF lang)+ outputJSONP txt++getCId :: String -> CGI CId+getCId name = maybe err return =<< fmap readCId (getInp name)+ where err = throwCGIError 400 ("Bad "++name) []+{-+getLimit :: CGI Int+getLimit = maybe err return =<< readInput "limit"+ where err = throwCGIError 400 "Missing/bad limit" []+-}++readParsePGF cwd cache =+ do parsepgf <- getInp "parser"+ liftIO $ readCache cache (cwd</>parsepgf)++parseEnviron s = do state <- liftIO $ readIO s+ return $ environ state++getInp name = maybe err (return . UTF8.decodeString) =<< getInput name+ where err = throwCGIError 400 ("Missing parameter: "++name) []+++instance JSON CId where+ showJSON = showJSON . show+ readJSON = (readResult =<<) . readJSON++instance JSON Expr where+ showJSON = showJSON . showExpr []+ readJSON = (m2r . readExpr =<<) . readJSON++m2r = maybe (Error "read failed") Ok++readResult s = case reads s of+ (x,r):_ | lex r==[("","")] -> Ok x+ _ -> Error "read failed"++--------------------------------------------------------------------------------+-- cat lincat fun lin fun cat cat+environ :: ([(CId, CId)],[(CId, Expr)],[((CId, CId), [CId])]) -> E.Environ+environ (lincats,lins0,funs) =+ E.initial (fromList lincats) concmap fs allfs+ where+ concmap = fromList lins+ allfs = map E.mkFuncWithArg funs+ fs = [E.mkFuncWithArg f | f@((fn,_),_)<-funs, fn `elem` cns]+ cns = map fst lins+ lins = filter (not . E.isMeta .snd) lins0+++instExpMeta :: [CId] -> Expr -> Expr+instExpMeta ps = fromJust . readExpr . instMeta ps . showExpr []++instMeta :: [CId] -> String -> String+instMeta ps s =+ case break (=='?') s of+ (s1,'?':s2) ->+ case span isDigit s2 of+ (s21@(_:_),s22) -> s1++show (ps!!(read s21-1))++instMeta ps s22+ ("",s22) -> s1++'?':instMeta ps s22+ (_,_) -> s
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}+import Control.Concurrent(forkIO)+import Network.FastCGI(runFastCGI,runFastCGIConcurrent')+import ExampleService(cgiMain,newPGFCache)++main = do --stderrToFile logFile+ fcgiMain =<< newPGFCache+++fcgiMain cache =+#ifndef mingw32_HOST_OS+ runFastCGIConcurrent' forkIO 100 (cgiMain cache)+#else+ runFastCGI (cgiMain cache)+#endif
@@ -0,0 +1,25 @@+Name: gf-exb+Version: 1.0+Cabal-version: >= 1.8+Build-type: Simple+License: GPL+Synopsis: Example-based grammar writing for the Grammatical Framework++executable exb.fcgi+ main-is: exb-fcgi.hs+ Hs-source-dirs: . ../server ../compiler ../runtime/haskell+ other-modules: ExampleService ExampleDemo+ FastCGIUtils Cache GF.Compile.ToAPI+ -- and a lot more...+ ghc-options: -threaded+ if impl(ghc>=7.0)+ ghc-options: -rtsopts++ build-depends: base >=4.2 && <5, json, cgi, fastcgi, random,+ containers, old-time, directory, bytestring, utf8-string,+ pretty, array, mtl, fst, filepath++ if os(windows)+ ghc-options: -optl-mwindows+ else+ build-depends: unix
@@ -0,0 +1,20 @@++Editor improvements for example-based grammar writing:++ Remove the same language from the example language menu++ Send the other language environment to getNext+- Compile a new .pgf automatically when needed+- Update buttons automatically when functions are added or removed+- Switch over to using AbsParadigmsEng.pgf instead of the old exprToAPI function++Editor support for guided construction of linearization functions+- enter api expressions by parsing them with AbsParadigmsEng.pgf in minibar+- replace simpleParseInput with one that accepts quoted string literals+- use lexcode/unlexcode in minibar+- better support for literals in minibar (completion info from the PGF+ library should indicate if literals are acceptable)++Server support for example-based grammar writing:+- Change getNext to use info from the example language+- Random generator restricted to defined functions++- More testing
@@ -0,0 +1,3 @@+import qualified GF++main = GF.main
@@ -0,0 +1,9 @@+libpgf is written by:++Krasimir Angelov <krasimir@chalmers.se>+Lauri Alanko <lealanko@ling.helsinki.fi>++with some contributions from:++Prasanth Kolachina <prasanth.kolachina@cse.gu.se>+Bjørnar Luteberget <luteberget@gmail.com>
@@ -0,0 +1,91 @@+project(libpgf)+cmake_minimum_required(VERSION 2.8)++set(GNU_LIGHTNING_ARCH "i386" CACHE STRING "Target architecture for GNU Lightning JIT")+#set(ADD_CFLAGS "-Wall -Wextra -Wno-missing-field-initializers -Wno-unused-parameter -Wno-unused-value" CACHE STRING "Additional C compiler options")+#set(CMAKE_SHARED_LINKER_FLAGS "${CMAKE_SHARED_LINKER_FLAGS} -Wl,-no-undefined")+set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -std=gnu99 ${ADD_CFLAGS}")++set(GNU_LIGHTNING_ARCH_HEADERS+ pgf/lightning/${GNU_LIGHTNING_ARCH}/asm.h+ pgf/lightning/${GNU_LIGHTNING_ARCH}/fp.h+ pgf/lightning/${GNU_LIGHTNING_ARCH}/core.h+ pgf/lightning/${GNU_LIGHTNING_ARCH}/funcs.h+)++file(COPY ${GNU_LIGHTNING_ARCH_HEADERS}+ DESTINATION ${CMAKE_CURRENT_SOURCE_DIR}/pgf/lightning/)+++include_directories(.)+include_directories(./pgf)+++set(libgu_la_SOURCES + gu/assert.c + gu/bits.c + gu/choice.c + gu/defs.c + gu/seq.c + gu/enum.c + gu/exn.c + gu/file.c + gu/fun.c + gu/hash.c + gu/in.c + gu/map.c + gu/mem.c + gu/out.c + gu/prime.c + gu/string.c + gu/utf8.c + gu/ucs.c + gu/variant.c+)++set(libpgf_la_SOURCES + pgf/data.c + pgf/data.h + pgf/expr.c + pgf/expr.h + pgf/parser.c + pgf/lookup.c+ pgf/jit.c + pgf/parseval.c + pgf/literals.c + pgf/literals.h + pgf/reader.h + pgf/reader.c + pgf/linearizer.c + pgf/typechecker.c + pgf/reasoner.c + pgf/evaluator.c + pgf/hopu.c + pgf/printer.c + pgf/graphviz.c + pgf/aligner.c + pgf/pgf.c + pgf/pgf.h +)++set(libsg_la_SOURCES + sg/sqlite3Btree.c + sg/sg.c+)+++add_library(gu SHARED ${libgu_la_SOURCES})+#set_property(TARGET gu PROPERTY C_STANDARD 99)+#set_property(TARGET gu PROPERTY WINDOWS_EXPORT_ALL_SYMBOLS true)+target_compile_definitions(gu PRIVATE COMPILING_GU=1)++add_library(pgf SHARED ${libpgf_la_SOURCES})+#set_property(TARGET pgf PROPERTY C_STANDARD 99)+#set_property(TARGET pgf PROPERTY WINDOWS_EXPORT_ALL_SYMBOLS true)+target_compile_definitions(pgf PRIVATE COMPILING_PGF=1)+target_link_libraries(pgf gu)+if(UNIX)+ target_link_libraries(pgf m)+endif(UNIX)++install(TARGETS gu pgf DESTINATION lib)
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions.++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version.++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
@@ -0,0 +1,60 @@+General Note+------------++If you want to use the statistical ranking in the parser then you+have to compile your grammar with the option '-probs=grammar.probs',+where grammar.probs must contain a tab separated file with+the probabilities for all functions in the abstract syntax.+In order to enable the named entity recongizer for the ParseEngAbs+grammar you also have to add the option '-literal=Symb' while compiling.+++For Linux users+---------------++You will need the packages: autoconf, automake, libtool, make++The compilation steps are:++$ autoreconf -i+$ ./configure+$ make+$ make install+++For Mac OSX users+-----------------++The following is what I did to make it work on MacOSX 10.8:++- Install XCode and XCode command line tools+- Install Homebrew: http://mxcl.github.com/homebrew/++$ brew install automake autoconf libtool+$ glibtoolize+$ autoreconf -i+$ ./configure+$ make+$ make install+++For Windows users+-----------------++- Install MinGW: http://www.mingw.org/. From the installer you need+ to select at least the following packages:+ - Mingw-developer-toolkit+ - Mingw-base+ - Msys-base+ After the installation, don't forget to fix the fstab file. See here:+ http://www.mingw.org/wiki/Getting_Started++- From the MSYS shell (c:/MinGW/msys/1.0/msys.bat) go to the directory + which contains the INSTALL file and do:++ $ autoreconf -i+ $ ./configure+ $ make+ $ make install++ The compiled binaries should be now in c:/MinGW/msys/1.0/local/bin.
@@ -0,0 +1,108 @@+lib_LTLIBRARIES = libgu.la libpgf.la libsg.la++pkgconfigdir = $(libdir)/pkgconfig+pkgconfig_DATA = libgu.pc libpgf.pc libsg.pc++configincludedir = $(libdir)/libgu/include++guincludedir=$(includedir)/gu+guinclude_HEADERS = \+ gu/assert.h \+ gu/bits.h \+ gu/choice.h \+ gu/defs.h \+ gu/enum.h \+ gu/exn.h \+ gu/file.h \+ gu/fun.h \+ gu/hash.h \+ gu/in.h \+ gu/map.h \+ gu/mem.h \+ gu/out.h \+ gu/prime.h \+ gu/seq.h \+ gu/string.h \+ gu/sysdeps.h \+ gu/ucs.h \+ gu/utf8.h \+ gu/variant.h++pgfincludedir=$(includedir)/pgf+pgfinclude_HEADERS = \+ pgf/expr.h \+ pgf/linearizer.h \+ pgf/literals.h \+ pgf/graphviz.h \+ pgf/pgf.h \+ pgf/data.h++sgincludedir=$(includedir)/sg+sginclude_HEADERS = \+ sg/sg.h++libgu_la_SOURCES = \+ gu/assert.c \+ gu/bits.c \+ gu/choice.c \+ gu/defs.c \+ gu/seq.c \+ gu/enum.c \+ gu/exn.c \+ gu/file.c \+ gu/fun.c \+ gu/hash.c \+ gu/in.c \+ gu/map.c \+ gu/mem.c \+ gu/out.c \+ gu/prime.c \+ gu/string.c \+ gu/utf8.c \+ gu/ucs.c \+ gu/variant.c+libgu_la_LDFLAGS = -no-undefined++libpgf_la_SOURCES = \+ pgf/data.c \+ pgf/data.h \+ pgf/expr.c \+ pgf/expr.h \+ pgf/parser.c \+ pgf/lookup.c \+ pgf/jit.c \+ pgf/parseval.c \+ pgf/literals.c \+ pgf/literals.h \+ pgf/reader.h \+ pgf/reader.c \+ pgf/writer.h \+ pgf/writer.c \+ pgf/linearizer.c \+ pgf/typechecker.c \+ pgf/reasoner.c \+ pgf/evaluator.c \+ pgf/hopu.c \+ pgf/printer.c \+ pgf/graphviz.c \+ pgf/aligner.c \+ pgf/pgf.c \+ pgf/pgf.h+libpgf_la_LDFLAGS = -no-undefined+libpgf_la_LIBADD = libgu.la++libsg_la_SOURCES = \+ sg/sqlite3Btree.c \+ sg/sg.c+libsg_la_LDFLAGS = -no-undefined+libsg_la_LIBADD = libgu.la libpgf.la++bin_PROGRAMS =++AUTOMAKE_OPTIONS = foreign subdir-objects dist-bzip2+ACLOCAL_AMFLAGS = -I m4++EXTRA_DIST = \+ libgu.pc.in \+ libpgf.pc.in \+ libsg.pc.in
@@ -0,0 +1,64 @@+AC_INIT(Portable Grammar Format library, 0.1-pre, + http://www.grammaticalframework.org/, + libpgf)+AC_PREREQ(2.58)++AC_CONFIG_SRCDIR([gu/mem.c])+AC_CONFIG_AUX_DIR([scripts])+AC_CONFIG_MACRO_DIR([m4])++AC_CANONICAL_TARGET++AM_INIT_AUTOMAKE([1.7.9])+m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])])++PKG_PROG_PKG_CONFIG++AC_CONFIG_HEADERS([config.h])++AM_MAINTAINER_MODE([enable])+AC_CHECK_LIB(m,nan)+AC_PROG_MAKE_SET+AC_PROG_INSTALL+AC_PROG_LIBTOOL+AC_PROG_CC+AC_PROG_CC_C99+AM_PROG_CC_C_O++[if [ "x$GCC" = "xyes" ]; then+ CFLAGS="$CFLAGS\+ -Wall\+ -Wextra\+ -Wno-missing-field-initializers\+ -Wno-unused-parameter\+ -Wno-unused-value"+fi]++case "$target_cpu" in+ i?86) cpu=i386; AC_DEFINE(LIGHTNING_I386, 1,+ [Define if lightning is targeting the x86 architecture]) ;;+ x86_64) cpu=i386; AC_DEFINE(LIGHTNING_I386, 1,+ [Define if lightning is targeting the x86 architecture]) ;;+ sparc*) cpu=sparc; AC_DEFINE(LIGHTNING_SPARC, 1,+ [Define if lightning is targeting the sparc architecture]) ;;+ powerpc) cpu=ppc; AC_DEFINE(LIGHTNING_PPC, 1,+ [Define if lightning is targeting the powerpc architecture]) ;;+ arm*) cpu=arm; AC_DEFINE(LIGHTNING_ARM, 1,+ [Define if lightning is targeting the arm architecture]) ;;+ *) AC_MSG_ERROR([cpu $target_cpu not supported]) ;;+esac++cpu_dir=pgf/lightning/$cpu+AC_CONFIG_LINKS(pgf/lightning/asm.h:$cpu_dir/asm.h dnl+ pgf/lightning/fp.h:$cpu_dir/fp.h dnl+ pgf/lightning/core.h:$cpu_dir/core.h dnl+ pgf/lightning/funcs.h:$cpu_dir/funcs.h, [],+ [cpu_dir=$cpu_dir])++AC_CONFIG_FILES([Makefile+ libgu.pc+ libpgf.pc+ libsg.pc+ ])++AC_OUTPUT
@@ -0,0 +1,52 @@+#include <gu/assert.h>+#include <stdlib.h>+#include <stdio.h>+#include <stdarg.h>++static const char*+gu_assert_mode_descs[] = {+ [GU_ASSERT_PRECOND] = "precondition failed",+ [GU_ASSERT_POSTCOND] = "postcondition failed",+ [GU_ASSERT_ASSERTION] = "assertion failed",+ [GU_ASSERT_NEVER] = "control should not reach here",+};++GU_API void+gu_abort_v_(GuAssertMode mode,+ const char* file, const char* func, int line,+ const char* msg_fmt, va_list args)+{+ const char* desc = gu_assert_mode_descs[mode];+ (void) fprintf(stderr, "%s (%s:%d): %s\n", func, file, line, desc);+ if (msg_fmt != NULL) {+ (void) fputc('\t', stderr);+ (void) vfprintf(stderr, msg_fmt, args);+ (void) fputc('\n', stderr);+ }+ abort();+}++GU_API void+gu_abort_(GuAssertMode mode,+ const char* file, const char* func, int line,+ const char* msg_fmt, ...)+{+ va_list args;+ va_start(args, msg_fmt);+ gu_abort_v_(mode, file, func, line, msg_fmt, args);+ va_end(args);+}++GU_API void +gu_fatal(const char* fmt, ...)+{+ va_list args;+ va_start(args, fmt);+ fputs("Fatal error", stderr);+ if (fmt) {+ fputs(": ", stderr);+ (void) vfprintf(stderr, fmt, args);+ }+ fputc('\n', stderr);+ abort();+}
@@ -0,0 +1,61 @@+#ifndef GU_ASSERT_H_+#define GU_ASSERT_H_++#include <gu/defs.h>++typedef enum {+ GU_ASSERT_PRECOND,+ GU_ASSERT_ASSERTION,+ GU_ASSERT_POSTCOND,+ GU_ASSERT_NEVER+} GuAssertMode;++GU_API_DECL void+gu_abort_v_(GuAssertMode mode, + const char* file, const char* func, int line,+ const char* msg_fmt, va_list args);++GU_API_DECL void+gu_abort_(GuAssertMode mode, + const char* file, const char* func, int line,+ const char* msg_fmt, ...);++#ifndef NDEBUG+#define gu_assertion_(mode_, expr_, ...) \+ GU_BEGIN \+ if (!(expr_)) { \+ gu_abort_(mode_, __FILE__, __func__, __LINE__, __VA_ARGS__); \+ } \+ GU_END+#else+// this should prevent unused variable warnings when a variable is only used+// in an assertion+#define gu_assertion_(mode_, expr_, ...) \+ GU_BEGIN \+ (void) (sizeof (expr_)); \+ GU_END+#endif+++#define gu_require(expr) \+ gu_assertion_(GU_ASSERT_PRECOND, expr, "%s", #expr)++#define gu_assert_msg(expr, ...) \+ gu_assertion_(GU_ASSERT_ASSERTION, expr, __VA_ARGS__)++#define gu_assert(expr) \+ gu_assert_msg(expr, "%s", #expr)++#define gu_ensure(expr) \+ gu_assertion_(GU_ASSERT_POSTCOND, expr, "%s", #expr)++#define gu_impossible_msg(...) \+ gu_assertion_(GU_ASSERT_ASSERTION, false, __VA_ARGS__)++#define gu_impossible() \+ gu_impossible_msg(NULL)++GU_API_DECL void+gu_fatal(const char* fmt, ...);++#endif /* GU_ASSERT_H_ */
@@ -0,0 +1,76 @@+#include <gu/bits.h>++#include <limits.h>+#include <inttypes.h>+#include <stdio.h>+#include <string.h>+#include <stdlib.h>+#include <math.h>++GU_INTERNAL unsigned+gu_ceil2e(unsigned u) +{+ u--;+ u |= u >> 1;+ u |= u >> 2;+ u |= u >> 4;+ u |= u >> 8;+#if UINT_MAX > UINT16_MAX+ u |= u >> 16;+#endif+#if UINT_MAX > UINT32_MAX+ u |= u >> 32;+#endif+ u++;+ return u;+}++GU_INTERNAL double+gu_decode_double(uint64_t u)+{+ bool sign = u >> 63;+ unsigned rawexp = u >> 52 & 0x7ff;+ uint64_t mantissa = u & 0xfffffffffffff;+ double ret;++ if (rawexp == 0x7ff) {+ ret = (mantissa == 0) ? INFINITY : NAN;+ } else {+ uint64_t m = rawexp ? 1ULL << 52 | mantissa : mantissa << 1;+ ret = ldexp((double) m, rawexp - 1075);+ }+ return sign ? copysign(ret, -1.0) : ret;+}++GU_INTERNAL uint64_t+gu_encode_double(double d)+{+ int sign = signbit(d) > 0;+ unsigned rawexp;+ uint64_t mantissa;++ switch (fpclassify(d)) {+ case FP_NAN:+ rawexp = 0x7ff;+ mantissa = 1;+ break;+ case FP_INFINITE:+ rawexp = 0x7ff;+ mantissa = 0;+ break;+ default: {+ int exp;+ mantissa = (uint64_t) scalbn(frexp(d, &exp), 53);+ mantissa &= ~ (1ULL << 52);+ exp -= 53;++ rawexp = exp + 1075;+ }+ }++ uint64_t u = (((uint64_t) sign) << 63) |+ (((uint64_t) rawexp & 0x7ff) << 52) |+ mantissa;++ return u;+}
@@ -0,0 +1,150 @@+#ifndef GU_BITS_H_+#define GU_BITS_H_++#include <gu/defs.h>+#include <gu/assert.h>+++#define GU_WORD_BITS (sizeof(GuWord) * CHAR_BIT)+++/*+ * Based on the Bit Twiddling Hacks collection by Sean Eron Anderson+ * <http://graphics.stanford.edu/~seander/bithacks.html>+ */++GU_INTERNAL_DECL+unsigned gu_ceil2e(unsigned i);++static inline int+gu_sign(int i) {+ return (i > 0) - (i < 0);+}++static inline size_t+gu_ceildiv(size_t size, size_t div)+{+ return (size + div - 1) / div;+}++static inline bool+gu_aligned(uintptr_t addr, size_t alignment)+{+ //gu_require(alignment == gu_ceil2e(alignment));+ return (addr & (alignment - 1)) == 0;+}++static inline uintptr_t+gu_align_forward(uintptr_t addr, size_t alignment) {+ //gu_require(alignment == gu_ceil2e(alignment));+ uintptr_t mask = alignment - 1;+ return (addr + mask) & ~mask;+}++static inline uintptr_t+gu_align_backward(uintptr_t addr, size_t alignment) {+ //gu_require(alignment == gu_ceil2e(alignment));+ return addr & ~(alignment - 1);+}++static inline bool+gu_bits_test(const GuWord* bitmap, int idx) {+ return !!(bitmap[idx / GU_WORD_BITS] & 1 << (idx % GU_WORD_BITS));+}++static inline void+gu_bits_set(GuWord* bitmap, int idx) {+ bitmap[idx / GU_WORD_BITS] |= ((GuWord) 1) << (idx % GU_WORD_BITS);+}++static inline void+gu_bits_clear(GuWord* bitmap, int idx) {+ bitmap[idx / GU_WORD_BITS] &= ~(((GuWord) 1) << (idx % GU_WORD_BITS));+}++static inline size_t+gu_bits_size(size_t n_bits) {+ return gu_ceildiv(n_bits, GU_WORD_BITS) * sizeof(GuWord);+}++static inline void*+gu_word_ptr(GuWord w)+{+ return (void*) w;+}++static inline GuWord+gu_ptr_word(void* p)+{+ return (GuWord) p;+}++#define GuOpaque() struct { GuWord w_; }++typedef GuWord GuTagged;++#define GU_TAG_MAX (sizeof(GuWord) - 1)++static inline size_t+gu_tagged_tag(GuTagged t) {+ return (int) (t & (sizeof(GuWord) - 1));+}++static inline void*+gu_tagged_ptr(GuTagged w) {+ return (void*) gu_align_backward(w, sizeof(GuWord));+}++static inline GuTagged+gu_tagged(void* ptr, size_t tag) {+ gu_require(tag < sizeof(GuWord));+ uintptr_t u = (uintptr_t) ptr;+ gu_require(gu_align_backward(u, sizeof(GuWord)) == u);+ return (GuWord) { u | tag };+}++#include <gu/exn.h>++#define GU_DECODE_2C_(u_, t_, umax_, posmax_, tmin_, err_) \+ (((u_) <= (posmax_)) \+ ? (t_) (u_) \+ : (tmin_) + ((t_) ((umax_) - (u_))) < 0 \+ ? (t_) (-1 - ((t_) ((umax_) - (u_)))) \+ : (t_) (gu_raise(err_, GuIntDecodeExn), -1))+++static inline int8_t+gu_decode_2c8(uint8_t u, GuExn* err)+{+ return GU_DECODE_2C_(u, int8_t, UINT8_C(0xff), + UINT8_C(0x7f), INT8_MIN, err);+}++static inline int16_t+gu_decode_2c16(uint16_t u, GuExn* err)+{+ return GU_DECODE_2C_(u, int16_t, UINT16_C(0xffff), + UINT16_C(0x7fff), INT16_MIN, err);+}++static inline int32_t+gu_decode_2c32(uint32_t u, GuExn* err)+{+ return GU_DECODE_2C_(u, int32_t, UINT32_C(0xffffffff), + UINT32_C(0x7fffffff), INT32_MIN, err);+}++static inline int64_t+gu_decode_2c64(uint64_t u, GuExn* err)+{+ return GU_DECODE_2C_(u, int64_t, UINT64_C(0xffffffffffffffff), + UINT64_C(0x7fffffffffffffff), INT64_MIN, err);+}++GU_INTERNAL_DECL double+gu_decode_double(uint64_t u);++GU_INTERNAL_DECL uint64_t+gu_encode_double(double d);++#endif // GU_BITS_H_
@@ -0,0 +1,68 @@+#include <gu/choice.h>+#include <gu/seq.h>+#include <gu/assert.h>++struct GuChoice {+ GuBuf* path;+ size_t path_idx;+};++GU_API GuChoice*+gu_new_choice(GuPool* pool)+{+ GuChoice* ch = gu_new(GuChoice, pool);+ ch->path = gu_new_buf(size_t, pool);+ ch->path_idx = 0;+ return ch;+}++GU_API GuChoiceMark+gu_choice_mark(GuChoice* ch)+{+ gu_assert(ch->path_idx <= gu_buf_length(ch->path));+ return (GuChoiceMark){ch->path_idx};+}++GU_API void+gu_choice_reset(GuChoice* ch, GuChoiceMark mark)+{+ gu_assert(ch->path_idx <= gu_buf_length(ch->path));+ gu_require(mark.path_idx <= ch->path_idx );+ ch->path_idx = mark.path_idx;+}++GU_API int+gu_choice_next(GuChoice* ch, int n_choices)+{+ gu_assert(n_choices >= 0);+ gu_assert(ch->path_idx <= gu_buf_length(ch->path));+ if (n_choices == 0) {+ return -1;+ }+ int i = 0;+ if (gu_buf_length(ch->path) > ch->path_idx) {+ i = (int) gu_buf_get(ch->path, size_t, ch->path_idx);+ gu_assert(i <= n_choices);+ } else {+ gu_buf_push(ch->path, size_t, n_choices);+ i = n_choices;+ }+ int ret = (i == 0) ? -1 : n_choices - i;+ ch->path_idx++;+ return ret;+}++GU_API bool+gu_choice_advance(GuChoice* ch)+{+ gu_assert(ch->path_idx <= gu_buf_length(ch->path));+ + while (gu_buf_length(ch->path) > ch->path_idx) {+ size_t last = gu_buf_pop(ch->path, size_t);+ if (last > 1) {+ gu_buf_push(ch->path, size_t, last-1);+ return true;+ }+ }+ return false;+}
@@ -0,0 +1,37 @@+#ifndef GU_CHOICE_H_+#define GU_CHOICE_H_++#include <gu/mem.h>++typedef struct GuChoice GuChoice;++typedef struct GuChoiceMark GuChoiceMark;++GU_API_DECL GuChoice*+gu_new_choice(GuPool* pool);++GU_API_DECL int+gu_choice_next(GuChoice* ch, int n_choices);++GU_API_DECL GuChoiceMark+gu_choice_mark(GuChoice* ch);++GU_API_DECL void+gu_choice_reset(GuChoice* ch, GuChoiceMark mark);++GU_API_DECL bool+gu_choice_advance(GuChoice* ch);+++// private++struct GuChoiceMark {+ size_t path_idx;+};+++++++#endif // GU_CHOICE_H_
@@ -0,0 +1,4 @@+#include <gu/defs.h>++void* const gu_null = NULL;+GU_API GuStruct* const gu_null_struct = NULL;
@@ -0,0 +1,231 @@+/** @file+ *+ * Miscellaneous macros.+ */++#ifndef GU_DEFS_H_+#define GU_DEFS_H_++// MSVC requires explicit export/import of+// symbols in DLLs. CMake takes care of this+// for functions, but not for data/variables.+#if defined(_MSC_VER)+#if defined(COMPILING_GU)+#define GU_API_DECL __declspec(dllexport)+#define GU_API __declspec(dllexport)+#else+#define GU_API_DECL __declspec(dllimport)+#define GU_API ERROR_NOT_COMPILING_LIBGU+#endif++#define GU_INTERNAL_DECL+#define GU_INTERNAL++#define restrict __restrict++#elif defined(__MINGW32__)++#define GU_API_DECL+#define GU_API++#define GU_INTERNAL_DECL+#define GU_INTERNAL++#else++#define GU_API_DECL+#define GU_API++#define GU_INTERNAL_DECL __attribute__ ((visibility ("hidden")))+#define GU_INTERNAL __attribute__ ((visibility ("hidden")))++#endif++// end MSVC workaround++#include <stddef.h>+#include <inttypes.h>+#include <stdbool.h>+#include <assert.h>+#include <limits.h>+#include <stdarg.h>+#include <gu/sysdeps.h>++#define gu_container(mem_p, container_type, member) \+ ((container_type*)(((uint8_t*) (mem_p)) - offsetof(container_type, member)))+/**< Find the address of a containing structure.+ *+ * If @c s has type @c t*, where @c t is a struct or union type with a+ * member @m, then <tt>GU_CONTAINER_P(&s->m, t, m) == s</tt>.+ * + * @param mem_p Pointer to the member of a structure.+ * @param container_type The type of the containing structure.+ * @param member The name of the member of @a container_type+ * @return The address of the containing structure.+ *+ * @hideinitializer */+++#define gu_member_p(struct_p_, offset_) \+ ((void*)&((uint8_t*)(struct_p_))[offset_])++#define gu_member(t_, struct_p_, offset_) \+ (*(t_*)gu_member_p(struct_p_, offset_))++#ifdef GU_ALIGNOF+# define gu_alignof GU_ALIGNOF+#else+# define gu_alignof(t_) \+ ((size_t)(offsetof(struct { char c_; t_ e_; }, e_)))+#endif++#define GU_PLIT(type, expr) \+ ((type[1]){ expr })++#define GU_LVALUE(type, expr) \+ (*((type[1]){ expr }))++#define GU_COMMA ,++#define GU_ARRAY_LEN(t,a) (sizeof((const t[])a) / sizeof(t))++#define GU_ID(...) __VA_ARGS__++// This trick is by Laurent Deniau <laurent.deniau@cern.ch>+#define GU_N_ARGS(...) \+ GU_N_ARGS_(__VA_ARGS__, \+ 31,30,29,28,27,26,25,24, \+ 23,22,21,20,19,18,17,16, \+ 15,14,13,12,11,10,9,8, \+ 7,6,5,4,3,2,1,0) +#define GU_N_ARGS_(...) GU_N_ARGS__(__VA_ARGS__)+#define GU_N_ARGS__(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p, \+ q,r,s,t,u,v,w,x,y,z,aa,ab,ac,ad,ae,N,...) \+ N++#define GU_ARG1(a1, ...) a1+#define GU_ARG2(a1, a2, ...) a2++#define GU_BEGIN do {+#define GU_END } while (false)++#define GU_NOP GU_BEGIN (void) 0; GU_END++/**< @hideinitializer */++//+// Assert+//++#define GU_MAX(a_, b_) ((a_) > (b_) ? (a_) : (b_))+#define GU_MIN(a_, b_) ((a_) < (b_) ? (a_) : (b_))++static inline int+gu_max(int a, int b) {+ return GU_MAX(a, b);+}++static inline int+gu_min(int a, int b) {+ return GU_MIN(a, b);+}++#ifdef GU_ALIGNOF+#define gu_flex_alignof gu_alignof+#else+#define gu_flex_alignof(t) 0+#endif++static inline size_t+gu_flex_size(size_t ssize, size_t offset, int n_elems, size_t e_size)+{+ return GU_MAX(ssize, offset + n_elems * e_size);+}++#define GU_FLEX_SIZE(type, flex_member, n_elems) \+ gu_flex_size(sizeof(type), offsetof(type, flex_member), \+ n_elems, sizeof(((type*)NULL)->flex_member[0]))+++// The following are directly from gmacros.h in GLib++#define GU_PASTE_ARGS(id1_,id2_) \+ id1_ ## id2_++#define GU_PASTE(id1_, id2_) \+ GU_PASTE_ARGS(id1_, id2_)++#define GU_STATIC_ASSERT(expr_) \+ typedef struct { \+ char static_assert[(expr_) ? 1 : -1]; \+ } GU_PASTE(GuStaticAssert_, __LINE__)+++#define GU_ENSURE_TYPE(T, EXPR) \+ ((void)(sizeof(*(T*)NULL=(EXPR))),(EXPR))++#define GU_END_DECLS \+ extern void gu_dummy_(void)++extern void* const gu_null;++// Dummy struct used for generic struct pointers+typedef struct GuStruct GuStruct;++GU_API_DECL extern GuStruct* const gu_null_struct;++typedef uintptr_t GuWord;++#define GU_WORD_MAX UINTPTR_MAX++// TODO: use max_align_t once C1X is supported+typedef union {+ char c;+ short s;+ int i;+ long l;+ long long ll;+ intmax_t im;+ float f;+ double d;+ long double ld;+ void* p;+ void (*fp)();+} GuMaxAlign;++#define gu_alloca(N) \+ (((union { GuMaxAlign align_; uint8_t buf_[N]; }){{0}}).buf_)+++// For Doxygen+#define GU_PRIVATE /** @private */++#ifdef GU_GNUC+# define GU_LIKELY(EXPR) __builtin_expect(EXPR, 1)+# define GU_UNLIKELY(EXPR) __builtin_expect(EXPR, 0)+# define GU_IS_CONSTANT(EXPR) __builtin_constant_p(EXPR)+#else+# define GU_LIKELY(EXPR) (EXPR)+# define GU_UNLIKELY(EXPR) (EXPR)+# ifdef GU_OPTIMIZE_SIZE+# define GU_IS_CONSTANT(EXPR) false+# else+# define GU_IS_CONSTANT(EXPR) true+# endif+#endif++// Splint annotations+#define GU_ONLY GU_SPLINT(only)+#define GU_NULL GU_SPLINT(null)+#define GU_NOTNULL GU_SPLINT(notnull) +#define GU_RETURNED GU_SPLINT(returned)+#define GU_ABSTRACT GU_SPLINT(abstract)+#define GU_IMMUTABLE GU_SPLINT(immutable)+#define GU_NOTREACHED GU_SPLINT(notreached)+#define GU_UNUSED GU_SPLINT(unused) GU_GNUC_ATTR(unused)+#define GU_OUT GU_SPLINT(out)+#define GU_IN GU_SPLINT(in)+#define GU_NORETURN GU_SPLINT(noreturn) GU_GNUC_ATTR(noreturn)+#define GU_MODIFIES(x) GU_SPLINT(modifies x)++#endif // GU_DEFS_H_
@@ -0,0 +1,7 @@+#include <gu/enum.h>++GU_API void+gu_enum_next(GuEnum* en, void* to, GuPool* pool)+{+ en->next(en, to, pool);+}
@@ -0,0 +1,35 @@+#ifndef GU_ENUM_H_+#define GU_ENUM_H_++#include <gu/mem.h>++typedef struct GuEnum GuEnum;++struct GuEnum {+ void (*next)(GuEnum* self, void* to, GuPool* pool);+};++GU_API_DECL void+gu_enum_next(GuEnum* en, void* to, GuPool* pool);++#ifdef GU_GNUC++#define gu_next(ENUM, T, POOL) \+ ({ \+ T gu_next_tmp_; \+ gu_enum_next((ENUM), &gu_next_tmp_, (POOL)); \+ gu_next_tmp_; \+ })+#else+static inline void*+gu_enum_next_(GuEnum* en, void* to, GuPool* pool)+{+ gu_enum_next(en, to, pool);+ return to;+}+#define gu_next(ENUM, T, POOL) \+ (*(T*)gu_enum_next_((ENUM), &(T){0}, (POOL)))++#endif++#endif /* GU_ENUM_H_ */
@@ -0,0 +1,78 @@+#include <gu/exn.h>+#include <gu/assert.h>+++GU_API GuExn*+gu_new_exn(GuPool* pool)+{+ GuExn* exn = gu_new(GuExn, pool);+ exn->state = GU_EXN_OK;+ exn->caught = NULL;+ exn->data.pool = pool;+ exn->data.data = NULL;+ return exn;+}++GU_API bool+gu_exn_is_raised(GuExn* err) {+ return err && (err->state == GU_EXN_RAISED);+}++GU_API bool+gu_exn_caught_(GuExn* err, const char* type)+{+ return (err->caught && strcmp(err->caught, type) == 0);+}++GU_API void+gu_exn_block(GuExn* err)+{+ if (err && err->state == GU_EXN_RAISED) {+ err->state = GU_EXN_BLOCKED;+ }+}++GU_API void+gu_exn_unblock(GuExn* err)+{+ if (err && err->state == GU_EXN_BLOCKED) {+ err->state = GU_EXN_RAISED;+ }+}++GU_API GuExnData*+gu_exn_raise_debug_(GuExn* err, const char* type, + const char* filename, const char* func, int lineno)+{+ gu_require(type);++ GuExnState old_state = err->state;+ err->state = GU_EXN_RAISED;+ if (old_state == GU_EXN_OK) {+ err->caught = type;+ if (err->data.pool) {+ return &err->data;+ }+ }++ // Exceptian had already been raised, possibly blocked, or no+ // exception value is required.+ return NULL;+}++GU_API GuExnData*+gu_exn_raise_(GuExn* base, const char* type)+{+ return gu_exn_raise_debug_(base, type, NULL, NULL, -1);+}++GU_API void+gu_raise_errno(GuExn* err)+{+ GuExnData* err_data = gu_raise(err, GuErrno);+ if (err_data) {+ GuErrno* gu_errno = gu_new(GuErrno, err_data->pool);+ *gu_errno = errno;+ err_data->data = gu_errno;+ }+}
@@ -0,0 +1,171 @@+#ifndef GU_EXN_H_+#define GU_EXN_H_++#include <gu/mem.h>++/** @file+ *+ * @defgroup GuExn Exceptions+ * Defined in <gu/exn.h>.+ * @{+ */++/// An exception frame.+typedef struct GuExn GuExn;++/// @private+typedef enum {+ GU_EXN_RAISED,+ GU_EXN_OK,+ GU_EXN_BLOCKED+} GuExnState;++typedef struct GuExnData GuExnData;++/// A structure for storing exception values.+struct GuExnData+/**+ * When an exception is raised, if there is an associated value, it+ * must be allocated from a pool that still exists when control+ * returns to the handler of that exception. This structure is used to+ * communicate the exception from the raiser to the handler: the+ * handler sets #pool when setting up the exception frame, and the+ * raiser uses that pool to allocate the value and stores that in+ * #data. When control returns to the handler, it reads the value from+ * there.+ */+{+ + /// The pool that the exception value should be allocated from.+ GuPool* pool;++ /// The exception value.+ void* data;+};++struct GuExn {+ /// @privatesection+ GuExnState state;+ const char* caught;+ GuExnData data;+};+++/// @name Creating exception frames+//@{+++/// Allocate a new local exception frame.+#define gu_exn(pool_) &(GuExn){ \+ .state = GU_EXN_OK, \+ .caught = NULL, \+ .data = {.pool = pool_, .data = NULL} \+}+++/// Allocate a new exception frame.+GU_API_DECL GuExn*+gu_new_exn(GuPool* pool);+++GU_API_DECL bool+gu_exn_is_raised(GuExn* err);++static inline void+gu_exn_clear(GuExn* err) {+ err->caught = NULL;+ err->state = GU_EXN_OK;+}++#define gu_exn_caught(err, type) \+ (err->caught && strcmp(err->caught, #type) == 0)+ +GU_API_DECL bool+gu_exn_caught_(GuExn* err, const char* type);++static inline const void*+gu_exn_caught_data(GuExn* err)+{+ return err->data.data;+}++/// Temporarily block a raised exception.+GU_API_DECL void+gu_exn_block(GuExn* err);++/// Show again a blocked exception.+GU_API_DECL void+gu_exn_unblock(GuExn* err);++//@private+GU_API_DECL GuExnData*+gu_exn_raise_(GuExn* err, const char* type);++//@private+GU_API_DECL GuExnData*+gu_exn_raise_debug_(GuExn* err, const char* type,+ const char* filename, const char* func, int lineno);++#ifdef NDEBUG+#define gu_exn_raise(err_, type_) \+ gu_exn_raise_(err_, type_)+#else+#define gu_exn_raise(err_, type_) \+ gu_exn_raise_debug_(err_, type_, \+ __FILE__, __func__, __LINE__)+#endif++/// Raise an exception.+#define gu_raise(exn, T) \+ gu_exn_raise(exn, #T)+/**< + * @param exn The current exception frame.+ *+ * @param T The C type of the exception to raise.+ *+ * @return A #GuExnData object that can be used to store the exception value, or+ * \c NULL if no value is required.+ * + * @note The associated #GuType object for type \p T must be visible.+ */++#define gu_raise_new(error_, t_, pool_, expr_) \+ GU_BEGIN \+ GuExnData* gu_raise_err_ = gu_raise(error_, t_); \+ if (gu_raise_err_) { \+ GuPool* pool_ = gu_raise_err_->pool; \+ gu_raise_err_->data = expr_; \+ } \+ GU_END++/// Check the status of the current exception frame+static inline bool+gu_ok(GuExn* exn) {+ return !GU_UNLIKELY(gu_exn_is_raised(exn));+}+/**<+ * @return \c false if an exception has been raised in the frame \p exn+ * and it has not been blocked, \c true otherwise.+ */+++/// Return from current function if an exception has been raised.+#define gu_return_on_exn(exn_, retval_) \+ GU_BEGIN \+ if (gu_exn_is_raised(exn_)) return retval_; \+ GU_END+/**<+ * @showinitializer+ */+++#include <errno.h>++typedef int GuErrno;++GU_API_DECL void+gu_raise_errno(GuExn* err);++/** @} */++#endif // GU_EXN_H_
@@ -0,0 +1,77 @@+#include <gu/file.h>++typedef struct GuFileOutStream GuFileOutStream;++struct GuFileOutStream {+ GuOutStream stream;+ FILE* file;+};++static size_t+gu_file_output(GuOutStream* stream, const uint8_t* buf, size_t len, GuExn* err)+{+ GuFileOutStream* fos = gu_container(stream, GuFileOutStream, stream);+ errno = 0;+ size_t wrote = fwrite(buf, 1, len, fos->file);+ if (wrote < len) {+ if (ferror(fos->file)) {+ gu_raise_errno(err);+ }+ }+ return wrote;+}++static void+gu_file_flush(GuOutStream* stream, GuExn* err)+{+ GuFileOutStream* fos = gu_container(stream, GuFileOutStream, stream);+ errno = 0;+ if (fflush(fos->file) != 0) {+ gu_raise_errno(err);+ }+}++GU_API GuOut*+gu_file_out(FILE* file, GuPool* pool)+{+ GuFileOutStream* fos = gu_new(GuFileOutStream, pool);+ fos->stream.begin_buf = NULL;+ fos->stream.end_buf = NULL;+ fos->stream.output = gu_file_output;+ fos->stream.flush = gu_file_flush;+ fos->file = file;+ return gu_new_out(&fos->stream, pool);+}+++typedef struct GuFileInStream GuFileInStream;++struct GuFileInStream {+ GuInStream stream;+ FILE* file;+};++static size_t +gu_file_input(GuInStream* stream, uint8_t* buf, size_t sz, GuExn* err)+{+ GuFileInStream* fis = gu_container(stream, GuFileInStream, stream);+ errno = 0;+ size_t got = fread(buf, 1, sz, fis->file);+ if (got == 0) {+ if (ferror(fis->file)) {+ gu_raise_errno(err);+ }+ }+ return got;+}++GU_API GuIn*+gu_file_in(FILE* file, GuPool* pool)+{+ GuFileInStream* fis = gu_new(GuFileInStream, pool);+ fis->stream.begin_buffer = NULL;+ fis->stream.end_buffer = NULL;+ fis->stream.input = gu_file_input;+ fis->file = file;+ return gu_new_in(&fis->stream, pool);+}
@@ -0,0 +1,14 @@+#ifndef GU_FILE_H_+#define GU_FILE_H_++#include <gu/in.h>+#include <gu/out.h>+#include <stdio.h>++GU_API_DECL GuOut*+gu_file_out(FILE* file, GuPool* pool);++GU_API_DECL GuIn* +gu_file_in(FILE* file, GuPool* pool);++#endif // GU_FILE_H_
@@ -0,0 +1,1 @@+#include <gu/fun.h>
@@ -0,0 +1,71 @@+#ifndef GU_FUN_H_+#define GU_FUN_H_++#include <gu/defs.h>++typedef void (*GuFn)();+typedef void (*GuFn0)(GuFn* clo);+typedef void (*GuFn1)(GuFn* clo, void* arg1);+typedef void (*GuFn2)(GuFn* clo, void* arg1, void* arg2);++#define gu_fn(fn_) (&(GuFn){ fn_ })++static inline void+gu_apply0(GuFn* fn) {+ (*fn)(fn);+}++static inline void+gu_apply1(GuFn* fn, void* arg1) {+ (*fn)(fn, arg1);+}++static inline void+gu_apply2(GuFn* fn, void* arg1, void* arg2) {+ (*fn)(fn, arg1, arg2);+}++#define gu_apply(fn_, ...) \+ ((fn_)->fn((fn_), __VA_ARGS__))++typedef struct GuClo0 GuClo0;++struct GuClo0 {+ GuFn fn;+};++typedef struct GuClo1 GuClo1;++struct GuClo1 {+ GuFn fn;+ void *env1;+};++typedef struct GuClo2 GuClo2;+struct GuClo2 {+ GuFn fn;+ void *env1;+ void *env2;+};++typedef struct GuClo3 GuClo3;+struct GuClo3 {+ GuFn fn;+ void *env1;+ void *env2;+ void *env3;+};++typedef const struct GuEquality GuEquality;++struct GuEquality {+ bool (*is_equal)(GuEquality* self, const void* a, const void* b);+};++typedef const struct GuOrder GuOrder;++struct GuOrder {+ int (*compare)(GuOrder* self, const void* a, const void* b);+};++#endif // GU_FUN_H_
@@ -0,0 +1,77 @@+#include <gu/hash.h>++GU_API GuHash+gu_hash_bytes(GuHash h, const uint8_t* buf, size_t len)+{+ for (size_t n = 0; n < len; n++) {+ h = gu_hash_byte(h, buf[n]);+ }+ return h;+}++static bool+gu_int_eq_fn(GuEquality* self, const void* p1, const void* p2)+{+ (void) self;+ const int* ip1 = p1;+ const int* ip2 = p2;+ return *ip1 == *ip2;+}++static GuHash+gu_int_hash_fn(GuHasher* self, const void* p)+{+ (void) self;+ return (GuHash) *(const int*) p;+}++GU_API GuHasher gu_int_hasher[1] = {+ {+ { gu_int_eq_fn },+ gu_int_hash_fn+ }+};++static bool+gu_addr_eq_fn(GuEquality* self, const void* p1, const void* p2)+{+ (void) self;+ return (p1 == p2);+}++static GuHash+gu_addr_hash_fn(GuHasher* self, const void* p)+{+ (void) self;+ return (GuHash) (uintptr_t) p;+}++GU_API GuHasher gu_addr_hasher[1] = {+ {+ { gu_addr_eq_fn },+ gu_addr_hash_fn+ }+};++static bool+gu_word_eq_fn(GuEquality* self, const void* p1, const void* p2)+{+ (void) self;+ const GuWord* wp1 = p1;+ const GuWord* wp2 = p2;+ return (*wp1 == *wp2);+}++static GuHash+gu_word_hash_fn(GuHasher* self, const void* p)+{+ (void) self;+ return (GuHash) (uintptr_t) p;+}++GU_API GuHasher gu_word_hasher[1] = {+ {+ { gu_word_eq_fn },+ gu_word_hash_fn+ }+};
@@ -0,0 +1,40 @@+#ifndef GU_HASH_H_+#define GU_HASH_H_++#include <gu/fun.h>++typedef GuWord GuHash;++static inline GuHash+gu_hash_ptr(void* ptr)+{+ return (GuHash) ptr;+}+++static inline GuHash+gu_hash_byte(GuHash h, uint8_t u)+{+ // Paul Larson's simple byte hash+ return h * 101 + u;+}+++GU_API_DECL GuHash+gu_hash_bytes(GuHash h, const uint8_t* buf, size_t len);++typedef const struct GuHasher GuHasher;++struct GuHasher {+ GuEquality eq;+ GuHash (*hash)(GuHasher* self, const void* p);+};+++GU_API_DECL extern GuHasher gu_int_hasher[1];++GU_API_DECL extern GuHasher gu_addr_hasher[1];++GU_API_DECL extern GuHasher gu_word_hasher[1];++#endif // GU_HASH_H_
@@ -0,0 +1,378 @@+#include <gu/in.h>+#include <gu/bits.h>+#include <math.h>+++static bool+gu_in_is_buffering(GuIn* in)+{+ return (in->buf_end != NULL);+}++static void+gu_in_end_buffering(GuIn* in, GuExn* err)+{+ if (!gu_in_is_buffering(in)) {+ return;+ }+ if (in->stream->end_buffer) {+ size_t len = ((ptrdiff_t) in->buf_size) + in->buf_curr;+ in->stream->end_buffer(in->stream, len, err);+ }+ in->buf_curr = 0;+ in->buf_size = 0;+ in->buf_end = NULL;+}++static bool+gu_in_begin_buffering(GuIn* in, GuExn* err)+{+ if (gu_in_is_buffering(in)) {+ if (in->buf_curr < 0) {+ return true;+ } else {+ gu_in_end_buffering(in, err);+ if (!gu_ok(err)) return false;+ }+ }+ if (!in->stream->begin_buffer) {+ return false;+ }+ size_t sz = 0;+ const uint8_t* new_buf = + in->stream->begin_buffer(in->stream, &sz, err);+ if (new_buf) {+ in->buf_end = &new_buf[sz];+ in->buf_curr = -(ptrdiff_t) sz;+ in->buf_size = sz;+ return true;+ }+ return false;+}++static size_t+gu_in_input(GuIn* in, uint8_t* dst, size_t sz, GuExn* err)+{+ if (sz == 0) {+ return 0;+ }+ gu_in_end_buffering(in, err);+ if (!gu_ok(err)) {+ return 0;+ }+ GuInStream* stream = in->stream;+ if (stream->input) {+ return stream->input(stream, dst, sz, err);+ }+ gu_raise(err, GuEOF);+ return 0;+}++GU_API size_t+gu_in_some(GuIn* in, uint8_t* dst, size_t sz, GuExn* err)+{+ gu_require(sz <= PTRDIFF_MAX);+ if (!gu_in_begin_buffering(in, err)) {+ if (!gu_ok(err)) return 0; + return gu_in_input(in, dst, sz, err);+ }+ size_t real_sz = GU_MIN(sz, (size_t)(-in->buf_curr));+ memcpy(dst, &in->buf_end[in->buf_curr], real_sz);+ in->buf_curr += real_sz;+ return real_sz;+}++GU_API void+gu_in_bytes_(GuIn* in, uint8_t* dst, size_t sz, GuExn* err)+{+ for (;;) {+ size_t avail_sz = GU_MIN(sz, (size_t)(-in->buf_curr));+ memcpy(dst, &in->buf_end[in->buf_curr], avail_sz);+ in->buf_curr += avail_sz;+ dst += avail_sz;+ sz -= avail_sz;++ if (sz == 0)+ break;++ if (!gu_in_begin_buffering(in, err)) {+ gu_in_input(in, dst, sz, err);+ return;+ }+ }+}++GU_API const uint8_t*+gu_in_begin_span(GuIn* in, size_t *sz_out, GuExn* err)+{+ if (!gu_in_begin_buffering(in, err)) {+ return NULL;+ }+ *sz_out = (size_t) -in->buf_curr;+ return &in->buf_end[in->buf_curr];+}++GU_API void+gu_in_end_span(GuIn* in, size_t consumed)+{+ gu_require(consumed <= (size_t) -in->buf_curr);+ in->buf_curr += (ptrdiff_t) consumed;+}++GU_API uint8_t +gu_in_u8_(GuIn* in, GuExn* err)+{+ if (gu_in_begin_buffering(in, err) && in->buf_curr < 0) {+ return in->buf_end[in->buf_curr++];+ }+ uint8_t u = 0;+ size_t r = gu_in_input(in, &u, 1, err);+ if (r < 1) {+ gu_raise(err, GuEOF);+ return 0;+ }+ return u;+}++static uint64_t+gu_in_be(GuIn* in, GuExn* err, int n)+{+ uint8_t buf[8];+ gu_in_bytes(in, buf, n, err);+ uint64_t u = 0;+ for (int i = 0; i < n; i++) {+ u = u << 8 | buf[i];+ }+ return u;+}++static uint64_t+gu_in_le(GuIn* in, GuExn* err, int n)+{+ uint8_t buf[8];+ gu_in_bytes(in, buf, n, err);+ uint64_t u = 0;+ for (int i = n-1; i >= 0; i--) {+ u = u << 8 | buf[i];+ }+ return u;+}++GU_API int8_t +gu_in_s8(GuIn* in, GuExn* err)+{+ return gu_decode_2c8(gu_in_u8(in, err), err);+}+++GU_API uint16_t+gu_in_u16le(GuIn* in, GuExn* err)+{+ return gu_in_le(in, err, 2);+}++GU_API int16_t +gu_in_s16le(GuIn* in, GuExn* err)+{+ return gu_decode_2c16(gu_in_u16le(in, err), err);+}++GU_API uint16_t+gu_in_u16be(GuIn* in, GuExn* err)+{+ return gu_in_be(in, err, 2);+}++GU_API int16_t +gu_in_s16be(GuIn* in, GuExn* err)+{+ return gu_decode_2c16(gu_in_u16be(in, err), err);+}++GU_API uint32_t+gu_in_u32le(GuIn* in, GuExn* err)+{+ return gu_in_le(in, err, 4);+}++GU_API int32_t +gu_in_s32le(GuIn* in, GuExn* err)+{+ return gu_decode_2c32(gu_in_u32le(in, err), err);+}++GU_API uint32_t+gu_in_u32be(GuIn* in, GuExn* err)+{+ return gu_in_be(in, err, 4);+}++GU_API int32_t +gu_in_s32be(GuIn* in, GuExn* err)+{+ return gu_decode_2c32(gu_in_u32be(in, err), err);+}++GU_API uint64_t+gu_in_u64le(GuIn* in, GuExn* err)+{+ return gu_in_le(in, err, 8);+}++GU_API int64_t +gu_in_s64le(GuIn* in, GuExn* err)+{+ return gu_decode_2c64(gu_in_u64le(in, err), err);+}++GU_API uint64_t+gu_in_u64be(GuIn* in, GuExn* err)+{+ return gu_in_be(in, err, 8);+}++GU_API int64_t +gu_in_s64be(GuIn* in, GuExn* err)+{+ return gu_decode_2c64(gu_in_u64be(in, err), err);+}++GU_API double+gu_in_f64le(GuIn* in, GuExn* err)+{+ return gu_decode_double(gu_in_u64le(in, err));+}++GU_API double+gu_in_f64be(GuIn* in, GuExn* err)+{+ return gu_decode_double(gu_in_u64be(in, err));+}++static void+gu_in_fini(GuFinalizer* fin)+{+ GuIn* in = gu_container(fin, GuIn, fini);+ GuPool* pool = gu_local_pool();+ GuExn* err = gu_exn(pool);+ gu_in_end_buffering(in, err);+ gu_pool_free(pool);+}++GU_API GuIn*+gu_new_in(GuInStream* stream, GuPool* pool)+{+ gu_require(stream != NULL);++ GuIn* in = gu_new(GuIn, pool);+ in->buf_end = NULL;+ in->buf_curr = 0;+ in->buf_size = 0;+ in->stream = stream;+ in->fini.fn = gu_in_fini;+ return in;+}++typedef struct GuBufferedInStream GuBufferedInStream;++struct GuBufferedInStream {+ GuInStream stream;+ size_t alloc;+ size_t have;+ size_t curr;+ GuIn* in;+ uint8_t buf[];+};++static const uint8_t*+gu_buffered_in_begin_buffer(GuInStream* self, size_t* sz_out, GuExn* err)+{+ GuBufferedInStream* bis = + gu_container(self, GuBufferedInStream, stream);+ if (bis->curr == bis->have) {+ bis->curr = 0;+ bis->have = gu_in_some(bis->in, bis->buf, bis->alloc, err);+ if (!gu_ok(err)) return NULL;+ }+ *sz_out = bis->have - bis->curr;+ return &bis->buf[bis->curr];+}++static void+gu_buffered_in_end_buffer(GuInStream* self, size_t consumed, GuExn* err)+{+ GuBufferedInStream* bis = + gu_container(self, GuBufferedInStream, stream);+ gu_require(consumed < bis->have - bis->curr);+ bis->curr += consumed;+}++static size_t+gu_buffered_in_input(GuInStream* self, uint8_t* dst, size_t sz, GuExn* err)+{+ GuBufferedInStream* bis = + gu_container(self, GuBufferedInStream, stream);+ return gu_in_some(bis->in, dst, sz, err);+}++GU_API GuIn*+gu_buffered_in(GuIn* in, size_t buf_sz, GuPool* pool)+{+ GuBufferedInStream* bis = gu_new_flex(pool, GuBufferedInStream,+ buf, buf_sz);+ bis->stream = (GuInStream) {+ .begin_buffer = gu_buffered_in_begin_buffer,+ .end_buffer = gu_buffered_in_end_buffer,+ .input = gu_buffered_in_input+ };+ bis->alloc = buf_sz;+ bis->have = bis->curr = 0;+ bis->in = in;+ return gu_new_in(&bis->stream, pool);+}++typedef struct GuDataIn GuDataIn;++struct GuDataIn {+ GuInStream stream; + const uint8_t* data;+ size_t sz;+};++static const uint8_t*+gu_data_in_begin_buffer(GuInStream* self, size_t* sz_out, GuExn* err)+{+ (void) err;+ GuDataIn* di = gu_container(self, GuDataIn, stream);+ const uint8_t* buf = di->data;+ if (buf) {+ *sz_out = di->sz;+ di->data = NULL;+ di->sz = 0;+ }+ return buf;+}++GU_API GuIn*+gu_data_in(const uint8_t* data, size_t sz, GuPool* pool)+{+ GuDataIn* di = gu_new(GuDataIn, pool);+ di->stream.begin_buffer = gu_data_in_begin_buffer;+ di->stream.end_buffer = NULL;+ di->stream.input = NULL;+ di->data = data;+ di->sz = sz;+ return gu_new_in(&di->stream, pool);+}++extern inline uint8_t +gu_in_u8(GuIn* restrict in, GuExn* err);++extern inline void+gu_in_bytes(GuIn* in, uint8_t* buf, size_t sz, GuExn* err);++extern inline int+gu_in_peek_u8(GuIn* restrict in);++extern inline void+gu_in_consume(GuIn* restrict in, size_t sz);
@@ -0,0 +1,134 @@+#ifndef GU_IN_H_+#define GU_IN_H_++#include <gu/defs.h>+#include <gu/exn.h>+#include <gu/assert.h>++typedef struct GuInStream GuInStream;++struct GuInStream {+ const uint8_t* (*begin_buffer)(GuInStream* self, size_t* sz_out, + GuExn* err);+ void (*end_buffer)(GuInStream* self, size_t consumed, GuExn* err);+ size_t (*input)(GuInStream* self, uint8_t* buf, size_t max_sz, + GuExn* err);+};++typedef struct GuIn GuIn;++struct GuIn {+ const uint8_t* restrict buf_end;+ ptrdiff_t buf_curr;+ size_t buf_size;+ GuInStream* stream;+ GuFinalizer fini;+};++GU_API_DECL GuIn*+gu_new_in(GuInStream* stream, GuPool* pool);++GU_API_DECL const uint8_t*+gu_in_begin_span(GuIn* in, size_t *sz_out, GuExn* err);++GU_API_DECL void+gu_in_end_span(GuIn* in, size_t consumed);++GU_API_DECL size_t+gu_in_some(GuIn* in, uint8_t* buf, size_t max_len, GuExn* err);++inline void+gu_in_bytes(GuIn* in, uint8_t* buf, size_t sz, GuExn* err)+{+ gu_require(sz < PTRDIFF_MAX);+ ptrdiff_t curr = in->buf_curr;+ ptrdiff_t new_curr = curr + (ptrdiff_t) sz;+ if (GU_UNLIKELY(new_curr > 0)) {+ GU_API_DECL void gu_in_bytes_(GuIn* in, uint8_t* buf, size_t sz, + GuExn* err);+ gu_in_bytes_(in, buf, sz, err);+ return;+ }+ memcpy(buf, &in->buf_end[curr], sz);+ in->buf_curr = new_curr;+}++inline int+gu_in_peek_u8(GuIn* restrict in)+{+ if (GU_UNLIKELY(in->buf_curr == 0)) {+ return -1;+ }+ return in->buf_end[in->buf_curr];+}++inline void+gu_in_consume(GuIn* restrict in, size_t sz)+{+ gu_require((ptrdiff_t) sz + in->buf_curr <= 0);+ in->buf_curr += sz;+}++inline uint8_t +gu_in_u8(GuIn* restrict in, GuExn* err)+{+ if (GU_UNLIKELY(in->buf_curr == 0)) {+ GU_API_DECL uint8_t gu_in_u8_(GuIn* restrict in, GuExn* err);+ return gu_in_u8_(in, err);+ }+ return in->buf_end[in->buf_curr++];+}++GU_API_DECL int8_t +gu_in_s8(GuIn* in, GuExn* err);++GU_API_DECL uint16_t+gu_in_u16le(GuIn* in, GuExn* err);++GU_API_DECL uint16_t+gu_in_u16be(GuIn* in, GuExn* err);++GU_API_DECL int16_t+gu_in_s16le(GuIn* in, GuExn* err);++GU_API_DECL int16_t+gu_in_s16be(GuIn* in, GuExn* err);++GU_API_DECL uint32_t+gu_in_u32le(GuIn* in, GuExn* err);++GU_API_DECL uint32_t+gu_in_u32be(GuIn* in, GuExn* err);++GU_API_DECL int32_t+gu_in_s32le(GuIn* in, GuExn* err);++GU_API_DECL int32_t+gu_in_s32be(GuIn* in, GuExn* err);++GU_API_DECL uint64_t+gu_in_u64le(GuIn* in, GuExn* err);++GU_API_DECL uint64_t+gu_in_u64be(GuIn* in, GuExn* err);++GU_API_DECL int64_t+gu_in_s64le(GuIn* in, GuExn* err);++GU_API_DECL int64_t+gu_in_s64be(GuIn* in, GuExn* err);++GU_API_DECL double+gu_in_f64le(GuIn* in, GuExn* err);++GU_API_DECL double+gu_in_f64be(GuIn* in, GuExn* err);++GU_API_DECL GuIn*+gu_buffered_in(GuIn* in, size_t sz, GuPool* pool);++GU_API_DECL GuIn*+gu_data_in(const uint8_t* buf, size_t size, GuPool* pool);+++#endif // GU_IN_H_
@@ -0,0 +1,393 @@+#include <gu/defs.h>+#include <gu/mem.h>+#include <gu/map.h>+#include <gu/assert.h>+#include <gu/prime.h>+#include <gu/string.h>++typedef struct GuMapData GuMapData;++struct GuMapData {+ uint8_t* keys;+ uint8_t* values;+ size_t n_occupied;+ size_t n_entries;+ size_t zero_idx;+};++struct GuMap {+ GuHasher* hasher;+ size_t key_size;+ size_t value_size;+ const void* default_value;+ GuMapData data;+ + GuFinalizer fin;+};++static void+gu_map_finalize(GuFinalizer* fin)+{+ GuMap* map = gu_container(fin, GuMap, fin);+ gu_mem_buf_free(map->data.keys);+ if (map->value_size) {+ gu_mem_buf_free(map->data.values);+ }+}++static const GuWord gu_map_empty_key = 0;++static bool+gu_map_buf_is_zero(const uint8_t* p, size_t sz) {+ while (sz >= sizeof(GuWord)) {+ sz -= sizeof(GuWord);+ if (memcmp(&p[sz], &gu_map_empty_key, sizeof(GuWord)) != 0) {+ return false;+ }+ }+ return (memcmp(p, &gu_map_empty_key, sz) == 0);+}++static bool+gu_map_entry_is_free(GuMap* map, GuMapData* data, size_t idx)+{+ if (idx == data->zero_idx) {+ return false;+ } else if (map->hasher == gu_addr_hasher) {+ const void* key = ((const void**)data->keys)[idx];+ return key == NULL;+ } else if (map->hasher == gu_word_hasher) {+ GuWord key = ((GuWord*)data->keys)[idx];+ return key == 0;+ } else if (map->hasher == gu_string_hasher) {+ GuString key = ((GuString*)data->keys)[idx];+ return key == NULL;+ }+ const void* key = &data->keys[idx * map->key_size];+ return gu_map_buf_is_zero(key, map->key_size);+}++static bool+gu_map_lookup(GuMap* map, const void* key, size_t* idx_out)+{+ size_t n = map->data.n_entries;+ if (map->hasher == gu_addr_hasher) {+ GuHash hash = (GuHash) key;+ size_t idx = hash % n;+ size_t offset = (hash % (n - 2)) + 1;+ while (true) {+ const void* entry_key =+ ((const void**)map->data.keys)[idx];+ if (entry_key == NULL && map->data.zero_idx != idx) {+ *idx_out = idx;+ return false;+ } else if (entry_key == key) {+ *idx_out = idx;+ return true;+ }+ idx = (idx + offset) % n;+ }+ } else if (map->hasher == gu_word_hasher) {+ GuWord w = *(const GuWord*)key;+ GuHash hash = (GuHash) w;+ size_t idx = hash % n;+ size_t offset = (hash % (n - 2)) + 1;+ while (true) {+ GuWord entry_key = ((GuWord*)map->data.keys)[idx];+ if (entry_key == 0 && map->data.zero_idx != idx) {+ *idx_out = idx;+ return false;+ } else if (entry_key == w) {+ *idx_out = idx;+ return true;+ }+ idx = (idx + offset) % n;+ }+ } else if (map->hasher == gu_string_hasher) {+ GuHasher* hasher = map->hasher;+ GuEquality* eq = (GuEquality*) hasher;+ GuHash hash = hasher->hash(hasher, key);+ size_t idx = hash % n;+ size_t offset = (hash % (n - 2)) + 1;+ while (true) {+ GuString entry_key =+ ((GuString*)map->data.keys)[idx];+ if (entry_key == NULL && map->data.zero_idx != idx) {+ *idx_out = idx;+ return false;+ } else if (eq->is_equal(eq, key, entry_key)) {+ *idx_out = idx;+ return true;+ }+ idx = (idx + offset) % n;+ }+ } else {+ GuHasher* hasher = map->hasher;+ GuEquality* eq = (GuEquality*) hasher;+ GuHash hash = hasher->hash(hasher, key);+ size_t idx = hash % n;+ size_t offset = (hash % (n - 2)) + 1;+ size_t key_size = map->key_size;+ while (true) {+ void* entry_key = &map->data.keys[idx * key_size];+ if (gu_map_buf_is_zero(entry_key, key_size) &&+ map->data.zero_idx != idx) {+ *idx_out = idx;+ return false;+ } else if (eq->is_equal(eq, key, entry_key)) {+ *idx_out = idx;+ return true;+ }+ idx = (idx + offset) % n;+ }+ }++ gu_impossible();+ return false;+}+ ++static void+gu_map_resize(GuMap* map, size_t req_entries)+{+ GuMapData* data = &map->data;+ GuMapData old_data = *data;++ size_t key_size = map->key_size;+ size_t key_alloc = 0;+ data->keys = gu_mem_buf_alloc(req_entries * key_size, &key_alloc);++ size_t value_size = map->value_size;+ size_t value_alloc = 0;+ if (value_size) {+ data->values = gu_mem_buf_alloc(req_entries * value_size,+ &value_alloc);+ memset(data->values, 0, value_alloc);+ }+ + data->n_entries = gu_twin_prime_inf(value_size ?+ GU_MIN(key_alloc / key_size,+ value_alloc / value_size)+ : key_alloc / key_size);+ if (map->hasher == gu_addr_hasher) {+ for (size_t i = 0; i < data->n_entries; i++) {+ ((const void**)data->keys)[i] = NULL;+ }+ } else if (map->hasher == gu_string_hasher) {+ for (size_t i = 0; i < data->n_entries; i++) {+ ((GuString*)data->keys)[i] = NULL;+ }+ } else {+ memset(data->keys, 0, key_alloc);+ }++ gu_assert(data->n_entries > data->n_occupied);+ + data->n_occupied = 0;+ data->zero_idx = SIZE_MAX;++ for (size_t i = 0; i < old_data.n_entries; i++) {+ if (gu_map_entry_is_free(map, &old_data, i)) {+ continue;+ }+ void* old_key = &old_data.keys[i * key_size];+ if (map->hasher == gu_addr_hasher) {+ old_key = *(void**)old_key;+ } else if (map->hasher == gu_string_hasher) {+ old_key = (void*) *(GuString*)old_key;+ }+ void* old_value = &old_data.values[i * value_size];++ memcpy(gu_map_insert(map, old_key),+ old_value, map->value_size);+ }++ gu_mem_buf_free(old_data.keys);+ if (value_size) {+ gu_mem_buf_free(old_data.values);+ }+}+++static bool+gu_map_maybe_resize(GuMap* map)+{+ if (map->data.n_entries <=+ map->data.n_occupied + (map->data.n_occupied / 4)) {+ size_t req_entries =+ gu_twin_prime_sup(GU_MAX(11, map->data.n_occupied * 4 / 3 + 1));+ gu_map_resize(map, req_entries);+ return true;+ }+ return false;+}++GU_API void*+gu_map_find(GuMap* map, const void* key)+{+ size_t idx;+ bool found = gu_map_lookup(map, key, &idx);+ if (found) {+ return &map->data.values[idx * map->value_size];+ }+ return NULL;+}++GU_API const void*+gu_map_find_default(GuMap* map, const void* key)+{+ void* p = gu_map_find(map, key);+ return p ? p : map->default_value;+}++GU_API const void*+gu_map_find_key(GuMap* map, const void* key)+{+ size_t idx;+ bool found = gu_map_lookup(map, key, &idx);+ if (found) {+ return &map->data.keys[idx * map->key_size];+ }+ return NULL;+}++GU_API bool+gu_map_has(GuMap* ht, const void* key)+{+ size_t idx;+ return gu_map_lookup(ht, key, &idx);+}++GU_API void*+gu_map_insert(GuMap* map, const void* key)+{+ size_t idx;+ bool found = gu_map_lookup(map, key, &idx);+ if (!found) {+ if (gu_map_maybe_resize(map)) {+ found = gu_map_lookup(map, key, &idx);+ gu_assert(!found);+ }+ if (map->hasher == gu_addr_hasher) {+ ((const void**)map->data.keys)[idx] = key;+ } else if (map->hasher == gu_string_hasher) {+ ((GuString*)map->data.keys)[idx] = key;+ } else {+ memcpy(&map->data.keys[idx * map->key_size],+ key, map->key_size);+ }+ if (map->default_value) {+ memcpy(&map->data.values[idx * map->value_size],+ map->default_value, map->value_size);+ }+ if (gu_map_entry_is_free(map, &map->data, idx)) {+ gu_assert(map->data.zero_idx == SIZE_MAX);+ map->data.zero_idx = idx;+ }+ map->data.n_occupied++;+ }+ return &map->data.values[idx * map->value_size];+}++GU_API void+gu_map_iter(GuMap* map, GuMapItor* itor, GuExn* err)+{+ for (size_t i = 0; i < map->data.n_entries && gu_ok(err); i++) {+ if (gu_map_entry_is_free(map, &map->data, i)) {+ continue;+ }+ const void* key = &map->data.keys[i * map->key_size];+ void* value = &map->data.values[i * map->value_size];+ if (map->hasher == gu_addr_hasher) {+ key = *(const void* const*) key;+ } else if (map->hasher == gu_string_hasher) {+ key = *(GuString*) key;+ }+ itor->fn(itor, key, value, err);+ }+}++typedef struct {+ GuEnum en;+ GuMap* ht;+ size_t i;+ GuMapKeyValue x;+} GuMapEnum;++static void+gu_map_enum_next(GuEnum* self, void* to, GuPool* pool)+{+ *((GuMapKeyValue**) to) = NULL;++ size_t i;+ GuMapEnum* en = (GuMapEnum*) self;+ for (i = en->i; i < en->ht->data.n_entries; i++) {+ if (gu_map_entry_is_free(en->ht, &en->ht->data, i)) {+ continue;+ }+ en->x.key = &en->ht->data.keys[i * en->ht->key_size];+ en->x.value = &en->ht->data.values[i * en->ht->value_size];+ if (en->ht->hasher == gu_addr_hasher) {+ en->x.key = *(const void* const*) en->x.key;+ } else if (en->ht->hasher == gu_string_hasher) {+ en->x.key = *(GuString*) en->x.key;+ }++ *((GuMapKeyValue**) to) = &en->x;+ break;+ }+ + en->i = i+1;+}++GU_API GuEnum*+gu_map_enum(GuMap* ht, GuPool* pool)+{+ GuMapEnum* en = gu_new(GuMapEnum, pool);+ en->en.next = gu_map_enum_next;+ en->ht = ht;+ en->i = 0;+ return &en->en;+}++GU_API size_t+gu_map_count(GuMap* map)+{+ size_t count = 0;+ for (size_t i = 0; i < map->data.n_entries; i++) {+ if (gu_map_entry_is_free(map, &map->data, i)) {+ continue;+ }+ count++;+ }+ return count;+}++static const uint8_t gu_map_no_values[1] = { 0 };++GU_API GuMap*+gu_make_map(size_t key_size, GuHasher* hasher,+ size_t value_size, const void* default_value,+ size_t init_size,+ GuPool* pool)+{+ GuMapData data = {+ .n_occupied = 0,+ .n_entries = 0,+ .keys = NULL,+ .values = value_size ? NULL : (uint8_t*) gu_map_no_values,+ .zero_idx = SIZE_MAX+ };+ GuMap* map = gu_new(GuMap, pool);+ map->default_value = default_value;+ map->hasher = hasher;+ map->data = data;+ map->key_size = key_size;+ map->value_size = value_size;+ map->fin.fn = gu_map_finalize;+ gu_pool_finally(pool, &map->fin);++ init_size = gu_twin_prime_sup(init_size);+ gu_map_resize(map, init_size);+ return map;+}
@@ -0,0 +1,87 @@+#ifndef GU_MAP_H_+#define GU_MAP_H_++#include <gu/hash.h>+#include <gu/mem.h>+#include <gu/exn.h>+#include <gu/enum.h>++typedef struct GuMapItor GuMapItor;++struct GuMapItor {+ void (*fn)(GuMapItor* self, const void* key, void* value,+ GuExn *err);+};++typedef struct GuMap GuMap;++GU_API_DECL GuMap*+gu_make_map(size_t key_size, GuHasher* hasher,+ size_t value_size, const void* default_value,+ size_t init_size,+ GuPool* pool);++#define GU_MAP_DEFAULT_INIT_SIZE 11++#define gu_new_map(K, HASHER, V, DV, POOL) \+ (gu_make_map(sizeof(K), (HASHER), sizeof(V), (DV), GU_MAP_DEFAULT_INIT_SIZE, (POOL)))++#define gu_new_set(K, HASHER, POOL) \+ (gu_make_map(sizeof(K), (HASHER), 0, NULL, GU_MAP_DEFAULT_INIT_SIZE, (POOL)))++#define gu_new_addr_map(K, V, DV, POOL) \+ (gu_make_map(sizeof(K), gu_addr_hasher, sizeof(V), (DV), GU_MAP_DEFAULT_INIT_SIZE, (POOL)))++GU_API_DECL size_t+gu_map_count(GuMap* map);++GU_API_DECL void*+gu_map_find_full(GuMap* ht, void* key_inout);++GU_API_DECL const void*+gu_map_find_default(GuMap* ht, const void* key);++#define gu_map_get(MAP, KEYP, V) \+ (*(V*)gu_map_find_default((MAP), (KEYP)))++GU_API_DECL void*+gu_map_find(GuMap* ht, const void* key);++#define gu_map_set(MAP, KEYP, V, VAL) \+ GU_BEGIN \+ V* gu_map_set_p_ = gu_map_find((MAP), (KEYP)); \+ *gu_map_set_p_ = (VAL); \+ GU_END++GU_API_DECL const void*+gu_map_find_key(GuMap* ht, const void* key);++GU_API_DECL bool+gu_map_has(GuMap* ht, const void* key);++GU_API_DECL void*+gu_map_insert(GuMap* ht, const void* key);++#define gu_map_put(MAP, KEYP, V, VAL) \+ GU_BEGIN \+ V* gu_map_put_p_ = gu_map_insert((MAP), (KEYP)); \+ *gu_map_put_p_ = (VAL); \+ GU_END++GU_API_DECL void+gu_map_iter(GuMap* ht, GuMapItor* itor, GuExn* err);++typedef struct {+ const void* key;+ void* value;+} GuMapKeyValue;++GU_API_DECL GuEnum*+gu_map_enum(GuMap* ht, GuPool* pool);++typedef GuMap GuIntMap;++#define gu_new_int_map(VAL_T, DEFAULT, POOL) \+ gu_new_map(int, gu_int_hasher, VAL_T, DEFAULT, POOL)++#endif // GU_MAP_H_
@@ -0,0 +1,376 @@+#include <gu/mem.h>+#include <gu/fun.h>+#include <gu/bits.h>+#include <gu/assert.h>+#include <string.h>+#include <stdlib.h>+#if !defined(_WIN32) && !defined(_WIN64)+#include <sys/mman.h>+#include <sys/stat.h>+#endif+#if !defined(_MSC_VER)+#include <unistd.h>+#endif+#include <fcntl.h>++#ifdef USE_VALGRIND+#include <valgrind/valgrind.h>+#define VG(X) X+#else+#define VG(X) GU_NOP+#endif++static const size_t+// Maximum request size for a chunk. The actual maximum chunk size+// may be somewhat larger.+ gu_mem_chunk_max_size = 1024 * sizeof(void*),++// number of bytes to allocate in the pool when it is created+ gu_mem_pool_initial_size = 24 * sizeof(void*),++// Pool allocations larger than this will get their own chunk if+// there's no room in the current one. Allocations smaller than this may trigger+// the creation of a new chunk, in which case the remaining space in+// the current chunk is left unused (internal fragmentation).+ gu_mem_max_shared_alloc = 64 * sizeof(void*),+ +// Should not be smaller than the granularity for malloc+ gu_mem_unit_size = 2 * sizeof(void*),++/* Malloc tuning: the additional memory used by malloc next to the+ allocated object */+ gu_malloc_overhead = sizeof(size_t);++static void*+gu_mem_realloc(void* p, size_t size)+{+ void* buf = realloc(p, size);+ if (size != 0 && buf == NULL) {+ gu_fatal("Memory allocation failed");+ }+ return buf;+}++static void*+gu_mem_alloc(size_t size)+{+ void* buf = malloc(size);+ if (buf == NULL) {+ gu_fatal("Memory allocation failed");+ }+ return buf;+}++static void+gu_mem_free(void* p)+{+ free(p);+}++static size_t+gu_mem_padovan(size_t min)+{+ // This could in principle be done faster with Q-matrices for+ // Padovan numbers, but not really worth it for our commonly+ // small numbers.+ if (min <= 5) {+ return min;+ }+ size_t a = 7, b = 9, c = 12;+ while (min > a) {+ if (b < a) {+ // overflow+ return SIZE_MAX;+ }+ size_t tmp = a + b;+ a = b;+ b = c;+ c = tmp;+ }+ return a;+}++GU_API void*+gu_mem_buf_realloc(void* old_buf, size_t min_size, size_t* real_size_out)+{+ size_t min_blocks = ((min_size + gu_malloc_overhead - 1) /+ gu_mem_unit_size) + 1;+ size_t blocks = gu_mem_padovan(min_blocks);+ size_t size = blocks * gu_mem_unit_size - gu_malloc_overhead;+ void* buf = gu_mem_realloc(old_buf, size);+ *real_size_out = buf ? size : 0;+ return buf;+}++GU_API void*+gu_mem_buf_alloc(size_t min_size, size_t* real_size_out)+{+ return gu_mem_buf_realloc(NULL, min_size, real_size_out);+}++GU_API void+gu_mem_buf_free(void* buf)+{+ gu_mem_free(buf);+}+++typedef struct GuMemChunk GuMemChunk;++struct GuMemChunk {+ GuMemChunk* next;+ uint8_t data[];+};++typedef struct GuFinalizerNode GuFinalizerNode;++struct GuFinalizerNode {+ GuFinalizerNode* next;+ GuFinalizer* fin;+};++enum GuPoolType {+ GU_POOL_HEAP,+ GU_POOL_LOCAL,+ GU_POOL_MMAP+};++struct GuPool {+ uint8_t* curr_buf; // actually GuMemChunk*+ GuMemChunk* chunks;+ GuFinalizerNode* finalizers;+ uint16_t type;+ size_t left_edge;+ size_t right_edge;+ size_t curr_size;+ uint8_t init_buf[];+};++static GuPool*+gu_init_pool(uint8_t* buf, size_t sz)+{+ gu_require(gu_aligned((uintptr_t) (void*) buf, gu_alignof(GuPool)));+ gu_require(sz >= sizeof(GuPool));+ GuPool* pool = (GuPool*) buf;+ pool->type = GU_POOL_HEAP;+ pool->curr_size = sz;+ pool->curr_buf = (uint8_t*) pool;+ pool->chunks = NULL;+ pool->finalizers = NULL;+ pool->left_edge = offsetof(GuPool, init_buf);+ pool->right_edge = sz;+ VG(VALGRIND_CREATE_MEMPOOL(pool, 0, false));+ return pool;+}++GU_API GuPool*+gu_local_pool_(uint8_t* buf, size_t sz)+{+ GuPool* pool = gu_init_pool(buf, sz);+ pool->type = GU_POOL_LOCAL;+ return pool;+}++GU_API GuPool* +gu_new_pool(void)+{+ size_t sz = GU_FLEX_SIZE(GuPool, init_buf, gu_mem_pool_initial_size);+ uint8_t* buf = gu_mem_buf_alloc(sz, &sz);+ GuPool* pool = gu_init_pool(buf, sz);+ return pool;+}++GU_API GuPool* +gu_mmap_pool(char* fpath, void* addr, size_t size, void**pptr)+{+#if !defined(_WIN32) && !defined(_WIN64)+ int prot = PROT_READ;+ int fd = open(fpath, O_RDONLY);+ if (fd < 0) {+ if (errno == ENOENT) {+ fd = open(fpath, O_RDWR | O_CREAT | O_TRUNC, S_IRUSR | S_IWUSR);+ if (fd < 0)+ return NULL;++ if (ftruncate(fd, size) < 0) {+ close(fd);+ return NULL;+ }++ prot |= PROT_WRITE;+ } else {+ return NULL;+ }+ }++ void *ptr = mmap(addr, size, prot, MAP_SHARED | MAP_FIXED, fd, 0);+ if (ptr == MAP_FAILED) {+ close(fd);+ return NULL;+ }++ gu_require(ptr == addr);++ *pptr = (prot & PROT_WRITE) ? NULL : ptr;++ size_t sz = GU_FLEX_SIZE(GuPool, init_buf, sizeof(int));+ uint8_t* buf = gu_mem_buf_alloc(sz, &sz);+ GuPool* pool = gu_init_pool(buf, size);++ uint8_t* pfd = pool->init_buf;+ *((int*) pfd) = fd;++ pool->type = GU_POOL_MMAP;+ pool->curr_buf = ptr;+ pool->left_edge = 0;++ return pool;+#else+ return NULL;+#endif+}++static void+gu_pool_expand(GuPool* pool, size_t req)+{+ gu_require(pool->type != GU_POOL_MMAP);+ size_t real_req = GU_MAX(req, GU_MIN(((size_t)pool->curr_size) + 1,+ gu_mem_chunk_max_size));+ gu_assert(real_req >= sizeof(GuMemChunk));+ size_t size = 0;+ GuMemChunk* chunk = gu_mem_buf_alloc(real_req, &size);+ chunk->next = pool->chunks;+ pool->chunks = chunk;+ pool->curr_buf = (uint8_t*) chunk;+ pool->left_edge = offsetof(GuMemChunk, data);+ pool->right_edge = pool->curr_size = size;+ gu_assert((size_t) pool->right_edge == size); +}++static size_t+gu_mem_advance(size_t old_pos, size_t pre_align, size_t pre_size,+ size_t align, size_t size)+{+ size_t p = gu_align_forward(old_pos, pre_align);+ p += pre_size;+ p = gu_align_forward(p, align);+ p += size;+ return p;+}++static void*+gu_pool_malloc_aligned(GuPool* pool, size_t pre_align, size_t pre_size,+ size_t align, size_t size) +{+ size_t pos = gu_mem_advance(pool->left_edge, pre_align, pre_size,+ align, size);+ if (pos > (size_t) pool->right_edge) {+ pos = gu_mem_advance(offsetof(GuMemChunk, data),+ pre_align, pre_size, align, size);+ gu_pool_expand(pool, pos);+ gu_assert(pos <= pool->right_edge);+ }+ pool->left_edge = pos;+ uint8_t* addr = &pool->curr_buf[pos - size];+ VG(VALGRIND_MEMPOOL_ALLOC(pool, addr - pre_size, size + pre_size ));+ return addr;+}++static size_t+gu_pool_avail(GuPool* pool)+{+ return (size_t) pool->right_edge - (size_t) pool->left_edge;+}++GU_API void*+gu_pool_malloc_unaligned(GuPool* pool, size_t size)+{+ if (size > gu_pool_avail(pool)) {+ gu_pool_expand(pool, offsetof(GuMemChunk, data) + size);+ gu_assert(size <= gu_pool_avail(pool));+ }+ pool->right_edge -= size;+ void* addr = &pool->curr_buf[pool->right_edge];+ VG(VALGRIND_MEMPOOL_ALLOC(pool, addr, size));+ return addr;+}++GU_API void*+gu_malloc_prefixed(GuPool* pool, size_t pre_align, size_t pre_size,+ size_t align, size_t size)+{+ void* ret = NULL;+ if (pre_align == 0) {+ pre_align = gu_alignof(GuMaxAlign);+ }+ if (align == 0) {+ align = gu_alignof(GuMaxAlign);+ }+ size_t full_size = gu_mem_advance(offsetof(GuMemChunk, data),+ pre_align, pre_size, align, size);+ if (full_size > gu_mem_max_shared_alloc &&+ pool->type != GU_POOL_MMAP) {+ GuMemChunk* chunk = gu_mem_alloc(full_size);+ chunk->next = pool->chunks;+ pool->chunks = chunk;+ uint8_t* addr = &chunk->data[full_size - size+ - offsetof(GuMemChunk, data)];+ VG(VALGRIND_MEMPOOL_ALLOC(pool, addr - pre_size,+ pre_size + size));+ ret = addr;+ } else if (pre_align == 1 && align == 1) {+ uint8_t* buf = gu_pool_malloc_unaligned(pool, pre_size + size);+ ret = &buf[pre_size];+ } else {+ ret = gu_pool_malloc_aligned(pool, pre_align, pre_size,+ align, size);+ }+ return ret;+}++GU_API void*+gu_malloc_aligned(GuPool* pool, size_t size, size_t align)+{+ return gu_malloc_prefixed(pool, 1, 0, align, size);+}++GU_API void +gu_pool_finally(GuPool* pool, GuFinalizer* finalizer)+{+ gu_require(pool->type != GU_POOL_MMAP);+ GuFinalizerNode* node = gu_new(GuFinalizerNode, pool);+ node->next = pool->finalizers;+ node->fin = finalizer;+ pool->finalizers = node;+}++GU_API void+gu_pool_free(GuPool* pool)+{+ GuFinalizerNode* node = pool->finalizers;+ while (node) {+ node->fin->fn(node->fin);+ node = node->next;+ }+ GuMemChunk* chunk = pool->chunks;+ while (chunk) {+ GuMemChunk* next = chunk->next;+ gu_mem_buf_free(chunk);+ chunk = next;+ }+ VG(VALGRIND_DESTROY_MEMPOOL(pool));+ if (pool->type == GU_POOL_HEAP) {+ gu_mem_buf_free(pool);+ } else if (pool->type == GU_POOL_MMAP) {+#if !defined(_WIN32) && !defined(_WIN64)+ uint8_t* pfd = pool->init_buf;+ int fd = *(pfd);++ munmap(pool->curr_buf, pool->curr_size);+ close(fd);+#endif+ }+}+++extern inline void* gu_malloc(GuPool* pool, size_t size);
@@ -0,0 +1,210 @@+/** @file+ *+ * Memory allocation tools.+ */++#ifndef GU_MEM_H_+#define GU_MEM_H_++#include <gu/defs.h>+#include <gu/fun.h>++/** @defgroup GuPool Memory pools */+//@{ +++/// A memory pool.+typedef struct GuPool GuPool;++/// @name Creating a pool +//@{+++/// Create a new memory pool.+GU_API_DECL GuPool*+gu_new_pool(void);++/**< + * @return A new memory pool.+ */+++//@private+GU_API_DECL GuPool*+gu_local_pool_(uint8_t* init_buf, size_t sz);++//@private+#define GU_LOCAL_POOL_INIT_SIZE (16 * sizeof(GuWord))+++/// Create a stack-allocated memory pool.+#define gu_local_pool() \+ gu_local_pool_(gu_alloca(GU_LOCAL_POOL_INIT_SIZE), \+ GU_LOCAL_POOL_INIT_SIZE)+/**<+ * @return A memory pool whose first chunk is allocated directly from+ * the stack. This makes its creation faster, and more suitable for+ * functions that usually allocate only a little memory from the pool+ * until it is freed.+ *+ * @note The pool created with #gu_local_pool \e must be freed with+ * #gu_pool_free before the end of the block where #gu_local_pool was+ * called.+ *+ * @note Because #gu_local_pool uses relatively much stack space, it+ * should not be used in the bodies of recursive functions.+ */++/// Create a pool stored in a memory mapped file.+GU_API_DECL GuPool* +gu_mmap_pool(char* fpath, void* addr, size_t size, void**pptr);++//@}+/// @name Destroying a pool+//@{+++/// Free a memory pool and all objects allocated from it.+GU_API_DECL void+gu_pool_free(GU_ONLY GuPool* pool);+/**<+ * When the pool is freed, all finalizers registered by+ * #gu_pool_finally on \p pool are invoked in reverse order of+ * registration.+ * + * @note After the pool is freed, all objects allocated from it become+ * invalid and may no longer be used. */++//@}+/// @name Allocating from a pool+//@{+ ++/// Allocate memory with a specified alignment.+GU_API_DECL void* +gu_malloc_aligned(GuPool* pool, size_t size, size_t alignment); ++GU_API_DECL void*+gu_malloc_prefixed(GuPool* pool, size_t pre_align, size_t pre_size,+ size_t align, size_t size);++/// Allocate memory from a pool.+inline void*+gu_malloc(GuPool* pool, size_t size) {+ return gu_malloc_aligned(pool, size, 0);+}++#include <string.h>++/** Allocate memory to store an array of objects of a given type. */++#define gu_new_n(type, n, pool) \+ ((type*)gu_malloc_aligned((pool), \+ sizeof(type) * (n), \+ gu_alignof(type)))+/**< + * @param type The C type of the objects to allocate.+ *+ * @param n The number of objects to allocate.+ * + * @param pool The memory pool to allocate from.+ *+ * @return A pointer to a heap-allocated array of \p n uninitialized+ * objects of type \p type. + */ +++/** Allocate memory to store an object of a given type. */++#define gu_new(type, pool) \+ gu_new_n(type, 1, pool)+/**< + * @param type The C type of the object to allocate.+ *+ * @param pool The memory pool to allocate from.+ *+ * @return A pointer to a heap-allocated uninitialized object of type+ * \p type.+ */+++#define gu_new_prefixed(pre_type, type, pool) \+ ((type*)(gu_malloc_prefixed((pool), \+ gu_alignof(pre_type), sizeof(pre_type), \+ gu_alignof(type), sizeof(type))))++// Alas, there's no portable way to get the alignment of flex structs.+#define gu_new_flex(pool_, type_, flex_member_, n_elems_) \+ ((type_ *)gu_malloc_aligned( \+ (pool_), \+ GU_FLEX_SIZE(type_, flex_member_, n_elems_), \+ gu_flex_alignof(type_)))+++//@}+/// @name Finalizers+//@{+++typedef struct GuFinalizer GuFinalizer;++struct GuFinalizer {+ void (*fn)(GuFinalizer* self);+ ///< @param self A pointer to this finalizer.+};++/// Register a finalizer.+GU_API_DECL void gu_pool_finally(GuPool* pool, GuFinalizer* fini);++/**< Register \p fini to be called when \p pool is destroyed. The+ * finalizers are called in reverse order of registration.+ */+++//@}+//@}++/** @defgroup GuMemBuf Memory buffers+ *+ * Resizable blocks of heap-allocated memory. These operations differ+ * from standard \c malloc, \c realloc and \c free -functions in that+ * memory buffers are not allocated by exact size. Instead, a minimum+ * size is requested, and the returned buffer may be larger. This+ * gives the memory allocator more flexibility when the client code+ * can make use of larger buffers than requested.+ * */++//@{+++/// Allocate a new memory buffer.+GU_API_DECL void*+gu_mem_buf_alloc(size_t min_size, size_t* real_size);+/**<+ * @param min_size The minimum acceptable size for a returned memory block.+ *+ * @param[out] real_size The actual size of the returned memory+ * block. This is never less than \p min_size.+ *+ * @return A pointer to the memory buffer.+ */+++/// Allocate a new memory buffer to replace an old one.+GU_API_DECL void*+gu_mem_buf_realloc(+ GU_NULL GU_ONLY GU_RETURNED+ void* buf,+ size_t min_size,+ size_t* real_size_out);+++/// Free a memory buffer.+GU_API_DECL void+gu_mem_buf_free(GU_ONLY void* buf);+++//@}+++#endif // GU_MEM_H_
@@ -0,0 +1,303 @@+#include <gu/seq.h>+#include <gu/out.h>+#include <gu/utf8.h>+#include <gu/bits.h>+#include <stdio.h>++static bool+gu_out_is_buffering(GuOut* out)+{+ return !!out->buf_end;+}+++static void+gu_out_end_buf(GuOut* out, GuExn* err)+{+ if (!gu_out_is_buffering(out)) {+ return;+ }+ GuOutStream* stream = out->stream;+ size_t curr_len = ((ptrdiff_t)out->buf_size) + out->buf_curr;+ stream->end_buf(stream, curr_len, err);+ out->buf_end = NULL;+ out->buf_size = out->buf_curr = 0;+}++static bool+gu_out_begin_buf(GuOut* out, size_t req, GuExn* err)+{+ GuOutStream* stream = out->stream;+ if (gu_out_is_buffering(out)) {+ if (out->buf_curr < 0) {+ return true;+ } else {+ gu_out_end_buf(out, err);+ if (!gu_ok(err)) {+ return false;+ }+ }+ }+ if (stream->begin_buf) {+ size_t sz = 0;+ uint8_t* buf = stream->begin_buf(stream, req, &sz, err);+ gu_assert(sz <= PTRDIFF_MAX);+ if (buf) {+ out->buf_end = &buf[sz];+ out->buf_curr = -(ptrdiff_t) sz;+ out->buf_size = sz;+ return true;+ }+ }+ return false;+}++++static void+gu_out_fini(GuFinalizer* self)+{+ GuOut* out = gu_container(self, GuOut, fini);+ if (gu_out_is_buffering(out)) {+ GuPool* pool = gu_local_pool();+ GuExn* err = gu_new_exn(pool);+ gu_out_end_buf(out, err);+ gu_pool_free(pool);+ }+}++GU_API GuOut*+gu_new_out(GuOutStream* stream, GuPool* pool)+{+ gu_require(stream != NULL);++ GuOut* out = gu_new(GuOut, pool);+ out->buf_end = NULL,+ out->buf_curr = 0,+ out->stream = stream,+ out->fini.fn = gu_out_fini;+ gu_pool_finally(pool, &out->fini);+ return out;+}++extern inline bool+gu_out_try_buf_(GuOut* out, const uint8_t* src, size_t len);++extern inline size_t+gu_out_bytes(GuOut* out, const uint8_t* buf, size_t len, GuExn* err);++static size_t+gu_out_output(GuOut* out, const uint8_t* src, size_t len, GuExn* err)+{+ gu_out_end_buf(out, err);+ if (!gu_ok(err)) {+ return 0;+ }+ return out->stream->output(out->stream, src, len, err);+}++GU_API void +gu_out_flush(GuOut* out, GuExn* err)+{+ GuOutStream* stream = out->stream;+ if (out->buf_end) {+ gu_out_end_buf(out, err);+ if (!gu_ok(err)) {+ return;+ }+ }+ if (stream->flush) {+ stream->flush(stream, err);+ }+}++GU_API uint8_t*+gu_out_begin_span(GuOut* out, size_t req, size_t* sz_out, GuExn* err)+{+ if (!out->buf_end && !gu_out_begin_buf(out, req, err)) {+ return NULL;+ }+ *sz_out = -out->buf_curr;+ return &out->buf_end[out->buf_curr];+}++GU_API void+gu_out_end_span(GuOut* out, size_t sz)+{+ ptrdiff_t new_curr = (ptrdiff_t) sz + out->buf_curr;+ gu_require(new_curr <= 0);+ out->buf_curr = new_curr;+}++GU_API size_t+gu_out_bytes_(GuOut* restrict out, const uint8_t* restrict src, size_t len, + GuExn* err)+{+ if (!gu_ok(err)) {+ return 0;+ } else if (gu_out_try_buf_(out, src, len)) {+ return len;+ }+ if (gu_out_begin_buf(out, len, err)) {+ if (gu_out_try_buf_(out, src, len)) {+ return len;+ }+ }+ return gu_out_output(out, src, len, err);+}++GU_API void+gu_out_u8_(GuOut* restrict out, uint8_t u, GuExn* err)+{+ if (gu_out_begin_buf(out, 1, err)) {+ if (gu_out_try_u8_(out, u)) {+ return;+ }+ }+ gu_out_output(out, &u, 1, err);+}++extern inline void+gu_out_u8(GuOut* restrict out, uint8_t u, GuExn* err);++extern inline void+gu_out_s8(GuOut* restrict out, int8_t i, GuExn* err);++extern inline bool+gu_out_is_buffered(GuOut* out);++extern inline bool+gu_out_try_u8_(GuOut* restrict out, uint8_t u);++GU_API void+gu_out_u16be(GuOut* out, uint16_t u, GuExn* err)+{+ gu_out_u8(out, (u>>8) & 0xFF, err);+ gu_out_u8(out, u & 0xFF, err);+}++GU_API void+gu_out_u64be(GuOut* out, uint64_t u, GuExn* err)+{+ gu_out_u8(out, (u>>56) & 0xFF, err);+ gu_out_u8(out, (u>>48) & 0xFF, err);+ gu_out_u8(out, (u>>40) & 0xFF, err);+ gu_out_u8(out, (u>>32) & 0xFF, err);+ gu_out_u8(out, (u>>24) & 0xFF, err);+ gu_out_u8(out, (u>>16) & 0xFF, err);+ gu_out_u8(out, (u>>8) & 0xFF, err);+ gu_out_u8(out, u & 0xFF, err);+}++GU_API void+gu_out_f64be(GuOut* out, double d, GuExn* err)+{+ gu_out_u64be(out, gu_encode_double(d), err);+}++typedef struct GuBufferedOutStream GuBufferedOutStream;++struct GuBufferedOutStream {+ GuOutStream stream;+ GuOut* real_out;+ size_t sz;+ uint8_t buf[];+};++static uint8_t*+gu_buffered_out_buf_begin(GuOutStream* self, size_t req, size_t* sz_out,+ GuExn* err)+{+ (void) (req && err);+ GuBufferedOutStream* b =+ gu_container(self, GuBufferedOutStream, stream);+ *sz_out = b->sz;+ return b->buf;+}++static void+gu_buffered_out_buf_end(GuOutStream* self, size_t sz, GuExn* err)+{+ GuBufferedOutStream* b =+ gu_container(self, GuBufferedOutStream, stream);+ gu_require(sz <= b->sz);+ gu_out_bytes(b->real_out, b->buf, sz, err);+}++static size_t+gu_buffered_out_output(GuOutStream* self, const uint8_t* src, size_t sz,+ GuExn* err)+{+ GuBufferedOutStream* bos =+ gu_container(self, GuBufferedOutStream, stream);+ return gu_out_bytes(bos->real_out, src, sz, err);+}++static void+gu_buffered_out_flush(GuOutStream* self, GuExn* err)+{+ GuBufferedOutStream* bos =+ gu_container(self, GuBufferedOutStream, stream);+ gu_out_flush(bos->real_out, err);+}++GU_API GuOut*+gu_new_buffered_out(GuOut* out, size_t sz, GuPool* pool)+{+ GuBufferedOutStream* b =+ gu_new_flex(pool, GuBufferedOutStream, buf, sz);+ b->stream = (GuOutStream) {+ .begin_buf = gu_buffered_out_buf_begin,+ .end_buf = gu_buffered_out_buf_end,+ .output = gu_buffered_out_output,+ .flush = gu_buffered_out_flush+ };+ b->real_out = out;+ b->sz = sz;+ return gu_new_out(&b->stream, pool);+}++GU_API GuOut*+gu_out_buffered(GuOut* out, GuPool* pool)+{+ if (gu_out_is_buffered(out)) {+ return out;+ }+ return gu_new_buffered_out(out, 4096, pool);+}+++extern inline void+gu_putc(char c, GuOut* out, GuExn* err);++GU_API void+gu_puts(const char* str, GuOut* out, GuExn* err)+{+ gu_out_bytes(out, (const uint8_t*) str, strlen(str), err);+}++GU_API void+gu_vprintf(const char* fmt, va_list args, GuOut* out, GuExn* err)+{+ GuPool* tmp_pool = gu_local_pool();++ va_list args2;+ va_copy(args2, args);+ int len = vsnprintf(NULL, 0, fmt, args2);+ gu_assert_msg(len >= 0, "Invalid format string: \"%s\"", fmt);+ va_end(args2);+ char* str = gu_new_n(char, len + 1, tmp_pool);+ vsnprintf(str, len + 1, fmt, args);++ gu_out_bytes(out, (const uint8_t*) str, strlen(str), err);+ gu_pool_free(tmp_pool);+}++GU_API void+gu_printf(GuOut* out, GuExn* err, const char* fmt, ...)+{+ va_list args;+ va_start(args, fmt);+ gu_vprintf(fmt, args, out, err);+ va_end(args);+}
@@ -0,0 +1,174 @@+#ifndef GU_OUT_H_+#define GU_OUT_H_++#include <gu/defs.h>+#include <gu/assert.h>+#include <gu/exn.h>+#include <gu/ucs.h>++typedef struct GuOut GuOut;++typedef struct GuOutStream GuOutStream;++struct GuOutStream {+ uint8_t* (*begin_buf)(GuOutStream* self, size_t req, size_t* sz_out,+ GuExn* err);+ void (*end_buf)(GuOutStream* self, size_t span, GuExn* err);+ size_t (*output)(GuOutStream* self, const uint8_t* buf, size_t size,+ GuExn* err);+ void (*flush)(GuOutStream* self, GuExn* err);+};+++struct GuOut {+ uint8_t* restrict buf_end;+ ptrdiff_t buf_curr;+ size_t buf_size;+ GuOutStream* stream;+ GuFinalizer fini;+};++GU_API_DECL GuOut*+gu_new_out(GuOutStream* stream, GuPool* pool);++inline bool+gu_out_is_buffered(GuOut* out)+{+ return !!out->stream->begin_buf;+}++GU_API_DECL GuOut*+gu_new_buffered_out(GuOut* out, size_t buf_sz, GuPool* pool);++GU_API_DECL GuOut*+gu_out_buffered(GuOut* out, GuPool* pool);++GU_API_DECL uint8_t*+gu_out_begin_span(GuOut* out, size_t req, size_t* sz_out, GuExn* err);++GU_API_DECL uint8_t*+gu_out_force_span(GuOut* out, size_t min, size_t max, size_t* sz_out,+ GuExn* err);++GU_API_DECL void+gu_out_end_span(GuOut* out, size_t sz);++GU_API_DECL size_t+gu_out_bytes_(GuOut* restrict out, const uint8_t* restrict src, + size_t len, GuExn* err);++inline bool+gu_out_try_buf_(GuOut* restrict out, const uint8_t* restrict src, size_t len)+{+ gu_require(len <= PTRDIFF_MAX);+ ptrdiff_t curr = out->buf_curr;+ ptrdiff_t new_curr = curr + (ptrdiff_t) len;+ if (GU_UNLIKELY(new_curr > 0)) {+ return false;+ }+ memcpy(&out->buf_end[curr], src, len);+ out->buf_curr = new_curr;+ return true;+}++inline size_t+gu_out_bytes(GuOut* restrict out, const uint8_t* restrict src, size_t len, + GuExn* err)+{+ if (GU_LIKELY(gu_out_try_buf_(out, src, len))) {+ return len;+ }+ return gu_out_bytes_(out, src, len, err);+}++GU_API_DECL void+gu_out_flush(GuOut* out, GuExn* err);++inline bool+gu_out_try_u8_(GuOut* restrict out, uint8_t u)+{+ ptrdiff_t curr = out->buf_curr;+ ptrdiff_t new_curr = curr + 1;+ if (GU_UNLIKELY(new_curr > 0)) {+ return false;+ }+ out->buf_end[curr] = u;+ out->buf_curr = new_curr;+ return true;+}++inline void+gu_out_u8(GuOut* restrict out, uint8_t u, GuExn* err)+{+ if (GU_UNLIKELY(!gu_out_try_u8_(out, u))) {+ GU_API_DECL void gu_out_u8_(GuOut* restrict out, uint8_t u, + GuExn* err);+ gu_out_u8_(out, u, err);+ }+}++inline void+gu_out_s8(GuOut* restrict out, int8_t i, GuExn* err)+{+ gu_out_u8(out, (uint8_t) i, err);+}++GU_API_DECL void+gu_out_u16le(GuOut* out, uint16_t u, GuExn* err);++GU_API_DECL void+gu_out_u16be(GuOut* out, uint16_t u, GuExn* err);++GU_API_DECL void+gu_out_s16le(GuOut* out, int16_t u, GuExn* err);++GU_API_DECL void+gu_out_s16be(GuOut* out, int16_t u, GuExn* err);++GU_API_DECL void+gu_out_u32le(GuOut* out, uint32_t u, GuExn* err);++GU_API_DECL void+gu_out_u32be(GuOut* out, uint32_t u, GuExn* err);++GU_API_DECL void+gu_out_s32le(GuOut* out, int32_t u, GuExn* err);++GU_API_DECL void+gu_out_s32be(GuOut* out, int32_t u, GuExn* err);++GU_API_DECL void+gu_out_u64le(GuOut* out, uint64_t u, GuExn* err);++GU_API_DECL void+gu_out_u64be(GuOut* out, uint64_t u, GuExn* err);++GU_API_DECL void+gu_out_s64le(GuOut* out, int64_t u, GuExn* err);++GU_API_DECL void+gu_out_s64be(GuOut* out, int64_t u, GuExn* err);++GU_API_DECL void+gu_out_f64le(GuOut* out, double d, GuExn* err);++GU_API_DECL void+gu_out_f64be(GuOut* out, double d, GuExn* err);++inline void+gu_putc(char c, GuOut* out, GuExn* err)+{+ GuUCS ucs = gu_char_ucs(c);+ gu_out_u8(out, (uint8_t) ucs, err);+}++GU_API_DECL void+gu_puts(const char* str, GuOut* out, GuExn* err);++GU_API_DECL void+gu_vprintf(const char* fmt, va_list args, GuOut* out, GuExn* err);++GU_API_DECL void+gu_printf(GuOut* out, GuExn* err, const char* fmt, ...);++#endif // GU_OUT_H_
@@ -0,0 +1,154 @@+#include <gu/defs.h>+#include <gu/assert.h>++static const uint32_t gu_prime_wheel_mask = 0UL+ | 1 << 1+ | 1 << 7+ | 1 << 11+ | 1 << 13+ | 1 << 17+ | 1 << 19+ | 1 << 23+ | 1 << 29;++static bool+gu_prime_wheel(int i)+{+ gu_assert(i >= 0 && i < 30);+ return !!(gu_prime_wheel_mask & (1 << i));+}++static const uint32_t gu_small_prime_mask = 0UL+ | 1 << 2+ | 1 << 3 + | 1 << 5+ | 1 << 7+ | 1 << 11+ | 1 << 13+ | 1 << 17+ | 1 << 19+ | 1 << 23+ | 1 << 29+ | 1U << 31;++static bool+gu_is_wheel_prime(int u)+{+ gu_assert(u > 30 && u % 2 != 0 && u % 3 != 0 && u % 5 != 0);+ int d = 0;+ int i = 7;+ goto start;+ while (d * d <= u) {+ for (i = 1; i <= 29; i+=2) {+ start:+ if (gu_prime_wheel(i) && u % (d + i) == 0) {+ return false;+ }+ }+ d += 30;+ }+ return true;+}++GU_INTERNAL int+gu_prime_inf(int i)+{+ if (i < 2) {+ return 0;+ } else if (i < 32) {+ while (!(gu_small_prime_mask & (1 << i))) {+ i--;+ }+ return i;+ }++ int d = (i - 1) | 1;+ int r = d % 30;++ while (!gu_prime_wheel(r) || !gu_is_wheel_prime(d)) {+ d -= 2;+ r -= 2;+ if (r < 0) {+ r += 30;+ } + }+ return d;+}++GU_INTERNAL int+gu_prime_sup(int i)+{+ if (i <= 2) {+ return 2;+ } else if (i < 32) {+ while (!(gu_small_prime_mask & (1 << i))) {+ i++;+ }+ return i;+ }++ int d = i | 1;+ int r = d % 30;++ while (!gu_prime_wheel(r) || !gu_is_wheel_prime(d)) {+ d += 2;+ r += 2;+ if (r > 30) {+ r -= 30;+ }+ }+ return d;+}++GU_INTERNAL bool+gu_is_prime(int i)+{+ if (i < 2) {+ return false;+ } else if (i < 30) {+ return !!(gu_small_prime_mask & (1 << i));+ } else if (!gu_prime_wheel(i % 30)) {+ return false;+ } else {+ return gu_is_wheel_prime(i);+ }+}++GU_INTERNAL bool+gu_is_twin_prime(int i)+{+ return gu_is_prime(i) && gu_is_prime(i - 2);+}++GU_INTERNAL int+gu_twin_prime_inf(int i)+{+ while (true) {+ i = gu_prime_inf(i);+ if (i == 0) {+ return 0;+ } else if (gu_is_prime(i - 2)) {+ return i;+ }+ i = i - 4;+ }+ return i;+}++GU_INTERNAL int+gu_twin_prime_sup(int i)+{+ if (i <= 5) {+ return 5;+ }+ i = i - 2;+ while (true) {+ i = gu_prime_sup(i);+ if (gu_is_prime(i + 2)) {+ return i + 2;+ }+ i = i + 4;+ }+ return i;+}+
@@ -0,0 +1,16 @@+#ifndef GU_PRIME_H_+#define GU_PRIME_H_++#include <gu/defs.h>++GU_INTERNAL_DECL bool gu_is_prime(int i);++GU_INTERNAL_DECL bool gu_is_twin_prime(int i);++GU_INTERNAL_DECL int gu_prime_inf(int i);+GU_INTERNAL_DECL int gu_twin_prime_inf(int i);++GU_INTERNAL_DECL int gu_prime_sup(int i);+GU_INTERNAL_DECL int gu_twin_prime_sup(int i);++#endif // GU_PRIME_H_
@@ -0,0 +1,366 @@+#include <gu/out.h>+#include <gu/seq.h>+#include <gu/fun.h>+#include <gu/assert.h>+#include <stdlib.h>+#if defined(__MINGW32__) || defined(_MSC_VER)+#include <malloc.h>+#endif++static void+gu_buf_fini(GuFinalizer* fin)+{+ GuBuf* buf = gu_container(fin, GuBuf, fin);+ if (buf->avail_len > 0)+ gu_mem_buf_free(buf->seq);+}++GU_API GuBuf*+gu_make_buf(size_t elem_size, GuPool* pool)+{+ GuBuf* buf = gu_new(GuBuf, pool);+ buf->seq = gu_empty_seq();+ buf->elem_size = elem_size;+ buf->avail_len = 0;+ buf->fin.fn = gu_buf_fini;+ gu_pool_finally(pool, &buf->fin);+ return buf;+}++extern size_t+gu_buf_length(GuBuf* buf);++extern size_t+gu_buf_avail(GuBuf* buf);++extern void*+gu_buf_data(GuBuf* buf);++extern GuSeq*+gu_buf_data_seq(GuBuf* buf);++extern void*+gu_buf_extend(GuBuf* buf);++extern const void*+gu_buf_trim(GuBuf* buf);++extern void+gu_buf_flush(GuBuf* buf);++static GuSeq gu_empty_seq_ = {0};++GU_API GuSeq*+gu_empty_seq() {+ return &gu_empty_seq_;+}++GU_API GuSeq*+gu_make_seq(size_t elem_size, size_t length, GuPool* pool)+{+ GuSeq* seq = gu_malloc(pool, sizeof(GuSeq) + elem_size * length);+ seq->len = length;+ return seq;+}++extern size_t+gu_seq_length(GuSeq* seq);++extern void*+gu_seq_data(GuSeq* seq);++GU_API GuSeq*+gu_alloc_seq_(size_t elem_size, size_t length)+{+ if (length == 0)+ return gu_empty_seq();++ size_t real_size;+ GuSeq* seq = gu_mem_buf_alloc(sizeof(GuSeq) + elem_size * length, &real_size);+ seq->len = (real_size - sizeof(GuSeq)) / elem_size;+ return seq;+}++GU_API GuSeq*+gu_realloc_seq_(GuSeq* seq, size_t elem_size, size_t length)+{+ size_t real_size;+ GuSeq* new_seq = (seq == NULL || seq == gu_empty_seq()) ?+ gu_mem_buf_alloc(sizeof(GuSeq) + elem_size * length, &real_size) :+ gu_mem_buf_realloc(seq, sizeof(GuSeq) + elem_size * length, &real_size);+ new_seq->len = (real_size - sizeof(GuSeq)) / elem_size;+ return new_seq;+}++GU_API void+gu_seq_free(GuSeq* seq)+{+ if (seq == NULL || seq == gu_empty_seq())+ return;+ gu_mem_buf_free(seq);+}++GU_API void+gu_buf_require(GuBuf* buf, size_t req_len)+{+ if (req_len <= buf->avail_len) {+ return;+ }++ size_t req_size = sizeof(GuSeq) + buf->elem_size * req_len;+ size_t real_size;+ + if (buf->seq == NULL || buf->seq == gu_empty_seq()) {+ buf->seq = gu_mem_buf_alloc(req_size, &real_size);+ buf->seq->len = 0;+ } else {+ buf->seq = gu_mem_buf_realloc(buf->seq, req_size, &real_size);+ }++ buf->avail_len = (real_size - sizeof(GuSeq)) / buf->elem_size;+}++GU_API void*+gu_buf_extend_n(GuBuf* buf, size_t n_elems)+{+ size_t len = gu_buf_length(buf);+ size_t new_len = len + n_elems;+ gu_buf_require(buf, new_len);+ buf->seq->len = new_len;+ return &buf->seq->data[buf->elem_size * len];+}++GU_API void+gu_buf_push_n(GuBuf* buf, const void* data, size_t n_elems)+{+ void* p = gu_buf_extend_n(buf, n_elems);+ memcpy(p, data, buf->elem_size * n_elems);+}++GU_API const void*+gu_buf_trim_n(GuBuf* buf, size_t n_elems)+{+ gu_require(n_elems <= gu_buf_length(buf));+ size_t new_len = gu_buf_length(buf) - n_elems;+ buf->seq->len = new_len;+ return &buf->seq->data[buf->elem_size * new_len];+}++GU_API void+gu_buf_pop_n(GuBuf* buf, size_t n_elems, void* data_out)+{+ const void* p = gu_buf_trim_n(buf, n_elems);+ memcpy(data_out, p, buf->elem_size * n_elems);+}++GU_API GuSeq*+gu_buf_freeze(GuBuf* buf, GuPool* pool)+{+ size_t len = gu_buf_length(buf);+ GuSeq* seq = gu_make_seq(buf->elem_size, len, pool);+ void* bufdata = gu_buf_data(buf);+ void* seqdata = gu_seq_data(seq);+ memcpy(seqdata, bufdata, buf->elem_size * len);+ return seq;+}++GU_API void*+gu_buf_insert(GuBuf* buf, size_t index)+{+ size_t len = buf->seq->len;+ gu_buf_require(buf, len + 1);++ uint8_t* target =+ buf->seq->data + buf->elem_size * index;+ memmove(target+buf->elem_size, target, (len-index)*buf->elem_size);++ buf->seq->len++;+ return target;+}++static void+gu_quick_sort(GuBuf *buf, GuOrder *order, int left, int right)+{+ int l_hold = left;+ int r_hold = right;++ void* pivot = alloca(buf->elem_size);+ memcpy(pivot,+ &buf->seq->data[buf->elem_size * left],+ buf->elem_size);+ while (left < right) {++ while ((order->compare(order, &buf->seq->data[buf->elem_size * right], pivot) >= 0) && (left < right))+ right--;++ if (left != right) {+ memcpy(&buf->seq->data[buf->elem_size * left],+ &buf->seq->data[buf->elem_size * right],+ buf->elem_size);+ left++;+ }++ while ((order->compare(order, &buf->seq->data[buf->elem_size * left], pivot) <= 0) && (left < right))+ left++;++ if (left != right) {+ memcpy(&buf->seq->data[buf->elem_size * right],+ &buf->seq->data[buf->elem_size * left],+ buf->elem_size);+ right--;+ }+ }+ + memcpy(&buf->seq->data[buf->elem_size * left],+ pivot,+ buf->elem_size);+ int index = left;+ left = l_hold;+ right = r_hold;++ if (left < index)+ gu_quick_sort(buf, order, left, index-1);++ if (right > index)+ gu_quick_sort(buf, order, index+1, right);+}++GU_API void+gu_buf_sort(GuBuf *buf, GuOrder *order)+{+ gu_quick_sort(buf, order, 0, gu_buf_length(buf) - 1);+}++GU_API void*+gu_seq_binsearch_(GuSeq *seq, GuOrder *order, size_t elem_size, const void *key)+{+ int i = 0;+ int j = seq->len-1;+ + while (i <= j) {+ int k = (i+j) / 2;+ uint8_t* elem_p = &seq->data[elem_size * k];+ int cmp = order->compare(order, key, elem_p);++ if (cmp < 0) {+ j = k-1;+ } else if (cmp > 0) {+ i = k+1;+ } else {+ return elem_p;+ }+ }++ return NULL;+}++GU_API bool+gu_seq_binsearch_index_(GuSeq *seq, GuOrder *order, size_t elem_size,+ const void *key, size_t *pindex)+{+ size_t i = 0;+ size_t j = seq->len-1;+ + while (i <= j) {+ size_t k = (i+j) / 2;+ uint8_t* elem_p = &seq->data[elem_size * k];+ int cmp = order->compare(order, key, elem_p);+ + if (cmp < 0) {+ j = k-1;+ } else if (cmp > 0) {+ i = k+1;+ } else {+ *pindex = k;+ return true;+ }+ }++ *pindex = j;+ return false;+}++static void+gu_heap_siftdown(GuBuf *buf, GuOrder *order, + const void *value, int startpos, int pos)+{+ while (pos > startpos) {+ int parentpos = (pos - 1) >> 1;+ void *parent = &buf->seq->data[buf->elem_size * parentpos];+ + if (order->compare(order, value, parent) >= 0)+ break;++ memcpy(&buf->seq->data[buf->elem_size * pos], parent, buf->elem_size);+ pos = parentpos;+ }++ memcpy(&buf->seq->data[buf->elem_size * pos], value, buf->elem_size);+}++static void+gu_heap_siftup(GuBuf *buf, GuOrder *order,+ const void *value, int pos)+{+ int startpos = pos;+ int endpos = gu_buf_length(buf);++ int childpos = 2*pos + 1;+ while (childpos < endpos) {+ int rightpos = childpos + 1;+ if (rightpos < endpos &&+ order->compare(order, + &buf->seq->data[buf->elem_size * childpos],+ &buf->seq->data[buf->elem_size * rightpos]) >= 0) {+ childpos = rightpos;+ }++ memcpy(&buf->seq->data[buf->elem_size * pos], + &buf->seq->data[buf->elem_size * childpos], buf->elem_size);+ pos = childpos;+ childpos = 2*pos + 1;+ }+ + gu_heap_siftdown(buf, order, value, startpos, pos);+}++GU_API void+gu_buf_heap_push(GuBuf *buf, GuOrder *order, void *value)+{+ gu_buf_extend(buf);+ gu_heap_siftdown(buf, order, value, 0, gu_buf_length(buf)-1);+}++GU_API void+gu_buf_heap_pop(GuBuf *buf, GuOrder *order, void* data_out)+{+ const void* last = gu_buf_trim(buf); // raises an error if empty++ if (gu_buf_length(buf) > 0) {+ memcpy(data_out, buf->seq->data, buf->elem_size);+ gu_heap_siftup(buf, order, last, 0);+ } else {+ memcpy(data_out, last, buf->elem_size);+ }+}++GU_API void+gu_buf_heap_replace(GuBuf *buf, GuOrder *order, void *value, void *data_out)+{+ gu_require(gu_buf_length(buf) > 0);++ memcpy(data_out, buf->seq->data, buf->elem_size);+ gu_heap_siftup(buf, order, value, 0);+}++GU_API void+gu_buf_heapify(GuBuf *buf, GuOrder *order)+{+ size_t middle = gu_buf_length(buf) / 2;+ void *value = alloca(buf->elem_size);+ + for (size_t i = 0; i < middle; i++) {+ memcpy(value, &buf->seq->data[buf->elem_size * i], buf->elem_size);+ gu_heap_siftup(buf, order, value, i);+ }+}
@@ -0,0 +1,190 @@+#ifndef GU_SEQ_H_+#define GU_SEQ_H_++#include <gu/mem.h>++typedef struct {+ size_t len;+ uint8_t data[0];+} GuSeq;++typedef struct {+ GuSeq* seq;+ size_t elem_size;+ size_t avail_len;+ GuFinalizer fin;+} GuBuf;++GU_API_DECL GuSeq*+gu_empty_seq();++GU_API_DECL GuSeq*+gu_make_seq(size_t elem_size, size_t len, GuPool* pool);++#define gu_new_seq(T, N, POOL) \+ gu_make_seq(sizeof(T), (N), (POOL))++GU_API_DECL GuSeq*+gu_alloc_seq_(size_t elem_size, size_t length);++#define gu_alloc_seq(T, N) \+ gu_alloc_seq_(sizeof(T), (N))++GU_API_DECL GuSeq*+gu_realloc_seq_(GuSeq* seq, size_t elem_size, size_t length);++#define gu_realloc_seq(S, T, N) \+ gu_realloc_seq_(S, sizeof(T), (N))++GU_API_DECL void+gu_seq_free(GuSeq* seq);++inline size_t+gu_seq_length(GuSeq* seq)+{+ return seq->len;+}++inline void*+gu_seq_data(GuSeq* seq)+{+ return seq->data;+}++#define gu_seq_index(SEQ, T, I) \+ (&((T*)gu_seq_data(SEQ))[I])++#define gu_seq_get(SEQ, T, I) \+ (*gu_seq_index(SEQ, T, I))++#define gu_seq_set(SEQ, T, I, V) \+ GU_BEGIN \+ (*gu_seq_index(SEQ, T, I) = (V)); \+ GU_END+++GU_API_DECL GuBuf*+gu_make_buf(size_t elem_size, GuPool* pool);++#define gu_new_buf(T, POOL) \+ gu_make_buf(sizeof(T), (POOL))++inline size_t+gu_buf_length(GuBuf* buf)+{+ return buf->seq->len;+}++inline size_t+gu_buf_avail(GuBuf* buf)+{+ return buf->avail_len;+}++inline void*+gu_buf_data(GuBuf* buf)+{+ return &buf->seq->data;+}++inline GuSeq*+gu_buf_data_seq(GuBuf* buf)+{+ return buf->seq;+}++#define gu_buf_index(BUF, T, I) \+ (&((T*)gu_buf_data(BUF))[I])++#define gu_buf_get(BUF, T, I) \+ (*gu_buf_index(BUF, T, I))++#define gu_buf_set(BUF, T, I, V) \+ GU_BEGIN \+ (*gu_buf_index(BUF, T, I) = (V)); \+ GU_END++GU_API_DECL void+gu_buf_push_n(GuBuf* buf, const void* elems, size_t n_elems);++GU_API_DECL void*+gu_buf_extend_n(GuBuf* buf, size_t n_elems);++inline void*+gu_buf_extend(GuBuf* buf)+{+ return gu_buf_extend_n(buf, 1);+}++#define gu_buf_push(BUF, T, VAL) \+ GU_BEGIN \+ ((*(T*)gu_buf_extend(BUF)) = (VAL)); \+ GU_END++GU_API_DECL void+gu_buf_pop_n(GuBuf* buf, size_t n_elems, void* data_out);++#define gu_buf_get_last(BUF, T) \+ (((T*)gu_buf_data(BUF))[(BUF)->seq->len-1])++#define gu_buf_index_last(BUF, T) \+ (&((T*)gu_buf_data(BUF))[(BUF)->seq->len-1])++GU_API_DECL const void*+gu_buf_trim_n(GuBuf* buf, size_t n_elems);++inline const void*+gu_buf_trim(GuBuf* buf)+{+ return gu_buf_trim_n(buf, 1);+}++GU_API_DECL void*+gu_buf_insert(GuBuf* buf, size_t n_index);++inline void+gu_buf_flush(GuBuf* buf)+{+ buf->seq->len = 0;+}++#define gu_buf_pop(BUF, T) \+ (*(T*)gu_buf_trim(BUF))++GU_API_DECL void+gu_buf_sort(GuBuf *buf, GuOrder *order);++#define gu_seq_binsearch(S, O, T, V) \+ ((T*) gu_seq_binsearch_(S, O, sizeof(T), V))++GU_API_DECL void*+gu_seq_binsearch_(GuSeq *seq, GuOrder *order, size_t elem_size, const void *key);++#define gu_seq_binsearch_index(S, O, T, V, PI) \+ gu_seq_binsearch_index_(S, O, sizeof(T), V, PI)++GU_API_DECL bool+gu_seq_binsearch_index_(GuSeq *seq, GuOrder *order, size_t elem_size, + const void *key, size_t *pindex);++// Using a buffer as a heap+GU_API_DECL void+gu_buf_heap_push(GuBuf *buf, GuOrder *order, void *value);++GU_API_DECL void+gu_buf_heap_pop(GuBuf *buf, GuOrder *order, void* data_out);++GU_API_DECL void+gu_buf_heap_replace(GuBuf *buf, GuOrder *order, void *value, void *data_out);++GU_API_DECL void+gu_buf_heapify(GuBuf *buf, GuOrder *order);++GU_API_DECL GuSeq*+gu_buf_freeze(GuBuf* buf, GuPool* pool);+#endif // GU_SEQ_H_++#ifdef GU_STRING_H_+GU_INTERNAL_DECL void+gu_buf_require(GuBuf* buf, size_t req_len);+#endif // GU_STRING_H_
@@ -0,0 +1,313 @@+#include <gu/out.h>+#include <gu/map.h>+#include <gu/string.h>+#include <gu/seq.h>+#include <gu/utf8.h>+#include <gu/assert.h>+#include <stdlib.h>+#if defined(__MINGW32__) || defined(_MSC_VER)+#include <malloc.h>+#endif++struct GuStringBuf {+ GuOutStream stream;+ GuBuf* buf;+ GuOut* out;+};++static size_t+gu_string_buf_output(GuOutStream* stream, const uint8_t* src, size_t sz,+ GuExn* err)+{+ (void) err;+ GuStringBuf* sbuf = gu_container(stream, GuStringBuf, stream);+ gu_buf_push_n(sbuf->buf, src, sz);+ return sz;+}++static uint8_t*+gu_string_buf_begin(GuOutStream* stream, size_t req, size_t* sz_out, GuExn* err)+{+ (void) req;+ (void) err;+ GuStringBuf* sbuf = gu_container(stream, GuStringBuf, stream);+ size_t len = gu_buf_length(sbuf->buf);+ gu_buf_require(sbuf->buf, len + req);+ size_t avail = sbuf->buf->avail_len;+ gu_assert(len < avail);+ *sz_out = (avail - len);+ return (uint8_t*) gu_buf_index(sbuf->buf, char, len);+}++static void+gu_string_buf_end(GuOutStream* stream, size_t sz, GuExn* err)+{+ (void) err;+ GuStringBuf* sbuf = gu_container(stream, GuStringBuf, stream);+ size_t len = gu_buf_length(sbuf->buf);+ gu_require(sz < len - sbuf->buf->avail_len);+ sbuf->buf->seq->len = len + sz;+}++GU_API GuStringBuf*+gu_new_string_buf(GuPool* pool)+{+ GuStringBuf* sbuf = gu_new(GuStringBuf, pool);+ sbuf->stream.output = gu_string_buf_output;+ sbuf->stream.begin_buf = gu_string_buf_begin;+ sbuf->stream.end_buf = gu_string_buf_end;+ sbuf->stream.flush = NULL;+ sbuf->buf = gu_new_buf(char, pool);+ sbuf->out = gu_new_out(&sbuf->stream, pool);+ return sbuf;+}++GU_API GuOut*+gu_string_buf_out(GuStringBuf* sb)+{+ return sb->out;+}++GU_API GuString+gu_string_buf_freeze(GuStringBuf* sb, GuPool* pool)+{+ gu_out_flush(sb->out, NULL);+ char* data = gu_buf_data(sb->buf);+ size_t len = gu_buf_length(sb->buf);++ char* p = gu_malloc_aligned(pool, len+1, 2);+ memcpy(p, data, len);+ p[len] = 0;++ return p;+}++GU_API char*+gu_string_buf_data(GuStringBuf* sb)+{+ gu_out_flush(sb->out, NULL);+ return gu_buf_data(sb->buf);+}++GU_API size_t+gu_string_buf_length(GuStringBuf* sb)+{+ gu_out_flush(sb->out, NULL);+ return gu_buf_length(sb->buf);+}++GU_API void+gu_string_buf_flush(GuStringBuf* sb)+{+ gu_buf_flush(sb->buf);+}++GU_API GuIn*+gu_string_in(GuString s, GuPool* pool)+{+ return gu_data_in((uint8_t*) s, strlen(s), pool);+}++GU_API GuString+gu_string_copy(GuString string, GuPool* pool)+{+ size_t len = strlen(string);+ char* p = gu_malloc_aligned(pool, len+1, 2);+ memcpy(p, string, len+1);+ return p;+}++GU_API void+gu_string_write(GuString s, GuOut* out, GuExn* err)+{+ gu_out_bytes(out, (uint8_t*) s, strlen(s), err);+}++GU_API GuString+gu_string_read(size_t len, GuPool* pool, GuIn* in, GuExn* err)+{+ char* buf = alloca(len*6+1);+ char* p = buf;+ for (size_t i = 0; i < len; i++) {+ gu_in_utf8_buf((uint8_t**) &p, in, err);+ }+ *p++ = 0;++ p = gu_malloc_aligned(pool, p-buf, 2);+ strcpy(p, buf);++ return p;+}++GU_API GuString+gu_string_read_latin1(size_t len, GuPool* pool, GuIn* in, GuExn* err)+{+ char* p = gu_malloc_aligned(pool, len+1, 2);+ gu_in_bytes(in, (uint8_t*)p, len, err);+ p[len] = 0;+ return p;+}++GU_API GuString+gu_format_string_v(const char* fmt, va_list args, GuPool* pool)+{+ GuPool* tmp_pool = gu_local_pool();+ GuStringBuf* sb = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sb);+ gu_vprintf(fmt, args, out, NULL);+ gu_out_flush(out, NULL);+ GuString s = gu_string_buf_freeze(sb, pool);+ gu_pool_free(tmp_pool);+ return s;+}++GU_API GuString+gu_format_string(GuPool* pool, const char* fmt, ...)+{+ va_list args;+ va_start(args, fmt);+ GuString s = gu_format_string_v(fmt, args, pool);+ va_end(args);+ return s;+}++GU_API bool+gu_string_to_int(GuString s, int *res)+{+ bool neg = false;+ if (*s == '-') {+ neg = true;+ s++;+ }++ if (*s == 0)+ return false;++ int n = 0;+ for (; *s; s++) {+ if (*s < '0' || *s > '9')+ return false;++ n = n * 10 + (*s - '0');+ }++ *res = neg ? -n : n;+ return true;+}++GU_API bool+gu_string_to_double(GuString s, double *res)+{+ bool neg = false;+ bool dec = false;+ double exp = 1;++ if (*s == '-') {+ neg = true;+ s++;+ }++ if (*s == 0)+ return false;++ double d = 0;+ for (; *s; s++) {+ if (*s == '.') {+ if (dec) return false;++ dec = true;+ continue;+ }++ if (*s < '0' || *s > '9')+ return false;++ if (dec) exp = exp * 10;++ d = d * 10 + (*s - '0');+ }++ *res = (neg ? -d : d) / exp;+ return true;+}++GU_API void+gu_double_to_string(double val, GuOut* out, GuExn* err)+{+ int ival = (int) val;+ gu_printf(out, err, "%d", ival);+ val -= ival;++ if (val < 0)+ val = -val;++ if (val != 0) {+ gu_putc('.', out, err);++ while (val > 0.000001) // process remaining digits+ {+ val = val * 10;+ ival = (int) val;+ gu_printf(out, err, "%d", ival);+ val -= ival;+ }+ }+}++GU_API bool+gu_string_is_prefix(GuString s1, GuString s2)+{+ size_t len1 = strlen(s1);+ size_t len2 = strlen(s2);++ if (len1 > len2)+ return false;++ for (size_t len = len1; len > 0; len--) {+ if (*s1 != *s2)+ return false;++ s1++;+ s2++;+ }++ return true;+}++GU_API GuHash+gu_string_hash(GuHash h, GuString s)+{+ return gu_hash_bytes(h, (uint8_t*)s, strlen(s));+}++static bool+gu_string_eq_fn(GuEquality* self, const void* p1, const void* p2)+{+ (void) self;+ return strcmp((GuString) p1, (GuString) p2) == 0;+}++GU_API GuEquality gu_string_equality[1] = { { gu_string_eq_fn } };++static int+gu_string_cmp_fn(GuOrder* self, const void* p1, const void* p2)+{+ (void) self;+ return strcmp((GuString) p1, (GuString) p2);+}++GU_API GuOrder gu_string_order[1] = { { gu_string_cmp_fn } };++static GuHash+gu_string_hasher_hash(GuHasher* self, const void* p)+{+ (void) self;+ return gu_string_hash(0, (GuString) p);+}++GU_API GuHasher gu_string_hasher[1] = {+ {+ .eq = { gu_string_eq_fn },+ .hash = gu_string_hasher_hash+ }+};
@@ -0,0 +1,97 @@+#ifndef GU_STRING_H_+#define GU_STRING_H_++#include <gu/bits.h>+#include <gu/in.h>+#include <gu/out.h>++typedef const char* GuString;++GU_API_DECL GuString+gu_string_copy(GuString string, GuPool* pool);++GU_API_DECL void+gu_string_write(GuString string, GuOut* out, GuExn* err);++GU_API_DECL GuString+gu_string_read(size_t len, GuPool* pool, GuIn* in, GuExn* err);++GU_API_DECL GuString+gu_string_read_latin1(size_t len, GuPool* pool, GuIn* in, GuExn* err);++GU_API_DECL GuIn*+gu_string_in(GuString string, GuPool* pool);++typedef struct GuStringBuf GuStringBuf;++GU_API_DECL GuStringBuf*+gu_new_string_buf(GuPool* pool);++GU_API_DECL GuOut*+gu_string_buf_out(GuStringBuf* sb);++GU_API_DECL GuString+gu_string_buf_freeze(GuStringBuf* sb, GuPool* pool);++GU_API_DECL char*+gu_string_buf_data(GuStringBuf* sb);++GU_API_DECL size_t+gu_string_buf_length(GuStringBuf* sb);++GU_API_DECL void+gu_string_buf_flush(GuStringBuf* sb);++GU_API_DECL GuString+gu_format_string_v(const char* fmt, va_list args, GuPool* pool);++GU_API_DECL GuString+gu_format_string(GuPool* pool, const char* fmt, ...);++GU_API_DECL bool+gu_string_to_int(GuString s, int *res);++GU_API_DECL bool+gu_string_to_double(GuString s, double *res);++GU_API_DECL void+gu_double_to_string(double val, GuOut* out, GuExn* err);++GU_API_DECL bool+gu_string_is_prefix(GuString s1, GuString s2);++#endif // GU_STRING_H_++#if defined(GU_FUN_H_) && !defined(GU_STRING_H_FUN_)+#define GU_STRING_H_FUN_+GU_API_DECL extern GuEquality gu_string_equality[1];++GU_API_DECL extern GuOrder gu_string_order[1];+#endif++#if defined(GU_HASH_H_) && !defined(GU_STRING_H_HASH_)+#define GU_STRING_H_HASH_++GU_API_DECL GuHash+gu_string_hash(GuHash h, GuString s);++GU_API_DECL extern GuHasher gu_string_hasher[1];+#endif++#if defined(GU_SEQ_H_) && !defined(GU_STRING_H_SEQ_)+#define GU_STRING_H_SEQ_++typedef GuSeq GuStrings;+#endif+++#if defined(GU_MAP_H_) && !defined(GU_STRING_H_MAP_)+#define GU_STRING_H_MAP_++typedef GuMap GuStringMap;++#define gu_new_string_map(VAL_T, DEFAULT, POOL) \+ gu_new_map(GuString, gu_string_hasher, VAL_T, (DEFAULT), (POOL))++#endif+
@@ -0,0 +1,27 @@+#ifndef GU_SYSDEPS_H_+#define GU_SYSDEPS_H_++#if defined(__GNUC__) && !defined(__STRICT_ANSI__)+# define GU_GNUC+#endif++#ifdef GU_GNUC+# define GU_ALIGNOF __alignof+# define GU_GNUC_ATTR(x) __attribute__(( x ))+# if defined(__OPTIMIZE_SIZE__)+# define GU_OPTIMIZE_SIZE+# elif defined(__OPTIMIZE__)+# define GU_OPTIMIZE_SPEED+# endif+#else+# define GU_GNUC_ATTR(x)+#endif++#ifdef S_SPLINT_S+# define GU_SPLINT(x) %{ x %}+#else+# define GU_SPLINT(x)+#endif+++#endif // GU_SYSDEPS_H_
@@ -0,0 +1,4818 @@+#include <gu/ucs.h>+#include <gu/assert.h>+#include <stdlib.h>++GU_API bool+gu_char_is_valid(char c)+{+ if (c < 0) {+ return false;+ } else if (c < 64) {+ return UINT64_C(0xffffffef00003f81) & (UINT64_C(1) << c);+ }+#if CHAR_MAX > 127 // Let's avoid spurious warnings+ else if (c > 127) {+ return false;+ }+#endif + return UINT64_C(0x7ffffffefffffffe) & (UINT64_C(1) << (c - 64));+}++GU_API char+gu_ucs_char(GuUCS uc, GuExn* err)+{+ if (0 <= uc && uc <= 127) {+ char c = (char) uc;+ if (gu_char_is_valid(c)) {+ return c;+ }+ }+ gu_raise(err, GuUCSExn);+ return 0;+}++GU_API size_t+gu_str_to_ucs(const char* cbuf, size_t len, GuUCS* ubuf, GuExn* err)+{+ size_t n = 0;+ while (n < len) {+ char c = cbuf[n];+ if (!gu_char_is_valid(c)) {+ gu_raise(err, GuUCSExn);+ return n;+ }+ ubuf[n] = gu_char_ucs(c);+ n++;+ }+ return n;+}++GU_API size_t+gu_ucs_to_str(const GuUCS* ubuf, size_t len, char* cbuf, GuExn* err)+{+ size_t n = 0;+ while (n < len) {+ char c = gu_ucs_char(ubuf[n], err);+ if (!gu_ok(err)) {+ break;+ }+ cbuf[n] = c;+ n++;+ }+ return n;+}+++extern inline bool+gu_ucs_valid(GuUCS ucs);++GU_API GuUCS+gu_char_ucs(char c)+{+ gu_require(gu_char_is_valid(c));+ GuUCS u = (GuUCS) c;+ gu_ensure(u < 0x80);+ return u;+}++++/*----------------------------------------------------------------------+* The rest of this file is a modified version of WCsubst.c from +* the base library in Haskell. It encodes the Unicode classes and it +* should not be changed+----------------------------------------------------------------------*/++enum {+ NUMCAT_LU, /* Letter, Uppercase */+ NUMCAT_LL, /* Letter, Lowercase */+ NUMCAT_LT, /* Letter, Titlecase */+ NUMCAT_LM, /* Letter, Modifier */+ NUMCAT_LO, /* Letter, Other */+ NUMCAT_MN, /* Mark, Non-Spacing */+ NUMCAT_MC, /* Mark, Spacing Combining */+ NUMCAT_ME, /* Mark, Enclosing */+ NUMCAT_ND, /* Number, Decimal */+ NUMCAT_NL, /* Number, Letter */+ NUMCAT_NO, /* Number, Other */+ NUMCAT_PC, /* Punctuation, Connector */+ NUMCAT_PD, /* Punctuation, Dash */+ NUMCAT_PS, /* Punctuation, Open */+ NUMCAT_PE, /* Punctuation, Close */+ NUMCAT_PI, /* Punctuation, Initial quote */+ NUMCAT_PF, /* Punctuation, Final quote */+ NUMCAT_PO, /* Punctuation, Other */+ NUMCAT_SM, /* Symbol, Math */+ NUMCAT_SC, /* Symbol, Currency */+ NUMCAT_SK, /* Symbol, Modifier */+ NUMCAT_SO, /* Symbol, Other */+ NUMCAT_ZS, /* Separator, Space */+ NUMCAT_ZL, /* Separator, Line */+ NUMCAT_ZP, /* Separator, Paragraph */+ NUMCAT_CC, /* Other, Control */+ NUMCAT_CF, /* Other, Format */+ NUMCAT_CS, /* Other, Surrogate */+ NUMCAT_CO, /* Other, Private Use */+ NUMCAT_CN /* Other, Not Assigned */+};++struct _convrule_ +{ + unsigned int category;+ unsigned int catnumber;+ int possible;+ int updist;+ int lowdist; + int titledist;+};++struct _charblock_ +{ + int start;+ int length;+ const struct _convrule_ *rule;+};++#define GENCAT_ZP 67108864+#define GENCAT_MC 8388608+#define GENCAT_NO 131072+#define GENCAT_SK 1024+#define GENCAT_CO 268435456+#define GENCAT_ME 4194304+#define GENCAT_ND 256+#define GENCAT_PO 4+#define GENCAT_LT 524288+#define GENCAT_PC 2048+#define GENCAT_SM 64+#define GENCAT_ZS 2+#define GENCAT_CC 1+#define GENCAT_LU 512+#define GENCAT_PD 128+#define GENCAT_SO 8192+#define GENCAT_PE 32+#define GENCAT_CS 134217728+#define GENCAT_PF 262144+#define GENCAT_CF 65536+#define GENCAT_PS 16+#define GENCAT_SC 8+#define GENCAT_LL 4096+#define GENCAT_ZL 33554432+#define GENCAT_LM 1048576+#define GENCAT_PI 32768+#define GENCAT_NL 16777216+#define GENCAT_MN 2097152+#define GENCAT_LO 16384+#define MAX_UNI_CHAR 1114109+#define NUM_BLOCKS 3073+#define NUM_CONVBLOCKS 1276+#define NUM_SPACEBLOCKS 7+#define NUM_LAT1BLOCKS 63+#define NUM_RULES 181+static const struct _convrule_ rule169={GENCAT_LU, NUMCAT_LU, 1, 0, -35332, 0};+static const struct _convrule_ rule157={GENCAT_SO, NUMCAT_SO, 1, -26, 0, -26};+static const struct _convrule_ rule168={GENCAT_LL, NUMCAT_LL, 1, -7264, 0, -7264};+static const struct _convrule_ rule173={GENCAT_LU, NUMCAT_LU, 1, 0, -42315, 0};+static const struct _convrule_ rule129={GENCAT_LL, NUMCAT_LL, 1, 8, 0, 8};+static const struct _convrule_ rule88={GENCAT_LL, NUMCAT_LL, 1, 42258, 0, 42258};+static const struct _convrule_ rule20={GENCAT_LL, NUMCAT_LL, 0, 0, 0, 0};+static const struct _convrule_ rule76={GENCAT_LL, NUMCAT_LL, 1, 10743, 0, 10743};+static const struct _convrule_ rule61={GENCAT_LL, NUMCAT_LL, 1, 10783, 0, 10783};+static const struct _convrule_ rule37={GENCAT_LU, NUMCAT_LU, 1, 0, 211, 0};+static const struct _convrule_ rule80={GENCAT_LL, NUMCAT_LL, 1, -214, 0, -214};+static const struct _convrule_ rule75={GENCAT_LL, NUMCAT_LL, 1, -211, 0, -211};+static const struct _convrule_ rule121={GENCAT_LL, NUMCAT_LL, 1, -48, 0, -48};+static const struct _convrule_ rule52={GENCAT_LU, NUMCAT_LU, 1, 0, -56, 0};+static const struct _convrule_ rule135={GENCAT_LL, NUMCAT_LL, 1, 112, 0, 112};+static const struct _convrule_ rule71={GENCAT_LL, NUMCAT_LL, 1, -207, 0, -207};+static const struct _convrule_ rule123={GENCAT_LU, NUMCAT_LU, 1, 0, 7264, 0};+static const struct _convrule_ rule152={GENCAT_LU, NUMCAT_LU, 1, 0, 28, 0};+static const struct _convrule_ rule159={GENCAT_LU, NUMCAT_LU, 1, 0, -3814, 0};+static const struct _convrule_ rule45={GENCAT_LU, NUMCAT_LU, 1, 0, 219, 0};+static const struct _convrule_ rule7={GENCAT_PD, NUMCAT_PD, 0, 0, 0, 0};+static const struct _convrule_ rule180={GENCAT_LL, NUMCAT_LL, 1, -40, 0, -40};+static const struct _convrule_ rule97={GENCAT_LL, NUMCAT_LL, 1, -38, 0, -38};+static const struct _convrule_ rule95={GENCAT_LU, NUMCAT_LU, 1, 0, 64, 0};+static const struct _convrule_ rule1={GENCAT_ZS, NUMCAT_ZS, 0, 0, 0, 0};+static const struct _convrule_ rule29={GENCAT_LU, NUMCAT_LU, 1, 0, 210, 0};+static const struct _convrule_ rule35={GENCAT_LU, NUMCAT_LU, 1, 0, 207, 0};+static const struct _convrule_ rule154={GENCAT_NL, NUMCAT_NL, 1, 0, 16, 0};+static const struct _convrule_ rule13={GENCAT_SO, NUMCAT_SO, 0, 0, 0, 0};+static const struct _convrule_ rule149={GENCAT_LU, NUMCAT_LU, 1, 0, -7517, 0};+static const struct _convrule_ rule128={GENCAT_LU, NUMCAT_LU, 1, 0, -7615, 0};+static const struct _convrule_ rule98={GENCAT_LL, NUMCAT_LL, 1, -37, 0, -37};+static const struct _convrule_ rule2={GENCAT_PO, NUMCAT_PO, 0, 0, 0, 0};+static const struct _convrule_ rule69={GENCAT_LL, NUMCAT_LL, 1, 42319, 0, 42319};+static const struct _convrule_ rule56={GENCAT_LU, NUMCAT_LU, 1, 0, 10792, 0};+static const struct _convrule_ rule25={GENCAT_LL, NUMCAT_LL, 1, -232, 0, -232};+static const struct _convrule_ rule43={GENCAT_LU, NUMCAT_LU, 1, 0, 218, 0};+static const struct _convrule_ rule165={GENCAT_LU, NUMCAT_LU, 1, 0, -10783, 0};+static const struct _convrule_ rule133={GENCAT_LL, NUMCAT_LL, 1, 100, 0, 100};+static const struct _convrule_ rule96={GENCAT_LU, NUMCAT_LU, 1, 0, 63, 0};+static const struct _convrule_ rule90={GENCAT_MN, NUMCAT_MN, 0, 0, 0, 0};+static const struct _convrule_ rule12={GENCAT_LL, NUMCAT_LL, 1, -32, 0, -32};+static const struct _convrule_ rule93={GENCAT_LU, NUMCAT_LU, 1, 0, 38, 0};+static const struct _convrule_ rule99={GENCAT_LL, NUMCAT_LL, 1, -31, 0, -31};+static const struct _convrule_ rule105={GENCAT_LU, NUMCAT_LU, 0, 0, 0, 0};+static const struct _convrule_ rule11={GENCAT_PC, NUMCAT_PC, 0, 0, 0, 0};+static const struct _convrule_ rule175={GENCAT_LU, NUMCAT_LU, 1, 0, -42258, 0};+static const struct _convrule_ rule144={GENCAT_LU, NUMCAT_LU, 1, 0, -112, 0};+static const struct _convrule_ rule15={GENCAT_PI, NUMCAT_PI, 0, 0, 0, 0};+static const struct _convrule_ rule132={GENCAT_LL, NUMCAT_LL, 1, 86, 0, 86};+static const struct _convrule_ rule122={GENCAT_MC, NUMCAT_MC, 0, 0, 0, 0};+static const struct _convrule_ rule126={GENCAT_LL, NUMCAT_LL, 1, 3814, 0, 3814};+static const struct _convrule_ rule44={GENCAT_LU, NUMCAT_LU, 1, 0, 217, 0};+static const struct _convrule_ rule153={GENCAT_LL, NUMCAT_LL, 1, -28, 0, -28};+static const struct _convrule_ rule178={GENCAT_CO, NUMCAT_CO, 0, 0, 0, 0};+static const struct _convrule_ rule114={GENCAT_LL, NUMCAT_LL, 1, -96, 0, -96};+static const struct _convrule_ rule51={GENCAT_LU, NUMCAT_LU, 1, 0, -97, 0};+static const struct _convrule_ rule39={GENCAT_LL, NUMCAT_LL, 1, 163, 0, 163};+static const struct _convrule_ rule179={GENCAT_LU, NUMCAT_LU, 1, 0, 40, 0};+static const struct _convrule_ rule124={GENCAT_NL, NUMCAT_NL, 0, 0, 0, 0};+static const struct _convrule_ rule94={GENCAT_LU, NUMCAT_LU, 1, 0, 37, 0};+static const struct _convrule_ rule82={GENCAT_LL, NUMCAT_LL, 1, -218, 0, -218};+static const struct _convrule_ rule118={GENCAT_LU, NUMCAT_LU, 1, 0, 15, 0};+static const struct _convrule_ rule67={GENCAT_LL, NUMCAT_LL, 1, -202, 0, -202};+static const struct _convrule_ rule66={GENCAT_LL, NUMCAT_LL, 1, -205, 0, -205};+static const struct _convrule_ rule47={GENCAT_LU, NUMCAT_LU, 1, 0, 2, 1};+static const struct _convrule_ rule30={GENCAT_LU, NUMCAT_LU, 1, 0, 206, 0};+static const struct _convrule_ rule109={GENCAT_LL, NUMCAT_LL, 1, -86, 0, -86};+static const struct _convrule_ rule4={GENCAT_PS, NUMCAT_PS, 0, 0, 0, 0};+static const struct _convrule_ rule3={GENCAT_SC, NUMCAT_SC, 0, 0, 0, 0};+static const struct _convrule_ rule150={GENCAT_LU, NUMCAT_LU, 1, 0, -8383, 0};+static const struct _convrule_ rule120={GENCAT_LU, NUMCAT_LU, 1, 0, 48, 0};+static const struct _convrule_ rule14={GENCAT_LO, NUMCAT_LO, 0, 0, 0, 0};+static const struct _convrule_ rule18={GENCAT_LL, NUMCAT_LL, 1, 743, 0, 743};+static const struct _convrule_ rule147={GENCAT_ZL, NUMCAT_ZL, 0, 0, 0, 0};+static const struct _convrule_ rule142={GENCAT_LU, NUMCAT_LU, 1, 0, -86, 0};+static const struct _convrule_ rule171={GENCAT_LU, NUMCAT_LU, 1, 0, -42308, 0};+static const struct _convrule_ rule162={GENCAT_LL, NUMCAT_LL, 1, -10792, 0, -10792};+static const struct _convrule_ rule166={GENCAT_LU, NUMCAT_LU, 1, 0, -10782, 0};+static const struct _convrule_ rule139={GENCAT_LU, NUMCAT_LU, 1, 0, -74, 0};+static const struct _convrule_ rule24={GENCAT_LU, NUMCAT_LU, 1, 0, -199, 0};+static const struct _convrule_ rule143={GENCAT_LU, NUMCAT_LU, 1, 0, -100, 0};+static const struct _convrule_ rule125={GENCAT_LL, NUMCAT_LL, 1, 35332, 0, 35332};+static const struct _convrule_ rule141={GENCAT_LL, NUMCAT_LL, 1, -7205, 0, -7205};+static const struct _convrule_ rule138={GENCAT_LL, NUMCAT_LL, 1, 9, 0, 9};+static const struct _convrule_ rule27={GENCAT_LL, NUMCAT_LL, 1, -300, 0, -300};+static const struct _convrule_ rule172={GENCAT_LU, NUMCAT_LU, 1, 0, -42319, 0};+static const struct _convrule_ rule31={GENCAT_LU, NUMCAT_LU, 1, 0, 205, 0};+static const struct _convrule_ rule59={GENCAT_LU, NUMCAT_LU, 1, 0, 69, 0};+static const struct _convrule_ rule6={GENCAT_SM, NUMCAT_SM, 0, 0, 0, 0};+static const struct _convrule_ rule119={GENCAT_LL, NUMCAT_LL, 1, -15, 0, -15};+static const struct _convrule_ rule110={GENCAT_LL, NUMCAT_LL, 1, -80, 0, -80};+static const struct _convrule_ rule176={GENCAT_LU, NUMCAT_LU, 1, 0, -42282, 0};+static const struct _convrule_ rule151={GENCAT_LU, NUMCAT_LU, 1, 0, -8262, 0};+static const struct _convrule_ rule130={GENCAT_LU, NUMCAT_LU, 1, 0, -8, 0};+static const struct _convrule_ rule26={GENCAT_LU, NUMCAT_LU, 1, 0, -121, 0};+static const struct _convrule_ rule0={GENCAT_CC, NUMCAT_CC, 0, 0, 0, 0};+static const struct _convrule_ rule111={GENCAT_LL, NUMCAT_LL, 1, 7, 0, 7};+static const struct _convrule_ rule91={GENCAT_MN, NUMCAT_MN, 1, 84, 0, 84};+static const struct _convrule_ rule78={GENCAT_LL, NUMCAT_LL, 1, 10749, 0, 10749};+static const struct _convrule_ rule77={GENCAT_LL, NUMCAT_LL, 1, 42305, 0, 42305};+static const struct _convrule_ rule70={GENCAT_LL, NUMCAT_LL, 1, 42315, 0, 42315};+static const struct _convrule_ rule50={GENCAT_LL, NUMCAT_LL, 1, -79, 0, -79};+static const struct _convrule_ rule60={GENCAT_LU, NUMCAT_LU, 1, 0, 71, 0};+static const struct _convrule_ rule22={GENCAT_LU, NUMCAT_LU, 1, 0, 1, 0};+static const struct _convrule_ rule49={GENCAT_LL, NUMCAT_LL, 1, -2, 0, -1};+static const struct _convrule_ rule92={GENCAT_LU, NUMCAT_LU, 1, 0, 116, 0};+static const struct _convrule_ rule83={GENCAT_LL, NUMCAT_LL, 1, 42282, 0, 42282};+static const struct _convrule_ rule155={GENCAT_NL, NUMCAT_NL, 1, -16, 0, -16};+static const struct _convrule_ rule102={GENCAT_LU, NUMCAT_LU, 1, 0, 8, 0};+static const struct _convrule_ rule23={GENCAT_LL, NUMCAT_LL, 1, -1, 0, -1};+static const struct _convrule_ rule87={GENCAT_LL, NUMCAT_LL, 1, -219, 0, -219};+static const struct _convrule_ rule79={GENCAT_LL, NUMCAT_LL, 1, -213, 0, -213};+static const struct _convrule_ rule64={GENCAT_LL, NUMCAT_LL, 1, -210, 0, -210};+static const struct _convrule_ rule163={GENCAT_LU, NUMCAT_LU, 1, 0, -10780, 0};+static const struct _convrule_ rule86={GENCAT_LL, NUMCAT_LL, 1, -71, 0, -71};+static const struct _convrule_ rule84={GENCAT_LL, NUMCAT_LL, 1, -69, 0, -69};+static const struct _convrule_ rule32={GENCAT_LU, NUMCAT_LU, 1, 0, 79, 0};+static const struct _convrule_ rule115={GENCAT_LU, NUMCAT_LU, 1, 0, -7, 0};+static const struct _convrule_ rule74={GENCAT_LL, NUMCAT_LL, 1, -209, 0, -209};+static const struct _convrule_ rule177={GENCAT_CS, NUMCAT_CS, 0, 0, 0, 0};+static const struct _convrule_ rule140={GENCAT_LT, NUMCAT_LT, 1, 0, -9, 0};+static const struct _convrule_ rule57={GENCAT_LL, NUMCAT_LL, 1, 10815, 0, 10815};+static const struct _convrule_ rule72={GENCAT_LL, NUMCAT_LL, 1, 42280, 0, 42280};+static const struct _convrule_ rule34={GENCAT_LU, NUMCAT_LU, 1, 0, 203, 0};+static const struct _convrule_ rule63={GENCAT_LL, NUMCAT_LL, 1, 10782, 0, 10782};+static const struct _convrule_ rule170={GENCAT_LU, NUMCAT_LU, 1, 0, -42280, 0};+static const struct _convrule_ rule145={GENCAT_LU, NUMCAT_LU, 1, 0, -128, 0};+static const struct _convrule_ rule100={GENCAT_LL, NUMCAT_LL, 1, -64, 0, -64};+static const struct _convrule_ rule17={GENCAT_NO, NUMCAT_NO, 0, 0, 0, 0};+static const struct _convrule_ rule89={GENCAT_LM, NUMCAT_LM, 0, 0, 0, 0};+static const struct _convrule_ rule46={GENCAT_LL, NUMCAT_LL, 1, 56, 0, 56};+static const struct _convrule_ rule131={GENCAT_LL, NUMCAT_LL, 1, 74, 0, 74};+static const struct _convrule_ rule42={GENCAT_LU, NUMCAT_LU, 1, 0, 214, 0};+static const struct _convrule_ rule148={GENCAT_ZP, NUMCAT_ZP, 0, 0, 0, 0};+static const struct _convrule_ rule101={GENCAT_LL, NUMCAT_LL, 1, -63, 0, -63};+static const struct _convrule_ rule36={GENCAT_LL, NUMCAT_LL, 1, 97, 0, 97};+static const struct _convrule_ rule137={GENCAT_LT, NUMCAT_LT, 1, 0, -8, 0};+static const struct _convrule_ rule134={GENCAT_LL, NUMCAT_LL, 1, 128, 0, 128};+static const struct _convrule_ rule81={GENCAT_LL, NUMCAT_LL, 1, 10727, 0, 10727};+static const struct _convrule_ rule62={GENCAT_LL, NUMCAT_LL, 1, 10780, 0, 10780};+static const struct _convrule_ rule41={GENCAT_LL, NUMCAT_LL, 1, 130, 0, 130};+static const struct _convrule_ rule68={GENCAT_LL, NUMCAT_LL, 1, -203, 0, -203};+static const struct _convrule_ rule65={GENCAT_LL, NUMCAT_LL, 1, -206, 0, -206};+static const struct _convrule_ rule48={GENCAT_LT, NUMCAT_LT, 1, -1, 1, 0};+static const struct _convrule_ rule19={GENCAT_PF, NUMCAT_PF, 0, 0, 0, 0};+static const struct _convrule_ rule33={GENCAT_LU, NUMCAT_LU, 1, 0, 202, 0};+static const struct _convrule_ rule103={GENCAT_LL, NUMCAT_LL, 1, -62, 0, -62};+static const struct _convrule_ rule8={GENCAT_ND, NUMCAT_ND, 0, 0, 0, 0};+static const struct _convrule_ rule53={GENCAT_LU, NUMCAT_LU, 1, 0, -130, 0};+static const struct _convrule_ rule28={GENCAT_LL, NUMCAT_LL, 1, 195, 0, 195};+static const struct _convrule_ rule158={GENCAT_LU, NUMCAT_LU, 1, 0, -10743, 0};+static const struct _convrule_ rule127={GENCAT_LL, NUMCAT_LL, 1, -59, 0, -59};+static const struct _convrule_ rule113={GENCAT_LU, NUMCAT_LU, 1, 0, -60, 0};+static const struct _convrule_ rule108={GENCAT_LL, NUMCAT_LL, 1, -8, 0, -8};+static const struct _convrule_ rule73={GENCAT_LL, NUMCAT_LL, 1, 42308, 0, 42308};+static const struct _convrule_ rule40={GENCAT_LU, NUMCAT_LU, 1, 0, 213, 0};+static const struct _convrule_ rule136={GENCAT_LL, NUMCAT_LL, 1, 126, 0, 126};+static const struct _convrule_ rule116={GENCAT_LU, NUMCAT_LU, 1, 0, 80, 0};+static const struct _convrule_ rule55={GENCAT_LU, NUMCAT_LU, 1, 0, -163, 0};+static const struct _convrule_ rule174={GENCAT_LU, NUMCAT_LU, 1, 0, -42305, 0};+static const struct _convrule_ rule161={GENCAT_LL, NUMCAT_LL, 1, -10795, 0, -10795};+static const struct _convrule_ rule58={GENCAT_LU, NUMCAT_LU, 1, 0, -195, 0};+static const struct _convrule_ rule54={GENCAT_LU, NUMCAT_LU, 1, 0, 10795, 0};+static const struct _convrule_ rule107={GENCAT_LL, NUMCAT_LL, 1, -54, 0, -54};+static const struct _convrule_ rule146={GENCAT_LU, NUMCAT_LU, 1, 0, -126, 0};+static const struct _convrule_ rule104={GENCAT_LL, NUMCAT_LL, 1, -57, 0, -57};+static const struct _convrule_ rule21={GENCAT_LL, NUMCAT_LL, 1, 121, 0, 121};+static const struct _convrule_ rule156={GENCAT_SO, NUMCAT_SO, 1, 0, 26, 0};+static const struct _convrule_ rule85={GENCAT_LL, NUMCAT_LL, 1, -217, 0, -217};+static const struct _convrule_ rule16={GENCAT_CF, NUMCAT_CF, 0, 0, 0, 0};+static const struct _convrule_ rule112={GENCAT_LL, NUMCAT_LL, 1, -116, 0, -116};+static const struct _convrule_ rule38={GENCAT_LU, NUMCAT_LU, 1, 0, 209, 0};+static const struct _convrule_ rule10={GENCAT_SK, NUMCAT_SK, 0, 0, 0, 0};+static const struct _convrule_ rule167={GENCAT_LU, NUMCAT_LU, 1, 0, -10815, 0};+static const struct _convrule_ rule5={GENCAT_PE, NUMCAT_PE, 0, 0, 0, 0};+static const struct _convrule_ rule164={GENCAT_LU, NUMCAT_LU, 1, 0, -10749, 0};+static const struct _convrule_ rule117={GENCAT_ME, NUMCAT_ME, 0, 0, 0, 0};+static const struct _convrule_ rule106={GENCAT_LL, NUMCAT_LL, 1, -47, 0, -47};+static const struct _convrule_ rule160={GENCAT_LU, NUMCAT_LU, 1, 0, -10727, 0};+static const struct _convrule_ rule9={GENCAT_LU, NUMCAT_LU, 1, 0, 32, 0};+static const struct _charblock_ allchars[]={+ {0, 32, &rule0},+ {32, 1, &rule1},+ {33, 3, &rule2},+ {36, 1, &rule3},+ {37, 3, &rule2},+ {40, 1, &rule4},+ {41, 1, &rule5},+ {42, 1, &rule2},+ {43, 1, &rule6},+ {44, 1, &rule2},+ {45, 1, &rule7},+ {46, 2, &rule2},+ {48, 10, &rule8},+ {58, 2, &rule2},+ {60, 3, &rule6},+ {63, 2, &rule2},+ {65, 26, &rule9},+ {91, 1, &rule4},+ {92, 1, &rule2},+ {93, 1, &rule5},+ {94, 1, &rule10},+ {95, 1, &rule11},+ {96, 1, &rule10},+ {97, 26, &rule12},+ {123, 1, &rule4},+ {124, 1, &rule6},+ {125, 1, &rule5},+ {126, 1, &rule6},+ {127, 33, &rule0},+ {160, 1, &rule1},+ {161, 1, &rule2},+ {162, 4, &rule3},+ {166, 1, &rule13},+ {167, 1, &rule2},+ {168, 1, &rule10},+ {169, 1, &rule13},+ {170, 1, &rule14},+ {171, 1, &rule15},+ {172, 1, &rule6},+ {173, 1, &rule16},+ {174, 1, &rule13},+ {175, 1, &rule10},+ {176, 1, &rule13},+ {177, 1, &rule6},+ {178, 2, &rule17},+ {180, 1, &rule10},+ {181, 1, &rule18},+ {182, 2, &rule2},+ {184, 1, &rule10},+ {185, 1, &rule17},+ {186, 1, &rule14},+ {187, 1, &rule19},+ {188, 3, &rule17},+ {191, 1, &rule2},+ {192, 23, &rule9},+ {215, 1, &rule6},+ {216, 7, &rule9},+ {223, 1, &rule20},+ {224, 23, &rule12},+ {247, 1, &rule6},+ {248, 7, &rule12},+ {255, 1, &rule21},+ {256, 1, &rule22},+ {257, 1, &rule23},+ {258, 1, &rule22},+ {259, 1, &rule23},+ {260, 1, &rule22},+ {261, 1, &rule23},+ {262, 1, &rule22},+ {263, 1, &rule23},+ {264, 1, &rule22},+ {265, 1, &rule23},+ {266, 1, &rule22},+ {267, 1, &rule23},+ {268, 1, &rule22},+ {269, 1, &rule23},+ {270, 1, &rule22},+ {271, 1, &rule23},+ {272, 1, &rule22},+ {273, 1, &rule23},+ {274, 1, &rule22},+ {275, 1, &rule23},+ {276, 1, &rule22},+ {277, 1, &rule23},+ {278, 1, &rule22},+ {279, 1, &rule23},+ {280, 1, &rule22},+ {281, 1, &rule23},+ {282, 1, &rule22},+ {283, 1, &rule23},+ {284, 1, &rule22},+ {285, 1, &rule23},+ {286, 1, &rule22},+ {287, 1, &rule23},+ {288, 1, &rule22},+ {289, 1, &rule23},+ {290, 1, &rule22},+ {291, 1, &rule23},+ {292, 1, &rule22},+ {293, 1, &rule23},+ {294, 1, &rule22},+ {295, 1, &rule23},+ {296, 1, &rule22},+ {297, 1, &rule23},+ {298, 1, &rule22},+ {299, 1, &rule23},+ {300, 1, &rule22},+ {301, 1, &rule23},+ {302, 1, &rule22},+ {303, 1, &rule23},+ {304, 1, &rule24},+ {305, 1, &rule25},+ {306, 1, &rule22},+ {307, 1, &rule23},+ {308, 1, &rule22},+ {309, 1, &rule23},+ {310, 1, &rule22},+ {311, 1, &rule23},+ {312, 1, &rule20},+ {313, 1, &rule22},+ {314, 1, &rule23},+ {315, 1, &rule22},+ {316, 1, &rule23},+ {317, 1, &rule22},+ {318, 1, &rule23},+ {319, 1, &rule22},+ {320, 1, &rule23},+ {321, 1, &rule22},+ {322, 1, &rule23},+ {323, 1, &rule22},+ {324, 1, &rule23},+ {325, 1, &rule22},+ {326, 1, &rule23},+ {327, 1, &rule22},+ {328, 1, &rule23},+ {329, 1, &rule20},+ {330, 1, &rule22},+ {331, 1, &rule23},+ {332, 1, &rule22},+ {333, 1, &rule23},+ {334, 1, &rule22},+ {335, 1, &rule23},+ {336, 1, &rule22},+ {337, 1, &rule23},+ {338, 1, &rule22},+ {339, 1, &rule23},+ {340, 1, &rule22},+ {341, 1, &rule23},+ {342, 1, &rule22},+ {343, 1, &rule23},+ {344, 1, &rule22},+ {345, 1, &rule23},+ {346, 1, &rule22},+ {347, 1, &rule23},+ {348, 1, &rule22},+ {349, 1, &rule23},+ {350, 1, &rule22},+ {351, 1, &rule23},+ {352, 1, &rule22},+ {353, 1, &rule23},+ {354, 1, &rule22},+ {355, 1, &rule23},+ {356, 1, &rule22},+ {357, 1, &rule23},+ {358, 1, &rule22},+ {359, 1, &rule23},+ {360, 1, &rule22},+ {361, 1, &rule23},+ {362, 1, &rule22},+ {363, 1, &rule23},+ {364, 1, &rule22},+ {365, 1, &rule23},+ {366, 1, &rule22},+ {367, 1, &rule23},+ {368, 1, &rule22},+ {369, 1, &rule23},+ {370, 1, &rule22},+ {371, 1, &rule23},+ {372, 1, &rule22},+ {373, 1, &rule23},+ {374, 1, &rule22},+ {375, 1, &rule23},+ {376, 1, &rule26},+ {377, 1, &rule22},+ {378, 1, &rule23},+ {379, 1, &rule22},+ {380, 1, &rule23},+ {381, 1, &rule22},+ {382, 1, &rule23},+ {383, 1, &rule27},+ {384, 1, &rule28},+ {385, 1, &rule29},+ {386, 1, &rule22},+ {387, 1, &rule23},+ {388, 1, &rule22},+ {389, 1, &rule23},+ {390, 1, &rule30},+ {391, 1, &rule22},+ {392, 1, &rule23},+ {393, 2, &rule31},+ {395, 1, &rule22},+ {396, 1, &rule23},+ {397, 1, &rule20},+ {398, 1, &rule32},+ {399, 1, &rule33},+ {400, 1, &rule34},+ {401, 1, &rule22},+ {402, 1, &rule23},+ {403, 1, &rule31},+ {404, 1, &rule35},+ {405, 1, &rule36},+ {406, 1, &rule37},+ {407, 1, &rule38},+ {408, 1, &rule22},+ {409, 1, &rule23},+ {410, 1, &rule39},+ {411, 1, &rule20},+ {412, 1, &rule37},+ {413, 1, &rule40},+ {414, 1, &rule41},+ {415, 1, &rule42},+ {416, 1, &rule22},+ {417, 1, &rule23},+ {418, 1, &rule22},+ {419, 1, &rule23},+ {420, 1, &rule22},+ {421, 1, &rule23},+ {422, 1, &rule43},+ {423, 1, &rule22},+ {424, 1, &rule23},+ {425, 1, &rule43},+ {426, 2, &rule20},+ {428, 1, &rule22},+ {429, 1, &rule23},+ {430, 1, &rule43},+ {431, 1, &rule22},+ {432, 1, &rule23},+ {433, 2, &rule44},+ {435, 1, &rule22},+ {436, 1, &rule23},+ {437, 1, &rule22},+ {438, 1, &rule23},+ {439, 1, &rule45},+ {440, 1, &rule22},+ {441, 1, &rule23},+ {442, 1, &rule20},+ {443, 1, &rule14},+ {444, 1, &rule22},+ {445, 1, &rule23},+ {446, 1, &rule20},+ {447, 1, &rule46},+ {448, 4, &rule14},+ {452, 1, &rule47},+ {453, 1, &rule48},+ {454, 1, &rule49},+ {455, 1, &rule47},+ {456, 1, &rule48},+ {457, 1, &rule49},+ {458, 1, &rule47},+ {459, 1, &rule48},+ {460, 1, &rule49},+ {461, 1, &rule22},+ {462, 1, &rule23},+ {463, 1, &rule22},+ {464, 1, &rule23},+ {465, 1, &rule22},+ {466, 1, &rule23},+ {467, 1, &rule22},+ {468, 1, &rule23},+ {469, 1, &rule22},+ {470, 1, &rule23},+ {471, 1, &rule22},+ {472, 1, &rule23},+ {473, 1, &rule22},+ {474, 1, &rule23},+ {475, 1, &rule22},+ {476, 1, &rule23},+ {477, 1, &rule50},+ {478, 1, &rule22},+ {479, 1, &rule23},+ {480, 1, &rule22},+ {481, 1, &rule23},+ {482, 1, &rule22},+ {483, 1, &rule23},+ {484, 1, &rule22},+ {485, 1, &rule23},+ {486, 1, &rule22},+ {487, 1, &rule23},+ {488, 1, &rule22},+ {489, 1, &rule23},+ {490, 1, &rule22},+ {491, 1, &rule23},+ {492, 1, &rule22},+ {493, 1, &rule23},+ {494, 1, &rule22},+ {495, 1, &rule23},+ {496, 1, &rule20},+ {497, 1, &rule47},+ {498, 1, &rule48},+ {499, 1, &rule49},+ {500, 1, &rule22},+ {501, 1, &rule23},+ {502, 1, &rule51},+ {503, 1, &rule52},+ {504, 1, &rule22},+ {505, 1, &rule23},+ {506, 1, &rule22},+ {507, 1, &rule23},+ {508, 1, &rule22},+ {509, 1, &rule23},+ {510, 1, &rule22},+ {511, 1, &rule23},+ {512, 1, &rule22},+ {513, 1, &rule23},+ {514, 1, &rule22},+ {515, 1, &rule23},+ {516, 1, &rule22},+ {517, 1, &rule23},+ {518, 1, &rule22},+ {519, 1, &rule23},+ {520, 1, &rule22},+ {521, 1, &rule23},+ {522, 1, &rule22},+ {523, 1, &rule23},+ {524, 1, &rule22},+ {525, 1, &rule23},+ {526, 1, &rule22},+ {527, 1, &rule23},+ {528, 1, &rule22},+ {529, 1, &rule23},+ {530, 1, &rule22},+ {531, 1, &rule23},+ {532, 1, &rule22},+ {533, 1, &rule23},+ {534, 1, &rule22},+ {535, 1, &rule23},+ {536, 1, &rule22},+ {537, 1, &rule23},+ {538, 1, &rule22},+ {539, 1, &rule23},+ {540, 1, &rule22},+ {541, 1, &rule23},+ {542, 1, &rule22},+ {543, 1, &rule23},+ {544, 1, &rule53},+ {545, 1, &rule20},+ {546, 1, &rule22},+ {547, 1, &rule23},+ {548, 1, &rule22},+ {549, 1, &rule23},+ {550, 1, &rule22},+ {551, 1, &rule23},+ {552, 1, &rule22},+ {553, 1, &rule23},+ {554, 1, &rule22},+ {555, 1, &rule23},+ {556, 1, &rule22},+ {557, 1, &rule23},+ {558, 1, &rule22},+ {559, 1, &rule23},+ {560, 1, &rule22},+ {561, 1, &rule23},+ {562, 1, &rule22},+ {563, 1, &rule23},+ {564, 6, &rule20},+ {570, 1, &rule54},+ {571, 1, &rule22},+ {572, 1, &rule23},+ {573, 1, &rule55},+ {574, 1, &rule56},+ {575, 2, &rule57},+ {577, 1, &rule22},+ {578, 1, &rule23},+ {579, 1, &rule58},+ {580, 1, &rule59},+ {581, 1, &rule60},+ {582, 1, &rule22},+ {583, 1, &rule23},+ {584, 1, &rule22},+ {585, 1, &rule23},+ {586, 1, &rule22},+ {587, 1, &rule23},+ {588, 1, &rule22},+ {589, 1, &rule23},+ {590, 1, &rule22},+ {591, 1, &rule23},+ {592, 1, &rule61},+ {593, 1, &rule62},+ {594, 1, &rule63},+ {595, 1, &rule64},+ {596, 1, &rule65},+ {597, 1, &rule20},+ {598, 2, &rule66},+ {600, 1, &rule20},+ {601, 1, &rule67},+ {602, 1, &rule20},+ {603, 1, &rule68},+ {604, 1, &rule69},+ {605, 3, &rule20},+ {608, 1, &rule66},+ {609, 1, &rule70},+ {610, 1, &rule20},+ {611, 1, &rule71},+ {612, 1, &rule20},+ {613, 1, &rule72},+ {614, 1, &rule73},+ {615, 1, &rule20},+ {616, 1, &rule74},+ {617, 1, &rule75},+ {618, 1, &rule20},+ {619, 1, &rule76},+ {620, 1, &rule77},+ {621, 2, &rule20},+ {623, 1, &rule75},+ {624, 1, &rule20},+ {625, 1, &rule78},+ {626, 1, &rule79},+ {627, 2, &rule20},+ {629, 1, &rule80},+ {630, 7, &rule20},+ {637, 1, &rule81},+ {638, 2, &rule20},+ {640, 1, &rule82},+ {641, 2, &rule20},+ {643, 1, &rule82},+ {644, 3, &rule20},+ {647, 1, &rule83},+ {648, 1, &rule82},+ {649, 1, &rule84},+ {650, 2, &rule85},+ {652, 1, &rule86},+ {653, 5, &rule20},+ {658, 1, &rule87},+ {659, 1, &rule20},+ {660, 1, &rule14},+ {661, 9, &rule20},+ {670, 1, &rule88},+ {671, 17, &rule20},+ {688, 18, &rule89},+ {706, 4, &rule10},+ {710, 12, &rule89},+ {722, 14, &rule10},+ {736, 5, &rule89},+ {741, 7, &rule10},+ {748, 1, &rule89},+ {749, 1, &rule10},+ {750, 1, &rule89},+ {751, 17, &rule10},+ {768, 69, &rule90},+ {837, 1, &rule91},+ {838, 42, &rule90},+ {880, 1, &rule22},+ {881, 1, &rule23},+ {882, 1, &rule22},+ {883, 1, &rule23},+ {884, 1, &rule89},+ {885, 1, &rule10},+ {886, 1, &rule22},+ {887, 1, &rule23},+ {890, 1, &rule89},+ {891, 3, &rule41},+ {894, 1, &rule2},+ {895, 1, &rule92},+ {900, 2, &rule10},+ {902, 1, &rule93},+ {903, 1, &rule2},+ {904, 3, &rule94},+ {908, 1, &rule95},+ {910, 2, &rule96},+ {912, 1, &rule20},+ {913, 17, &rule9},+ {931, 9, &rule9},+ {940, 1, &rule97},+ {941, 3, &rule98},+ {944, 1, &rule20},+ {945, 17, &rule12},+ {962, 1, &rule99},+ {963, 9, &rule12},+ {972, 1, &rule100},+ {973, 2, &rule101},+ {975, 1, &rule102},+ {976, 1, &rule103},+ {977, 1, &rule104},+ {978, 3, &rule105},+ {981, 1, &rule106},+ {982, 1, &rule107},+ {983, 1, &rule108},+ {984, 1, &rule22},+ {985, 1, &rule23},+ {986, 1, &rule22},+ {987, 1, &rule23},+ {988, 1, &rule22},+ {989, 1, &rule23},+ {990, 1, &rule22},+ {991, 1, &rule23},+ {992, 1, &rule22},+ {993, 1, &rule23},+ {994, 1, &rule22},+ {995, 1, &rule23},+ {996, 1, &rule22},+ {997, 1, &rule23},+ {998, 1, &rule22},+ {999, 1, &rule23},+ {1000, 1, &rule22},+ {1001, 1, &rule23},+ {1002, 1, &rule22},+ {1003, 1, &rule23},+ {1004, 1, &rule22},+ {1005, 1, &rule23},+ {1006, 1, &rule22},+ {1007, 1, &rule23},+ {1008, 1, &rule109},+ {1009, 1, &rule110},+ {1010, 1, &rule111},+ {1011, 1, &rule112},+ {1012, 1, &rule113},+ {1013, 1, &rule114},+ {1014, 1, &rule6},+ {1015, 1, &rule22},+ {1016, 1, &rule23},+ {1017, 1, &rule115},+ {1018, 1, &rule22},+ {1019, 1, &rule23},+ {1020, 1, &rule20},+ {1021, 3, &rule53},+ {1024, 16, &rule116},+ {1040, 32, &rule9},+ {1072, 32, &rule12},+ {1104, 16, &rule110},+ {1120, 1, &rule22},+ {1121, 1, &rule23},+ {1122, 1, &rule22},+ {1123, 1, &rule23},+ {1124, 1, &rule22},+ {1125, 1, &rule23},+ {1126, 1, &rule22},+ {1127, 1, &rule23},+ {1128, 1, &rule22},+ {1129, 1, &rule23},+ {1130, 1, &rule22},+ {1131, 1, &rule23},+ {1132, 1, &rule22},+ {1133, 1, &rule23},+ {1134, 1, &rule22},+ {1135, 1, &rule23},+ {1136, 1, &rule22},+ {1137, 1, &rule23},+ {1138, 1, &rule22},+ {1139, 1, &rule23},+ {1140, 1, &rule22},+ {1141, 1, &rule23},+ {1142, 1, &rule22},+ {1143, 1, &rule23},+ {1144, 1, &rule22},+ {1145, 1, &rule23},+ {1146, 1, &rule22},+ {1147, 1, &rule23},+ {1148, 1, &rule22},+ {1149, 1, &rule23},+ {1150, 1, &rule22},+ {1151, 1, &rule23},+ {1152, 1, &rule22},+ {1153, 1, &rule23},+ {1154, 1, &rule13},+ {1155, 5, &rule90},+ {1160, 2, &rule117},+ {1162, 1, &rule22},+ {1163, 1, &rule23},+ {1164, 1, &rule22},+ {1165, 1, &rule23},+ {1166, 1, &rule22},+ {1167, 1, &rule23},+ {1168, 1, &rule22},+ {1169, 1, &rule23},+ {1170, 1, &rule22},+ {1171, 1, &rule23},+ {1172, 1, &rule22},+ {1173, 1, &rule23},+ {1174, 1, &rule22},+ {1175, 1, &rule23},+ {1176, 1, &rule22},+ {1177, 1, &rule23},+ {1178, 1, &rule22},+ {1179, 1, &rule23},+ {1180, 1, &rule22},+ {1181, 1, &rule23},+ {1182, 1, &rule22},+ {1183, 1, &rule23},+ {1184, 1, &rule22},+ {1185, 1, &rule23},+ {1186, 1, &rule22},+ {1187, 1, &rule23},+ {1188, 1, &rule22},+ {1189, 1, &rule23},+ {1190, 1, &rule22},+ {1191, 1, &rule23},+ {1192, 1, &rule22},+ {1193, 1, &rule23},+ {1194, 1, &rule22},+ {1195, 1, &rule23},+ {1196, 1, &rule22},+ {1197, 1, &rule23},+ {1198, 1, &rule22},+ {1199, 1, &rule23},+ {1200, 1, &rule22},+ {1201, 1, &rule23},+ {1202, 1, &rule22},+ {1203, 1, &rule23},+ {1204, 1, &rule22},+ {1205, 1, &rule23},+ {1206, 1, &rule22},+ {1207, 1, &rule23},+ {1208, 1, &rule22},+ {1209, 1, &rule23},+ {1210, 1, &rule22},+ {1211, 1, &rule23},+ {1212, 1, &rule22},+ {1213, 1, &rule23},+ {1214, 1, &rule22},+ {1215, 1, &rule23},+ {1216, 1, &rule118},+ {1217, 1, &rule22},+ {1218, 1, &rule23},+ {1219, 1, &rule22},+ {1220, 1, &rule23},+ {1221, 1, &rule22},+ {1222, 1, &rule23},+ {1223, 1, &rule22},+ {1224, 1, &rule23},+ {1225, 1, &rule22},+ {1226, 1, &rule23},+ {1227, 1, &rule22},+ {1228, 1, &rule23},+ {1229, 1, &rule22},+ {1230, 1, &rule23},+ {1231, 1, &rule119},+ {1232, 1, &rule22},+ {1233, 1, &rule23},+ {1234, 1, &rule22},+ {1235, 1, &rule23},+ {1236, 1, &rule22},+ {1237, 1, &rule23},+ {1238, 1, &rule22},+ {1239, 1, &rule23},+ {1240, 1, &rule22},+ {1241, 1, &rule23},+ {1242, 1, &rule22},+ {1243, 1, &rule23},+ {1244, 1, &rule22},+ {1245, 1, &rule23},+ {1246, 1, &rule22},+ {1247, 1, &rule23},+ {1248, 1, &rule22},+ {1249, 1, &rule23},+ {1250, 1, &rule22},+ {1251, 1, &rule23},+ {1252, 1, &rule22},+ {1253, 1, &rule23},+ {1254, 1, &rule22},+ {1255, 1, &rule23},+ {1256, 1, &rule22},+ {1257, 1, &rule23},+ {1258, 1, &rule22},+ {1259, 1, &rule23},+ {1260, 1, &rule22},+ {1261, 1, &rule23},+ {1262, 1, &rule22},+ {1263, 1, &rule23},+ {1264, 1, &rule22},+ {1265, 1, &rule23},+ {1266, 1, &rule22},+ {1267, 1, &rule23},+ {1268, 1, &rule22},+ {1269, 1, &rule23},+ {1270, 1, &rule22},+ {1271, 1, &rule23},+ {1272, 1, &rule22},+ {1273, 1, &rule23},+ {1274, 1, &rule22},+ {1275, 1, &rule23},+ {1276, 1, &rule22},+ {1277, 1, &rule23},+ {1278, 1, &rule22},+ {1279, 1, &rule23},+ {1280, 1, &rule22},+ {1281, 1, &rule23},+ {1282, 1, &rule22},+ {1283, 1, &rule23},+ {1284, 1, &rule22},+ {1285, 1, &rule23},+ {1286, 1, &rule22},+ {1287, 1, &rule23},+ {1288, 1, &rule22},+ {1289, 1, &rule23},+ {1290, 1, &rule22},+ {1291, 1, &rule23},+ {1292, 1, &rule22},+ {1293, 1, &rule23},+ {1294, 1, &rule22},+ {1295, 1, &rule23},+ {1296, 1, &rule22},+ {1297, 1, &rule23},+ {1298, 1, &rule22},+ {1299, 1, &rule23},+ {1300, 1, &rule22},+ {1301, 1, &rule23},+ {1302, 1, &rule22},+ {1303, 1, &rule23},+ {1304, 1, &rule22},+ {1305, 1, &rule23},+ {1306, 1, &rule22},+ {1307, 1, &rule23},+ {1308, 1, &rule22},+ {1309, 1, &rule23},+ {1310, 1, &rule22},+ {1311, 1, &rule23},+ {1312, 1, &rule22},+ {1313, 1, &rule23},+ {1314, 1, &rule22},+ {1315, 1, &rule23},+ {1316, 1, &rule22},+ {1317, 1, &rule23},+ {1318, 1, &rule22},+ {1319, 1, &rule23},+ {1320, 1, &rule22},+ {1321, 1, &rule23},+ {1322, 1, &rule22},+ {1323, 1, &rule23},+ {1324, 1, &rule22},+ {1325, 1, &rule23},+ {1326, 1, &rule22},+ {1327, 1, &rule23},+ {1329, 38, &rule120},+ {1369, 1, &rule89},+ {1370, 6, &rule2},+ {1377, 38, &rule121},+ {1415, 1, &rule20},+ {1417, 1, &rule2},+ {1418, 1, &rule7},+ {1421, 2, &rule13},+ {1423, 1, &rule3},+ {1425, 45, &rule90},+ {1470, 1, &rule7},+ {1471, 1, &rule90},+ {1472, 1, &rule2},+ {1473, 2, &rule90},+ {1475, 1, &rule2},+ {1476, 2, &rule90},+ {1478, 1, &rule2},+ {1479, 1, &rule90},+ {1488, 27, &rule14},+ {1520, 3, &rule14},+ {1523, 2, &rule2},+ {1536, 6, &rule16},+ {1542, 3, &rule6},+ {1545, 2, &rule2},+ {1547, 1, &rule3},+ {1548, 2, &rule2},+ {1550, 2, &rule13},+ {1552, 11, &rule90},+ {1563, 1, &rule2},+ {1564, 1, &rule16},+ {1566, 2, &rule2},+ {1568, 32, &rule14},+ {1600, 1, &rule89},+ {1601, 10, &rule14},+ {1611, 21, &rule90},+ {1632, 10, &rule8},+ {1642, 4, &rule2},+ {1646, 2, &rule14},+ {1648, 1, &rule90},+ {1649, 99, &rule14},+ {1748, 1, &rule2},+ {1749, 1, &rule14},+ {1750, 7, &rule90},+ {1757, 1, &rule16},+ {1758, 1, &rule13},+ {1759, 6, &rule90},+ {1765, 2, &rule89},+ {1767, 2, &rule90},+ {1769, 1, &rule13},+ {1770, 4, &rule90},+ {1774, 2, &rule14},+ {1776, 10, &rule8},+ {1786, 3, &rule14},+ {1789, 2, &rule13},+ {1791, 1, &rule14},+ {1792, 14, &rule2},+ {1807, 1, &rule16},+ {1808, 1, &rule14},+ {1809, 1, &rule90},+ {1810, 30, &rule14},+ {1840, 27, &rule90},+ {1869, 89, &rule14},+ {1958, 11, &rule90},+ {1969, 1, &rule14},+ {1984, 10, &rule8},+ {1994, 33, &rule14},+ {2027, 9, &rule90},+ {2036, 2, &rule89},+ {2038, 1, &rule13},+ {2039, 3, &rule2},+ {2042, 1, &rule89},+ {2048, 22, &rule14},+ {2070, 4, &rule90},+ {2074, 1, &rule89},+ {2075, 9, &rule90},+ {2084, 1, &rule89},+ {2085, 3, &rule90},+ {2088, 1, &rule89},+ {2089, 5, &rule90},+ {2096, 15, &rule2},+ {2112, 25, &rule14},+ {2137, 3, &rule90},+ {2142, 1, &rule2},+ {2208, 19, &rule14},+ {2276, 31, &rule90},+ {2307, 1, &rule122},+ {2308, 54, &rule14},+ {2362, 1, &rule90},+ {2363, 1, &rule122},+ {2364, 1, &rule90},+ {2365, 1, &rule14},+ {2366, 3, &rule122},+ {2369, 8, &rule90},+ {2377, 4, &rule122},+ {2381, 1, &rule90},+ {2382, 2, &rule122},+ {2384, 1, &rule14},+ {2385, 7, &rule90},+ {2392, 10, &rule14},+ {2402, 2, &rule90},+ {2404, 2, &rule2},+ {2406, 10, &rule8},+ {2416, 1, &rule2},+ {2417, 1, &rule89},+ {2418, 15, &rule14},+ {2433, 1, &rule90},+ {2434, 2, &rule122},+ {2437, 8, &rule14},+ {2447, 2, &rule14},+ {2451, 22, &rule14},+ {2474, 7, &rule14},+ {2482, 1, &rule14},+ {2486, 4, &rule14},+ {2492, 1, &rule90},+ {2493, 1, &rule14},+ {2494, 3, &rule122},+ {2497, 4, &rule90},+ {2503, 2, &rule122},+ {2507, 2, &rule122},+ {2509, 1, &rule90},+ {2510, 1, &rule14},+ {2519, 1, &rule122},+ {2524, 2, &rule14},+ {2527, 3, &rule14},+ {2530, 2, &rule90},+ {2534, 10, &rule8},+ {2544, 2, &rule14},+ {2546, 2, &rule3},+ {2548, 6, &rule17},+ {2554, 1, &rule13},+ {2555, 1, &rule3},+ {2561, 2, &rule90},+ {2563, 1, &rule122},+ {2565, 6, &rule14},+ {2575, 2, &rule14},+ {2579, 22, &rule14},+ {2602, 7, &rule14},+ {2610, 2, &rule14},+ {2613, 2, &rule14},+ {2616, 2, &rule14},+ {2620, 1, &rule90},+ {2622, 3, &rule122},+ {2625, 2, &rule90},+ {2631, 2, &rule90},+ {2635, 3, &rule90},+ {2641, 1, &rule90},+ {2649, 4, &rule14},+ {2654, 1, &rule14},+ {2662, 10, &rule8},+ {2672, 2, &rule90},+ {2674, 3, &rule14},+ {2677, 1, &rule90},+ {2689, 2, &rule90},+ {2691, 1, &rule122},+ {2693, 9, &rule14},+ {2703, 3, &rule14},+ {2707, 22, &rule14},+ {2730, 7, &rule14},+ {2738, 2, &rule14},+ {2741, 5, &rule14},+ {2748, 1, &rule90},+ {2749, 1, &rule14},+ {2750, 3, &rule122},+ {2753, 5, &rule90},+ {2759, 2, &rule90},+ {2761, 1, &rule122},+ {2763, 2, &rule122},+ {2765, 1, &rule90},+ {2768, 1, &rule14},+ {2784, 2, &rule14},+ {2786, 2, &rule90},+ {2790, 10, &rule8},+ {2800, 1, &rule2},+ {2801, 1, &rule3},+ {2817, 1, &rule90},+ {2818, 2, &rule122},+ {2821, 8, &rule14},+ {2831, 2, &rule14},+ {2835, 22, &rule14},+ {2858, 7, &rule14},+ {2866, 2, &rule14},+ {2869, 5, &rule14},+ {2876, 1, &rule90},+ {2877, 1, &rule14},+ {2878, 1, &rule122},+ {2879, 1, &rule90},+ {2880, 1, &rule122},+ {2881, 4, &rule90},+ {2887, 2, &rule122},+ {2891, 2, &rule122},+ {2893, 1, &rule90},+ {2902, 1, &rule90},+ {2903, 1, &rule122},+ {2908, 2, &rule14},+ {2911, 3, &rule14},+ {2914, 2, &rule90},+ {2918, 10, &rule8},+ {2928, 1, &rule13},+ {2929, 1, &rule14},+ {2930, 6, &rule17},+ {2946, 1, &rule90},+ {2947, 1, &rule14},+ {2949, 6, &rule14},+ {2958, 3, &rule14},+ {2962, 4, &rule14},+ {2969, 2, &rule14},+ {2972, 1, &rule14},+ {2974, 2, &rule14},+ {2979, 2, &rule14},+ {2984, 3, &rule14},+ {2990, 12, &rule14},+ {3006, 2, &rule122},+ {3008, 1, &rule90},+ {3009, 2, &rule122},+ {3014, 3, &rule122},+ {3018, 3, &rule122},+ {3021, 1, &rule90},+ {3024, 1, &rule14},+ {3031, 1, &rule122},+ {3046, 10, &rule8},+ {3056, 3, &rule17},+ {3059, 6, &rule13},+ {3065, 1, &rule3},+ {3066, 1, &rule13},+ {3072, 1, &rule90},+ {3073, 3, &rule122},+ {3077, 8, &rule14},+ {3086, 3, &rule14},+ {3090, 23, &rule14},+ {3114, 16, &rule14},+ {3133, 1, &rule14},+ {3134, 3, &rule90},+ {3137, 4, &rule122},+ {3142, 3, &rule90},+ {3146, 4, &rule90},+ {3157, 2, &rule90},+ {3160, 2, &rule14},+ {3168, 2, &rule14},+ {3170, 2, &rule90},+ {3174, 10, &rule8},+ {3192, 7, &rule17},+ {3199, 1, &rule13},+ {3201, 1, &rule90},+ {3202, 2, &rule122},+ {3205, 8, &rule14},+ {3214, 3, &rule14},+ {3218, 23, &rule14},+ {3242, 10, &rule14},+ {3253, 5, &rule14},+ {3260, 1, &rule90},+ {3261, 1, &rule14},+ {3262, 1, &rule122},+ {3263, 1, &rule90},+ {3264, 5, &rule122},+ {3270, 1, &rule90},+ {3271, 2, &rule122},+ {3274, 2, &rule122},+ {3276, 2, &rule90},+ {3285, 2, &rule122},+ {3294, 1, &rule14},+ {3296, 2, &rule14},+ {3298, 2, &rule90},+ {3302, 10, &rule8},+ {3313, 2, &rule14},+ {3329, 1, &rule90},+ {3330, 2, &rule122},+ {3333, 8, &rule14},+ {3342, 3, &rule14},+ {3346, 41, &rule14},+ {3389, 1, &rule14},+ {3390, 3, &rule122},+ {3393, 4, &rule90},+ {3398, 3, &rule122},+ {3402, 3, &rule122},+ {3405, 1, &rule90},+ {3406, 1, &rule14},+ {3415, 1, &rule122},+ {3424, 2, &rule14},+ {3426, 2, &rule90},+ {3430, 10, &rule8},+ {3440, 6, &rule17},+ {3449, 1, &rule13},+ {3450, 6, &rule14},+ {3458, 2, &rule122},+ {3461, 18, &rule14},+ {3482, 24, &rule14},+ {3507, 9, &rule14},+ {3517, 1, &rule14},+ {3520, 7, &rule14},+ {3530, 1, &rule90},+ {3535, 3, &rule122},+ {3538, 3, &rule90},+ {3542, 1, &rule90},+ {3544, 8, &rule122},+ {3558, 10, &rule8},+ {3570, 2, &rule122},+ {3572, 1, &rule2},+ {3585, 48, &rule14},+ {3633, 1, &rule90},+ {3634, 2, &rule14},+ {3636, 7, &rule90},+ {3647, 1, &rule3},+ {3648, 6, &rule14},+ {3654, 1, &rule89},+ {3655, 8, &rule90},+ {3663, 1, &rule2},+ {3664, 10, &rule8},+ {3674, 2, &rule2},+ {3713, 2, &rule14},+ {3716, 1, &rule14},+ {3719, 2, &rule14},+ {3722, 1, &rule14},+ {3725, 1, &rule14},+ {3732, 4, &rule14},+ {3737, 7, &rule14},+ {3745, 3, &rule14},+ {3749, 1, &rule14},+ {3751, 1, &rule14},+ {3754, 2, &rule14},+ {3757, 4, &rule14},+ {3761, 1, &rule90},+ {3762, 2, &rule14},+ {3764, 6, &rule90},+ {3771, 2, &rule90},+ {3773, 1, &rule14},+ {3776, 5, &rule14},+ {3782, 1, &rule89},+ {3784, 6, &rule90},+ {3792, 10, &rule8},+ {3804, 4, &rule14},+ {3840, 1, &rule14},+ {3841, 3, &rule13},+ {3844, 15, &rule2},+ {3859, 1, &rule13},+ {3860, 1, &rule2},+ {3861, 3, &rule13},+ {3864, 2, &rule90},+ {3866, 6, &rule13},+ {3872, 10, &rule8},+ {3882, 10, &rule17},+ {3892, 1, &rule13},+ {3893, 1, &rule90},+ {3894, 1, &rule13},+ {3895, 1, &rule90},+ {3896, 1, &rule13},+ {3897, 1, &rule90},+ {3898, 1, &rule4},+ {3899, 1, &rule5},+ {3900, 1, &rule4},+ {3901, 1, &rule5},+ {3902, 2, &rule122},+ {3904, 8, &rule14},+ {3913, 36, &rule14},+ {3953, 14, &rule90},+ {3967, 1, &rule122},+ {3968, 5, &rule90},+ {3973, 1, &rule2},+ {3974, 2, &rule90},+ {3976, 5, &rule14},+ {3981, 11, &rule90},+ {3993, 36, &rule90},+ {4030, 8, &rule13},+ {4038, 1, &rule90},+ {4039, 6, &rule13},+ {4046, 2, &rule13},+ {4048, 5, &rule2},+ {4053, 4, &rule13},+ {4057, 2, &rule2},+ {4096, 43, &rule14},+ {4139, 2, &rule122},+ {4141, 4, &rule90},+ {4145, 1, &rule122},+ {4146, 6, &rule90},+ {4152, 1, &rule122},+ {4153, 2, &rule90},+ {4155, 2, &rule122},+ {4157, 2, &rule90},+ {4159, 1, &rule14},+ {4160, 10, &rule8},+ {4170, 6, &rule2},+ {4176, 6, &rule14},+ {4182, 2, &rule122},+ {4184, 2, &rule90},+ {4186, 4, &rule14},+ {4190, 3, &rule90},+ {4193, 1, &rule14},+ {4194, 3, &rule122},+ {4197, 2, &rule14},+ {4199, 7, &rule122},+ {4206, 3, &rule14},+ {4209, 4, &rule90},+ {4213, 13, &rule14},+ {4226, 1, &rule90},+ {4227, 2, &rule122},+ {4229, 2, &rule90},+ {4231, 6, &rule122},+ {4237, 1, &rule90},+ {4238, 1, &rule14},+ {4239, 1, &rule122},+ {4240, 10, &rule8},+ {4250, 3, &rule122},+ {4253, 1, &rule90},+ {4254, 2, &rule13},+ {4256, 38, &rule123},+ {4295, 1, &rule123},+ {4301, 1, &rule123},+ {4304, 43, &rule14},+ {4347, 1, &rule2},+ {4348, 1, &rule89},+ {4349, 332, &rule14},+ {4682, 4, &rule14},+ {4688, 7, &rule14},+ {4696, 1, &rule14},+ {4698, 4, &rule14},+ {4704, 41, &rule14},+ {4746, 4, &rule14},+ {4752, 33, &rule14},+ {4786, 4, &rule14},+ {4792, 7, &rule14},+ {4800, 1, &rule14},+ {4802, 4, &rule14},+ {4808, 15, &rule14},+ {4824, 57, &rule14},+ {4882, 4, &rule14},+ {4888, 67, &rule14},+ {4957, 3, &rule90},+ {4960, 9, &rule2},+ {4969, 20, &rule17},+ {4992, 16, &rule14},+ {5008, 10, &rule13},+ {5024, 85, &rule14},+ {5120, 1, &rule7},+ {5121, 620, &rule14},+ {5741, 2, &rule2},+ {5743, 17, &rule14},+ {5760, 1, &rule1},+ {5761, 26, &rule14},+ {5787, 1, &rule4},+ {5788, 1, &rule5},+ {5792, 75, &rule14},+ {5867, 3, &rule2},+ {5870, 3, &rule124},+ {5873, 8, &rule14},+ {5888, 13, &rule14},+ {5902, 4, &rule14},+ {5906, 3, &rule90},+ {5920, 18, &rule14},+ {5938, 3, &rule90},+ {5941, 2, &rule2},+ {5952, 18, &rule14},+ {5970, 2, &rule90},+ {5984, 13, &rule14},+ {5998, 3, &rule14},+ {6002, 2, &rule90},+ {6016, 52, &rule14},+ {6068, 2, &rule90},+ {6070, 1, &rule122},+ {6071, 7, &rule90},+ {6078, 8, &rule122},+ {6086, 1, &rule90},+ {6087, 2, &rule122},+ {6089, 11, &rule90},+ {6100, 3, &rule2},+ {6103, 1, &rule89},+ {6104, 3, &rule2},+ {6107, 1, &rule3},+ {6108, 1, &rule14},+ {6109, 1, &rule90},+ {6112, 10, &rule8},+ {6128, 10, &rule17},+ {6144, 6, &rule2},+ {6150, 1, &rule7},+ {6151, 4, &rule2},+ {6155, 3, &rule90},+ {6158, 1, &rule16},+ {6160, 10, &rule8},+ {6176, 35, &rule14},+ {6211, 1, &rule89},+ {6212, 52, &rule14},+ {6272, 41, &rule14},+ {6313, 1, &rule90},+ {6314, 1, &rule14},+ {6320, 70, &rule14},+ {6400, 31, &rule14},+ {6432, 3, &rule90},+ {6435, 4, &rule122},+ {6439, 2, &rule90},+ {6441, 3, &rule122},+ {6448, 2, &rule122},+ {6450, 1, &rule90},+ {6451, 6, &rule122},+ {6457, 3, &rule90},+ {6464, 1, &rule13},+ {6468, 2, &rule2},+ {6470, 10, &rule8},+ {6480, 30, &rule14},+ {6512, 5, &rule14},+ {6528, 44, &rule14},+ {6576, 17, &rule122},+ {6593, 7, &rule14},+ {6600, 2, &rule122},+ {6608, 10, &rule8},+ {6618, 1, &rule17},+ {6622, 34, &rule13},+ {6656, 23, &rule14},+ {6679, 2, &rule90},+ {6681, 2, &rule122},+ {6683, 1, &rule90},+ {6686, 2, &rule2},+ {6688, 53, &rule14},+ {6741, 1, &rule122},+ {6742, 1, &rule90},+ {6743, 1, &rule122},+ {6744, 7, &rule90},+ {6752, 1, &rule90},+ {6753, 1, &rule122},+ {6754, 1, &rule90},+ {6755, 2, &rule122},+ {6757, 8, &rule90},+ {6765, 6, &rule122},+ {6771, 10, &rule90},+ {6783, 1, &rule90},+ {6784, 10, &rule8},+ {6800, 10, &rule8},+ {6816, 7, &rule2},+ {6823, 1, &rule89},+ {6824, 6, &rule2},+ {6832, 14, &rule90},+ {6846, 1, &rule117},+ {6912, 4, &rule90},+ {6916, 1, &rule122},+ {6917, 47, &rule14},+ {6964, 1, &rule90},+ {6965, 1, &rule122},+ {6966, 5, &rule90},+ {6971, 1, &rule122},+ {6972, 1, &rule90},+ {6973, 5, &rule122},+ {6978, 1, &rule90},+ {6979, 2, &rule122},+ {6981, 7, &rule14},+ {6992, 10, &rule8},+ {7002, 7, &rule2},+ {7009, 10, &rule13},+ {7019, 9, &rule90},+ {7028, 9, &rule13},+ {7040, 2, &rule90},+ {7042, 1, &rule122},+ {7043, 30, &rule14},+ {7073, 1, &rule122},+ {7074, 4, &rule90},+ {7078, 2, &rule122},+ {7080, 2, &rule90},+ {7082, 1, &rule122},+ {7083, 3, &rule90},+ {7086, 2, &rule14},+ {7088, 10, &rule8},+ {7098, 44, &rule14},+ {7142, 1, &rule90},+ {7143, 1, &rule122},+ {7144, 2, &rule90},+ {7146, 3, &rule122},+ {7149, 1, &rule90},+ {7150, 1, &rule122},+ {7151, 3, &rule90},+ {7154, 2, &rule122},+ {7164, 4, &rule2},+ {7168, 36, &rule14},+ {7204, 8, &rule122},+ {7212, 8, &rule90},+ {7220, 2, &rule122},+ {7222, 2, &rule90},+ {7227, 5, &rule2},+ {7232, 10, &rule8},+ {7245, 3, &rule14},+ {7248, 10, &rule8},+ {7258, 30, &rule14},+ {7288, 6, &rule89},+ {7294, 2, &rule2},+ {7360, 8, &rule2},+ {7376, 3, &rule90},+ {7379, 1, &rule2},+ {7380, 13, &rule90},+ {7393, 1, &rule122},+ {7394, 7, &rule90},+ {7401, 4, &rule14},+ {7405, 1, &rule90},+ {7406, 4, &rule14},+ {7410, 2, &rule122},+ {7412, 1, &rule90},+ {7413, 2, &rule14},+ {7416, 2, &rule90},+ {7424, 44, &rule20},+ {7468, 63, &rule89},+ {7531, 13, &rule20},+ {7544, 1, &rule89},+ {7545, 1, &rule125},+ {7546, 3, &rule20},+ {7549, 1, &rule126},+ {7550, 29, &rule20},+ {7579, 37, &rule89},+ {7616, 54, &rule90},+ {7676, 4, &rule90},+ {7680, 1, &rule22},+ {7681, 1, &rule23},+ {7682, 1, &rule22},+ {7683, 1, &rule23},+ {7684, 1, &rule22},+ {7685, 1, &rule23},+ {7686, 1, &rule22},+ {7687, 1, &rule23},+ {7688, 1, &rule22},+ {7689, 1, &rule23},+ {7690, 1, &rule22},+ {7691, 1, &rule23},+ {7692, 1, &rule22},+ {7693, 1, &rule23},+ {7694, 1, &rule22},+ {7695, 1, &rule23},+ {7696, 1, &rule22},+ {7697, 1, &rule23},+ {7698, 1, &rule22},+ {7699, 1, &rule23},+ {7700, 1, &rule22},+ {7701, 1, &rule23},+ {7702, 1, &rule22},+ {7703, 1, &rule23},+ {7704, 1, &rule22},+ {7705, 1, &rule23},+ {7706, 1, &rule22},+ {7707, 1, &rule23},+ {7708, 1, &rule22},+ {7709, 1, &rule23},+ {7710, 1, &rule22},+ {7711, 1, &rule23},+ {7712, 1, &rule22},+ {7713, 1, &rule23},+ {7714, 1, &rule22},+ {7715, 1, &rule23},+ {7716, 1, &rule22},+ {7717, 1, &rule23},+ {7718, 1, &rule22},+ {7719, 1, &rule23},+ {7720, 1, &rule22},+ {7721, 1, &rule23},+ {7722, 1, &rule22},+ {7723, 1, &rule23},+ {7724, 1, &rule22},+ {7725, 1, &rule23},+ {7726, 1, &rule22},+ {7727, 1, &rule23},+ {7728, 1, &rule22},+ {7729, 1, &rule23},+ {7730, 1, &rule22},+ {7731, 1, &rule23},+ {7732, 1, &rule22},+ {7733, 1, &rule23},+ {7734, 1, &rule22},+ {7735, 1, &rule23},+ {7736, 1, &rule22},+ {7737, 1, &rule23},+ {7738, 1, &rule22},+ {7739, 1, &rule23},+ {7740, 1, &rule22},+ {7741, 1, &rule23},+ {7742, 1, &rule22},+ {7743, 1, &rule23},+ {7744, 1, &rule22},+ {7745, 1, &rule23},+ {7746, 1, &rule22},+ {7747, 1, &rule23},+ {7748, 1, &rule22},+ {7749, 1, &rule23},+ {7750, 1, &rule22},+ {7751, 1, &rule23},+ {7752, 1, &rule22},+ {7753, 1, &rule23},+ {7754, 1, &rule22},+ {7755, 1, &rule23},+ {7756, 1, &rule22},+ {7757, 1, &rule23},+ {7758, 1, &rule22},+ {7759, 1, &rule23},+ {7760, 1, &rule22},+ {7761, 1, &rule23},+ {7762, 1, &rule22},+ {7763, 1, &rule23},+ {7764, 1, &rule22},+ {7765, 1, &rule23},+ {7766, 1, &rule22},+ {7767, 1, &rule23},+ {7768, 1, &rule22},+ {7769, 1, &rule23},+ {7770, 1, &rule22},+ {7771, 1, &rule23},+ {7772, 1, &rule22},+ {7773, 1, &rule23},+ {7774, 1, &rule22},+ {7775, 1, &rule23},+ {7776, 1, &rule22},+ {7777, 1, &rule23},+ {7778, 1, &rule22},+ {7779, 1, &rule23},+ {7780, 1, &rule22},+ {7781, 1, &rule23},+ {7782, 1, &rule22},+ {7783, 1, &rule23},+ {7784, 1, &rule22},+ {7785, 1, &rule23},+ {7786, 1, &rule22},+ {7787, 1, &rule23},+ {7788, 1, &rule22},+ {7789, 1, &rule23},+ {7790, 1, &rule22},+ {7791, 1, &rule23},+ {7792, 1, &rule22},+ {7793, 1, &rule23},+ {7794, 1, &rule22},+ {7795, 1, &rule23},+ {7796, 1, &rule22},+ {7797, 1, &rule23},+ {7798, 1, &rule22},+ {7799, 1, &rule23},+ {7800, 1, &rule22},+ {7801, 1, &rule23},+ {7802, 1, &rule22},+ {7803, 1, &rule23},+ {7804, 1, &rule22},+ {7805, 1, &rule23},+ {7806, 1, &rule22},+ {7807, 1, &rule23},+ {7808, 1, &rule22},+ {7809, 1, &rule23},+ {7810, 1, &rule22},+ {7811, 1, &rule23},+ {7812, 1, &rule22},+ {7813, 1, &rule23},+ {7814, 1, &rule22},+ {7815, 1, &rule23},+ {7816, 1, &rule22},+ {7817, 1, &rule23},+ {7818, 1, &rule22},+ {7819, 1, &rule23},+ {7820, 1, &rule22},+ {7821, 1, &rule23},+ {7822, 1, &rule22},+ {7823, 1, &rule23},+ {7824, 1, &rule22},+ {7825, 1, &rule23},+ {7826, 1, &rule22},+ {7827, 1, &rule23},+ {7828, 1, &rule22},+ {7829, 1, &rule23},+ {7830, 5, &rule20},+ {7835, 1, &rule127},+ {7836, 2, &rule20},+ {7838, 1, &rule128},+ {7839, 1, &rule20},+ {7840, 1, &rule22},+ {7841, 1, &rule23},+ {7842, 1, &rule22},+ {7843, 1, &rule23},+ {7844, 1, &rule22},+ {7845, 1, &rule23},+ {7846, 1, &rule22},+ {7847, 1, &rule23},+ {7848, 1, &rule22},+ {7849, 1, &rule23},+ {7850, 1, &rule22},+ {7851, 1, &rule23},+ {7852, 1, &rule22},+ {7853, 1, &rule23},+ {7854, 1, &rule22},+ {7855, 1, &rule23},+ {7856, 1, &rule22},+ {7857, 1, &rule23},+ {7858, 1, &rule22},+ {7859, 1, &rule23},+ {7860, 1, &rule22},+ {7861, 1, &rule23},+ {7862, 1, &rule22},+ {7863, 1, &rule23},+ {7864, 1, &rule22},+ {7865, 1, &rule23},+ {7866, 1, &rule22},+ {7867, 1, &rule23},+ {7868, 1, &rule22},+ {7869, 1, &rule23},+ {7870, 1, &rule22},+ {7871, 1, &rule23},+ {7872, 1, &rule22},+ {7873, 1, &rule23},+ {7874, 1, &rule22},+ {7875, 1, &rule23},+ {7876, 1, &rule22},+ {7877, 1, &rule23},+ {7878, 1, &rule22},+ {7879, 1, &rule23},+ {7880, 1, &rule22},+ {7881, 1, &rule23},+ {7882, 1, &rule22},+ {7883, 1, &rule23},+ {7884, 1, &rule22},+ {7885, 1, &rule23},+ {7886, 1, &rule22},+ {7887, 1, &rule23},+ {7888, 1, &rule22},+ {7889, 1, &rule23},+ {7890, 1, &rule22},+ {7891, 1, &rule23},+ {7892, 1, &rule22},+ {7893, 1, &rule23},+ {7894, 1, &rule22},+ {7895, 1, &rule23},+ {7896, 1, &rule22},+ {7897, 1, &rule23},+ {7898, 1, &rule22},+ {7899, 1, &rule23},+ {7900, 1, &rule22},+ {7901, 1, &rule23},+ {7902, 1, &rule22},+ {7903, 1, &rule23},+ {7904, 1, &rule22},+ {7905, 1, &rule23},+ {7906, 1, &rule22},+ {7907, 1, &rule23},+ {7908, 1, &rule22},+ {7909, 1, &rule23},+ {7910, 1, &rule22},+ {7911, 1, &rule23},+ {7912, 1, &rule22},+ {7913, 1, &rule23},+ {7914, 1, &rule22},+ {7915, 1, &rule23},+ {7916, 1, &rule22},+ {7917, 1, &rule23},+ {7918, 1, &rule22},+ {7919, 1, &rule23},+ {7920, 1, &rule22},+ {7921, 1, &rule23},+ {7922, 1, &rule22},+ {7923, 1, &rule23},+ {7924, 1, &rule22},+ {7925, 1, &rule23},+ {7926, 1, &rule22},+ {7927, 1, &rule23},+ {7928, 1, &rule22},+ {7929, 1, &rule23},+ {7930, 1, &rule22},+ {7931, 1, &rule23},+ {7932, 1, &rule22},+ {7933, 1, &rule23},+ {7934, 1, &rule22},+ {7935, 1, &rule23},+ {7936, 8, &rule129},+ {7944, 8, &rule130},+ {7952, 6, &rule129},+ {7960, 6, &rule130},+ {7968, 8, &rule129},+ {7976, 8, &rule130},+ {7984, 8, &rule129},+ {7992, 8, &rule130},+ {8000, 6, &rule129},+ {8008, 6, &rule130},+ {8016, 1, &rule20},+ {8017, 1, &rule129},+ {8018, 1, &rule20},+ {8019, 1, &rule129},+ {8020, 1, &rule20},+ {8021, 1, &rule129},+ {8022, 1, &rule20},+ {8023, 1, &rule129},+ {8025, 1, &rule130},+ {8027, 1, &rule130},+ {8029, 1, &rule130},+ {8031, 1, &rule130},+ {8032, 8, &rule129},+ {8040, 8, &rule130},+ {8048, 2, &rule131},+ {8050, 4, &rule132},+ {8054, 2, &rule133},+ {8056, 2, &rule134},+ {8058, 2, &rule135},+ {8060, 2, &rule136},+ {8064, 8, &rule129},+ {8072, 8, &rule137},+ {8080, 8, &rule129},+ {8088, 8, &rule137},+ {8096, 8, &rule129},+ {8104, 8, &rule137},+ {8112, 2, &rule129},+ {8114, 1, &rule20},+ {8115, 1, &rule138},+ {8116, 1, &rule20},+ {8118, 2, &rule20},+ {8120, 2, &rule130},+ {8122, 2, &rule139},+ {8124, 1, &rule140},+ {8125, 1, &rule10},+ {8126, 1, &rule141},+ {8127, 3, &rule10},+ {8130, 1, &rule20},+ {8131, 1, &rule138},+ {8132, 1, &rule20},+ {8134, 2, &rule20},+ {8136, 4, &rule142},+ {8140, 1, &rule140},+ {8141, 3, &rule10},+ {8144, 2, &rule129},+ {8146, 2, &rule20},+ {8150, 2, &rule20},+ {8152, 2, &rule130},+ {8154, 2, &rule143},+ {8157, 3, &rule10},+ {8160, 2, &rule129},+ {8162, 3, &rule20},+ {8165, 1, &rule111},+ {8166, 2, &rule20},+ {8168, 2, &rule130},+ {8170, 2, &rule144},+ {8172, 1, &rule115},+ {8173, 3, &rule10},+ {8178, 1, &rule20},+ {8179, 1, &rule138},+ {8180, 1, &rule20},+ {8182, 2, &rule20},+ {8184, 2, &rule145},+ {8186, 2, &rule146},+ {8188, 1, &rule140},+ {8189, 2, &rule10},+ {8192, 11, &rule1},+ {8203, 5, &rule16},+ {8208, 6, &rule7},+ {8214, 2, &rule2},+ {8216, 1, &rule15},+ {8217, 1, &rule19},+ {8218, 1, &rule4},+ {8219, 2, &rule15},+ {8221, 1, &rule19},+ {8222, 1, &rule4},+ {8223, 1, &rule15},+ {8224, 8, &rule2},+ {8232, 1, &rule147},+ {8233, 1, &rule148},+ {8234, 5, &rule16},+ {8239, 1, &rule1},+ {8240, 9, &rule2},+ {8249, 1, &rule15},+ {8250, 1, &rule19},+ {8251, 4, &rule2},+ {8255, 2, &rule11},+ {8257, 3, &rule2},+ {8260, 1, &rule6},+ {8261, 1, &rule4},+ {8262, 1, &rule5},+ {8263, 11, &rule2},+ {8274, 1, &rule6},+ {8275, 1, &rule2},+ {8276, 1, &rule11},+ {8277, 10, &rule2},+ {8287, 1, &rule1},+ {8288, 5, &rule16},+ {8294, 10, &rule16},+ {8304, 1, &rule17},+ {8305, 1, &rule89},+ {8308, 6, &rule17},+ {8314, 3, &rule6},+ {8317, 1, &rule4},+ {8318, 1, &rule5},+ {8319, 1, &rule89},+ {8320, 10, &rule17},+ {8330, 3, &rule6},+ {8333, 1, &rule4},+ {8334, 1, &rule5},+ {8336, 13, &rule89},+ {8352, 30, &rule3},+ {8400, 13, &rule90},+ {8413, 4, &rule117},+ {8417, 1, &rule90},+ {8418, 3, &rule117},+ {8421, 12, &rule90},+ {8448, 2, &rule13},+ {8450, 1, &rule105},+ {8451, 4, &rule13},+ {8455, 1, &rule105},+ {8456, 2, &rule13},+ {8458, 1, &rule20},+ {8459, 3, &rule105},+ {8462, 2, &rule20},+ {8464, 3, &rule105},+ {8467, 1, &rule20},+ {8468, 1, &rule13},+ {8469, 1, &rule105},+ {8470, 2, &rule13},+ {8472, 1, &rule6},+ {8473, 5, &rule105},+ {8478, 6, &rule13},+ {8484, 1, &rule105},+ {8485, 1, &rule13},+ {8486, 1, &rule149},+ {8487, 1, &rule13},+ {8488, 1, &rule105},+ {8489, 1, &rule13},+ {8490, 1, &rule150},+ {8491, 1, &rule151},+ {8492, 2, &rule105},+ {8494, 1, &rule13},+ {8495, 1, &rule20},+ {8496, 2, &rule105},+ {8498, 1, &rule152},+ {8499, 1, &rule105},+ {8500, 1, &rule20},+ {8501, 4, &rule14},+ {8505, 1, &rule20},+ {8506, 2, &rule13},+ {8508, 2, &rule20},+ {8510, 2, &rule105},+ {8512, 5, &rule6},+ {8517, 1, &rule105},+ {8518, 4, &rule20},+ {8522, 1, &rule13},+ {8523, 1, &rule6},+ {8524, 2, &rule13},+ {8526, 1, &rule153},+ {8527, 1, &rule13},+ {8528, 16, &rule17},+ {8544, 16, &rule154},+ {8560, 16, &rule155},+ {8576, 3, &rule124},+ {8579, 1, &rule22},+ {8580, 1, &rule23},+ {8581, 4, &rule124},+ {8585, 1, &rule17},+ {8592, 5, &rule6},+ {8597, 5, &rule13},+ {8602, 2, &rule6},+ {8604, 4, &rule13},+ {8608, 1, &rule6},+ {8609, 2, &rule13},+ {8611, 1, &rule6},+ {8612, 2, &rule13},+ {8614, 1, &rule6},+ {8615, 7, &rule13},+ {8622, 1, &rule6},+ {8623, 31, &rule13},+ {8654, 2, &rule6},+ {8656, 2, &rule13},+ {8658, 1, &rule6},+ {8659, 1, &rule13},+ {8660, 1, &rule6},+ {8661, 31, &rule13},+ {8692, 268, &rule6},+ {8960, 8, &rule13},+ {8968, 1, &rule4},+ {8969, 1, &rule5},+ {8970, 1, &rule4},+ {8971, 1, &rule5},+ {8972, 20, &rule13},+ {8992, 2, &rule6},+ {8994, 7, &rule13},+ {9001, 1, &rule4},+ {9002, 1, &rule5},+ {9003, 81, &rule13},+ {9084, 1, &rule6},+ {9085, 30, &rule13},+ {9115, 25, &rule6},+ {9140, 40, &rule13},+ {9180, 6, &rule6},+ {9186, 25, &rule13},+ {9216, 39, &rule13},+ {9280, 11, &rule13},+ {9312, 60, &rule17},+ {9372, 26, &rule13},+ {9398, 26, &rule156},+ {9424, 26, &rule157},+ {9450, 22, &rule17},+ {9472, 183, &rule13},+ {9655, 1, &rule6},+ {9656, 9, &rule13},+ {9665, 1, &rule6},+ {9666, 54, &rule13},+ {9720, 8, &rule6},+ {9728, 111, &rule13},+ {9839, 1, &rule6},+ {9840, 248, &rule13},+ {10088, 1, &rule4},+ {10089, 1, &rule5},+ {10090, 1, &rule4},+ {10091, 1, &rule5},+ {10092, 1, &rule4},+ {10093, 1, &rule5},+ {10094, 1, &rule4},+ {10095, 1, &rule5},+ {10096, 1, &rule4},+ {10097, 1, &rule5},+ {10098, 1, &rule4},+ {10099, 1, &rule5},+ {10100, 1, &rule4},+ {10101, 1, &rule5},+ {10102, 30, &rule17},+ {10132, 44, &rule13},+ {10176, 5, &rule6},+ {10181, 1, &rule4},+ {10182, 1, &rule5},+ {10183, 31, &rule6},+ {10214, 1, &rule4},+ {10215, 1, &rule5},+ {10216, 1, &rule4},+ {10217, 1, &rule5},+ {10218, 1, &rule4},+ {10219, 1, &rule5},+ {10220, 1, &rule4},+ {10221, 1, &rule5},+ {10222, 1, &rule4},+ {10223, 1, &rule5},+ {10224, 16, &rule6},+ {10240, 256, &rule13},+ {10496, 131, &rule6},+ {10627, 1, &rule4},+ {10628, 1, &rule5},+ {10629, 1, &rule4},+ {10630, 1, &rule5},+ {10631, 1, &rule4},+ {10632, 1, &rule5},+ {10633, 1, &rule4},+ {10634, 1, &rule5},+ {10635, 1, &rule4},+ {10636, 1, &rule5},+ {10637, 1, &rule4},+ {10638, 1, &rule5},+ {10639, 1, &rule4},+ {10640, 1, &rule5},+ {10641, 1, &rule4},+ {10642, 1, &rule5},+ {10643, 1, &rule4},+ {10644, 1, &rule5},+ {10645, 1, &rule4},+ {10646, 1, &rule5},+ {10647, 1, &rule4},+ {10648, 1, &rule5},+ {10649, 63, &rule6},+ {10712, 1, &rule4},+ {10713, 1, &rule5},+ {10714, 1, &rule4},+ {10715, 1, &rule5},+ {10716, 32, &rule6},+ {10748, 1, &rule4},+ {10749, 1, &rule5},+ {10750, 258, &rule6},+ {11008, 48, &rule13},+ {11056, 21, &rule6},+ {11077, 2, &rule13},+ {11079, 6, &rule6},+ {11085, 39, &rule13},+ {11126, 32, &rule13},+ {11160, 34, &rule13},+ {11197, 12, &rule13},+ {11210, 8, &rule13},+ {11264, 47, &rule120},+ {11312, 47, &rule121},+ {11360, 1, &rule22},+ {11361, 1, &rule23},+ {11362, 1, &rule158},+ {11363, 1, &rule159},+ {11364, 1, &rule160},+ {11365, 1, &rule161},+ {11366, 1, &rule162},+ {11367, 1, &rule22},+ {11368, 1, &rule23},+ {11369, 1, &rule22},+ {11370, 1, &rule23},+ {11371, 1, &rule22},+ {11372, 1, &rule23},+ {11373, 1, &rule163},+ {11374, 1, &rule164},+ {11375, 1, &rule165},+ {11376, 1, &rule166},+ {11377, 1, &rule20},+ {11378, 1, &rule22},+ {11379, 1, &rule23},+ {11380, 1, &rule20},+ {11381, 1, &rule22},+ {11382, 1, &rule23},+ {11383, 5, &rule20},+ {11388, 2, &rule89},+ {11390, 2, &rule167},+ {11392, 1, &rule22},+ {11393, 1, &rule23},+ {11394, 1, &rule22},+ {11395, 1, &rule23},+ {11396, 1, &rule22},+ {11397, 1, &rule23},+ {11398, 1, &rule22},+ {11399, 1, &rule23},+ {11400, 1, &rule22},+ {11401, 1, &rule23},+ {11402, 1, &rule22},+ {11403, 1, &rule23},+ {11404, 1, &rule22},+ {11405, 1, &rule23},+ {11406, 1, &rule22},+ {11407, 1, &rule23},+ {11408, 1, &rule22},+ {11409, 1, &rule23},+ {11410, 1, &rule22},+ {11411, 1, &rule23},+ {11412, 1, &rule22},+ {11413, 1, &rule23},+ {11414, 1, &rule22},+ {11415, 1, &rule23},+ {11416, 1, &rule22},+ {11417, 1, &rule23},+ {11418, 1, &rule22},+ {11419, 1, &rule23},+ {11420, 1, &rule22},+ {11421, 1, &rule23},+ {11422, 1, &rule22},+ {11423, 1, &rule23},+ {11424, 1, &rule22},+ {11425, 1, &rule23},+ {11426, 1, &rule22},+ {11427, 1, &rule23},+ {11428, 1, &rule22},+ {11429, 1, &rule23},+ {11430, 1, &rule22},+ {11431, 1, &rule23},+ {11432, 1, &rule22},+ {11433, 1, &rule23},+ {11434, 1, &rule22},+ {11435, 1, &rule23},+ {11436, 1, &rule22},+ {11437, 1, &rule23},+ {11438, 1, &rule22},+ {11439, 1, &rule23},+ {11440, 1, &rule22},+ {11441, 1, &rule23},+ {11442, 1, &rule22},+ {11443, 1, &rule23},+ {11444, 1, &rule22},+ {11445, 1, &rule23},+ {11446, 1, &rule22},+ {11447, 1, &rule23},+ {11448, 1, &rule22},+ {11449, 1, &rule23},+ {11450, 1, &rule22},+ {11451, 1, &rule23},+ {11452, 1, &rule22},+ {11453, 1, &rule23},+ {11454, 1, &rule22},+ {11455, 1, &rule23},+ {11456, 1, &rule22},+ {11457, 1, &rule23},+ {11458, 1, &rule22},+ {11459, 1, &rule23},+ {11460, 1, &rule22},+ {11461, 1, &rule23},+ {11462, 1, &rule22},+ {11463, 1, &rule23},+ {11464, 1, &rule22},+ {11465, 1, &rule23},+ {11466, 1, &rule22},+ {11467, 1, &rule23},+ {11468, 1, &rule22},+ {11469, 1, &rule23},+ {11470, 1, &rule22},+ {11471, 1, &rule23},+ {11472, 1, &rule22},+ {11473, 1, &rule23},+ {11474, 1, &rule22},+ {11475, 1, &rule23},+ {11476, 1, &rule22},+ {11477, 1, &rule23},+ {11478, 1, &rule22},+ {11479, 1, &rule23},+ {11480, 1, &rule22},+ {11481, 1, &rule23},+ {11482, 1, &rule22},+ {11483, 1, &rule23},+ {11484, 1, &rule22},+ {11485, 1, &rule23},+ {11486, 1, &rule22},+ {11487, 1, &rule23},+ {11488, 1, &rule22},+ {11489, 1, &rule23},+ {11490, 1, &rule22},+ {11491, 1, &rule23},+ {11492, 1, &rule20},+ {11493, 6, &rule13},+ {11499, 1, &rule22},+ {11500, 1, &rule23},+ {11501, 1, &rule22},+ {11502, 1, &rule23},+ {11503, 3, &rule90},+ {11506, 1, &rule22},+ {11507, 1, &rule23},+ {11513, 4, &rule2},+ {11517, 1, &rule17},+ {11518, 2, &rule2},+ {11520, 38, &rule168},+ {11559, 1, &rule168},+ {11565, 1, &rule168},+ {11568, 56, &rule14},+ {11631, 1, &rule89},+ {11632, 1, &rule2},+ {11647, 1, &rule90},+ {11648, 23, &rule14},+ {11680, 7, &rule14},+ {11688, 7, &rule14},+ {11696, 7, &rule14},+ {11704, 7, &rule14},+ {11712, 7, &rule14},+ {11720, 7, &rule14},+ {11728, 7, &rule14},+ {11736, 7, &rule14},+ {11744, 32, &rule90},+ {11776, 2, &rule2},+ {11778, 1, &rule15},+ {11779, 1, &rule19},+ {11780, 1, &rule15},+ {11781, 1, &rule19},+ {11782, 3, &rule2},+ {11785, 1, &rule15},+ {11786, 1, &rule19},+ {11787, 1, &rule2},+ {11788, 1, &rule15},+ {11789, 1, &rule19},+ {11790, 9, &rule2},+ {11799, 1, &rule7},+ {11800, 2, &rule2},+ {11802, 1, &rule7},+ {11803, 1, &rule2},+ {11804, 1, &rule15},+ {11805, 1, &rule19},+ {11806, 2, &rule2},+ {11808, 1, &rule15},+ {11809, 1, &rule19},+ {11810, 1, &rule4},+ {11811, 1, &rule5},+ {11812, 1, &rule4},+ {11813, 1, &rule5},+ {11814, 1, &rule4},+ {11815, 1, &rule5},+ {11816, 1, &rule4},+ {11817, 1, &rule5},+ {11818, 5, &rule2},+ {11823, 1, &rule89},+ {11824, 10, &rule2},+ {11834, 2, &rule7},+ {11836, 4, &rule2},+ {11840, 1, &rule7},+ {11841, 1, &rule2},+ {11842, 1, &rule4},+ {11904, 26, &rule13},+ {11931, 89, &rule13},+ {12032, 214, &rule13},+ {12272, 12, &rule13},+ {12288, 1, &rule1},+ {12289, 3, &rule2},+ {12292, 1, &rule13},+ {12293, 1, &rule89},+ {12294, 1, &rule14},+ {12295, 1, &rule124},+ {12296, 1, &rule4},+ {12297, 1, &rule5},+ {12298, 1, &rule4},+ {12299, 1, &rule5},+ {12300, 1, &rule4},+ {12301, 1, &rule5},+ {12302, 1, &rule4},+ {12303, 1, &rule5},+ {12304, 1, &rule4},+ {12305, 1, &rule5},+ {12306, 2, &rule13},+ {12308, 1, &rule4},+ {12309, 1, &rule5},+ {12310, 1, &rule4},+ {12311, 1, &rule5},+ {12312, 1, &rule4},+ {12313, 1, &rule5},+ {12314, 1, &rule4},+ {12315, 1, &rule5},+ {12316, 1, &rule7},+ {12317, 1, &rule4},+ {12318, 2, &rule5},+ {12320, 1, &rule13},+ {12321, 9, &rule124},+ {12330, 4, &rule90},+ {12334, 2, &rule122},+ {12336, 1, &rule7},+ {12337, 5, &rule89},+ {12342, 2, &rule13},+ {12344, 3, &rule124},+ {12347, 1, &rule89},+ {12348, 1, &rule14},+ {12349, 1, &rule2},+ {12350, 2, &rule13},+ {12353, 86, &rule14},+ {12441, 2, &rule90},+ {12443, 2, &rule10},+ {12445, 2, &rule89},+ {12447, 1, &rule14},+ {12448, 1, &rule7},+ {12449, 90, &rule14},+ {12539, 1, &rule2},+ {12540, 3, &rule89},+ {12543, 1, &rule14},+ {12549, 41, &rule14},+ {12593, 94, &rule14},+ {12688, 2, &rule13},+ {12690, 4, &rule17},+ {12694, 10, &rule13},+ {12704, 27, &rule14},+ {12736, 36, &rule13},+ {12784, 16, &rule14},+ {12800, 31, &rule13},+ {12832, 10, &rule17},+ {12842, 30, &rule13},+ {12872, 8, &rule17},+ {12880, 1, &rule13},+ {12881, 15, &rule17},+ {12896, 32, &rule13},+ {12928, 10, &rule17},+ {12938, 39, &rule13},+ {12977, 15, &rule17},+ {12992, 63, &rule13},+ {13056, 256, &rule13},+ {13312, 6582, &rule14},+ {19904, 64, &rule13},+ {19968, 20941, &rule14},+ {40960, 21, &rule14},+ {40981, 1, &rule89},+ {40982, 1143, &rule14},+ {42128, 55, &rule13},+ {42192, 40, &rule14},+ {42232, 6, &rule89},+ {42238, 2, &rule2},+ {42240, 268, &rule14},+ {42508, 1, &rule89},+ {42509, 3, &rule2},+ {42512, 16, &rule14},+ {42528, 10, &rule8},+ {42538, 2, &rule14},+ {42560, 1, &rule22},+ {42561, 1, &rule23},+ {42562, 1, &rule22},+ {42563, 1, &rule23},+ {42564, 1, &rule22},+ {42565, 1, &rule23},+ {42566, 1, &rule22},+ {42567, 1, &rule23},+ {42568, 1, &rule22},+ {42569, 1, &rule23},+ {42570, 1, &rule22},+ {42571, 1, &rule23},+ {42572, 1, &rule22},+ {42573, 1, &rule23},+ {42574, 1, &rule22},+ {42575, 1, &rule23},+ {42576, 1, &rule22},+ {42577, 1, &rule23},+ {42578, 1, &rule22},+ {42579, 1, &rule23},+ {42580, 1, &rule22},+ {42581, 1, &rule23},+ {42582, 1, &rule22},+ {42583, 1, &rule23},+ {42584, 1, &rule22},+ {42585, 1, &rule23},+ {42586, 1, &rule22},+ {42587, 1, &rule23},+ {42588, 1, &rule22},+ {42589, 1, &rule23},+ {42590, 1, &rule22},+ {42591, 1, &rule23},+ {42592, 1, &rule22},+ {42593, 1, &rule23},+ {42594, 1, &rule22},+ {42595, 1, &rule23},+ {42596, 1, &rule22},+ {42597, 1, &rule23},+ {42598, 1, &rule22},+ {42599, 1, &rule23},+ {42600, 1, &rule22},+ {42601, 1, &rule23},+ {42602, 1, &rule22},+ {42603, 1, &rule23},+ {42604, 1, &rule22},+ {42605, 1, &rule23},+ {42606, 1, &rule14},+ {42607, 1, &rule90},+ {42608, 3, &rule117},+ {42611, 1, &rule2},+ {42612, 10, &rule90},+ {42622, 1, &rule2},+ {42623, 1, &rule89},+ {42624, 1, &rule22},+ {42625, 1, &rule23},+ {42626, 1, &rule22},+ {42627, 1, &rule23},+ {42628, 1, &rule22},+ {42629, 1, &rule23},+ {42630, 1, &rule22},+ {42631, 1, &rule23},+ {42632, 1, &rule22},+ {42633, 1, &rule23},+ {42634, 1, &rule22},+ {42635, 1, &rule23},+ {42636, 1, &rule22},+ {42637, 1, &rule23},+ {42638, 1, &rule22},+ {42639, 1, &rule23},+ {42640, 1, &rule22},+ {42641, 1, &rule23},+ {42642, 1, &rule22},+ {42643, 1, &rule23},+ {42644, 1, &rule22},+ {42645, 1, &rule23},+ {42646, 1, &rule22},+ {42647, 1, &rule23},+ {42648, 1, &rule22},+ {42649, 1, &rule23},+ {42650, 1, &rule22},+ {42651, 1, &rule23},+ {42652, 2, &rule89},+ {42655, 1, &rule90},+ {42656, 70, &rule14},+ {42726, 10, &rule124},+ {42736, 2, &rule90},+ {42738, 6, &rule2},+ {42752, 23, &rule10},+ {42775, 9, &rule89},+ {42784, 2, &rule10},+ {42786, 1, &rule22},+ {42787, 1, &rule23},+ {42788, 1, &rule22},+ {42789, 1, &rule23},+ {42790, 1, &rule22},+ {42791, 1, &rule23},+ {42792, 1, &rule22},+ {42793, 1, &rule23},+ {42794, 1, &rule22},+ {42795, 1, &rule23},+ {42796, 1, &rule22},+ {42797, 1, &rule23},+ {42798, 1, &rule22},+ {42799, 1, &rule23},+ {42800, 2, &rule20},+ {42802, 1, &rule22},+ {42803, 1, &rule23},+ {42804, 1, &rule22},+ {42805, 1, &rule23},+ {42806, 1, &rule22},+ {42807, 1, &rule23},+ {42808, 1, &rule22},+ {42809, 1, &rule23},+ {42810, 1, &rule22},+ {42811, 1, &rule23},+ {42812, 1, &rule22},+ {42813, 1, &rule23},+ {42814, 1, &rule22},+ {42815, 1, &rule23},+ {42816, 1, &rule22},+ {42817, 1, &rule23},+ {42818, 1, &rule22},+ {42819, 1, &rule23},+ {42820, 1, &rule22},+ {42821, 1, &rule23},+ {42822, 1, &rule22},+ {42823, 1, &rule23},+ {42824, 1, &rule22},+ {42825, 1, &rule23},+ {42826, 1, &rule22},+ {42827, 1, &rule23},+ {42828, 1, &rule22},+ {42829, 1, &rule23},+ {42830, 1, &rule22},+ {42831, 1, &rule23},+ {42832, 1, &rule22},+ {42833, 1, &rule23},+ {42834, 1, &rule22},+ {42835, 1, &rule23},+ {42836, 1, &rule22},+ {42837, 1, &rule23},+ {42838, 1, &rule22},+ {42839, 1, &rule23},+ {42840, 1, &rule22},+ {42841, 1, &rule23},+ {42842, 1, &rule22},+ {42843, 1, &rule23},+ {42844, 1, &rule22},+ {42845, 1, &rule23},+ {42846, 1, &rule22},+ {42847, 1, &rule23},+ {42848, 1, &rule22},+ {42849, 1, &rule23},+ {42850, 1, &rule22},+ {42851, 1, &rule23},+ {42852, 1, &rule22},+ {42853, 1, &rule23},+ {42854, 1, &rule22},+ {42855, 1, &rule23},+ {42856, 1, &rule22},+ {42857, 1, &rule23},+ {42858, 1, &rule22},+ {42859, 1, &rule23},+ {42860, 1, &rule22},+ {42861, 1, &rule23},+ {42862, 1, &rule22},+ {42863, 1, &rule23},+ {42864, 1, &rule89},+ {42865, 8, &rule20},+ {42873, 1, &rule22},+ {42874, 1, &rule23},+ {42875, 1, &rule22},+ {42876, 1, &rule23},+ {42877, 1, &rule169},+ {42878, 1, &rule22},+ {42879, 1, &rule23},+ {42880, 1, &rule22},+ {42881, 1, &rule23},+ {42882, 1, &rule22},+ {42883, 1, &rule23},+ {42884, 1, &rule22},+ {42885, 1, &rule23},+ {42886, 1, &rule22},+ {42887, 1, &rule23},+ {42888, 1, &rule89},+ {42889, 2, &rule10},+ {42891, 1, &rule22},+ {42892, 1, &rule23},+ {42893, 1, &rule170},+ {42894, 1, &rule20},+ {42896, 1, &rule22},+ {42897, 1, &rule23},+ {42898, 1, &rule22},+ {42899, 1, &rule23},+ {42900, 2, &rule20},+ {42902, 1, &rule22},+ {42903, 1, &rule23},+ {42904, 1, &rule22},+ {42905, 1, &rule23},+ {42906, 1, &rule22},+ {42907, 1, &rule23},+ {42908, 1, &rule22},+ {42909, 1, &rule23},+ {42910, 1, &rule22},+ {42911, 1, &rule23},+ {42912, 1, &rule22},+ {42913, 1, &rule23},+ {42914, 1, &rule22},+ {42915, 1, &rule23},+ {42916, 1, &rule22},+ {42917, 1, &rule23},+ {42918, 1, &rule22},+ {42919, 1, &rule23},+ {42920, 1, &rule22},+ {42921, 1, &rule23},+ {42922, 1, &rule171},+ {42923, 1, &rule172},+ {42924, 1, &rule173},+ {42925, 1, &rule174},+ {42928, 1, &rule175},+ {42929, 1, &rule176},+ {42999, 1, &rule14},+ {43000, 2, &rule89},+ {43002, 1, &rule20},+ {43003, 7, &rule14},+ {43010, 1, &rule90},+ {43011, 3, &rule14},+ {43014, 1, &rule90},+ {43015, 4, &rule14},+ {43019, 1, &rule90},+ {43020, 23, &rule14},+ {43043, 2, &rule122},+ {43045, 2, &rule90},+ {43047, 1, &rule122},+ {43048, 4, &rule13},+ {43056, 6, &rule17},+ {43062, 2, &rule13},+ {43064, 1, &rule3},+ {43065, 1, &rule13},+ {43072, 52, &rule14},+ {43124, 4, &rule2},+ {43136, 2, &rule122},+ {43138, 50, &rule14},+ {43188, 16, &rule122},+ {43204, 1, &rule90},+ {43214, 2, &rule2},+ {43216, 10, &rule8},+ {43232, 18, &rule90},+ {43250, 6, &rule14},+ {43256, 3, &rule2},+ {43259, 1, &rule14},+ {43264, 10, &rule8},+ {43274, 28, &rule14},+ {43302, 8, &rule90},+ {43310, 2, &rule2},+ {43312, 23, &rule14},+ {43335, 11, &rule90},+ {43346, 2, &rule122},+ {43359, 1, &rule2},+ {43360, 29, &rule14},+ {43392, 3, &rule90},+ {43395, 1, &rule122},+ {43396, 47, &rule14},+ {43443, 1, &rule90},+ {43444, 2, &rule122},+ {43446, 4, &rule90},+ {43450, 2, &rule122},+ {43452, 1, &rule90},+ {43453, 4, &rule122},+ {43457, 13, &rule2},+ {43471, 1, &rule89},+ {43472, 10, &rule8},+ {43486, 2, &rule2},+ {43488, 5, &rule14},+ {43493, 1, &rule90},+ {43494, 1, &rule89},+ {43495, 9, &rule14},+ {43504, 10, &rule8},+ {43514, 5, &rule14},+ {43520, 41, &rule14},+ {43561, 6, &rule90},+ {43567, 2, &rule122},+ {43569, 2, &rule90},+ {43571, 2, &rule122},+ {43573, 2, &rule90},+ {43584, 3, &rule14},+ {43587, 1, &rule90},+ {43588, 8, &rule14},+ {43596, 1, &rule90},+ {43597, 1, &rule122},+ {43600, 10, &rule8},+ {43612, 4, &rule2},+ {43616, 16, &rule14},+ {43632, 1, &rule89},+ {43633, 6, &rule14},+ {43639, 3, &rule13},+ {43642, 1, &rule14},+ {43643, 1, &rule122},+ {43644, 1, &rule90},+ {43645, 1, &rule122},+ {43646, 50, &rule14},+ {43696, 1, &rule90},+ {43697, 1, &rule14},+ {43698, 3, &rule90},+ {43701, 2, &rule14},+ {43703, 2, &rule90},+ {43705, 5, &rule14},+ {43710, 2, &rule90},+ {43712, 1, &rule14},+ {43713, 1, &rule90},+ {43714, 1, &rule14},+ {43739, 2, &rule14},+ {43741, 1, &rule89},+ {43742, 2, &rule2},+ {43744, 11, &rule14},+ {43755, 1, &rule122},+ {43756, 2, &rule90},+ {43758, 2, &rule122},+ {43760, 2, &rule2},+ {43762, 1, &rule14},+ {43763, 2, &rule89},+ {43765, 1, &rule122},+ {43766, 1, &rule90},+ {43777, 6, &rule14},+ {43785, 6, &rule14},+ {43793, 6, &rule14},+ {43808, 7, &rule14},+ {43816, 7, &rule14},+ {43824, 43, &rule20},+ {43867, 1, &rule10},+ {43868, 4, &rule89},+ {43876, 2, &rule20},+ {43968, 35, &rule14},+ {44003, 2, &rule122},+ {44005, 1, &rule90},+ {44006, 2, &rule122},+ {44008, 1, &rule90},+ {44009, 2, &rule122},+ {44011, 1, &rule2},+ {44012, 1, &rule122},+ {44013, 1, &rule90},+ {44016, 10, &rule8},+ {44032, 11172, &rule14},+ {55216, 23, &rule14},+ {55243, 49, &rule14},+ {55296, 896, &rule177},+ {56192, 128, &rule177},+ {56320, 1024, &rule177},+ {57344, 6400, &rule178},+ {63744, 366, &rule14},+ {64112, 106, &rule14},+ {64256, 7, &rule20},+ {64275, 5, &rule20},+ {64285, 1, &rule14},+ {64286, 1, &rule90},+ {64287, 10, &rule14},+ {64297, 1, &rule6},+ {64298, 13, &rule14},+ {64312, 5, &rule14},+ {64318, 1, &rule14},+ {64320, 2, &rule14},+ {64323, 2, &rule14},+ {64326, 108, &rule14},+ {64434, 16, &rule10},+ {64467, 363, &rule14},+ {64830, 1, &rule5},+ {64831, 1, &rule4},+ {64848, 64, &rule14},+ {64914, 54, &rule14},+ {65008, 12, &rule14},+ {65020, 1, &rule3},+ {65021, 1, &rule13},+ {65024, 16, &rule90},+ {65040, 7, &rule2},+ {65047, 1, &rule4},+ {65048, 1, &rule5},+ {65049, 1, &rule2},+ {65056, 14, &rule90},+ {65072, 1, &rule2},+ {65073, 2, &rule7},+ {65075, 2, &rule11},+ {65077, 1, &rule4},+ {65078, 1, &rule5},+ {65079, 1, &rule4},+ {65080, 1, &rule5},+ {65081, 1, &rule4},+ {65082, 1, &rule5},+ {65083, 1, &rule4},+ {65084, 1, &rule5},+ {65085, 1, &rule4},+ {65086, 1, &rule5},+ {65087, 1, &rule4},+ {65088, 1, &rule5},+ {65089, 1, &rule4},+ {65090, 1, &rule5},+ {65091, 1, &rule4},+ {65092, 1, &rule5},+ {65093, 2, &rule2},+ {65095, 1, &rule4},+ {65096, 1, &rule5},+ {65097, 4, &rule2},+ {65101, 3, &rule11},+ {65104, 3, &rule2},+ {65108, 4, &rule2},+ {65112, 1, &rule7},+ {65113, 1, &rule4},+ {65114, 1, &rule5},+ {65115, 1, &rule4},+ {65116, 1, &rule5},+ {65117, 1, &rule4},+ {65118, 1, &rule5},+ {65119, 3, &rule2},+ {65122, 1, &rule6},+ {65123, 1, &rule7},+ {65124, 3, &rule6},+ {65128, 1, &rule2},+ {65129, 1, &rule3},+ {65130, 2, &rule2},+ {65136, 5, &rule14},+ {65142, 135, &rule14},+ {65279, 1, &rule16},+ {65281, 3, &rule2},+ {65284, 1, &rule3},+ {65285, 3, &rule2},+ {65288, 1, &rule4},+ {65289, 1, &rule5},+ {65290, 1, &rule2},+ {65291, 1, &rule6},+ {65292, 1, &rule2},+ {65293, 1, &rule7},+ {65294, 2, &rule2},+ {65296, 10, &rule8},+ {65306, 2, &rule2},+ {65308, 3, &rule6},+ {65311, 2, &rule2},+ {65313, 26, &rule9},+ {65339, 1, &rule4},+ {65340, 1, &rule2},+ {65341, 1, &rule5},+ {65342, 1, &rule10},+ {65343, 1, &rule11},+ {65344, 1, &rule10},+ {65345, 26, &rule12},+ {65371, 1, &rule4},+ {65372, 1, &rule6},+ {65373, 1, &rule5},+ {65374, 1, &rule6},+ {65375, 1, &rule4},+ {65376, 1, &rule5},+ {65377, 1, &rule2},+ {65378, 1, &rule4},+ {65379, 1, &rule5},+ {65380, 2, &rule2},+ {65382, 10, &rule14},+ {65392, 1, &rule89},+ {65393, 45, &rule14},+ {65438, 2, &rule89},+ {65440, 31, &rule14},+ {65474, 6, &rule14},+ {65482, 6, &rule14},+ {65490, 6, &rule14},+ {65498, 3, &rule14},+ {65504, 2, &rule3},+ {65506, 1, &rule6},+ {65507, 1, &rule10},+ {65508, 1, &rule13},+ {65509, 2, &rule3},+ {65512, 1, &rule13},+ {65513, 4, &rule6},+ {65517, 2, &rule13},+ {65529, 3, &rule16},+ {65532, 2, &rule13},+ {65536, 12, &rule14},+ {65549, 26, &rule14},+ {65576, 19, &rule14},+ {65596, 2, &rule14},+ {65599, 15, &rule14},+ {65616, 14, &rule14},+ {65664, 123, &rule14},+ {65792, 3, &rule2},+ {65799, 45, &rule17},+ {65847, 9, &rule13},+ {65856, 53, &rule124},+ {65909, 4, &rule17},+ {65913, 17, &rule13},+ {65930, 2, &rule17},+ {65932, 1, &rule13},+ {65936, 12, &rule13},+ {65952, 1, &rule13},+ {66000, 45, &rule13},+ {66045, 1, &rule90},+ {66176, 29, &rule14},+ {66208, 49, &rule14},+ {66272, 1, &rule90},+ {66273, 27, &rule17},+ {66304, 32, &rule14},+ {66336, 4, &rule17},+ {66352, 17, &rule14},+ {66369, 1, &rule124},+ {66370, 8, &rule14},+ {66378, 1, &rule124},+ {66384, 38, &rule14},+ {66422, 5, &rule90},+ {66432, 30, &rule14},+ {66463, 1, &rule2},+ {66464, 36, &rule14},+ {66504, 8, &rule14},+ {66512, 1, &rule2},+ {66513, 5, &rule124},+ {66560, 40, &rule179},+ {66600, 40, &rule180},+ {66640, 78, &rule14},+ {66720, 10, &rule8},+ {66816, 40, &rule14},+ {66864, 52, &rule14},+ {66927, 1, &rule2},+ {67072, 311, &rule14},+ {67392, 22, &rule14},+ {67424, 8, &rule14},+ {67584, 6, &rule14},+ {67592, 1, &rule14},+ {67594, 44, &rule14},+ {67639, 2, &rule14},+ {67644, 1, &rule14},+ {67647, 23, &rule14},+ {67671, 1, &rule2},+ {67672, 8, &rule17},+ {67680, 23, &rule14},+ {67703, 2, &rule13},+ {67705, 7, &rule17},+ {67712, 31, &rule14},+ {67751, 9, &rule17},+ {67840, 22, &rule14},+ {67862, 6, &rule17},+ {67871, 1, &rule2},+ {67872, 26, &rule14},+ {67903, 1, &rule2},+ {67968, 56, &rule14},+ {68030, 2, &rule14},+ {68096, 1, &rule14},+ {68097, 3, &rule90},+ {68101, 2, &rule90},+ {68108, 4, &rule90},+ {68112, 4, &rule14},+ {68117, 3, &rule14},+ {68121, 27, &rule14},+ {68152, 3, &rule90},+ {68159, 1, &rule90},+ {68160, 8, &rule17},+ {68176, 9, &rule2},+ {68192, 29, &rule14},+ {68221, 2, &rule17},+ {68223, 1, &rule2},+ {68224, 29, &rule14},+ {68253, 3, &rule17},+ {68288, 8, &rule14},+ {68296, 1, &rule13},+ {68297, 28, &rule14},+ {68325, 2, &rule90},+ {68331, 5, &rule17},+ {68336, 7, &rule2},+ {68352, 54, &rule14},+ {68409, 7, &rule2},+ {68416, 22, &rule14},+ {68440, 8, &rule17},+ {68448, 19, &rule14},+ {68472, 8, &rule17},+ {68480, 18, &rule14},+ {68505, 4, &rule2},+ {68521, 7, &rule17},+ {68608, 73, &rule14},+ {69216, 31, &rule17},+ {69632, 1, &rule122},+ {69633, 1, &rule90},+ {69634, 1, &rule122},+ {69635, 53, &rule14},+ {69688, 15, &rule90},+ {69703, 7, &rule2},+ {69714, 20, &rule17},+ {69734, 10, &rule8},+ {69759, 3, &rule90},+ {69762, 1, &rule122},+ {69763, 45, &rule14},+ {69808, 3, &rule122},+ {69811, 4, &rule90},+ {69815, 2, &rule122},+ {69817, 2, &rule90},+ {69819, 2, &rule2},+ {69821, 1, &rule16},+ {69822, 4, &rule2},+ {69840, 25, &rule14},+ {69872, 10, &rule8},+ {69888, 3, &rule90},+ {69891, 36, &rule14},+ {69927, 5, &rule90},+ {69932, 1, &rule122},+ {69933, 8, &rule90},+ {69942, 10, &rule8},+ {69952, 4, &rule2},+ {69968, 35, &rule14},+ {70003, 1, &rule90},+ {70004, 2, &rule2},+ {70006, 1, &rule14},+ {70016, 2, &rule90},+ {70018, 1, &rule122},+ {70019, 48, &rule14},+ {70067, 3, &rule122},+ {70070, 9, &rule90},+ {70079, 2, &rule122},+ {70081, 4, &rule14},+ {70085, 4, &rule2},+ {70093, 1, &rule2},+ {70096, 10, &rule8},+ {70106, 1, &rule14},+ {70113, 20, &rule17},+ {70144, 18, &rule14},+ {70163, 25, &rule14},+ {70188, 3, &rule122},+ {70191, 3, &rule90},+ {70194, 2, &rule122},+ {70196, 1, &rule90},+ {70197, 1, &rule122},+ {70198, 2, &rule90},+ {70200, 6, &rule2},+ {70320, 47, &rule14},+ {70367, 1, &rule90},+ {70368, 3, &rule122},+ {70371, 8, &rule90},+ {70384, 10, &rule8},+ {70401, 1, &rule90},+ {70402, 2, &rule122},+ {70405, 8, &rule14},+ {70415, 2, &rule14},+ {70419, 22, &rule14},+ {70442, 7, &rule14},+ {70450, 2, &rule14},+ {70453, 5, &rule14},+ {70460, 1, &rule90},+ {70461, 1, &rule14},+ {70462, 2, &rule122},+ {70464, 1, &rule90},+ {70465, 4, &rule122},+ {70471, 2, &rule122},+ {70475, 3, &rule122},+ {70487, 1, &rule122},+ {70493, 5, &rule14},+ {70498, 2, &rule122},+ {70502, 7, &rule90},+ {70512, 5, &rule90},+ {70784, 48, &rule14},+ {70832, 3, &rule122},+ {70835, 6, &rule90},+ {70841, 1, &rule122},+ {70842, 1, &rule90},+ {70843, 4, &rule122},+ {70847, 2, &rule90},+ {70849, 1, &rule122},+ {70850, 2, &rule90},+ {70852, 2, &rule14},+ {70854, 1, &rule2},+ {70855, 1, &rule14},+ {70864, 10, &rule8},+ {71040, 47, &rule14},+ {71087, 3, &rule122},+ {71090, 4, &rule90},+ {71096, 4, &rule122},+ {71100, 2, &rule90},+ {71102, 1, &rule122},+ {71103, 2, &rule90},+ {71105, 9, &rule2},+ {71168, 48, &rule14},+ {71216, 3, &rule122},+ {71219, 8, &rule90},+ {71227, 2, &rule122},+ {71229, 1, &rule90},+ {71230, 1, &rule122},+ {71231, 2, &rule90},+ {71233, 3, &rule2},+ {71236, 1, &rule14},+ {71248, 10, &rule8},+ {71296, 43, &rule14},+ {71339, 1, &rule90},+ {71340, 1, &rule122},+ {71341, 1, &rule90},+ {71342, 2, &rule122},+ {71344, 6, &rule90},+ {71350, 1, &rule122},+ {71351, 1, &rule90},+ {71360, 10, &rule8},+ {71840, 32, &rule9},+ {71872, 32, &rule12},+ {71904, 10, &rule8},+ {71914, 9, &rule17},+ {71935, 1, &rule14},+ {72384, 57, &rule14},+ {73728, 921, &rule14},+ {74752, 111, &rule124},+ {74864, 5, &rule2},+ {77824, 1071, &rule14},+ {92160, 569, &rule14},+ {92736, 31, &rule14},+ {92768, 10, &rule8},+ {92782, 2, &rule2},+ {92880, 30, &rule14},+ {92912, 5, &rule90},+ {92917, 1, &rule2},+ {92928, 48, &rule14},+ {92976, 7, &rule90},+ {92983, 5, &rule2},+ {92988, 4, &rule13},+ {92992, 4, &rule89},+ {92996, 1, &rule2},+ {92997, 1, &rule13},+ {93008, 10, &rule8},+ {93019, 7, &rule17},+ {93027, 21, &rule14},+ {93053, 19, &rule14},+ {93952, 69, &rule14},+ {94032, 1, &rule14},+ {94033, 46, &rule122},+ {94095, 4, &rule90},+ {94099, 13, &rule89},+ {110592, 2, &rule14},+ {113664, 107, &rule14},+ {113776, 13, &rule14},+ {113792, 9, &rule14},+ {113808, 10, &rule14},+ {113820, 1, &rule13},+ {113821, 2, &rule90},+ {113823, 1, &rule2},+ {113824, 4, &rule16},+ {118784, 246, &rule13},+ {119040, 39, &rule13},+ {119081, 60, &rule13},+ {119141, 2, &rule122},+ {119143, 3, &rule90},+ {119146, 3, &rule13},+ {119149, 6, &rule122},+ {119155, 8, &rule16},+ {119163, 8, &rule90},+ {119171, 2, &rule13},+ {119173, 7, &rule90},+ {119180, 30, &rule13},+ {119210, 4, &rule90},+ {119214, 48, &rule13},+ {119296, 66, &rule13},+ {119362, 3, &rule90},+ {119365, 1, &rule13},+ {119552, 87, &rule13},+ {119648, 18, &rule17},+ {119808, 26, &rule105},+ {119834, 26, &rule20},+ {119860, 26, &rule105},+ {119886, 7, &rule20},+ {119894, 18, &rule20},+ {119912, 26, &rule105},+ {119938, 26, &rule20},+ {119964, 1, &rule105},+ {119966, 2, &rule105},+ {119970, 1, &rule105},+ {119973, 2, &rule105},+ {119977, 4, &rule105},+ {119982, 8, &rule105},+ {119990, 4, &rule20},+ {119995, 1, &rule20},+ {119997, 7, &rule20},+ {120005, 11, &rule20},+ {120016, 26, &rule105},+ {120042, 26, &rule20},+ {120068, 2, &rule105},+ {120071, 4, &rule105},+ {120077, 8, &rule105},+ {120086, 7, &rule105},+ {120094, 26, &rule20},+ {120120, 2, &rule105},+ {120123, 4, &rule105},+ {120128, 5, &rule105},+ {120134, 1, &rule105},+ {120138, 7, &rule105},+ {120146, 26, &rule20},+ {120172, 26, &rule105},+ {120198, 26, &rule20},+ {120224, 26, &rule105},+ {120250, 26, &rule20},+ {120276, 26, &rule105},+ {120302, 26, &rule20},+ {120328, 26, &rule105},+ {120354, 26, &rule20},+ {120380, 26, &rule105},+ {120406, 26, &rule20},+ {120432, 26, &rule105},+ {120458, 28, &rule20},+ {120488, 25, &rule105},+ {120513, 1, &rule6},+ {120514, 25, &rule20},+ {120539, 1, &rule6},+ {120540, 6, &rule20},+ {120546, 25, &rule105},+ {120571, 1, &rule6},+ {120572, 25, &rule20},+ {120597, 1, &rule6},+ {120598, 6, &rule20},+ {120604, 25, &rule105},+ {120629, 1, &rule6},+ {120630, 25, &rule20},+ {120655, 1, &rule6},+ {120656, 6, &rule20},+ {120662, 25, &rule105},+ {120687, 1, &rule6},+ {120688, 25, &rule20},+ {120713, 1, &rule6},+ {120714, 6, &rule20},+ {120720, 25, &rule105},+ {120745, 1, &rule6},+ {120746, 25, &rule20},+ {120771, 1, &rule6},+ {120772, 6, &rule20},+ {120778, 1, &rule105},+ {120779, 1, &rule20},+ {120782, 50, &rule8},+ {124928, 197, &rule14},+ {125127, 9, &rule17},+ {125136, 7, &rule90},+ {126464, 4, &rule14},+ {126469, 27, &rule14},+ {126497, 2, &rule14},+ {126500, 1, &rule14},+ {126503, 1, &rule14},+ {126505, 10, &rule14},+ {126516, 4, &rule14},+ {126521, 1, &rule14},+ {126523, 1, &rule14},+ {126530, 1, &rule14},+ {126535, 1, &rule14},+ {126537, 1, &rule14},+ {126539, 1, &rule14},+ {126541, 3, &rule14},+ {126545, 2, &rule14},+ {126548, 1, &rule14},+ {126551, 1, &rule14},+ {126553, 1, &rule14},+ {126555, 1, &rule14},+ {126557, 1, &rule14},+ {126559, 1, &rule14},+ {126561, 2, &rule14},+ {126564, 1, &rule14},+ {126567, 4, &rule14},+ {126572, 7, &rule14},+ {126580, 4, &rule14},+ {126585, 4, &rule14},+ {126590, 1, &rule14},+ {126592, 10, &rule14},+ {126603, 17, &rule14},+ {126625, 3, &rule14},+ {126629, 5, &rule14},+ {126635, 17, &rule14},+ {126704, 2, &rule6},+ {126976, 44, &rule13},+ {127024, 100, &rule13},+ {127136, 15, &rule13},+ {127153, 15, &rule13},+ {127169, 15, &rule13},+ {127185, 37, &rule13},+ {127232, 13, &rule17},+ {127248, 31, &rule13},+ {127280, 60, &rule13},+ {127344, 43, &rule13},+ {127462, 29, &rule13},+ {127504, 43, &rule13},+ {127552, 9, &rule13},+ {127568, 2, &rule13},+ {127744, 45, &rule13},+ {127792, 78, &rule13},+ {127872, 79, &rule13},+ {127956, 36, &rule13},+ {128000, 255, &rule13},+ {128256, 75, &rule13},+ {128336, 42, &rule13},+ {128379, 41, &rule13},+ {128421, 158, &rule13},+ {128581, 139, &rule13},+ {128736, 13, &rule13},+ {128752, 4, &rule13},+ {128768, 116, &rule13},+ {128896, 85, &rule13},+ {129024, 12, &rule13},+ {129040, 56, &rule13},+ {129104, 10, &rule13},+ {129120, 40, &rule13},+ {129168, 30, &rule13},+ {131072, 42711, &rule14},+ {173824, 4149, &rule14},+ {177984, 222, &rule14},+ {194560, 542, &rule14},+ {917505, 1, &rule16},+ {917536, 96, &rule16},+ {917760, 240, &rule90},+ {983040, 65534, &rule178},+ {1048576, 65534, &rule178}+};+static const struct _charblock_ convchars[]={+ {65, 26, &rule9},+ {97, 26, &rule12},+ {181, 1, &rule18},+ {192, 23, &rule9},+ {216, 7, &rule9},+ {224, 23, &rule12},+ {248, 7, &rule12},+ {255, 1, &rule21},+ {256, 1, &rule22},+ {257, 1, &rule23},+ {258, 1, &rule22},+ {259, 1, &rule23},+ {260, 1, &rule22},+ {261, 1, &rule23},+ {262, 1, &rule22},+ {263, 1, &rule23},+ {264, 1, &rule22},+ {265, 1, &rule23},+ {266, 1, &rule22},+ {267, 1, &rule23},+ {268, 1, &rule22},+ {269, 1, &rule23},+ {270, 1, &rule22},+ {271, 1, &rule23},+ {272, 1, &rule22},+ {273, 1, &rule23},+ {274, 1, &rule22},+ {275, 1, &rule23},+ {276, 1, &rule22},+ {277, 1, &rule23},+ {278, 1, &rule22},+ {279, 1, &rule23},+ {280, 1, &rule22},+ {281, 1, &rule23},+ {282, 1, &rule22},+ {283, 1, &rule23},+ {284, 1, &rule22},+ {285, 1, &rule23},+ {286, 1, &rule22},+ {287, 1, &rule23},+ {288, 1, &rule22},+ {289, 1, &rule23},+ {290, 1, &rule22},+ {291, 1, &rule23},+ {292, 1, &rule22},+ {293, 1, &rule23},+ {294, 1, &rule22},+ {295, 1, &rule23},+ {296, 1, &rule22},+ {297, 1, &rule23},+ {298, 1, &rule22},+ {299, 1, &rule23},+ {300, 1, &rule22},+ {301, 1, &rule23},+ {302, 1, &rule22},+ {303, 1, &rule23},+ {304, 1, &rule24},+ {305, 1, &rule25},+ {306, 1, &rule22},+ {307, 1, &rule23},+ {308, 1, &rule22},+ {309, 1, &rule23},+ {310, 1, &rule22},+ {311, 1, &rule23},+ {313, 1, &rule22},+ {314, 1, &rule23},+ {315, 1, &rule22},+ {316, 1, &rule23},+ {317, 1, &rule22},+ {318, 1, &rule23},+ {319, 1, &rule22},+ {320, 1, &rule23},+ {321, 1, &rule22},+ {322, 1, &rule23},+ {323, 1, &rule22},+ {324, 1, &rule23},+ {325, 1, &rule22},+ {326, 1, &rule23},+ {327, 1, &rule22},+ {328, 1, &rule23},+ {330, 1, &rule22},+ {331, 1, &rule23},+ {332, 1, &rule22},+ {333, 1, &rule23},+ {334, 1, &rule22},+ {335, 1, &rule23},+ {336, 1, &rule22},+ {337, 1, &rule23},+ {338, 1, &rule22},+ {339, 1, &rule23},+ {340, 1, &rule22},+ {341, 1, &rule23},+ {342, 1, &rule22},+ {343, 1, &rule23},+ {344, 1, &rule22},+ {345, 1, &rule23},+ {346, 1, &rule22},+ {347, 1, &rule23},+ {348, 1, &rule22},+ {349, 1, &rule23},+ {350, 1, &rule22},+ {351, 1, &rule23},+ {352, 1, &rule22},+ {353, 1, &rule23},+ {354, 1, &rule22},+ {355, 1, &rule23},+ {356, 1, &rule22},+ {357, 1, &rule23},+ {358, 1, &rule22},+ {359, 1, &rule23},+ {360, 1, &rule22},+ {361, 1, &rule23},+ {362, 1, &rule22},+ {363, 1, &rule23},+ {364, 1, &rule22},+ {365, 1, &rule23},+ {366, 1, &rule22},+ {367, 1, &rule23},+ {368, 1, &rule22},+ {369, 1, &rule23},+ {370, 1, &rule22},+ {371, 1, &rule23},+ {372, 1, &rule22},+ {373, 1, &rule23},+ {374, 1, &rule22},+ {375, 1, &rule23},+ {376, 1, &rule26},+ {377, 1, &rule22},+ {378, 1, &rule23},+ {379, 1, &rule22},+ {380, 1, &rule23},+ {381, 1, &rule22},+ {382, 1, &rule23},+ {383, 1, &rule27},+ {384, 1, &rule28},+ {385, 1, &rule29},+ {386, 1, &rule22},+ {387, 1, &rule23},+ {388, 1, &rule22},+ {389, 1, &rule23},+ {390, 1, &rule30},+ {391, 1, &rule22},+ {392, 1, &rule23},+ {393, 2, &rule31},+ {395, 1, &rule22},+ {396, 1, &rule23},+ {398, 1, &rule32},+ {399, 1, &rule33},+ {400, 1, &rule34},+ {401, 1, &rule22},+ {402, 1, &rule23},+ {403, 1, &rule31},+ {404, 1, &rule35},+ {405, 1, &rule36},+ {406, 1, &rule37},+ {407, 1, &rule38},+ {408, 1, &rule22},+ {409, 1, &rule23},+ {410, 1, &rule39},+ {412, 1, &rule37},+ {413, 1, &rule40},+ {414, 1, &rule41},+ {415, 1, &rule42},+ {416, 1, &rule22},+ {417, 1, &rule23},+ {418, 1, &rule22},+ {419, 1, &rule23},+ {420, 1, &rule22},+ {421, 1, &rule23},+ {422, 1, &rule43},+ {423, 1, &rule22},+ {424, 1, &rule23},+ {425, 1, &rule43},+ {428, 1, &rule22},+ {429, 1, &rule23},+ {430, 1, &rule43},+ {431, 1, &rule22},+ {432, 1, &rule23},+ {433, 2, &rule44},+ {435, 1, &rule22},+ {436, 1, &rule23},+ {437, 1, &rule22},+ {438, 1, &rule23},+ {439, 1, &rule45},+ {440, 1, &rule22},+ {441, 1, &rule23},+ {444, 1, &rule22},+ {445, 1, &rule23},+ {447, 1, &rule46},+ {452, 1, &rule47},+ {453, 1, &rule48},+ {454, 1, &rule49},+ {455, 1, &rule47},+ {456, 1, &rule48},+ {457, 1, &rule49},+ {458, 1, &rule47},+ {459, 1, &rule48},+ {460, 1, &rule49},+ {461, 1, &rule22},+ {462, 1, &rule23},+ {463, 1, &rule22},+ {464, 1, &rule23},+ {465, 1, &rule22},+ {466, 1, &rule23},+ {467, 1, &rule22},+ {468, 1, &rule23},+ {469, 1, &rule22},+ {470, 1, &rule23},+ {471, 1, &rule22},+ {472, 1, &rule23},+ {473, 1, &rule22},+ {474, 1, &rule23},+ {475, 1, &rule22},+ {476, 1, &rule23},+ {477, 1, &rule50},+ {478, 1, &rule22},+ {479, 1, &rule23},+ {480, 1, &rule22},+ {481, 1, &rule23},+ {482, 1, &rule22},+ {483, 1, &rule23},+ {484, 1, &rule22},+ {485, 1, &rule23},+ {486, 1, &rule22},+ {487, 1, &rule23},+ {488, 1, &rule22},+ {489, 1, &rule23},+ {490, 1, &rule22},+ {491, 1, &rule23},+ {492, 1, &rule22},+ {493, 1, &rule23},+ {494, 1, &rule22},+ {495, 1, &rule23},+ {497, 1, &rule47},+ {498, 1, &rule48},+ {499, 1, &rule49},+ {500, 1, &rule22},+ {501, 1, &rule23},+ {502, 1, &rule51},+ {503, 1, &rule52},+ {504, 1, &rule22},+ {505, 1, &rule23},+ {506, 1, &rule22},+ {507, 1, &rule23},+ {508, 1, &rule22},+ {509, 1, &rule23},+ {510, 1, &rule22},+ {511, 1, &rule23},+ {512, 1, &rule22},+ {513, 1, &rule23},+ {514, 1, &rule22},+ {515, 1, &rule23},+ {516, 1, &rule22},+ {517, 1, &rule23},+ {518, 1, &rule22},+ {519, 1, &rule23},+ {520, 1, &rule22},+ {521, 1, &rule23},+ {522, 1, &rule22},+ {523, 1, &rule23},+ {524, 1, &rule22},+ {525, 1, &rule23},+ {526, 1, &rule22},+ {527, 1, &rule23},+ {528, 1, &rule22},+ {529, 1, &rule23},+ {530, 1, &rule22},+ {531, 1, &rule23},+ {532, 1, &rule22},+ {533, 1, &rule23},+ {534, 1, &rule22},+ {535, 1, &rule23},+ {536, 1, &rule22},+ {537, 1, &rule23},+ {538, 1, &rule22},+ {539, 1, &rule23},+ {540, 1, &rule22},+ {541, 1, &rule23},+ {542, 1, &rule22},+ {543, 1, &rule23},+ {544, 1, &rule53},+ {546, 1, &rule22},+ {547, 1, &rule23},+ {548, 1, &rule22},+ {549, 1, &rule23},+ {550, 1, &rule22},+ {551, 1, &rule23},+ {552, 1, &rule22},+ {553, 1, &rule23},+ {554, 1, &rule22},+ {555, 1, &rule23},+ {556, 1, &rule22},+ {557, 1, &rule23},+ {558, 1, &rule22},+ {559, 1, &rule23},+ {560, 1, &rule22},+ {561, 1, &rule23},+ {562, 1, &rule22},+ {563, 1, &rule23},+ {570, 1, &rule54},+ {571, 1, &rule22},+ {572, 1, &rule23},+ {573, 1, &rule55},+ {574, 1, &rule56},+ {575, 2, &rule57},+ {577, 1, &rule22},+ {578, 1, &rule23},+ {579, 1, &rule58},+ {580, 1, &rule59},+ {581, 1, &rule60},+ {582, 1, &rule22},+ {583, 1, &rule23},+ {584, 1, &rule22},+ {585, 1, &rule23},+ {586, 1, &rule22},+ {587, 1, &rule23},+ {588, 1, &rule22},+ {589, 1, &rule23},+ {590, 1, &rule22},+ {591, 1, &rule23},+ {592, 1, &rule61},+ {593, 1, &rule62},+ {594, 1, &rule63},+ {595, 1, &rule64},+ {596, 1, &rule65},+ {598, 2, &rule66},+ {601, 1, &rule67},+ {603, 1, &rule68},+ {604, 1, &rule69},+ {608, 1, &rule66},+ {609, 1, &rule70},+ {611, 1, &rule71},+ {613, 1, &rule72},+ {614, 1, &rule73},+ {616, 1, &rule74},+ {617, 1, &rule75},+ {619, 1, &rule76},+ {620, 1, &rule77},+ {623, 1, &rule75},+ {625, 1, &rule78},+ {626, 1, &rule79},+ {629, 1, &rule80},+ {637, 1, &rule81},+ {640, 1, &rule82},+ {643, 1, &rule82},+ {647, 1, &rule83},+ {648, 1, &rule82},+ {649, 1, &rule84},+ {650, 2, &rule85},+ {652, 1, &rule86},+ {658, 1, &rule87},+ {670, 1, &rule88},+ {837, 1, &rule91},+ {880, 1, &rule22},+ {881, 1, &rule23},+ {882, 1, &rule22},+ {883, 1, &rule23},+ {886, 1, &rule22},+ {887, 1, &rule23},+ {891, 3, &rule41},+ {895, 1, &rule92},+ {902, 1, &rule93},+ {904, 3, &rule94},+ {908, 1, &rule95},+ {910, 2, &rule96},+ {913, 17, &rule9},+ {931, 9, &rule9},+ {940, 1, &rule97},+ {941, 3, &rule98},+ {945, 17, &rule12},+ {962, 1, &rule99},+ {963, 9, &rule12},+ {972, 1, &rule100},+ {973, 2, &rule101},+ {975, 1, &rule102},+ {976, 1, &rule103},+ {977, 1, &rule104},+ {981, 1, &rule106},+ {982, 1, &rule107},+ {983, 1, &rule108},+ {984, 1, &rule22},+ {985, 1, &rule23},+ {986, 1, &rule22},+ {987, 1, &rule23},+ {988, 1, &rule22},+ {989, 1, &rule23},+ {990, 1, &rule22},+ {991, 1, &rule23},+ {992, 1, &rule22},+ {993, 1, &rule23},+ {994, 1, &rule22},+ {995, 1, &rule23},+ {996, 1, &rule22},+ {997, 1, &rule23},+ {998, 1, &rule22},+ {999, 1, &rule23},+ {1000, 1, &rule22},+ {1001, 1, &rule23},+ {1002, 1, &rule22},+ {1003, 1, &rule23},+ {1004, 1, &rule22},+ {1005, 1, &rule23},+ {1006, 1, &rule22},+ {1007, 1, &rule23},+ {1008, 1, &rule109},+ {1009, 1, &rule110},+ {1010, 1, &rule111},+ {1011, 1, &rule112},+ {1012, 1, &rule113},+ {1013, 1, &rule114},+ {1015, 1, &rule22},+ {1016, 1, &rule23},+ {1017, 1, &rule115},+ {1018, 1, &rule22},+ {1019, 1, &rule23},+ {1021, 3, &rule53},+ {1024, 16, &rule116},+ {1040, 32, &rule9},+ {1072, 32, &rule12},+ {1104, 16, &rule110},+ {1120, 1, &rule22},+ {1121, 1, &rule23},+ {1122, 1, &rule22},+ {1123, 1, &rule23},+ {1124, 1, &rule22},+ {1125, 1, &rule23},+ {1126, 1, &rule22},+ {1127, 1, &rule23},+ {1128, 1, &rule22},+ {1129, 1, &rule23},+ {1130, 1, &rule22},+ {1131, 1, &rule23},+ {1132, 1, &rule22},+ {1133, 1, &rule23},+ {1134, 1, &rule22},+ {1135, 1, &rule23},+ {1136, 1, &rule22},+ {1137, 1, &rule23},+ {1138, 1, &rule22},+ {1139, 1, &rule23},+ {1140, 1, &rule22},+ {1141, 1, &rule23},+ {1142, 1, &rule22},+ {1143, 1, &rule23},+ {1144, 1, &rule22},+ {1145, 1, &rule23},+ {1146, 1, &rule22},+ {1147, 1, &rule23},+ {1148, 1, &rule22},+ {1149, 1, &rule23},+ {1150, 1, &rule22},+ {1151, 1, &rule23},+ {1152, 1, &rule22},+ {1153, 1, &rule23},+ {1162, 1, &rule22},+ {1163, 1, &rule23},+ {1164, 1, &rule22},+ {1165, 1, &rule23},+ {1166, 1, &rule22},+ {1167, 1, &rule23},+ {1168, 1, &rule22},+ {1169, 1, &rule23},+ {1170, 1, &rule22},+ {1171, 1, &rule23},+ {1172, 1, &rule22},+ {1173, 1, &rule23},+ {1174, 1, &rule22},+ {1175, 1, &rule23},+ {1176, 1, &rule22},+ {1177, 1, &rule23},+ {1178, 1, &rule22},+ {1179, 1, &rule23},+ {1180, 1, &rule22},+ {1181, 1, &rule23},+ {1182, 1, &rule22},+ {1183, 1, &rule23},+ {1184, 1, &rule22},+ {1185, 1, &rule23},+ {1186, 1, &rule22},+ {1187, 1, &rule23},+ {1188, 1, &rule22},+ {1189, 1, &rule23},+ {1190, 1, &rule22},+ {1191, 1, &rule23},+ {1192, 1, &rule22},+ {1193, 1, &rule23},+ {1194, 1, &rule22},+ {1195, 1, &rule23},+ {1196, 1, &rule22},+ {1197, 1, &rule23},+ {1198, 1, &rule22},+ {1199, 1, &rule23},+ {1200, 1, &rule22},+ {1201, 1, &rule23},+ {1202, 1, &rule22},+ {1203, 1, &rule23},+ {1204, 1, &rule22},+ {1205, 1, &rule23},+ {1206, 1, &rule22},+ {1207, 1, &rule23},+ {1208, 1, &rule22},+ {1209, 1, &rule23},+ {1210, 1, &rule22},+ {1211, 1, &rule23},+ {1212, 1, &rule22},+ {1213, 1, &rule23},+ {1214, 1, &rule22},+ {1215, 1, &rule23},+ {1216, 1, &rule118},+ {1217, 1, &rule22},+ {1218, 1, &rule23},+ {1219, 1, &rule22},+ {1220, 1, &rule23},+ {1221, 1, &rule22},+ {1222, 1, &rule23},+ {1223, 1, &rule22},+ {1224, 1, &rule23},+ {1225, 1, &rule22},+ {1226, 1, &rule23},+ {1227, 1, &rule22},+ {1228, 1, &rule23},+ {1229, 1, &rule22},+ {1230, 1, &rule23},+ {1231, 1, &rule119},+ {1232, 1, &rule22},+ {1233, 1, &rule23},+ {1234, 1, &rule22},+ {1235, 1, &rule23},+ {1236, 1, &rule22},+ {1237, 1, &rule23},+ {1238, 1, &rule22},+ {1239, 1, &rule23},+ {1240, 1, &rule22},+ {1241, 1, &rule23},+ {1242, 1, &rule22},+ {1243, 1, &rule23},+ {1244, 1, &rule22},+ {1245, 1, &rule23},+ {1246, 1, &rule22},+ {1247, 1, &rule23},+ {1248, 1, &rule22},+ {1249, 1, &rule23},+ {1250, 1, &rule22},+ {1251, 1, &rule23},+ {1252, 1, &rule22},+ {1253, 1, &rule23},+ {1254, 1, &rule22},+ {1255, 1, &rule23},+ {1256, 1, &rule22},+ {1257, 1, &rule23},+ {1258, 1, &rule22},+ {1259, 1, &rule23},+ {1260, 1, &rule22},+ {1261, 1, &rule23},+ {1262, 1, &rule22},+ {1263, 1, &rule23},+ {1264, 1, &rule22},+ {1265, 1, &rule23},+ {1266, 1, &rule22},+ {1267, 1, &rule23},+ {1268, 1, &rule22},+ {1269, 1, &rule23},+ {1270, 1, &rule22},+ {1271, 1, &rule23},+ {1272, 1, &rule22},+ {1273, 1, &rule23},+ {1274, 1, &rule22},+ {1275, 1, &rule23},+ {1276, 1, &rule22},+ {1277, 1, &rule23},+ {1278, 1, &rule22},+ {1279, 1, &rule23},+ {1280, 1, &rule22},+ {1281, 1, &rule23},+ {1282, 1, &rule22},+ {1283, 1, &rule23},+ {1284, 1, &rule22},+ {1285, 1, &rule23},+ {1286, 1, &rule22},+ {1287, 1, &rule23},+ {1288, 1, &rule22},+ {1289, 1, &rule23},+ {1290, 1, &rule22},+ {1291, 1, &rule23},+ {1292, 1, &rule22},+ {1293, 1, &rule23},+ {1294, 1, &rule22},+ {1295, 1, &rule23},+ {1296, 1, &rule22},+ {1297, 1, &rule23},+ {1298, 1, &rule22},+ {1299, 1, &rule23},+ {1300, 1, &rule22},+ {1301, 1, &rule23},+ {1302, 1, &rule22},+ {1303, 1, &rule23},+ {1304, 1, &rule22},+ {1305, 1, &rule23},+ {1306, 1, &rule22},+ {1307, 1, &rule23},+ {1308, 1, &rule22},+ {1309, 1, &rule23},+ {1310, 1, &rule22},+ {1311, 1, &rule23},+ {1312, 1, &rule22},+ {1313, 1, &rule23},+ {1314, 1, &rule22},+ {1315, 1, &rule23},+ {1316, 1, &rule22},+ {1317, 1, &rule23},+ {1318, 1, &rule22},+ {1319, 1, &rule23},+ {1320, 1, &rule22},+ {1321, 1, &rule23},+ {1322, 1, &rule22},+ {1323, 1, &rule23},+ {1324, 1, &rule22},+ {1325, 1, &rule23},+ {1326, 1, &rule22},+ {1327, 1, &rule23},+ {1329, 38, &rule120},+ {1377, 38, &rule121},+ {4256, 38, &rule123},+ {4295, 1, &rule123},+ {4301, 1, &rule123},+ {7545, 1, &rule125},+ {7549, 1, &rule126},+ {7680, 1, &rule22},+ {7681, 1, &rule23},+ {7682, 1, &rule22},+ {7683, 1, &rule23},+ {7684, 1, &rule22},+ {7685, 1, &rule23},+ {7686, 1, &rule22},+ {7687, 1, &rule23},+ {7688, 1, &rule22},+ {7689, 1, &rule23},+ {7690, 1, &rule22},+ {7691, 1, &rule23},+ {7692, 1, &rule22},+ {7693, 1, &rule23},+ {7694, 1, &rule22},+ {7695, 1, &rule23},+ {7696, 1, &rule22},+ {7697, 1, &rule23},+ {7698, 1, &rule22},+ {7699, 1, &rule23},+ {7700, 1, &rule22},+ {7701, 1, &rule23},+ {7702, 1, &rule22},+ {7703, 1, &rule23},+ {7704, 1, &rule22},+ {7705, 1, &rule23},+ {7706, 1, &rule22},+ {7707, 1, &rule23},+ {7708, 1, &rule22},+ {7709, 1, &rule23},+ {7710, 1, &rule22},+ {7711, 1, &rule23},+ {7712, 1, &rule22},+ {7713, 1, &rule23},+ {7714, 1, &rule22},+ {7715, 1, &rule23},+ {7716, 1, &rule22},+ {7717, 1, &rule23},+ {7718, 1, &rule22},+ {7719, 1, &rule23},+ {7720, 1, &rule22},+ {7721, 1, &rule23},+ {7722, 1, &rule22},+ {7723, 1, &rule23},+ {7724, 1, &rule22},+ {7725, 1, &rule23},+ {7726, 1, &rule22},+ {7727, 1, &rule23},+ {7728, 1, &rule22},+ {7729, 1, &rule23},+ {7730, 1, &rule22},+ {7731, 1, &rule23},+ {7732, 1, &rule22},+ {7733, 1, &rule23},+ {7734, 1, &rule22},+ {7735, 1, &rule23},+ {7736, 1, &rule22},+ {7737, 1, &rule23},+ {7738, 1, &rule22},+ {7739, 1, &rule23},+ {7740, 1, &rule22},+ {7741, 1, &rule23},+ {7742, 1, &rule22},+ {7743, 1, &rule23},+ {7744, 1, &rule22},+ {7745, 1, &rule23},+ {7746, 1, &rule22},+ {7747, 1, &rule23},+ {7748, 1, &rule22},+ {7749, 1, &rule23},+ {7750, 1, &rule22},+ {7751, 1, &rule23},+ {7752, 1, &rule22},+ {7753, 1, &rule23},+ {7754, 1, &rule22},+ {7755, 1, &rule23},+ {7756, 1, &rule22},+ {7757, 1, &rule23},+ {7758, 1, &rule22},+ {7759, 1, &rule23},+ {7760, 1, &rule22},+ {7761, 1, &rule23},+ {7762, 1, &rule22},+ {7763, 1, &rule23},+ {7764, 1, &rule22},+ {7765, 1, &rule23},+ {7766, 1, &rule22},+ {7767, 1, &rule23},+ {7768, 1, &rule22},+ {7769, 1, &rule23},+ {7770, 1, &rule22},+ {7771, 1, &rule23},+ {7772, 1, &rule22},+ {7773, 1, &rule23},+ {7774, 1, &rule22},+ {7775, 1, &rule23},+ {7776, 1, &rule22},+ {7777, 1, &rule23},+ {7778, 1, &rule22},+ {7779, 1, &rule23},+ {7780, 1, &rule22},+ {7781, 1, &rule23},+ {7782, 1, &rule22},+ {7783, 1, &rule23},+ {7784, 1, &rule22},+ {7785, 1, &rule23},+ {7786, 1, &rule22},+ {7787, 1, &rule23},+ {7788, 1, &rule22},+ {7789, 1, &rule23},+ {7790, 1, &rule22},+ {7791, 1, &rule23},+ {7792, 1, &rule22},+ {7793, 1, &rule23},+ {7794, 1, &rule22},+ {7795, 1, &rule23},+ {7796, 1, &rule22},+ {7797, 1, &rule23},+ {7798, 1, &rule22},+ {7799, 1, &rule23},+ {7800, 1, &rule22},+ {7801, 1, &rule23},+ {7802, 1, &rule22},+ {7803, 1, &rule23},+ {7804, 1, &rule22},+ {7805, 1, &rule23},+ {7806, 1, &rule22},+ {7807, 1, &rule23},+ {7808, 1, &rule22},+ {7809, 1, &rule23},+ {7810, 1, &rule22},+ {7811, 1, &rule23},+ {7812, 1, &rule22},+ {7813, 1, &rule23},+ {7814, 1, &rule22},+ {7815, 1, &rule23},+ {7816, 1, &rule22},+ {7817, 1, &rule23},+ {7818, 1, &rule22},+ {7819, 1, &rule23},+ {7820, 1, &rule22},+ {7821, 1, &rule23},+ {7822, 1, &rule22},+ {7823, 1, &rule23},+ {7824, 1, &rule22},+ {7825, 1, &rule23},+ {7826, 1, &rule22},+ {7827, 1, &rule23},+ {7828, 1, &rule22},+ {7829, 1, &rule23},+ {7835, 1, &rule127},+ {7838, 1, &rule128},+ {7840, 1, &rule22},+ {7841, 1, &rule23},+ {7842, 1, &rule22},+ {7843, 1, &rule23},+ {7844, 1, &rule22},+ {7845, 1, &rule23},+ {7846, 1, &rule22},+ {7847, 1, &rule23},+ {7848, 1, &rule22},+ {7849, 1, &rule23},+ {7850, 1, &rule22},+ {7851, 1, &rule23},+ {7852, 1, &rule22},+ {7853, 1, &rule23},+ {7854, 1, &rule22},+ {7855, 1, &rule23},+ {7856, 1, &rule22},+ {7857, 1, &rule23},+ {7858, 1, &rule22},+ {7859, 1, &rule23},+ {7860, 1, &rule22},+ {7861, 1, &rule23},+ {7862, 1, &rule22},+ {7863, 1, &rule23},+ {7864, 1, &rule22},+ {7865, 1, &rule23},+ {7866, 1, &rule22},+ {7867, 1, &rule23},+ {7868, 1, &rule22},+ {7869, 1, &rule23},+ {7870, 1, &rule22},+ {7871, 1, &rule23},+ {7872, 1, &rule22},+ {7873, 1, &rule23},+ {7874, 1, &rule22},+ {7875, 1, &rule23},+ {7876, 1, &rule22},+ {7877, 1, &rule23},+ {7878, 1, &rule22},+ {7879, 1, &rule23},+ {7880, 1, &rule22},+ {7881, 1, &rule23},+ {7882, 1, &rule22},+ {7883, 1, &rule23},+ {7884, 1, &rule22},+ {7885, 1, &rule23},+ {7886, 1, &rule22},+ {7887, 1, &rule23},+ {7888, 1, &rule22},+ {7889, 1, &rule23},+ {7890, 1, &rule22},+ {7891, 1, &rule23},+ {7892, 1, &rule22},+ {7893, 1, &rule23},+ {7894, 1, &rule22},+ {7895, 1, &rule23},+ {7896, 1, &rule22},+ {7897, 1, &rule23},+ {7898, 1, &rule22},+ {7899, 1, &rule23},+ {7900, 1, &rule22},+ {7901, 1, &rule23},+ {7902, 1, &rule22},+ {7903, 1, &rule23},+ {7904, 1, &rule22},+ {7905, 1, &rule23},+ {7906, 1, &rule22},+ {7907, 1, &rule23},+ {7908, 1, &rule22},+ {7909, 1, &rule23},+ {7910, 1, &rule22},+ {7911, 1, &rule23},+ {7912, 1, &rule22},+ {7913, 1, &rule23},+ {7914, 1, &rule22},+ {7915, 1, &rule23},+ {7916, 1, &rule22},+ {7917, 1, &rule23},+ {7918, 1, &rule22},+ {7919, 1, &rule23},+ {7920, 1, &rule22},+ {7921, 1, &rule23},+ {7922, 1, &rule22},+ {7923, 1, &rule23},+ {7924, 1, &rule22},+ {7925, 1, &rule23},+ {7926, 1, &rule22},+ {7927, 1, &rule23},+ {7928, 1, &rule22},+ {7929, 1, &rule23},+ {7930, 1, &rule22},+ {7931, 1, &rule23},+ {7932, 1, &rule22},+ {7933, 1, &rule23},+ {7934, 1, &rule22},+ {7935, 1, &rule23},+ {7936, 8, &rule129},+ {7944, 8, &rule130},+ {7952, 6, &rule129},+ {7960, 6, &rule130},+ {7968, 8, &rule129},+ {7976, 8, &rule130},+ {7984, 8, &rule129},+ {7992, 8, &rule130},+ {8000, 6, &rule129},+ {8008, 6, &rule130},+ {8017, 1, &rule129},+ {8019, 1, &rule129},+ {8021, 1, &rule129},+ {8023, 1, &rule129},+ {8025, 1, &rule130},+ {8027, 1, &rule130},+ {8029, 1, &rule130},+ {8031, 1, &rule130},+ {8032, 8, &rule129},+ {8040, 8, &rule130},+ {8048, 2, &rule131},+ {8050, 4, &rule132},+ {8054, 2, &rule133},+ {8056, 2, &rule134},+ {8058, 2, &rule135},+ {8060, 2, &rule136},+ {8064, 8, &rule129},+ {8072, 8, &rule137},+ {8080, 8, &rule129},+ {8088, 8, &rule137},+ {8096, 8, &rule129},+ {8104, 8, &rule137},+ {8112, 2, &rule129},+ {8115, 1, &rule138},+ {8120, 2, &rule130},+ {8122, 2, &rule139},+ {8124, 1, &rule140},+ {8126, 1, &rule141},+ {8131, 1, &rule138},+ {8136, 4, &rule142},+ {8140, 1, &rule140},+ {8144, 2, &rule129},+ {8152, 2, &rule130},+ {8154, 2, &rule143},+ {8160, 2, &rule129},+ {8165, 1, &rule111},+ {8168, 2, &rule130},+ {8170, 2, &rule144},+ {8172, 1, &rule115},+ {8179, 1, &rule138},+ {8184, 2, &rule145},+ {8186, 2, &rule146},+ {8188, 1, &rule140},+ {8486, 1, &rule149},+ {8490, 1, &rule150},+ {8491, 1, &rule151},+ {8498, 1, &rule152},+ {8526, 1, &rule153},+ {8544, 16, &rule154},+ {8560, 16, &rule155},+ {8579, 1, &rule22},+ {8580, 1, &rule23},+ {9398, 26, &rule156},+ {9424, 26, &rule157},+ {11264, 47, &rule120},+ {11312, 47, &rule121},+ {11360, 1, &rule22},+ {11361, 1, &rule23},+ {11362, 1, &rule158},+ {11363, 1, &rule159},+ {11364, 1, &rule160},+ {11365, 1, &rule161},+ {11366, 1, &rule162},+ {11367, 1, &rule22},+ {11368, 1, &rule23},+ {11369, 1, &rule22},+ {11370, 1, &rule23},+ {11371, 1, &rule22},+ {11372, 1, &rule23},+ {11373, 1, &rule163},+ {11374, 1, &rule164},+ {11375, 1, &rule165},+ {11376, 1, &rule166},+ {11378, 1, &rule22},+ {11379, 1, &rule23},+ {11381, 1, &rule22},+ {11382, 1, &rule23},+ {11390, 2, &rule167},+ {11392, 1, &rule22},+ {11393, 1, &rule23},+ {11394, 1, &rule22},+ {11395, 1, &rule23},+ {11396, 1, &rule22},+ {11397, 1, &rule23},+ {11398, 1, &rule22},+ {11399, 1, &rule23},+ {11400, 1, &rule22},+ {11401, 1, &rule23},+ {11402, 1, &rule22},+ {11403, 1, &rule23},+ {11404, 1, &rule22},+ {11405, 1, &rule23},+ {11406, 1, &rule22},+ {11407, 1, &rule23},+ {11408, 1, &rule22},+ {11409, 1, &rule23},+ {11410, 1, &rule22},+ {11411, 1, &rule23},+ {11412, 1, &rule22},+ {11413, 1, &rule23},+ {11414, 1, &rule22},+ {11415, 1, &rule23},+ {11416, 1, &rule22},+ {11417, 1, &rule23},+ {11418, 1, &rule22},+ {11419, 1, &rule23},+ {11420, 1, &rule22},+ {11421, 1, &rule23},+ {11422, 1, &rule22},+ {11423, 1, &rule23},+ {11424, 1, &rule22},+ {11425, 1, &rule23},+ {11426, 1, &rule22},+ {11427, 1, &rule23},+ {11428, 1, &rule22},+ {11429, 1, &rule23},+ {11430, 1, &rule22},+ {11431, 1, &rule23},+ {11432, 1, &rule22},+ {11433, 1, &rule23},+ {11434, 1, &rule22},+ {11435, 1, &rule23},+ {11436, 1, &rule22},+ {11437, 1, &rule23},+ {11438, 1, &rule22},+ {11439, 1, &rule23},+ {11440, 1, &rule22},+ {11441, 1, &rule23},+ {11442, 1, &rule22},+ {11443, 1, &rule23},+ {11444, 1, &rule22},+ {11445, 1, &rule23},+ {11446, 1, &rule22},+ {11447, 1, &rule23},+ {11448, 1, &rule22},+ {11449, 1, &rule23},+ {11450, 1, &rule22},+ {11451, 1, &rule23},+ {11452, 1, &rule22},+ {11453, 1, &rule23},+ {11454, 1, &rule22},+ {11455, 1, &rule23},+ {11456, 1, &rule22},+ {11457, 1, &rule23},+ {11458, 1, &rule22},+ {11459, 1, &rule23},+ {11460, 1, &rule22},+ {11461, 1, &rule23},+ {11462, 1, &rule22},+ {11463, 1, &rule23},+ {11464, 1, &rule22},+ {11465, 1, &rule23},+ {11466, 1, &rule22},+ {11467, 1, &rule23},+ {11468, 1, &rule22},+ {11469, 1, &rule23},+ {11470, 1, &rule22},+ {11471, 1, &rule23},+ {11472, 1, &rule22},+ {11473, 1, &rule23},+ {11474, 1, &rule22},+ {11475, 1, &rule23},+ {11476, 1, &rule22},+ {11477, 1, &rule23},+ {11478, 1, &rule22},+ {11479, 1, &rule23},+ {11480, 1, &rule22},+ {11481, 1, &rule23},+ {11482, 1, &rule22},+ {11483, 1, &rule23},+ {11484, 1, &rule22},+ {11485, 1, &rule23},+ {11486, 1, &rule22},+ {11487, 1, &rule23},+ {11488, 1, &rule22},+ {11489, 1, &rule23},+ {11490, 1, &rule22},+ {11491, 1, &rule23},+ {11499, 1, &rule22},+ {11500, 1, &rule23},+ {11501, 1, &rule22},+ {11502, 1, &rule23},+ {11506, 1, &rule22},+ {11507, 1, &rule23},+ {11520, 38, &rule168},+ {11559, 1, &rule168},+ {11565, 1, &rule168},+ {42560, 1, &rule22},+ {42561, 1, &rule23},+ {42562, 1, &rule22},+ {42563, 1, &rule23},+ {42564, 1, &rule22},+ {42565, 1, &rule23},+ {42566, 1, &rule22},+ {42567, 1, &rule23},+ {42568, 1, &rule22},+ {42569, 1, &rule23},+ {42570, 1, &rule22},+ {42571, 1, &rule23},+ {42572, 1, &rule22},+ {42573, 1, &rule23},+ {42574, 1, &rule22},+ {42575, 1, &rule23},+ {42576, 1, &rule22},+ {42577, 1, &rule23},+ {42578, 1, &rule22},+ {42579, 1, &rule23},+ {42580, 1, &rule22},+ {42581, 1, &rule23},+ {42582, 1, &rule22},+ {42583, 1, &rule23},+ {42584, 1, &rule22},+ {42585, 1, &rule23},+ {42586, 1, &rule22},+ {42587, 1, &rule23},+ {42588, 1, &rule22},+ {42589, 1, &rule23},+ {42590, 1, &rule22},+ {42591, 1, &rule23},+ {42592, 1, &rule22},+ {42593, 1, &rule23},+ {42594, 1, &rule22},+ {42595, 1, &rule23},+ {42596, 1, &rule22},+ {42597, 1, &rule23},+ {42598, 1, &rule22},+ {42599, 1, &rule23},+ {42600, 1, &rule22},+ {42601, 1, &rule23},+ {42602, 1, &rule22},+ {42603, 1, &rule23},+ {42604, 1, &rule22},+ {42605, 1, &rule23},+ {42624, 1, &rule22},+ {42625, 1, &rule23},+ {42626, 1, &rule22},+ {42627, 1, &rule23},+ {42628, 1, &rule22},+ {42629, 1, &rule23},+ {42630, 1, &rule22},+ {42631, 1, &rule23},+ {42632, 1, &rule22},+ {42633, 1, &rule23},+ {42634, 1, &rule22},+ {42635, 1, &rule23},+ {42636, 1, &rule22},+ {42637, 1, &rule23},+ {42638, 1, &rule22},+ {42639, 1, &rule23},+ {42640, 1, &rule22},+ {42641, 1, &rule23},+ {42642, 1, &rule22},+ {42643, 1, &rule23},+ {42644, 1, &rule22},+ {42645, 1, &rule23},+ {42646, 1, &rule22},+ {42647, 1, &rule23},+ {42648, 1, &rule22},+ {42649, 1, &rule23},+ {42650, 1, &rule22},+ {42651, 1, &rule23},+ {42786, 1, &rule22},+ {42787, 1, &rule23},+ {42788, 1, &rule22},+ {42789, 1, &rule23},+ {42790, 1, &rule22},+ {42791, 1, &rule23},+ {42792, 1, &rule22},+ {42793, 1, &rule23},+ {42794, 1, &rule22},+ {42795, 1, &rule23},+ {42796, 1, &rule22},+ {42797, 1, &rule23},+ {42798, 1, &rule22},+ {42799, 1, &rule23},+ {42802, 1, &rule22},+ {42803, 1, &rule23},+ {42804, 1, &rule22},+ {42805, 1, &rule23},+ {42806, 1, &rule22},+ {42807, 1, &rule23},+ {42808, 1, &rule22},+ {42809, 1, &rule23},+ {42810, 1, &rule22},+ {42811, 1, &rule23},+ {42812, 1, &rule22},+ {42813, 1, &rule23},+ {42814, 1, &rule22},+ {42815, 1, &rule23},+ {42816, 1, &rule22},+ {42817, 1, &rule23},+ {42818, 1, &rule22},+ {42819, 1, &rule23},+ {42820, 1, &rule22},+ {42821, 1, &rule23},+ {42822, 1, &rule22},+ {42823, 1, &rule23},+ {42824, 1, &rule22},+ {42825, 1, &rule23},+ {42826, 1, &rule22},+ {42827, 1, &rule23},+ {42828, 1, &rule22},+ {42829, 1, &rule23},+ {42830, 1, &rule22},+ {42831, 1, &rule23},+ {42832, 1, &rule22},+ {42833, 1, &rule23},+ {42834, 1, &rule22},+ {42835, 1, &rule23},+ {42836, 1, &rule22},+ {42837, 1, &rule23},+ {42838, 1, &rule22},+ {42839, 1, &rule23},+ {42840, 1, &rule22},+ {42841, 1, &rule23},+ {42842, 1, &rule22},+ {42843, 1, &rule23},+ {42844, 1, &rule22},+ {42845, 1, &rule23},+ {42846, 1, &rule22},+ {42847, 1, &rule23},+ {42848, 1, &rule22},+ {42849, 1, &rule23},+ {42850, 1, &rule22},+ {42851, 1, &rule23},+ {42852, 1, &rule22},+ {42853, 1, &rule23},+ {42854, 1, &rule22},+ {42855, 1, &rule23},+ {42856, 1, &rule22},+ {42857, 1, &rule23},+ {42858, 1, &rule22},+ {42859, 1, &rule23},+ {42860, 1, &rule22},+ {42861, 1, &rule23},+ {42862, 1, &rule22},+ {42863, 1, &rule23},+ {42873, 1, &rule22},+ {42874, 1, &rule23},+ {42875, 1, &rule22},+ {42876, 1, &rule23},+ {42877, 1, &rule169},+ {42878, 1, &rule22},+ {42879, 1, &rule23},+ {42880, 1, &rule22},+ {42881, 1, &rule23},+ {42882, 1, &rule22},+ {42883, 1, &rule23},+ {42884, 1, &rule22},+ {42885, 1, &rule23},+ {42886, 1, &rule22},+ {42887, 1, &rule23},+ {42891, 1, &rule22},+ {42892, 1, &rule23},+ {42893, 1, &rule170},+ {42896, 1, &rule22},+ {42897, 1, &rule23},+ {42898, 1, &rule22},+ {42899, 1, &rule23},+ {42902, 1, &rule22},+ {42903, 1, &rule23},+ {42904, 1, &rule22},+ {42905, 1, &rule23},+ {42906, 1, &rule22},+ {42907, 1, &rule23},+ {42908, 1, &rule22},+ {42909, 1, &rule23},+ {42910, 1, &rule22},+ {42911, 1, &rule23},+ {42912, 1, &rule22},+ {42913, 1, &rule23},+ {42914, 1, &rule22},+ {42915, 1, &rule23},+ {42916, 1, &rule22},+ {42917, 1, &rule23},+ {42918, 1, &rule22},+ {42919, 1, &rule23},+ {42920, 1, &rule22},+ {42921, 1, &rule23},+ {42922, 1, &rule171},+ {42923, 1, &rule172},+ {42924, 1, &rule173},+ {42925, 1, &rule174},+ {42928, 1, &rule175},+ {42929, 1, &rule176},+ {65313, 26, &rule9},+ {65345, 26, &rule12},+ {66560, 40, &rule179},+ {66600, 40, &rule180},+ {71840, 32, &rule9},+ {71872, 32, &rule12}+};+static const struct _charblock_ spacechars[]={+ {32, 1, &rule1},+ {160, 1, &rule1},+ {5760, 1, &rule1},+ {8192, 11, &rule1},+ {8239, 1, &rule1},+ {8287, 1, &rule1},+ {12288, 1, &rule1}+};++/*+ Obtain the reference to character rule by doing+ binary search over the specified array of blocks.+ To make checkattr shorter, the address of+ nullrule is returned if the search fails:+ this rule defines no category and no conversion+ distances. The compare function returns 0 when+ key->start is within the block. Otherwise+ result of comparison of key->start and start of the+ current block is returned as usual.+*/++static const struct _convrule_ nullrule={0,NUMCAT_CN,0,0,0,0};++static int blkcmp(const void *vk,const void *vb)+{+ const struct _charblock_ *key,*cur;+ key=vk;+ cur=vb;+ if((key->start>=cur->start)&&(key->start<(cur->start+cur->length)))+ {+ return 0;+ }+ if(key->start>cur->start) return 1;+ return -1;+}++static const struct _convrule_ *getrule(+ const struct _charblock_ *blocks,+ int numblocks,+ int unichar)+{+ struct _charblock_ key={unichar,1,(void *)0};+ struct _charblock_ *cb=bsearch(&key,blocks,numblocks,sizeof(key),blkcmp);+ if(cb==(void *)0) return &nullrule;+ return cb->rule;+}+ +++/*+ Check whether a character (internal code) has certain attributes.+ Attributes (category flags) may be ORed. The function ANDs+ character category flags and the mask and returns the result.+ If the character belongs to one of the categories requested,+ the result will be nonzero.+*/++inline static int checkattr(int c,unsigned int catmask)+{+ return (catmask & (getrule(allchars,(c<256)?NUM_LAT1BLOCKS:NUM_BLOCKS,c)->category));+}++inline static int checkattr_s(int c,unsigned int catmask)+{+ return (catmask & (getrule(spacechars,NUM_SPACEBLOCKS,c)->category));+}++/*+ Define predicate functions for some combinations of categories.+*/++#define unipred(p,m) \+bool p(GuUCS c) \+{ \+ return checkattr(c,m); \+}++bool gu_ucs_is_space(GuUCS c)+{+ if (c == ' ' || c == '\t' || c == '\n' || c == '\r' ||+ c == '\f' || c == '\v' || c == '\xa0')+ return true;+ return checkattr_s(c,GENCAT_ZS);+}+++GU_API unipred(gu_ucs_is_cntrl,GENCAT_CC)+GU_API unipred(gu_ucs_is_print, (GENCAT_MC | GENCAT_NO | GENCAT_SK | GENCAT_ME | GENCAT_ND | GENCAT_PO | GENCAT_LT | GENCAT_PC | GENCAT_SM | GENCAT_ZS | GENCAT_LU | GENCAT_PD | GENCAT_SO | GENCAT_PE | GENCAT_PF | GENCAT_PS | GENCAT_SC | GENCAT_LL | GENCAT_LM | GENCAT_PI | GENCAT_NL | GENCAT_MN | GENCAT_LO))+GU_API unipred(gu_ucs_is_upper,(GENCAT_LU|GENCAT_LT))+GU_API unipred(gu_ucs_is_lower,GENCAT_LL)+GU_API unipred(gu_ucs_is_alpha,(GENCAT_LL|GENCAT_LU|GENCAT_LT|GENCAT_LM|GENCAT_LO))+GU_API unipred(gu_ucs_is_digit,GENCAT_ND)++GU_API unipred(gu_ucs_is_alnum,(GENCAT_LT|GENCAT_LU|GENCAT_LL|GENCAT_LM|GENCAT_LO|+ GENCAT_MC|GENCAT_ME|GENCAT_MN|+ GENCAT_NO|GENCAT_ND|GENCAT_NL))++#define caseconv(p,to) \+GuUCS p(GuUCS c) \+{ \+ const struct _convrule_ *rule=getrule(convchars,NUM_CONVBLOCKS,c);\+ if(rule==&nullrule) return c;\+ return c+rule->to;\+}++GU_API caseconv(gu_ucs_to_upper,updist)+GU_API caseconv(gu_ucs_to_lower,lowdist)+GU_API caseconv(gu_ucs_to_title,titledist)++GU_API int gu_ucs_gen_cat(GuUCS c)+{+ return getrule(allchars,NUM_BLOCKS,c)->catnumber;+}
@@ -0,0 +1,55 @@+#ifndef GU_UCS_H_+#define GU_UCS_H_++#include <gu/defs.h>+#include <gu/exn.h>+#include <gu/assert.h>++#if defined(__STDC_ISO_10646__) && WCHAR_MAX >= 0x10FFFF+#include <wchar.h>+#define GU_UCS_WCHAR+typedef wchar_t GuUCS;+#else+typedef int32_t GuUCS;+#endif++#define GU_UCS_MAX ((GuUCS)(0x10FFFF))++GU_API_DECL bool+gu_char_is_valid(char c);++inline bool+gu_ucs_valid(GuUCS ucs)+{+ return ucs >= 0 && ucs <= GU_UCS_MAX;+}++GU_API_DECL GuUCS+gu_char_ucs(char c);++GU_API_DECL char+gu_ucs_char(GuUCS uc, GuExn* err);++GU_API_DECL size_t+gu_str_to_ucs(const char* cbuf, size_t len, GuUCS* ubuf, GuExn* err);++GU_API_DECL size_t+gu_ucs_to_str(const GuUCS* ubuf, size_t len, char* cbuf, GuExn* err);++GU_API_DECL bool gu_ucs_is_upper(GuUCS c);+GU_API_DECL bool gu_ucs_is_digit(GuUCS c);+GU_API_DECL bool gu_ucs_is_alpha(GuUCS c);+GU_API_DECL bool gu_ucs_is_cntrl(GuUCS c);+GU_API_DECL bool gu_ucs_is_space(GuUCS c);+GU_API_DECL bool gu_ucs_is_print(GuUCS c);+GU_API_DECL bool gu_ucs_is_lower(GuUCS c);++GU_API_DECL bool gu_ucs_is_alnum(GuUCS c);++GU_API_DECL GuUCS gu_ucs_to_lower(GuUCS c);+GU_API_DECL GuUCS gu_ucs_to_upper(GuUCS c);+GU_API_DECL GuUCS gu_ucs_to_title(GuUCS c);++GU_API_DECL int gu_ucs_is_gencat(GuUCS wc);++#endif // GU_ISO10646_H_
@@ -0,0 +1,176 @@+#include <gu/assert.h>+#include <gu/utf8.h>++GU_API GuUCS+gu_utf8_decode(const uint8_t** src_inout)+{+ const uint8_t* src = *src_inout;+ uint8_t c = src[0];+ if (c < 0x80) {+ *src_inout = src + 1;+ return (GuUCS) c;+ }+ size_t len = (c < 0xe0 ? 1 :+ c < 0xf0 ? 2 :+ c < 0xf8 ? 3 :+ c < 0xfc ? 4 :+ 5+ );+ uint64_t mask = 0x0103070F1f7f;+ uint32_t u = c & (mask >> (len * 8));+ for (size_t i = 1; i <= len; i++) {+ c = src[i];+ u = u << 6 | (c & 0x3f);+ }+ *src_inout = &src[len + 1];+ return (GuUCS) u;+}++GU_API GuUCS+gu_in_utf8_(GuIn* in, GuExn* err)+{+ uint8_t c = gu_in_u8(in, err);+ if (!gu_ok(err)) {+ return 0;+ }+ if (c < 0x80) {+ return c;+ } + if (c < 0xc2) {+ goto fail;+ }+ int len = (c < 0xe0 ? 1 :+ c < 0xf0 ? 2 :+ c < 0xf8 ? 3 :+ c < 0xfc ? 4 :+ 5+ );+ uint64_t mask = 0x0103070F1f7f;+ uint32_t u = c & (mask >> (len * 8));+ uint8_t buf[5];+ // If reading the extra bytes causes EOF, it is an encoding+ // error, not a legitimate end of character stream.+ gu_in_bytes(in, buf, len, err);+ if (gu_exn_caught(err, GuEOF)) {+ gu_exn_clear(err);+ goto fail;+ }+ if (!gu_ok(err)) {+ return 0;+ }+ for (int i = 0; i < len; i++) {+ c = buf[i];+ if ((c & 0xc0) != 0x80) {+ goto fail;+ }+ u = u << 6 | (c & 0x3f);+ }+ GuUCS ucs = (GuUCS) u;+ if (!gu_ucs_valid(ucs)) {+ goto fail;+ }+ return ucs;++fail:+ gu_raise(err, GuUCSExn);+ return 0;+}++extern inline GuUCS+gu_in_utf8(GuIn* in, GuExn* err);++GU_API void+gu_in_utf8_buf(uint8_t** buf, GuIn* in, GuExn* err)+{+ uint8_t* p = *buf;++ uint8_t c = gu_in_u8(in, err);+ if (!gu_ok(err)) {+ return;+ }+ *(p++) = c;++ if (c < 0x80) {+ *buf = p;+ return;+ }+ if (c < 0xc2) {+ goto fail;+ }++ int len = (c < 0xe0 ? 1 :+ c < 0xf0 ? 2 :+ c < 0xf8 ? 3 :+ c < 0xfc ? 4 :+ 5+ );+ // If reading the extra bytes causes EOF, it is an encoding+ // error, not a legitimate end of character stream.+ gu_in_bytes(in, p, len, err);+ if (gu_exn_caught(err, GuEOF)) {+ gu_exn_clear(err);+ goto fail;+ }+ if (!gu_ok(err)) {+ return;+ }+ *buf = p+len;+ return;++fail:+ gu_raise(err, GuUCSExn);+ return;+}++GU_API void+gu_utf8_encode(GuUCS ucs, uint8_t** buf)+{+ gu_require(gu_ucs_valid(ucs));+ uint8_t* p = *buf;+ if (ucs < 0x80) {+ p[0] = (uint8_t) ucs;+ *buf = p+1;+ } else if (ucs < 0x800) {+ p[0] = 0xc0 | (ucs >> 6);+ p[1] = 0x80 | (ucs & 0x3f);+ *buf = p+2;+ } else if (ucs < 0x10000) {+ p[0] = 0xe0 | (ucs >> 12);+ p[1] = 0x80 | ((ucs >> 6) & 0x3f);+ p[2] = 0x80 | (ucs & 0x3f);+ *buf = p+3;+ } else if (ucs < 0x200000) {+ p[0] = 0xf0 | (ucs >> 18);+ p[1] = 0x80 | ((ucs >> 12) & 0x3f);+ p[2] = 0x80 | ((ucs >> 6) & 0x3f);+ p[3] = 0x80 | (ucs & 0x3f);+ *buf = p+4;+ } else if (ucs < 0x4000000) {+ p[0] = 0xf8 | (ucs >> 24);+ p[1] = 0x80 | ((ucs >> 18) & 0x3f);+ p[2] = 0x80 | ((ucs >> 12) & 0x3f);+ p[3] = 0x80 | ((ucs >> 6) & 0x3f);+ p[4] = 0x80 | (ucs & 0x3f);+ *buf = p+5;+ } else {+ p[0] = 0xfc | (ucs >> 30);+ p[1] = 0x80 | ((ucs >> 24) & 0x3f);+ p[2] = 0x80 | ((ucs >> 18) & 0x3f);+ p[3] = 0x80 | ((ucs >> 12) & 0x3f);+ p[4] = 0x80 | ((ucs >> 6) & 0x3f);+ p[5] = 0x80 | (ucs & 0x3f);+ *buf = p+6;+ }+}++GU_API void+gu_out_utf8_(GuUCS ucs, GuOut* out, GuExn* err)+{+ uint8_t buf[6];+ uint8_t* p = buf;+ gu_utf8_encode(ucs, &p);+ gu_out_bytes(out, buf, p-buf, err);+}++extern inline void+gu_out_utf8(GuUCS ucs, GuOut* out, GuExn* err);
@@ -0,0 +1,43 @@+#ifndef GU_UTF8_H_+#define GU_UTF8_H_++#include <gu/in.h>+#include <gu/out.h>+#include <gu/ucs.h>++inline GuUCS+gu_in_utf8(GuIn* in, GuExn* err)+{+ int i = gu_in_peek_u8(in);+ if (i >= 0 && i < 0x80) {+ gu_in_consume(in, 1);+ return (GuUCS) i;+ }+ GU_API_DECL GuUCS gu_in_utf8_(GuIn* in, GuExn* err);+ return gu_in_utf8_(in, err);+}++inline void+gu_out_utf8(GuUCS ucs, GuOut* out, GuExn* err)+{+ gu_require(gu_ucs_valid(ucs));+ if (GU_LIKELY(ucs < 0x80)) {+ gu_out_u8(out, ucs, err);+ } else {+ GU_API_DECL void gu_out_utf8_(GuUCS ucs, GuOut* out, GuExn* err);+ gu_out_utf8_(ucs, out, err);+ }+}++// Helper functions used in other modules++GU_API_DECL GuUCS+gu_utf8_decode(const uint8_t** buf);++GU_API_DECL void+gu_utf8_encode(GuUCS ucs, uint8_t** buf);++GU_API_DECL void+gu_in_utf8_buf(uint8_t** buf, GuIn* in, GuExn* err);++#endif // GU_UTF8_H_
@@ -0,0 +1,94 @@+#include "variant.h"+#include "bits.h"++enum {+ GU_VARIANT_ALIGNMENT = sizeof(uintptr_t)+};++GU_API void*+gu_alloc_variant(uint8_t tag, size_t size, + size_t align, GuVariant* variant_out, GuPool* pool)+{+ align = gu_max(align, GU_VARIANT_ALIGNMENT);+ if (((size_t)tag) > GU_VARIANT_ALIGNMENT - 2) {+ uint8_t* alloc = gu_malloc_aligned(pool, align + size, align);+ alloc[align - 1] = tag;+ void* p = &alloc[align];+ *variant_out = (uintptr_t)p;+ return p;+ }+ void* p = gu_malloc_aligned(pool, size, align);+ *variant_out = ((uintptr_t)p) | (tag + 1);+ return p;+}++GU_API GuVariant +gu_make_variant(uint8_t tag, size_t size, size_t align, const void* init,+ GuPool* pool)+{+ GuVariant v;+ void* data = gu_alloc_variant(tag, size, align, &v, pool);+ memcpy(data, init, size);+ return v;+}++GU_API int+gu_variant_tag(GuVariant variant)+{+ if (gu_variant_is_null(variant)) {+ return GU_VARIANT_NULL;+ }+ int u = variant % GU_VARIANT_ALIGNMENT;+ if (u == 0) {+ uint8_t* mem = (uint8_t*)variant;+ return mem[-1];+ }+ return u - 1;+}++GU_API void*+gu_variant_data(GuVariant variant)+{+ if (gu_variant_is_null(variant)) {+ return NULL;+ }+ return (void*)gu_align_backward(variant, GU_VARIANT_ALIGNMENT);+}++GU_API GuVariantInfo+gu_variant_open(GuVariant variant)+{+ GuVariantInfo info = {+ .tag = gu_variant_tag(variant),+ .data = gu_variant_data(variant)+ };+ return info;+}++GU_API GuVariant+gu_variant_close(GuVariantInfo info)+{+ GuVariant variant;++ if (((size_t)info.tag) > GU_VARIANT_ALIGNMENT - 2) {+ variant = (uintptr_t)info.data;+ assert(gu_variant_tag(variant) == info.tag);+ } else {+ variant = ((uintptr_t)info.data) | (info.tag + 1);+ }++ return variant;+}++GU_API int +gu_variant_intval(GuVariant variant)+{+ int u = variant % GU_VARIANT_ALIGNMENT;+ if (u == 0) {+ int* mem = (int*)variant;+ return *mem;+ }+ return (variant / GU_VARIANT_ALIGNMENT);+}++GU_API const GuVariant gu_null_variant = { (GuWord) NULL };
@@ -0,0 +1,111 @@+/* + * Copyright 2010 University of Helsinki.+ * + * This file is part of libgu.+ * + * Libgu is free software: you can redistribute it and/or modify it under+ * the terms of the GNU Lesser General Public License as published by the+ * Free Software Foundation, either version 3 of the License, or (at your+ * option) any later version.+ * + * Libgu is distributed in the hope that it will be useful, but WITHOUT+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public+ * License along with libgu. If not, see <http://www.gnu.org/licenses/>.+ */++/** @file+ *+ * Lightweight tagged data. + */++#ifndef GU_VARIANT_H_+#define GU_VARIANT_H_++#include <gu/defs.h>+#include <gu/mem.h>++/** @name Variants+ * @{+ */++typedef uintptr_t GuVariant;+++GU_API_DECL+void* gu_alloc_variant(uint8_t tag, + size_t size, size_t align, + GuVariant* variant_out, GuPool* pool);++GU_API_DECL+GuVariant gu_make_variant(uint8_t tag, + size_t size, size_t align, + const void* init, GuPool* pool);++#define gu_new_variant(tag, type, variant_out, pool) \+ ((type*)gu_alloc_variant(tag, sizeof(type), \+ gu_alignof(type), variant_out, pool))++/**< + * @hideinitializer */++#define gu_new_variant_i(POOL, TAG, T, ...) \+ gu_make_variant(TAG, sizeof(T), gu_alignof(T), \+ &(T){ __VA_ARGS__ }, POOL)++++#define gu_new_flex_variant(tag, type, flex_mem, n_elems, variant_out, pool) \+ ((type*)gu_alloc_variant(tag, \+ GU_FLEX_SIZE(type, flex_mem, n_elems), \+ gu_flex_alignof(type), \+ variant_out, pool))+/**< + * @hideinitializer */++enum {+ GU_VARIANT_NULL = -1+};++GU_API_DECL+int gu_variant_tag(GuVariant variant);++GU_API_DECL+void* gu_variant_data(GuVariant variant);+++typedef struct GuVariantInfo GuVariantInfo;++struct GuVariantInfo {+ int tag;+ void* data;+};++GU_API_DECL GuVariantInfo gu_variant_open(GuVariant variant);+GU_API_DECL GuVariant gu_variant_close(GuVariantInfo info);++/** @} */++static inline void*+gu_variant_to_ptr(GuVariant variant)+{+ return (void*) variant;+}++static inline GuVariant+gu_variant_from_ptr(const void* p)+{+ return (uintptr_t) p;+}++GU_API_DECL extern const GuVariant gu_null_variant;++static inline bool+gu_variant_is_null(GuVariant v) {+ return ((void*)v == NULL);+}++#endif // GU_VARIANT_H_
@@ -0,0 +1,10 @@+prefix=@prefix@+exec_prefix=@exec_prefix@+libdir=@libdir@+includedir=@includedir@++Name: libgu+Description: Gothenburg Utilities library+Version: @VERSION@+Libs: -L${libdir} -lgu +Cflags: -I${includedir}
@@ -0,0 +1,11 @@+prefix=@prefix@+exec_prefix=@exec_prefix@+libdir=@libdir@+includedir=@includedir@++Name: libpgf+Description: Portable Grammar Format library+Requires: libgu+Version: @VERSION@+Libs: -L${libdir} -lpgf+Cflags: -I${includedir}
@@ -0,0 +1,10 @@+prefix=@prefix@+exec_prefix=@exec_prefix@+libdir=@libdir@+includedir=@includedir@++Name: libsg+Description: Semantic Graph library+Version: @VERSION@+Libs: -L${libdir} -lsg -lpgf +Cflags: -I${includedir}
@@ -0,0 +1,533 @@+# ===========================================================================+# http://www.gnu.org/software/autoconf-archive/ax_prog_doxygen.html+# ===========================================================================+#+# SYNOPSIS+#+# DX_INIT_DOXYGEN(PROJECT-NAME, DOXYFILE-PATH, [OUTPUT-DIR])+# DX_DOXYGEN_FEATURE(ON|OFF)+# DX_DOT_FEATURE(ON|OFF)+# DX_HTML_FEATURE(ON|OFF)+# DX_CHM_FEATURE(ON|OFF)+# DX_CHI_FEATURE(ON|OFF)+# DX_MAN_FEATURE(ON|OFF)+# DX_RTF_FEATURE(ON|OFF)+# DX_XML_FEATURE(ON|OFF)+# DX_PDF_FEATURE(ON|OFF)+# DX_PS_FEATURE(ON|OFF)+#+# DESCRIPTION+#+# The DX_*_FEATURE macros control the default setting for the given+# Doxygen feature. Supported features are 'DOXYGEN' itself, 'DOT' for+# generating graphics, 'HTML' for plain HTML, 'CHM' for compressed HTML+# help (for MS users), 'CHI' for generating a seperate .chi file by the+# .chm file, and 'MAN', 'RTF', 'XML', 'PDF' and 'PS' for the appropriate+# output formats. The environment variable DOXYGEN_PAPER_SIZE may be+# specified to override the default 'a4wide' paper size.+#+# By default, HTML, PDF and PS documentation is generated as this seems to+# be the most popular and portable combination. MAN pages created by+# Doxygen are usually problematic, though by picking an appropriate subset+# and doing some massaging they might be better than nothing. CHM and RTF+# are specific for MS (note that you can't generate both HTML and CHM at+# the same time). The XML is rather useless unless you apply specialized+# post-processing to it.+#+# The macros mainly control the default state of the feature. The use can+# override the default by specifying --enable or --disable. The macros+# ensure that contradictory flags are not given (e.g.,+# --enable-doxygen-html and --enable-doxygen-chm,+# --enable-doxygen-anything with --disable-doxygen, etc.) Finally, each+# feature will be automatically disabled (with a warning) if the required+# programs are missing.+#+# Once all the feature defaults have been specified, call DX_INIT_DOXYGEN+# with the following parameters: a one-word name for the project for use+# as a filename base etc., an optional configuration file name (the+# default is 'Doxyfile', the same as Doxygen's default), and an optional+# output directory name (the default is 'doxygen-doc').+#+# Automake Support+#+# The following is a template aminclude.am file for use with Automake.+# Make targets and variables values are controlled by the various+# DX_COND_* conditionals set by autoconf.+#+# The provided targets are:+#+# doxygen-doc: Generate all doxygen documentation.+#+# doxygen-run: Run doxygen, which will generate some of the+# documentation (HTML, CHM, CHI, MAN, RTF, XML)+# but will not do the post processing required+# for the rest of it (PS, PDF, and some MAN).+#+# doxygen-man: Rename some doxygen generated man pages.+#+# doxygen-ps: Generate doxygen PostScript documentation.+#+# doxygen-pdf: Generate doxygen PDF documentation.+#+# Note that by default these are not integrated into the automake targets.+# If doxygen is used to generate man pages, you can achieve this+# integration by setting man3_MANS to the list of man pages generated and+# then adding the dependency:+#+# $(man3_MANS): doxygen-doc+#+# This will cause make to run doxygen and generate all the documentation.+#+# The following variable is intended for use in Makefile.am:+#+# DX_CLEANFILES = everything to clean.+#+# Then add this variable to MOSTLYCLEANFILES.+#+# ----- begin aminclude.am -------------------------------------+#+# ## --------------------------------- ##+# ## Format-independent Doxygen rules. ##+# ## --------------------------------- ##+#+# if DX_COND_doc+#+# ## ------------------------------- ##+# ## Rules specific for HTML output. ##+# ## ------------------------------- ##+#+# if DX_COND_html+#+# DX_CLEAN_HTML = @DX_DOCDIR@/html+#+# endif DX_COND_html+#+# ## ------------------------------ ##+# ## Rules specific for CHM output. ##+# ## ------------------------------ ##+#+# if DX_COND_chm+#+# DX_CLEAN_CHM = @DX_DOCDIR@/chm+#+# if DX_COND_chi+#+# DX_CLEAN_CHI = @DX_DOCDIR@/@PACKAGE@.chi+#+# endif DX_COND_chi+#+# endif DX_COND_chm+#+# ## ------------------------------ ##+# ## Rules specific for MAN output. ##+# ## ------------------------------ ##+#+# if DX_COND_man+#+# DX_CLEAN_MAN = @DX_DOCDIR@/man+#+# endif DX_COND_man+#+# ## ------------------------------ ##+# ## Rules specific for RTF output. ##+# ## ------------------------------ ##+#+# if DX_COND_rtf+#+# DX_CLEAN_RTF = @DX_DOCDIR@/rtf+#+# endif DX_COND_rtf+#+# ## ------------------------------ ##+# ## Rules specific for XML output. ##+# ## ------------------------------ ##+#+# if DX_COND_xml+#+# DX_CLEAN_XML = @DX_DOCDIR@/xml+#+# endif DX_COND_xml+#+# ## ----------------------------- ##+# ## Rules specific for PS output. ##+# ## ----------------------------- ##+#+# if DX_COND_ps+#+# DX_CLEAN_PS = @DX_DOCDIR@/@PACKAGE@.ps+#+# DX_PS_GOAL = doxygen-ps+#+# doxygen-ps: @DX_DOCDIR@/@PACKAGE@.ps+#+# @DX_DOCDIR@/@PACKAGE@.ps: @DX_DOCDIR@/@PACKAGE@.tag+# cd @DX_DOCDIR@/latex; \+# rm -f *.aux *.toc *.idx *.ind *.ilg *.log *.out; \+# $(DX_LATEX) refman.tex; \+# $(MAKEINDEX_PATH) refman.idx; \+# $(DX_LATEX) refman.tex; \+# countdown=5; \+# while $(DX_EGREP) 'Rerun (LaTeX|to get cross-references right)' \+# refman.log > /dev/null 2>&1 \+# && test $$countdown -gt 0; do \+# $(DX_LATEX) refman.tex; \+# countdown=`expr $$countdown - 1`; \+# done; \+# $(DX_DVIPS) -o ../@PACKAGE@.ps refman.dvi+#+# endif DX_COND_ps+#+# ## ------------------------------ ##+# ## Rules specific for PDF output. ##+# ## ------------------------------ ##+#+# if DX_COND_pdf+#+# DX_CLEAN_PDF = @DX_DOCDIR@/@PACKAGE@.pdf+#+# DX_PDF_GOAL = doxygen-pdf+#+# doxygen-pdf: @DX_DOCDIR@/@PACKAGE@.pdf+#+# @DX_DOCDIR@/@PACKAGE@.pdf: @DX_DOCDIR@/@PACKAGE@.tag+# cd @DX_DOCDIR@/latex; \+# rm -f *.aux *.toc *.idx *.ind *.ilg *.log *.out; \+# $(DX_PDFLATEX) refman.tex; \+# $(DX_MAKEINDEX) refman.idx; \+# $(DX_PDFLATEX) refman.tex; \+# countdown=5; \+# while $(DX_EGREP) 'Rerun (LaTeX|to get cross-references right)' \+# refman.log > /dev/null 2>&1 \+# && test $$countdown -gt 0; do \+# $(DX_PDFLATEX) refman.tex; \+# countdown=`expr $$countdown - 1`; \+# done; \+# mv refman.pdf ../@PACKAGE@.pdf+#+# endif DX_COND_pdf+#+# ## ------------------------------------------------- ##+# ## Rules specific for LaTeX (shared for PS and PDF). ##+# ## ------------------------------------------------- ##+#+# if DX_COND_latex+#+# DX_CLEAN_LATEX = @DX_DOCDIR@/latex+#+# endif DX_COND_latex+#+# .PHONY: doxygen-run doxygen-doc $(DX_PS_GOAL) $(DX_PDF_GOAL)+#+# .INTERMEDIATE: doxygen-run $(DX_PS_GOAL) $(DX_PDF_GOAL)+#+# doxygen-run: @DX_DOCDIR@/@PACKAGE@.tag+#+# doxygen-doc: doxygen-run $(DX_PS_GOAL) $(DX_PDF_GOAL)+#+# @DX_DOCDIR@/@PACKAGE@.tag: $(DX_CONFIG) $(pkginclude_HEADERS)+# rm -rf @DX_DOCDIR@+# $(DX_ENV) $(DX_DOXYGEN) $(srcdir)/$(DX_CONFIG)+#+# DX_CLEANFILES = \+# @DX_DOCDIR@/@PACKAGE@.tag \+# -r \+# $(DX_CLEAN_HTML) \+# $(DX_CLEAN_CHM) \+# $(DX_CLEAN_CHI) \+# $(DX_CLEAN_MAN) \+# $(DX_CLEAN_RTF) \+# $(DX_CLEAN_XML) \+# $(DX_CLEAN_PS) \+# $(DX_CLEAN_PDF) \+# $(DX_CLEAN_LATEX)+#+# endif DX_COND_doc+#+# ----- end aminclude.am ---------------------------------------+#+# LICENSE+#+# Copyright (c) 2009 Oren Ben-Kiki <oren@ben-kiki.org>+#+# Copying and distribution of this file, with or without modification, are+# permitted in any medium without royalty provided the copyright notice+# and this notice are preserved. This file is offered as-is, without any+# warranty.++#serial 10++## ----------##+## Defaults. ##+## ----------##++DX_ENV=""+AC_DEFUN([DX_FEATURE_doc], ON)+AC_DEFUN([DX_FEATURE_dot], ON)+AC_DEFUN([DX_FEATURE_man], OFF)+AC_DEFUN([DX_FEATURE_html], ON)+AC_DEFUN([DX_FEATURE_chm], OFF)+AC_DEFUN([DX_FEATURE_chi], OFF)+AC_DEFUN([DX_FEATURE_rtf], OFF)+AC_DEFUN([DX_FEATURE_xml], OFF)+AC_DEFUN([DX_FEATURE_pdf], ON)+AC_DEFUN([DX_FEATURE_ps], ON)++## --------------- ##+## Private macros. ##+## --------------- ##++# DX_ENV_APPEND(VARIABLE, VALUE)+# ------------------------------+# Append VARIABLE="VALUE" to DX_ENV for invoking doxygen.+AC_DEFUN([DX_ENV_APPEND], [AC_SUBST([DX_ENV], ["$DX_ENV $1='$2'"])])++# DX_DIRNAME_EXPR+# ---------------+# Expand into a shell expression prints the directory part of a path.+AC_DEFUN([DX_DIRNAME_EXPR],+ [[expr ".$1" : '\(\.\)[^/]*$' \| "x$1" : 'x\(.*\)/[^/]*$']])++# DX_IF_FEATURE(FEATURE, IF-ON, IF-OFF)+# -------------------------------------+# Expands according to the M4 (static) status of the feature.+AC_DEFUN([DX_IF_FEATURE], [ifelse(DX_FEATURE_$1, ON, [$2], [$3])])++# DX_REQUIRE_PROG(VARIABLE, PROGRAM)+# ----------------------------------+# Require the specified program to be found for the DX_CURRENT_FEATURE to work.+AC_DEFUN([DX_REQUIRE_PROG], [+AC_PATH_TOOL([$1], [$2])+if test "$DX_FLAG_[]DX_CURRENT_FEATURE$$1" = 1; then+ AC_MSG_WARN([$2 not found - will not DX_CURRENT_DESCRIPTION])+ AC_SUBST(DX_FLAG_[]DX_CURRENT_FEATURE, 0)+fi+])++# DX_TEST_FEATURE(FEATURE)+# ------------------------+# Expand to a shell expression testing whether the feature is active.+AC_DEFUN([DX_TEST_FEATURE], [test "$DX_FLAG_$1" = 1])++# DX_CHECK_DEPEND(REQUIRED_FEATURE, REQUIRED_STATE)+# -------------------------------------------------+# Verify that a required features has the right state before trying to turn on+# the DX_CURRENT_FEATURE.+AC_DEFUN([DX_CHECK_DEPEND], [+test "$DX_FLAG_$1" = "$2" \+|| AC_MSG_ERROR([doxygen-DX_CURRENT_FEATURE ifelse([$2], 1,+ requires, contradicts) doxygen-DX_CURRENT_FEATURE])+])++# DX_CLEAR_DEPEND(FEATURE, REQUIRED_FEATURE, REQUIRED_STATE)+# ----------------------------------------------------------+# Turn off the DX_CURRENT_FEATURE if the required feature is off.+AC_DEFUN([DX_CLEAR_DEPEND], [+test "$DX_FLAG_$1" = "$2" || AC_SUBST(DX_FLAG_[]DX_CURRENT_FEATURE, 0)+])++# DX_FEATURE_ARG(FEATURE, DESCRIPTION,+# CHECK_DEPEND, CLEAR_DEPEND,+# REQUIRE, DO-IF-ON, DO-IF-OFF)+# --------------------------------------------+# Parse the command-line option controlling a feature. CHECK_DEPEND is called+# if the user explicitly turns the feature on (and invokes DX_CHECK_DEPEND),+# otherwise CLEAR_DEPEND is called to turn off the default state if a required+# feature is disabled (using DX_CLEAR_DEPEND). REQUIRE performs additional+# requirement tests (DX_REQUIRE_PROG). Finally, an automake flag is set and+# DO-IF-ON or DO-IF-OFF are called according to the final state of the feature.+AC_DEFUN([DX_ARG_ABLE], [+ AC_DEFUN([DX_CURRENT_FEATURE], [$1])+ AC_DEFUN([DX_CURRENT_DESCRIPTION], [$2])+ AC_ARG_ENABLE(doxygen-$1,+ [AS_HELP_STRING(DX_IF_FEATURE([$1], [--disable-doxygen-$1],+ [--enable-doxygen-$1]),+ DX_IF_FEATURE([$1], [don't $2], [$2]))],+ [+case "$enableval" in+#(+y|Y|yes|Yes|YES)+ AC_SUBST([DX_FLAG_$1], 1)+ $3+;; #(+n|N|no|No|NO)+ AC_SUBST([DX_FLAG_$1], 0)+;; #(+*)+ AC_MSG_ERROR([invalid value '$enableval' given to doxygen-$1])+;;+esac+], [+AC_SUBST([DX_FLAG_$1], [DX_IF_FEATURE([$1], 1, 0)])+$4+])+if DX_TEST_FEATURE([$1]); then+ $5+ :+fi+if DX_TEST_FEATURE([$1]); then+ AM_CONDITIONAL(DX_COND_$1, :)+ $6+ :+else+ AM_CONDITIONAL(DX_COND_$1, false)+ $7+ :+fi+])++## -------------- ##+## Public macros. ##+## -------------- ##++# DX_XXX_FEATURE(DEFAULT_STATE)+# -----------------------------+AC_DEFUN([DX_DOXYGEN_FEATURE], [AC_DEFUN([DX_FEATURE_doc], [$1])])+AC_DEFUN([DX_MAN_FEATURE], [AC_DEFUN([DX_FEATURE_man], [$1])])+AC_DEFUN([DX_HTML_FEATURE], [AC_DEFUN([DX_FEATURE_html], [$1])])+AC_DEFUN([DX_CHM_FEATURE], [AC_DEFUN([DX_FEATURE_chm], [$1])])+AC_DEFUN([DX_CHI_FEATURE], [AC_DEFUN([DX_FEATURE_chi], [$1])])+AC_DEFUN([DX_RTF_FEATURE], [AC_DEFUN([DX_FEATURE_rtf], [$1])])+AC_DEFUN([DX_XML_FEATURE], [AC_DEFUN([DX_FEATURE_xml], [$1])])+AC_DEFUN([DX_XML_FEATURE], [AC_DEFUN([DX_FEATURE_xml], [$1])])+AC_DEFUN([DX_PDF_FEATURE], [AC_DEFUN([DX_FEATURE_pdf], [$1])])+AC_DEFUN([DX_PS_FEATURE], [AC_DEFUN([DX_FEATURE_ps], [$1])])++# DX_INIT_DOXYGEN(PROJECT, [CONFIG-FILE], [OUTPUT-DOC-DIR])+# ---------------------------------------------------------+# PROJECT also serves as the base name for the documentation files.+# The default CONFIG-FILE is "Doxyfile" and OUTPUT-DOC-DIR is "doxygen-doc".+AC_DEFUN([DX_INIT_DOXYGEN], [++# Files:+AC_SUBST([DX_PROJECT], [$1])+AC_SUBST([DX_CONFIG], [ifelse([$2], [], Doxyfile, [$2])])+AC_SUBST([DX_DOCDIR], [ifelse([$3], [], doxygen-doc, [$3])])++# Environment variables used inside doxygen.cfg:+DX_ENV_APPEND(SRCDIR, $srcdir)+DX_ENV_APPEND(PROJECT, $DX_PROJECT)+DX_ENV_APPEND(DOCDIR, $DX_DOCDIR)+DX_ENV_APPEND(VERSION, $PACKAGE_VERSION)++# Doxygen itself:+DX_ARG_ABLE(doc, [generate any doxygen documentation],+ [],+ [],+ [DX_REQUIRE_PROG([DX_DOXYGEN], doxygen)+ DX_REQUIRE_PROG([DX_PERL], perl)],+ [DX_ENV_APPEND(PERL_PATH, $DX_PERL)])++# Dot for graphics:+DX_ARG_ABLE(dot, [generate graphics for doxygen documentation],+ [DX_CHECK_DEPEND(doc, 1)],+ [DX_CLEAR_DEPEND(doc, 1)],+ [DX_REQUIRE_PROG([DX_DOT], dot)],+ [DX_ENV_APPEND(HAVE_DOT, YES)+ DX_ENV_APPEND(DOT_PATH, [`DX_DIRNAME_EXPR($DX_DOT)`])],+ [DX_ENV_APPEND(HAVE_DOT, NO)])++# Man pages generation:+DX_ARG_ABLE(man, [generate doxygen manual pages],+ [DX_CHECK_DEPEND(doc, 1)],+ [DX_CLEAR_DEPEND(doc, 1)],+ [],+ [DX_ENV_APPEND(GENERATE_MAN, YES)],+ [DX_ENV_APPEND(GENERATE_MAN, NO)])++# RTF file generation:+DX_ARG_ABLE(rtf, [generate doxygen RTF documentation],+ [DX_CHECK_DEPEND(doc, 1)],+ [DX_CLEAR_DEPEND(doc, 1)],+ [],+ [DX_ENV_APPEND(GENERATE_RTF, YES)],+ [DX_ENV_APPEND(GENERATE_RTF, NO)])++# XML file generation:+DX_ARG_ABLE(xml, [generate doxygen XML documentation],+ [DX_CHECK_DEPEND(doc, 1)],+ [DX_CLEAR_DEPEND(doc, 1)],+ [],+ [DX_ENV_APPEND(GENERATE_XML, YES)],+ [DX_ENV_APPEND(GENERATE_XML, NO)])++# (Compressed) HTML help generation:+DX_ARG_ABLE(chm, [generate doxygen compressed HTML help documentation],+ [DX_CHECK_DEPEND(doc, 1)],+ [DX_CLEAR_DEPEND(doc, 1)],+ [DX_REQUIRE_PROG([DX_HHC], hhc)],+ [DX_ENV_APPEND(HHC_PATH, $DX_HHC)+ DX_ENV_APPEND(GENERATE_HTML, YES)+ DX_ENV_APPEND(GENERATE_HTMLHELP, YES)],+ [DX_ENV_APPEND(GENERATE_HTMLHELP, NO)])++# Seperate CHI file generation.+DX_ARG_ABLE(chi, [generate doxygen seperate compressed HTML help index file],+ [DX_CHECK_DEPEND(chm, 1)],+ [DX_CLEAR_DEPEND(chm, 1)],+ [],+ [DX_ENV_APPEND(GENERATE_CHI, YES)],+ [DX_ENV_APPEND(GENERATE_CHI, NO)])++# Plain HTML pages generation:+DX_ARG_ABLE(html, [generate doxygen plain HTML documentation],+ [DX_CHECK_DEPEND(doc, 1) DX_CHECK_DEPEND(chm, 0)],+ [DX_CLEAR_DEPEND(doc, 1) DX_CLEAR_DEPEND(chm, 0)],+ [],+ [DX_ENV_APPEND(GENERATE_HTML, YES)],+ [DX_TEST_FEATURE(chm) || DX_ENV_APPEND(GENERATE_HTML, NO)])++# PostScript file generation:+DX_ARG_ABLE(ps, [generate doxygen PostScript documentation],+ [DX_CHECK_DEPEND(doc, 1)],+ [DX_CLEAR_DEPEND(doc, 1)],+ [DX_REQUIRE_PROG([DX_LATEX], latex)+ DX_REQUIRE_PROG([DX_MAKEINDEX], makeindex)+ DX_REQUIRE_PROG([DX_DVIPS], dvips)+ DX_REQUIRE_PROG([DX_EGREP], egrep)])++# PDF file generation:+DX_ARG_ABLE(pdf, [generate doxygen PDF documentation],+ [DX_CHECK_DEPEND(doc, 1)],+ [DX_CLEAR_DEPEND(doc, 1)],+ [DX_REQUIRE_PROG([DX_PDFLATEX], pdflatex)+ DX_REQUIRE_PROG([DX_MAKEINDEX], makeindex)+ DX_REQUIRE_PROG([DX_EGREP], egrep)])++# LaTeX generation for PS and/or PDF:+if DX_TEST_FEATURE(ps) || DX_TEST_FEATURE(pdf); then+ AM_CONDITIONAL(DX_COND_latex, :)+ DX_ENV_APPEND(GENERATE_LATEX, YES)+else+ AM_CONDITIONAL(DX_COND_latex, false)+ DX_ENV_APPEND(GENERATE_LATEX, NO)+fi++# Paper size for PS and/or PDF:+AC_ARG_VAR(DOXYGEN_PAPER_SIZE,+ [a4wide (default), a4, letter, legal or executive])+case "$DOXYGEN_PAPER_SIZE" in+#(+"")+ AC_SUBST(DOXYGEN_PAPER_SIZE, "")+;; #(+a4wide|a4|letter|legal|executive)+ DX_ENV_APPEND(PAPER_SIZE, $DOXYGEN_PAPER_SIZE)+;; #(+*)+ AC_MSG_ERROR([unknown DOXYGEN_PAPER_SIZE='$DOXYGEN_PAPER_SIZE'])+;;+esac++#For debugging:+#echo DX_FLAG_doc=$DX_FLAG_doc+#echo DX_FLAG_dot=$DX_FLAG_dot+#echo DX_FLAG_man=$DX_FLAG_man+#echo DX_FLAG_html=$DX_FLAG_html+#echo DX_FLAG_chm=$DX_FLAG_chm+#echo DX_FLAG_chi=$DX_FLAG_chi+#echo DX_FLAG_rtf=$DX_FLAG_rtf+#echo DX_FLAG_xml=$DX_FLAG_xml+#echo DX_FLAG_pdf=$DX_FLAG_pdf+#echo DX_FLAG_ps=$DX_FLAG_ps+#echo DX_ENV=$DX_ENV+])
@@ -0,0 +1,241 @@+#include "data.h"+#include "linearizer.h"+#include "pgf.h"+#include <gu/utf8.h>++typedef struct {+ PgfLinFuncs* funcs;+ GuBuf* parent_stack;+ GuBuf* parent_current;+ GuBuf* phrases;+ PgfAlignmentPhrase* last_phrase;+ GuStringBuf* sbuf;+ size_t n_matches;+ GuExn* err;+ bool bind;+ PgfCapitState capit;+ GuPool* out_pool;+ GuPool* tmp_pool;+} PgfAlignerLin;++static void+pgf_aligner_flush_phrase(PgfAlignerLin* alin)+{+ size_t n_fids = gu_buf_length(alin->parent_current);++ if (alin->n_matches == n_fids &&+ alin->n_matches == alin->last_phrase->n_fids) {+ // if the current compound word has the same parents+ // as the last one then we just combine them with a space++ alin->last_phrase->phrase =+ gu_format_string(alin->out_pool, "%s %s", + alin->last_phrase->phrase,+ gu_string_buf_freeze(alin->sbuf, alin->tmp_pool));+ } else {+ // push the current word to the buffer of words+ + PgfAlignmentPhrase* phrase = + gu_new_flex(alin->out_pool, PgfAlignmentPhrase, fids, n_fids);+ phrase->phrase = gu_string_buf_freeze(alin->sbuf, alin->out_pool);+ phrase->n_fids = n_fids;+ for (size_t i = 0; i < n_fids; i++) {+ phrase->fids[i] = gu_buf_get(alin->parent_current, int, i);+ }+ gu_buf_push(alin->phrases, PgfAlignmentPhrase*, phrase);+ + alin->last_phrase = phrase;+ }++ alin->n_matches = 0;+}++static void+pgf_aligner_push_parent(PgfAlignerLin* alin, int fid)+{+ gu_buf_push(alin->parent_current, int, fid);++ if (alin->last_phrase != NULL) {+ for (size_t i = 0; i < alin->last_phrase->n_fids; i++) {+ if (fid == alin->last_phrase->fids[i]) {+ alin->n_matches++;+ break;+ }+ }+ }+}++static void+pgf_aligner_lzn_symbol_token(PgfLinFuncs** funcs, PgfToken tok)+{+ PgfAlignerLin* alin = gu_container(funcs, PgfAlignerLin, funcs);+ if (!gu_ok(alin->err)) {+ return;+ }++ // get the tree node id that generates this token+ size_t n_parents = gu_buf_length(alin->parent_stack);+ int fid = gu_buf_get(alin->parent_stack, int, n_parents-1);++ // how many nodes so far are involved in the current compound word+ size_t n_fids = gu_buf_length(alin->parent_current);++ if (alin->bind) {+ // here we glue tokens++ alin->bind = false;++ bool found = false;+ for (size_t i = 0; i < n_fids; i++) {+ int current_fid = gu_buf_get(alin->parent_current, int, i);+ if (fid == current_fid) {+ found = true;+ break;+ }+ }++ // add the tree node id to the list of parents if it has not+ // been added already.+ if (!found) {+ pgf_aligner_push_parent(alin, fid);+ }+ } else {+ // here we start a new (compound) word++ pgf_aligner_flush_phrase(alin);+ gu_string_buf_flush(alin->sbuf);+ gu_buf_flush(alin->parent_current);++ pgf_aligner_push_parent(alin, fid);+ + if (alin->capit == PGF_CAPIT_NEXT)+ alin->capit = PGF_CAPIT_NONE;+ }++ GuOut* out = gu_string_buf_out(alin->sbuf);++ switch (alin->capit) {+ case PGF_CAPIT_NONE:+ gu_string_write(tok, out, alin->err);+ break;+ case PGF_CAPIT_FIRST: {+ GuUCS c = gu_utf8_decode((const uint8_t**) &tok);+ c = gu_ucs_to_upper(c);+ gu_out_utf8(c, out, alin->err);+ gu_string_write(tok, out, alin->err);+ alin->capit = PGF_CAPIT_NONE;+ break;+ } + case PGF_CAPIT_ALL:+ alin->capit = PGF_CAPIT_NEXT;+ // continue+ case PGF_CAPIT_NEXT: {+ const uint8_t* p = (uint8_t*) tok;+ while (*p) {+ GuUCS c = gu_utf8_decode(&p);+ c = gu_ucs_to_upper(c);+ gu_out_utf8(c, out, alin->err);+ }+ break;+ }+ }+}++static void+pgf_aligner_lzn_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfAlignerLin* alin = gu_container(funcs, PgfAlignerLin, funcs);+ gu_buf_push(alin->parent_stack, int, fid);+}++static void+pgf_aligner_lzn_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfAlignerLin* alin = gu_container(funcs, PgfAlignerLin, funcs);+ gu_buf_pop(alin->parent_stack, int);+}+ +static void+pgf_aligner_lzn_symbol_ne(PgfLinFuncs** funcs)+{+ PgfAlignerLin* alin = gu_container(funcs, PgfAlignerLin, funcs);+ gu_raise(alin->err, PgalinNonExist);+}++static void+pgf_aligner_lzn_symbol_bind(PgfLinFuncs** funcs)+{+ PgfAlignerLin* alin = gu_container(funcs, PgfAlignerLin, funcs);+ alin->bind = true;+}++static void+pgf_aligner_lzn_symbol_capit(PgfLinFuncs** funcs, PgfCapitState capit)+{+ PgfAlignerLin* alin = gu_container(funcs, PgfAlignerLin, funcs);+ alin->capit = capit;+}++static void+pgf_aligner_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId id)+{+ pgf_aligner_lzn_symbol_token(funcs, "?");+}++static PgfLinFuncs pgf_file_lin_funcs = {+ .symbol_token = pgf_aligner_lzn_symbol_token,+ .begin_phrase = pgf_aligner_lzn_begin_phrase,+ .end_phrase = pgf_aligner_lzn_end_phrase,+ .symbol_ne = pgf_aligner_lzn_symbol_ne,+ .symbol_bind = pgf_aligner_lzn_symbol_bind,+ .symbol_capit = pgf_aligner_lzn_symbol_capit,+ .symbol_meta = pgf_aligner_lzn_symbol_meta+};++GuSeq*+pgf_align_words(PgfConcr* concr, PgfExpr expr,+ GuExn* err, GuPool* pool)+{+ GuPool* tmp_pool = gu_local_pool();+ + GuEnum* cts =+ pgf_lzr_concretize(concr, expr, err, tmp_pool);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ GuBuf* phrases = gu_new_buf(PgfAlignmentPhrase*, pool);++ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (!gu_variant_is_null(ctree)) {+ ctree = pgf_lzr_wrap_linref(ctree, tmp_pool);+ + PgfAlignerLin alin = {+ .funcs = &pgf_file_lin_funcs,+ .parent_stack = gu_new_buf(int, tmp_pool),+ .parent_current = gu_new_buf(int, tmp_pool),+ .phrases = phrases,+ .last_phrase = NULL,+ .sbuf = gu_new_string_buf(tmp_pool),+ .n_matches = 0,+ .err = err,+ .bind = true,+ .capit = PGF_CAPIT_NONE,+ .out_pool = pool,+ .tmp_pool = tmp_pool+ };+ gu_buf_push(alin.parent_stack, int, -1);++ pgf_lzr_linearize(concr, ctree, 0, &alin.funcs, tmp_pool);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ pgf_aligner_flush_phrase(&alin);+ }++ gu_pool_free(tmp_pool);+ return gu_buf_data_seq(phrases);+}
@@ -0,0 +1,58 @@+#include "data.h"+#include <gu/variant.h>+#include <gu/assert.h>+#include <math.h>++PGF_INTERNAL bool +pgf_tokens_equal(PgfTokens* t1, PgfTokens* t2)+{+ size_t len1 = gu_seq_length(t1);+ size_t len2 = gu_seq_length(t2);+ if (len1 != len2) {+ return false;+ }+ for (size_t i = 0; i < len1; i++) {+ GuString s1 = gu_seq_get(t1, PgfToken, i);+ GuString s2 = gu_seq_get(t2, PgfToken, i);+ if (strcmp(s1, s2) != 0) {+ return false;+ }+ }+ return true;+}++static int+pgf_flag_cmp_fn(GuOrder* self, const void* p1, const void* p2)+{+ (void) self;+ return strcmp((GuString) p1, ((PgfFlag*) p2)->name);+}++PGF_INTERNAL GuOrder pgf_flag_order[1] = { { pgf_flag_cmp_fn } };++static int+pgf_abscat_cmp_fn(GuOrder* self, const void* p1, const void* p2)+{+ (void) self;+ return strcmp((GuString) p1, ((PgfAbsCat*) p2)->name);+}++PGF_INTERNAL GuOrder pgf_abscat_order[1] = { { pgf_abscat_cmp_fn } };++static int+pgf_absfun_cmp_fn(GuOrder* self, const void* p1, const void* p2)+{+ (void) self;+ return strcmp((GuString) p1, ((PgfAbsFun*) p2)->name);+}++PGF_INTERNAL GuOrder pgf_absfun_order[1] = { { pgf_absfun_cmp_fn } };++static int+pgf_concr_cmp_fn(GuOrder* self, const void* p1, const void* p2)+{+ (void) self;+ return strcmp((GuString) p1, ((PgfConcr*) p2)->name);+}++PGF_INTERNAL GuOrder pgf_concr_order[1] = { { pgf_concr_cmp_fn } };
@@ -0,0 +1,370 @@+#ifndef PGF_DATA_H_+#define PGF_DATA_H_++#include <gu/variant.h>+#include <gu/map.h>+#include <gu/string.h>+#include <gu/seq.h>+#include <pgf/pgf.h>++typedef struct PgfCCat PgfCCat;++typedef GuSeq PgfCCats;++#define PgfCIdMap GuStringMap++typedef struct {+ PgfCId name;+ PgfLiteral value;+} PgfFlag;++typedef GuSeq PgfFlags;++PGF_INTERNAL_DECL extern GuOrder pgf_flag_order[1];++// PgfPatt++typedef GuVariant PgfPatt;++typedef enum {+ PGF_PATT_APP,+ PGF_PATT_VAR,+ PGF_PATT_AS,+ PGF_PATT_WILD,+ PGF_PATT_LIT,+ PGF_PATT_IMPL_ARG,+ PGF_PATT_TILDE,+ PGF_PATT_NUM_TAGS+} PgfPattTag;++typedef struct {+ PgfCId ctor;+ size_t n_args;+ PgfPatt args[];+} PgfPattApp;++typedef struct {+ PgfLiteral lit;+} PgfPattLit;++typedef struct {+ PgfCId var;+} PgfPattVar;++typedef struct {+ PgfCId var;+ PgfPatt patt;+} PgfPattAs;++typedef char PgfPattWild;++typedef struct {+ PgfPatt patt;+} PgfPattImplArg;++typedef struct {+ PgfExpr expr;+} PgfPattTilde;++typedef struct {+ PgfExpr body;+ size_t n_patts;+ PgfPatt patts[];+} PgfEquation;++typedef GuSeq PgfEquations;++typedef void *PgfFunction;++typedef struct {+ PgfCId name;+ PgfType* type;+ int arity;+ PgfEquations* defns; // maybe null+ PgfExprProb ep;+ PgfFunction predicate;+ struct {+ PgfFunction code;+ union {+ size_t caf_offset;+ PgfFunction* con;+ };+ } closure;+} PgfAbsFun;++typedef GuSeq PgfAbsFuns;++PGF_INTERNAL_DECL extern GuOrder pgf_absfun_order[1];++typedef GuMap PgfMetaChildMap;++typedef struct {+ PgfCId name;+ PgfHypos* context;++ prob_t prob;++ void* predicate;+} PgfAbsCat;++typedef GuSeq PgfAbsCats;++PGF_INTERNAL_DECL extern GuOrder pgf_abscat_order[1];+++typedef struct PgfEvalGates PgfEvalGates;++typedef struct {+ PgfCId name;+ PgfFlags* aflags;+ PgfAbsFuns* funs;+ PgfAbsCats* cats;+ PgfAbsFun* abs_lin_fun;+ PgfEvalGates* eval_gates;+} PgfAbstr;++typedef enum {+ PGF_INSTR_CHECK_ARGS = 0,+ PGF_INSTR_CASE = 1,+ PGF_INSTR_CASE_LIT = 2,+ PGF_INSTR_SAVE = 3,+ PGF_INSTR_ALLOC = 4,+ PGF_INSTR_PUT_CONSTR = 5,+ PGF_INSTR_PUT_CLOSURE = 6,+ PGF_INSTR_PUT_LIT = 7,+ PGF_INSTR_SET = 8,+ PGF_INSTR_SET_PAD = 9,+ PGF_INSTR_PUSH_FRAME = 10,+ PGF_INSTR_PUSH = 11,+ PGF_INSTR_TUCK = 12,+ PGF_INSTR_EVAL = 13,+ PGF_INSTR_DROP = 16,+ PGF_INSTR_JUMP = 17,+ PGF_INSTR_FAIL = 18,+ PGF_INSTR_PUSH_ACCUM = 19,+ PGF_INSTR_POP_ACCUM = 20,+ PGF_INSTR_ADD = 21,+} PgfInstruction;++typedef GuSeq PgfConcrs;++PGF_INTERNAL_DECL extern GuOrder pgf_concr_order[1];++struct PgfPGF {+ uint16_t major_version;+ uint16_t minor_version;+ PgfFlags* gflags;+ PgfAbstr abstract;+ PgfConcrs* concretes;+ GuPool* pool; // the pool in which the grammar is allocated+};++typedef struct {+ PgfAbsCat *abscat;+ PgfCCats* cats;++ size_t n_lins;+ GuString labels[];+ /**< Labels for tuples. All nested tuples, records and tables+ * in the GF linearization types are flattened into a single+ * tuple in the corresponding PGF concrete category. This+ * field holds the labels that indicate which GF field or+ * parameter (or their combination) each tuple element+ * represents. */+} PgfCncCat;++typedef GuSeq PgfTokens;++PGF_INTERNAL_DECL bool+pgf_tokens_equal(PgfTokens* t1, PgfTokens* t2);++typedef GuSeq PgfSymbols;++typedef struct {+ PgfSymbols* form;+ /**< The form of this variant as a list of tokens. */++ GuStrings* prefixes;+ /**< The prefixes of the following symbol that trigger this+ * form. */+} PgfAlternative;++typedef struct PgfItemConts PgfItemConts;++typedef PgfCIdMap PgfPrintNames;++typedef GuStringMap PgfCncFunOverloadMap;++typedef GuMap PgfCncOverloadMap;++typedef struct PgfItem PgfItem;++typedef GuVariant PgfSymbol;++typedef enum {+ PGF_SYMBOL_CAT,+ PGF_SYMBOL_LIT,+ PGF_SYMBOL_VAR,+ PGF_SYMBOL_KS,+ PGF_SYMBOL_KP,+ PGF_SYMBOL_BIND,+ PGF_SYMBOL_SOFT_BIND,+ PGF_SYMBOL_NE,+ PGF_SYMBOL_SOFT_SPACE,+ PGF_SYMBOL_CAPIT,+ PGF_SYMBOL_ALL_CAPIT,+} PgfSymbolTag;++typedef struct {+ int d;+ int r;+} PgfSymbolIdx;++typedef PgfSymbolIdx PgfSymbolCat, PgfSymbolLit, PgfSymbolVar;++typedef struct {+ char token[0]; // a flexible array that contains the token+} PgfSymbolKS;++typedef struct PgfSymbolKP+/** A prefix-dependent symbol. The form that this symbol takes+ * depends on the form of a prefix of the following symbol. */+{+ PgfSymbols* default_form;+ /**< Default form that this symbol takes if none of of the+ * variant forms is triggered. */++ size_t n_forms;+ PgfAlternative forms[]; + /**< Variant forms whose choise depends on the following+ * symbol. */+} PgfSymbolKP;++typedef struct {+ char nothing[0]; // Empty struct+} PgfSymbolNE;++typedef struct {+ char nothing[0]; // Empty struct+} PgfSymbolBIND;++typedef struct {+ char nothing[0]; // Empty struct+} PgfSymbolCAPIT;++typedef GuBuf PgfProductionIdx;++typedef struct {+ PgfSymbols* syms; // -> PgfSymbol+ PgfProductionIdx* idx;+} PgfSequence;++typedef GuSeq PgfSequences;++typedef struct {+ PgfAbsFun* absfun;+ PgfExprProb *ep;+ int funid;+ size_t n_lins;+ PgfSequence* lins[];+} PgfCncFun;++typedef GuSeq PgfCncFuns; ++struct PgfConcr {+ PgfCId name;+ PgfAbstr* abstr;+ PgfFlags* cflags;+ PgfPrintNames* printnames;+ GuMap* ccats;+ PgfCncFunOverloadMap* fun_indices;+ PgfCncOverloadMap* coerce_idx;+ PgfCncFuns* cncfuns;+ PgfSequences* sequences;+ PgfCIdMap* cnccats;+ int total_cats;+ + GuPool* pool; // if the language is loaded separately then this is the pool+ GuFinalizer fin; // and this is the finalizer in the pool of the whole grammar+};++++// PgfProduction++typedef GuVariant PgfProduction;++typedef enum {+ PGF_PRODUCTION_APPLY,+ PGF_PRODUCTION_COERCE,+ PGF_PRODUCTION_EXTERN+} PgfProductionTag;++typedef struct {+ PgfCCat* ccat;+ PgfCCats* hypos;+} PgfPArg;++typedef GuSeq PgfPArgs;++typedef struct {+ PgfCncFun* fun; + PgfPArgs* args;+} PgfProductionApply;++typedef struct PgfProductionCoerce+/** A coercion. This production is a logical union of the coercions of+ * another FId. This allows common subsets of productions to be+ * shared. */+{+ PgfCCat* coerce;+} PgfProductionCoerce;++typedef struct {+ PgfExprProb *ep;+ GuSeq* lins;+} PgfProductionExtern;++typedef struct {+ PgfExprProb *ep;+ PgfPArgs* args;+} PgfProductionMeta;++typedef GuSeq PgfProductionSeq;++typedef struct {+ PgfCCat* ccat;+ size_t lin_idx;+ PgfProductionApply* papp;+} PgfProductionIdxEntry;++struct PgfCCat {+ PgfCncCat* cnccat;+ PgfCncFuns* lindefs;+ PgfCncFuns* linrefs;+ size_t n_synprods;+ PgfProductionSeq* prods;+ float viterbi_prob;+ int fid;+ PgfItemConts* conts;+ struct PgfAnswers* answers;+ GuFinalizer fin[0];+};++PGF_API_DECL bool+pgf_production_is_lexical(PgfProductionApply *papp, + GuBuf* non_lexical_buf, GuPool* pool);++PGF_API_DECL void+pgf_parser_index(PgfConcr* concr, + PgfCCat* ccat, PgfProduction prod,+ bool is_lexical,+ GuPool *pool);++PGF_API_DECL void+pgf_lzr_index(PgfConcr* concr, + PgfCCat* ccat, PgfProduction prod,+ bool is_lexical,+ GuPool *pool);++#endif
@@ -0,0 +1,513 @@+#include "pgf/pgf.h"+#include "pgf/data.h"+#include "pgf/reasoner.h"+#include <stdlib.h>++#define PGF_ARGS_DELTA 5++static inline PgfClosure*+pgf_mk_pap(PgfReasoner* rs, PgfClosure* fun,+ size_t n_args, PgfClosure** args)+{+ if (n_args > 0) {+ PgfValuePAP* val = gu_new_flex(rs->pool, PgfValuePAP, args, n_args);+ val->header.code = rs->eval_gates->evaluate_value_pap;+ val->fun = fun;+ val->n_args = n_args*sizeof(PgfClosure*);+ for (size_t i = 0; i < n_args; i++) {+ val->args[i] = args[i];+ }+ return &val->header;+ }+ return fun;+}++PGF_INTERNAL PgfClosure*+pgf_evaluate_expr_thunk(PgfReasoner* rs, PgfExprThunk* thunk)+{+ PgfEnv* env = thunk->env;+ PgfExpr expr = thunk->expr;++ size_t n_args = 0;+ PgfClosure** args = NULL;+ PgfClosure* res = NULL;++repeat:;+ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* eabs = ei.data;++ if (n_args > 0) {+ PgfEnv* new_env = gu_new(PgfEnv, rs->pool);+ new_env->next = env;+ new_env->closure = args[--n_args];++ env = new_env;+ expr = eabs->body;+ goto repeat;+ } else {+ thunk->header.code = rs->eval_gates->evaluate_value_lambda;+ thunk->expr = eabs->body;+ res = &thunk->header;+ }+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* eapp = ei.data;+ PgfExprThunk* thunk = + gu_new(PgfExprThunk, rs->pool);+ thunk->header.code = rs->eval_gates->evaluate_expr_thunk;+ thunk->env = env;+ thunk->expr = eapp->arg;+ + if (n_args % PGF_ARGS_DELTA == 0) {+ args = realloc(args, n_args + PGF_ARGS_DELTA);+ }+ args[n_args++] = &thunk->header;++ expr = eapp->fun;+ goto repeat;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = ei.data;+ PgfValueLit* val = (PgfValueLit*) thunk;+ val->header.code = rs->eval_gates->evaluate_value_lit;+ val->lit = elit->lit;+ res = &val->header;+ break;+ }+ case PGF_EXPR_META: {+ PgfExprMeta* emeta = ei.data;++ PgfValueMeta* val =+ gu_new(PgfValueMeta, rs->pool);+ val->header.code = rs->eval_gates->evaluate_meta;+ val->env = env;+ val->id = emeta->id;+ res = pgf_mk_pap(rs, &val->header, n_args, args);+ break;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* efun = ei.data;++ PgfAbsFun* absfun =+ gu_seq_binsearch(rs->abstract->funs, pgf_absfun_order, PgfAbsFun, efun->fun);+ gu_assert(absfun != NULL);++ if (absfun->closure.code != NULL) {+ res = pgf_mk_pap(rs, (PgfClosure*) &absfun->closure, n_args, args);+ } else {+ size_t arity = absfun->arity;++ if (n_args >= arity) {+ PgfValue* val = gu_new_flex(rs->pool, PgfValue, args, n_args);+ val->header.code = rs->eval_gates->evaluate_value;+ val->con = (PgfClosure*) &absfun->closure;++ for (size_t i = 0; i < n_args; i++) {+ val->args[i] = args[--n_args];+ }+ res = &val->header;+ } else {+ PgfExprThunk* lambda = gu_new(PgfExprThunk, rs->pool);+ lambda->header.code = rs->eval_gates->evaluate_value_lambda;+ lambda->env = NULL;+ res = pgf_mk_pap(rs, &lambda->header, n_args, args);++ for (size_t i = 0; i < arity; i++) {+ PgfExpr new_expr, arg;++ PgfExprVar *evar =+ gu_new_variant(PGF_EXPR_VAR,+ PgfExprVar,+ &arg, rs->pool);+ evar->var = arity-i-1;++ PgfExprApp *eapp =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &new_expr, rs->pool);+ eapp->fun = expr;+ eapp->arg = arg;+ + expr = new_expr;+ }++ for (size_t i = 0; i < arity-1; i++) {+ PgfExpr new_expr;++ PgfExprAbs *eabs =+ gu_new_variant(PGF_EXPR_ABS,+ PgfExprAbs,+ &new_expr, rs->pool);+ eabs->bind_type = PGF_BIND_TYPE_EXPLICIT;+ eabs->id = "_";+ eabs->body = expr;++ expr = new_expr;+ }+ + lambda->expr = expr;+ }+ }+ break;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* evar = ei.data;+ PgfEnv* tmp_env = env;+ size_t i = evar->var;+ while (i > 0) {+ tmp_env = tmp_env->next;+ if (tmp_env == NULL) {+ GuExnData* err_data = gu_raise(rs->err, PgfExn);+ if (err_data) {+ err_data->data = "invalid de Bruijn index";+ }+ return NULL;+ }+ i--;+ }++ res = pgf_mk_pap(rs, tmp_env->closure, n_args, args);+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = ei.data;+ expr = etyped->expr;+ goto repeat;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = ei.data;+ expr = eimpl->expr;+ goto repeat;+ }+ default:+ gu_impossible();+ }++ free(args);+ return res;+}++PGF_INTERNAL PgfClosure*+pgf_evaluate_lambda_application(PgfReasoner* rs, PgfExprThunk* lambda,+ PgfClosure* arg)+{+ PgfEnv* new_env = gu_new(PgfEnv, rs->pool);+ new_env->next = lambda->env;+ new_env->closure = arg;++ PgfExprThunk* thunk = gu_new(PgfExprThunk, rs->pool);+ thunk->header.code = rs->eval_gates->evaluate_expr_thunk;+ thunk->env = new_env;+ thunk->expr = lambda->expr;+ return pgf_evaluate_expr_thunk(rs, thunk);+}++static PgfExpr+pgf_value2expr(PgfReasoner* rs, int level, PgfClosure* clos)+{+ clos = rs->eval_gates->enter(rs, clos);+ if (clos == NULL)+ return gu_null_variant;++ PgfExpr expr = gu_null_variant;+ size_t n_args = 0;+ PgfClosure** args;++ if (clos->code == rs->eval_gates->evaluate_value) {+ PgfValue* val = (PgfValue*) clos;+ PgfAbsFun* absfun = gu_container(val->con, PgfAbsFun, closure);++ expr = absfun->ep.expr;+ n_args = gu_seq_length(absfun->type->hypos);+ args = val->args;+ } else if (clos->code == rs->eval_gates->evaluate_value_lit) {+ PgfValueLit* val = (PgfValueLit*) clos;++ PgfExprLit *elit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &expr, rs->out_pool);++ GuVariantInfo i = gu_variant_open(val->lit);+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = i.data;++ PgfLiteralStr* new_lstr =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(lstr->val)+1,+ &elit->lit, rs->out_pool);+ strcpy(new_lstr->val, lstr->val);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = i.data;++ PgfLiteralInt* new_lint =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &elit->lit, rs->out_pool);+ new_lint->val = lint->val;+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = i.data;++ PgfLiteralFlt* new_lflt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &elit->lit, rs->out_pool);+ new_lflt->val = lflt->val;+ break;+ }+ default:+ gu_impossible();+ }+ } else if (clos->code == rs->eval_gates->evaluate_value_pap) {+ PgfValuePAP *pap = (PgfValuePAP*) clos;++ PgfValueGen* gen =+ gu_new(PgfValueGen, rs->pool);+ gen->header.code = rs->eval_gates->evaluate_gen;+ gen->level = level;++ size_t n_args = pap->n_args/sizeof(PgfClosure*);+ PgfValuePAP* new_pap = gu_new_flex(rs->pool, PgfValuePAP, args, n_args+1);+ new_pap->header.code = rs->eval_gates->evaluate_value_pap;+ new_pap->fun = pap->fun;+ new_pap->n_args = pap->n_args+sizeof(PgfClosure*);+ new_pap->args[0] = &gen->header;+ for (size_t i = 0; i < n_args; i++) {+ new_pap->args[i+1] = pap->args[i];+ }++ PgfExprAbs *eabs =+ gu_new_variant(PGF_EXPR_ABS,+ PgfExprAbs,+ &expr, rs->out_pool);+ eabs->bind_type = PGF_BIND_TYPE_EXPLICIT;+ eabs->id = gu_format_string(rs->out_pool, "v%d", level);+ eabs->body = pgf_value2expr(rs, level+1, &new_pap->header);+ } else if (clos->code == rs->eval_gates->evaluate_value_const) {+ PgfValuePAP* val = (PgfValuePAP*) clos;+ + if (val->fun->code == rs->eval_gates->evaluate_meta) {+ PgfValueMeta* fun = (PgfValueMeta*) val->fun;++ PgfExprMeta *emeta =+ gu_new_variant(PGF_EXPR_META,+ PgfExprMeta,+ &expr, rs->out_pool);+ emeta->id = fun->id;+ } else if (val->fun->code == rs->eval_gates->evaluate_gen) {+ PgfValueGen* fun = (PgfValueGen*) val->fun;++ PgfExprVar *evar =+ gu_new_variant(PGF_EXPR_VAR,+ PgfExprVar,+ &expr, rs->out_pool);+ evar->var = level - fun->level - 1;+ } else if (val->fun->code == rs->eval_gates->evaluate_sum) {+ PgfValueSum* sum = (PgfValueSum*) val->fun;++ PgfExpr e1,e2;+ PgfExprFun *efun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, 2,+ &e1, rs->out_pool);+ strcpy(efun->fun, "+");++ PgfExprLit *elit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &e2, rs->out_pool);+ elit->lit = sum->lit;+ + PgfExprApp* eapp =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &expr, rs->out_pool);+ eapp->fun = e1;+ eapp->arg = e2;+ + size_t n_consts = gu_buf_length(sum->consts);+ for (size_t i = 0; i < n_consts; i++) {+ PgfClosure* con =+ gu_buf_get(sum->consts, PgfClosure*, i);++ PgfExpr fun = expr;+ PgfExpr arg = + pgf_value2expr(rs, level, con);+ if (gu_variant_is_null(arg))+ return gu_null_variant;++ PgfExprApp* e =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &expr, rs->out_pool);+ e->fun = fun;+ e->arg = arg;+ }+ } else {+ PgfAbsFun* absfun = gu_container(val->fun, PgfAbsFun, closure);+ expr = absfun->ep.expr;+ }++ n_args = val->n_args/sizeof(PgfClosure*);+ args = val->args;+ } else {+ gu_impossible();+ }++ for (size_t i = 0; i < n_args; i++) {+ PgfExpr fun = expr;+ PgfExpr arg = + pgf_value2expr(rs, level, args[i]);+ if (gu_variant_is_null(arg))+ return gu_null_variant;++ PgfExprApp* e =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &expr, rs->out_pool);+ e->fun = fun;+ e->arg = arg;+ }++ return expr;+}++PGF_API PgfExpr+pgf_compute(PgfPGF* pgf, PgfExpr expr, GuExn* err, GuPool* pool, GuPool* out_pool)+{+ PgfReasoner* rs =+ pgf_new_reasoner(pgf, err, pool, out_pool);++ PgfExprThunk* thunk =+ gu_new(PgfExprThunk, pool);+ thunk->header.code = rs->eval_gates->evaluate_expr_thunk;+ thunk->env = NULL;+ thunk->expr = expr;++ return pgf_value2expr(rs, 0, &thunk->header);+}++PGF_INTERNAL void+pgf_evaluate_accum_init_int(PgfReasoner* rs, + PgfEvalAccum* accum, int val)+{+ PgfLiteralInt *lit_int =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &accum->lit,+ rs->pool);+ lit_int->val = val;+ accum->consts = NULL;+}++PGF_INTERNAL void+pgf_evaluate_accum_init_str(PgfReasoner* rs, + PgfEvalAccum* accum, GuString val)+{+ if (val == NULL)+ val = "";++ PgfLiteralStr *lit_str =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(val)+1,+ &accum->lit, rs->pool);+ strcpy((char*) lit_str->val, (char*) val);+ accum->consts = NULL;+}++PGF_INTERNAL void+pgf_evaluate_accum_init_flt(PgfReasoner* rs, + PgfEvalAccum* accum, float val)+{+ PgfLiteralFlt *lit_flt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &accum->lit,+ rs->pool);+ lit_flt->val = val;+ accum->enter_stack_ptr = rs->enter_stack_ptr;+ rs->enter_stack_ptr = ((char*)accum)-sizeof(char*)*2;+ accum->consts = NULL;+}++static void+pgf_evaluate_accum_add_helper(PgfEvalAccum* accum, PgfLiteral lit)+{+ GuVariantInfo ei = gu_variant_open(lit);+ switch (ei.tag) {+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = ei.data;+ ((PgfLiteralInt*)gu_variant_data(accum->lit))->val += lint->val;+ break;+ }+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = ei.data;+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = ei.data;+ ((PgfLiteralFlt*)gu_variant_data(accum->lit))->val += lflt->val;+ break;+ }+ }+}++PGF_INTERNAL void+pgf_evaluate_accum_add(PgfReasoner* rs,+ PgfEvalAccum* accum, PgfClosure* closure)+{+ if (closure->code == rs->eval_gates->evaluate_value_lit) {+ PgfValueLit* val = (PgfValueLit*) closure;+ pgf_evaluate_accum_add_helper(accum, val->lit);+ } else if (closure->code == rs->eval_gates->evaluate_value_const) {+ if (accum->consts == NULL)+ accum->consts = gu_new_buf(PgfClosure*, rs->pool);++ PgfValuePAP* pap = (PgfValuePAP*) closure;+ + if (pap->fun->code == rs->eval_gates->evaluate_sum) {+ PgfValueSum* val = (PgfValueSum*) ((PgfValuePAP*) closure)->fun;+ pgf_evaluate_accum_add_helper(accum, val->lit);++ size_t n_consts = gu_buf_length(val->consts);+ for (size_t i = 0; i < n_consts; i++) {+ PgfClosure* clos = gu_buf_get(val->consts, PgfClosure*, i);+ gu_buf_push(accum->consts, PgfClosure*, clos);+ }+ } else {+ gu_buf_push(accum->consts, PgfClosure*, closure);+ }+ } else {+ gu_impossible();+ }+}++PGF_INTERNAL PgfClosure*+pgf_evaluate_accum_done(PgfReasoner* rs, PgfEvalAccum* accum)+{+ rs->enter_stack_ptr = accum->enter_stack_ptr;++ if (accum->consts == NULL) {+ PgfValueLit* val = gu_new(PgfValueLit, rs->pool);+ val->header.code = rs->eval_gates->evaluate_value_lit;+ val->lit = accum->lit;+ return &val->header;+ } else {+ PgfValueSum* val = gu_new(PgfValueSum, rs->pool);+ val->header.code = rs->eval_gates->evaluate_sum;+ val->lit = accum->lit;+ val->consts = accum->consts;+ return &val->header;+ }+}
@@ -0,0 +1,1796 @@+#include "pgf.h"+#include "data.h"+#include <gu/assert.h>+#include <gu/utf8.h>+#include <gu/seq.h>+#include <ctype.h>+#include <stdio.h>+#include <stdlib.h>+#include <math.h>++static PgfExpr+pgf_expr_unwrap(PgfExpr expr)+{+ while (true) {+ GuVariantInfo i = gu_variant_open(expr);+ switch (i.tag) {+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = i.data;+ expr = eimpl->expr;+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = i.data;+ expr = etyped->expr;+ break;+ }+ default:+ return expr;+ }+ }+}++PGF_API int+pgf_expr_arity(PgfExpr expr)+{+ int n = 0;+ while (true) {+ PgfExpr e = pgf_expr_unwrap(expr);+ GuVariantInfo i = gu_variant_open(e);+ switch (i.tag) {+ case PGF_EXPR_APP: {+ PgfExprApp* app = i.data;+ expr = app->fun;+ n = n + 1;+ break;+ }+ case PGF_EXPR_FUN:+ return n;+ default:+ return -1;+ }+ }+}++PGF_API PgfApplication*+pgf_expr_unapply(PgfExpr expr, GuPool* pool)+{+ int arity = pgf_expr_arity(expr);+ if (arity < 0) {+ return NULL;+ }+ PgfApplication* appl = gu_new_flex(pool, PgfApplication, args, arity);+ appl->n_args = arity;+ for (int n = arity - 1; n >= 0; n--) {+ PgfExpr e = pgf_expr_unwrap(expr);+ gu_assert(gu_variant_tag(e) == PGF_EXPR_APP);+ PgfExprApp* app = gu_variant_data(e);+ appl->args[n] = app->arg;+ expr = app->fun;+ }+ PgfExpr e = pgf_expr_unwrap(expr);+ gu_assert(gu_variant_tag(e) == PGF_EXPR_FUN);+ PgfExprFun* fun = gu_variant_data(e);+ appl->fun = fun->fun;+ return appl;+}++PGF_API PgfExpr+pgf_expr_apply(PgfApplication* app, GuPool* pool)+{+ PgfExpr expr;++ size_t len = strlen(app->fun);+ PgfExprFun *efun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, len+1,+ &expr, pool);+ strcpy(efun->fun, app->fun);++ for (int i = 0; i < app->n_args; i++) {+ expr = gu_new_variant_i(pool, + PGF_EXPR_APP, PgfExprApp,+ .fun = expr,+ .arg = app->args[i]);+ }+ + return expr;+}++PGF_API PgfExpr+pgf_expr_abs(PgfBindType bind_type, PgfCId id, PgfExpr body, GuPool* pool)+{+ return gu_new_variant_i(pool, + PGF_EXPR_ABS, PgfExprAbs,+ .bind_type = bind_type,+ .id = id,+ .body = body);+}++PGF_API PgfExprAbs*+pgf_expr_unabs(PgfExpr expr)+{+ GuVariantInfo i = gu_variant_open(expr);+ if (i.tag == PGF_EXPR_ABS) {+ return (PgfExprAbs*) i.data;+ }++ return NULL;+}++PGF_API PgfExpr+pgf_expr_meta(int id, GuPool* pool)+{+ return gu_new_variant_i(pool, + PGF_EXPR_META, PgfExprMeta,+ .id = id);+}++PGF_API PgfExprMeta*+pgf_expr_unmeta(PgfExpr expr)+{+ GuVariantInfo i = gu_variant_open(expr);+ if (i.tag == PGF_EXPR_META) {+ return (PgfExprMeta*) i.data;+ }++ return NULL;+}++PGF_API PgfExpr+pgf_expr_string(GuString str, GuPool* pool)+{+ PgfLiteral lit;+ PgfLiteralStr* plit = + gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(str)+1,+ &lit, pool);+ strcpy(plit->val, str);+ return gu_new_variant_i(pool,+ PGF_EXPR_LIT,+ PgfExprLit,+ lit);+}++PGF_API PgfExpr+pgf_expr_int(int val, GuPool* pool)+{+ PgfLiteral lit;+ PgfLiteralInt* plit = + gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &lit, pool);+ plit->val = val;+ return gu_new_variant_i(pool,+ PGF_EXPR_LIT,+ PgfExprLit,+ lit);+}++PGF_API PgfExpr+pgf_expr_float(double val, GuPool* pool)+{+ PgfLiteral lit;+ PgfLiteralFlt* plit = + gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &lit, pool);+ plit->val = val;+ return gu_new_variant_i(pool,+ PGF_EXPR_LIT,+ PgfExprLit,+ lit);+}++PGF_API void*+pgf_expr_unlit(PgfExpr expr, int lit_tag)+{+ expr = pgf_expr_unwrap(expr);+ GuVariantInfo i = gu_variant_open(expr);+ if (i.tag == PGF_EXPR_LIT) {+ PgfExprLit* elit = i.data;+ GuVariantInfo i2 = gu_variant_open(elit->lit);+ if (i2.tag == lit_tag) {+ return i2.data;+ }+ }+ + return NULL;+}++typedef struct PgfExprParser PgfExprParser;++typedef enum {+ PGF_TOKEN_LPAR,+ PGF_TOKEN_RPAR,+ PGF_TOKEN_LCURLY,+ PGF_TOKEN_RCURLY,+ PGF_TOKEN_QUESTION,+ PGF_TOKEN_LAMBDA,+ PGF_TOKEN_RARROW,+ PGF_TOKEN_LTRIANGLE,+ PGF_TOKEN_RTRIANGLE,+ PGF_TOKEN_COMMA,+ PGF_TOKEN_COLON,+ PGF_TOKEN_SEMI,+ PGF_TOKEN_WILD,+ PGF_TOKEN_IDENT,+ PGF_TOKEN_INT,+ PGF_TOKEN_FLT,+ PGF_TOKEN_STR,+ PGF_TOKEN_UNKNOWN,+ PGF_TOKEN_EOF,+} PGF_TOKEN_TAG;++typedef GuUCS (*PgfParserGetc)(void* state, bool mark, GuExn* err);++struct PgfExprParser {+ GuExn* err;+ GuPool* expr_pool;+ GuPool* tmp_pool;+ PGF_TOKEN_TAG token_tag;+ GuStringBuf* token_value;++ void* getch_state;+ PgfParserGetc getch;+ GuUCS ch;+};++static void+pgf_expr_parser_getc(PgfExprParser* parser, bool mark)+{+ parser->ch = parser->getch(parser->getch_state, mark, parser->err);+ if (!gu_ok(parser->err)) {+ gu_exn_clear(parser->err);+ parser->ch = EOF;+ }+}++static bool+pgf_is_ident_first(GuUCS ucs)+{+ return (ucs == '_') ||+ (ucs >= 'a' && ucs <= 'z') ||+ (ucs >= 'A' && ucs <= 'Z') ||+ (ucs >= 192 && ucs <= 255 && ucs != 247 && ucs != 215);+}++static bool+pgf_is_ident_rest(GuUCS ucs)+{+ return (ucs == '_') ||+ (ucs == '\'') ||+ (ucs >= '0' && ucs <= '9') ||+ (ucs >= 'a' && ucs <= 'z') ||+ (ucs >= 'A' && ucs <= 'Z') ||+ (ucs >= 192 && ucs <= 255 && ucs != 247 && ucs != 215);+}++static bool+pgf_is_normal_ident(PgfCId id)+{+ const uint8_t* p = (const uint8_t*) id;+ GuUCS ucs = gu_utf8_decode(&p);+ if (!pgf_is_ident_first(ucs))+ return false;++ for (;;) {+ ucs = gu_utf8_decode(&p);+ if (ucs == 0)+ break;+ if (!pgf_is_ident_rest(ucs))+ return false;+ }++ return true;+}++static void+pgf_expr_parser_token(PgfExprParser* parser, bool mark)+{+ while (isspace(parser->ch)) {+ pgf_expr_parser_getc(parser, mark);+ mark = false;+ }++ parser->token_tag = PGF_TOKEN_UNKNOWN;+ parser->token_value = NULL;++ switch (parser->ch) {+ case EOF:+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_EOF;+ break;+ case '(':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_LPAR;+ break;+ case ')':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_RPAR;+ break;+ case '{':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_LCURLY;+ break;+ case '}':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_RCURLY;+ break;+ case '<':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_LTRIANGLE;+ break;+ case '>':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_RTRIANGLE;+ break;+ case '?':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_QUESTION;+ break;+ case '\\':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_LAMBDA;+ break;+ case '-':+ pgf_expr_parser_getc(parser, mark);+ if (parser->ch == '>') {+ pgf_expr_parser_getc(parser, false);+ parser->token_tag = PGF_TOKEN_RARROW;+ }+ break;+ case ',':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_COMMA;+ break;+ case ':':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_COLON;+ break;+ case ';':+ pgf_expr_parser_getc(parser, mark);+ parser->token_tag = PGF_TOKEN_SEMI;+ break;+ case '\'':+ pgf_expr_parser_getc(parser, mark);++ GuStringBuf* chars = gu_new_string_buf(parser->tmp_pool);+ while (parser->ch != '\'' && parser->ch != EOF) {+ if (parser->ch == '\\') {+ pgf_expr_parser_getc(parser, false);+ }+ gu_out_utf8(parser->ch, gu_string_buf_out(chars), parser->err);+ pgf_expr_parser_getc(parser, false);+ }+ if (parser->ch == '\'') {+ pgf_expr_parser_getc(parser, false);+ gu_out_utf8(0, gu_string_buf_out(chars), parser->err);+ parser->token_tag = PGF_TOKEN_IDENT;+ parser->token_value = chars;+ }+ break;+ default: {+ GuStringBuf* chars = gu_new_string_buf(parser->tmp_pool);++ if (pgf_is_ident_first(parser->ch)) {+ do {+ gu_out_utf8(parser->ch, gu_string_buf_out(chars), parser->err);+ pgf_expr_parser_getc(parser, mark);+ mark = false;+ } while (pgf_is_ident_rest(parser->ch));+ gu_out_utf8(0, gu_string_buf_out(chars), parser->err);+ parser->token_tag = PGF_TOKEN_IDENT;+ parser->token_value = chars;+ } else if (isdigit(parser->ch)) {+ while (isdigit(parser->ch)) {+ gu_out_utf8(parser->ch, gu_string_buf_out(chars), parser->err);+ pgf_expr_parser_getc(parser, mark);+ mark = false;+ }++ if (parser->ch == '.') {+ gu_out_utf8(parser->ch, gu_string_buf_out(chars), parser->err);+ pgf_expr_parser_getc(parser, false);+ + while (isdigit(parser->ch)) {+ gu_out_utf8(parser->ch, gu_string_buf_out(chars), parser->err);+ pgf_expr_parser_getc(parser, false);+ }+ gu_out_utf8(0, gu_string_buf_out(chars), parser->err);+ parser->token_tag = PGF_TOKEN_FLT;+ parser->token_value = chars;+ } else {+ gu_out_utf8(0, gu_string_buf_out(chars), parser->err);+ parser->token_tag = PGF_TOKEN_INT;+ parser->token_value = chars;+ }+ } else if (parser->ch == '"') {+ pgf_expr_parser_getc(parser, mark);++ while (parser->ch != '"' && parser->ch != EOF) {+ if (parser->ch == '\\') {+ pgf_expr_parser_getc(parser, false);+ switch (parser->ch) {+ case '\\':+ gu_out_utf8('\\', gu_string_buf_out(chars), parser->err);+ break;+ case '"':+ gu_out_utf8('\"', gu_string_buf_out(chars), parser->err);+ break;+ case 'n':+ gu_out_utf8('\n', gu_string_buf_out(chars), parser->err);+ break;+ case 'r':+ gu_out_utf8('\r', gu_string_buf_out(chars), parser->err);+ break;+ case 'b':+ gu_out_utf8('\b', gu_string_buf_out(chars), parser->err);+ break;+ case 't':+ gu_out_utf8('\t', gu_string_buf_out(chars), parser->err);+ break;+ default:+ return;+ }+ } else {+ gu_out_utf8(parser->ch, gu_string_buf_out(chars), parser->err);+ }+ pgf_expr_parser_getc(parser, false);+ }+ + if (parser->ch == '"') {+ pgf_expr_parser_getc(parser, false);+ gu_out_utf8(0, gu_string_buf_out(chars), parser->err);+ parser->token_tag = PGF_TOKEN_STR;+ parser->token_value = chars;+ }+ } else {+ pgf_expr_parser_getc(parser, mark);+ }+ break;+ }+ }+}++static bool+pgf_expr_parser_lookahead(PgfExprParser* parser, int ch)+{+ while (isspace(parser->ch)) {+ pgf_expr_parser_getc(parser, false);+ }++ return (parser->ch == ch);+}++PGF_API PgfExpr+pgf_expr_parser_expr(PgfExprParser* parser, bool mark);++static PgfType*+pgf_expr_parser_type(PgfExprParser* parser, bool mark);++static PgfExpr+pgf_expr_parser_term(PgfExprParser* parser, bool mark)+{+ switch (parser->token_tag) {+ case PGF_TOKEN_LPAR: {+ pgf_expr_parser_token(parser, false);+ PgfExpr expr = pgf_expr_parser_expr(parser, false);+ if (parser->token_tag == PGF_TOKEN_RPAR) {+ pgf_expr_parser_token(parser, mark);+ return expr;+ } else {+ return gu_null_variant;+ }+ }+ case PGF_TOKEN_LTRIANGLE: {+ pgf_expr_parser_token(parser, false);+ PgfExpr expr = pgf_expr_parser_expr(parser, false);+ if (gu_variant_is_null(expr))+ return gu_null_variant;++ if (parser->token_tag != PGF_TOKEN_COLON) {+ return gu_null_variant;+ }+ pgf_expr_parser_token(parser, false);++ PgfType* type = pgf_expr_parser_type(parser, false);+ if (type == NULL)+ return gu_null_variant;++ if (parser->token_tag != PGF_TOKEN_RTRIANGLE) {+ return gu_null_variant;+ }+ pgf_expr_parser_token(parser, mark);++ return gu_new_variant_i(parser->expr_pool,+ PGF_EXPR_TYPED,+ PgfExprTyped,+ expr, type);+ }+ case PGF_TOKEN_QUESTION: {+ pgf_expr_parser_token(parser, mark);++ PgfMetaId id = 0;+ if (parser->token_tag == PGF_TOKEN_INT) {+ char* str =+ gu_string_buf_data(parser->token_value);+ id = atoi(str);+ pgf_expr_parser_token(parser, mark);+ }+ return gu_new_variant_i(parser->expr_pool,+ PGF_EXPR_META,+ PgfExprMeta,+ id);+ }+ case PGF_TOKEN_IDENT: {+ PgfCId id = gu_string_buf_data(parser->token_value);+ pgf_expr_parser_token(parser, mark);+ PgfExpr e;+ PgfExprFun* fun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(id)+1,+ &e, parser->expr_pool);+ strcpy(fun->fun, id);+ return e;+ }+ case PGF_TOKEN_INT: {+ char* str =+ gu_string_buf_data(parser->token_value);+ int n = atoi(str);+ pgf_expr_parser_token(parser, mark);+ PgfLiteral lit =+ gu_new_variant_i(parser->expr_pool,+ PGF_LITERAL_INT,+ PgfLiteralInt,+ n);+ return gu_new_variant_i(parser->expr_pool,+ PGF_EXPR_LIT,+ PgfExprLit,+ lit);+ }+ case PGF_TOKEN_STR: {+ char* str =+ gu_string_buf_data(parser->token_value);+ pgf_expr_parser_token(parser, mark);+ return pgf_expr_string(str, parser->expr_pool);+ }+ case PGF_TOKEN_FLT: {+ char* str = + gu_string_buf_data(parser->token_value);+ double d;+ if (!gu_string_to_double(str,&d))+ return gu_null_variant;+ pgf_expr_parser_token(parser, mark);+ PgfLiteral lit =+ gu_new_variant_i(parser->expr_pool,+ PGF_LITERAL_FLT,+ PgfLiteralFlt,+ d);+ return gu_new_variant_i(parser->expr_pool,+ PGF_EXPR_LIT,+ PgfExprLit,+ lit);+ }+ default:+ return gu_null_variant;+ }+}++static PgfExpr+pgf_expr_parser_arg(PgfExprParser* parser, bool mark)+{+ PgfExpr arg;++ if (parser->token_tag == PGF_TOKEN_LCURLY) {+ pgf_expr_parser_token(parser, false);++ arg = pgf_expr_parser_expr(parser, false);+ if (gu_variant_is_null(arg))+ return gu_null_variant;++ if (parser->token_tag != PGF_TOKEN_RCURLY) {+ return gu_null_variant;+ }+ pgf_expr_parser_token(parser, mark);++ arg = gu_new_variant_i(parser->expr_pool,+ PGF_EXPR_IMPL_ARG,+ PgfExprImplArg,+ arg);+ } else {+ arg = pgf_expr_parser_term(parser, mark);+ }++ return arg;+}++static bool+pgf_expr_parser_bind(PgfExprParser* parser, GuBuf* binds)+{+ PgfCId var;+ PgfBindType bind_type = PGF_BIND_TYPE_EXPLICIT;++ if (parser->token_tag == PGF_TOKEN_LCURLY) {+ bind_type = PGF_BIND_TYPE_IMPLICIT;+ pgf_expr_parser_token(parser, false);+ }++ for (;;) {+ if (parser->token_tag == PGF_TOKEN_IDENT) {+ var =+ gu_string_copy(gu_string_buf_data(parser->token_value), parser->expr_pool);+ pgf_expr_parser_token(parser, false);+ } else if (parser->token_tag == PGF_TOKEN_WILD) {+ var = "_";+ pgf_expr_parser_token(parser, false);+ } else {+ return false;+ }++ PgfExpr bind =+ gu_new_variant_i(parser->expr_pool,+ PGF_EXPR_ABS,+ PgfExprAbs,+ bind_type,+ var,+ gu_null_variant);+ gu_buf_push(binds, PgfExpr, bind);+ + if (bind_type == PGF_BIND_TYPE_EXPLICIT ||+ parser->token_tag != PGF_TOKEN_COMMA) {+ break;+ }++ pgf_expr_parser_token(parser, false);+ }++ if (bind_type == PGF_BIND_TYPE_IMPLICIT) {+ if (parser->token_tag != PGF_TOKEN_RCURLY)+ return false;+ pgf_expr_parser_token(parser, false);+ }++ return true;+}++static GuBuf*+pgf_expr_parser_binds(PgfExprParser* parser)+{+ GuBuf* binds = gu_new_buf(PgfExpr, parser->tmp_pool);++ for (;;) {+ if (!pgf_expr_parser_bind(parser, binds))+ return NULL;++ if (parser->token_tag != PGF_TOKEN_COMMA)+ break;++ pgf_expr_parser_token(parser, false);+ }++ return binds;+}++PGF_API PgfExpr+pgf_expr_parser_expr(PgfExprParser* parser, bool mark)+{+ if (parser->token_tag == PGF_TOKEN_LAMBDA) {+ pgf_expr_parser_token(parser, false);+ GuBuf* binds = pgf_expr_parser_binds(parser);+ if (binds == NULL)+ return gu_null_variant;++ if (parser->token_tag != PGF_TOKEN_RARROW) {+ return gu_null_variant;+ }+ pgf_expr_parser_token(parser, false);++ PgfExpr expr = pgf_expr_parser_expr(parser, mark);+ if (gu_variant_is_null(expr))+ return gu_null_variant;++ size_t n_binds = gu_buf_length(binds);+ for (size_t i = n_binds; i > 0; i--) {+ PgfExpr bind = gu_buf_get(binds, PgfExpr, i-1);++ ((PgfExprAbs*) gu_variant_data(bind))->body = expr;+ expr = bind;+ }+ return expr;+ } else {+ PgfExpr expr = pgf_expr_parser_term(parser, mark);+ if (gu_variant_is_null(expr))+ return gu_null_variant;++ while (parser->token_tag != PGF_TOKEN_EOF &&+ parser->token_tag != PGF_TOKEN_RPAR &&+ parser->token_tag != PGF_TOKEN_RCURLY &&+ parser->token_tag != PGF_TOKEN_RTRIANGLE &&+ parser->token_tag != PGF_TOKEN_COLON &&+ parser->token_tag != PGF_TOKEN_COMMA &&+ parser->token_tag != PGF_TOKEN_SEMI &&+ parser->token_tag != PGF_TOKEN_UNKNOWN) {+ PgfExpr arg = pgf_expr_parser_arg(parser, mark);+ if (gu_variant_is_null(arg))+ return expr;++ expr = gu_new_variant_i(parser->expr_pool,+ PGF_EXPR_APP,+ PgfExprApp,+ expr, arg);+ }++ return expr;+ }+}++static bool+pgf_expr_parser_hypos(PgfExprParser* parser, GuBuf* hypos)+{+ PgfCId var;+ PgfBindType bind_type = PGF_BIND_TYPE_EXPLICIT;++ for (;;) {+ if (bind_type == PGF_BIND_TYPE_EXPLICIT &&+ parser->token_tag == PGF_TOKEN_LCURLY) {+ bind_type = PGF_BIND_TYPE_IMPLICIT;+ pgf_expr_parser_token(parser, false);+ }++ if (parser->token_tag == PGF_TOKEN_IDENT) {+ var =+ gu_string_copy(gu_string_buf_data(parser->token_value), parser->expr_pool);+ pgf_expr_parser_token(parser, false);+ } else if (parser->token_tag == PGF_TOKEN_WILD) {+ var = "_";+ pgf_expr_parser_token(parser, false);+ } else {+ return false;+ }++ PgfHypo* hypo = gu_buf_extend(hypos);+ hypo->bind_type = bind_type;+ hypo->cid = var;+ hypo->type = NULL;++ if (bind_type == PGF_BIND_TYPE_IMPLICIT &&+ parser->token_tag == PGF_TOKEN_RCURLY) {+ bind_type = PGF_BIND_TYPE_EXPLICIT;+ pgf_expr_parser_token(parser, false);+ }++ if (parser->token_tag != PGF_TOKEN_COMMA) {+ break;+ }+ + pgf_expr_parser_token(parser, false);+ }++ if (bind_type == PGF_BIND_TYPE_IMPLICIT)+ return false;++ return true;+}++static PgfType*+pgf_expr_parser_atom(PgfExprParser* parser, bool mark)+{+ if (parser->token_tag != PGF_TOKEN_IDENT)+ return NULL;++ PgfCId cid =+ gu_string_copy(gu_string_buf_data(parser->token_value), parser->expr_pool);+ pgf_expr_parser_token(parser, mark);++ GuBuf* args = gu_new_buf(PgfExpr, parser->tmp_pool);+ while (parser->token_tag != PGF_TOKEN_EOF &&+ parser->token_tag != PGF_TOKEN_RPAR &&+ parser->token_tag != PGF_TOKEN_RTRIANGLE &&+ parser->token_tag != PGF_TOKEN_RARROW) {+ PgfExpr arg =+ pgf_expr_parser_arg(parser, mark);+ if (gu_variant_is_null(arg))+ break;++ gu_buf_push(args, PgfExpr, arg);+ }++ size_t n_exprs = gu_buf_length(args);++ PgfType* type = gu_new_flex(parser->expr_pool, PgfType, exprs, n_exprs);+ type->hypos = gu_empty_seq();+ type->cid = cid;+ type->n_exprs = n_exprs;++ for (size_t i = 0; i < n_exprs; i++) {+ type->exprs[i] = gu_buf_get(args, PgfExpr, i);+ }+ + return type;+}++static PgfType*+pgf_expr_parser_type(PgfExprParser* parser, bool mark)+{+ PgfType* type = NULL;+ GuBuf* hypos = gu_new_buf(PgfHypo, parser->expr_pool);++ for (;;) {+ if (parser->token_tag == PGF_TOKEN_LPAR) {+ pgf_expr_parser_token(parser, false);++ size_t n_start = gu_buf_length(hypos);++ if ((parser->token_tag == PGF_TOKEN_IDENT &&+ (pgf_expr_parser_lookahead(parser, ',') || + pgf_expr_parser_lookahead(parser, ':'))) ||+ (parser->token_tag == PGF_TOKEN_LCURLY) ||+ (parser->token_tag == PGF_TOKEN_WILD)) {++ if (!pgf_expr_parser_hypos(parser, hypos))+ return NULL;++ if (parser->token_tag != PGF_TOKEN_COLON)+ return NULL;++ pgf_expr_parser_token(parser, false);+ } else {+ PgfHypo* hypo = gu_buf_extend(hypos);+ hypo->bind_type = PGF_BIND_TYPE_EXPLICIT;+ hypo->cid = "_";+ hypo->type = NULL;+ }++ size_t n_end = gu_buf_length(hypos);++ PgfType* type = pgf_expr_parser_type(parser, false);+ if (type == NULL)+ return NULL;++ if (parser->token_tag != PGF_TOKEN_RPAR)+ return NULL;++ pgf_expr_parser_token(parser, false);++ if (parser->token_tag != PGF_TOKEN_RARROW)+ return NULL;++ pgf_expr_parser_token(parser, false);++ for (size_t i = n_start; i < n_end; i++) {+ PgfHypo* hypo = gu_buf_index(hypos, PgfHypo, i);+ hypo->type = type;+ }+ } else {+ type = pgf_expr_parser_atom(parser, mark);+ if (type == NULL)+ return NULL;++ if (parser->token_tag != PGF_TOKEN_RARROW)+ break;++ pgf_expr_parser_token(parser, false);++ PgfHypo* hypo = gu_buf_extend(hypos);+ hypo->bind_type = PGF_BIND_TYPE_EXPLICIT;+ hypo->cid = "_";+ hypo->type = type;+ }+ }++ type->hypos = gu_buf_data_seq(hypos);++ return type;+}++PGF_API PgfExprParser*+pgf_new_parser(void* getc_state, PgfParserGetc getc, GuPool* pool, GuPool* tmp_pool, GuExn* err)+{+ PgfExprParser* parser = gu_new(PgfExprParser, tmp_pool);+ parser->err = err;+ parser->expr_pool = pool;+ parser->tmp_pool = tmp_pool;+ parser->getch_state = getc_state;+ parser->getch = getc;+ parser->ch = ' ';+ pgf_expr_parser_token(parser, false);+ return parser;+}++static GuUCS+pgf_expr_parser_in_getc(void* state, bool mark, GuExn* err)+{+ return gu_in_utf8((GuIn*) state, err);+}++PGF_API PgfExpr+pgf_read_expr(GuIn* in, GuPool* pool, GuPool* tmp_pool, GuExn* err)+{+ PgfExprParser* parser =+ pgf_new_parser(in, pgf_expr_parser_in_getc, pool, tmp_pool, err);+ PgfExpr expr = pgf_expr_parser_expr(parser, true);+ if (parser->token_tag != PGF_TOKEN_EOF)+ return gu_null_variant;+ return expr;+}++PGF_API int+pgf_read_expr_tuple(GuIn* in,+ size_t n_exprs, PgfExpr exprs[],+ GuPool* pool, GuExn* err)+{+ GuPool* tmp_pool = gu_new_pool();+ PgfExprParser* parser =+ pgf_new_parser(in, pgf_expr_parser_in_getc, pool, tmp_pool, err);+ if (parser->token_tag != PGF_TOKEN_LTRIANGLE)+ goto fail;+ pgf_expr_parser_token(parser, false);+ for (size_t i = 0; i < n_exprs; i++) {+ if (i > 0) {+ if (parser->token_tag != PGF_TOKEN_COMMA)+ goto fail;+ pgf_expr_parser_token(parser, false);+ }++ exprs[i] = pgf_expr_parser_expr(parser, false);+ if (gu_variant_is_null(exprs[i]))+ goto fail;+ }+ if (parser->token_tag != PGF_TOKEN_RTRIANGLE)+ goto fail;+ pgf_expr_parser_token(parser, false);+ if (parser->token_tag != PGF_TOKEN_EOF)+ goto fail;+ gu_pool_free(tmp_pool);++ return 1;+ +fail:+ gu_pool_free(tmp_pool);+ return 0;+}++PGF_API GuSeq*+pgf_read_expr_matrix(GuIn* in,+ size_t n_exprs,+ GuPool* pool, GuExn* err)+{+ GuPool* tmp_pool = gu_new_pool();+ PgfExprParser* parser =+ pgf_new_parser(in, pgf_expr_parser_in_getc, pool, tmp_pool, err);+ if (parser->token_tag != PGF_TOKEN_LTRIANGLE)+ goto fail;+ pgf_expr_parser_token(parser, false);++ GuBuf* buf = gu_new_buf(PgfExpr, pool);+ + if (parser->token_tag != PGF_TOKEN_RTRIANGLE) { + for (;;) {+ PgfExpr* exprs = gu_buf_extend_n(buf, n_exprs);++ for (size_t i = 0; i < n_exprs; i++) {+ if (i > 0) {+ if (parser->token_tag != PGF_TOKEN_COMMA)+ goto fail;+ pgf_expr_parser_token(parser, false);+ }++ exprs[i] = pgf_expr_parser_expr(parser, false);+ if (gu_variant_is_null(exprs[i]))+ goto fail;+ }++ if (parser->token_tag != PGF_TOKEN_SEMI)+ break;++ pgf_expr_parser_token(parser, false);+ }++ if (parser->token_tag != PGF_TOKEN_RTRIANGLE)+ goto fail;+ }++ pgf_expr_parser_token(parser, false);+ if (parser->token_tag != PGF_TOKEN_EOF)+ goto fail;+ gu_pool_free(tmp_pool);++ return gu_buf_data_seq(buf);++fail:+ gu_pool_free(tmp_pool);+ return NULL;+}++PGF_API PgfType*+pgf_read_type(GuIn* in, GuPool* pool, GuPool* tmp_pool, GuExn* err)+{+ PgfExprParser* parser = + pgf_new_parser(in, pgf_expr_parser_in_getc, pool, tmp_pool, err);+ PgfType* type = pgf_expr_parser_type(parser, true);+ if (parser->token_tag != PGF_TOKEN_EOF)+ return NULL;+ return type;+}++PGF_API bool+pgf_literal_eq(PgfLiteral lit1, PgfLiteral lit2)+{+ GuVariantInfo ei1 = gu_variant_open(lit1);+ GuVariantInfo ei2 = gu_variant_open(lit2);+ + if (ei1.tag != ei2.tag)+ return false;++ switch (ei1.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lit1 = ei1.data;+ PgfLiteralStr* lit2 = ei2.data;+ return strcmp(lit1->val, lit2->val) == 0;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lit1 = ei1.data;+ PgfLiteralInt* lit2 = ei2.data;+ return (lit1->val == lit2->val);+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lit1 = ei1.data;+ PgfLiteralFlt* lit2 = ei2.data;+ return (lit1->val == lit2->val);+ }+ default:+ gu_impossible();+ }+ + return false;+}++PGF_API int+pgf_expr_eq(PgfExpr e1, PgfExpr e2)+{+ GuVariantInfo ei1 = gu_variant_open(e1);+ GuVariantInfo ei2 = gu_variant_open(e2);+ + if (ei1.tag != ei2.tag)+ return false;++ switch (ei1.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* abs1 = ei1.data;+ PgfExprAbs* abs2 = ei2.data;+ return strcmp(abs1->id, abs2->id) == 0 &&+ pgf_expr_eq(abs1->body, abs2->body);+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app1 = ei1.data;+ PgfExprApp* app2 = ei2.data;+ return (pgf_expr_eq(app1->fun,app2->fun) &&+ pgf_expr_eq(app1->arg,app2->arg));+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* lit1 = ei1.data;+ PgfExprLit* lit2 = ei2.data;+ return (pgf_literal_eq(lit1->lit,lit2->lit));+ }+ case PGF_EXPR_META: {+ PgfExprMeta* meta1 = ei1.data;+ PgfExprMeta* meta2 = ei2.data;+ return (meta1->id == meta2->id);+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* fun1 = ei1.data;+ PgfExprFun* fun2 = ei2.data;+ return strcmp(fun1->fun, fun2->fun) == 0;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* var1 = ei1.data;+ PgfExprVar* var2 = ei2.data;+ return (var1->var == var2->var);+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* typed1 = ei1.data;+ PgfExprTyped* typed2 = ei2.data;+ return pgf_expr_eq(typed1->expr, typed2->expr) &&+ pgf_type_eq(typed1->type, typed2->type);+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* impl1 = ei1.data;+ PgfExprImplArg* impl2 = ei2.data;+ return pgf_expr_eq(impl1->expr, impl2->expr);+ }+ default:+ gu_impossible();+ }+ + return false;+}++PGF_API GuHash+pgf_literal_hash(GuHash h, PgfLiteral lit)+{+ GuVariantInfo i = gu_variant_open(lit);++ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lit = i.data;+ h = gu_string_hash(h, lit->val);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lit = i.data;+ h = gu_hash_byte(h, lit->val);+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lit = i.data;+ h = gu_hash_byte(h, lit->val);+ break;+ }+ default:+ gu_impossible();+ }++ return h;+}++PGF_API GuHash+pgf_expr_hash(GuHash h, PgfExpr e)+{+ GuVariantInfo ei = gu_variant_open(e);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* abs = ei.data;+ h = gu_string_hash(h, abs->id);+ h = pgf_expr_hash(h, abs->body);+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ h = pgf_expr_hash(h, app->fun);+ h = pgf_expr_hash(h, app->arg);+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* lit = ei.data;+ h = pgf_literal_hash(h, lit->lit);+ break;+ }+ case PGF_EXPR_META:+ h = gu_hash_byte(h, '?');+ break;+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;+ h = gu_string_hash(h, fun->fun);+ break;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* evar = ei.data;+ + h = gu_hash_byte(h, evar->var);+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* typed = ei.data;+ h = pgf_expr_hash(h, typed->expr);+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* impl = ei.data;+ h = pgf_expr_hash(h, impl->expr);+ break;+ }+ default:+ gu_impossible();+ }+ return h;+}++PGF_API size_t+pgf_expr_size(PgfExpr expr)+{+ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* abs = ei.data;+ return pgf_expr_size(abs->body);+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ return pgf_expr_size(app->fun) + pgf_expr_size(app->arg);+ }+ case PGF_EXPR_LIT:+ case PGF_EXPR_META:+ case PGF_EXPR_FUN:+ case PGF_EXPR_VAR: {+ return 1;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* typed = ei.data;+ return pgf_expr_size(typed->expr);+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* impl = ei.data;+ return pgf_expr_size(impl->expr);+ }+ default:+ gu_impossible();+ return 0;+ }+}++static void+pgf_expr_functions_helper(PgfExpr expr, GuBuf* functions)+{+ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* abs = ei.data;+ pgf_expr_functions_helper(abs->body, functions);+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ pgf_expr_functions_helper(app->fun, functions);+ pgf_expr_functions_helper(app->arg, functions);+ break;+ }+ case PGF_EXPR_LIT:+ case PGF_EXPR_META:+ case PGF_EXPR_VAR: {+ break;+ }+ case PGF_EXPR_FUN:{+ PgfExprFun* fun = ei.data;+ gu_buf_push(functions, GuString, fun->fun);+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* typed = ei.data;+ pgf_expr_functions_helper(typed->expr, functions);+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* impl = ei.data;+ pgf_expr_functions_helper(impl->expr, functions);+ break;+ }+ default:+ gu_impossible();+ }+}++PGF_API GuSeq*+pgf_expr_functions(PgfExpr expr, GuPool* pool)+{+ GuBuf* functions = gu_new_buf(GuString, pool);+ pgf_expr_functions_helper(expr, functions);+ return gu_buf_data_seq(functions);+}++PGF_API PgfType*+pgf_type_substitute(PgfType* type, GuSeq* meta_values, GuPool* pool)+{+ size_t n_hypos = gu_seq_length(type->hypos);+ PgfHypos* new_hypos = gu_new_seq(PgfHypo, n_hypos, pool);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(type->hypos, PgfHypo, i);+ PgfHypo* new_hypo = gu_seq_index(new_hypos, PgfHypo, i);++ new_hypo->bind_type = hypo->bind_type;+ new_hypo->cid = gu_string_copy(hypo->cid, pool);+ new_hypo->type = pgf_type_substitute(hypo->type, meta_values, pool);+ }++ PgfType *new_type =+ gu_new_flex(pool, PgfType, exprs, type->n_exprs);+ new_type->hypos = new_hypos;+ new_type->cid = gu_string_copy(type->cid, pool);+ new_type->n_exprs = type->n_exprs;++ for (size_t i = 0; i < type->n_exprs; i++) {+ new_type->exprs[i] =+ pgf_expr_substitute(type->exprs[i], meta_values, pool);+ }+ + return new_type;+}++PGF_API PgfExpr+pgf_expr_substitute(PgfExpr expr, GuSeq* meta_values, GuPool* pool)+{+ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* abs = ei.data;++ PgfCId id = gu_string_copy(abs->id, pool);+ PgfExpr body = pgf_expr_substitute(abs->body, meta_values, pool);+ return gu_new_variant_i(pool,+ PGF_EXPR_ABS,+ PgfExprAbs,+ abs->bind_type, id, body);+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ + PgfExpr fun = pgf_expr_substitute(app->fun, meta_values, pool);+ PgfExpr arg = pgf_expr_substitute(app->arg, meta_values, pool);+ return gu_new_variant_i(pool,+ PGF_EXPR_APP,+ PgfExprApp,+ fun, arg);+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = ei.data;++ PgfLiteral lit;+ GuVariantInfo i = gu_variant_open(elit->lit);+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = i.data;++ PgfLiteralStr* new_lstr =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(lstr->val)+1,+ &lit, pool);+ strcpy(new_lstr->val, lstr->val);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = i.data;++ PgfLiteralInt* new_lint =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &lit, pool);+ new_lint->val = lint->val;+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = i.data;++ PgfLiteralFlt* new_lflt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &lit, pool);+ new_lflt->val = lflt->val;+ break;+ }+ default:+ gu_impossible();+ }+ + return gu_new_variant_i(pool,+ PGF_EXPR_LIT,+ PgfExprLit,+ lit);+ }+ case PGF_EXPR_META: {+ PgfExprMeta* meta = ei.data;+ PgfExpr e = gu_null_variant;+ if ((size_t) meta->id < gu_seq_length(meta_values)) {+ e = gu_seq_get(meta_values, PgfExpr, meta->id);+ }+ if (gu_variant_is_null(e)) {+ e = gu_new_variant_i(pool,+ PGF_EXPR_META,+ PgfExprMeta,+ meta->id);+ }+ return e;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;++ PgfExpr e;+ PgfExprFun* new_fun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(fun->fun)+1,+ &e, pool);+ strcpy(new_fun->fun, fun->fun);+ return e;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* var = ei.data;+ return gu_new_variant_i(pool,+ PGF_EXPR_VAR,+ PgfExprVar,+ var->var);+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* typed = ei.data;+ + PgfExpr expr = pgf_expr_substitute(typed->expr, meta_values, pool);+ PgfType *type = pgf_type_substitute(typed->type, meta_values, pool);++ return gu_new_variant_i(pool,+ PGF_EXPR_TYPED,+ PgfExprTyped,+ expr,+ type);+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* impl = ei.data;++ PgfExpr expr = pgf_expr_substitute(impl->expr, meta_values, pool);+ return gu_new_variant_i(pool,+ PGF_EXPR_IMPL_ARG,+ PgfExprImplArg,+ expr);+ }+ default:+ gu_impossible();+ return gu_null_variant;+ }+}++PGF_API void+pgf_print_cid(PgfCId id,+ GuOut* out, GuExn* err)+{+ if (pgf_is_normal_ident(id))+ gu_string_write(id, out, err);+ else {+ gu_putc('\'', out, err);+ const uint8_t* p = (const uint8_t*) id;+ for (;;) {+ GuUCS ucs = gu_utf8_decode(&p);+ if (ucs == 0)+ break;+ if (ucs == '\'')+ gu_puts("\\\'", out, err);+ else if (ucs == '\\')+ gu_puts("\\\\", out, err);+ else+ gu_out_utf8(ucs, out, err);+ }+ gu_putc('\'', out, err);+ }+}++PGF_API void+pgf_print_literal(PgfLiteral lit,+ GuOut* out, GuExn* err)+{+ GuVariantInfo ei = gu_variant_open(lit);+ switch (ei.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lit = ei.data;+ gu_putc('"', out, err);+ const uint8_t* s = (uint8_t*) lit->val;+ while (*s) {+ GuUCS c = gu_utf8_decode(&s);+ switch (c) {+ case '\\':+ gu_puts("\\\\", out, err);+ break;+ case '"':+ gu_puts("\\\"", out, err);+ break;+ case '\n':+ gu_puts("\\n", out, err);+ break;+ case '\r':+ gu_puts("\\r", out, err);+ break;+ case '\b':+ gu_puts("\\b", out, err);+ break;+ case '\t':+ gu_puts("\\t", out, err);+ break;+ default:+ gu_out_utf8(c, out, err);+ }+ }+ gu_putc('"', out, err);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lit = ei.data;+ gu_printf(out, err, "%d", lit->val);+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lit = ei.data;+ gu_printf(out, err, "%lf", lit->val);+ break;+ }+ default:+ gu_impossible();+ }+}++PGF_API void+pgf_print_expr(PgfExpr expr, PgfPrintContext* ctxt, int prec,+ GuOut* out, GuExn* err)+{+ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* abs = ei.data;++ if (prec > 1) {+ gu_puts("(", out, err);+ }++ gu_putc('\\', out, err);+ + PgfPrintContext* new_ctxt = ctxt;++ for (;;) {+ if (abs->bind_type == PGF_BIND_TYPE_IMPLICIT) {+ gu_putc('{', out, err);+ }+ pgf_print_cid(abs->id, out, err);+ if (abs->bind_type == PGF_BIND_TYPE_IMPLICIT) {+ gu_putc('}', out, err);+ }++ PgfPrintContext* c = malloc(sizeof(PgfPrintContext));+ c->name = abs->id;+ c->next = new_ctxt;+ new_ctxt = c;++ if (gu_variant_tag(abs->body) != PGF_EXPR_ABS)+ break;+ + gu_putc(',', out, err);+ + abs = gu_variant_data(abs->body);+ }++ gu_puts(" -> ", out, err);+ pgf_print_expr(abs->body, new_ctxt, 1, out, err);++ while (new_ctxt != ctxt) {+ PgfPrintContext* next = new_ctxt->next;+ free(new_ctxt);+ new_ctxt = next;+ }++ if (prec > 1) {+ gu_puts(")", out, err);+ }+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ if (prec > 3) {+ gu_puts("(", out, err);+ }+ pgf_print_expr(app->fun, ctxt, 3, out, err);+ gu_puts(" ", out, err);+ pgf_print_expr(app->arg, ctxt, 4, out, err);+ if (prec > 3) {+ gu_puts(")", out, err);+ }+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* lit = ei.data;+ pgf_print_literal(lit->lit, out, err);+ break;+ }+ case PGF_EXPR_META: {+ PgfExprMeta* meta = ei.data;+ gu_putc('?', out, err);+ if (meta->id > 0)+ gu_printf(out, err, "%d", meta->id);+ break;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;+ pgf_print_cid(fun->fun, out, err);+ break;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* evar = ei.data;+ + int var = evar->var;+ PgfPrintContext* c = ctxt;+ while (c != NULL && var > 0) {+ c = ctxt->next;+ var--;+ }+ + if (c == NULL) {+ gu_printf(out, err, "#%d", evar->var);+ } else {+ pgf_print_cid(c->name, out, err);+ }+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* typed = ei.data;+ gu_putc('<', out, err);+ pgf_print_expr(typed->expr, ctxt, 0, out, err);+ gu_puts(" : ", out, err);+ pgf_print_type(typed->type, ctxt, 0, out, err);+ gu_putc('>', out, err);+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* impl = ei.data;+ gu_putc('{', out, err);+ pgf_print_expr(impl->expr, ctxt, 0, out, err);+ gu_putc('}', out, err);+ break;+ }+ default:+ gu_impossible();+ }+}++PGF_API PgfPrintContext*+pgf_print_hypo(PgfHypo *hypo, PgfPrintContext* ctxt, int prec,+ GuOut *out, GuExn *err)+{+ if (hypo->bind_type == PGF_BIND_TYPE_IMPLICIT) {+ gu_puts("({", out, err);+ pgf_print_cid(hypo->cid, out, err);+ gu_puts("} : ", out, err);+ pgf_print_type(hypo->type, ctxt, 0, out, err);+ gu_puts(")", out, err);+ } else {+ GuPool* tmp_pool = gu_new_pool();++ if (strcmp(hypo->cid, "_") != 0) {+ gu_puts("(", out, err);+ pgf_print_cid(hypo->cid, out, err);+ gu_puts(" : ", out, err);+ pgf_print_type(hypo->type, ctxt, 0, out, err);+ gu_puts(")", out, err);+ } else {+ pgf_print_type(hypo->type, ctxt, prec, out, err);+ }++ gu_pool_free(tmp_pool);+ }++ PgfPrintContext* new_ctxt = malloc(sizeof(PgfPrintContext));+ new_ctxt->name = hypo->cid;+ new_ctxt->next = ctxt;+ return new_ctxt;+}++PGF_API void+pgf_print_type(PgfType *type, PgfPrintContext* ctxt, int prec,+ GuOut *out, GuExn *err)+{+ size_t n_hypos = gu_seq_length(type->hypos);+ + if (n_hypos > 0) {+ if (prec > 0) gu_putc('(', out, err);++ PgfPrintContext* new_ctxt = ctxt;+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo *hypo = gu_seq_index(type->hypos, PgfHypo, i);+ new_ctxt = pgf_print_hypo(hypo, new_ctxt, 1, out, err);++ gu_puts(" -> ", out, err);+ }++ pgf_print_cid(type->cid, out, err);+ + for (size_t i = 0; i < type->n_exprs; i++) {+ gu_puts(" ", out, err);+ pgf_print_expr(type->exprs[i], new_ctxt, 4, out, err);+ }++ while (new_ctxt != ctxt) {+ PgfPrintContext* next = new_ctxt->next;+ free(new_ctxt);+ new_ctxt = next;+ }++ if (prec > 0) gu_putc(')', out, err);+ } else if (type->n_exprs > 0) {+ if (prec > 3) gu_putc('(', out, err);+ + gu_string_write(type->cid, out, err);+ + for (size_t i = 0; i < type->n_exprs; i++) {+ gu_puts(" ", out, err);+ pgf_print_expr(type->exprs[i], ctxt, 4, out, err);+ }+ + if (prec > 3) gu_putc(')', out, err);+ } else {+ pgf_print_cid(type->cid, out, err);+ }+}++PGF_API void+pgf_print_context(PgfHypos *hypos, PgfPrintContext* ctxt,+ GuOut *out, GuExn *err)+{+ PgfPrintContext* new_ctxt = ctxt;++ size_t n_hypos = gu_seq_length(hypos);+ for (size_t i = 0; i < n_hypos; i++) {+ if (i > 0)+ gu_putc(' ', out, err);++ PgfHypo *hypo = gu_seq_index(hypos, PgfHypo, i);+ new_ctxt = pgf_print_hypo(hypo, new_ctxt, 4, out, err); + }+}++PGF_API void+pgf_print_expr_tuple(size_t n_exprs, PgfExpr exprs[], PgfPrintContext* ctxt,+ GuOut* out, GuExn* err)+{+ gu_putc('<', out, err);+ for (size_t i = 0; i < n_exprs; i++) {+ if (i > 0)+ gu_putc(',', out, err);+ pgf_print_expr(exprs[i], ctxt, 0, out, err);+ }+ gu_putc('>', out, err);+}++PGF_API bool+pgf_type_eq(PgfType* t1, PgfType* t2)+{+ if (gu_seq_length(t1->hypos) != gu_seq_length(t2->hypos))+ return false;++ size_t n_hypos = gu_seq_length(t1->hypos);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo *hypo1 = gu_seq_index(t1->hypos, PgfHypo, i);+ PgfHypo *hypo2 = gu_seq_index(t1->hypos, PgfHypo, i);+ + if (hypo1->bind_type != hypo2->bind_type)+ return false;+ + if (strcmp(hypo1->cid, hypo2->cid) != 0)+ return false;+ + if (!pgf_type_eq(hypo1->type, hypo2->type))+ return false;+ }+ + if (strcmp(t1->cid, t2->cid) != 0)+ return false;++ if (t1->n_exprs != t2->n_exprs)+ return false;++ for (size_t i = 0; i < t1->n_exprs; i++) {+ if (!pgf_expr_eq(t1->exprs[i], t2->exprs[i]))+ return false;+ }++ return true;+}++PGF_API prob_t+pgf_compute_tree_probability(PgfPGF *gr, PgfExpr expr)+{+ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ return pgf_compute_tree_probability(gr, app->fun) ++ pgf_compute_tree_probability(gr, app->arg);+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;+ PgfAbsFun* absfun =+ gu_seq_binsearch(gr->abstract.funs, pgf_absfun_order, PgfAbsFun, fun->fun);+ if (absfun == NULL)+ return INFINITY;+ else+ return absfun->ep.prob;+ }+ default:+ return 0;+ }+}
@@ -0,0 +1,248 @@+#ifndef EXPR_H_+#define EXPR_H_++#include <gu/in.h>+#include <gu/out.h>+#include <gu/variant.h>+#include <gu/seq.h>++/// Abstract syntax trees+/// @file++/// An abstract syntax tree+typedef GuVariant PgfExpr;++typedef struct PgfHypo PgfHypo;+typedef struct PgfType PgfType;++typedef int PgfMetaId;++typedef enum {+ PGF_BIND_TYPE_EXPLICIT,+ PGF_BIND_TYPE_IMPLICIT+} PgfBindType;++// PgfLiteral++typedef GuVariant PgfLiteral;+++typedef enum {+ PGF_LITERAL_STR,+ PGF_LITERAL_INT,+ PGF_LITERAL_FLT,+ PGF_LITERAL_NUM_TAGS+} PgfLiteralTag;++typedef struct {+ char val[0]; // a flexible array that contains the value+} PgfLiteralStr;++typedef struct {+ int val;+} PgfLiteralInt;++typedef struct {+ double val;+} PgfLiteralFlt;++++struct PgfHypo {+ PgfBindType bind_type;++ PgfCId cid;+ /**< Locally scoped name for the parameter if dependent types+ * are used. "_" for normal parameters. */++ PgfType* type;+};++typedef GuSeq PgfHypos;++struct PgfType {+ PgfHypos* hypos;+ PgfCId cid; /// XXX: resolve to PgfCat*?+ size_t n_exprs;+ PgfExpr exprs[];+};++ +typedef enum {+ PGF_EXPR_ABS,+ PGF_EXPR_APP,+ PGF_EXPR_LIT,+ PGF_EXPR_META,+ PGF_EXPR_FUN,+ PGF_EXPR_VAR,+ PGF_EXPR_TYPED,+ PGF_EXPR_IMPL_ARG,+ PGF_EXPR_NUM_TAGS+} PgfExprTag;++typedef struct {+ PgfBindType bind_type;+ PgfCId id;+ PgfExpr body;+} PgfExprAbs;++typedef struct {+ PgfExpr fun;+ PgfExpr arg;+} PgfExprApp;++typedef struct {+ PgfLiteral lit;+} PgfExprLit;++typedef struct {+ PgfMetaId id;+} PgfExprMeta;++typedef struct {+ char fun[0];+} PgfExprFun;++typedef struct {+ int var;+} PgfExprVar;++/**< A variable. The value is a de Bruijn index to the environment,+ * beginning from the innermost variable. */++typedef struct {+ PgfExpr expr;+ PgfType* type;+} PgfExprTyped;++typedef struct {+ PgfExpr expr;+} PgfExprImplArg;++typedef float prob_t;++typedef struct {+ prob_t prob;+ PgfExpr expr;+} PgfExprProb;++PGF_API_DECL int+pgf_expr_arity(PgfExpr expr);++typedef struct PgfApplication PgfApplication;++struct PgfApplication {+ PgfCId fun;+ int n_args;+ PgfExpr args[];+};++PGF_API_DECL PgfApplication*+pgf_expr_unapply(PgfExpr expr, GuPool* pool);++PGF_API_DECL PgfExpr+pgf_expr_apply(PgfApplication*, GuPool* pool);++PGF_API_DECL PgfExpr+pgf_expr_abs(PgfBindType bind_type, PgfCId id, PgfExpr body, GuPool* pool);++PGF_API_DECL PgfExprAbs*+pgf_expr_unabs(PgfExpr expr);++PGF_API_DECL PgfExpr+pgf_expr_string(GuString, GuPool* pool);++PGF_API_DECL PgfExpr+pgf_expr_int(int val, GuPool* pool);++PGF_API_DECL PgfExpr+pgf_expr_float(double val, GuPool* pool);++PGF_API_DECL void*+pgf_expr_unlit(PgfExpr expr, int lit_tag);++PGF_API_DECL PgfExpr+pgf_expr_meta(int id, GuPool* pool);++PGF_API_DECL PgfExprMeta*+pgf_expr_unmeta(PgfExpr expr);++PGF_API_DECL PgfExpr+pgf_read_expr(GuIn* in, GuPool* pool, GuPool* tmp_pool, GuExn* err);++PGF_API_DECL int+pgf_read_expr_tuple(GuIn* in,+ size_t n_exprs, PgfExpr exprs[],+ GuPool* pool, GuExn* err);++PGF_API_DECL GuSeq*+pgf_read_expr_matrix(GuIn* in, size_t n_exprs,+ GuPool* pool, GuExn* err);++PGF_API_DECL PgfType*+pgf_read_type(GuIn* in, GuPool* pool, GuPool* tmp_pool, GuExn* err);++PGF_API_DECL bool+pgf_literal_eq(PgfLiteral lit1, PgfLiteral lit2);++PGF_API_DECL int+pgf_expr_eq(PgfExpr e1, PgfExpr e2);++PGF_API_DECL bool+pgf_type_eq(PgfType* t1, PgfType* t2);++PGF_API_DECL GuHash+pgf_literal_hash(GuHash h, PgfLiteral lit);++PGF_API_DECL GuHash+pgf_expr_hash(GuHash h, PgfExpr e);++PGF_API size_t+pgf_expr_size(PgfExpr expr);++PGF_API GuSeq*+pgf_expr_functions(PgfExpr expr, GuPool* pool);++PGF_API PgfExpr+pgf_expr_substitute(PgfExpr expr, GuSeq* meta_values, GuPool* pool);++PGF_API PgfType*+pgf_type_substitute(PgfType* type, GuSeq* meta_values, GuPool* pool);++typedef struct PgfPrintContext PgfPrintContext;++struct PgfPrintContext {+ PgfCId name;+ PgfPrintContext* next;+};++PGF_API_DECL void+pgf_print_cid(PgfCId id, GuOut* out, GuExn* err);++PGF_API_DECL void+pgf_print_literal(PgfLiteral lit, GuOut* out, GuExn* err);++PGF_API_DECL void+pgf_print_expr(PgfExpr expr, PgfPrintContext* ctxt, int prec, + GuOut* out, GuExn* err);++PGF_API_DECL PgfPrintContext*+pgf_print_hypo(PgfHypo *hypo, PgfPrintContext* ctxt, int prec,+ GuOut* out, GuExn *err);++PGF_API_DECL void+pgf_print_type(PgfType *type, PgfPrintContext* ctxt, int prec,+ GuOut* out, GuExn *err);++PGF_API_DECL void+pgf_print_context(PgfHypos *hypos, PgfPrintContext* ctxt,+ GuOut *out, GuExn *err);++PGF_API_DECL void+pgf_print_expr_tuple(size_t n_exprs, PgfExpr exprs[], PgfPrintContext* ctxt,+ GuOut* out, GuExn* err);++PGF_API_DECL prob_t+pgf_compute_tree_probability(PgfPGF *gr, PgfExpr expr);++#endif /* EXPR_H_ */
@@ -0,0 +1,415 @@+#include "data.h"+#include "graphviz.h"+#include "linearizer.h"++PgfGraphvizOptions pgf_default_graphviz_options[1] =+ { {0, 0, 0, 1, NULL, NULL, NULL, NULL, NULL, NULL} } ;++static int+pgf_graphviz_abstract_tree_(PgfPGF* pgf, PgfExpr expr, int *pid,+ PgfGraphvizOptions* opts,+ GuOut* out, GuExn* err)+{+ int id = -1;++ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS:+ gu_impossible();+ break;+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ id = pgf_graphviz_abstract_tree_(pgf, app->fun, pid, opts, out, err);+ int arg_id = pgf_graphviz_abstract_tree_(pgf, app->arg, pid, opts, out, err);+ gu_printf(out, err, "n%d -- n%d", id, arg_id);+ if (opts->nodeEdgeStyle != NULL && *opts->nodeEdgeStyle && opts->nodeColor != NULL && *opts->nodeColor)+ gu_printf(out, err, " [style = \"%s\", color = \"%s\"]", opts->nodeEdgeStyle, opts->nodeColor);+ else if (opts->nodeEdgeStyle != NULL && *opts->nodeEdgeStyle)+ gu_printf(out, err, " [style = \"%s\"]", opts->nodeEdgeStyle);+ else if (opts->nodeColor != NULL && *opts->nodeColor)+ gu_printf(out, err, " [color = \"%s\"]", opts->nodeColor);+ gu_printf(out, err, "\n", id, arg_id);+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* lit = ei.data;+ id = (*pid)++;+ gu_printf(out, err, "n%d[label = \"", id);+ + GuVariantInfo ei = gu_variant_open(lit->lit);+ switch (ei.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lit = ei.data;+ gu_puts("\\\"", out, err);+ gu_string_write(lit->val, out, err);+ gu_puts("\\\"", out, err);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lit = ei.data;+ gu_printf(out, err, "%d", lit->val);+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lit = ei.data;+ gu_printf(out, err, "%lf", lit->val);+ break;+ }+ default:+ gu_impossible();+ }++ gu_puts("\", style = \"solid\", shape = \"plaintext\"]\n", out, err);+ break;+ }+ case PGF_EXPR_META:+ id = (*pid)++;+ gu_printf(out, err, "n%d[label = \"?\", style = \"solid\", shape = \"plaintext\"]\n", id);+ break;+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;+ id = (*pid)++;+ if (opts->noFun && opts->noCat) {+ gu_printf(out, err, "n%d[shape = \"point\"]\n", id);+ } else {+ gu_printf(out, err, "n%d[label = \"", id);+ PgfType* ty = (opts->noCat) ? NULL : pgf_function_type(pgf, fun->fun);+ if (!opts->noFun)+ gu_string_write(fun->fun, out, err);+ if (!opts->noFun && ty != NULL)+ gu_puts(" : ", out,err);+ if (ty != NULL)+ gu_string_write(ty->cid, out, err);+ gu_puts("\", shape = \"plaintext\", style = \"solid\"", out, err);+ if (opts->nodeColor != NULL && *opts->nodeColor)+ gu_printf(out, err, ", fontcolor = \"%s\"", opts->nodeColor);+ if (opts->nodeFont != NULL && *opts->nodeFont)+ gu_printf(out, err, ", fontname = \"%s\"", opts->nodeFont);+ gu_puts("]\n", out, err);+ }+ break;+ }+ case PGF_EXPR_VAR:+ gu_impossible();+ break;+ case PGF_EXPR_TYPED: {+ PgfExprTyped* typed = ei.data;+ id = pgf_graphviz_abstract_tree_(pgf, typed->expr, pid, opts, out, err);+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* implarg = ei.data;+ id = pgf_graphviz_abstract_tree_(pgf, implarg->expr, pid, opts, out, err);+ break;+ }+ default:+ gu_impossible();+ }++ return id;+}++PGF_API void+pgf_graphviz_abstract_tree(PgfPGF* pgf, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err)+{+ int id = 0;++ gu_puts("graph {\n", out, err);+ pgf_graphviz_abstract_tree_(pgf, expr, &id, opts, out, err);+ gu_puts("}", out, err);+}++typedef struct PgfParseNode PgfParseNode;+ +struct PgfParseNode {+ int id;+ PgfParseNode* parent;+ GuString fun;+ GuString label;+};++typedef struct {+ PgfLinFuncs* funcs;++ GuPool* pool;+ GuOut* out;+ GuExn* err;++ PgfParseNode* parent;+ size_t level;+ GuBuf* internals;+ GuBuf* leaves;+} PgfBracketLznState;++static void+pgf_bracket_lzn_symbol_token(PgfLinFuncs** funcs, PgfToken tok)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);++ PgfParseNode* node = gu_new(PgfParseNode, state->pool);+ node->id = 100000 + gu_buf_length(state->leaves);+ node->parent = state->parent;+ node->fun = NULL;+ node->label = tok;+ gu_buf_push(state->leaves, PgfParseNode*, node);+}++static void+pgf_bracket_lzn_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);++ if (strcmp(cat, "_") == 0)+ return;+ + state->level++;++ GuBuf* level;+ if (state->level < gu_buf_length(state->internals))+ level = gu_buf_get(state->internals, GuBuf*, state->level);+ else {+ level = gu_new_buf(PgfParseNode*, state->pool);+ gu_buf_push(state->internals, GuBuf*, level);+ }++ size_t len = gu_buf_length(level);+ for (size_t i = 0; i < len; i++) {+ PgfParseNode* node = gu_buf_get(level, PgfParseNode*, i);+ if (node->id == fid) {+ state->parent = node;+ return;+ }+ }+ + PgfParseNode* node = gu_new(PgfParseNode, state->pool);+ node->id = fid;+ node->parent = state->parent;+ node->fun = fun;+ node->label = cat;+ gu_buf_push(level, PgfParseNode*, node);++ state->parent = node;+}++static void+pgf_bracket_lzn_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);++ if (strcmp(cat, "_") == 0)+ return;++ state->level--;+ state->parent = state->parent->parent;+}++static void+pgf_bracket_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId meta_id)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);++ PgfParseNode* node = gu_new(PgfParseNode, state->pool);+ node->id = 100000 + gu_buf_length(state->leaves);+ node->parent = state->parent;+ node->fun = NULL;+ node->label = "?";+ gu_buf_push(state->leaves, PgfParseNode*, node);+}++static PgfLinFuncs pgf_bracket_lin_funcs = {+ .symbol_token = pgf_bracket_lzn_symbol_token,+ .begin_phrase = pgf_bracket_lzn_begin_phrase,+ .end_phrase = pgf_bracket_lzn_end_phrase,+ .symbol_ne = NULL,+ .symbol_bind = NULL,+ .symbol_capit = NULL,+ .symbol_meta = pgf_bracket_lzn_symbol_meta+};++static void+pgf_graphviz_parse_level(GuBuf* level, PgfGraphvizOptions* opts, GuOut* out, GuExn* err)+{+ gu_puts("\n subgraph {rank=same;\n", out, err);++ size_t len = gu_buf_length(level);+ + if (len > 1)+ gu_puts(" edge[style=invis]\n", out, err);++ for (size_t i = 0; i < len; i++) {+ PgfParseNode* node = gu_buf_get(level, PgfParseNode*, i);+ if (node->fun != NULL) {+ gu_printf(out, err, " n%d[label=\"", node->id);+ if (!opts->noFun)+ gu_string_write(node->fun, out, err);+ if (!opts->noFun && !opts->noCat)+ gu_puts(" : ", out, err);+ if (!opts->noCat)+ gu_string_write(node->label, out, err);+ gu_puts("\"", out, err);+ if (opts->nodeColor != NULL && *opts->nodeColor)+ gu_printf(out, err, ", fontcolor = \"%s\"", opts->nodeColor);+ if (opts->nodeFont != NULL && *opts->nodeFont)+ gu_printf(out, err, ", fontname = \"%s\"", opts->nodeFont);+ gu_puts("]\n", out, err);+ } else {+ if (opts->noLeaves)+ gu_printf(out, err, " n%d[label=\"\"]\n", node->id);+ else {+ gu_printf(out, err, " n%d[label=\"%s\"", node->id, node->label);+ if (opts->leafColor != NULL && *opts->leafColor)+ gu_printf(out, err, ", fontcolor = \"%s\"", opts->leafColor);+ if (opts->leafFont != NULL && *opts->leafFont)+ gu_printf(out, err, ", fontname = \"%s\"", opts->leafFont);+ gu_puts("]\n", out, err);+ }+ }+ }+ + if (len > 1) {+ for (size_t i = 0; i < len; i++) {+ PgfParseNode* node = gu_buf_get(level, PgfParseNode*, i); + + gu_puts((i == 0) ? " " : " -- ", out, err);+ gu_printf(out, err, "n%d", node->id);+ }+ gu_puts("\n", out, err);+ }+ + gu_puts(" }\n", out, err);++ for (size_t i = 0; i < len; i++) {+ PgfParseNode* node = gu_buf_get(level, PgfParseNode*, i); + if (node->parent != NULL) {+ gu_printf(out, err, " n%d -- n%d", node->parent->id, node->id);++ GuString edgeStyle, color;+ if (node->fun == NULL) {+ edgeStyle = opts->leafEdgeStyle;+ color = opts->leafColor;+ } else {+ edgeStyle = opts->nodeEdgeStyle;+ color = opts->nodeColor;+ }++ if (edgeStyle != NULL && *edgeStyle && color != NULL && *color)+ gu_printf(out, err, " [style = \"%s\", color = \"%s\"]", edgeStyle, color);+ else if (edgeStyle != NULL && *edgeStyle)+ gu_printf(out, err, " [style = \"%s\"]", edgeStyle);+ else if (color != NULL && *color)+ gu_printf(out, err, " [color = \"%s\"]", color);++ gu_putc('\n', out, err); + }+ }+}++PGF_API void+pgf_graphviz_parse_tree(PgfConcr* concr, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err)+{+ GuPool* tmp_pool = gu_local_pool();+ + GuEnum* cts = + pgf_lzr_concretize(concr, expr, err, tmp_pool);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return;+ }++ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (gu_variant_is_null(ctree)) {+ gu_pool_free(tmp_pool);+ return;+ }++ gu_puts("graph {\n", out, err);+ gu_puts(" node[shape=plaintext]\n", out, err);++ PgfBracketLznState state;+ state.funcs = &pgf_bracket_lin_funcs;+ state.pool = tmp_pool;+ state.out = out;+ state.err = err;++ state.parent = NULL;+ state.level = -1;+ state.internals = gu_new_buf(GuBuf*, tmp_pool);+ state.leaves = gu_new_buf(PgfParseNode*, tmp_pool);+ pgf_lzr_linearize(concr, ctree, 0, &state.funcs, tmp_pool);++ size_t len = gu_buf_length(state.internals);+ for (size_t i = 0; i < len; i++) {+ GuBuf* level = gu_buf_get(state.internals, GuBuf*, i);+ pgf_graphviz_parse_level(level, opts, out, err);+ }+ pgf_graphviz_parse_level(state.leaves, opts, out, err);++ gu_puts("}", out, err);++ gu_pool_free(tmp_pool);+}+++PGF_API_DECL void+pgf_graphviz_word_alignment(PgfConcr** concrs, size_t n_concrs, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err)+{+ GuPool* tmp_pool = gu_local_pool();+ + gu_puts("digraph {\n", out, err);+ gu_puts("rankdir=LR ;\n", out, err);+ gu_puts("node [shape = record", out, err);+ if (opts->leafFont != NULL && *opts->leafFont)+ gu_printf(out, err, ", fontname = \"%s\"", opts->leafFont);+ if (opts->leafColor != NULL && *opts->leafColor)+ gu_printf(out, err, ", fontcolor = \"%s\"", opts->leafColor);+ gu_puts("] ;\n\n", out, err);+ if (opts->leafEdgeStyle != NULL && *opts->leafEdgeStyle)+ gu_printf(out, err, "edge [style = %s];\n", opts->leafEdgeStyle);+ gu_puts("\n", out, err);++ GuSeq* alignment = NULL;+ GuSeq* last_alignment = NULL;+ for (size_t i = 0; i < n_concrs; i++) {+ alignment = pgf_align_words(concrs[i], expr, err, tmp_pool);+ gu_printf(out, err, " struct%d[label=\"", i);++ size_t n_tokens = gu_seq_length(alignment);+ for (size_t j = 0; j < n_tokens; j++) {+ PgfAlignmentPhrase* phrase = gu_seq_get(alignment, PgfAlignmentPhrase*, j);+ if (j > 0)+ gu_puts(" | ", out, err);+ gu_printf(out, err, "<n%d> %s", j, phrase->phrase);+ }++ gu_puts("\"] ;\n", out, err);++ if (last_alignment != NULL) {+ size_t n_last_tokens = gu_seq_length(last_alignment);++ for (size_t j = 0; j < n_tokens; j++) {+ PgfAlignmentPhrase* phrase = gu_seq_get(alignment, PgfAlignmentPhrase*, j);++ for (size_t k = 0; k < phrase->n_fids; k++) {+ int fid = phrase->fids[k];++ for (size_t l = 0; l < n_last_tokens; l++) {+ PgfAlignmentPhrase* last_phrase = gu_seq_get(last_alignment, PgfAlignmentPhrase*, l);+ + for (size_t r = 0; r < last_phrase->n_fids; r++) {+ int last_fid = last_phrase->fids[r];+ if (fid == last_fid) {+ gu_printf(out, err, "struct%d:n%d:e -> struct%d:n%d:w ;\n",i,j,i-1,l);+ }+ }+ }+ }+ }+ }++ last_alignment = alignment;+ }++ gu_puts("}", out, err);++ gu_pool_free(tmp_pool);+}
@@ -0,0 +1,28 @@+#ifndef PGF_GRAPHVIZ_H_+#define PGF_GRAPHVIZ_H_++typedef struct {+ int noLeaves;+ int noFun;+ int noCat;+ int noDep;+ GuString nodeFont;+ GuString leafFont;+ GuString nodeColor;+ GuString leafColor;+ GuString nodeEdgeStyle;+ GuString leafEdgeStyle;+} PgfGraphvizOptions;++extern PgfGraphvizOptions pgf_default_graphviz_options[1];++PGF_API_DECL void+pgf_graphviz_abstract_tree(PgfPGF* pgf, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err);++PGF_API_DECL void+pgf_graphviz_parse_tree(PgfConcr* concr, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err);++PGF_API_DECL void+pgf_graphviz_word_alignment(PgfConcr** concrs, size_t n_concrs, PgfExpr expr, PgfGraphvizOptions* opts, GuOut* out, GuExn* err);++#endif
@@ -0,0 +1,11 @@+#include "data.h"+#include "reasoner.h"+#include "hopu.h"++PGF_INTERNAL void+pgf_pattern_unify(PgfReasoner* rs, PgfClosure* c1, PgfClosure* c2)+{+ c1 = rs->eval_gates->enter(rs, c1);+ c2 = rs->eval_gates->enter(rs, c2);+}+
@@ -0,0 +1,8 @@+#ifndef HOPU_H+#define HOPU_H++PGF_INTERNAL_DECL void+pgf_pattern_unify(PgfReasoner* rs, PgfClosure* c1, PgfClosure* c2);++#endif+
@@ -0,0 +1,1357 @@+#include <gu/seq.h>+#include <gu/file.h>+#include <gu/utf8.h>+#include <pgf/data.h>+#include <pgf/reasoner.h>+#include <pgf/reader.h>+#include "lightning.h"+#if defined(__MINGW32__) || defined(_MSC_VER)+#include <malloc.h>+#endif++//#define PGF_JIT_DEBUG+++struct PgfJitState {+ jit_state jit;+ jit_insn *buf;+ char *save_ip_ptr;+ GuBuf* call_patches;+ GuBuf* segment_patches;+ size_t n_cafs;+};++#define _jit (rdr->jit_state->jit)++typedef struct {+ PgfCId cid;+ jit_insn *ref;+} PgfCallPatch;++typedef struct {+ size_t segment;+ jit_insn *ref;+ bool is_abs;+} PgfSegmentPatch;++// Between two calls to pgf_jit_make_space we are not allowed+// to emit more that JIT_CODE_WINDOW bytes. This is not quite+// safe but this is how GNU lightning is designed.+#define JIT_CODE_WINDOW 128++#define JIT_VHEAP JIT_V0+#define JIT_VSTATE JIT_V1+#define JIT_VCLOS JIT_V2++#if defined(__MINGW32__) || defined(_MSC_VER)+#include <windows.h>++static int+getpagesize()+{+ SYSTEM_INFO system_info;+ GetSystemInfo(&system_info);+ return system_info.dwPageSize;+}+#endif+++static void+pgf_jit_finalize_page(GuFinalizer* self)+{+ free(self);+}++static void+pgf_jit_alloc_page(PgfReader* rdr)+{+ void *page;++ size_t page_size = getpagesize();++#if defined(ANDROID)+ if ((page = memalign(page_size, page_size)) == NULL) { +#elif defined(__MINGW32__) || defined(_MSC_VER)+ if ((page = malloc(page_size)) == NULL) {+#else+ if (posix_memalign(&page, page_size, page_size) != 0) {+#endif+ gu_fatal("Memory allocation failed");+ }++ GuFinalizer* fin = page;+ fin->fn = pgf_jit_finalize_page;+ gu_pool_finally(rdr->opool, fin);++ rdr->jit_state->buf = page;+ jit_set_ip(rdr->jit_state->buf+sizeof(GuFinalizer));+}++PGF_INTERNAL PgfJitState*+pgf_new_jit(PgfReader* rdr)+{+ PgfJitState* state = gu_new(PgfJitState, rdr->tmp_pool);+ memset(&state->jit, 0, sizeof(state->jit));+ state->call_patches = gu_new_buf(PgfCallPatch, rdr->tmp_pool);+ state->segment_patches = gu_new_buf(PgfSegmentPatch, rdr->tmp_pool);+ state->buf = NULL;+ state->save_ip_ptr = NULL;+ state->n_cafs = 0;+ return state;+}++static void+pgf_jit_make_space(PgfReader* rdr, size_t space)+{+ size_t page_size = getpagesize();+ if (rdr->jit_state->buf == NULL) {+ pgf_jit_alloc_page(rdr);+ } else {+ assert (jit_get_ip().ptr < rdr->jit_state->save_ip_ptr);++ if (jit_get_ip().ptr + space > ((char*) rdr->jit_state->buf) + page_size) {+ jit_flush_code(rdr->jit_state->buf, jit_get_ip().ptr);+ pgf_jit_alloc_page(rdr);+ }+ }++ rdr->jit_state->save_ip_ptr = jit_get_ip().ptr + space;+}++static PgfAbsFun*+pgf_jit_read_absfun(PgfReader* rdr, PgfAbstr* abstr)+{+ gu_in_f64be(rdr->in, rdr->err); // ignore+ gu_return_on_exn(rdr->err, NULL);++ PgfCId name = pgf_read_cid(rdr, rdr->tmp_pool);+ gu_return_on_exn(rdr->err, NULL);++ PgfAbsFun* absfun =+ gu_seq_binsearch(abstr->funs, pgf_absfun_order, PgfAbsFun, name);+ assert(absfun != NULL);++ return absfun;+}++PGF_INTERNAL void+pgf_jit_predicate(PgfReader* rdr, PgfAbstr* abstr,+ PgfAbsCat* abscat)+{+#ifdef PGF_JIT_DEBUG+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ + gu_string_write(abscat->name, out, err);+ gu_puts(":\n", out, err);+#endif++ size_t n_funs = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ abscat->predicate = (PgfFunction) jit_get_ip().ptr;++ if (strcmp(abscat->name, "String") == 0) {+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, " MK_STRING\n");+#endif++ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_mk_string);++#ifdef PGF_JIT_DEBUG+ gu_puts(" RET\n", out, err);+#endif+ // compile RET+ jit_bare_ret();+ + return;+ }++ if (strcmp(abscat->name, "Int") == 0) {+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, " MK_INT\n");+#endif++ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_mk_int);++#ifdef PGF_JIT_DEBUG+ gu_puts(" RET\n", out, err);+#endif+ // compile RET+ jit_bare_ret();+ + return;+ }++ if (strcmp(abscat->name, "Float") == 0) {+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, " MK_FLOAT\n");+#endif++ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_mk_float);++#ifdef PGF_JIT_DEBUG+ gu_puts(" RET\n", out, err);+#endif+ // compile RET+ jit_bare_ret();+ + return;+ }++ PgfAbsFun* absfun = NULL;+ PgfAbsFun* next_absfun = NULL;++ if (n_funs > 0) {+ next_absfun = pgf_jit_read_absfun(rdr, abstr);++#ifdef PGF_JIT_DEBUG+ gu_puts(" TRY_FIRST ", out, err);+ gu_string_write(next_absfun->name, out, err);+ gu_puts("\n", out, err);+#endif++ // compile TRY_FIRST+ jit_prepare(3);+ jit_movi_p(JIT_R0,next_absfun);+ jit_pusharg_p(JIT_R0);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_try_first);+ jit_bare_ret();+ } else {+#ifdef PGF_JIT_DEBUG+ gu_puts(" RET\n", out, err);+#endif+ // compile RET+ jit_bare_ret();+ }++#ifdef PGF_JIT_DEBUG+ if (n_funs > 0) {+ gu_string_write(next_absfun->name, out, err);+ gu_puts(":\n", out, err);+ }+#endif++ for (size_t i = 0; i < n_funs; i++) {+ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ absfun = next_absfun;+ absfun->predicate = (PgfFunction) jit_get_ip().ptr;++ size_t n_hypos = gu_seq_length(absfun->type->hypos);++ if (n_hypos > 0) {+ if (i+1 < n_funs) {+ next_absfun = pgf_jit_read_absfun(rdr, abstr); // i+1++#ifdef PGF_JIT_DEBUG+ gu_puts(" TRY_ELSE ", out, err);+ gu_string_write(next_absfun->name, out, err);+ gu_puts("\n", out, err);+#endif++ // compile TRY_ELSE+ jit_prepare(3);+ jit_movi_p(JIT_R0, next_absfun);+ jit_pusharg_p(JIT_R0);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_try_else);+ }++ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(absfun->type->hypos, PgfHypo, i);++ jit_insn *ref;++ // call the predicate for the category in hypo->type->cid+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, + (i+1 < n_hypos) ? " CALL %s\n" + : " CALL %s tail(0)\n",+ hypo->type->cid);+#endif++ // compile CALL+ ref = jit_movi_p(JIT_R0, jit_forward());+ jit_str_p(JIT_VCLOS, JIT_R0);++ PgfCallPatch patch;+ patch.cid = hypo->type->cid;+ patch.ref = jit_jmpi(jit_forward());+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);++ if (i+1 < n_hypos) {+ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);+ jit_patch_movi(ref,jit_get_label());+ } else {+ jit_patch_movi(ref,abstr->eval_gates->complete);+ }+ }+ } else {+ if (i+1 < n_funs) {+ next_absfun = pgf_jit_read_absfun(rdr, abstr); // i+1++#ifdef PGF_JIT_DEBUG+ gu_puts(" TRY_CONSTANT ", out, err);+ gu_string_write(next_absfun->name, out, err);+ gu_puts("\n", out, err);+#endif++ // compile TRY_CONSTANT+ jit_prepare(3);+ jit_movi_p(JIT_R0, next_absfun);+ jit_pusharg_p(JIT_R0);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_try_constant);+ } else {+#ifdef PGF_JIT_DEBUG+ gu_puts(" COMPLETE\n", out, err);+#endif++ // compile COMPLETE+ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_complete);+ }++#ifdef PGF_JIT_DEBUG+ gu_puts(" RET\n", out, err);+#endif++ // compile RET+ jit_ret();+ }++#ifdef PGF_JIT_DEBUG+ if (i+1 < n_funs) {+ gu_string_write(next_absfun->name, out, err);+ gu_puts(":\n", out, err);+ }+#endif+ }++#ifdef PGF_JIT_DEBUG+ gu_pool_free(tmp_pool);+#endif+}++static void+pgf_jit_finalize_cafs(GuFinalizer* self)+{+ PgfEvalGates* gates = gu_container(self, PgfEvalGates, fin);+ if (gates->cafs != NULL)+ gu_seq_free(gates->cafs);+}++PGF_INTERNAL PgfEvalGates*+pgf_jit_gates(PgfReader* rdr)+{+ PgfEvalGates* gates = gu_new(PgfEvalGates, rdr->opool);+ jit_insn *ref, *next, *ref2;++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_indirection = jit_get_ip().ptr;+ jit_ldxi_p(JIT_VCLOS, JIT_VCLOS, offsetof(PgfIndirection,val));+ jit_ldr_p(JIT_R0, JIT_VCLOS);+ jit_jmpr(JIT_R0);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_value = jit_get_ip().ptr;+ jit_movr_p(JIT_VHEAP, JIT_VCLOS);+ jit_ldxi_p(JIT_RET, JIT_VHEAP, offsetof(PgfValue, con));+ jit_bare_ret();++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_value_lit = jit_get_ip().ptr;+ jit_movr_p(JIT_VHEAP, JIT_VCLOS);+ jit_prepare(1);+ jit_ldxi_p(JIT_R0, JIT_VHEAP, offsetof(PgfValueLit, lit));+ jit_pusharg_p(JIT_R0);+ jit_finish(gu_variant_data);+ jit_bare_ret();++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_caf = jit_get_ip().ptr;+ jit_ldxi_i(JIT_R0, JIT_VCLOS, offsetof(PgfAbsFun, closure.caf_offset) - offsetof(PgfAbsFun, closure));+ jit_addr_p(JIT_VCLOS, JIT_VSTATE, JIT_R0);+ jit_ldr_p(JIT_R0, JIT_VCLOS);+ jit_jmpr(JIT_R0);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->enter = (void*) jit_get_ip().ptr;+ jit_prolog(2);+ int rs_arg = jit_arg_p();+ int closure_arg = jit_arg_p();+ jit_getarg_p(JIT_VSTATE, rs_arg);+ jit_getarg_p(JIT_VCLOS, closure_arg);+ jit_stxi_p(offsetof(PgfReasoner, enter_stack_ptr), JIT_VSTATE, JIT_SP);+ jit_ldr_p(JIT_R0, JIT_VCLOS);+ jit_pushr_i(JIT_R0); // this is just for stack alignment on System V+ jit_callr(JIT_R0);+ jit_popr_i(JIT_R0); // this is just for stack alignment on System V+ jit_movr_p(JIT_RET, JIT_VHEAP);+ jit_ret();++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_value_pap = jit_get_ip().ptr;+ jit_popr_p(JIT_VHEAP);+ jit_addi_p(JIT_R1, JIT_VCLOS, offsetof(PgfValuePAP,args));+ jit_ldxi_p(JIT_R2, JIT_VCLOS, offsetof(PgfValuePAP,n_args));+ jit_addr_p(JIT_R2, JIT_R2, JIT_R1);+ next = jit_get_label();+ ref = jit_bger_i(jit_forward(), JIT_R1, JIT_R2);+ jit_ldr_p(JIT_R0, JIT_R1);+ jit_pushr_p(JIT_R0);+ jit_addi_p(JIT_R1, JIT_R1, sizeof(PgfClosure*));+ jit_jmpi(next);+ jit_patch(ref);+ jit_pushr_p(JIT_VHEAP);+ jit_ldxi_p(JIT_VCLOS, JIT_VCLOS, offsetof(PgfValuePAP,fun));+ jit_ldr_p(JIT_R0, JIT_VCLOS);+ jit_jmpr(JIT_R0);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->update_closure = jit_get_ip().ptr;+ jit_popr_p(JIT_FP);+ jit_popr_p(JIT_VCLOS);+ jit_movi_p(JIT_R1, gates->evaluate_indirection);+ jit_str_p(JIT_VCLOS, JIT_R1);+ jit_stxi_p(offsetof(PgfIndirection, val), JIT_VCLOS, JIT_VHEAP);+ jit_bare_ret();++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW*4);++ gates->update_pap = jit_get_ip().ptr;+ jit_subi_p(JIT_R0, JIT_R0, sizeof(void*));+ jit_pushr_i(JIT_R0);+ jit_prepare(2);+ jit_addi_i(JIT_R0, JIT_R0, sizeof(PgfValuePAP));+ jit_pusharg_ui(JIT_R0);+ jit_ldxi_p(JIT_R0, JIT_VSTATE, offsetof(PgfReasoner,pool));+ jit_pusharg_p(JIT_R0);+ jit_finish(gu_malloc);+ jit_popr_i(JIT_R1);+ jit_movi_p(JIT_R2, gates->evaluate_value_pap);+ jit_str_p(JIT_RET, JIT_R2);+ jit_stxi_p(offsetof(PgfValuePAP,fun), JIT_RET, JIT_VCLOS);+ jit_stxi_p(offsetof(PgfValuePAP,n_args), JIT_RET, JIT_R1);+ jit_ldr_p(JIT_R2, JIT_SP);+ ref2 = jit_bnei_p(jit_forward(), JIT_R2, gates->update_closure);+ jit_ldxi_p(JIT_VHEAP, JIT_FP, sizeof(void*));+ jit_movi_p(JIT_R2, gates->evaluate_indirection);+ jit_str_p(JIT_VHEAP, JIT_R2);+ jit_stxi_p(offsetof(PgfIndirection, val), JIT_VHEAP, JIT_RET);+ jit_ldr_p(JIT_R2, JIT_FP);+ jit_pushr_p(JIT_R2);+ jit_ldxi_p(JIT_R2, JIT_FP, 2*sizeof(void*));+ jit_pushr_p(JIT_R2);+ next = jit_get_label();+ ref = jit_blei_i(jit_forward(), JIT_R1, 0);+ jit_ldxi_p(JIT_R2, JIT_FP, -sizeof(void*));+ jit_stxi_p(2*sizeof(void*), JIT_FP, JIT_R2);+ jit_stxi_p(offsetof(PgfValuePAP,args), JIT_RET, JIT_R2);+ jit_addi_i(JIT_RET, JIT_RET, sizeof(void*));+ jit_subi_i(JIT_FP, JIT_FP, sizeof(void*));+ jit_subi_i(JIT_R1, JIT_R1, sizeof(void*));+ jit_jmpi(next);+ jit_patch(ref);+ jit_popr_p(JIT_R0);+ jit_popr_p(JIT_FP);+ jit_addi_p(JIT_SP, JIT_SP, 4*sizeof(void*));+ jit_pushr_p(JIT_R0);+ jit_ldr_p(JIT_R0, JIT_VCLOS);+ jit_jmpr(JIT_R0);+ jit_patch(ref2);+ jit_movr_p(JIT_VHEAP, JIT_RET);+ jit_pushr_p(JIT_R1);+ next = jit_get_label();+ ref = jit_blei_i(jit_forward(), JIT_R1, 0);+ jit_ldxi_p(JIT_R2, JIT_FP, -sizeof(void*));+ jit_stxi_p(offsetof(PgfValuePAP,args), JIT_RET, JIT_R2);+ jit_addi_i(JIT_RET, JIT_RET, sizeof(void*));+ jit_subi_i(JIT_FP, JIT_FP, sizeof(void*));+ jit_subi_i(JIT_R1, JIT_R1, sizeof(void*));+ jit_jmpi(next);+ jit_patch(ref);+ jit_popr_p(JIT_R1);+ jit_popr_p(JIT_R0);+ jit_addr_p(JIT_SP, JIT_SP, JIT_R1);+ jit_jmpr(JIT_R0);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_expr_thunk = jit_get_ip().ptr;+ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_evaluate_expr_thunk);+ ref = jit_beqr_p(jit_forward(), JIT_VCLOS, JIT_RET);+ jit_pushr_p(JIT_VCLOS);+ jit_pushr_p(JIT_FP);+ jit_movr_p(JIT_FP, JIT_SP);+ jit_movi_p(JIT_R1, gates->update_closure);+ jit_pushr_p(JIT_R1);+ jit_retval_p(JIT_VCLOS);+ jit_patch(ref);+ jit_ldr_p(JIT_R0, JIT_VCLOS);+ jit_jmpr(JIT_R0);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_value_lambda = jit_get_ip().ptr;+ jit_subr_p(JIT_R0, JIT_FP, JIT_SP);+ jit_blti_i(gates->update_pap, JIT_R0, 2*sizeof(PgfClosure*));+ jit_popr_p(JIT_R2);+ jit_popr_p(JIT_R1);+ jit_pushr_p(JIT_R2);+ jit_prepare(3);+ jit_pusharg_p(JIT_R1);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_evaluate_lambda_application);+ jit_retval(JIT_VCLOS);+ jit_ldr_p(JIT_R0, JIT_VCLOS);+ jit_jmpr(JIT_R0);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW*2);++ gates->evaluate_value_const = jit_get_ip().ptr;+ jit_jmpi(gates->evaluate_value);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW*4);++ gates->mk_const = jit_get_ip().ptr;+ jit_popr_p(JIT_R0);+ ref2 = jit_bnei_p(jit_forward(), JIT_R0, gates->update_closure);+ jit_subr_p(JIT_R0, JIT_FP, JIT_SP);+ jit_pushr_i(JIT_R0);+ jit_prepare(2);+ jit_addi_i(JIT_R0, JIT_R0, sizeof(PgfValuePAP));+ jit_pusharg_ui(JIT_R0);+ jit_ldxi_p(JIT_R0, JIT_VSTATE, offsetof(PgfReasoner,pool));+ jit_pusharg_p(JIT_R0);+ jit_finish(gu_malloc);+ jit_popr_i(JIT_R1);+ jit_movi_p(JIT_R2, gates->evaluate_value_const);+ jit_str_p(JIT_RET, JIT_R2);+ jit_stxi_p(offsetof(PgfValuePAP,fun), JIT_RET, JIT_VCLOS);+ jit_stxi_p(offsetof(PgfValuePAP,n_args), JIT_RET, JIT_R1);+ jit_ldxi_p(JIT_VHEAP, JIT_FP, sizeof(void*));+ jit_movi_p(JIT_R2, gates->evaluate_indirection);+ jit_str_p(JIT_VHEAP, JIT_R2);+ jit_stxi_p(offsetof(PgfIndirection, val), JIT_VHEAP, JIT_RET);+ jit_ldr_p(JIT_R2, JIT_FP);+ jit_pushr_p(JIT_R2);+ jit_ldxi_p(JIT_R2, JIT_FP, 2*sizeof(void*));+ jit_pushr_p(JIT_R2);+ jit_addi_p(JIT_RET, JIT_RET, offsetof(PgfValuePAP,args)-sizeof(PgfClosure*));+ next = jit_get_label();+ ref = jit_blei_i(jit_forward(), JIT_R1, 0);+ jit_ldxi_p(JIT_R2, JIT_FP, -sizeof(void*));+ jit_stxi_p(2*sizeof(void*), JIT_FP, JIT_R2);+ jit_stxr_p(JIT_R1, JIT_RET, JIT_R2);+ jit_subi_i(JIT_FP, JIT_FP, sizeof(void*));+ jit_subi_i(JIT_R1, JIT_R1, sizeof(void*));+ jit_jmpi(next);+ jit_patch(ref);+ jit_popr_p(JIT_R0);+ jit_popr_p(JIT_FP);+ jit_addi_p(JIT_SP, JIT_SP, 3*sizeof(void*));+ jit_pushr_p(JIT_R0);+ jit_jmpi(gates->mk_const);+ jit_patch(ref2);+ jit_ldxi_p(JIT_R1, JIT_VSTATE, offsetof(PgfReasoner,enter_stack_ptr));+ ref2 = jit_bner_p(jit_forward(), JIT_FP, JIT_R1);+ jit_stxi_p(offsetof(PgfReasoner,tmp), JIT_VSTATE, JIT_R0);+ jit_subr_p(JIT_R0, JIT_FP, JIT_SP);+ jit_pushr_i(JIT_R0);+ jit_prepare(2);+ jit_addi_i(JIT_R0, JIT_R0, sizeof(PgfValuePAP));+ jit_pusharg_ui(JIT_R0);+ jit_ldxi_p(JIT_R0, JIT_VSTATE, offsetof(PgfReasoner,pool));+ jit_pusharg_p(JIT_R0);+ jit_finish(gu_malloc);+ jit_movr_p(JIT_VHEAP, JIT_RET);+ jit_popr_i(JIT_R1);+ jit_movi_p(JIT_R2, gates->evaluate_value_const);+ jit_str_p(JIT_VHEAP, JIT_R2);+ jit_stxi_p(offsetof(PgfValuePAP,fun), JIT_VHEAP, JIT_VCLOS);+ jit_stxi_p(offsetof(PgfValuePAP,n_args), JIT_VHEAP, JIT_R1);+ next = jit_get_label();+ ref = jit_blei_i(jit_forward(), JIT_R1, 0);+ jit_popr_p(JIT_R2);+ jit_stxi_p(offsetof(PgfValuePAP,args), JIT_RET, JIT_R2);+ jit_addi_p(JIT_RET, JIT_RET, sizeof(void*));+ jit_subi_i(JIT_R1, JIT_R1, sizeof(void*));+ jit_jmpi(next);+ jit_patch(ref);+ jit_ldxi_p(JIT_R0, JIT_VSTATE, offsetof(PgfReasoner,tmp));+ jit_jmpr(JIT_R0);+ jit_patch(ref2);+ jit_ldxi_p(JIT_VCLOS, JIT_FP, sizeof(void*));+ jit_ldr_p(JIT_FP, JIT_FP);+ jit_ldxi_i(JIT_R0, JIT_VCLOS, offsetof(PgfAbsFun,arity)-offsetof(PgfAbsFun,closure));+ jit_muli_i(JIT_R0, JIT_R0, sizeof(PgfClosure*));+ jit_addi_i(JIT_R0, JIT_R0, sizeof(void*));+ jit_subr_p(JIT_R0, JIT_FP, JIT_R0); // don't use jit_subr_p(JIT_SP, JIT_FP, JIT_R0) since it is dangerous on x86+ jit_movr_p(JIT_SP, JIT_R0);+ jit_jmpi(gates->mk_const);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_gen = jit_get_ip().ptr;+ jit_jmpi(gates->mk_const);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_meta = jit_get_ip().ptr;+ jit_jmpi(gates->mk_const);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->evaluate_sum = jit_get_ip().ptr;+ jit_jmpi(gates->mk_const);++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->combine1 = (void*) jit_get_ip().ptr;+ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_combine1);+ jit_bare_ret();++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->combine2 = (void*) jit_get_ip().ptr;+ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_combine2);+ jit_bare_ret();++ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);++ gates->complete = (void*) jit_get_ip().ptr;+ jit_prepare(2);+ jit_pusharg_p(JIT_VCLOS);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_reasoner_complete);+ jit_ret();++ gates->fin.fn = pgf_jit_finalize_cafs;+ gates->cafs = NULL;+ gu_pool_finally(rdr->opool, &gates->fin);++ return gates;+}++#define PGF_CAFS_DELTA 20++PGF_INTERNAL void+pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,+ PgfAbsFun* absfun)+{+#ifdef PGF_JIT_DEBUG+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ + gu_string_write(absfun->name, out, err);+ gu_puts(":\n", out, err);+#endif++ size_t n_segments = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ gu_buf_flush(rdr->jit_state->segment_patches);++ absfun->closure.code = abstr->eval_gates->mk_const;++ for (size_t segment = 0; segment < n_segments; segment++) {+ size_t n_instrs = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ pgf_jit_make_space(rdr, (JIT_CODE_WINDOW/4)*n_instrs);++ if (segment == 0) {+ if (absfun->arity == 0) {+ // we add a new CAF+ if (rdr->jit_state->n_cafs % PGF_CAFS_DELTA == 0) {+ abstr->eval_gates->cafs =+ gu_realloc_seq(abstr->eval_gates->cafs,+ PgfFunction,+ rdr->jit_state->n_cafs + PGF_CAFS_DELTA);+ }+ absfun->closure.code = abstr->eval_gates->evaluate_caf;+ size_t caf_id = rdr->jit_state->n_cafs++;+ absfun->closure.caf_offset = + offsetof(PgfReasoner,cafs)++ caf_id*sizeof(PgfIndirection);+ gu_seq_set(abstr->eval_gates->cafs,+ PgfFunction,+ caf_id,+ jit_get_ip().ptr);+ } else {+ absfun->closure.code = jit_get_ip().ptr;+ }+ }++ size_t curr_offset = 0;++ size_t n_patches = gu_buf_length(rdr->jit_state->segment_patches);+ for (size_t i = 0; i < n_patches; i++) {+ PgfSegmentPatch* patch = + gu_buf_index(rdr->jit_state->segment_patches, PgfSegmentPatch, i);+ if (patch->segment == segment) {+ if (patch->is_abs) {+ jit_patch_movi(patch->ref,jit_get_ip().ptr);+ } else {+ jit_patch(patch->ref);+ }+ }+ }++#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "%03d ", segment);+#endif++ for (size_t label = 0; label < n_instrs; label++) {+#ifdef PGF_JIT_DEBUG+ if (label > 0)+ gu_printf(out, err, " ");+#endif++ uint8_t tag = pgf_read_tag(rdr);+ uint8_t opcode = tag >> 2;+ uint8_t mod = tag & 0x03;+ switch (opcode) {+ case PGF_INSTR_CHECK_ARGS: {+ int n = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "CHECK_ARGS %d\n", n);+#endif+ jit_subr_p(JIT_R0, JIT_FP, JIT_SP);+ jit_blti_i(abstr->eval_gates->update_pap, JIT_R0, (n+1)*sizeof(PgfClosure*));+ break;+ }+ case PGF_INSTR_CASE: {+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);+ int target = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "CASE %s %03d\n", id, target);+#endif+ jit_insn *ref1 =+ jit_movi_p(JIT_R1, jit_forward());+ PgfCallPatch call_patch;+ call_patch.cid = id;+ call_patch.ref = ref1;+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, call_patch);++ jit_insn *ref2 =+ jit_bner_p(jit_forward(), JIT_RET, JIT_R1);+ PgfSegmentPatch label_patch;+ label_patch.segment = target;+ label_patch.ref = ref2;+ label_patch.is_abs = false;+ gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, label_patch);+ break;+ }+ case PGF_INSTR_CASE_LIT: {+ int target = 0;+ jit_insn *jump = 0;++ switch (mod) {+ case 0: {+ int n = pgf_read_int(rdr);+ target = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "CASE_LIT %d %03d\n", n, target);+#endif+ jit_ldxi_p(JIT_R1, JIT_RET, offsetof(PgfLiteralInt,val));+ jump =+ jit_bnei_i(jit_forward(), JIT_R1, n);+ break;+ }+ case 1: {+ GuString s = pgf_read_string(rdr);+ target = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "CASE_LIT %s %03d\n", s, target);+#endif+ jit_pushr_p(JIT_RET);+ jit_prepare(2);+ jit_pusharg_p(JIT_RET);+ jit_movi_p(JIT_R0, s);+ jit_pusharg_p(JIT_R0);+ jit_finish(strcmp);+ jit_retval(JIT_R1);+ jit_popr_p(JIT_RET);+ jump =+ jit_bnei_i(jit_forward(), JIT_R1, 0);+ break;+ }+ case 2: {+ double d = pgf_read_double(rdr);+ target = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "CASE_LIT %f %03d\n", d, target);+#endif+ jit_ldxi_d(JIT_FPR0, JIT_RET, offsetof(PgfLiteralFlt,val));+ jit_movi_d(JIT_FPR1, d);+ jump =+ jit_bner_d(jit_forward(), JIT_FPR0, JIT_FPR1);+ break;+ }+ default:+ gu_impossible();+ }++ PgfSegmentPatch label_patch;+ label_patch.segment = target;+ label_patch.ref = jump;+ label_patch.is_abs = false;+ gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, label_patch);++ break;+ }+ case PGF_INSTR_SAVE: {+ int i = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "SAVE %d\n", i);+#endif+ jit_ldxi_p(JIT_R0, JIT_VHEAP, sizeof(PgfValue)+sizeof(PgfClosure*)*i);+ jit_pushr_p(JIT_R0);+ break;+ }+ case PGF_INSTR_ALLOC: {+ size_t size = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "ALLOC %d\n", size);+#endif+ jit_prepare(2);+ jit_movi_ui(JIT_R0, size*sizeof(void*));+ jit_pusharg_ui(JIT_R0);+ jit_ldxi_p(JIT_R0, JIT_VSTATE, offsetof(PgfReasoner,pool));+ jit_pusharg_p(JIT_R0);+ jit_finish(gu_malloc);+ jit_retval_p(JIT_VHEAP);++ curr_offset = 0;+ break;+ }+ case PGF_INSTR_PUT_CONSTR: {+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUT_CONSTR %s\n", id);+#endif++ jit_movi_p(JIT_R0, abstr->eval_gates->evaluate_value);+ jit_stxi_p(curr_offset*sizeof(void*), JIT_VHEAP, JIT_R0);+ curr_offset++;+ + PgfCallPatch patch;+ patch.cid = id;+ patch.ref = jit_movi_p(JIT_R0, jit_forward());+ jit_stxi_p(curr_offset*sizeof(void*), JIT_VHEAP, JIT_R0);+ curr_offset++;++ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);+ break;+ }+ case PGF_INSTR_PUT_CLOSURE: {+ size_t target = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUT_CLOSURE %03d\n", target);+#endif++ PgfSegmentPatch patch;+ patch.segment = target;+ patch.ref = jit_movi_p(JIT_R0, jit_forward());+ patch.is_abs = true;+ jit_stxi_p(curr_offset*sizeof(void*), JIT_VHEAP, JIT_R0);+ curr_offset++;++ gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, patch);+ break;+ }+ case PGF_INSTR_PUT_LIT: {+ jit_movi_p(JIT_R0, abstr->eval_gates->evaluate_value_lit);+ jit_stxi_p(curr_offset*sizeof(void*), JIT_VHEAP, JIT_R0);+ curr_offset++;++ PgfLiteral lit = gu_null_variant;+ switch (mod) {+ case 0: {+ PgfLiteralInt *lit_int =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &lit,+ rdr->opool);+ lit_int->val = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUT_LIT %d\n", lit_int->val);+#endif+ break;+ }+ case 1: {+ size_t len = pgf_read_len(rdr);+ uint8_t* buf = alloca(len*6+1);+ uint8_t* p = buf;+ for (size_t i = 0; i < len; i++) {+ gu_in_utf8_buf(&p, rdr->in, rdr->err);+ }+ *p++ = 0;++ PgfLiteralStr *lit_str =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, p-buf,+ &lit, rdr->opool);+ strcpy((char*) lit_str->val, (char*) buf);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUT_LIT \"%s\"\n", lit_str->val);+#endif+ break;+ }+ case 2: {+ PgfLiteralFlt *lit_flt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &lit,+ rdr->opool);+ lit_flt->val = pgf_read_double(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUT_LIT %f\n", lit_flt->val);+#endif+ break;+ }+ default:+ gu_impossible();+ }++ jit_movi_p(JIT_R0, lit);+ jit_stxi_p(curr_offset*sizeof(void*), JIT_VHEAP, JIT_R0);+ curr_offset++;+ break;+ }+ case PGF_INSTR_SET: {+ switch (mod) {+ case 0: {+ size_t offset = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "SET hp(%d)\n", offset);+#endif+ jit_addi_p(JIT_R0, JIT_VHEAP, offset*sizeof(void*));+ break;+ }+ case 1: {+ size_t index = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "SET stk(%d)\n", index);+#endif+ jit_ldxi_p(JIT_R0, JIT_SP, index*sizeof(PgfClosure*));+ break;+ }+ case 2: {+ size_t index = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "SET env(%d)\n", index);+#endif+ jit_ldxi_p(JIT_R0, JIT_VCLOS, sizeof(PgfClosure)+index*sizeof(PgfClosure*));+ break;+ }+ case 3: {+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "SET %s\n", id);+#endif+ PgfCallPatch patch;+ patch.cid = id;+ patch.ref = jit_movi_p(JIT_R0, jit_forward());+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);+ break;+ }+ default:+ gu_impossible();+ }+ + jit_stxi_p(curr_offset*sizeof(void*), JIT_VHEAP, JIT_R0);+ curr_offset++;+ break;+ }+ case PGF_INSTR_SET_PAD: {+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "SET_PAD\n");+#endif+ jit_movi_p(JIT_R0, NULL);+ jit_stxi_p(curr_offset*sizeof(void*), JIT_VHEAP, JIT_R0);+ curr_offset++;+ break;+ }+ case PGF_INSTR_PUSH_FRAME: {+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH_FRAME\n");+#endif+ jit_pushr_p(JIT_VCLOS);+ jit_pushr_p(JIT_FP);+ jit_movr_p(JIT_FP, JIT_SP);+ break;+ }+ case PGF_INSTR_PUSH: {+ switch (mod) {+ case 0: {+ size_t offset = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH hp(%d)\n", offset);+#endif++ if (offset == 0) {+ jit_pushr_p(JIT_VHEAP);+ } else {+ jit_addi_p(JIT_R0, JIT_VHEAP, offset*sizeof(void*));+ jit_pushr_p(JIT_R0);+ }+ break;+ }+ case 1: {+ size_t index = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH stk(%d)\n", index);+#endif+ jit_ldxi_p(JIT_R0, JIT_SP, index*sizeof(PgfClosure*));+ jit_pushr_p(JIT_R0);+ break;+ }+ case 2: {+ size_t index = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH env(%d)\n", index);+#endif+ jit_ldxi_p(JIT_R0, JIT_VCLOS, sizeof(PgfClosure)+index*sizeof(PgfClosure*));+ jit_pushr_p(JIT_R0);+ break;+ }+ case 3: {+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH %s\n", id);+#endif+ PgfCallPatch patch;+ patch.cid = id;+ patch.ref = jit_movi_p(JIT_R0, jit_forward());+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);+ jit_pushr_p(JIT_R0);+ break;+ }+ default:+ gu_impossible();+ }+ break;+ }+ case PGF_INSTR_TUCK: {+ switch (mod) {+ case 0: {+ size_t offset = pgf_read_int(rdr);+ size_t sindex = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "TUCK hp(%d) %d\n", offset, sindex);+#endif++ if (offset == 0) {+ jit_stxi_p(sizeof(PgfClosure*)*sindex, JIT_SP, JIT_VHEAP);+ } else {+ jit_addi_p(JIT_R0, JIT_VHEAP, offset*sizeof(void*));+ jit_stxi_p(sizeof(PgfClosure*)*sindex, JIT_SP, JIT_R0);+ }+ break;+ }+ case 1: {+ size_t index = pgf_read_int(rdr);+ size_t sindex = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "TUCK stk(%d) %d\n", index, sindex);+#endif+ jit_ldxi_p(JIT_R0, JIT_SP, index*sizeof(PgfClosure*));+ jit_stxi_p(sizeof(PgfClosure*)*sindex, JIT_SP, JIT_R0);+ break;+ }+ case 2: {+ size_t index = pgf_read_int(rdr);+ size_t sindex = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "TUCK env(%d) %d\n", index, sindex);+#endif+ jit_ldxi_p(JIT_R0, JIT_VCLOS, sizeof(PgfClosure)+index*sizeof(PgfClosure*));+ jit_stxi_p(sizeof(PgfClosure*)*sindex, JIT_SP, JIT_R0);+ break;+ }+ case 3: {+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);+ size_t sindex = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "TUCK %s %d\n", id, sindex);+#endif+ PgfCallPatch patch;+ patch.cid = id;+ patch.ref = jit_movi_p(JIT_R0, jit_forward());+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);+ jit_stxi_p(sizeof(PgfClosure*)*sindex, JIT_SP, JIT_R0);+ break;+ }+ default:+ gu_impossible();+ }+ break;+ }+ case PGF_INSTR_EVAL+0:+ case PGF_INSTR_EVAL+2:+ case PGF_INSTR_EVAL+1: {+ switch (mod) {+ case 0: {+ size_t offset = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "EVAL hp(%d)", offset);+#endif+ jit_addi_p(JIT_VCLOS, JIT_VHEAP, offset*sizeof(void*));+ break;+ }+ case 1: {+ size_t index = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "EVAL stk(%d)", index);+#endif+ jit_ldxi_p(JIT_VCLOS, JIT_SP, index*sizeof(PgfClosure*));+ break;+ }+ case 2: {+ size_t index = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "EVAL env(%d)", index);+#endif+ jit_ldxi_p(JIT_VCLOS, JIT_VCLOS, sizeof(PgfClosure)+index*sizeof(PgfClosure*));+ break;+ }+ case 3: {+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "EVAL %s", id);+#endif+ PgfCallPatch patch;+ patch.cid = id;+ patch.ref = jit_movi_p(JIT_VCLOS, jit_forward());+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);+ break;+ }+ default:+ gu_impossible();+ }++ jit_ldr_p(JIT_R0, JIT_VCLOS);++ switch (opcode - PGF_INSTR_EVAL) {+ case 0: {+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "\n");+#endif+ jit_callr(JIT_R0);+ jit_popr_p(JIT_FP);+ jit_popr_p(JIT_VCLOS);+ break;+ }+ case 1: {+ size_t a = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, " tail(%d)\n", a);+#endif+ jit_addi_p(JIT_SP, JIT_SP, a*sizeof(PgfClosure*));+ jit_jmpr(JIT_R0);+ break;+ }+ case 2: {+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, " update\n");+#endif++ jit_movi_p(JIT_R1, abstr->eval_gates->update_closure);+ jit_pushr_p(JIT_R1);+ jit_jmpr(JIT_R0);+ break;+ }+ default:+ gu_impossible();+ }+ break;+ }+ case PGF_INSTR_DROP: {+ size_t n = pgf_read_int(rdr);++#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "DROP %d\n", n);+#endif++ jit_addi_p(JIT_SP, JIT_SP, n*sizeof(PgfClosure*));+ break;+ }+ case PGF_INSTR_JUMP: {+ size_t target = pgf_read_int(rdr);++#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "JUMP %03d\n", target);+#endif++ jit_insn *jump =+ jit_jmpi(jit_forward());++ PgfSegmentPatch label_patch;+ label_patch.segment = target;+ label_patch.ref = jump;+ label_patch.is_abs = false;+ gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, label_patch);+ break;+ }+ case PGF_INSTR_FAIL:+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "FAIL\n");+#endif+ jit_jmpi(abstr->eval_gates->mk_const);+ break;+ case PGF_INSTR_PUSH_ACCUM:+ jit_subi_p(JIT_SP, JIT_SP, sizeof(PgfEvalAccum));++ switch (mod) {+ case 0: {+ int val = pgf_read_int(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH_ACCUM %d\n", val);+#endif+ jit_prepare(3);+ jit_movi_i(JIT_R0, val);+ jit_movr_p(JIT_R1, JIT_SP);+ jit_pusharg_p(JIT_R0);+ jit_pusharg_p(JIT_R1);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_evaluate_accum_init_int);+ break;+ }+ case 1: {+ size_t len = pgf_read_len(rdr);+ uint8_t* buf = alloca(len*6+1);+ uint8_t* p = buf;+ for (size_t i = 0; i < len; i++) {+ gu_in_utf8_buf(&p, rdr->in, rdr->err);+ }+ *p++ = 0;++ GuString val = + *buf ? gu_string_copy((GuString) buf, rdr->opool)+ : NULL;+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH_ACCUM \"%s\"\n", buf);+#endif+ jit_prepare(3);+ jit_movi_p(JIT_R0, val);+ jit_movr_p(JIT_R1, JIT_SP);+ jit_pusharg_p(JIT_R0);+ jit_pusharg_p(JIT_R1);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_evaluate_accum_init_str);+ break;+ }+ case 2: {+ double val = pgf_read_double(rdr);+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "PUSH_ACCUM %f\n", val);+#endif+ jit_prepare_d(1);+ jit_prepare_i(2);+ jit_movi_d(JIT_FPR0, val);+ jit_movr_p(JIT_R1, JIT_SP);+ jit_pusharg_d(JIT_FPR0);+ jit_pusharg_p(JIT_R1);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_evaluate_accum_init_flt);+ break;+ }+ default:+ gu_impossible();+ }+ break;+ case PGF_INSTR_POP_ACCUM:+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "POP_ACCUM\n");+#endif+ jit_prepare(2);+ jit_pusharg_p(JIT_SP);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_evaluate_accum_done);+ jit_addi_p(JIT_SP, JIT_SP, sizeof(PgfEvalAccum));+ jit_pushr_p(JIT_RET);+ break;+ case PGF_INSTR_ADD:+#ifdef PGF_JIT_DEBUG+ gu_printf(out, err, "ADD\n");+#endif+ jit_prepare(3);+ jit_movr_p(JIT_R1, JIT_SP);+ jit_pusharg_p(JIT_VHEAP);+ jit_pusharg_p(JIT_R1);+ jit_pusharg_p(JIT_VSTATE);+ jit_finish(pgf_evaluate_accum_add);+ break;+ default:+ gu_impossible();+ }+ }+ }+}++PGF_INTERNAL void+pgf_jit_done(PgfReader* rdr, PgfAbstr* abstr)+{+ size_t n_patches = gu_buf_length(rdr->jit_state->call_patches);+ for (size_t i = 0; i < n_patches; i++) {+ PgfCallPatch* patch =+ gu_buf_index(rdr->jit_state->call_patches, PgfCallPatch, i);++ PgfAbsCat* arg =+ gu_seq_binsearch(abstr->cats, pgf_abscat_order, PgfAbsCat, patch->cid);+ if (arg != NULL) {+ jit_patch_at(patch->ref,(jit_insn*) arg->predicate);+ } else {+ PgfAbsFun* fun =+ gu_seq_binsearch(abstr->funs, pgf_absfun_order, PgfAbsFun, patch->cid);+ if (fun == NULL)+ gu_impossible();+ else {+ jit_patch_movi(patch->ref,&fun->closure);+ }+ }+ }+ + jit_flush_code(rdr->jit_state->buf, jit_get_ip().ptr);+}
@@ -0,0 +1,62 @@+/******************************** -*- C -*- ****************************+ *+ * lightning main include file+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_h+#define __lightning_h++#ifdef __cplusplus+extern "C" {+#endif++#include "lightning/asm-common.h"++#ifndef LIGHTNING_DEBUG+#include "lightning/asm.h"+#endif++#include "lightning/core.h"+#include "lightning/core-common.h"+#include "lightning/funcs.h"+#include "lightning/funcs-common.h"+#include "lightning/fp.h"+#include "lightning/fp-common.h"++#ifndef JIT_R0+#error GNU lightning does not support the current target+#endif++#ifdef __cplusplus+}+#endif++#endif /* __lightning_h */
@@ -0,0 +1,1801 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler for the arm+ *+ ***********************************************************************/++/***********************************************************************+ *+ * Copyright 2011 Free Software Foundation+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ * Authors:+ * Paulo Cesar Pereira de Andrade+ ***********************************************************************/++#ifndef __lightning_asm_h+#define __lightning_asm_h++typedef enum {+ _R0, /* argument / result */+ _R1, /* argument */+ _R2, /* argument */+ _R3, /* argument */+ _R4, /* variable */+ _R5, /* variable */+ _R6, /* variable */+ _R7, /* variable */+ _R8, /* variable */+ _R9, /* variable */+ _R10, /* sl - stack limit */+ _R11, /* fp - frame pointer */+ _R12, /* ip - temporary */+ _R13, /* sp - stack pointer */+ _R14, /* lr - link register */+ _R15, /* pc - program counter */+} jit_gpr_t;++#define JIT_RET _R0+#define JIT_PC _R15+#define JIT_LR _R14+#define JIT_SP _R13+#define JIT_FP _R11+#define JIT_TMP _R8+#define JIT_FTMP _R9++/* must use blx to call functions or jit instruction set matches runtime? */+#define jit_exchange_p() 1++/* _VxxxQ macros mean _Q0=_D0, _Q1=_D2, ... */+typedef enum {+ _S0, _D0 = _S0, _Q0 = _D0,+ _S1,+ _S2, _D1 = _S2,+ _S3,+ _S4, _D2 = _S4, _Q1 = _D2,+ _S5,+ _S6, _D3 = _S6,+ _S7,+ _S8, _D4 = _S8, _Q2 = _D4,+ _S9,+ _S10, _D5 = _S10,+ _S11,+ _S12, _D6 = _S12, _Q3 = _D6,+ _S13,+ _S14, _D7 = _S14,+ _S15,+ _S16, _D8 = _S16, _Q4 = _D8,+ _S17,+ _S18, _D9 = _S18,+ _S19,+ _S20, _D10 = _S20, _Q5 = _D10,+ _S21,+ _S22, _D11 = _S22,+ _S23,+ _S24, _D12 = _S24, _Q6 = _D12,+ _S25,+ _S26, _D13 = _S26,+ _S27,+ _S28, _D14 = _S28, _Q7 = _D14,+ _S29,+ _S30, _D15 = _S30,+ _S31,+ JIT_FPRET, /* for abstraction of returning a float/double result */+} jit_fpr_t;++/* match vfpv3 result */+#define NAN_TO_INT_IS_ZERO 1++#define jit_armv6_p() (jit_cpu.version >= 6)+typedef union _jit_thumb_t {+ int i;+ short s[2];+} jit_thumb_t;++#if __BYTE_ORDER == __LITTLE_ENDIAN+# define _jit_WW(i, j) (_jit_W(j), _jit_W(i))+# define code2thumb(t0, t1, c0, c1) (t1 = c0, t0 = c1)+# define thumb2code(t0, t1, c0, c1) (c0 = t1, c1 = t0)+#else+# define _jit_WW(i, j) (_jit_W(i), _jit_W(j))+# define code2thumb(t0, t1, c0, c1) (t0 = c0, t1 = c1)+# define thumb2code(t0, t1, c0, c1) (c0 = t0, c1 = t1)+#endif++#define ARM_CC_EQ 0x00000000 /* Z=1 */+#define ARM_CC_NE 0x10000000 /* Z=0 */+#define ARM_CC_HS 0x20000000 /* C=1 */+# define ARM_CC_CS ARM_CC_HS+#define ARM_CC_LO 0x30000000 /* C=0 */+# define ARM_CC_CC ARM_CC_LO+#define ARM_CC_MI 0x40000000 /* N=1 */+#define ARM_CC_PL 0x50000000 /* N=0 */+#define ARM_CC_VS 0x60000000 /* V=1 */+#define ARM_CC_VC 0x70000000 /* V=0 */+#define ARM_CC_HI 0x80000000 /* C=1 && Z=0 */+#define ARM_CC_LS 0x90000000 /* C=0 || Z=1 */+#define ARM_CC_GE 0xa0000000 /* N=V */+#define ARM_CC_LT 0xb0000000 /* N!=V */+#define ARM_CC_GT 0xc0000000 /* Z=0 && N=V */+#define ARM_CC_LE 0xd0000000 /* Z=1 || N!=V */+#define ARM_CC_AL 0xe0000000 /* always */+#define ARM_CC_NV 0xf0000000 /* reserved */++#define ARM_MOV 0x01a00000+#define THUMB_MOV 0x4600+#define ARM_MOVWI 0x03000000+#define THUMB_MOVI 0x2000+#define THUMB2_MOVI 0xf0400000+#define THUMB2_MOVWI 0xf2400000+#define ARM_MOVTI 0x03400000+#define THUMB2_MOVTI 0xf2c00000+#define ARM_MVN 0x01e00000+#define THUMB_MVN 0x43c0+#define THUMB2_MVN 0xea600000+#define THUMB2_MVNI 0xf0600000+#define ARM_MRC 0x0e100010+#define ARM_MRRC 0x0c500000+#define ARM_MRS 0x010f0000+#define ARM_MSRI 0x03200000+#define ARM_MSR 0x0120f000++#define ARM_I 0x02000000 /* immediate */+#define ARM_S 0x00100000 /* set flags */+#define ARM_ADD 0x00800000+#define THUMB_ADD 0x1800+#define THUMB_ADDX 0x4400+#define THUMB2_ADD 0xeb000000+#define THUMB_ADDI3 0x1c00+#define THUMB_ADDI8 0x3000+#define THUMB2_ADDI 0xf1000000+#define THUMB2_ADDWI 0xf2000000+#define ARM_ADC 0x00a00000+#define THUMB_ADC 0x4140+#define THUMB2_ADC 0xeb400000+#define THUMB2_ADCI 0xf1400000+#define ARM_SUB 0x00400000+#define THUMB_SUB 0x1a00+#define THUMB2_SUB 0xeba00000+#define THUMB_SUBI3 0x1e00+#define THUMB_SUBI8 0x3800+#define THUMB2_SUBI 0xf1a00000+#define THUMB2_SUBWI 0xf2a00000+#define ARM_SBC 0x00c00000+#define THUMB_SBC 0x4180+#define THUMB2_SBC 0xeb600000+#define THUMB2_SBCI 0xf1600000+#define ARM_RSB 0x00600000+#define THUMB2_RSB 0xebc00000+#define THUMB_RSBI 0x4240+#define THUMB2_RSBI 0xf1c00000+#define ARM_MUL 0x00000090+#define THUMB_MUL 0x4340+#define THUMB2_MUL 0xfb00f000+#define ARM_SMULL 0x00c00090+#define THUMB2_SMULL 0xfb800000+#define ARM_UMULL 0x00800090+#define THUMB2_UMULL 0xfba00000+#define THUMB2_SDIV 0xfb90f0f0+#define THUMB2_UDIV 0xfbb0f0f0++#define ARM_AND 0x00000000+#define THUMB_AND 0x4000+#define THUMB2_AND 0xea000000+#define THUMB2_ANDI 0xf0000000+#define ARM_BIC 0x01c00000+#define THUMB2_BIC 0xea200000+#define THUMB2_BICI 0xf0200000+#define ARM_ORR 0x01800000+#define THUMB_ORR 0x4300+#define THUMB2_ORR 0xea400000+#define THUMB2_ORRI 0xf0400000+#define ARM_EOR 0x00200000+#define THUMB_EOR 0x4040+#define THUMB2_EOR 0xea800000+#define THUMB2_EORI 0xf0800000+#define ARM_REV 0x06bf0f30+#define THUMB_REV 0xba00+#define THUMB2_REV 0xfa90f080+#define ARM_REV16 0x06bf0fb0+#define THUMB_REV16 0xba40+#define THUMB2_REV16 0xfa90f090+#define ARM_SXTB 0x06af0070+#define THUMB_SXTB 0xb240+#define THUMB2_SXTB 0xfa4f0080+#define ARM_UXTB 0x06ef0070+#define THUMB_UXTB 0xb2c0+#define THUMB2_UXTB 0xfa5f0080+#define ARM_SXTH 0x06bf0070+#define THUMB_SXTH 0xb200+#define THUMB2_SXTH 0xfa0f0080+#define ARM_UXTH 0x06ff0070+#define THUMB_UXTH 0xb280+#define THUMB2_UXTH 0xfa1f0080+#define ARM_XTR8 0x00000400 /* ?xt? rotate 8 bits */+#define ARM_XTR16 0x00000800 /* ?xt? rotate 16 bits */+#define ARM_XTR24 0x00000c00 /* ?xt? rotate 24 bits */++#define ARM_SHIFT 0x01a00000+#define ARM_R 0x00000010 /* register shift */+#define ARM_LSL 0x00000000+#define THUMB_LSL 0x4080+#define THUMB2_LSL 0xfa00f000+#define THUMB_LSLI 0x0000+#define THUMB2_LSLI 0xea4f0000+#define ARM_LSR 0x00000020+#define THUMB_LSR 0x40c0+#define THUMB2_LSR 0xfa20f000+#define THUMB_LSRI 0x0800+#define THUMB2_LSRI 0xea4f0010+#define ARM_ASR 0x00000040+#define THUMB_ASR 0x4100+#define THUMB2_ASR 0xfa40f000+#define THUMB_ASRI 0x1000+#define THUMB2_ASRI 0xea4f0020+#define ARM_ROR 0x00000060+#define ARM_PKH 0x06800010 /* v6T2,v7 */++#define ARM_CMP 0x01500000+#define THUMB_CMP 0x4280+#define THUMB_CMPX 0x4500+#define THUMB2_CMP 0xebb00000+#define THUMB_CMPI 0x2800+#define THUMB2_CMPI 0xf1b00000+#define ARM_CMN 0x01700000+#define THUMB_CMN 0x42c0+#define THUMB2_CMN 0xeb100000+#define THUMB2_CMNI 0xf1100000+#define ARM_TST 0x01100000+#define THUMB_TST 0x4200+#define THUMB2_TST 0xea100000+#define THUMB2_TSTI 0xf0100000+#define ARM_TEQ 0x01300000++/* branch */+#define ARM_BX 0x012fff10+#define ARM_BLX 0x012fff30+#define THUMB_BLX 0x4780+#define ARM_BLXI 0xfa000000+#define THUMB2_BLXI 0xf000c000+#define ARM_B 0x0a000000+#define THUMB_CC_B 0xd000+#define THUMB_B 0xe000+#define THUMB2_CC_B 0xf0008000+#define THUMB2_B 0xf0009000+#define ARM_BLI 0x0b000000+#define THUMB2_BLI 0xf000d000++/* ldr/str */+#define ARM_P 0x00800000 /* positive offset+ * actually, the errata manual+ * calls this to U field and+ * 1<<24 the P field */+#define THUMB2_P 0x00000400+#define THUMB2_U 0x00000200+#define THUMB2_W 0x00000100+#define ARM_LDRSB 0x011000d0+#define THUMB_LDRSB 0x5600+#define THUMB2_LDRSB 0xf9100000+#define ARM_LDRSBI 0x015000d0+#define THUMB2_LDRSBI 0xf9100c00+#define THUMB2_LDRSBWI 0xf9900000+#define ARM_LDRB 0x07500000+#define THUMB_LDRB 0x5c00+#define THUMB2_LDRB 0xf8100000+#define ARM_LDRBI 0x05500000+#define THUMB_LDRBI 0x7800+#define THUMB2_LDRBI 0xf8100c00+#define THUMB2_LDRBWI 0xf8900000+#define ARM_LDRSH 0x011000f0+#define THUMB_LDRSH 0x5e00+#define THUMB2_LDRSH 0xf9300000+#define ARM_LDRSHI 0x015000f0+#define THUMB2_LDRSHI 0xf9300c00+#define THUMB2_LDRSHWI 0xf9b00000+#define ARM_LDRH 0x011000b0+#define THUMB_LDRH 0x5a00+#define THUMB2_LDRH 0xf8300000+#define ARM_LDRHI 0x015000b0+#define THUMB_LDRHI 0x8800+#define THUMB2_LDRHI 0xf8300c00+#define THUMB2_LDRHWI 0xf8b00000+#define ARM_LDR 0x07100000+#define THUMB_LDR 0x5800+#define THUMB2_LDR 0xf8500000+#define ARM_LDRI 0x05100000+#define THUMB_LDRI 0x6800+#define THUMB_LDRISP 0x9800+#define THUMB2_LDRI 0xf8500c00 /* manual says v6t2/v7; does not work */+#define THUMB2_LDRWI 0xf8d00000+#define ARM_LDRD 0x010000d0+#define ARM_LDRDI 0x014000d0+#define THUMB2_LDRDI 0xe8500000+#define ARM_STRB 0x07400000+#define THUMB_STRB 0x5400+#define THUMB2_STRB 0xf8000000+#define ARM_STRBI 0x05400000+#define THUMB_STRBI 0x7000+#define THUMB2_STRBI 0xf8000c00+#define THUMB2_STRBWI 0xf8800000+#define ARM_STRH 0x010000b0+#define THUMB_STRH 0x5200+#define THUMB2_STRH 0xf8200000+#define ARM_STRHI 0x014000b0+#define THUMB_STRHI 0x8000+#define THUMB2_STRHI 0xf8200c00+#define THUMB2_STRHWI 0xf8a00000+#define ARM_STR 0x07000000+#define THUMB_STR 0x5000+#define THUMB2_STR 0xf8400000+#define ARM_STRI 0x05000000+#define THUMB_STRI 0x6000+#define THUMB_STRISP 0x9000+#define THUMB2_STRI 0xf8400c00+#define THUMB2_STRWI 0xf8c00000+#define ARM_STRD 0x010000f0+#define ARM_STRDI 0x014000f0+#define THUMB2_STRDI 0xe8400000 /* manual says v6t2/v7; does not work */++/* ldm/stm */+#define ARM_M 0x08000000+#define ARM_M_L 0x00100000 /* load; store if not set */+#define ARM_M_I 0x00800000 /* inc; dec if not set */+#define ARM_M_B 0x01000000 /* before; after if not set */+#define ARM_M_U 0x00200000 /* update Rn */+#define THUMB2_LDM_W 0x00200000+#define THUMB2_LDM_P 0x00008000+#define THUMB2_LDM_M 0x00004000+#define THUMB_LDMIA 0xc800+#define THUMB2_LDMIA 0xe8900000+#define THUMB2_LDMDB 0xe9100000+#define THUMB_PUSH 0xb400+#define THUMB2_PUSH 0xe92d0000+#define THUMB_POP 0xbc00+#define THUMB2_POP 0xe8bd0000++/* misc */+#define ARM_CLZ 0x016f0f10+#define ARM_PLD 0xf750f000+#define ARM_PLDW 0xf710f000+#define ARM_PLDI 0xf510f000+#define ARM_PLDWI 0xf510f000+#define ARM_PLDLI 0xf55ff000+#define ARM_PLD_U 0x00800000+#define ARM_PLII 0xf4d0f000+#define ARM_PLINI 0xf450f000+#define ARM_PLI 0xf6d0f000+#define ARM_PLIN 0xf650f000++#define FPSCR_N 0x80000000/* Negative condition code flag */+#define FPSCR_Z 0x40000000/* Zero condition code flag */+#define FPSCR_C 0x20000000/* Carry condition code flag */+#define FPSCR_V 0x10000000/* Overflow condition code flag */+#define FPSCR_QC 0x08000000/* Cumulative saturation flag */+#define FPSCR_AHP 0x04000000/* Alternative half-precision (unset is IEEE format) */+#define FPSCR_DN 0x02000000/* Default NaN mode */+#define FPSCR_FZ 0x01000000/* Flush to zero (unset is fully IEEE-754 compliant) */+#define FPSCR_RMASK 0x00c00000+# define FPSCR_RN 0x00000000 /* Round to Nearest */+# define FPSCR_RP 0x00400000 /* Round towards Plus Infinity */+# define FPSCR_RM 0x00800000 /* Round towards Minus Infinity */+# define FPSCR_RZ 0x00c00000 /* Round towards Zero */+#define FPSCR_STRIDE 0x00300000+#define FPSCR_RES1 0x00080000/* Reserved, UNK/SBZP */+#define FPSCR_LEN 0x00070000+#define FPSCR_IDE 0x00008000/* Input Denormal exception trap enable */+#define FPSCR_IXE 0x00001000/* Inexact exception trap enable */+#define FPSCR_UFE 0x00000800/* Underflow exception trap enable */+#define FPSCR_OFE 0x00000400/* Overflow exception trap enable */+#define FPSCR_DZE 0x00000200/* Division by zero exception trap enable */+#define FPSCR_IOE 0x00000100/* Invalid Operation exception trap enable */+#define FPSCR_IDC 0x00000080/* Input Denormal cumulative exception flag */+#define FPSCR_RES0 0x00000060/* Reserved, UNK/SBZP */+#define FPSCR_IXC 0x00000010/* Inexact cumulative exception flag */+#define FPSCR_UFC 0x00000008/* Underflow cumulative exception flag */+#define FPSCR_OFC 0x00000004/* Overflow cumulative exception flag */+#define FPSCR_DZC 0x00000002/* Division by zero cumulative exception flag */+#define FPSCR_IOC 0x00000001/* Invalid Operation cumulative exception flag */++/***********************************************************************+ * VFPv2 and VFPv3 (encoding T2/A2) instructions+ ***********************************************************************/+#define ARM_V_E 0x00000080 /* ARM_VCMP exception if NaN arg(s) */+#define ARM_V_Z 0x00010000 /* ARM_VCMP with zero */+#define ARM_V_F64 0x00000100 /* Undefined in single precision only variant */+#define ARM_VADD_F 0x0e300a00+#define ARM_VSUB_F 0x0e300a40+#define ARM_VMUL_F 0x0e200a00+#define ARM_VDIV_F 0x0e800a00+#define ARM_VABS_F 0x0eb00ac0+#define ARM_VNEG_F 0x0eb10a40+#define ARM_VSQRT_F 0x0eb10ac0+#define ARM_VMOV_F 0x0eb00a40+#define ARM_VMOV_A_S 0x0e100a10 /* vmov rn, sn */+#define ARM_VMOV_S_A 0x0e000a10 /* vmov sn, rn */+#define ARM_VMOV_AA_D 0x0c500b10 /* vmov rn,rn, dn */+#define ARM_VMOV_D_AA 0x0c400b10 /* vmov dn, rn,rn */+#define ARM_VCMP 0x0eb40a40+#define ARM_VMRS 0x0ef10a10+#define ARM_VMSR 0x0ee10a10+#define ARM_VCVT_2I 0x00040000 /* to integer */+#define ARM_VCVT_2S 0x00010000 /* to signed */+#define ARM_VCVT_RS 0x00000080 /* round to zero or signed */+#define ARM_VCVT 0x0eb80a40+#define ARM_VCVT_S32_F32 ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_2S|ARM_VCVT_RS+#define ARM_VCVT_U32_F32 ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_RS+#define ARM_VCVT_S32_F64 ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_2S|ARM_VCVT_RS|ARM_V_F64+#define ARM_VCVT_U32_F64 ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_RS|ARM_V_F64+#define ARM_VCVT_F32_S32 ARM_VCVT|ARM_VCVT_RS+#define ARM_VCVT_F32_U32 ARM_VCVT+#define ARM_VCVT_F64_S32 ARM_VCVT|ARM_VCVT_RS|ARM_V_F64+#define ARM_VCVT_F64_U32 ARM_VCVT|ARM_V_F64+#define ARM_VCVT_F 0x0eb70ac0+#define ARM_VCVT_F32_F64 ARM_VCVT_F+#define ARM_VCVT_F64_F32 ARM_VCVT_F|ARM_V_F64++/* does not set bit 7, meaning to use rounding mode of FPSCR */+#define ARM_VCVTR_S32_F32 ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_2S+#define ARM_VCVTR_U32_F32 ARM_VCVT|ARM_VCVT_2I+#define ARM_VCVTR_S32_F64 ARM_VCVT|ARM_VCVT_2I|ARM_VCVT_2S|ARM_V_F64+#define ARM_VCVTR_U32_F64 ARM_VCVT|ARM_VCVT_2I|ARM_V_F64++/***********************************************************************+ * NEON instructions (encoding T1/A1) (condition must always be ARM_CC_NV)+ ***********************************************************************/+#define ARM_V_D 0x00400000+#define ARM_V_N 0x00000080+#define ARM_V_Q 0x00000040+#define ARM_V_M 0x00000020+#define ARM_V_U 0x01000000+#define ARM_V_I16 0x00100000+#define ARM_V_I32 0x00200000+#define ARM_V_I64 0x00300000+#define ARM_V_S16 0x00040000+#define ARM_V_S32 0x00080000++#define ARM_VADD_I 0x02000800+#define ARM_VQADD_I 0x02000010 /* sets flag on overflow/carry */+#define ARM_VADDL_I 0x02800000 /* q=d+d */+#define ARM_VADDW_I 0x02800100 /* q=q+d */+#define ARM_VSUB_I 0x03000800+#define ARM_VQSUB_I 0x02000210 /* sets flag on overflow/carry */+#define ARM_VSUBL_I 0x02800200+#define ARM_VSUBW_I 0x02800300+#define ARM_VMUL_I 0x02000910+#define ARM_VMULL_I 0x02800c00++#define ARM_VABS_I 0x03b10300+#define ARM_VQABS_I 0x03b00700 /* sets flag on overflow */+#define ARM_VNEG_I 0x03b10380+#define ARM_VQNEG_I 0x03b00780 /* sets flag on overflow */++#define ARM_VAND 0x02000110+#define ARM_VBIC 0x02100110+#define ARM_VORR 0x02200110+#define ARM_VORN 0x02300110+#define ARM_VEOR 0x03000110+#define ARM_VMOVL_S8 0x00080000+#define ARM_VMOVL_S16 0x00100000+#define ARM_VMOVL_S32 0x00200000+#define ARM_VMOVL_I 0x02800a10++#define ARM_VMVSI 0x0eb00a00+#define ARM_VMOVI 0x02800010+#define ARM_VMVNI 0x02800030++#define ARM_VLDR 0x0d100a00+#define ARM_VSTR 0x0d000a00+#define ARM_VM 0x0c000a00++/***********************************************************************+ * Advanced SIMD (encoding T2/A2) instructions+ ***********************************************************************/+#define ARM_VMOV_ADV_U 0x00800000 /* zero extend, sign extend if unset */+#define ARM_VMOV_ADV_8 0x00400000+#define ARM_VMOV_ADV_16 0x00000020+#define ARM_VMOV_A_D 0x0e100b10+#define ARM_VMOV_D_A 0x0e000b10++static int+encode_vfp_double(int mov, int inv, unsigned lo, unsigned hi)+{+ int code, mode, imm, mask;++ if (hi != lo) {+ if (mov && !inv) {+ /* (I64)+ * aaaaaaaabbbbbbbbccccccccddddddddeeeeeeeeffffffffgggggggghhhhhhhh+ */+ for (mode = 0, mask = 0xff; mode < 4; mask <<= 8, mode++) {+ imm = lo & mask;+ if (imm != mask && imm != 0)+ goto fail;+ imm = hi & mask;+ if (imm != mask && imm != 0)+ goto fail;+ }+ mode = 0xe20;+ imm = (((hi & 0x80000000) >> 24) | ((hi & 0x00800000) >> 17) |+ ((hi & 0x00008000) >> 10) | ((hi & 0x00000080) >> 3) |+ ((lo & 0x80000000) >> 28) | ((lo & 0x00800000) >> 21) |+ ((lo & 0x00008000) >> 14) | ((lo & 0x00000080) >> 7));+ goto success;+ }+ goto fail;+ }+ /* (I32)+ * 00000000 00000000 00000000 abcdefgh+ * 00000000 00000000 abcdefgh 00000000+ * 00000000 abcdefgh 00000000 00000000+ * abcdefgh 00000000 00000000 00000000 */+ for (mode = 0, mask = 0xff; mode < 4; mask <<= 8, mode++) {+ if ((lo & mask) == lo) {+ imm = lo >> (mode << 3);+ mode <<= 9;+ goto success;+ }+ }+ /* (I16)+ * 00000000 abcdefgh 00000000 abcdefgh+ * abcdefgh 00000000 abcdefgh 00000000 */+ for (mode = 0, mask = 0xff; mode < 2; mask <<= 8, mode++) {+ if ((lo & mask) && ((lo & (mask << 16)) >> 16) == (lo & mask)) {+ imm = lo >> (mode << 3);+ mode = 0x800 | (mode << 9);+ goto success;+ }+ }+ if (mov) {+ /* (I32)+ * 00000000 00000000 abcdefgh 11111111+ * 00000000 abcdefgh 11111111 11111111 */+ for (mode = 0, mask = 0xff; mode < 2;+ mask = (mask << 8) | 0xff, mode++) {+ if ((lo & mask) == mask &&+ !((lo & ~mask) >> 8) &&+ (imm = lo >> (8 + (mode << 8)))) {+ mode = 0xc00 | (mode << 8);+ goto success;+ }+ }+ if (!inv) {+ /* (F32)+ * aBbbbbbc defgh000 00000000 00000000+ * from the ARM Architecture Reference Manual:+ * In this entry, B = NOT(b). The bit pattern represents the+ * floating-point number (-1)^s* 2^exp * mantissa, where+ * S = UInt(a),+ * exp = UInt(NOT(b):c:d)-3 and+ * mantissa = (16+UInt(e:f:g:h))/16. */+ if ((lo & 0x7ffff) == 0 &&+ (((lo & 0x7e000000) == 0x3e000000) ||+ ((lo & 0x7e000000) == 0x40000000))) {+ mode = 0xf00;+ imm = ((lo >> 24) & 0x80) | ((lo >> 19) & 0x7f);+ goto success;+ }+ }+ }++fail:+ /* need another approach (load from memory, move from arm register, etc) */+ return (-1);++success:+ code = inv ? ARM_VMVNI : ARM_VMOVI;+ switch ((mode & 0xf00) >> 8) {+ case 0x0: case 0x2: case 0x4: case 0x6:+ case 0x8: case 0xa:+ if (inv) mode |= 0x20;+ if (!mov) mode |= 0x100;+ break;+ case 0x1: case 0x3: case 0x5: case 0x7:+ /* should actually not reach here */+ assert(!inv);+ case 0x9: case 0xb:+ assert(!mov);+ break;+ case 0xc: case 0xd:+ /* should actually not reach here */+ assert(inv);+ case 0xe:+ assert(mode & 0x20);+ assert(mov && !inv);+ break;+ default:+ assert(!(mode & 0x20));+ break;+ }+ imm = ((imm & 0x80) << 17) | ((imm & 0x70) << 12) | (imm & 0x0f);+ code |= mode | imm;+#ifdef USE_THUMB_CODE+ if (code & 0x1000000)+ code |= 0xff000000;+ else+ code |= 0xef000000;+#else+ code |= ARM_CC_NV;+#endif+ return (code);+}++#ifdef USE_THUMB_CODE+#define _jit_TI(I) (_jitl.thumb.i = (I), _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))+#else+#define _jit_TI(I) _jit_I(I)+#endif++#define arm_vodi(oi,r0) \+ (assert(!((oi) & 0x0000f000) && !((r0) & 1)), \+ _jit_TI((oi)|(_u4((r0) >> 1)<<12)))++#define arm_voqi(oi,r0) \+ (assert(!((oi) & 0x0000f000) && !((r0) & 3)), \+ _jit_TI((oi)|(_u4((r0) >> 1)<<12)))++#define arm_vo_ss(o,r0,r1) _arm_cc_vo_ss(ARM_CC_NV,o,r0,r1)+#define arm_cc_vo_ss(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f)), \+ _jit_TI((cc)|(o) | (((r0) & 1) ? ARM_V_D : 0) | (((r1) & 1) ? ARM_V_M : 0)|(_u4((r0) >> 1)<<12)|_u4((r1) >> 1)))++#define arm_vo_dd(o,r0,r1) _arm_cc_vo_dd(ARM_CC_NV,o,r0,r1)+#define arm_cc_vo_dd(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f) && !((r0) & 1) && !((r1) & 1)), \+ _jit_TI((cc)|(o)|(_u4((r0) >> 1)<<12)|_u4((r1) >> 1)))++#define arm_vo_qd(o,r0,r1) arm_cc_vo_qd(ARM_CC_NV,o,r0,r1)+#define arm_cc_vo_qd(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f) && !((r0) & 3) && !((r1) & 1)), \+ _jit_TI((cc)|(o)|(_u4((r0) >> 1)<<12)|_u4((r1) >> 1)))++#define arm_vo_qq(o,r0,r1) arm_cc_vo_qq(ARM_CC_NV,o,r0,r1)+#define arm_cc_vo_qq(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f) && !((r0) & 3) && !((r1) & 3)), \+ _jit_TI((cc)|(o)|(_u4((r0) >> 1)<<12)|_u4((r1) >> 1)))++#define arm_vorr_(o,r0,r1) arm_cc_vorr_(ARM_CC_NV,o,r0,r1)+#define arm_cc_vorr_(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f)), \+ _jit_TI((cc)|(o)|(_u4(r1)<<16)|(_u4(r0)<<12)))++#define arm_vors_(o,r0,r1) arm_cc_vors_(ARM_CC_NV,o,r0,r1)+#define arm_cc_vors_(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f)), \+ _jit_TI((cc)|(o)|(((r1) & 1) ? ARM_V_N : 0)|(_u4(r1 >> 1)<<16)|(_u4(r0)<<12)))++#define arm_vorv_(o,r0,r1) arm_cc_vorv_(ARM_CC_NV,o,r0,r1)+#define arm_cc_vorv_(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && ((o) & 0xf000f00f)), \+ _jit_TI((cc)|(o)|(((r1) & 1) ? ARM_V_M : 0)|(_u4((r1) >> 1)<<16)|(_u4(r0)<<12)))++#define arm_vori_(o,r0,r1) arm_cc_vori_(ARM_CC_NV,o,r0,r1)+#define arm_cc_vori_(cc,o,r0,r1) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f)), \+ /* use same bit pattern, to set opc1... */ \+ _jit_TI((cc)|(o)|((r1 & 1) ? ARM_V_I32 : 0)|(_u4((r1) >> 1)<<16)|(_u4(r0)<<12)))++#define arm_vorrd(o,r0,r1,r2) arm_cc_vorrd(ARM_CC_NV,o,r0,r1,r2)+#define arm_cc_vorrd(cc,o,r0,r1,r2) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff00f) && !((r2) & 1)), \+ _jit_TI((cc)|(o)|(_u4(r1)<<16)|(_u4(r0)<<12)|_u4((r2) >> 1)))++#define arm_vosss(o,r0,r1,r2) arm_cc_vosss(ARM_CC_NV,o,r0,r1,r2)+#define arm_cc_vosss(cc,o,r0,r1,r2) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff00f)), \+ _jit_TI((cc)|(o)|(((r0) & 1) ? ARM_V_D : 0)|(((r1) & 1) ? ARM_V_N : 0)|(((r2) & 1) ? ARM_V_M : 0)|(_u4((r1) >> 1)<<16)|(_u4((r0) >> 1)<<12)|_u4((r2) >> 1)))++#define arm_voddd(o,r0,r1,r2) arm_cc_voddd(ARM_CC_NV,o,r0,r1,r2)+#define arm_cc_voddd(cc,o,r0,r1,r2) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff00f) && !((r0) & 1) && !((r1) & 1) && !((r2) & 1)), \+ _jit_TI((cc)|(o)|(_u4((r1) >> 1)<<16)|(_u4((r0) >> 1)<<12)|_u4((r2) >> 1)))++#define arm_voqdd(o,r0,r1,r2) arm_cc_voqdd(ARM_CC_NV,o,r0,r1,r2)+#define arm_cc_voqdd(cc,o,r0,r1,r2) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff00f) && !((r0) & 3) && !((r1) & 1) && !((r2) & 1)), \+ _jit_TI((cc)|(o)|(_u4((r1) >> 1)<<16)|(_u4((r0) >> 1)<<12)|_u4((r2) >> 1)))++#define arm_voqqd(o,r0,r1,r2) arm_cc_voqqd(ARM_CC_NV,o,r0,r1,r2)+#define arm_cc_voqqd(cc,o,r0,r1,r2) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff00f) && !((r0) & 3) && !((r1) & 3) && !((r2) & 1)), \+ _jit_TI((cc)|(o)|(_u4((r1) >> 1)<<16)|(_u4((r0) >> 1)<<12)|_u4((r2) >> 1)))++#define arm_voqqq(o,r0,r1,r2) arm_cc_voqqq(ARM_CC_NV,o,r0,r1,r2)+#define arm_cc_voqqq(cc,o,r0,r1,r2) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff00f) && !((r0) & 3) && !((r1) & 3) && !((r2) & 3)), \+ _jit_TI((cc)|(o)|(_u4((r1) >> 1)<<16)|(_u4((r0) >> 1)<<12)|_u4((r2) >> 1)))++#define arm_cc_vldst(cc,o,r0,r1,i0) \+ /* i0 << 2 is byte offset */ \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff0ff) && (!((r0) & 1) | !((o) & ARM_V_F64))), \+ _jit_TI((cc)|(o)|(((r0) & 1) ? ARM_V_D : 0)|(_u4(r1)<<16)|(_u4((r0) >> 1)<<12)|_u8(i0)))++#define arm_cc_vorsl(cc,o,r0,r1,i0) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff0ff)), \+ /* save i0 double precision registers */ \+ _jit_TI((cc)|((o) | ((r1) & 1) ? ARM_V_D : 0)|(_u4(r0)<<16)|(_u4((r1) >> 1)<<12)|_u8(((o) & ARM_V_F64) ? ((i0) << 1) : (i0))))++/***********************************************************************+ * VFPv2 and VFPv3 (encoding T2/A2) instructions+ ***********************************************************************/+#define _CC_VADD_F32(cc,r0,r1,r2) arm_cc_vosss(cc,ARM_VADD_F,r0,r1,r2)+#define _VADD_F32(r0,r1,r2) _CC_VADD_F32(ARM_CC_AL,r0,r1,r2)+#define _CC_VADD_F64(cc,r0,r1,r2) arm_cc_voddd(cc,ARM_VADD_F|ARM_V_F64,r0,r1,r2)+#define _VADD_F64(r0,r1,r2) _CC_VADD_F64(ARM_CC_AL,r0,r1,r2)+#define _CC_VSUB_F32(cc,r0,r1,r2) arm_cc_vosss(cc,ARM_VSUB_F,r0,r1,r2)+#define _VSUB_F32(r0,r1,r2) _CC_VSUB_F32(ARM_CC_AL,r0,r1,r2)+#define _CC_VSUB_F64(cc,r0,r1,r2) arm_cc_voddd(cc,ARM_VSUB_F|ARM_V_F64,r0,r1,r2)+#define _VSUB_F64(r0,r1,r2) _CC_VSUB_F64(ARM_CC_AL,r0,r1,r2)+#define _CC_VMUL_F32(cc,r0,r1,r2) arm_cc_vosss(cc,ARM_VMUL_F,r0,r1,r2)+#define _VMUL_F32(r0,r1,r2) _CC_VMUL_F32(ARM_CC_AL,r0,r1,r2)+#define _CC_VMUL_F64(cc,r0,r1,r2) arm_cc_voddd(cc,ARM_VMUL_F|ARM_V_F64,r0,r1,r2)+#define _VMUL_F64(r0,r1,r2) _CC_VMUL_F64(ARM_CC_AL,r0,r1,r2)+#define _CC_VDIV_F32(cc,r0,r1,r2) arm_cc_vosss(cc,ARM_VDIV_F,r0,r1,r2)+#define _VDIV_F32(r0,r1,r2) _CC_VDIV_F32(ARM_CC_AL,r0,r1,r2)+#define _CC_VDIV_F64(cc,r0,r1,r2) arm_cc_voddd(cc,ARM_VDIV_F|ARM_V_F64,r0,r1,r2)+#define _VDIV_F64(r0,r1,r2) _CC_VDIV_F64(ARM_CC_AL,r0,r1,r2)+#define _CC_VABS_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VABS_F,r0,r1)+#define _VABS_F32(r0,r1) _CC_VABS_F32(ARM_CC_AL,r0,r1)+#define _CC_VABS_F64(cc,r0,r1) arm_cc_vo_dd(cc,ARM_VABS_F|ARM_V_F64,r0,r1)+#define _VABS_F64(r0,r1) _CC_VABS_F64(ARM_CC_AL,r0,r1)+#define _CC_VNEG_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VNEG_F,r0,r1)+#define _VNEG_F32(r0,r1) _CC_VNEG_F32(ARM_CC_AL,r0,r1)+#define _CC_VNEG_F64(cc,r0,r1) arm_cc_vo_dd(cc,ARM_VNEG_F|ARM_V_F64,r0,r1)+#define _VNEG_F64(r0,r1) _CC_VNEG_F64(ARM_CC_AL,r0,r1)+#define _CC_VSQRT_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VSQRT_F,r0,r1)+#define _VSQRT_F32(r0,r1) _CC_VSQRT_F32(ARM_CC_AL,r0,r1)+#define _CC_VSQRT_F64(cc,r0,r1) arm_cc_vo_dd(cc,ARM_VSQRT_F|ARM_V_F64,r0,r1)+#define _VSQRT_F64(r0,r1) _CC_VSQRT_F64(ARM_CC_AL,r0,r1)+#define _CC_VMOV_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VMOV_F,r0,r1)+#define _VMOV_F32(r0,r1) _CC_VMOV_F32(ARM_CC_AL,r0,r1)+#define _CC_VMOV_F64(cc,r0,r1) arm_cc_vo_dd(cc,ARM_VMOV_F|ARM_V_F64,r0,r1)+#define _VMOV_F64(r0,r1) _CC_VMOV_F64(ARM_CC_AL,r0,r1)+#define _CC_VMOV_AA_D(cc,r0,r1,r2) arm_cc_vorrd(cc,ARM_VMOV_AA_D,r0,r1,r2)+#define _VMOV_AA_D(r0,r1,r2) _CC_VMOV_AA_D(ARM_CC_AL,r0,r1,r2)+#define _CC_VMOV_D_AA(cc,r0,r1,r2) arm_cc_vorrd(cc,ARM_VMOV_D_AA,r1,r2,r0)+#define _VMOV_D_AA(r0,r1,r2) _CC_VMOV_D_AA(ARM_CC_AL,r0,r1,r2)+#define _CC_VMOV_A_S(cc,r0,r1) arm_cc_vors_(cc,ARM_VMOV_A_S,r0,r1)+#define _VMOV_A_S(r0,r1) _CC_VMOV_A_S(ARM_CC_AL,r0,r1)+#define _CC_VMOV_S_A(cc,r0,r1) arm_cc_vors_(cc,ARM_VMOV_S_A,r1,r0)+#define _VMOV_S_A(r0,r1) _CC_VMOV_S_A(ARM_CC_AL,r0,r1)+#define _CC_VCMP_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCMP,r0,r1)+#define _VCMP_F32(r0,r1) _CC_VCMP_F32(ARM_CC_AL,r0,r1)+#define _CC_VCMP_F64(cc,r0,r1) arm_cc_vo_dd(cc,ARM_VCMP|ARM_V_F64,r0,r1)+#define _VCMP_F64(r0,r1) _CC_VCMP_F64(ARM_CC_AL,r0,r1)+#define _CC_VCMPE_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCMP|ARM_V_E,r0,r1)+#define _VCMPE_F32(r0,r1) _CC_VCMPE_F32(ARM_CC_AL,r0,r1)+#define _CC_VCMPE_F64(cc,r0,r1) arm_cc_vo_dd(cc,ARM_VCMP|ARM_V_E|ARM_V_F64,r0,r1)+#define _VCMPE_F64(r0,r1) _CC_VCMPE_F64(ARM_CC_AL,r0,r1)+#define _CC_VCMPZ_F32(cc,r0) arm_cc_vo_ss(cc,ARM_VCMP|ARM_V_Z,r0,0)+#define _VCMPZ_F32(r0) _CC_VCMPZ_F32(ARM_CC_AL,r0)+#define _CC_VCMPZ_F64(cc,r0) arm_cc_vo_dd(cc,ARM_VCMP|ARM_V_Z|ARM_V_F64,r0,0)+#define _VCMPZ_F64(r0) _CC_VCMPZ_F64(ARM_CC_AL,r0)+#define _CC_VCMPEZ_F32(cc,r0) arm_cc_vo_ss(cc,ARM_VCMP|ARM_V_Z|ARM_V_E,r0,0)+#define _VCMPEZ_F32(r0) _CC_VCMPEZ_F32(ARM_CC_AL,r0)+#define _CC_VCMPEZ_F64(cc,r0) arm_cc_vo_dd(cc,ARM_VCMP|ARM_V_Z|ARM_V_E|ARM_V_F64,r0,0)+#define _VCMPEZ_F64(r0) _CC_VCMPEZ_F64(ARM_CC_AL,r0)+#define _CC_VMRS(cc,r0) arm_cc_vorr_(cc,ARM_VMRS,r0,0)+#define _VMRS(r0) _CC_VMRS(ARM_CC_AL,r0)+#define _CC_VMSR(cc,r0) arm_cc_vorr_(cc,ARM_VMSR,r0,0)+#define _VMSR(r0) _CC_VMSR(ARM_CC_AL,r0)+#define _CC_VCVT_S32_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_S32_F32,r0,r1)+#define _VCVT_S32_F32(r0,r1) _CC_VCVT_S32_F32(ARM_CC_AL,r0,r1)+#define _CC_VCVT_U32_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_U32_F32,r0,r1)+#define _VCVT_U32_F32(r0,r1) _CC_VCVT_U32_F32(ARM_CC_AL,r0,r1)+#define _CC_VCVT_S32_F64(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_S32_F64,r0,r1)+#define _VCVT_S32_F64(r0,r1) _CC_VCVT_S32_F64(ARM_CC_AL,r0,r1)+#define _CC_VCVT_U32_F64(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_U32_F64,r0,r1)+#define _VCVT_U32_F64(r0,r1) _CC_VCVT_U32_F64(ARM_CC_AL,r0,r1)+#define _CC_VCVT_F32_S32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_F32_S32,r0,r1)+#define _VCVT_F32_S32(r0,r1) _CC_VCVT_F32_S32(ARM_CC_AL,r0,r1)+#define _CC_VCVT_F32_U32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_F32_U32,r0,r1)+#define _VCVT_F32_U32(r0,r1) _CC_VCVT_F32_U32(ARM_CC_AL,r0,r1)+#define _CC_VCVT_F64_S32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_F64_S32,r0,r1)+#define _VCVT_F64_S32(r0,r1) _CC_VCVT_F64_S32(ARM_CC_AL,r0,r1)+#define _CC_VCVT_F64_U32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_F64_U32,r0,r1)+#define _VCVT_F64_U32(r0,r1) _CC_VCVT_F64_U32(ARM_CC_AL,r0,r1)+#define _CC_VCVT_F32_F64(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_F32_F64,r0,r1)+#define _VCVT_F32_F64(r0,r1) _CC_VCVT_F32_F64(ARM_CC_AL,r0,r1)+#define _CC_VCVT_F64_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVT_F64_F32,r0,r1)+#define _VCVT_F64_F32(r0,r1) _CC_VCVT_F64_F32(ARM_CC_AL,r0,r1)+/* use rounding mode in fpscr (intended for floor, ceil, etc) */+#define _CC_VCVTR_S32_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVTR_S32_F32,r0,r1)+#define _VCVTR_S32_F32(r0,r1) _CC_VCVTR_S32_F32(ARM_CC_AL,r0,r1)+#define _CC_VCVTR_U32_F32(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVTR_U32_F32,r0,r1)+#define _VCVTR_U32_F32(r0,r1) _CC_VCVTR_U32_F32(ARM_CC_AL,r0,r1)+#define _CC_VCVTR_S32_F64(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVTR_S32_F64,r0,r1)+#define _VCVTR_S32_F64(r0,r1) _CC_VCVTR_S32_F64(ARM_CC_AL,r0,r1)+#define _CC_VCVTR_U32_F64(cc,r0,r1) arm_cc_vo_ss(cc,ARM_VCVTR_U32_F64,r0,r1)+#define _VCVTR_U32_F64(r0,r1) _CC_VCVTR_U32_F64(ARM_CC_AL,r0,r1)+/***********************************************************************+ * NEON instructions (encoding T1/A1) (condition must always be ARM_CC_NV)+ ***********************************************************************/+#define _CC_VLDMIA_F32(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_L|ARM_M_I,r0,r1,i0)+#define _VLDMIA_F32(r0,r1,i0) _CC_VLDMIA_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDMIA_F64(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_L|ARM_M_I|ARM_V_F64,r0,r1,i0)+#define _VLDMIA_F64(r0,r1,i0) _CC_VLDMIA_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTMIA_F32(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_I,r0,r1,i0)+#define _VSTMIA_F32(r0,r1,i0) _CC_VSTMIA_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTMIA_F64(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_I|ARM_V_F64,r0,r1,i0)+#define _VSTMIA_F64(r0,r1,i0) _CC_VSTMIA_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDMIA_U_F32(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_L|ARM_M_I|ARM_M_U,r0,r1,i0)+#define _VLDMIA_U_F32(r0,r1,i0) _CC_VLDMIA_U_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDMIA_U_F64(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_L|ARM_M_I|ARM_M_U|ARM_V_F64,r0,r1,i0)+#define _VLDMIA_U_F64(r0,r1,i0) _CC_VLDMIA_U_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTMIA_U_F32(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_I|ARM_M_U,r0,r1,i0)+#define _VSTMIA_U_F32(r0,r1,i0) _CC_VSTMIA_U_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTMIA_U_F64(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_I|ARM_M_U|ARM_V_F64,r0,r1,i0)+#define _VSTMIA_U_F64(r0,r1,i0) _CC_VSTMIA_U_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDMDB_U_F32(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_L|ARM_M_B|ARM_M_U,r0,r1,i0)+#define _VLDMDB_U_F32(r0,r1,i0) _CC_VLDMDB_U_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDMDB_U_F64(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_L|ARM_M_B|ARM_M_U|ARM_V_F64,r0,r1,i0)+#define _VLDMDB_U_F64(r0,r1,i0) _CC_VLDMDB_U_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTMDB_U_F32(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_B|ARM_M_U,r0,r1,i0)+#define _VSTMDB_U_F32(r0,r1,i0) _CC_VSTMDB_U_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTMDB_U_F64(cc,r0,r1,i0) arm_cc_vorsl(cc,ARM_VM|ARM_M_B|ARM_M_U|ARM_V_F64,r0,r1,i0)+#define _VSTMDB_U_F64(r0,r1,i0) _CC_VSTMDB_U_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VPUSH_F32(cc,r0,i0) _CC_VSTMDB_U_F32(cc,JIT_SP,r0,i0)+#define _VPUSH_F32(r0,i0) _CC_VPUSH_F32(ARM_CC_AL,r0,i0)+#define _CC_VPUSH_F64(cc,r0,i0) _CC_VSTMDB_U_F64(cc,JIT_SP,r0,i0)+#define _VPUSH_F64(r0,i0) _CC_VPUSH_F64(ARM_CC_AL,r0,i0)+#define _CC_VPOP_F32(cc,r0,i0) _CC_VLDMIA_U_F32(cc,JIT_SP,r0,i0)+#define _VPOP_F32(r0,i0) _CC_VPOP_F32(ARM_CC_AL,r0,i0)+#define _CC_VPOP_F64(cc,r0,i0) _CC_VLDMIA_U_F64(cc,JIT_SP,r0,i0)+#define _VPOP_F64(r0,i0) _CC_VPOP_F64(ARM_CC_AL,r0,i0)+/***********************************************************************+ * Advanced SIMD (encoding T2/A2) instructions+ ***********************************************************************/+#define _CC_VMOV_A_S8(cc,r0,r1) arm_cc_vorv_(cc,ARM_VMOV_A_D|ARM_VMOV_ADV_8,r0,r1)+#define _VMOV_A_S8(r0,r1) _CC_VMOV_A_S8(ARM_CC_AL,r0,r1)+#define _CC_VMOV_A_U8(cc,r0,r1) arm_cc_vorv_(cc,ARM_VMOV_A_D|ARM_VMOV_ADV_8|ARM_VMOV_ADV_U,r0,r1)+#define _VMOV_A_U8(r0,r1) _CC_VMOV_A_U8(ARM_CC_AL,r0,r1)+#define _CC_VMOV_A_S16(cc,r0,r1) arm_cc_vorv_(cc,ARM_VMOV_A_D|ARM_VMOV_ADV_16,r0,r1)+#define _VMOV_A_S16(r0,r1) _CC_VMOV_A_S16(ARM_CC_AL,r0,r1)+#define _CC_VMOV_A_U16(cc,r0,r1) arm_cc_vorv_(cc,ARM_VMOV_A_D|ARM_VMOV_ADV_16|ARM_VMOV_ADV_U,r0,r1)+#define _VMOV_A_U16(r0,r1) _CC_VMOV_A_U16(ARM_CC_AL,r0,r1)+#define _CC_VMOV_A_S32(cc,r0,r1) arm_cc_vori_(cc,ARM_VMOV_A_D,r0,r1)+#define _VMOV_A_S32(r0,r1) _CC_VMOV_A_S32(ARM_CC_AL,r0,r1)+#define _CC_VMOV_A_U32(cc,r0,r1) arm_cc_vori_(cc,ARM_VMOV_A_D|ARM_VMOV_ADV_U,r0,r1)+#define _VMOV_A_U32(r0,r1) _CC_VMOV_A_U32(ARM_CC_AL,r0,r1)+#define _CC_VMOV_V_I8(cc,r0,r1) arm_cc_vorv_(cc,ARM_VMOV_D_A|ARM_VMOV_ADV_8,r1,r0)+#define _VMOV_V_I8(r0,r1) _CC_VMOV_V_I8(ARM_CC_AL,r0,r1)+#define _CC_VMOV_V_I16(cc,r0,r1) arm_cc_vorv_(cc,ARM_VMOV_D_A|ARM_VMOV_ADV_16,r1,r0)+#define _VMOV_V_I16(r0,r1) _CC_VMOV_V_I16(ARM_CC_AL,r0,r1)+#define _CC_VMOV_V_I32(cc,r0,r1) arm_cc_vori_(cc,ARM_VMOV_D_A,r1,r0)+#define _VMOV_V_I32(r0,r1) _CC_VMOV_V_I32(ARM_CC_AL,r0,r1)+#define _VADD_I8(r0,r1,r2) arm_voddd(ARM_VADD_I,r0,r1,r2)+#define _VADDQ_I8(r0,r1,r2) arm_voqqq(ARM_VADD_I|ARM_V_Q,r0,r1,r2)+#define _VADD_I16(r0,r1,r2) arm_voddd(ARM_VADD_I|ARM_V_I16,r0,r1,r2)+#define _VADDQ_I16(r0,r1,r2) arm_voqqq(ARM_VADD_I|ARM_V_I16|ARM_V_Q,r0,r1,r2)+#define _VADD_I32(r0,r1,r2) arm_voddd(ARM_VADD_I|ARM_V_I32,r0,r1,r2)+#define _VADDQ_I32(r0,r1,r2) arm_voqqq(ARM_VADD_I|ARM_V_I32|ARM_V_Q,r0,r1,r2)+#define _VADD_I64(r0,r1,r2) arm_voddd(ARM_VADD_I|ARM_V_I64,r0,r1,r2)+#define _VADDQ_I64(r0,r1,r2) arm_voqqq(ARM_VADD_I|ARM_V_I64|ARM_V_Q,r0,r1,r2)+#define _VQADD_S8(r0,r1,r2) arm_voddd(ARM_VQADD_I,r0,r1,r2)+#define _VQADDQ_S8(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_Q,r0,r1,r2)+#define _VQADD_U8(r0,r1,r2) arm_voddd(ARM_VQADD_I|ARM_V_U,r0,r1,r2)+#define _VQADDQ_U8(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VQADD_S16(r0,r1,r2) arm_voddd(ARM_VQADD_I|ARM_V_I16,r0,r1,r2)+#define _VQADDQ_S16(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_I16|ARM_V_Q,r0,r1,r2)+#define _VQADD_U16(r0,r1,r2) arm_voddd(ARM_VQADD_I|ARM_V_I16|ARM_V_U,r0,r1,r2)+#define _VQADDQ_U16(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_I16|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VQADD_S32(r0,r1,r2) arm_voddd(ARM_VQADD_I|ARM_V_I32,r0,r1,r2)+#define _VQADDQ_S32(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_I32|ARM_V_Q,r0,r1,r2)+#define _VQADD_U32(r0,r1,r2) arm_voddd(ARM_VQADD_I|ARM_V_I32|ARM_V_U,r0,r1,r2)+#define _VQADDQ_U32(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_I32|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VQADD_S64(r0,r1,r2) arm_voddd(ARM_VQADD_I|ARM_V_I64,r0,r1,r2)+#define _VQADDQ_S64(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_I64|ARM_V_Q,r0,r1,r2)+#define _VQADD_U64(r0,r1,r2) arm_voddd(ARM_VQADD_I|ARM_V_I64|ARM_V_U,r0,r1,r2)+#define _VQADDQ_U64(r0,r1,r2) arm_voqqq(ARM_VQADD_I|ARM_V_I64|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VADDL_S8(r0,r1,r2) arm_voqdd(ARM_VADDL_I,r0,r1,r2)+#define _VADDL_U8(r0,r1,r2) arm_voqdd(ARM_VADDL_I|ARM_V_U,r0,r1,r2)+#define _VADDL_S16(r0,r1,r2) arm_voqdd(ARM_VADDL_I|ARM_V_I16,r0,r1,r2)+#define _VADDL_U16(r0,r1,r2) arm_voqdd(ARM_VADDL_I|ARM_V_I16|ARM_V_U,r0,r1,r2)+#define _VADDL_S32(r0,r1,r2) arm_voqdd(ARM_VADDL_I|ARM_V_I32,r0,r1,r2)+#define _VADDL_U32(r0,r1,r2) arm_voqdd(ARM_VADDL_I|ARM_V_I32|ARM_V_U,r0,r1,r2)+#define _VADDW_S8(r0,r1,r2) arm_voqqd(ARM_VADDW_I,r0,r1,r2)+#define _VADDW_U8(r0,r1,r2) arm_voqqd(ARM_VADDW_I|ARM_V_U,r0,r1,r2)+#define _VADDW_S16(r0,r1,r2) arm_voqqd(ARM_VADDW_I|ARM_V_I16,r0,r1,r2)+#define _VADDW_U16(r0,r1,r2) arm_voqqd(ARM_VADDW_I|ARM_V_I16|ARM_V_U,r0,r1,r2)+#define _VADDW_S32(r0,r1,r2) arm_voqqd(ARM_VADDW_I|ARM_V_I32,r0,r1,r2)+#define _VADDW_U32(r0,r1,r2) arm_voqqd(ARM_VADDW_I|ARM_V_I32|ARM_V_U,r0,r1,r2)+#define _VSUB_I8(r0,r1,r2) arm_voddd(ARM_VSUB_I,r0,r1,r2)+#define _VSUBQ_I8(r0,r1,r2) arm_voqqq(ARM_VSUB_I|ARM_V_Q,r0,r1,r2)+#define _VSUB_I16(r0,r1,r2) arm_voddd(ARM_VSUB_I|ARM_V_I16,r0,r1,r2)+#define _VSUBQ_I16(r0,r1,r2) arm_voqqq(ARM_VSUB_I|ARM_V_I16|ARM_V_Q,r0,r1,r2)+#define _VSUB_I32(r0,r1,r2) arm_voddd(ARM_VSUB_I|ARM_V_I32,r0,r1,r2)+#define _VSUBQ_I32(r0,r1,r2) arm_voqqq(ARM_VSUB_I|ARM_V_I32|ARM_V_Q,r0,r1,r2)+#define _VSUB_I64(r0,r1,r2) arm_voddd(ARM_VSUB_I|ARM_V_I64,r0,r1,r2)+#define _VSUBQ_I64(r0,r1,r2) arm_voqqq(ARM_VSUB_I|ARM_V_I64|ARM_V_Q,r0,r1,r2)+#define _VQSUB_S8(r0,r1,r2) arm_voddd(ARM_VQSUB_I,r0,r1,r2)+#define _VQSUBQ_S8(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_Q,r0,r1,r2)+#define _VQSUB_U8(r0,r1,r2) arm_voddd(ARM_VQSUB_I|ARM_V_U,r0,r1,r2)+#define _VQSUBQ_U8(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VQSUB_S16(r0,r1,r2) arm_voddd(ARM_VQSUB_I|ARM_V_I16,r0,r1,r2)+#define _VQSUBQ_S16(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_I16|ARM_V_Q,r0,r1,r2)+#define _VQSUB_U16(r0,r1,r2) arm_voddd(ARM_VQSUB_I|ARM_V_I16|ARM_V_U,r0,r1,r2)+#define _VQSUBQ_U16(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_I16|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VQSUB_S32(r0,r1,r2) arm_voddd(ARM_VQSUB_I|ARM_V_I32,r0,r1,r2)+#define _VQSUBQ_S32(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_I32|ARM_V_Q,r0,r1,r2)+#define _VQSUB_U32(r0,r1,r2) arm_voddd(ARM_VQSUB_I|ARM_V_I32|ARM_V_U,r0,r1,r2)+#define _VQSUBQ_U32(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_I32|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VQSUB_S64(r0,r1,r2) arm_voddd(ARM_VQSUB_I|ARM_V_I64,r0,r1,r2)+#define _VQSUBQ_S64(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_I64|ARM_V_Q,r0,r1,r2)+#define _VQSUB_U64(r0,r1,r2) arm_voddd(ARM_VQSUB_I|ARM_V_I64|ARM_V_U,r0,r1,r2)+#define _VQSUBQ_U64(r0,r1,r2) arm_voqqq(ARM_VQSUB_I|ARM_V_I64|ARM_V_U|ARM_V_Q,r0,r1,r2)+#define _VSUBL_S8(r0,r1,r2) arm_voqdd(ARM_VSUBL_I,r0,r1,r2)+#define _VSUBL_U8(r0,r1,r2) arm_voqdd(ARM_VSUBL_I|ARM_V_U,r0,r1,r2)+#define _VSUBL_S16(r0,r1,r2) arm_voqdd(ARM_VSUBL_I|ARM_V_I16,r0,r1,r2)+#define _VSUBL_U16(r0,r1,r2) arm_voqdd(ARM_VSUBL_I|ARM_V_I16|ARM_V_U,r0,r1,r2)+#define _VSUBL_S32(r0,r1,r2) arm_voqdd(ARM_VSUBL_I|ARM_V_I32,r0,r1,r2)+#define _VSUBL_U32(r0,r1,r2) arm_voqdd(ARM_VSUBL_I|ARM_V_I32|ARM_V_U,r0,r1,r2)+#define _VSUBW_S8(r0,r1,r2) arm_voqqd(ARM_VSUBW_I,r0,r1,r2)+#define _VSUBW_U8(r0,r1,r2) arm_voqqd(ARM_VSUBW_I|ARM_V_U,r0,r1,r2)+#define _VSUBW_S16(r0,r1,r2) arm_voqqd(ARM_VSUBW_I|ARM_V_I16,r0,r1,r2)+#define _VSUBW_U16(r0,r1,r2) arm_voqqd(ARM_VSUBW_I|ARM_V_I16|ARM_V_U,r0,r1,r2)+#define _VSUBW_S32(r0,r1,r2) arm_voqqd(ARM_VSUBW_I|ARM_V_I32,r0,r1,r2)+#define _VSUBW_U32(r0,r1,r2) arm_voqqd(ARM_VSUBW_I|ARM_V_I32|ARM_V_U,r0,r1,r2)+#define _VMUL_I8(r0,r1,r2) arm_voddd(ARM_VMUL_I,r0,r1,r2)+#define _VMULQ_I8(r0,r1,r2) arm_voqqq(ARM_VMUL_I|ARM_V_Q,r0,r1,r2)+#define _VMUL_I16(r0,r1,r2) arm_voddd(ARM_VMUL_I|ARM_V_I16,r0,r1,r2)+#define _VMULQ_I16(r0,r1,r2) arm_voqqq(ARM_VMUL_I|ARM_V_Q|ARM_V_I16,r0,r1,r2)+#define _VMUL_I32(r0,r1,r2) arm_voddd(ARM_VMUL_I|ARM_V_I32,r0,r1,r2)+#define _VMULQ_I32(r0,r1,r2) arm_voqqq(ARM_VMUL_I|ARM_V_Q|ARM_V_I32,r0,r1,r2)+#define _VMULL_S8(r0,r1,r2) arm_voqdd(ARM_VMULL_I,r0,r1,r2)+#define _VMULL_U8(r0,r1,r2) arm_voqdd(ARM_VMULL_I|ARM_V_U,r0,r1,r2)+#define _VMULL_S16(r0,r1,r2) arm_voqdd(ARM_VMULL_I|ARM_V_I16,r0,r1,r2)+#define _VMULL_U16(r0,r1,r2) arm_voqdd(ARM_VMULL_I|ARM_V_U|ARM_V_I16,r0,r1,r2)+#define _VMULL_S32(r0,r1,r2) arm_voqdd(ARM_VMULL_I|ARM_V_I32,r0,r1,r2)+#define _VMULL_U32(r0,r1,r2) arm_voqdd(ARM_VMULL_I|ARM_V_U|ARM_V_I32,r0,r1,r2)+#define _VABS_S8(r0,r1) arm_vo_dd(ARM_VABS_I,r0,r1)+#define _VABSQ_S8(r0,r1) arm_vo_qq(ARM_VABS_I|ARM_V_Q,r0,r1)+#define _VABS_S16(r0,r1) arm_vo_dd(ARM_VABS_I|ARM_V_S16,r0,r1)+#define _VABSQ_S16(r0,r1) arm_vo_qq(ARM_VABS_I|ARM_V_S16|ARM_V_Q,r0,r1)+#define _VABS_S32(r0,r1) arm_vo_dd(ARM_VABS_I|ARM_V_S32,r0,r1)+#define _VABSQ_S32(r0,r1) arm_vo_qq(ARM_VABS_I|ARM_V_S32|ARM_V_Q,r0,r1)+#define _VQABS_S8(r0,r1) arm_vo_dd(ARM_VQABS_I,r0,r1)+#define _VQABSQ_S8(r0,r1) arm_vo_qq(ARM_VQABS_I|ARM_V_Q,r0,r1)+#define _VQABS_S16(r0,r1) arm_vo_dd(ARM_VQABS_I|ARM_V_S16,r0,r1)+#define _VQABSQ_S16(r0,r1) arm_vo_qq(ARM_VQABS_I|ARM_V_S16|ARM_V_Q,r0,r1)+#define _VQABS_S32(r0,r1) arm_vo_dd(ARM_VQABS_I|ARM_V_S32,r0,r1)+#define _VQABSQ_S32(r0,r1) arm_vo_qq(ARM_VQABS_I|ARM_V_S32|ARM_V_Q,r0,r1)+#define _VNEG_S8(r0,r1) arm_vo_dd(ARM_VNEG_I,r0,r1)+#define _VNEGQ_S8(r0,r1) arm_vo_qq(ARM_VNEG_I|ARM_V_Q,r0,r1)+#define _VNEG_S16(r0,r1) arm_vo_dd(ARM_VNEG_I|ARM_V_S16,r0,r1)+#define _VNEGQ_S16(r0,r1) arm_vo_qq(ARM_VNEG_I|ARM_V_S16|ARM_V_Q,r0,r1)+#define _VNEG_S32(r0,r1) arm_vo_dd(ARM_VNEG_I|ARM_V_S32,r0,r1)+#define _VNEGQ_S32(r0,r1) arm_vo_qq(ARM_VNEG_I|ARM_V_S32|ARM_V_Q,r0,r1)+#define _VQNEG_S8(r0,r1) arm_vo_dd(ARM_VQNEG_I,r0,r1)+#define _VQNEGQ_S8(r0,r1) arm_vo_qq(ARM_VQNEG_I|ARM_V_Q,r0,r1)+#define _VQNEG_S16(r0,r1) arm_vo_dd(ARM_VQNEG_I|ARM_V_S16,r0,r1)+#define _VQNEGQ_S16(r0,r1) arm_vo_qq(ARM_VQNEG_I|ARM_V_S16|ARM_V_Q,r0,r1)+#define _VQNEG_S32(r0,r1) arm_vo_dd(ARM_VQNEG_I|ARM_V_S32,r0,r1)+#define _VQNEGQ_S32(r0,r1) arm_vo_qq(ARM_VQNEG_I|ARM_V_S32|ARM_V_Q,r0,r1)+#define _VAND(r0,r1,r2) arm_voddd(ARM_VAND,r0,r1,r2)+#define _VANDQ(r0,r1,r2) arm_voqqq(ARM_VAND|ARM_V_Q,r0,r1,r2)+#define _VBIC(r0,r1,r2) arm_voddd(ARM_VBIC,r0,r1,r2)+#define _VBICQ(r0,r1,r2) arm_voqqq(ARM_VBIC|ARM_V_Q,r0,r1,r2)+#define _VORR(r0,r1,r2) arm_voddd(ARM_VORR,r0,r1,r2)+#define _VORRQ(r0,r1,r2) arm_voqqq(ARM_VORR|ARM_V_Q,r0,r1,r2)+#define _VORN(r0,r1,r2) arm_voddd(ARM_VORN,r0,r1,r2)+#define _VORNQ(r0,r1,r2) arm_voqqq(ARM_VORN|ARM_V_Q,r0,r1,r2)+#define _VEOR(r0,r1,r2) arm_voddd(ARM_VEOR,r0,r1,r2)+#define _VEORQ(r0,r1,r2) arm_voqqq(ARM_VEOR|ARM_V_Q,r0,r1,r2)+#define _VMOV(r0,r1) _VORR(r0,r1,r1)+#define _VMOVQ(r0,r1) _VORRQ(r0,r1,r1)+#define _VMOVL_S8(r0,r1) arm_vo_qd(ARM_VMOVL_I|ARM_VMOVL_S8,r0,r1)+#define _VMOVL_U8(r0,r1) arm_vo_qd(ARM_VMOVL_I|ARM_V_U|ARM_VMOVL_S8,r0,r1)+#define _VMOVL_S16(r0,r1) arm_vo_qd(ARM_VMOVL_I|ARM_VMOVL_S16,r0,r1)+#define _VMOVL_U16(r0,r1) arm_vo_qd(ARM_VMOVL_I|ARM_V_U|ARM_VMOVL_S16,r0,r1)+#define _VMOVL_S32(r0,r1) arm_vo_qd(ARM_VMOVL_I|ARM_VMOVL_S32,r0,r1)+#define _VMOVL_U32(r0,r1) arm_vo_qd(ARM_VMOVL_I|ARM_V_U|ARM_VMOVL_S32,r0,r1)+/* "oi" should be the result of encode_vfp_double */+#define _VIMM(oi,r0) arm_vodi(oi,r0)+#define _VIMMQ(oi,r0) arm_voqi(oi|ARM_V_Q,r0)+/* index is multipled by four */+#define _CC_VLDRN_F32(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VLDR,r0,r1,i0)+#define _VLDRN_F32(r0,r1,i0) _CC_VLDRN_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDR_F32(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VLDR|ARM_P,r0,r1,i0)+#define _VLDR_F32(r0,r1,i0) _CC_VLDR_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDRN_F64(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VLDR|ARM_V_F64,r0,r1,i0)+#define _VLDRN_F64(r0,r1,i0) _CC_VLDRN_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VLDR_F64(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VLDR|ARM_V_F64|ARM_P,r0,r1,i0)+#define _VLDR_F64(r0,r1,i0) _CC_VLDR_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTRN_F32(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VSTR,r0,r1,i0)+#define _VSTRN_F32(r0,r1,i0) _CC_VSTRN_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTR_F32(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VSTR|ARM_P,r0,r1,i0)+#define _VSTR_F32(r0,r1,i0) _CC_VSTR_F32(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTRN_F64(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VSTR|ARM_V_F64,r0,r1,i0)+#define _VSTRN_F64(r0,r1,i0) _CC_VSTRN_F64(ARM_CC_AL,r0,r1,i0)+#define _CC_VSTR_F64(cc,r0,r1,i0) arm_cc_vldst(cc,ARM_VSTR|ARM_V_F64|ARM_P,r0,r1,i0)+#define _VSTR_F64(r0,r1,i0) _CC_VSTR_F64(ARM_CC_AL,r0,r1,i0)++/* from binutils */+#define rotate_left(v, n) (v << n | v >> (32 - n))+static int+encode_arm_immediate(unsigned int v)+{+ unsigned int a, i;++ for (i = 0; i < 32; i += 2)+ if ((a = rotate_left(v, i)) <= 0xff)+ return (a | (i << 7));++ return (-1);+}++#define corrr(cc,o,rn,rd,rm) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00fff0f)), \+ _jit_I((cc)|(o)|(_u4(rn)<<16)|(_u4(rd)<<12)|_u4(rm)))++#define corri(cc,o,rn,rd,im) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00fffff) && !((im) & 0xfffff000)), \+ _jit_I((cc)|(o)|(_u4(rn)<<16)|(_u4(rd)<<12)|_u12(im)))++#define coriw(cc,o,rd,im) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00fffff) && !(im & 0xffff0000)), \+ _jit_I((cc)|(o)|((im&0xf000)<<4)|(_u4(rd)<<12)|(im&0xfff)))++#define corri8(cc,o,rn,rt,im) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00fff0f) && !(im & 0xffffff00)), \+ _jit_I((cc)|(o)|(_u4(rn)<<16)|(_u4(rt)<<12)|((im&0xf0)<<4)|(im&0x0f)))++#define corrrr(cc,o,rh,rl,rm,rn) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00fff0f)), \+ _jit_I((cc)|(o)|(_u4(rh)<<16)|(_u4(rl)<<12)|(_u4(rm)<<8)|_u4(rn)))++#define corrrs(cc,o,rn,rd,rm,im) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000ff8f)), \+ _jit_I((cc)|(o)|(_u4(rd)<<12)|(_u4(rn)<<16)|(im<<7)|_u4(rm)))++#define cshift(cc,o,rd,rm,rn,im) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xffe0ff8f) && ((_u4(rm)<<8)&(im<<7)) == 0), \+ _jit_I((cc)|ARM_SHIFT|(o)|(_u4(rd)<<12)|(_u4(rm)<<8)|(im<<7)|_u4(rn)))++#define cb(cc,o,im) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf0ffffff)), \+ _jit_I((cc)|(o)|_u24(im)))++#define cbx(cc,o,rm) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000000f)), \+ _jit_I((cc)|(o)|_u4(rm)))++#define corl(cc,o,r0,i0) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00fffff)), \+ _jit_I((cc)|(o)|(_u4(r0)<<16)|_u16(i0)))++#define c6orr(cc,o,rd,rm) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf000f00f)), \+ _jit_I((cc)|(o)|(_u4(rd)<<12)|_u4(rm)))++#define arm_cc_pkh(cc,o,rn,rd,rm,im) \+ (assert(!((cc) & 0x0fffffff) && !((o) & 0xf00ff00f)), \+ _jit_I((cc)|(o)|(_u4(rn)<<16)|(_u4(rd)<<12)|(_u5(im)<<7)|_u4(rm)))+++#define _CC_MOV(cc,rd,rm) corrr(cc,ARM_MOV,0,rd,rm)+#define _MOV(rd,rm) _CC_MOV(ARM_CC_AL,rd,rm)+#define T1_MOV(rd,rm) _jit_W(THUMB_MOV|((_u4(rd)&8)<<4)|(_u4(rm)<<3)|(rd&7))+#define T2_MOV(rd,rm) T2_ORR(rd,_R15,rm)+#define _CC_MOVI(cc,rd,im) corri(cc,ARM_MOV|ARM_I,0,rd,im)+#define _MOVI(rd,im) _CC_MOVI(ARM_CC_AL,rd,im)+#define _CC_MOVWI(cc,rd,im) coriw(cc,ARM_MOVWI,rd,im)+#define _MOVWI(rd,im) _CC_MOVWI(ARM_CC_AL,rd,im)+#define T1_MOVI(rd,im) _jit_W(THUMB_MOVI|(_u3(rd)<<8)|_u8(im))+#define T2_MOVI(rd,im) torri(THUMB2_MOVI,_R15,rd,im)+#define T2_MOVWI(rd,im) toriw(THUMB2_MOVWI,rd,im)+#define _CC_MOVTI(cc,rd,im) coriw(cc,ARM_MOVTI,rd,im)+#define _MOVTI(rd,im) _CC_MOVTI(ARM_CC_AL,rd,im)+#define T2_MOVTI(rd,im) toriw(THUMB2_MOVTI,rd,im)+#define _CC_MVN(cc,rd,rm) corrr(cc,ARM_MVN,0,rd,rm)+#define _MVN(rd,rm) _CC_MVN(ARM_CC_AL,rd,rm)+#define T1_MVN(rd,rm) _jit_W(THUMB_MVN|(_u3(rm)<<3)|_u3(rd))+#define T2_MVN(rd,rm) torrr(THUMB2_MVN,rd,_R15,rm)+#define _CC_MVNI(cc,rd,im) corri(cc,ARM_MVN|ARM_I,0,rd,im)+#define _MVNI(rd,im) _CC_MVNI(ARM_CC_AL,rd,im)+#define T2_MVNI(rd,im) torri(THUMB2_MVNI,_R15,rd,im)+#define _CC_NOT(cc,rd,rm) _CC_MVN(cc,rd,rm)+#define _NOT(rd,rm) _CC_NOT(ARM_CC_AL,rd,rm)+#define T1_NOT(rd,rm) T1_MVN(rd,rm)+#define T2_NOT(rd,rm) T2_MVN(rd,rm)+#define _NOP() _MOV(_R0, _R0)+#define T1_NOP() _jit_W(0xbf00)++#define _CC_ADD(cc,rd,rn,rm) corrr(cc,ARM_ADD,rn,rd,rm)+#define _ADD(rd,rn,rm) _CC_ADD(ARM_CC_AL,rd,rn,rm)+#define T1_ADD(rd,rn,rm) _jit_W(THUMB_ADD|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rd))+#define T1_ADDX(rdn,rm) _jit_W(THUMB_ADDX|((_u4(rdn)&8)<<4)|(_u4(rm)<<3)|(rdn&7))+#define T2_ADD(rd,rn,rm) torrr(THUMB2_ADD,rn,rd,rm)+#define _CC_ADDI(cc,rd,rn,im) corri(cc,ARM_ADD|ARM_I,rn,rd,im)+#define _ADDI(rd,rn,im) _CC_ADDI(ARM_CC_AL,rd,rn,im)+#define T1_ADDI3(rd,rn,im) _jit_W(THUMB_ADDI3|(_u3(im)<<6)|(_u3(rn)<<3)|_u3(rd))+#define T1_ADDI8(rdn,im) _jit_W(THUMB_ADDI8|(_u3(rdn)<<8)|_u8(im))+#define T2_ADDI(rd,rn,im) torri(THUMB2_ADDI,rn,rd,im)+#define T2_ADDWI(rd,rn,im) torri(THUMB2_ADDWI,rn,rd,im)+#define _CC_ADDS(cc,rd,rn,rm) corrr(cc,ARM_ADD|ARM_S,rn,rd,rm)+#define _ADDS(rd,rn,rm) _CC_ADDS(ARM_CC_AL,rd,rn,rm)+#define T2_ADDS(rd,rn,rm) torrr(THUMB2_ADD|ARM_S,rn,rd,rm)+#define _ADDSI(rd,rn,im) corri(ARM_CC_AL,ARM_ADD|ARM_S|ARM_I,rn,rd,im)+#define T2_ADDSI(rd,rn,im) torri(THUMB2_ADDI|ARM_S,rn,rd,im)+#define _CC_ADC(cc,rd,rn,rm) corrr(cc,ARM_ADC,rn,rd,rm)+#define _ADC(rd,rn,rm) _CC_ADC(ARM_CC_AL,rd,rn,rm)+#define T1_ADC(rdn,rm) _jit_W(THUMB_ADC|(_u3(rm)<<3)|_u3(rdn))+#define T2_ADC(rd,rn,rm) torrr(THUMB2_ADC,rn,rd,rm)+#define _CC_ADCI(cc,rd,rn,im) corri(cc,ARM_ADC|ARM_I,rn,rd,im)+#define _ADCI(rd,rn,im) _CC_ADCI(ARM_CC_AL,rd,rn,im)+#define T2_ADCI(rd,rn,im) torri(THUMB2_ADCI,rn,rd,im)+#define _CC_ADCS(cc,rd,rn,rm) corrr(cc,ARM_ADC|ARM_S,rn,rd,rm)+#define _ADCS(rd,rn,rm) _CC_ADCS(ARM_CC_AL,rd,rn,rm)+#define T2_ADCS(rd,rn,rm) torrr(THUMB2_ADC|ARM_S,rn,rd,rm)+#define _CC_ADCSI(cc,rd,rn,im) corri(cc,ARM_ADC|ARM_S|ARM_I,rn,rd,im)+#define _ADCSI(rd,rn,im) _CC_ADCSI(ARM_CC_AL,rd,rn,im)+#define T2_ADCSI(rd,rn,im) torri(THUMB2_ADCI|ARM_S,rn,rd,im)+#define _CC_SUB(cc,rd,rn,rm) corrr(cc,ARM_SUB,rn,rd,rm)+#define _SUB(rd,rn,rm) _CC_SUB(ARM_CC_AL,rd,rn,rm)+#define T1_SUB(rd,rn,rm) _jit_W(THUMB_SUB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rd))+#define T2_SUB(rd,rn,rm) torrr(THUMB2_SUB,rn,rd,rm)+#define _CC_SUBI(cc,rd,rn,im) corri(cc,ARM_SUB|ARM_I,rn,rd,im)+#define _SUBI(rd,rn,im) _CC_SUBI(ARM_CC_AL,rd,rn,im)+#define T1_SUBI3(rd,rn,im) _jit_W(THUMB_SUBI3|(_u3(im)<<6)|(_u3(rn)<<3)|_u3(rd))+#define T1_SUBI8(rdn,im) _jit_W(THUMB_SUBI8|(_u3(rdn)<<8)|_u8(im))+#define T2_SUBI(rd,rn,im) torri(THUMB2_SUBI,rn,rd,im)+#define T2_SUBWI(rd,rn,im) torri(THUMB2_SUBWI,rn,rd,im)+#define _CC_SUBS(cc,rd,rn,rm) corrr(cc,ARM_SUB|ARM_S,rn,rd,rm)+#define _SUBS(rd,rn,rm) _CC_SUBS(ARM_CC_AL,rd,rn,rm)+#define T2_SUBS(rd,rn,rm) torrr(THUMB2_SUB|ARM_S,rn,rd,rm)+#define _CC_SUBSI(cc,rd,rn,im) corri(cc,ARM_SUB|ARM_S|ARM_I,rn,rd,im)+#define _SUBSI(rd,rn,im) _CC_SUBSI(ARM_CC_AL,rd,rn,im)+#define T2_SUBSI(rd,rn,im) torri(THUMB2_SUBI|ARM_S,rn,rd,im)+#define _CC_SBC(cc,rd,rn,rm) corrr(cc,ARM_SBC,rn,rd,rm)+#define _SBC(rd,rn,rm) _CC_SBC(ARM_CC_AL,rd,rn,rm)+#define T1_SBC(rdn,rm) _jit_W(THUMB_SBC|(_u3(rm)<<3)|_u3(rdn))+#define T2_SBC(rd,rn,rm) torrr(THUMB2_SBC,rn,rd,rm)+#define _CC_SBCI(cc,rd,rn,im) corri(cc,ARM_SBC|ARM_I,rn,rd,im)+#define _SBCI(rd,rn,im) _CC_SBCI(ARM_CC_AL,rd,rn,im)+#define T2_SBCI(rd,rn,im) torri(THUMB2_SBCI,rn,rd,im)+#define _CC_SBCS(cc,rd,rn,rm) corrr(cc,ARM_SBC|ARM_S,rn,rd,rm)+#define _SBCS(rd,rn,rm) _CC_SBCS(ARM_CC_AL,rd,rn,rm)+#define T2_SBCS(rd,rn,rm) torrr(THUMB2_SBC|ARM_S,rn,rd,rm)+#define _CC_SBCSI(cc,rd,rn,im) corri(cc,ARM_SBC|ARM_S|ARM_I,rn,rd,im)+#define _SBCSI(rd,rn,im) _CC_SBCSI(ARM_CC_AL,rd,rn,im)+#define T2_SBCSI(rd,rn,im) torri(THUMB2_SBCI|ARM_S,rn,rd,im)+#define _CC_RSB(cc,rd,rn,rm) corrr(cc,ARM_RSB,rn,rd,rm)+#define _RSB(rd,rn,rm) _CC_RSB(ARM_CC_AL,rd,rn,rm)+#define T2_RSB(rd,rn,rm) torrr(THUMB2_RSB,rn,rd,rm)+#define _CC_RSBI(cc,rd,rn,im) corri(cc,ARM_RSB|ARM_I,rn,rd,im)+#define _RSBI(rd,rn,im) _CC_RSBI(ARM_CC_AL,rd,rn,im)+#define T1_RSBI(rd,rn) _jit_W(THUMB_RSBI|(_u3(rn)<<3)|_u3(rd))+#define T2_RSBI(rd,rn,im) torri(THUMB2_RSBI,rn,rd,im)++#define _CC_MUL(cc,rl,rn,rm) corrrr(cc,ARM_MUL,rl,0,rm,rn)+#define _MUL(rl,rn,rm) _CC_MUL(ARM_CC_AL,rl,rn,rm)+#define T1_MUL(rdm,rn) _jit_W(THUMB_MUL|(_u3(rn)<<3)|_u3(rdm))+#define T2_MUL(rd,rn,rm) torrr(THUMB2_MUL,rn,rd,rm)+#define _CC_SMULL(cc,rl,rh,rn,rm) corrrr(cc,ARM_SMULL,rh,rl,rm,rn)+#define _SMULL(rl,rh,rn,rm) _CC_SMULL(ARM_CC_AL,rl,rh,rn,rm)+#define T2_SMULL(rl,rh,rn,rm) torrrr(THUMB2_SMULL,rn,rl,rh,rm)+#define _CC_UMULL(cc,rl,rh,rn,rm) corrrr(cc,ARM_UMULL,rh,rl,rm,rn)+#define _UMULL(rl,rh,rn,rm) _CC_UMULL(ARM_CC_AL,rl,rh,rn,rm)+#define T2_UMULL(rl,rh,rn,rm) torrrr(THUMB2_UMULL,rn,rl,rh,rm)+#define T2_SDIV(rd,rn,rm) torrr(THUMB2_SDIV,rn,rd,rm)+#define T2_UDIV(rd,rn,rm) torrr(THUMB2_UDIV,rn,rd,rm)++#define _CC_AND(cc,rd,rn,rm) corrr(cc,ARM_AND,rn,rd,rm)+#define _AND(rd,rn,rm) _CC_AND(ARM_CC_AL,rd,rn,rm)+#define T1_AND(rdn,rm) _jit_W(THUMB_AND|(_u3(rm)<<3)|_u3(rdn))+#define T2_AND(rd,rn,rm) torrr(THUMB2_AND,rn,rd,rm)+#define _CC_ANDI(cc,rd,rn,im) corri(cc,ARM_AND|ARM_I,rn,rd,im)+#define _ANDI(rd,rn,im) _CC_ANDI(ARM_CC_AL,rd,rn,im)+#define T2_ANDI(rd,rn,im) torri(THUMB2_ANDI,rn,rd,im)+#define _CC_ANDS(cc,rd,rn,rm) corrr(cc,ARM_AND|ARM_S,rn,rd,rm)+#define _ANDS(rd,rn,rm) _CC_ANDS(ARM_CC_AL,rd,rn,rm)+#define T2_ANDS(rd,rn,rm) torrr(THUMB2_AND|ARM_S,rn,rd,rm)+#define _CC_ANDSI(cc,rd,rn,im) corri(cc,ARM_AND|ARM_S|ARM_I,rn,rd,im)+#define _ANDSI(rd,rn,im) _CC_ANDSI(ARM_CC_AL,rd,rn,im)+#define T2_ANDSI(rd,rn,im) torri(ARM_CC_AL,THUMB2_ANDI|ARM_S,rn,rd,im)+#define _CC_BIC(cc,rd,rn,rm) corrr(cc,ARM_BIC,rn,rd,rm)+#define _BIC(rd,rn,rm) _CC_BIC(ARM_CC_AL,rd,rn,rm)+#define T2_BIC(rd,rn,rm) torrr(THUMB2_BIC,rn,rd,rm)+#define _CC_BICI(cc,rd,rn,im) corri(cc,ARM_BIC|ARM_I,rn,rd,im)+#define _BICI(rd,rn,im) _CC_BICI(ARM_CC_AL,rd,rn,im)+#define T2_BICI(rd,rn,im) torri(THUMB2_BICI,rn,rd,im)+#define _CC_BICS(cc,rd,rn,rm) corrr(cc,ARM_BIC|ARM_S,rn,rd,rm)+#define _BICS(rd,rn,rm) _CC_BICS(ARM_CC_AL,rd,rn,rm)+#define T2_BICS(rd,rn,rm) torrr(THUMB2_BIC|ARM_S,rn,rd,rm)+#define _CC_BICSI(cc,rd,rn,im) corri(cc,ARM_BIC|ARM_S|ARM_I,rn,rd,im)+#define _BICSI(rd,rn,im) _CC_BICSI(ARM_CC_AL,rd,rn,im)+#define T2_BICSI(rd,rn,im) torri(ARM_CC_AL,THUMB2_BICI|ARM_S,rn,rd,im)+#define _CC_ORR(cc,rd,rn,rm) corrr(cc,ARM_ORR,rn,rd,rm)+#define _ORR(rd,rn,rm) _CC_ORR(ARM_CC_AL,rd,rn,rm)+#define T1_ORR(rdn,rm) _jit_W(THUMB_ORR|(_u3(rm)<<3)|_u3(rdn))+#define T2_ORR(rd,rn,rm) torrr(THUMB2_ORR,rn,rd,rm)+#define _CC_ORR_SI(cc,rd,rn,rm,sh,im) \+ corrrs(cc,ARM_ORR|sh,rn,rd,rm,im)+#define _ORR_SI(rd,rn,rm,sh,im) _CC_ORR_SI(ARM_CC_AL,rd,rn,rm,sh,im)+#define _CC_ORRI(cc,rd,rn,im) corri(cc,ARM_ORR|ARM_I,rn,rd,im)+#define _ORRI(rd,rn,im) _CC_ORRI(ARM_CC_AL,rd,rn,im)+#define T2_ORRI(rd,rn,im) torri(THUMB2_ORRI,rn,rd,im)+#define _CC_EOR(cc,rd,rn,rm) corrr(cc,ARM_EOR,rn,rd,rm)+#define _EOR(rd,rn,rm) _CC_EOR(ARM_CC_AL,rd,rn,rm)+#define T1_EOR(rdn,rm) _jit_W(THUMB_EOR|(_u3(rm)<<3)|_u3(rdn))+#define T2_EOR(rd,rn,rm) torrr(THUMB2_EOR,rn,rd,rm)+#define _CC_EOR_SI(cc,rd,rn,rm,sh,im) \+ corrrs(cc,ARM_EOR|sh,rn,rd,rm,im)+#define _EOR_SI(rd,rn,rm,sh,im) _CC_EOR_SI(ARM_CC_AL,rd,rn,rm,sh,im)+#define _CC_EORI(cc,rd,rn,im) corri(cc,ARM_EOR|ARM_I,rn,rd,im)+#define _EORI(rd,rn,im) _CC_EORI(ARM_CC_AL,rd,rn,im)+#define T2_EORI(rd,rn,im) torri(THUMB2_EORI,rn,rd,im)++#define _CC_REV(cc,rd,rm) c6orr(cc,ARM_REV,rd,rm)+#define _REV(rd,rm) _CC_REV(ARM_CC_AL,rd,rm)+#define T1_REV(rd,rm) _jit_W(THUMB_REV|(_u3(rm)<<3)|_u3(rd))+#define T2_REV(rd,rm) torrr(THUMB2_REV,rm,rd,rm)+#define _CC_REV16(cc,rd,rm) c6orr(cc,ARM_REV16,rd,rm)+#define _REV16(rd,rm) _CC_REV16(ARM_CC_AL,rd,rm)+#define T1_REV16(rd,rm) _jit_W(THUMB_REV16|(_u3(rm)<<3)|_u3(rd))+#define T2_REV16(rd,rm) torrr(THUMB2_REV16,rm,rd,rm)+#define _CC_SXTB(cc,rd,rm) c6orr(cc,ARM_SXTB,rd,rm)+#define _SXTB(rd,rm) _CC_SXTB(ARM_CC_AL,rd,rm)+#define T1_SXTB(rd,rm) _jit_W(THUMB_SXTB|(_u3(rm)<<3)|_u3(rd))+#define T2_SXTB(rd,rm) torrr(THUMB2_SXTB,_R15,rd,rm)+#define _CC_UXTB(cc,rd,rm) c6orr(cc,ARM_UXTB,rd,rm)+#define _UXTB(rd,rm) _CC_UXTB(ARM_CC_AL,rd,rm)+#define T1_UXTB(rd,rm) _jit_W(THUMB_UXTB|(_u3(rm)<<3)|_u3(rd))+#define T2_UXTB(rd,rm) torrr(THUMB2_UXTB,_R15,rd,rm)+#define _CC_SXTH(cc,rd,rm) c6orr(cc,ARM_SXTH,rd,rm)+#define _SXTH(rd,rm) _CC_SXTH(ARM_CC_AL,rd,rm)+#define T1_SXTH(rd,rm) _jit_W(THUMB_SXTH|(_u3(rm)<<3)|_u3(rd))+#define T2_SXTH(rd,rm) torrr(THUMB2_SXTH,_R15,rd,rm)+#define _CC_UXTH(cc,rd,rm) c6orr(cc,ARM_UXTH,rd,rm)+#define _UXTH(rd,rm) _CC_UXTH(ARM_CC_AL,rd,rm)+#define T1_UXTH(rd,rm) _jit_W(THUMB_UXTH|(_u3(rm)<<3)|_u3(rd))+#define T2_UXTH(rd,rm) torrr(THUMB2_UXTH,_R15,rd,rm)++#define _CC_SHIFT(cc,o,rd,rm,rn,im) cshift(cc,o,rd,rm,rn,im)+#define _CC_LSL(cc,rd,rn,rm) _CC_SHIFT(cc,ARM_LSL|ARM_R,rd,rm,rn,0)+#define _LSL(rd,rn,rm) _CC_LSL(ARM_CC_AL,rd,rn,rm)+#define T1_LSL(rdn,rm) _jit_W(THUMB_LSL|(_u3(rm)<<3)|_u3(rdn))+#define T2_LSL(rd,rn,rm) torrr(THUMB2_LSL,rn,rd,rm)+#define _CC_LSLI(cc,rd,rn,im) _CC_SHIFT(cc,ARM_LSL,rd,0,rn,im)+#define _LSLI(rd,rn,im) _CC_LSLI(ARM_CC_AL,rd,rn,im)+#define T1_LSLI(rd,rm,im) _jit_W(THUMB_LSLI|(_u5(im)<<6)|(_u3(rm)<<3)|_u3(rd))+#define T2_LSLI(rd,rm,im) tshift(THUMB2_LSLI,rd,rm,im)+#define _CC_LSR(cc,rd,rn,rm) _CC_SHIFT(cc,ARM_LSR|ARM_R,rd,rm,rn,0)+#define _LSR(rd,rn,rm) _CC_LSR(ARM_CC_AL,rd,rn,rm)+#define T1_LSR(rdn,rm) _jit_W(THUMB_LSR|(_u3(rm)<<3)|_u3(rdn))+#define T2_LSR(rd,rn,rm) torrr(THUMB2_LSR,rn,rd,rm)+#define _CC_LSRI(cc,rd,rn,im) _CC_SHIFT(cc,ARM_LSR,rd,0,rn,im)+#define _LSRI(rd,rn,im) _CC_LSRI(ARM_CC_AL,rd,rn,im)+#define T1_LSRI(rd,rm,im) _jit_W(THUMB_LSRI|(_u5(im)<<6)|(_u3(rm)<<3)|_u3(rd))+#define T2_LSRI(rd,rm,im) tshift(THUMB2_LSRI,rd,rm,im)+#define _CC_ASR(cc,rd,rn,rm) _CC_SHIFT(cc,ARM_ASR|ARM_R,rd,rm,rn,0)+#define _ASR(rd,rn,rm) _CC_ASR(ARM_CC_AL,rd,rn,rm)+#define T1_ASR(rdn,rm) _jit_W(THUMB_ASR|(_u3(rm)<<3)|_u3(rdn))+#define T2_ASR(rd,rn,rm) torrr(THUMB2_ASR,rn,rd,rm)+#define _CC_ASRI(cc,rd,rn,im) _CC_SHIFT(cc,ARM_ASR,rd,0,rn,im)+#define _ASRI(rd,rn,im) _CC_ASRI(ARM_CC_AL,rd,rn,im)+#define T1_ASRI(rd,rm,im) _jit_W(THUMB_ASRI|(_u5(im)<<6)|(_u3(rm)<<3)|_u3(rd))+#define T2_ASRI(rd,rm,im) tshift(THUMB2_ASRI,rd,rm,im)++#define _CC_CMP(cc,rn,rm) corrr(cc,ARM_CMP,rn,0,rm)+#define _CMP(rn,rm) _CC_CMP(ARM_CC_AL,rn,rm)+#define T1_CMP(rn,rm) _jit_W(THUMB_CMP|(_u3(rm)<<3)|_u3(rn))+#define T1_CMPX(rn,rm) _jit_W(THUMB_CMPX|((_u4(rn)&8)<<4)|(_u4(rm)<<3)|(rn&7))+#define T2_CMP(rn,rm) torrr(THUMB2_CMP,rn,_R15,rm)+#define _CC_CMPI(cc,rn,im) corri(cc,ARM_CMP|ARM_I,rn,0,im)+#define _CMPI(rn,im) _CC_CMPI(ARM_CC_AL,rn,im)+#define T1_CMPI(rn,im) _jit_W(THUMB_CMPI|(_u3(rn)<<8)|_u8(im))+#define T2_CMPI(rn,im) torri(THUMB2_CMPI,rn,_R15,im)+#define _CC_CMN(cc,rn,rm) corrr(cc,ARM_CMN,rn,0,rm)+#define _CMN(rn,rm) _CC_CMN(ARM_CC_AL,rn,rm)+#define T1_CMN(rn,rm) _jit_W(THUMB_CMN|(_u3(rm)<<3)|_u3(rm))+#define T2_CMN(rn,rm) torrr(THUMB2_CMN,rn,_R15,rm)+#define _CC_CMNI(cc,rn,im) corri(cc,ARM_CMN|ARM_I,rn,_R15,im)+#define _CMNI(rn,im) _CC_CMNI(ARM_CC_AL,rn,im)+#define T2_CMNI(rn,im) torri(THUMB2_CMNI,rn,_R15,im)+#define _CC_TST(cc,rn,rm) corrr(cc,ARM_TST,rn,r0,rm)+#define _TST(rn,rm) _CC_TST(ARM_CC_AL,rn,rm)+#define T1_TST(rn,rm) _jit_W(THUMB_TST|(_u3(rm)<<3)|_u3(rn))+#define T2_TST(rn,rm) torrr(THUMB2_TST,rn,_R15,rm)+#define _CC_TSTI(cc,rn,im) corri(cc,ARM_TST|ARM_I,rn,0,im)+#define _TSTI(rn,im) _CC_TSTI(ARM_CC_AL,rn,im)+#define T2_TSTI(rn,im) torri(THUMB2_TSTI,rn,_R15,im)+#define _CC_TEQ(cc,rn,rm) corrr(cc,ARM_TEQ,rn,0,rm)+#define _TEQ(rn,rm) _CC_TEQ(ARM_CC_AL,rn,rm)+#define _CC_TEQI(cc,rm,im) corri(cc,ARM_TEQ|ARM_I,rn,0,im)+#define _TEQI(rn,im) _CC_TEQI(ARM_CC_AL,rn,im)++#define _CC_BX(cc,rm) cbx(cc,ARM_BX,rm)+#define _BX(rm) _CC_BX(ARM_CC_AL,rm)+#define T1_BX(rm) _jit_W(0x4700|(_u4(rm)<<3))+#define _CC_BLX(cc,rm) cbx(cc,ARM_BLX,rm)+#define _BLX(rm) _CC_BLX(ARM_CC_AL,rm)+#define T1_BLX(rm) _jit_W(THUMB_BLX|(_u4(rm)<<3))+#define _BLXI(im) blxi(im)+#define T2_BLXI(im) tb(THUMB2_BLXI,im)+#define _CC_B(cc,im) cb(cc,ARM_B,im)+#define _B(im) _CC_B(ARM_CC_AL,im)+#define T1_CC_B(cc,im) tc8(cc,im)+#define T1_B(im) t11(im)+#define T2_CC_B(cc,im) tcb(cc,im)+#define T2_B(im) tb(THUMB2_B,im)+#define _CC_BLI(cc,im) cb(cc,ARM_BLI,im)+#define _BLI(im) _CC_BLI(ARM_CC_AL,im)+#define T2_BLI(im) tb(THUMB2_BLI,im)++#define _CC_LDRSB(cc,rt,rn,rm) corrr(cc,ARM_LDRSB|ARM_P,rn,rt,rm)+#define _LDRSB(rt,rn,rm) _CC_LDRSB(ARM_CC_AL,rt,rn,rm)+#define T1_LDRSB(rt,rn,rm) _jit_W(THUMB_LDRSB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_LDRSB(rt,rn,rm) torxr(THUMB2_LDRSB,rn,rt,rm)+#define _CC_LDRSBN(cc,rt,rn,rm) corrr(cc,ARM_LDRSB,rn,rt,rm)+#define _LDRSBN(rt,rn,rm) _CC_LDRSBN(ARM_CC_AL,rt,rn,rm)+#define _CC_LDRSBI(cc,rt,rn,im) corri8(cc,ARM_LDRSBI|ARM_P,rn,rt,im)+#define _LDRSBI(rt,rn,im) _CC_LDRSBI(ARM_CC_AL,rt,rn,im)+#define T2_LDRSBI(rt,rn,im) torri8(THUMB2_LDRSBI|THUMB2_U,rn,rt,im)+#define T2_LDRSBWI(rt,rn,im) torri12(THUMB2_LDRSBWI,rn,rt,im)+#define _CC_LDRSBIN(cc,rt,rn,im) corri8(cc,ARM_LDRSBI,rn,rt,im)+#define _LDRSBIN(rt,rn,im) _CC_LDRSBIN(ARM_CC_AL,rt,rn,im)+#define T2_LDRSBIN(rt,rn,im) torri8(THUMB2_LDRSBI,rn,rt,im)+#define _CC_LDRB(cc,rt,rn,rm) corrr(cc,ARM_LDRB|ARM_P,rn,rt,rm)+#define _LDRB(rt,rn,rm) _CC_LDRB(ARM_CC_AL,rt,rn,rm)+#define T1_LDRB(rt,rn,rm) _jit_W(THUMB_LDRB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_LDRB(rt,rn,rm) torxr(THUMB2_LDRB,rn,rt,rm)+#define _CC_LDRBN(cc,rt,rn,rm) corrr(cc,ARM_LDRB,rn,rt,rm)+#define _LDRBN(rt,rn,rm) _CC_LDRBN(ARM_CC_AL,rt,rn,rm)+#define _CC_LDRBI(cc,rt,rn,im) corri(cc,ARM_LDRBI|ARM_P,rn,rt,im)+#define _LDRBI(rt,rn,im) _CC_LDRBI(ARM_CC_AL,rt,rn,im)+#define T1_LDRBI(rt,rn,im) _jit_W(THUMB_LDRBI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_LDRBI(rt,rn,im) torri8(THUMB2_LDRBI|THUMB2_U,rn,rt,im)+#define T2_LDRBWI(rt,rn,im) torri12(THUMB2_LDRBWI,rn,rt,im)+#define _CC_LDRBIN(cc,rt,rn,im) corri(cc,ARM_LDRBI,rn,rt,im)+#define _LDRBIN(rt,rn,im) _CC_LDRBIN(ARM_CC_AL,rt,rn,im)+#define T2_LDRBIN(rt,rn,im) torri8(THUMB2_LDRBI,rn,rt,im)+#define _CC_LDRSH(cc,rt,rn,rm) corrr(cc,ARM_LDRSH|ARM_P,rn,rt,rm)+#define _LDRSH(rt,rn,rm) _CC_LDRSH(ARM_CC_AL,rt,rn,rm)+#define T1_LDRSH(rt,rn,rm) _jit_W(THUMB_LDRSH|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_LDRSH(rt,rn,rm) torxr(THUMB2_LDRSH,rn,rt,rm)+#define _CC_LDRSHN(cc,rt,rn,rm) corrr(cc,ARM_LDRSH,rn,rt,rm)+#define _LDRSHN(rt,rn,rm) _CC_LDRSHN(ARM_CC_AL,rt,rn,rm)+#define _CC_LDRSHI(cc,rt,rn,im) corri8(cc,ARM_LDRSHI|ARM_P,rn,rt,im)+#define _LDRSHI(rt,rn,im) _CC_LDRSHI(ARM_CC_AL,rt,rn,im)+#define T2_LDRSHI(rt,rn,im) torri8(THUMB2_LDRSHI|THUMB2_U,rn,rt,im)+#define T2_LDRSHWI(rt,rn,im) torri12(THUMB2_LDRSHWI,rn,rt,im)+#define _CC_LDRSHIN(cc,rt,rn,im) corri8(cc,ARM_LDRSHI,rn,rt,im)+#define _LDRSHIN(rt,rn,im) _CC_LDRSHIN(ARM_CC_AL,rt,rn,im)+#define T2_LDRSHIN(rt,rn,im) torri8(THUMB2_LDRSHI,rn,rt,im)+#define _CC_LDRH(cc,rt,rn,rm) corrr(cc,ARM_LDRH|ARM_P,rn,rt,rm)+#define _LDRH(rt,rn,rm) _CC_LDRH(ARM_CC_AL,rt,rn,rm)+#define T1_LDRH(rt,rn,rm) _jit_W(THUMB_LDRH|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_LDRH(rt,rn,rm) torxr(THUMB2_LDRH,rn,rt,rm)+#define _CC_LDRHN(cc,rt,rn,rm) corrr(cc,ARM_LDRH,rn,rt,rm)+#define _LDRHN(rt,rn,rm) CC_LDRHN(ARM_CC_AL,rt,rn,rm)+#define _CC_LDRHI(cc,rt,rn,im) corri8(cc,ARM_LDRHI|ARM_P,rn,rt,im)+#define _LDRHI(rt,rn,im) _CC_LDRHI(ARM_CC_AL,rt,rn,im)+#define T1_LDRHI(rt,rn,im) _jit_W(THUMB_LDRHI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_LDRHI(rt,rn,im) torri8(THUMB2_LDRHI|THUMB2_U,rn,rt,im)+#define T2_LDRHWI(rt,rn,im) torri12(THUMB2_LDRHWI,rn,rt,im)+#define _CC_LDRHIN(cc,rt,rn,im) corri8(cc,ARM_LDRHI,rn,rt,im)+#define _LDRHIN(rt,rn,im) _CC_LDRHIN(ARM_CC_AL,rt,rn,im)+#define T2_LDRHIN(rt,rn,im) torri8(THUMB2_LDRHI,rn,rt,im)+#define _CC_LDR(cc,rt,rn,rm) corrr(cc,ARM_LDR|ARM_P,rn,rt,rm)+#define _LDR(rt,rn,rm) _CC_LDR(ARM_CC_AL,rt,rn,rm)+#define T1_LDR(rt,rn,rm) _jit_W(THUMB_LDR|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_LDR(rt,rn,rm) torxr(THUMB2_LDR,rn,rt,rm)+#define _CC_LDRN(cc,rt,rn,rm) corrr(cc,ARM_LDR,rn,rt,rm)+#define _LDRN(rt,rn,rm) _CC_LDRN(ARM_CC_AL,rt,rn,rm)+#define _CC_LDRI(cc,rt,rn,im) corri(cc,ARM_LDRI|ARM_P,rn,rt,im)+#define _LDRI(rt,rn,im) _CC_LDRI(ARM_CC_AL,rt,rn,im)+#define T1_LDRI(rt,rn,im) _jit_W(THUMB_LDRI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T1_LDRISP(rt,im) _jit_W(THUMB_LDRISP|(_u3(rt)<<8)|_u8(im))+#define T2_LDRI(rt,rn,im) torri8(THUMB2_LDRI|THUMB2_U,rn,rt,im)+#define T2_LDRWI(rt,rn,im) torri12(THUMB2_LDRWI,rn,rt,im)+#define _CC_LDRIN(cc,rt,rn,im) corri(cc,ARM_LDRI,rn,rt,im)+#define _LDRIN(rt,rn,im) _CC_LDRIN(ARM_CC_AL,rt,rn,im)+#define T2_LDRIN(rt,rn,im) torri8(THUMB2_LDRI,rn,rt,im)+#define _CC_LDRD(cc,rt,rn,rm) corrr(cc,ARM_LDRD|ARM_P,rn,rt,rm)+#define _LDRD(rt,rn,rm) _CC_LDRD(ARM_CC_AL,rt,rn,rm)+#define _CC_LDRDN(cc,rt,rn,rm) corrr(cc,ARM_LDRD,rn,rt,rm)+#define _LDRDN(rd,rn,rm) _CC_LDRDN(ARM_CC_AL,rn,rt,rm)+#define _CC_LDRDI(cc,rt,rn,im) corri8(cc,ARM_LDRDI|ARM_P,rn,rt,im)+#define _LDRDI(rt,rn,im) _CC_LDRDI(ARM_CC_AL,rn,rt,im)+#define T2_LDRDI(rt,rt2,rn,im) torrri8(THUMB2_LDRDI|ARM_P,rn,rt,rt2,im)+#define _CC_LDRDIN(cc,rt,rn,im) corri8(cc,ARM_LDRDI,rn,rt,im)+#define _LDRDIN(rt,rn,im) _CC_LDRDIN(ARM_CC_AL,rt,rn,im)+#define T2_LDRDIN(rt,rt2,rn,im) torrri8(THUMB2_LDRDI,rn,rt,rt2,im)+#define _CC_STRB(cc,rt,rn,rm) corrr(cc,ARM_STRB|ARM_P,rn,rt,rm)+#define _STRB(rt,rn,rm) _CC_STRB(ARM_CC_AL,rt,rn,rm)+#define T1_STRB(rt,rn,rm) _jit_W(THUMB_STRB|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_STRB(rt,rn,rm) torxr(THUMB2_STRB,rn,rt,rm)+#define _CC_STRBN(cc,rt,rn,rm) corrr(cc,ARM_STRB,rn,rt,rm)+#define _STRBN(rt,rn,rm) _CC_STRBN(ARM_CC_AL,rt,rn,rm)+#define _CC_STRBI(cc,rt,rn,im) corri(cc,ARM_STRBI|ARM_P,rn,rt,im)+#define _STRBI(rt,rn,im) _CC_STRBI(ARM_CC_AL,rt,rn,im)+#define T1_STRBI(rt,rn,im) _jit_W(THUMB_STRBI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_STRBI(rt,rn,im) torri8(THUMB2_STRBI|THUMB2_U,rn,rt,im)+#define T2_STRBWI(rt,rn,im) torri12(THUMB2_STRBWI,rn,rt,im)+#define _CC_STRBIN(cc,rt,rn,im) corri(cc,ARM_STRBI,rn,rt,im)+#define _STRBIN(rt,rn,im) _CC_STRBIN(ARM_CC_AL,rt,rn,im)+#define T2_STRBIN(rt,rn,im) torri8(THUMB2_STRBI,rn,rt,im)+#define _CC_STRH(cc,rt,rn,rm) corrr(cc,ARM_STRH|ARM_P,rn,rt,rm)+#define _STRH(rt,rn,rm) _CC_STRH(ARM_CC_AL,rt,rn,rm)+#define T1_STRH(rt,rn,rm) _jit_W(THUMB_STRH|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_STRH(rt,rn,rm) torxr(THUMB2_STRH,rn,rt,rm)+#define _CC_STRHN(cc,rt,rn,rm) corrr(cc,ARM_STRH,rn,rt,rm)+#define _STRHN(rt,rn,rm) _CC_STRHN(ARM_CC_AL,rt,rn,rm)+#define _CC_STRHI(cc,rt,rn,im) corri8(cc,ARM_STRHI|ARM_P,rn,rt,im)+#define _STRHI(rt,rn,im) _CC_STRHI(ARM_CC_AL,rt,rn,im)+#define T1_STRHI(rt,rn,im) _jit_W(THUMB_STRHI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_STRHI(rt,rn,im) torri8(THUMB2_STRHI|THUMB2_U,rn,rt,im)+#define T2_STRHWI(rt,rn,im) torri12(THUMB2_STRHWI,rn,rt,im)+#define _CC_STRHIN(cc,rt,rn,im) corri8(cc,ARM_STRHI,rn,rt,im)+#define _STRHIN(rt,rn,im) _CC_STRHIN(ARM_CC_AL,rt,rn,im)+#define T2_STRHIN(rt,rn,im) torri8(THUMB2_STRHI,rn,rt,im)+#define _CC_STR(cc,rt,rn,rm) corrr(cc,ARM_STR|ARM_P,rn,rt,rm)+#define _STR(rt,rn,rm) _CC_STR(ARM_CC_AL,rt,rn,rm)+#define T1_STR(rt,rn,rm) _jit_W(THUMB_STR|(_u3(rm)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T2_STR(rt,rn,rm) torxr(THUMB2_STR,rn,rt,rm)+#define _CC_STRN(cc,rt,rn,rm) corrr(cc,ARM_STR,rn,rt,rm)+#define _STRN(rt,rn,rm) _CC_STRN(ARM_CC_AL,rt,rn,rm)+#define _CC_STRI(cc,rt,rn,im) corri(cc,ARM_STRI|ARM_P,rn,rt,im)+#define _STRI(rt,rn,im) _CC_STRI(ARM_CC_AL,rt,rn,im)+#define T1_STRI(rt,rn,im) _jit_W(THUMB_STRI|(_u5(im)<<6)|(_u3(rn)<<3)|_u3(rt))+#define T1_STRISP(rt,im) _jit_W(THUMB_STRISP|(_u3(rt)<<8)|(_u8(im)))+#define T2_STRI(rt,rn,im) torri8(THUMB2_STRI|THUMB2_U,rn,rt,im)+#define T2_STRWI(rt,rn,im) torri12(THUMB2_STRWI,rn,rt,im)+#define _CC_STRIN(cc,rt,rn,im) corri(cc,ARM_STRI,rn,rt,im)+#define _STRIN(rt,rn,im) _CC_STRIN(ARM_CC_AL,rt,rn,im)+#define T2_STRIN(rt,rn,im) torri8(THUMB2_STRI,rn,rt,im)+#define _CC_STRD(cc,rt,rn,rm) corrr(cc,ARM_STRD|ARM_P,rt,rn,rm)+#define _STRD(rt,rn,rm) _CC_STRD(ARM_CC_AL,rt,rn,rm)+#define _CC_STRDN(cc,rt,rn,rm) corrr(cc,ARM_STRD,rn,rt,rm)+#define _STRDN(rt,rn,rm) _CC_STRDN(ARM_CC_AL,rt,rn,rm)+#define _CC_STRDI(cc,rt,rn,im) corri8(cc,ARM_STRDI|ARM_P,rn,rt,im)+#define _STRDI(rt,rn,im) _CC_STRDI(ARM_CC_AL,rt,rn,im)+#define T2_STRDI(rt,rt2,rn,im) torrri8(THUMB2_STRDI|ARM_P,rn,rt,rt2,im)+#define _CC_STRDIN(cc,rt,rn,im) corri8(cc,ARM_STRDI,rn,rt,im)+#define _STRDIN(rt,rn,im) _CC_STRDIN(ARM_CC_AL,rt,rn,im)+#define T2_STRDIN(rt,rt2,rn,im) torrri8(THUMB2_STRDI,rn,rt,rt2,im)++#define _CC_LDMIA(cc,rn,im) corl(cc,ARM_M|ARM_M_L|ARM_M_I,rn,im)+#define _LDMIA(rn,im) _CC_LDMIA(ARM_CC_AL,rn,im)+#define _CC_LDM(cc,rn,im) _CC_LDMIA(cc,rn,im)+#define _LDM(rn,im) _LDMIA(rn,im)+#define T1_LDMIA(rn,im) _jit_W(THUMB_LDMIA|(_u3(rn)<<8)|im)+#define T2_LDMIA(rn,im) torl(THUMB2_LDMIA,rn,im)+#define _CC_LDMIA_U(cc,rn,im) corl(cc,ARM_M|ARM_M_L|ARM_M_I|ARM_M_U,rn,im)+#define _LDMIA_U(rn,im) _CC_LDMIA_U(ARM_CC_AL,rn,im)+#define _LDM_U(r0,i0) _LDMIA_U(r0,i0)+#define _CC_LDMIB(cc,rn,im) corl(cc,ARM_M|ARM_M_L|ARM_M_I|ARM_M_B,rn,im)+#define _LDMIB(rn,im) _CC_LDMIB(ARM_CC_AL,rn,im)+#define _CC_LDMIB_U(cc,rn,im) corl(cc,ARM_M|ARM_M_L|ARM_M_I|ARM_M_B|ARM_M_U,rn,im)+#define _LDMIB_U(rn,im) _CC_LDMIB_U(ARM_CC_AL,rn,im)+#define _CC_LDMDA(cc,rn,im) corl(cc,ARM_M|ARM_M_L,rn,im)+#define _LDMDA(rn,im) _CC_LDMDA(ARM_CC_AL,rn,im)+#define _CC_LDMDA_U(cc,rn,im) corl(cc,ARM_M|ARM_M_L|ARM_M_U,rn,im)+#define _LDMDA_U(rn,im) _CC_LDMDA_U(ARM_CC_AL,rn,im)+#define _CC_LDMDB(cc,rn,im) corl(cc,ARM_M|ARM_M_L|ARM_M_B,rn,im)+#define _LDMDB(rn,im) _CC_LDMDB(ARM_CC_AL,rn,im)+# define T2_LDMDB(rn,im) torl(THUMB2_LDMDB,rn,im)++#define _CC_LDMDB_U(cc,rn,im) corl(cc,ARM_M|ARM_M_L|ARM_M_B|ARM_M_U,rn,im)+#define _LDMDB_U(rn,im) _CC_LDMDB_U(ARM_CC_AL,rn,im)+#define _CC_STMIA(cc,rn,im) corl(cc,ARM_M|ARM_M_I,rn,im)+#define _STMIA(rn,im) _CC_STMIA(ARM_CC_AL,rn,im)+#define _CC_STM(cc,rn,im) _CC_STMIA(cc,rn,im)+#define _STM(rn,im) _STMIA(rn,im)+#define _CC_STMIA_U(cc,rn,im) corl(cc,ARM_M|ARM_M_I|ARM_M_U,rn,im)+#define _STMIA_U(rn,im) _CC_STMIA_U(ARM_CC_AL,rn,im)+#define _CC_STM_U(cc,rn,im) _CC_STMIA_U(cc,rn,im)+#define _STM_U(rn,im) _STMIA_U(rn,im)+#define _CC_STMIB(cc,rn,im) corl(cc,ARM_M|ARM_M_I|ARM_M_B,rn,im)+#define _STMIB(rn,im) _CC_STMIB(ARM_CC_AL,rn,im)+#define _CC_STMIB_U(cc,rn,im) corl(cc,ARM_M|ARM_M_I|ARM_M_B|ARM_M_U,rn,im)+#define _STMIB_U(rn,im) _CC_STMIB_U(ARM_CC_AL,rn,im)+#define _CC_STMDA(cc,rn,im) corl(cc,ARM_M,rn,im)+#define _STMDA(rn,im) _CC_STMDA(ARM_CC_AL,rn,im)+#define _CC_STMDA_U(cc,rn,im) corl(cc,ARM_M|ARM_M_U,rn,im)+#define _STMDA_U(rn,im) _CC_STMDA_U(ARM_CC_AL,rn,im)+#define _CC_STMDB(cc,rn,im) corl(cc,ARM_M|ARM_M_B,rn,im)+#define _STMDB(rn,im) _CC_STMDB(ARM_CC_AL,rn,im)+#define _CC_STMDB_U(cc,rn,im) corl(cc,ARM_M|ARM_M_B|ARM_M_U,rn,im)+#define _STMDB_U(rn,im) _CC_STMDB_U(ARM_CC_AL,rn,im)+#define _CC_PUSH(cc,im) _CC_STMDB_U(cc,JIT_SP,im)+#define _PUSH(im) _STMDB_U(JIT_SP,im)+#define T1_PUSH(im) _jit_W(THUMB_PUSH|((im&0x4000)>>6)|(im&0xff))+#define T2_PUSH(im) tpp(THUMB2_PUSH,im)+#define _CC_POP(cc,im) _LDMIA_U(cc,JIT_SP,im)+#define _POP(im) _LDMIA_U(JIT_SP,im)+#define T1_POP(im) _jit_W(THUMB_POP|((im&0x8000)>>7)|(im&0xff))+#define T2_POP(im) tpp(THUMB2_POP,im)++#define _CC_PKHBTI(cc,rd,rn,rm,im) arm_cc_pkh(cc,ARM_PKH,rn,rd,rm,im)+#define _CC_PKHTBI(cc,rd,rn,rm,im) arm_cc_pkh(cc,ARM_PKH|ARM_ASR,rn,rd,rm,im)+#define _PKHBTI(rd,rn,rm,im) _CC_PKHBTI(ARM_CC_AL,rd,rn,rm,im)+#define _PKHTBI(rd,rn,rm,im) _CC_PKHTBI(ARM_CC_AL,rd,rn,rm,im)+#define _PKHBT(rd,rn,rm) _CC_PKHBTI(ARM_CC_AL,rd,rn,rm,0)+#define _PKHTB(rd,rn,rm) _CC_PKHTBI(ARM_CC_AL,rd,rn,rm,0)++static int+encode_thumb_immediate(unsigned int v)+{+ int i;+ unsigned int m;+ unsigned int n;+ /* 00000000 00000000 00000000 abcdefgh */+ if ((v & 0xff) == v)+ return (v);+ /* 00000000 abcdefgh 00000000 abcdefgh */+ if ((v & 0xff00ff) == v && ((v & 0xff0000) >> 16) == (v & 0xff))+ return ((v & 0xff) | (1 << 12));+ /* abcdefgh 00000000 abcdefgh 00000000 */+ if (((v & 0xffff0000) >> 16) == (v & 0xffff) && (v & 0xff) == 0)+ return ((v & 0x000000ff) | (2 << 12));+ /* abcdefgh abcdefgh abcdefgh abcdefgh */+ if ( (v & 0xff) == ((v & 0xff00) >> 8) &&+ ((v & 0xff00) >> 8) == ((v & 0xff0000) >> 16) &&+ ((v & 0xff0000) << 8) == (v & 0xff000000))+ return ((v & 0xff) | (3 << 12));+ /* 1bcdefgh << 24 ... 1bcdefgh << 1 */+ for (i = 8, m = 0xff000000, n = 0x80000000;+ i < 23; i++, m >>= 1, n >>= 1) {+ if ((v & m) == v && (v & n)) {+ v >>= 32 - i;+ if (!(i & 1))+ v &= 0x7f;+ i >>= 1;+ return (((i & 7) << 12) | ((i & 8) << 23) | v);+ }+ }+ return (-1);+}++static int+encode_thumb_word_immediate(unsigned int v)+{+ if ((v & 0xfffff000) == 0)+ return (((v & 0x800) << 15) | ((v & 0x700) << 4) | (v & 0xff));+ return (-1);+}++static int+encode_thumb_jump(int v)+{+ int s, i1, i2, j1, j2;+ if (v >= (int)-0x800000 && v <= 0x7fffff) {+ s = !!(v & 0x800000);+ i1 = !!(v & 0x400000);+ i2 = !!(v & 0x200000);+ j1 = s ? i1 : !i1;+ j2 = s ? i2 : !i2;+ return ((s<<26)|((v&0x1ff800)<<5)|(j1<<13)|(j2<<11)|(v&0x7ff));+ }+ return (-1);+}++static int+encode_thumb_cc_jump(int v)+{+ int s, j1, j2;+ if (v >= (int)-0x80000 && v <= 0x7ffff) {+ s = !!(v & 0x80000);+ j1 = !!(v & 0x20000);+ j2 = !!(v & 0x40000);+ return ((s<<26)|((v&0x1f800)<<5)|(j1<<13)|(j2<<11)|(v&0x7ff));+ }+ return (-1);+}++#if !NAN_TO_INT_IS_ZERO+static int+encode_thumb_shift(int v, int type)+{+ switch (type) {+ case ARM_ASR:+ case ARM_LSL:+ case ARM_LSR: type >>= 1; break;+ default: assert(!"handled shift");+ }+ assert(v >= 0 && v <= 31);+ return (((v & 0x1c) << 10) | ((v & 3) << 6) | type);+}+#endif++#define thumb2_orri(o,rn,rd,im) torri(o,rn,rd,im)+#define torri(o,rn,rd,im) \+ (assert(!((o) & 0x0c0f7fff) && !((im) & 0xfbff8f00)), \+ _jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rd)<<8)|(im)), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define torri8(o,rn,rt,im) \+ (assert(!((o) & 0x000ff0ff) && !((im) & 0xffffff00)), \+ _jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rt)<<12)|im), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define torri12(o,rn,rt,im) \+ (assert(!((o) & 0x000fffff) && !((im) & 0xfffff000)), \+ _jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rt)<<12)|(im)), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define toriw(o,rd,im) \+ (assert(!((o) & 0x40f7fff) && !((im) & 0xffff0000)), \+ _jitl.thumb.i = ((o)|(((im)&0xf000)<<4)|(((im)&0x800)<<15)|(((im)&0x700)<<4)|(_u4(rd)<<8)|((im)&0xff)), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define torrr(o,rn,rd,rm) \+ (assert(!((o) & 0xf0f0f)), \+ _jit.jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rd)<<8)|_u4(rm)), \+ _jit_WW(_jit.jitl.thumb.s[0], _jit.jitl.thumb.s[1]))++#define torrrs(o,rn,rd,rm,im) \+ (assert(!((o) & 0x000f0f0f) && !((im) & 0xffff8f0f)), \+ _jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rd)<<8)|(im)|_u4(rm)), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define torxr(o,rn,rt,rm) \+ (assert(!((o) & 0xf0f0f)), \+ _jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rt)<<12)|_u4(rm)) \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define torrrr(o,rn,rl,rh,rm) \+ (assert(!((o) & 0x000fff0f)), \+ _jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rl)<<12)|(_u4(rh)<<8)|_u4(rm)), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define torrri8(o,rn,rt,rt2,im) \+ (assert(!((o) & 0x000fffff) && !((im) & 0xffffff00)), \+ _jitl.thumb.i = ((o)|(_u4(rn)<<16)|(_u4(rt)<<12)|(_u4(rt2)<<8)|(im)), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define tc8(cc,im) \+ (assert(!((cc) & 0x0fffffff) && ((cc) != ARM_CC_AL) && ((cc) != ARM_CC_NV) && _s8P(im)), \+ _jit_W(THUMB_CC_B|((cc)>>20)|((im)&0xff)))++#define t11(im) \+ (assert(!((im) & 0xfffff800)), \+ _jit_W(THUMB_B|(im)))++#define tcb(cc,im) \+ (assert(!((cc) & 0xfffffff) && ((cc) != ARM_CC_AL) && ((cc) != ARM_CC_NV) && !((im) & (THUMB2_CC_B|(((unsigned)cc) >> 6)))), \+ _jitl.thumb.i = THUMB2_CC_B|(((unsigned)(cc)) >> 6)|(im), \+ _jit_WW(_jitl.thumb.s[0], _jitl.thumb.s[1]))++#define blxi(im) \+ (assert(!((im) & 0xfe000000)), \+ _jit_I(ARM_BLXI|(im)))++#define tb(o,im) \+ (assert(!((o) & 0x07ff2fff) && !((o) & (im))), \+ jitl.thumb.i = (o)|(im), \+ _jit_WW(thumb.s[0], thumb.s[1]))++#define tshift(o,rd,rm,im) \+ (assert(!((o) & 0x7fcf) && ((im) >= 0) && ((im) < 32)), \+ thumb.i = (o|(((im)&0x1c)<<10)|(_u4(rd)<<8)|(((im)&3)<<6)|_u4(rm)), \+ _jit_WW(thumb.s[0], thumb.s[1]))++#define thumb2_orrr(o,rn,rd,rm) \+ (assert(!((o) & 0x000f0f0f)), \+ thumb.i = (o) | (_u4(rn)<<16) | (_u4(rd)<<8) | _u4(rm), \+ _jit_WW(thumb.s[0], thumb.s[1]))++#define thumb2_bfx(o,rn,rd,lsb,width) \+ (assert(!((o) & 0x7fdf) && ((lsb) >= 0) && ((lsb) < 32) && ((width) >= 0) && ((width) <= 32)), \+ thumb.i = (o) | (_u4(rn) << 16) | (_u4(rd) << 8) | \+ (((((lsb) + (width) > 31) ? 31 : (lsb) + (width)) & 7) << 10) | \+ (((((lsb) + (width) > 31) ? 31 : (lsb) + (width)) & 3) << 5) | \+ (((lsb) + (width) > 31) ? 31 : (lsb) + (width)), \+ _jit_WW(thumb.s[0], thumb.s[1]))++#define thumb2_cbxz(o,rn,im) \+ (assert(!((o) & 0x2ff) && (im) >= 0 && (im) < 128 && !((im) & 1)), \+ _jit_W((o)|((((im) >> 1)&0x80)<<5)|((((im) >> 1)&0x1f)<<3)|_u3(rn)))++#define thumb2_dbg(h,l,im) \+ (assert(!((h) & ~0xffff) && !((l) & 0xffff000f)), \+ _jit_WW((h), (l) | _u4(im)))++#define tpp(o,im) \+ (assert(!((o) & 0x0000ffff) && !((im) & 0xffff2000) && \+ (!((o) == THUMB2_PUSH) || !((im) & 0x8000)) && \+ (__builtin_popcount((im) & 0x1fff) > 1)), \+ _jit.jitl.thumb.i = (o)|(im), \+ _jit_WW(_jit.jitl.thumb.s[0], _jit.jitl.thumb.s[1]))++#define THUMB2_IT 0+#define THUMB2_ITT 1+#define THUMB2_ITE 2+#define THUMB2_ITTT 3+#define THUMB2_ITET 4+#define THUMB2_ITTE 5+#define THUMB2_ITEE 6+#define THUMB2_ITTTT 7+#define THUMB2_ITETT 8+#define THUMB2_ITTET 9+#define THUMB2_ITEET 10+#define THUMB2_ITTTE 11+#define THUMB2_ITETE 12+#define THUMB2_ITTEE 13+#define THUMB2_ITEEE 14+#define tcit(tc,it) \+ (assert(!(tc & 0xfffffff) && tc != ARM_CC_NV), \+ _jit_W(0xbf00 | (tc >> 24) | \+ ((it == THUMB2_IT) ? 1<<3 : \+ (it == THUMB2_ITT) ? ((((tc) >> 28) & 1)<<3)| (1<<2) : \+ (it == THUMB2_ITE) ? (!(((tc) >> 28) & 1)<<3)| (1<<2) : \+ (it == THUMB2_ITTT) ? ((((tc) >> 28) & 1)<<3)| ((((tc) >> 28) & 1)<<2)| (1<<1) : \+ (it == THUMB2_ITET) ? (!(((tc) >> 28) & 1)<<3)| ((((tc) >> 28) & 1)<<2)| (1<<1) : \+ (it == THUMB2_ITTE) ? ((((tc) >> 28) & 1)<<3)|(!(((tc) >> 28) & 1)<<2)| (1<<1) : \+ (it == THUMB2_ITEE) ? (!(((tc) >> 28) & 1)<<3)|(!(((tc) >> 28) & 1)<<2)| (1<<1) : \+ (it == THUMB2_ITTTT) ? ((((tc) >> 28) & 1)<<3)| ((((tc) >> 28) & 1)<<2)| ((((tc) >> 28) & 1)<<1)|1 : \+ (it == THUMB2_ITETT) ? (!(((tc) >> 28) & 1)<<3)| ((((tc) >> 28) & 1)<<2)| ((((tc) >> 28) & 1)<<1)|1 : \+ (it == THUMB2_ITTET) ? ((((tc) >> 28) & 1)<<3)|(!(((tc) >> 28) & 1)<<2)| ((((tc) >> 28) & 1)<<1)|1 : \+ (it == THUMB2_ITEET) ? (!(((tc) >> 28) & 1)<<3)|(!(((tc) >> 28) & 1)<<2)| ((((tc) >> 28) & 1)<<1)|1 : \+ (it == THUMB2_ITTTE) ? ((((tc) >> 28) & 1)<<3)| ((((tc) >> 28) & 1)<<2)|(!(((tc) >> 28) & 1)<<1)|1 : \+ (it == THUMB2_ITETE) ? (!(((tc) >> 28) & 1)<<3)| ((((tc) >> 28) & 1)<<2)|(!(((tc) >> 28) & 1)<<1)|1 : \+ (it == THUMB2_ITTEE) ? ((((tc) >> 28) & 1)<<3)|(!(((tc) >> 28) & 1)<<2)|(!(((tc) >> 28) & 1)<<1)|1 : \+ (it == THUMB2_ITEEE) ? (!(((tc) >> 28) & 1)<<3)|(!(((tc) >> 28) & 1)<<2)|(!(((tc) >> 28) & 1)<<1)|1 : \+ assert(!"valid it code"))))++#define _IT(cc) tcit(cc,THUMB2_IT)+#define _ITT(cc) tcit(cc,THUMB2_ITT)+#define _ITE(cc) tcit(cc,THUMB2_ITE)+#define _ITTT(cc) tcit(cc,THUMB2_ITTT)+#define _ITTE(cc) tcit(cc,THUMB2_ITTE)+#define _ITET(cc) tcit(cc,THUMB2_ITET)+#define _ITEE(cc) tcit(cc,THUMB2_ITEE)+#define _ITTTT(cc) tcit(cc,THUMB2_ITTTT)+#define _ITETT(cc) tcit(cc,THUMB2_ITETT)+#define _ITTET(cc) tcit(cc,THUMB2_ITTET)+#define _ITEET(cc) tcit(cc,THUMB2_ITEET)+#define _ITTTE(cc) tcit(cc,THUMB2_ITTTE)+#define _ITETE(cc) tcit(cc,THUMB2_ITETE)+#define _ITTEE(cc) tcit(cc,THUMB2_ITTEE)+#define _ITEEE(cc) tcit(cc,THUMB2_ITEEE)++#define torl(o,rn,im) \+ (assert(!((o) & 0xf1fff) && \+ ((rn) != _R15 || !(im) || (((o) & 0xc000) == 0xc000)) && \+ !((o) & THUMB2_LDM_W) || !((im) & (1 << (rn)))), \+ thumb.i = ((o) | (_u4(rn)<<16) | _u13(im)), \+ _jit_WW(thumb.s[0], thumb.s[1]))++#define thumb2_mrrc(o,t2,t,cc,o1,m) \+ (assert(!((o) & 0x03afffff)), \+ thumb.i = ((o)|(_u4(t2)<<16)|(_u4(t)<<12)|(_u4(cc)<<8)|(_u4(o1)<<4)|_u4(m)), \+ _jit_WW(thumb.s[0], thumb.s[1]))++#define thumb2_pkh(o,rn,rd,rm,im) \+ (assert(!((o) & 0x7ffcf)), \+ thumb.i = ((o)|(_u4(rn)<<16)|((_u5(im)&0x1c)<<10)| \+ (_u4(rd)<<12)|(((im)&3)<<6)|_u4(rm)), \+ _jit_WW(thumb.s[0], thumb.s[1]))++/* v6T2, v7 */+#define THUMB2_BFX 0xf3600000+#define T2_BFC(rd,lsb,width) thumb2_bfx(THUMB2_BFX,_R15,rd,lsb,width)+#define T2_BFI(rd,rn,lsb,width) thumb2_bfx(THUMB2_BFX,rn,rd,lsb,width)+/* not permitted in IT block */+#define THUMB2_CBZ 0xb100+#define T2_CBZ(rn,im) thumb2_cbxz(THUMB2_CBZ,rn,im)+#define THUMB2_CBNZ 0xb900+#define T2_CBNZ(rn,im) thumb2_cbxz(THUMB2_CBNZ,rn,im)+/* CDP/CDP2 here - same encoding as arm, but can start at "&3 == 2 offset" */+#define THUMB2_CLZ 0xfab0f080+#define T2_CLZ(rd,rm) thumb2_orrr(THUMB2_CLZ,rd,rm,rm)++#endif /* __lightning_asm_h */
@@ -0,0 +1,2163 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer (arm version)+ *+ ***********************************************************************/++/***********************************************************************+ *+ * Copyright 2011 Free Software Foundation, Inc.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ *+ * GNU lightning is distributed in the hope that it will be useful, but+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ *+ * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ * Authors:+ * Paulo Cesar Pereira de Andrade+ ***********************************************************************/++#ifndef __lightning_core_arm_h+#define __lightning_core_arm_h++typedef unsigned char _uc, jit_insn;++struct {+ _ui version : 4;+ _ui extend : 1;+ /* only generate thumb instructions for thumb2 */+ _ui thumb : 1;+ _ui vfp : 3;+ _ui neon : 1;+ _ui abi : 2;+} jit_cpu;+struct {+ /* prevent using thumb instructions that set flags? */+ _ui no_set_flags : 1;+} jit_flags;++struct jit_local_state {+ int framesize;+ int nextarg_get;+ int nextarg_put;+ int nextarg_getf;+ int alloca_offset;+ int stack_length;+ int stack_offset;+ void *stack;+ jit_thumb_t thumb;+ jit_insn* thumb_pc;+ jit_insn* thumb_tmp;+ int tmp;+ /* hackish mostly to make test cases work; use arm instruction+ * set in jmpi if did not yet see a prolog */+ int after_prolog;+ void *arguments[256];+ int types[8];+#ifdef JIT_NEED_PUSH_POP+ /* minor support for unsupported code but that exists in test cases... */+ int push[32];+ int pop;+#endif+};++#define JIT_R_NUM 4+static const jit_gpr_t+jit_r_order[JIT_R_NUM] = {+ _R0, _R1, _R2, _R3+};+#define JIT_R(i) jit_r_order[i]++#define JIT_V_NUM 4+static const jit_gpr_t+jit_v_order[JIT_V_NUM] = {+ _R4, _R5, _R6, _R7+};+#define JIT_V(i) jit_v_order[i]++#define JIT_FRAMESIZE 48++#define jit_no_set_flags() jit_flags.no_set_flags+#define jit_thumb_p() jit_cpu.thumb+#define jit_armv5_p() (jit_cpu.version >= 5)+#define jit_armv5e_p() (jit_cpu.version >= 5 && jit_cpu.extend)+#define jit_armv7r_p() 0+#define jit_swf_p() (jit_cpu.vfp == 0)+#define jit_hardfp_p() jit_cpu.abi++#define __jit_inline static++#ifdef USE_THUMB_CODE+#define jit_nop(n) \+{ \+ assert(n >= 0); \+ for (; n > 0; n -= 2) \+ T1_NOP(); \+}+#else+#define jit_nop(n) \+{ \+ assert(n >= 0); \+ for (; n > 0; n -= 4) \+ _NOP(); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_movr_i(r0, r1) \+{ \+ if (r0 != r1) { \+ T1_MOV(r0, r1); \+ } \+}+#else+#define jit_movr_i(r0, r1) \+{ \+ if (r0 != r1) { \+ _MOV(r0, r1); \+ } \+}+#endif++#define jit_movi_i(r0, i0) \+ ((!jit_no_set_flags() && r0 < 8 && !(i0 & 0xffffff80)) ? \+ T1_MOVI(r0, i0) : \+ ((_jitl.tmp = encode_thumb_immediate(i0)) != -1) ? \+ T2_MOVI(r0, _jitl.tmp) : \+ ((_jitl.tmp = encode_thumb_immediate(~i0)) != -1) ? \+ T2_MVNI(r0, _jitl.tmp) : \+ ( T2_MOVWI(r0, _jit_US(i0)), \+ ((i0 & 0xffff0000) ? T2_MOVTI(r0, _jit_US((unsigned)i0 >> 16)) : 0) ))++#ifdef USE_THUMB_CODE+#define jit_movi_p(r0, i0) \+ (T2_MOVWI(r0, _jit_US((int)i0)), T2_MOVTI(r0, _jit_US((int)i0 >> 16)), _jit.x.pc-8)+#else+#define jit_movi_p(r0, i0) \+ ((jit_armv6_p()) ? \+ (_MOVWI(r0, _jit_US((unsigned int)i0)), \+ _MOVTI(r0, _jit_US(((unsigned int)i0) >> 16)), \+ _jit.x.pc - 8) : \+ (_MOVI(r0, encode_arm_immediate(((int) i0) & 0xff000000)), \+ _ORRI(r0, r0, encode_arm_immediate(((int) i0) & 0x00ff0000)), \+ _ORRI(r0, r0, encode_arm_immediate(((int) i0) & 0x0000ff00)), \+ _ORRI(r0, r0, ((int) i0) & 0x000000ff), \+ _jit.x.pc - 16))+#endif++#ifdef USE_THUMB_CODE+#define jit_patch_movi(i0, i1) \+{ \+ union { \+ short *s; \+ int *i; \+ void *v; \+ } u; \+ jit_thumb_t thumb; \+ unsigned int im; \+ int q0, q1, q2, q3; \+ im = (unsigned int)i1; u.v = i0; \+\+ q0 = (im & 0xf000) << 4; \+ q1 = (im & 0x0800) << 15; \+ q2 = (im & 0x0700) << 4; \+ q3 = im & 0x00ff; \+ code2thumb(thumb.s[0], thumb.s[1], u.s[0], u.s[1]); \+ assert( (thumb.i & 0xfbf00000) == THUMB2_MOVWI); \+ thumb.i = (thumb.i & 0xfbf00f00) | q0 | q1 | q2 | q3; \+ thumb2code(thumb.s[0], thumb.s[1], u.s[0], u.s[1]); \+ im >>= 16; \+ q0 = (im & 0xf000) << 4; \+ q1 = (im & 0x0800) << 15; \+ q2 = (im & 0x0700) << 4; \+ q3 = im & 0x00ff; \+ code2thumb(thumb.s[0], thumb.s[1], u.s[2], u.s[3]); \+ assert( (thumb.i & 0xfbf00000) == THUMB2_MOVTI); \+ thumb.i = (thumb.i & 0xfbf00f00) | q0 | q1 | q2 | q3; \+ thumb2code(thumb.s[0], thumb.s[1], u.s[2], u.s[3]); \+} +#else+#define jit_patch_movi(i0, i1) \+{ \+ union { \+ short *s; \+ int *i; \+ void *v; \+ } u; \+ jit_thumb_t thumb; \+ unsigned int im; \+ int q0, q1, q2, q3; \+ im = (unsigned int)i1; u.v = i0; \+\+ if (jit_armv6_p()) { \+ q0 = im & 0xfff; \+ q1 = (im & 0xf000) << 4; \+ q2 = (im & 0xfff0000) >> 16; \+ q3 = (im & 0xf0000000) >> 12; \+ assert( (u.i[0] & 0x0ff00000) == (ARM_MOVWI)); \+ assert( (u.i[1] & 0x0ff00000) == (ARM_MOVTI)); \+ u.i[0] = (u.i[0] & 0xfff0f000) | q1 | q0; \+ u.i[1] = (u.i[1] & 0xfff0f000) | q3 | q2; \+ } \+ else { \+ q0 = im & 0x000000ff; q1 = im & 0x0000ff00; \+ q2 = im & 0x00ff0000; q3 = im & 0xff000000; \+ assert( (u.i[0] & 0x0ff00000) == (ARM_MOV|ARM_I)); \+ u.i[0] = (u.i[0] & 0xfffff000) | encode_arm_immediate(q3); \+ assert( (u.i[1] & 0x0ff00000) == (ARM_ORR|ARM_I)); \+ u.i[1] = (u.i[1] & 0xfffff000) | encode_arm_immediate(q2); \+ assert( (u.i[2] & 0x0ff00000) == (ARM_ORR|ARM_I)); \+ u.i[2] = (u.i[2] & 0xfffff000) | encode_arm_immediate(q1); \+ assert( (u.i[3] & 0x0ff00000) == (ARM_ORR|ARM_I)); \+ u.i[3] = (u.i[3] & 0xfffff000) | encode_arm_immediate(q0); \+ } \+} +#endif++#define jit_patch_calli(i0, i1) jit_patch_at(i0, i1)++#ifdef USE_THUMB_CODE+#define jit_patch_at(jump, label) \+{ \+ long d; \+ union { \+ short *s; \+ int *i; \+ void *v; \+ } u; \+ jit_thumb_t thumb; \+ u.v = jump; \+ if (jump >= _jitl.thumb_pc) \+ { \+ code2thumb(thumb.s[0], thumb.s[1], u.s[0], u.s[1]); \+ if ((thumb.i & THUMB2_B) == THUMB2_B) { \+ d = (((long)label - (long)jump) >> 1) - 2; \+ assert(_s24P(d)); \+ thumb.i = THUMB2_B | encode_thumb_jump(d); \+ thumb2code(thumb.s[0], thumb.s[1], u.s[0], u.s[1]); \+ } \+ else if ((thumb.i & THUMB2_B) == THUMB2_CC_B) { \+ d = (((long)label - (long)jump) >> 1) - 2; \+ assert(_s20P(d)); \+ thumb.i = THUMB2_CC_B | (thumb.i & 0x3c00000) | \+ encode_thumb_cc_jump(d); \+ thumb2code(thumb.s[0], thumb.s[1], u.s[0], u.s[1]); \+ } \+ else if ((thumb.i & 0xfbf08000) == THUMB2_MOVWI) { \+ jit_patch_movi(jump, label); \+ } else \+ assert(!"handled branch opcode"); \+ } else { \+ /* 0x0e000000 because 0x01000000 is (branch&) link modifier */ \+ if ((u.i[0] & 0x0e000000) == ARM_B) { \+ d = (((long)label - (long)jump) >> 2) - 2; \+ assert(_s24P(d)); \+ u.i[0] = (u.i[0] & 0xff000000) | (d & 0x00ffffff); \+ } else if ((jit_armv6_p() && (u.i[0] & 0x0ff00000) == ARM_MOVWI) || \+ (!jit_armv6_p() && (u.i[0] & 0x0ff00000) == (ARM_MOV|ARM_I))) { \+ jit_patch_movi(jump, label); \+ } else { \+ assert(!"handled branch opcode"); \+ } \+ } \+}+#else+#define jit_patch_at(jump, label) \+{ \+ union { \+ short *s; \+ int *i; \+ void *v; \+ } u; \+ u.v = jump; \+ /* 0x0e000000 because 0x01000000 is (branch&) link modifier */ \+ if ((u.i[0] & 0x0e000000) == ARM_B) { \+ long d = (((long)label - (long)jump) >> 2) - 2; \+ assert(_s24P(d)); \+ u.i[0] = (u.i[0] & 0xff000000) | (d & 0x00ffffff); \+ } else if ((jit_armv6_p() && (u.i[0] & 0x0ff00000) == ARM_MOVWI) || \+ (!jit_armv6_p() && (u.i[0] & 0x0ff00000) == (ARM_MOV|ARM_I))) { \+ jit_patch_movi(jump, label); \+ } else { \+ assert(!"handled branch opcode"); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_notr_i(r0, r1) \+ ((!jit_no_set_flags() && (r0|r1) < 8) ? T1_NOT(r0, r1) : T2_NOT(r0, r1))+#else+#define jit_notr_i(r0, r1) \+ _NOT(r0, r1)+#endif++#ifdef USE_THUMB_CODE+#define jit_negr_i(r0, r1) \+ ((!jit_no_set_flags() && (r0|r1) < 8) ? T1_RSBI(r0, r1), T2_RSBI(r0, r1, 0))+#else+#define jit_negr_i(r0, r1) \+ _RSBI(r0, r1, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_addr_i(r0, r1, r2) \+{ \+ if (!jit_no_set_flags() && (r0|r1|r2) < 8) \+ T1_ADD(r0, r1, r2); \+ else if (r0 == r1 || r0 == r2) \+ T1_ADDX(r0, r0 == r1 ? r2 : r1); \+ else \+ T2_ADD(r0, r1, r2); \+}+#else+#define jit_addr_i(r0, r1, r2) \+ _ADD(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_addi_i(r0, r1, i0) \+{ \+ int i; \+ jit_gpr_t reg; \+ if (!jit_no_set_flags() && (r0|r1) < 8 && !(i0 & ~7)) \+ T1_ADDI3(r0, r1, i0); \+ else if (!jit_no_set_flags() && (r0|r1) < 8 && !(-i0 & ~7)) \+ T1_SUBI3(r0, r1, -i0); \+ else if (!jit_no_set_flags() && r0 < 8 && r0 == r1 && !(i0 & ~0xff)) \+ T1_ADDI8(r0, i0); \+ else if (!jit_no_set_flags() && r0 < 8 && r0 == r1 && !(-i0 & ~0xff)) \+ T1_SUBI8(r0, -i0); \+ else if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_ADDI(r0, r1, i); \+ else if ((i = encode_thumb_immediate(-i0)) != -1) \+ T2_SUBI(r0, r1, i); \+ else if ((i = encode_thumb_word_immediate(i0)) != -1) \+ T2_ADDWI(r0, r1, i); \+ else if ((i = encode_thumb_word_immediate(-i0)) != -1) \+ T2_SUBWI(r0, r1, i); \+ else { \+ reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_ADD(r0, r1, reg); \+ } \+}+#else+#define jit_addi_i(r0, r1, i0) \+ (encode_arm_immediate(i0) != -1) ? \+ _ADDI(r0, r1, encode_arm_immediate(i0)) : \+ ((encode_arm_immediate(-i0) != -1) ? \+ _SUBI(r0, r1, encode_arm_immediate(-i0)) : \+ (jit_movi_i(JIT_TMP, i0), _ADD(r0, r1, JIT_TMP)))+#endif++#ifdef USE_THUMB_CODE+#define jit_addcr_i(r0, r1, r2) \+ /* thumb auto set carry if not inside IT block */ \+ ((r0|r1|r2) < 8) ? T1_ADD(r0, r1, r2) : T2_ADDS(r0, r1, r2)+#else+#define jit_addcr_i(r0, r1, r2) \+ _ADDS(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_addci_i(r0, r1, i0) \+{ \+ int i; \+ if ((r0|r1) < 8 && !(i0 & ~7)) \+ T1_ADDI3(r0, r1, i0); \+ else if ((r0|r1) < 8 && !(-i0 & ~7)) \+ T1_SUBI3(r0, r1, -i0); \+ else if (r0 < 8 && r0 == r1 && !(i0 & ~0xff)) \+ T1_ADDI8(r0, i0); \+ else if (r0 < 8 && r0 == r1 && !(-i0 & ~0xff)) \+ T1_SUBI8(r0, -i0); \+ else if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_ADDSI(r0, r1, i); \+ else if ((i = encode_thumb_immediate(-i0)) != -1) \+ T2_SUBSI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_ADDS(r0, r1, reg); \+ } \+} +#else+#define jit_addci_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _ADDSI(r0, r1, i); \+ else if ((i = encode_arm_immediate(-i0)) != -1) \+ _SUBSI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _ADDS(r0, r1, reg); \+ } \+} +#endif++#ifdef USE_THUMB_CODE+#define jit_addxr_i(r0, r1, r2) \+{ /* keep setting carry because don't know last ADC */ \+ /* thumb auto set carry if not inside IT block */ \+ if ((r0|r1|r2) < 8 && (r0 == r1 || r0 == r2)) \+ T1_ADC(r0, r0 == r1 ? r2 : r1); \+ else \+ T2_ADCS(r0, r1, r2); \+}+#else+#define jit_addxr_i(r0, r1, r2) \+ /* keep setting carry because don't know last ADC */ \+ _ADCS(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_addxi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_ADCSI(r0, r1, i); \+ else if ((i = encode_thumb_immediate(-i0)) != -1) \+ T2_SBCSI(r0, r1, i); \+ else { \+ int no_set_flags = jit_no_set_flags(); \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_no_set_flags() = 1; \+ jit_movi_i(reg, i0); \+ jit_no_set_flags() = no_set_flags; \+ T2_ADCS(r0, r1, reg); \+ } \+}+#else+#define jit_addxi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _ADCSI(r0, r1, i); \+ else if ((i = encode_arm_immediate(-i0)) != -1) \+ _SBCSI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _ADCS(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_subr_i(r0, r1, r2) \+{ \+ if (!jit_no_set_flags() && (r0|r1|r2) < 8) \+ T1_SUB(r0, r1, r2); \+ else \+ T2_SUB(r0, r1, r2); \+}+#else+#define jit_subr_i(r0, r1, r2) \+ _SUB(r0, r1, r2);+#endif++#ifdef USE_THUMB_CODE+#define jit_subi_i(r0, r1, i0) \+{ \+ int i; \+ if (!jit_no_set_flags() && (r0|r1) < 8 && !(i0 & ~7)) \+ T1_SUBI3(r0, r1, i0); \+ else if (!jit_no_set_flags() && (r0|r1) < 8 && !(-i0 & ~7)) \+ T1_ADDI3(r0, r1, -i0); \+ else if (!jit_no_set_flags() && r0 < 8 && r0 == r1 && !(i0 & ~0xff)) \+ T1_SUBI8(r0, i0); \+ else if (!jit_no_set_flags() && r0 < 8 && r0 == r1 && !(-i0 & ~0xff)) \+ T1_ADDI8(r0, -i0); \+ else if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_SUBI(r0, r1, i); \+ else if ((i = encode_thumb_immediate(-i0)) != -1) \+ T2_ADDI(r0, r1, i); \+ else if ((i = encode_thumb_word_immediate(i0)) != -1) \+ T2_SUBWI(r0, r1, i); \+ else if ((i = encode_thumb_word_immediate(-i0)) != -1) \+ T2_ADDWI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_SUB(r0, r1, reg); \+ } \+}+#else+#define jit_subi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _SUBI(r0, r1, i); \+ else if ((i = encode_arm_immediate(-i0)) != -1) \+ _ADDI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _SUB(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_subcr_i(r0, r1, r2) \+ /* thumb auto set carry if not inside IT block */ \+ ((r0|r1|r2) < 8) ? T1_SUB(r0, r1, r2) : T2_SUBS(r0, r1, r2)+#else+#define jit_subcr_i(r0, r1, r2) \+ _SUBS(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_subci_i(r0, r1, i0) \+{ \+ int i; \+ if ((r0|r1) < 8 && !(i0 & ~7)) \+ T1_SUBI3(r0, r1, i0); \+ else if ((r0|r1) < 8 && !(-i0 & ~7)) \+ T1_ADDI3(r0, r1, -i0); \+ else if (r0 < 8 && r0 == r1 && !(i0 & ~0xff)) \+ T1_SUBI8(r0, i0); \+ else if (r0 < 8 && r0 == r1 && !(-i0 & ~0xff)) \+ T1_ADDI8(r0, -i0); \+ else if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_SUBSI(r0, r1, i); \+ else if ((i = encode_thumb_immediate(-i0)) != -1) \+ T2_ADDSI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_SUBS(r0, r1, reg); \+ } \+}+#else+#define jit_subci_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _SUBSI(r0, r1, i); \+ else if ((i = encode_arm_immediate(-i0)) != -1) \+ _ADDSI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _SUBS(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_subxr_i(r0, r1, r2) \+ /* keep setting carry because don't know last ADC */ \+ /* thumb auto set carry if not inside IT block */ \+ ((r0|r1|r2) < 8 && r0 == r1) ? T1_SBC(r0, r2) : T2_SBCS(r0, r1, r2)+#else+#define jit_subxr_i(r0, r1, r2) \+ /* keep setting carry because don't know last ADC */ \+ _SBCS(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_subxi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_SBCSI(r0, r1, i); \+ else if ((i = encode_thumb_immediate(-i0)) != -1) \+ T2_ADCSI(r0, r1, i); \+ else { \+ int no_set_flags = jit_no_set_flags(); \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_no_set_flags() = 1; \+ jit_movi_i(reg, i0); \+ jit_no_set_flags() = no_set_flags; \+ T2_SBCS(r0, r1, reg); \+ } \+}+#else+#define jit_subxi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _SBCSI(r0, r1, i); \+ else if ((i = encode_arm_immediate(-i0)) != -1) \+ _ADCSI(r0, r1, i); \+ else { \+ reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _SBCS(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_rsbr_i(r0, r1, r2) \+ T2_RSB(r0, r1, r2)+#else+#define jit_rsbr_i(r0, r1, r2) \+ _RSB(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_rsbi_i(r0, r1, i0) \+{ \+ int i; \+ if (i0 == 0) \+ jit_negr_i(r0, r1); \+ else if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_RSBI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_RSB(r0, r1, reg); \+ } \+}+#else+#define jit_rsbi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _RSBI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _RSB(r0, r1, reg); \+ } \+}+#endif++#define jit_mulr_i(r0, r1, r2) jit_mulr_ui(r0, r1, r2)+#ifdef USE_THUMB_CODE+#define jit_mulr_ui(r0, r1, r2) \+{ \+ if (!jit_no_set_flags() && r0 == r2 && (r0|r1) < 8) \+ T1_MUL(r0, r1); \+ else if (!jit_no_set_flags() && r0 == r1 && (r0|r2) < 8) \+ T1_MUL(r0, r2); \+ else \+ T2_MUL(r0, r1, r2); \+}+#else+#define jit_mulr_ui(r0, r1, r2) \+{ \+ if (r0 == r1 && !jit_armv6_p()) { \+ if (r0 != r2) \+ _MUL(r0, r2, r1); \+ else { \+ _MOV(JIT_TMP, r1); \+ _MUL(r0, JIT_TMP, r2); \+ } \+ } \+ else \+ _MUL(r0, r1, r2); \+}+#endif++#define jit_muli_i(r0, r1, i0) jit_muli_ui(r0, r1, i0)+#define jit_muli_ui(r0, r1, i0) \+{ \+ jit_gpr_t reg; \+ reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ jit_mulr_i(r0, r1, reg); \+}++#ifdef USE_THUMB_CODE+#define jit_hmulr_i(r0, r1, r2) \+ T2_SMULL(JIT_TMP, r0, r1, r2)+#else+#define jit_hmulr_i(r0, r1, r2) \+{ \+ if (r0 == r1 && !jit_armv6_p()) { \+ assert(r2 != JIT_TMP); \+ _SMULL(JIT_TMP, r0, r2, r1); \+ } \+ else \+ _SMULL(JIT_TMP, r0, r1, r2); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_hmuli_i(r0, r1, i0) \+{ \+ assert(r0 != JIT_TMP); \+ jit_movi_i(JIT_TMP, i0); \+ T2_SMULL(JIT_TMP, r0, r1, JIT_TMP); \+}+#else+#define jit_hmuli_i(r0, r1, i0) \+{ \+ jit_gpr_t reg; \+ if (r0 != r1 || jit_armv6_p()) { \+ jit_movi_i(JIT_TMP, i0); \+ _SMULL(JIT_TMP, r0, r1, JIT_TMP); \+ } \+ else { \+ if (r0 != _R0) reg = _R0; \+ else if (r0 != _R1) reg = _R1; \+ else if (r0 != _R2) reg = _R2; \+ else reg = _R3; \+ _PUSH(1<<reg); \+ jit_movi_i(reg, i0); \+ _SMULL(JIT_TMP, r0, r1, reg); \+ _POP(1<<reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_hmulr_ui(r0, r1, r2) \+ T2_UMULL(JIT_TMP, r0, r1, r2)+#else+#define jit_hmulr_ui(r0, r1, r2) \+{ \+ if (r0 == r1 && !jit_armv6_p()) { \+ assert(r2 != JIT_TMP); \+ _UMULL(JIT_TMP, r0, r2, r1); \+ } \+ else \+ _UMULL(JIT_TMP, r0, r1, r2); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_hmuli_ui(r0, r1, i0) \+{ \+ assert(r0 != JIT_TMP); \+ jit_movi_i(JIT_TMP, i0); \+ T2_UMULL(JIT_TMP, r0, r1, JIT_TMP); \+}+#else+#define jit_hmuli_ui(r0, r1, i0) \+{ \+ if (r0 != r1 || jit_armv6_p()) { \+ jit_movi_i(JIT_TMP, i0); \+ _UMULL(JIT_TMP, r0, r1, JIT_TMP); \+ } else { \+ jit_gpr_t reg; \+ if (r0 != _R0) reg = _R0; \+ else if (r0 != _R1) reg = _R1; \+ else if (r0 != _R2) reg = _R2; \+ else reg = _R3; \+ _PUSH(1<<reg); \+ jit_movi_i(reg, i0); \+ _UMULL(JIT_TMP, r0, r1, reg); \+ _POP(1<<reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_divr_i(r0, r1, r2) \+{ \+ if (jit_armv7r_p()) \+ T2_SDIV(r0, r1, r2); \+ else \+ arm_divmod(&_jit, 1, 1, r0, r1, r2); \+}+#else+#define jit_divr_i(r0, r1, r2) \+ arm_divmod(&_jit, 1, 1, r0, r1, r2)+#endif++#define jit_divi_i(r0, r1, i0) \+{ \+ jit_movi_i(JIT_TMP, i0); \+ jit_divr_i(r0, r1, JIT_TMP); \+}++#ifdef USE_THUMB_CODE+#define jit_divr_ui(r0, r1, r2) \+{ \+ if (jit_armv7r_p()) \+ T2_UDIV(r0, r1, r2); \+ else \+ arm_divmod(&_jit, 1, 0, r0, r1, r2); \+}+#else+#define jit_divr_ui(r0, r1, r2) \+ arm_divmod(&_jit, 1, 0, r0, r1, r2);+#endif++#define jit_divi_ui(r0, r1, i0) \+ (jit_movi_i(JIT_TMP, i0), \+ jit_divr_ui(_jit, r0, r1, JIT_TMP))++#define jit_modr_i(r0, r1, r2) \+ arm_divmod(&_jit, 0, 1, r0, r1, r2)++#define jit_modi_i(r0, r1, i0) \+ (jit_movi_i(JIT_TMP, i0), jit_modr_i(r0, r1, JIT_TMP))++#define jit_modr_ui(r0, r1, r2) \+ arm_divmod(&_jit, 0, 0, r0, r1, r2)++#define jit_modi_ui(r0, r1, i0) \+ (jit_movi_i(JIT_TMP, i0), jit_modr_ui(_jit, r0, r1, JIT_TMP))++#ifdef USE_THUMB_CODE+#define jit_andr_i(r0, r1, r2) \+ (!jit_no_set_flags() && (r0|r1|r2) < 8 && (r0 == r1 || r0 == r2)) ? T1_AND(r0, r0 == r1 ? r2 : r1) : T2_AND(r0, r1, r2)+#else+#define jit_andr_i(r0, r1, r2) \+ _AND(r0, r1, r2);+#endif++#ifdef USE_THUMB_CODE+#define jit_andi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_ANDI(r0, r1, i); \+ else if ((i = encode_thumb_immediate(~i0)) != -1) \+ T2_BICI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_AND(r0, r1, reg); \+ } \+}+#else+#define jit_andi_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _ANDI(r0, r1, i); \+ else if ((i = encode_arm_immediate(~i0)) != -1) \+ _BICI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _AND(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_orr_i(r0, r1, r2) \+{ \+ if (!jit_no_set_flags() && (r0|r1|r2) < 8 && (r0 == r1 || r0 == r2)) \+ T1_ORR(r0, r0 == r1 ? r2 : r1); \+ else \+ T2_ORR(r0, r1, r2); \+}+#else+#define jit_orr_i(r0, r1, r2) \+ _ORR(r0, r1, r2);+#endif++#ifdef USE_THUMB_CODE+#define jit_ori_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_ORRI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_ORR(r0, r1, reg); \+ } \+}+#else+#define jit_ori_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _ORRI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _ORR(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_xorr_i(r0, r1, r2) \+{ \+ if (!jit_no_set_flags() && (r0|r1|r2) < 8 && (r0 == r1 || r0 == r2)) \+ T1_EOR(r0, r0 == r1 ? r2 : r1); \+ else \+ T2_EOR(r0, r1, r2); \+}+#else+#define jit_xorr_i(r0, r1, r2) \+ _EOR(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_xori_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_EORI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ T2_EOR(r0, r1, reg); \+ } \+}+#else+#define jit_xori_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _EORI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _EOR(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_lshr_i(r0, r1, r2) \+ if (!jit_no_set_flags() && (r0|r1|r2) < 8 && r0 == r1) \+ T1_LSL(r0, r2); \+ else \+ T2_LSL(r0, r1, r2);+#else+#define jit_lshr_i(r0, r1, r2) \+ _LSL(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_lshi_i(r0, r1, i0) \+{ \+ assert(i0 >= 0 && i0 <= 31); \+ if (i0 == 0) \+ jit_movr_i(r0, r1); \+ else \+ if (!jit_no_set_flags() && (r0|r1) < 8) \+ T1_LSLI(r0, r1, i0); \+ else \+ T2_LSLI(r0, r1, i0); \+}+#else+#define jit_lshi_i(r0, r1, i0) \+{ \+ assert(i0 >= 0 && i0 <= 31); \+ if (i0 == 0) \+ jit_movr_i(r0, r1); \+ else \+ _LSLI(r0, r1, i0); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_rshr_i(r0, r1, r2) \+{ \+ if (!jit_no_set_flags() && (r0|r1|r2) < 8 && r0 == r1) \+ T1_ASR(r0, r2); \+ else \+ T2_ASR(r0, r1, r2); \+}+#else+#define jit_rshr_i(r0, r1, r2) \+ _ASR(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_rshi_i(r0, r1, i0) \+{ \+ assert(i0 >= 0 && i0 <= 31); \+ if (i0 == 0) \+ jit_movr_i(r0, r1); \+ else if (!jit_no_set_flags() && (r0|r1) < 8) \+ T1_ASRI(r0, r1, i0); \+ else \+ T2_ASRI(r0, r1, i0); \+}+#else+#define jit_rshi_i(r0, r1, i0) \+{ \+ assert(i0 >= 0 && i0 <= 31); \+ if (i0 == 0) \+ jit_movr_i(r0, r1); \+ else \+ _ASRI(r0, r1, i0); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_rshr_ui(r0, r1, r2) \+{ \+ if (!jit_no_set_flags() && (r0|r1|r2) < 8 && r0 == r1) \+ T1_LSR(r0, r2); \+ else \+ T2_LSR(r0, r1, r2); \+}+#else+#define jit_rshr_ui(r0, r1, r2) \+ _LSR(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_rshi_ui(r0, r1, i0) \+{ \+ assert(i0 >= 0 && i0 <= 31); \+ if (i0 == 0) \+ jit_movr_i(r0, r1); \+ else if (!jit_no_set_flags() && (r0|r1) < 8) \+ T1_LSRI(r0, r1, i0); \+ else \+ T2_LSRI(r0, r1, i0); \+}+#else+#define jit_rshi_ui(r0, r1, i0) \+{ \+ assert(i0 >= 0 && i0 <= 31); \+ if (i0 == 0) \+ jit_movr_i(r0, r1); \+ else \+ _LSRI(r0, r1, i0); \+}+#endif++#ifdef USE_THUMB_CODE+#define arm_ccr(ct, cf, r0, r1, r2) \+{ \+ assert((ct ^ cf) >> 28 == 1); \+ if ((r1|r2) < 8) \+ T1_CMP(r1, r2); \+ else if ((r1&r2) & 8) \+ T1_CMPX(r1, r2); \+ else \+ T2_CMP(r1, r2); \+ _ITE(ct); \+ if (r0 < 8) { \+ T1_MOVI(r0, 1); \+ T1_MOVI(r0, 0); \+ } else { \+ T2_MOVI(r0, 1); \+ T2_MOVI(r0, 0); \+ } \+}+#else+#define arm_ccr(ct, cf, r0, r1, r2) \+{ \+ _CMP(r1, r2); \+ _CC_MOVI(ct, r0, 1); \+ _CC_MOVI(cf, r0, 0); \+}+#endif++#ifdef USE_THUMB_CODE+#define arm_cci(ct, cf, r0, r1, i0) \+{ \+ int i; \+ if (r1 < 7 && !(i0 & 0xffffff00)) \+ T1_CMPI(r1, i0); \+ else if ((i = encode_thumb_immediate(i0)) != -1) \+ T2_CMPI(r1, i); \+ else if ((i = encode_thumb_immediate(-i0)) != -1) \+ T2_CMNI(r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ arm_ccr(_jit, ct, cf, r0, r1, reg); \+ goto next; \+ } \+ _ITE(ct); \+ if (r0 < 8) { \+ T1_MOVI(r0, 1); \+ T1_MOVI(r0, 0); \+ } \+ else { \+ T2_MOVI(r0, 1); \+ T2_MOVI(r0, 0); \+ } \+next: \+}+#else+#define arm_cci(ct, cf, r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _CMPI(r1, i); \+ else if ((i = encode_arm_immediate(-i0)) != -1) \+ _CMNI(r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _CMP(r1, reg); \+ } \+ _CC_MOVI(ct, r0, 1); \+ _CC_MOVI(cf, r0, 0); \+}+#endif++#define jit_ltr_i(r0, r1, r2) arm_ccr(_jit,ARM_CC_LT,ARM_CC_GE,r0,r1,r2)+#define jit_lti_i(r0, r1, i0) arm_cci(_jit,ARM_CC_LT,ARM_CC_GE,r0,r1,i0)+#define jit_ltr_ui(r0, r1, r2) arm_ccr(_jit,ARM_CC_LO,ARM_CC_HS,r0,r1,r2)+#define jit_lti_ui(r0, r1, i0) arm_cci(_jit,ARM_CC_LO,ARM_CC_HS,r0,r1,i0)+#define jit_ler_i(r0, r1, r2) arm_ccr(_jit,ARM_CC_LE,ARM_CC_GT,r0,r1,r2)+#define jit_lei_i(r0, r1, i0) arm_cci(_jit,ARM_CC_LE,ARM_CC_GT,r0,r1,i0)+#define jit_ler_ui(r0, r1, r2) arm_ccr(_jit,ARM_CC_LS,ARM_CC_HI,r0,r1,r2)+#define jit_lei_ui(r0, r1, i0) arm_cci(_jit,ARM_CC_LS,ARM_CC_HI,r0,r1,i0)+#define jit_eqr_i(r0, r1, r2) arm_ccr(_jit,ARM_CC_EQ,ARM_CC_NE,r0,r1,r2)+#define jit_eqi_i(r0, r1, i0) arm_cci(_jit,ARM_CC_EQ,ARM_CC_NE,r0,r1,i0)+#define jit_ger_i(r0, r1, r2) arm_ccr(_jit,ARM_CC_GE,ARM_CC_LT,r0,r1,r2)+#define jit_gei_i(r0, r1, i0) arm_cci(_jit,ARM_CC_GE,ARM_CC_LT,r0,r1,i0)+#define jit_ger_ui(r0, r1, r2) arm_ccr(_jit,ARM_CC_HS,ARM_CC_LO,r0,r1,r2)+#define jit_gei_ui(r0, r1, i0) arm_cci(_jit,ARM_CC_HS,ARM_CC_LO,r0,r1,i0)+#define jit_gtr_i(r0, r1, r2) arm_ccr(_jit,ARM_CC_GT,ARM_CC_LE,r0,r1,r2)+#define jit_gti_i(r0, r1, i0) arm_cci(_jit,ARM_CC_GT,ARM_CC_LE,r0,r1,i0)+#define jit_gtr_ui(r0, r1, r2) arm_ccr(_jit,ARM_CC_HI,ARM_CC_LS,r0,r1,r2)+#define jit_gti_ui(r0, r1, i0) arm_cci(_jit,ARM_CC_HI,ARM_CC_LS,r0,r1,i0)++#ifdef USE_THUMB_CODE+#define jit_ner_i(r0, r1, r2) \+ arm_ccr(_jit, ARM_CC_NE, ARM_CC_EQ, r0, r1, r2)+#else+#define jit_ner_i(r0, r1, r2) \+ (_SUBS(r0, r1, r2), _CC_MOVI(ARM_CC_NE, r0, 1))+#endif++#ifdef USE_THUMB_CODE+#define jit_nei_i(r0, r1, i0) \+ arm_cci(_jit, ARM_CC_NE, ARM_CC_EQ, r0, r1, i0)+#else+#define jit_nei_i(r0, r1, i0) \+{ \+ int i; \+ if ((i = encode_arm_immediate(i0)) != -1) \+ _SUBSI(r0, r1, i); \+ else if ((i = encode_arm_immediate(-i0)) != -1) \+ _ADDSI(r0, r1, i); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _SUBS(r0, r1, reg); \+ } \+ _CC_MOVI(ARM_CC_NE, r0, 1); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_jmpr(r0) T1_MOV(_R15, r0)+#else+#define jit_jmpr(r0) _MOV(_R15, r0)+#endif++#ifdef USE_THUMB_CODE+#define jit_jmpi(i0) \+ (_jitl.thumb_tmp = _jit.x.pc, \+ (_jitl.after_prolog) ? \+ ((_s20P((((long)i0 - (long)_jitl.thumb_tmp) >> 1) - 2)) ? \+ T2_B(encode_thumb_jump((((long)i0 - (long)_jitl.thumb_tmp) >> 1) - 2)) : \+ (jit_movi_p(JIT_TMP, i0), jit_jmpr(JIT_TMP))) : \+ (assert(_s24P((((long)i0 - (long)_jitl.thumb_tmp) >> 2) - 2)), \+ _CC_B(ARM_CC_AL, ((((long)i0 - (long)_jitl.thumb_tmp) >> 2) - 2) & 0x00ffffff)) \+ _jitl.thumb_tmp)+#else+#define jit_jmpi(i0) \+ (_jitl.thumb_tmp = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)_jitl.thumb_tmp) >> 2) - 2)), \+ _CC_B(ARM_CC_AL, ((((long)i0 - (long)_jitl.thumb_tmp) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_tmp)+#endif++#ifdef USE_THUMB_CODE+#define arm_bccr(cc, i0, r0, r1) \+ (((r0|r1) < 8) ? T1_CMP(r0, r1) : (((r0&r1) & 8) ? T1_CMPX(r0, r1) : T2_CMP(r0, r1)), \+ /* use only thumb2 conditional as does not know if will be patched */ \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s20P((((long)i0 - (long)l) >> 1) - 2)), \+ T2_CC_B(cc, encode_thumb_cc_jump((((long)i0 - (long)l) >> 1) - 2)), \+ _jitl.thumb_tmp)+#else+#define arm_bccr(cc, i0, r0, r1) \+ (_CMP(r0, r1), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s24P((((long)(i0) - (long)_jit.x.pc) >> 2) - 2)), \+ _CC_B(cc, ((((long)(i0) - (long)_jit.x.pc) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_tmp)+#endif++#ifdef USE_THUMB_CODE+#define arm_bcci(cc, i0, r0, i1) \+ (((r0 < 7 && !(i1 & 0xffffff00)) ? \+ T1_CMPI(r0, i1) : \+ ((encode_thumb_immediate(i1) != -1) ? \+ T2_CMPI(r0, encode_thumb_immediate(i1)) : \+ ((encode_thumb_immediate(-i1) != -1) ? \+ T2_CMNI(r0, encode_thumb_immediate(-i1)) : \+ (jit_movi_i(JIT_TMP, i1), T2_CMP(r0, JIT_TMP))))), \+ /* use only thumb2 conditional as does not know if will be patched */ \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s20P((((long)i0 - (long)_jitl.thumb_tmp) >> 1) - 2)), \+ T2_CC_B(cc, encode_thumb_cc_jump((((long)i0 - (long)l) >> 1) - 2)), \+ _jitl.thumb_tmp)+#else+#define arm_bcci(cc, i0, r0, i1) \+ (((encode_arm_immediate(i1) != -1) ? \+ _CMPI(r0, encode_arm_immediate(i1)) : \+ ((encode_arm_immediate(-i1) != -1) ? \+ _CMNI(r0, encode_arm_immediate(-i1)) : \+ (jit_movi_i(JIT_TMP, i1), _CMP(r0, JIT_TMP)))), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)_jitl.thumb_tmp) >> 2) - 2)), \+ _CC_B(cc, ((((long)i0 - (long)_jitl.thumb_tmp) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_tmp)+#endif++#define jit_bltr_i(i0, r0, r1) arm_bccr(ARM_CC_LT, i0, r0, r1)+#define jit_blti_i(i0, r0, i1) arm_bcci(ARM_CC_LT, i0, r0, i1)+#define jit_bltr_ui(i0, r0, r1) arm_bccr(ARM_CC_LO, i0, r0, r1)+#define jit_blti_ui(i0, r0, i1) arm_bcci(ARM_CC_LO, i0, r0, i1)+#define jit_bler_i(i0, r0, r1) arm_bccr(ARM_CC_LE, i0, r0, r1)+#define jit_blei_i(i0, r0, i1) arm_bcci(ARM_CC_LE, i0, r0, i1)+#define jit_bler_ui(i0, r0, r1) arm_bccr(ARM_CC_LS, i0, r0, r1)+#define jit_blei_ui(i0, r0, i1) arm_bcci(ARM_CC_LS, i0, r0, i1)+#define jit_beqr_i(i0, r0, r1) arm_bccr(ARM_CC_EQ, i0, r0, r1)+#define jit_beqi_i(i0, r0, i1) arm_bcci(ARM_CC_EQ, i0, r0, i1)+#define jit_bger_i(i0, r0, r1) arm_bccr(ARM_CC_GE, i0, r0, r1)+#define jit_bgei_i(i0, r0, i1) arm_bcci(ARM_CC_GE, i0, r0, i1)+#define jit_bger_ui(i0, r0, r1) arm_bccr(ARM_CC_HS, i0, r0, r1)+#define jit_bgei_ui(i0, r0, i1) arm_bcci(ARM_CC_HS, i0, r0, i1)+#define jit_bgtr_i(i0, r0, r1) arm_bccr(ARM_CC_GT, i0, r0, r1)+#define jit_bgti_i(i0, r0, i1) arm_bcci(ARM_CC_GT, i0, r0, i1)+#define jit_bgtr_ui(i0, r0, r1) arm_bccr(ARM_CC_HI, i0, r0, r1)+#define jit_bgti_ui(i0, r0, i1) arm_bcci(ARM_CC_HI, i0, r0, i1)+#define jit_bner_i(i0, r0, r1) arm_bccr(ARM_CC_NE, i0, r0, r1)+#define jit_bnei_i(i0, r0, i1) arm_bcci(ARM_CC_NE, i0, r0, i1)++#ifdef USE_THUMB_CODE+#define arm_baddr(cc, i0, r0, r1) \+ (((r0|r1) < 8) ? T1_ADD(r0, r0, r1) : T2_ADDS(r0, r0, r1), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s20P((((long)i0 - (long)l) >> 1) - 2)), \+ T2_CC_B(cc, encode_thumb_cc_jump((((long)i0 - (long)l) >> 1) - 2)), \+ _jitl.thumb_tmp)+#else+#define arm_baddr(cc, i0, r0, r1) \+ (_ADDS(r0, r0, r1), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)l) >> 2) - 2)), \+ _CC_B(cc, ((((long)i0 - (long)l) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_tmp)+#endif++#ifdef USE_THUMB_CODE+#define arm_baddi(cc, i0, r0, i1) \+ (((r0 < 8 && !(i1 & ~7)) ? \+ T1_ADDI3(r0, r0, i1) : \+ ((r0 < 8 && !(-i1 & ~7)) ? \+ T1_SUBI3(r0, r0, -i1) : \+ ((r0 < 8 && !(i1 & ~0xff)) ? \+ T1_ADDI8(r0, i1) : \+ ((r0 < 8 && !(-i1 & ~0xff)) ? \+ T1_SUBI8(r0, -i1) : \+ ((encode_thumb_immediate(i1) != -1) ? \+ T2_ADDSI(r0, r0, encode_thumb_immediate(i1)) : \+ ((encode_thumb_immediate(-i1) != -1) ? \+ T2_SUBSI(r0, r0, encode_thumb_immediate(-i1)) : \+ (jit_movi_i(JIT_TMP, i1), T2_ADDS(r0, r0, JIT_TMP)))))))), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s20P((((long)i0 - (long)l) >> 1) - 2)), \+ T2_CC_B(cc, encode_thumb_cc_jump((((long)i0 - (long)l) >> 1) - 2)), \+ _jitl.thumb_tmp)+#else+#define arm_baddi(cc, i0, r0, i1) \+ (((encode_arm_immediate(i1) != -1) ? \+ _ADDSI(r0, r0, encode_arm_immediate(i1)) : \+ ((encode_arm_immediate(-i1) != -1) ? \+ _SUBSI(r0, r0, encode_arm_immediate(-i1)) : \+ (jit_movi_i(JIT_TMP, i1), _ADDS(r0, r0, JIT_TMP)))), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)l) >> 2) - 2)), \+ _CC_B(cc, ((((long)i0 - (long)l) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_tmp)+#endif++#define jit_boaddr_i(i0, r0, r1) arm_baddr(ARM_CC_VS, i0, r0, r1)+#define jit_boaddi_i(i0, r0, i1) arm_baddi(ARM_CC_VS, i0, r0, i1)+#define jit_boaddr_ui(i0, r0, r1) arm_baddr(ARM_CC_HS, i0, r0, r1)+#define jit_boaddi_ui(i0, r0, i1) arm_baddi(ARM_CC_HS, i0, r0, i1)++#ifdef USE_THUMB_CODE+#define arm_bsubr(cc, i0, r0, r1) \+ (((r0|r1) < 8) ? T1_SUB(r0, r0, r1) : T2_SUBS(r0, r0, r1), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s20P((((long)i0 - (long)l) >> 1) - 2)), \+ T2_CC_B(cc, encode_thumb_cc_jump((((long)i0 - (long)l) >> 1) - 2)), \+ _jitl.thumb_tmp)+#else+#define arm_bsubr(cc, i0, r0, r1) \+ (_SUBS(r0, r0, r1), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)l) >> 2) - 2)), \+ _CC_B(cc, ((((long)i0 - (long)l) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_tmp)+#endif++#ifdef USE_THUMB_CODE+#define arm_bsubi(cc, i0, r0, i1) \+ (((r0 < 8 && !((i1) & ~7)) ? \+ T1_SUBI3(r0, r0, i1) : \+ ((r0 < 8 && !(-(i1) & ~7)) ? \+ T1_ADDI3(r0, r0, -i1) : \+ ((r0 < 8 && !((i1) & ~0xff)) ? \+ T1_SUBI8(r0, i1) : \+ ((r0 < 8 && !(-(i1) & ~0xff)) ? \+ T1_ADDI8(r0, -(i1)) : \+ ((encode_thumb_immediate(i1) != -1) ? \+ T2_SUBSI(r0, r0, encode_thumb_immediate(i1)) : \+ ((encode_thumb_immediate(-i1) != -1) ? \+ T2_ADDSI(r0, r0, encode_thumb_immediate(-i1)) : \+ (jit_movi_i(JIT_TMP, i1), T2_SUBS(r0, r0, JIT_TMP)))))))), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s20P((((long)i0 - (long)_jitl.thumb_tmp) >> 1) - 2)), \+ T2_CC_B(cc, encode_thumb_cc_jump((((long)(i0) - (long)_jitl.thumb_tmp) >> 1) - 2)), \+ _jitl.thumb_tmp)+#else+#define arm_bsubi(cc, i0, r0, i1) \+ (((encode_arm_immediate(i1) != -1) ? \+ _SUBSI(r0, r0, encode_arm_immediate(i1)) : \+ ((encode_arm_immediate(-i1) != -1) ? \+ _ADDSI(r0, r0, encode_arm_immediate(-i1)) : \+ (jit_movi_i(JIT_TMP, i1), _SUBS(r0, r0, JIT_TMP)))), \+ _jitl.thumb_tmp = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)l) >> 2) - 2)), \+ _CC_B(cc, ((((long)i0 - (long)l) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_tmp)+#endif++#define jit_bosubr_i(i0, r0, r1) arm_bsubr(ARM_CC_VS, i0, r0, r1)+#define jit_bosubi_i(i0, r0, i1) arm_bsubi(ARM_CC_VS, i0, r0, i1)+#define jit_bosubr_ui(i0, r0, r1) arm_bsubr(ARM_CC_LO, i0, r0, r1)+#define jit_bosubi_ui(i0, r0, i1) arm_bsubi(ARM_CC_LO, i0, r0, i1)++#ifdef USE_THUMB_CODE+#define arm_bmxr(cc, i0, r0, r1) \+ (((r0|r1) < 8) ? T1_TST(r0, r1) : T2_TST(r0, r1), \+ _jitl.thumb_pc = _jit.x.pc, \+ assert(_s20P((((long)i0 - (long)l) >> 1) - 2)), \+ T2_CC_B(cc, encode_thumb_cc_jump((((long)i0 - (long)l) >> 1) - 2)), \+ _jitl.thumb_pc)+#else+#define arm_bmxr(cc, i0, r0, r1) \+ (((jit_armv5_p()) ? _TST(r0, r1) : _ANDS(JIT_TMP, r0, r1)), \+ _jitl.thumb_pc = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)l) >> 2) - 2)), \+ _CC_B(cc, ((((long)i0 - (long)l) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_pc)+#endif++#ifdef USE_THUMB_CODE+#define arm_bmxi(cc, i0, r0, i1) \+ ((jit_armv5_p()) ? \+ ((encode_arm_immediate(i1) != -1) ? \+ _TSTI(r0, encode_arm_immediate(i1)) : \+ (jit_movi_i(JIT_TMP, i1), _TST(r0, JIT_TMP))) \+ (((i = encode_arm_immediate(i1)) != -1) ? \+ _ANDSI(JIT_TMP, r0, i) : \+ (((encode_arm_immediate(~i1)) != -1) ? \+ _BICSI(JIT_TMP, r0, encode_arm_immediate(~i1)) : \+ (jit_movi_i(JIT_TMP, i1), _ANDS(JIT_TMP, r0, JIT_TMP)))), \+ _jitl.thumb_pc = _jit.x.pc, \+ assert(_s24P((((long)i0 - (long)_jitl.thumb_pc) >> 2) - 2)), \+ _CC_B(cc, ((((long)i0 - (long)_jitl.thumb_pc) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_pc)+#else+#define arm_bmxi(cc, i0, r0, i1) \+ ((jit_armv5_p()) ? \+ ((encode_arm_immediate(i1) != -1) ? \+ _TSTI(r0, encode_arm_immediate(i1)) : \+ (jit_movi_i(JIT_TMP, i1), _TST(r0, JIT_TMP))) : \+ ((encode_arm_immediate(i1) != -1) ? \+ _ANDSI(JIT_TMP, r0, encode_arm_immediate(i1)) : \+ ((encode_arm_immediate(~(i1)) != -1) ? \+ _BICSI(JIT_TMP, r0, encode_arm_immediate(~i1)) : \+ (jit_movi_i(JIT_TMP, i1), _ANDS(JIT_TMP, r0, JIT_TMP)))), \+ _jitl.thumb_pc = _jit.x.pc, \+ assert(_s24P((((long)(i0) - (long)_jitl.thumb_pc) >> 2) - 2)), \+ _CC_B(cc, ((((long)(i0) - (long)_jitl.thumb_pc) >> 2) - 2) & 0x00ffffff), \+ _jitl.thumb_pc)+#endif++#define jit_bmsr_i(i0, r0, r1) arm_bmxr(ARM_CC_NE, i0, r0, r1)+#define jit_bmsi_i(i0, r0, i1) arm_bmxi(ARM_CC_NE, i0, r0, i1)+#define jit_bmcr_i(i0, r0, r1) arm_bmxr(ARM_CC_EQ, i0, r0, r1)+#define jit_bmci_i(i0, r0, i1) arm_bmxi(ARM_CC_EQ, i0, r0, i1)++#ifdef USE_THUMB_CODE+#define jit_ldr_c(r0, r1) T2_LDRSBI(r0, r1, 0)+#else+#define jit_ldr_c(r0, r1) _LDRSBI(r0, r1, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldi_c(r0, i0) \+{ \+ jit_movi_i(JIT_TMP, (int)i0); \+ T2_LDRSBI(r0, JIT_TMP, 0); \+}+#else+#define jit_ldi_c(r0, i0) \+{ \+ jit_movi_i(JIT_TMP, (int)i0); \+ _LDRSBI(r0, JIT_TMP, 0); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxr_c(r0, r1, r2) \+ ((r0|r1|r2) < 8) ? T1_LDRSB(r0, r1, r2) : T2_LDRSB(r0, r1, r2)+#else+#define jit_ldxr_c(r0, r1, r2) _LDRSB(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxi_c(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 255) \+ T2_LDRSBI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -255) \+ T2_LDRSBIN(r0, r1, -i0); \+ else if (i0 >= 0 && i0 <= 4095) \+ T2_LDRSBWI(r0, r1, i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ if ((r0|r1|reg) < 8) \+ T1_LDRSB(r0, r1, reg); \+ else \+ T2_LDRSB(r0, r1, reg); \+ } \+}+#else+#define jit_ldxi_c(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 255) \+ _LDRSBI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -255) \+ _LDRSBIN(r0, r1, -i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _LDRSB(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_ldr_uc(r0, r1) T2_LDRBI(r0, r1, 0)+#else+#define jit_ldr_uc(r0, r1) _LDRBI(r0, r1, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldi_uc(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), T2_LDRBI(r0, JIT_TMP, 0))+#else+#define jit_ldi_uc(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), _LDRBI(r0, JIT_TMP, 0))+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxr_uc(r0, r1, r2) \+ ((r0|r1|r2) < 8) ? T1_LDRB(r0, r1, r2) : T2_LDRB(r0, r1, r2)+#else+#define jit_ldxr_uc(r0, r1, r2) _LDRB(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxi_uc(r0, r1, i0) \+{ \+ if ((r0|r1) < 8 && i0 >= 0 && i0 < 0x20) \+ T1_LDRBI(r0, r1, i0); \+ else if (i0 >= 0 && i0 <= 255) \+ T2_LDRBI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -255) \+ T2_LDRBIN(r0, r1, -i0); \+ else if (i0 >= 0 && i0 <= 4095) \+ T2_LDRBWI(r0, r1, i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ if ((r0|r1|reg) < 8) \+ T1_LDRB(r0, r1, reg); \+ else \+ T2_LDRB(r0, r1, reg); \+ } \+}+#else+#define jit_ldxi_uc(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 4095) \+ _LDRBI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -4095) \+ _LDRBIN(r0, r1, -i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _LDRB(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_ldr_s(r0, r1) T2_LDRSHI(r0, r1, 0)+#else+#define jit_ldr_s(r0, r1) _LDRSHI(r0, r1, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldi_s(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), T2_LDRSHI(r0, JIT_TMP, 0))+#else+#define jit_ldi_s(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), _LDRSHI(r0, JIT_TMP, 0))+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxr_s(r0, r1, r2) \+ ((r0|r1|r2) < 8) ? T1_LDRSH(r0, r1, r2) : T2_LDRSH(r0, r1, r2)+#else+#define jit_ldxr_s(r0, r1, r2) _LDRSH(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxi_s(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 255) \+ T2_LDRSHI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -255) \+ T2_LDRSHIN(r0, r1, -i0); \+ else if (i0 >= 0 && i0 <= 4095) \+ T2_LDRSHWI(r0, r1, i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ if ((r0|r1|reg) < 8) \+ T1_LDRSH(r0, r1, reg); \+ else \+ T2_LDRSH(r0, r1, reg); \+ } \+}+#else+#define jit_ldxi_s(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 255) \+ _LDRSHI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -255) \+ _LDRSHIN(r0, r1, -i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _LDRSH(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_ldr_us(r0, r1) T2_LDRHI(r0, r1, 0)+#else+#define jit_ldr_us(r0, r1) _LDRHI(r0, r1, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldi_us(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), T2_LDRHI(r0, JIT_TMP, 0))+#else+#define jit_ldi_us(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), _LDRHI(r0, JIT_TMP, 0))+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxr_us(r0, r1, r2) \+ ((r0|r1|r2) < 8) ? T1_LDRH(r0, r1, r2) : T2_LDRH(r0, r1, r2)+#else+#define jit_ldxr_us(r0, r1, r2) _LDRH(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxi_us(r0, r1, i0) \+{ \+ if ((r0|r1) < 8 && i0 >= 0 && !(i0 & 1) && (i0 >> 1) < 0x20) \+ T1_LDRHI(r0, r1, i0 >> 1); \+ else if (i0 >= 0 && i0 <= 255) \+ T2_LDRHI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -255) \+ T2_LDRHIN(r0, r1, -i0); \+ else if (i0 >= 0 && i0 <= 4095) \+ T2_LDRHWI(r0, r1, i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ if ((r0|r1|reg) < 8) \+ T1_LDRH(r0, r1, reg); \+ else \+ T2_LDRH(r0, r1, reg); \+ } \+}+#else+#define jit_ldxi_us(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 255) \+ _LDRHI(r0, r1, i0); \+ else if (i0 < 0 && i0 >= -255) \+ _LDRHIN(r0, r1, -i0); \+ else { \+ jit_gpr_t reg = r0 != r1 ? r0 : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _LDRH(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_ldr_i(r0, r1) T2_LDRI(r0, r1, 0)+#else+#define jit_ldr_i(r0, r1) _LDRI(r0, r1, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldi_i(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), T2_LDRI(r0, JIT_TMP, 0))+#else+#define jit_ldi_i(r0, i0) \+ (jit_movi_i(JIT_TMP, (int)i0), _LDRI(r0, JIT_TMP, 0))+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxr_i(r0, r1, r2) \+ (((r0|r1|r2) < 8) ? T1_LDR(r0, r1, r2) : T2_LDR(r0, r1, r2))+#else+#define jit_ldxr_i(r0, r1, r2) _LDR(r0, r1, r2)+#endif++#ifdef USE_THUMB_CODE+#define jit_ldxi_i(r0, r1, i0) \+{ \+ if (((r0)|(r1)) < 8 && (i0) >= 0 && !((i0) & 3) && ((i0) >> 2) < 0x20) \+ T1_LDRI(r0, r1, (i0) >> 2); \+ else if ((r1) == _R13 && (r0) < 8 && \+ (i0) >= 0 && !((i0) & 3) && ((i0) >> 2) <= 255) \+ T1_LDRISP(r0, (i0) >> 2); \+ else if ((i0) >= 0 && (i0) <= 255) \+ T2_LDRI(r0, r1, i0); \+ else if ((i0) < 0 && (i0) >= -255) \+ T2_LDRIN((r0), (r1), -(i0)); \+ else if ((i0) >= 0 && (i0) <= 4095) \+ T2_LDRWI(r0, r1, i0); \+ else { \+ jit_gpr_t reg = (r0) != (r1) ? (r0) : JIT_TMP; \+ jit_movi_i(reg, i0); \+ if (((r0)|(r1)|reg) < 8) \+ T1_LDR(r0, r1, reg); \+ else \+ T2_LDR(r0, r1, reg); \+ } \+}+#else+#define jit_ldxi_i(r0, r1, i0) \+{ \+ if ((i0) >= 0 && (i0) <= 4095) \+ _LDRI(r0, r1, i0); \+ else if ((i0) < 0 && (i0) >= -4095) \+ _LDRIN(r0, r1, -i0); \+ else { \+ jit_gpr_t reg = (r0) != (r1) ? (r0) : JIT_TMP; \+ jit_movi_i(reg, i0); \+ _LDR(r0, r1, reg); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_str_c(r0, r1) T2_STRBI(r1, r0, 0);+#else+#define jit_str_c(r0, r1) _STRBI(r1, r0, 0);+#endif++#ifdef USE_THUMB_CODE+#define jit_sti_c(r0, i0) (jit_movi_i(JIT_TMP, (int)i0), T2_STRBI(r0, JIT_TMP, 0))+#else+#define jit_sti_c(r0, i0) (jit_movi_i(JIT_TMP, (int)i0), _STRBI(r0, JIT_TMP, 0))+#endif++#ifdef USE_THUMB_CODE+#define jit_stxr_c(r0, r1, r2) \+ (((r0)|(r1)|(r2)) < 8) ? T1_STRB(r2, r1, r0) : T2_STRB(r2, r1, r0)+#else+#define jit_stxr_c(r0, r1, r2) _STRB(r2, r1, r0)+#endif++#ifdef USE_THUMB_CODE+#define jit_stxi_c(r0, r1, i0) \+{ \+ if ((r0|r1) < 8 && i0 >= 0 && i0 < 0x20) \+ T1_STRBI(r1, r0, i0); \+ else if (i0 >= 0 && i0 <= 255) \+ T2_STRBI(r1, r0, i0); \+ else if (i0 < 0 && i0 >= -255) \+ T2_STRBIN(r1, r0, -i0); \+ else if (i0 >= 0 && i0 <= 4095) \+ T2_STRBWI(r1, r0, i0); \+ else { \+ jit_movi_i(JIT_TMP, (int)i0); \+ if ((r0|r1|JIT_TMP) < 8) \+ T1_STRB(r1, r0, JIT_TMP); \+ else \+ T2_STRB(r1, r0, JIT_TMP); \+ } \+}+#else+#define jit_stxi_c(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 4095) \+ _STRBI(r1, r0, i0); \+ else if (i0 < 0 && i0 >= -4095) \+ _STRBIN(r1, r0, -i0); \+ else { \+ jit_movi_i(JIT_TMP, i0); \+ _STRB(r1, r0, JIT_TMP); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_str_s(r0, r1) T2_STRHI(r1, r0, 0)+#else+#define jit_str_s(r0, r1) _STRHI(r1, r0, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_sti_s(r0, i0) (jit_movi_i(JIT_TMP, (int)i0), T2_STRHI(r0, JIT_TMP, 0))+#else+#define jit_sti_s(r0, i0) (jit_movi_i(JIT_TMP, (int)i0), _STRHI(r0, JIT_TMP, 0))+#endif++#ifdef USE_THUMB_CODE+#define jit_stxr_s(r0, r1, r2) \+ ((((r0)|(r1)|(r2)) < 8) ? T1_STRH(r2, r1, r0) : T2_STRH(r2, r1, r0))+#else+#define jit_stxr_s(r0, r1, r2) _STRH(r2, r1, r0)+#endif++#ifdef USE_THUMB_CODE+#define jit_stxi_s(r0, r1, i0) \+{ \+ if ((r0|r1) < 8 && i0 >= 0 && !(i0 & 1) && (i0 >> 1) < 0x20) \+ T1_STRHI(r1, r0, i0 >> 1); \+ else if (i0 >= 0 && i0 <= 255) \+ T2_STRHI(r1, r0, i0); \+ else if (i0 < 0 && i0 >= -255) \+ T2_STRHIN(r1, r0, -i0); \+ else if (i0 >= 0 && i0 <= 4095) \+ T2_STRHWI(r1, r0, i0); \+ else { \+ jit_movi_i(JIT_TMP, (int)i0); \+ if ((r0|r1|JIT_TMP) < 8) \+ T1_STRH(r1, r0, JIT_TMP); \+ else \+ T2_STRH(r1, r0, JIT_TMP); \+ } \+}+#else+#define jit_stxi_s(r0, r1, i0) \+{ \+ if (i0 >= 0 && i0 <= 255) \+ _STRHI(r1, r0, i0); \+ else if (i0 < 0 && i0 >= -255) \+ _STRHIN(r1, r0, -i0); \+ else { \+ jit_movi_i(JIT_TMP, i0); \+ _STRH(r1, r0, JIT_TMP); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_str_i(r0, r1) T2_STRI(r1, r0, 0)+#else+#define jit_str_i(r0, r1) _STRI(r1, r0, 0)+#endif++#ifdef USE_THUMB_CODE+#define jit_sti_i(r0, i0) (jit_movi_i(JIT_TMP, (int)i0), T2_STRI(r0, JIT_TMP, 0))+#else+#define jit_sti_i(r0, i0) (jit_movi_i(JIT_TMP, (int)i0), _STRI(r0, JIT_TMP, 0))+#endif++#ifdef USE_THUMB_CODE+#define jit_stxr_i(r0, r1, r2) ((((r0)|(r1)|(r2)) < 8) ? T1_STR(r2, r1, r0) : T2_STR(r2, r1, r0))+#else+#define jit_stxr_i(r0, r1, r2) _STR(r2, r1, r0)+#endif++#ifdef USE_THUMB_CODE+#define jit_stxi_i(i0, r0, r1) \+{ \+ if ((r0|r1) < 8 && i0 >= 0 && !(i0 & 3) && (i0 >> 2) < 0x20) \+ T1_STRI(r1, r0, i0 >> 2); \+ else if (r0 == _R13 && r1 < 8 && \+ i0 >= 0 && !(i0 & 3) && (i0 >> 2) <= 255) \+ T1_STRISP(r1, i0 >> 2); \+ else if (i0 >= 0 && i0 <= 255) \+ T2_STRI(r1, r0, i0); \+ else if (i0 < 0 && i0 >= -255) \+ T2_STRIN(r1, r0, -i0); \+ else if (i0 >= 0 && i0 <= 4095) \+ T2_STRWI(r1, r0, i0); \+ else { \+ jit_movi_i(JIT_TMP, (int)i0); \+ if ((r0|r1|JIT_TMP) < 8) \+ T1_STR(r1, r0, JIT_TMP); \+ else \+ T2_STR(r1, r0, JIT_TMP); \+ } \+}+#else+#define jit_stxi_i(i0, r0, r1) \+{ \+ if (i0 >= 0 && i0 <= 4095) \+ _STRI(r1, r0, i0); \+ else if (i0 < 0 && i0 >= -4095) \+ _STRIN(r1, r0, -i0); \+ else { \+ jit_movi_i(JIT_TMP, i0); \+ _STR(r1, r0, JIT_TMP); \+ } \+}+#endif++#if __BYTE_ORDER == __LITTLE_ENDIAN+/* inline glibc htons (without register clobber) */+#ifdef USE_THUMB_CODE+#define jit_ntoh_us(r0, r1) \+ ((r0|r1) < 8) ? T1_REV16(r0, r1) : T2_REV16(r0, r1)+#else+#define jit_ntoh_us(r0, r1) \+{ \+ if (jit_armv6_p()) \+ _REV16(r0, r1); \+ else { \+ _LSLI(JIT_TMP, r1, 24); \+ _LSRI(r0, r1, 8); \+ _ORR_SI(r0, r0, JIT_TMP, ARM_LSR, 16); \+ } \+}+#endif++/* inline glibc htonl (without register clobber) */+#ifdef USE_THUMB_CODE+#define jit_ntoh_ui(r0, r1) \+ ((r0|r1) < 8) ? T1_REV(r0, r1) : T2_REV(r0, r1)+#else+#define jit_ntoh_ui(r0, r1) \+{ \+ if (jit_armv6_p()) \+ _REV(r0, r1); \+ else { \+ _EOR_SI(JIT_TMP, r1, r1, ARM_ROR, 16); \+ _LSRI(JIT_TMP, JIT_TMP, 8); \+ _BICI(JIT_TMP, JIT_TMP, encode_arm_immediate(0xff00)); \+ _EOR_SI(r0, JIT_TMP, r1, ARM_ROR, 8); \+ } \+}+#endif+#endif++#ifdef USE_THUMB_CODE+#define jit_extr_c_i(r0, r1) \+ ((r0|r1) < 8) ? T1_SXTB(r0, r1) : T2_SXTB(r0, r1)+#else+#define jit_extr_c_i(r0, r1) \+{ \+ if (jit_armv6_p()) \+ _SXTB(r0, r1); \+ else { \+ _LSLI(r0, r1, 24); \+ _ASRI(r0, r0, 24); \+ } \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_extr_c_ui(r0, r1) \+ ((r0|r1) < 8) ? T1_UXTB(r0, r1) : T2_UXTB(r0, r1)+#else+#define jit_extr_c_ui(r0, r1) \+ jit_armv6_p() ? _UXTB(r0, r1) : _ANDI(r0, r1, 0xff)+#endif++#ifdef USE_THUMB_CODE+#define jit_extr_s_i(r0, r1) \+ ((r0|r1) < 8) ? T1_SXTH(r0, r1) : T2_SXTH(r0, r1)+#else+#define jit_extr_s_i(r0, r1) \+ (jit_armv6_p()) ? _SXTH(r0, r1) : (_LSLI(r0, r1, 16), _ASRI(r0, r0, 16))+#endif++#ifdef USE_THUMB_CODE+#define jit_extr_s_ui(r0, r1) \+ ((r0|r1) < 8) ? T1_UXTH(r0, r1) : T2_UXTH(r0, r1)+#else+#define jit_extr_s_ui(r0, r1) \+ /* _ANDI(r0, r1, 0xffff) needs more instructions */ \+ (jit_armv6_p()) ? _UXTH(r0, r1) : (_LSLI(r0, r1, 16), _LSRI(r0, r0, 16))+#endif++#define jit_allocai(i0) \+ (assert((i0) >= 0), \+ _jitl.alloca_offset += i0, \+ jit_patch_movi(_jitl.stack, (void *) \+ ((_jitl.alloca_offset + _jitl.stack_length + 7) & -8)), \+ (-_jitl.alloca_offset))++#ifdef USE_THUMB_CODE+#define jit_prolog(n) \+{ \+ /* switch to thumb mode (better approach would be to+ * or 1 address being called, but no clear distinction+ * of what is a pointer to a jit function, or if patching+ * a pointer to a jit function) */ \+ _ADDI(_R12, _R15, 1); \+ _BX(_R12); \+ if (!_jitl.after_prolog) { \+ _jitl.after_prolog = 1; \+ _jitl.thumb_pc = _jit.x.pc; \+ } \+ if (jit_hardfp_p()) { \+ T2_PUSH((1<<_R4)|(1<<_R5)|(1<<_R6)|(1<<_R7)|(1<<_R8)|(1<<_R9)| \+ /* previous fp and return address */ \+ (1<<JIT_FP)|(1<<JIT_LR)); \+ _VPUSH_F64(_D8, 8); \+ T2_PUSH(/* arguments (should keep state and only save "i0" registers) */ \+ (1<<_R0)|(1<<_R1)|(1<<_R2)|(1<<_R3)); \+ } \+ else \+ T2_PUSH(/* arguments (should keep state and only save "i0" registers) */ \+ (1<<_R0)|(1<<_R1)|(1<<_R2)|(1<<_R3)| \+ (1<<_R4)|(1<<_R5)|(1<<_R6)|(1<<_R7)|(1<<_R8)|(1<<_R9)| \+ /* previous fp and return address */ \+ (1<<JIT_FP)|(1<<JIT_LR)); \+ T2_MOV(JIT_FP, JIT_SP); \+ \+ _jitl.nextarg_get = _jitl.nextarg_getf = 0; \+ _jitl.nextarg_put = 0; \+ _jitl.framesize = JIT_FRAMESIZE; \+ if (jit_hardfp_p()) \+ _jitl.framesize += 64; \+ \+ /* patch alloca and stack adjustment */ \+ _jitl.stack = (int *)_jit.x.pc; \+ \+ if (jit_swf_p()) \+ /* 6 soft double precision float registers */ \+ _jitl.alloca_offset = 48; \+ else \+ _jitl.alloca_offset = 0; \+ \+ jit_movi_p(JIT_TMP, (void *)_jitl.alloca_offset); \+ jit_subr_i(JIT_SP, JIT_SP, JIT_TMP); \+ _jitl.stack_length = _jitl.stack_offset = 0; \+}+#else+#define jit_prolog(n) \+{ \+ if (!_jitl.after_prolog) { \+ _jitl.after_prolog = 1; \+ _jitl.thumb_pc = _jit.x.pc; \+ } \+ if (jit_hardfp_p()) { \+ _PUSH((1<<_R4)|(1<<_R5)|(1<<_R6)|(1<<_R7)|(1<<_R8)|(1<<_R9)| \+ /* previous fp and return address */ \+ (1<<JIT_FP)|(1<<JIT_LR)); \+ _VPUSH_F64(_D8, 8); \+ _PUSH(/* arguments (should keep state and only save "i0" registers) */ \+ (1<<_R0)|(1<<_R1)|(1<<_R2)|(1<<_R3)); \+ } \+ else \+ _PUSH(/* arguments (should keep state and only save "i0" registers) */ \+ (1<<_R0)|(1<<_R1)|(1<<_R2)|(1<<_R3)| \+ (1<<_R4)|(1<<_R5)|(1<<_R6)|(1<<_R7)|(1<<_R8)|(1<<_R9)| \+ /* previous fp and return address */ \+ (1<<JIT_FP)|(1<<JIT_LR)); \+ _MOV(JIT_FP, JIT_SP); \+ \+ _jitl.nextarg_get = _jitl.nextarg_getf = 0; \+ _jitl.nextarg_put = 0; \+ _jitl.framesize = JIT_FRAMESIZE; \+ if (jit_hardfp_p()) \+ _jitl.framesize += 64; \+ \+ /* patch alloca and stack adjustment */ \+ _jitl.stack = (int *)_jit.x.pc; \+ _jitl.stack_length = _jitl.stack_offset = 0; \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_callr(r0) \+ (T1_ADDI3(JIT_LR, JIT_PC, 4), \+ T2_PUSH((1<<JIT_LR)), \+ T1_MOV(JIT_PC, r0))+#else+#define jit_callr(r0) \+ (_ADDI(JIT_LR, JIT_PC, 4), \+ _PUSH((1<<JIT_LR)), \+ _MOV(JIT_PC, r0))+#endif++#ifdef USE_THUMB_CODE+#define jit_calli(i0) \+ (_jitl.thumb_tmp = jit_movi_p(JIT_TMP, i0), \+ jit_callr(JIT_TMP), \+ _jitl.thumb_tmp)+#else+#define jit_calli(i0) \+ (_jitl.thumb_tmp = jit_movi_p(JIT_TMP, i0), \+ jit_callr(JIT_TMP), \+ _jitl.thumb_tmp)+#endif++#define jit_prepare_i(i0) \+ (assert((i0) >= 0 && !_jitl.nextarg_put), \+ _jitl.stack_offset = i0 << 2)++#define jit_arg_c() jit_arg_p()+#define jit_arg_uc() jit_arg_p()+#define jit_arg_s() jit_arg_p()+#define jit_arg_us() jit_arg_p()+#define jit_arg_i() jit_arg_p()+#define jit_arg_ui() jit_arg_p()+#define jit_arg_l() jit_arg_p()+#define jit_arg_ul() jit_arg_p()+#define jit_arg_p() \+ ((_jitl.nextarg_get > 2) ? \+ ((_jitl.framesize += sizeof(int)) - sizeof(int)) : \+ (_jitl.nextarg_get++))++#define jit_getarg_c(r0, i0) \+ jit_ldxi_c(r0, JIT_FP, (((i0) < 4) ? (i0) << 2 : (i0)) + ((__BYTE_ORDER == __BIG_ENDIAN) ? (sizeof(int) - sizeof(char)) : 0))++#define jit_getarg_uc(r0, i0) \+ jit_ldxi_uc(r0, JIT_FP, (((i0) < 4) ? (i0) << 2 : (i0)) + ((__BYTE_ORDER == __BIG_ENDIAN) ? (sizeof(int) - sizeof(char)) : 0))++#define jit_getarg_s(r0, i0) \+ jit_ldxi_s(r0, JIT_FP, (((i0) < 4) ? (i0) << 2 : (i0)) + ((__BYTE_ORDER == __BIG_ENDIAN) ? (sizeof(int) - sizeof(short)) : 0))++#define jit_getarg_us(r0, i0) \+ jit_ldxi_us(r0, JIT_FP, (((i0) < 4) ? (i0) << 2 : (i0)) + ((__BYTE_ORDER == __BIG_ENDIAN) ? (sizeof(int) - sizeof(short)) : 0))++#define jit_getarg_i(r0, i0) arm_getarg_i(_jit, r0, i0)+#define jit_getarg_ui(r0, i0) arm_getarg_i(_jit, r0, i0)+#define jit_getarg_l(r0, i0) arm_getarg_i(_jit, r0, i0)+#define jit_getarg_ul(r0, i0) arm_getarg_i(_jit, r0, i0)+#define jit_getarg_p(r0, i0) \+ jit_ldxi_i(r0, JIT_FP, (((i0) < 4) ? (i0) << 2 : (i0))); /* arguments are saved in prolog */++#define jit_pusharg_i(r0) \+ (jit_pushr_i(r0), _jitl.nextarg_put++)++#ifdef USE_THUMB_CODE+#define jit_finishr(rs) \+{ \+ if (r0 < 4) { \+ jit_movr_i(JIT_TMP, r0); \+ r0 = JIT_TMP; \+ } \+ if (_jitl.nextarg_put) { \+ T2_POP(((1 << _jitl.nextarg_put) - 1) & 0xf); \+ _jitl.nextarg_put = 0; \+ } \+ T1_BLX(r0); \+}+#else+#define jit_finishr(rs) \+{ \+ if (r0 < 4) { \+ jit_movr_i(JIT_TMP, r0); \+ r0 = JIT_TMP; \+ } \+ if (_jitl.nextarg_put) { \+ _POP(((1 << _jitl.nextarg_put) - 1) & 0xf); \+ _jitl.nextarg_put = 0; \+ } \+ _BLX(r0); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_finish(i0) \+ ((_jitl.nextarg_put) ? \+ (T2_POP(((1 << _jitl.nextarg_put) - 1) & 0xf), \+ _jitl.nextarg_put = 0) : 0, \+ _jitl.thumb_tmp = jit_movi_p(JIT_TMP, i0), \+ T1_BLX(JIT_TMP), \+ _jitl.thumb_tmp)+#else+#define jit_finish(i0) \+ ((_jitl.nextarg_put) ? \+ (_POP(((1 << _jitl.nextarg_put) - 1) & 0xf), \+ _jitl.nextarg_put = 0) : 0, \+ _jitl.thumb_tmp = jit_movi_p(JIT_TMP, i0), \+ _BLX(JIT_TMP), \+ _jitl.thumb_tmp)+#endif++#define jit_retval_i(r0) jit_movr_i(r0, JIT_RET)++#ifdef USE_THUMB_CODE+#define jit_ret() \+{ \+ /* do not restore arguments */ \+ jit_addi_i(JIT_SP, JIT_FP, 16); \+ if (jit_hardfp_p()) \+ _VPOP_F64(_D8, 8); \+ T2_POP(/* callee save */ \+ (1<<_R4)|(1<<_R5)|(1<<_R6)|(1<<_R7)|(1<<_R8)|(1<<_R9)| \+ /* previous fp and return address */ \+ (1<<JIT_FP)|(1<<JIT_PC)); \+ if (((int)_jit.x.pc & 2)) \+ T1_NOP(); \+}+#else+#define jit_ret() \+{ \+ /* do not restore arguments */ \+ jit_addi_i(JIT_SP, JIT_FP, 16); \+ if (jit_hardfp_p()) \+ _VPOP_F64(_D8, 8); \+ _POP(/* callee save */ \+ (1<<_R4)|(1<<_R5)|(1<<_R6)|(1<<_R7)|(1<<_R8)|(1<<_R9)| \+ /* previous fp and return address */ \+ (1<<JIT_FP)|(1<<JIT_PC)); \+}+#endif++#ifdef USE_THUMB_CODE+#define jit_bare_ret() T2_POP(1<<JIT_PC)+#else+#define jit_bare_ret() _POP(1<<JIT_PC)+#endif++#ifdef USE_THUMB_CODE+# define jit_pushr_i(r0) T2_PUSH((1<<r0))+# define jit_popr_i(r0) T2_POP((1<<r0))+#else+# define jit_pushr_i(r0) _PUSH((1<<r0))+# define jit_popr_i(r0) _POP((1<<r0))+#endif++#endif /* __lightning_core_arm_h */
@@ -0,0 +1,1253 @@+/******************************** -*- C -*- ****************************+ *+ * Support macros for arm software floating-point math+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2011 Free Software Foundation, Inc.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ * Authors:+ * Paulo Cesar Pereira de Andrade+ ***********************************************************************/+++#ifndef __lightning_fp_swf_h+#define __lightning_fp_swf_h++#include <math.h>++#define swf_off(rn) ((rn) << 2)++extern float __addsf3(float, float);+extern double __adddf3(double, double);+extern float __aeabi_fsub(float, float);+extern double __aeabi_dsub(double, double);+extern float __aeabi_fmul(float, float);+extern double __aeabi_dmul(double, double);+extern float __aeabi_fdiv(float, float);+extern double __aeabi_ddiv(double, double);+extern float __aeabi_i2f(int);+extern double __aeabi_i2d(int);+extern float __aeabi_d2f(double);+extern double __aeabi_f2d(float);+extern int __aeabi_f2iz(double);+extern int __aeabi_d2iz(float);+extern int __aeabi_fcmplt(float, float);+extern int __aeabi_dcmplt(double, double);+extern int __aeabi_fcmple(float, float);+extern int __aeabi_dcmple(double, double);+extern int __aeabi_fcmpeq(float, float);+extern int __aeabi_dcmpeq(double, double);+extern int __aeabi_fcmpge(float, float);+extern int __aeabi_dcmpge(double, double);+extern int __aeabi_fcmpgt(float, float);+extern int __aeabi_dcmpgt(double, double);+extern int __aeabi_fcmpun(float, float);+extern int __aeabi_dcmpun(double, double);++#define swf_call(function, label) \+ do { \+ int d; \+ if (!jit_exchange_p()) { \+ if (jit_thumb_p()) \+ d = (((int)function - (int)_jit->x.pc) >> 1) - 2; \+ else \+ d = (((int)function - (int)_jit->x.pc) >> 2) - 2; \+ if (_s24P(d)) { \+ if (jit_thumb_p()) \+ T2_BLI(encode_thumb_jump(d)); \+ else \+ _BLI(d & 0x00ffffff); \+ } \+ else \+ goto label; \+ } \+ else { \+ label: \+ jit_movi_i(JIT_FTMP, (int)function); \+ if (jit_thumb_p()) \+ T1_BLX(JIT_FTMP); \+ else \+ _BLX(JIT_FTMP); \+ } \+ } while (0)+#define swf_ldrin(rt, rn, im) \+ do { \+ if (jit_thumb_p()) T2_LDRIN(rt, rn, im); \+ else _LDRIN(rt, rn, im); \+ } while (0)+#define swf_strin(rt, rn, im) \+ do { \+ if (jit_thumb_p()) T2_STRIN(rt, rn, im); \+ else _STRIN(rt, rn, im); \+ } while (0)+#define swf_push(mask) \+ do { \+ if (jit_thumb_p()) T1_PUSH(mask); \+ else _PUSH(mask); \+ } while (0)+#define swf_pop(mask) \+ do { \+ if (jit_thumb_p()) T1_POP(mask); \+ else _POP(mask); \+ } while (0)+#define swf_bici(rt, rn, im) \+ do { \+ if (jit_thumb_p()) \+ T2_BICI(rt, rn, encode_thumb_immediate(im)); \+ else \+ _BICI(rt, rn, encode_arm_immediate(im)); \+ } while (0)+#if 0+__jit_inline void+swf_movr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ if (r0 != r1) {+ if (r0 == JIT_FPRET)+ /* jit_ret() must follow! */+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ else {+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ }+ }+}++__jit_inline void+swf_movr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ if (r0 != r1) {+ if (!jit_thumb_p() && jit_armv5e_p()) {+ if (r0 == JIT_FPRET)+ /* jit_ret() must follow! */+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ else {+ _LDRDIN(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ _STRDIN(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ }+ }+ else {+ if (r0 == JIT_FPRET) {+ /* jit_ret() must follow! */+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ }+ else {+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 4);+ swf_strin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+ }+ }+}++__jit_inline void+swf_movi_f(jit_state_t _jit, jit_fpr_t r0, float i0)+{+ union {+ int i;+ float f;+ } u;+ u.f = i0;+ if (r0 == JIT_FPRET)+ /* jit_ret() must follow! */+ jit_movi_i(_R0, u.i);+ else {+ jit_movi_i(JIT_FTMP, u.i);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ }+}++__jit_inline void+swf_movi_d(jit_state_t _jit, jit_fpr_t r0, double i0)+{+ union {+ int i[2];+ double d;+ } u;+ u.d = i0;+ if (r0 == JIT_FPRET) {+ /* jit_ret() must follow! */+ jit_movi_i(_R0, u.i[0]);+ jit_movi_i(_R1, u.i[1]);+ }+ else {+ jit_movi_i(JIT_FTMP, u.i[0]);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ jit_movi_i(JIT_FTMP, u.i[1]);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+}++__jit_inline void+swf_extr_i_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ swf_push(0xf);+ if (r1 != _R0)+ jit_movr_i(_R0, r1);+ swf_call(__aeabi_i2f, i2f);+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_pop(0xf);+}++__jit_inline void+swf_extr_i_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ swf_push(0xf);+ if (r1 != _R0)+ jit_movr_i(_R0, r1);+ swf_call(__aeabi_i2d, i2d);+ if (!jit_thumb_p() && jit_armv5e_p())+ _STRDIN(_R0, JIT_FP, swf_off(r0) + 8);+ else {+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_strin(_R1, JIT_FP, swf_off(r0) + 4);+ }+ swf_pop(0xf);+}++static void+swf_extr_d_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ swf_push(0xf);+ if (!jit_thumb_p() && jit_armv5e_p())+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ }+ swf_call(__aeabi_d2f, d2f);+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_pop(0xf);+}++static void+swf_extr_f_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ swf_push(0xf);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_call(__aeabi_f2d, f2d);+ if (!jit_thumb_p() && jit_armv5e_p())+ _STRDIN(_R0, JIT_FP, swf_off(r0) + 8);+ else {+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_strin(_R1, JIT_FP, swf_off(r0) + 4);+ }+ swf_pop(0xf);+}++static void+swf_if(jit_state_t _jit, float (*i0)(float), jit_gpr_t r0, jit_fpr_t r1)+{+ int l;+#if !NAN_TO_INT_IS_ZERO+ jit_insn *is_nan;+ jit_insn *fast_not_nan;+ jit_insn *slow_not_nan;+#endif+ l = 0xf;+ if ((int)r0 < 4)+ /* bogus extra push to align at 8 bytes */+ l = (l & ~(1 << r0)) | 0x10;+ swf_push(l);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+#if !NAN_TO_INT_IS_ZERO+ /* >> based on fragment of __aeabi_fcmpun */+ jit_lshi_i(JIT_FTMP, _R0, 1);+ if (jit_thumb_p())+ torrrs(THUMB2_MVN|ARM_S, _R0, JIT_TMP, JIT_FTMP,+ encode_thumb_shift(24, ARM_ASR));+ else+ corrrs(ARM_CC_AL,ARM_MVN|ARM_S|ARM_ASR, _R0, JIT_TMP, JIT_FTMP, 24);+ fast_not_nan = _jit->x.pc;+ if (jit_thumb_p()) {+ T2_CC_B(ARM_CC_NE, 0);+ tshift(THUMB2_LSLI|ARM_S, _R0, JIT_TMP, 9);+ }+ else {+ _CC_B(ARM_CC_NE, 0);+ cshift(ARM_CC_AL, ARM_S|ARM_LSL, _R0, JIT_TMP, _R0, 9);+ }+ slow_not_nan = _jit->x.pc;+ if (jit_thumb_p())+ T2_CC_B(ARM_CC_EQ, 0);+ else+ _CC_B(ARM_CC_EQ, 0);+ jit_movi_i(r0, 0x80000000);+ is_nan = _jit->x.pc;+ if (jit_thumb_p())+ T2_B(0);+ else+ _B(ARM_CC_AL, 0);+ jit_patch(fast_not_nan);+ jit_patch(slow_not_nan);+ /* << based on fragment of __aeabi_fcmpun */+#endif+ if (i0)+ swf_call(i0, fallback);+ swf_call(__aeabi_f2iz, f2iz);+ jit_movr_i(r0, _R0);+#if !NAN_TO_INT_IS_ZERO+ jit_patch(is_nan);+#endif+ swf_pop(l);+}++static void+swf_id(jit_state_t _jit, double (*i0)(double), jit_gpr_t r0, jit_fpr_t r1)+{+ int l;+#if !NAN_TO_INT_IS_ZERO+ jit_insn *is_nan;+ jit_insn *fast_not_nan;+ jit_insn *slow_not_nan;+#endif+ l = 0xf;+ if ((int)r0 < 4)+ /* bogus extra push to align at 8 bytes */+ l = (l & ~(1 << r0)) | 0x10;+ swf_push(l);+ if (!jit_thumb_p() && jit_armv5e_p())+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ }+#if !NAN_TO_INT_IS_ZERO+ /* >> based on fragment of __aeabi_dcmpun */+ jit_lshi_i(JIT_TMP, _R1, 1);+ if (jit_thumb_p())+ torrrs(THUMB2_MVN|ARM_S, _R0, JIT_TMP, JIT_TMP,+ encode_thumb_shift(21, ARM_ASR));+ else+ corrrs(ARM_CC_AL,ARM_MVN|ARM_S|ARM_ASR, _R0, JIT_TMP, JIT_TMP, 21);+ fast_not_nan = _jit->x.pc;+ if (jit_thumb_p()) {+ T2_CC_B(ARM_CC_NE, 0);+ torrrs(THUMB2_ORR|ARM_S, _R0, JIT_TMP, _R1,+ encode_thumb_shift(12, ARM_LSL));+ }+ else {+ _CC_B(ARM_CC_NE, 0);+ corrrs(ARM_CC_AL,ARM_ORR|ARM_S|ARM_LSL, _R0, JIT_TMP, _R1, 12);+ }+ slow_not_nan = _jit->x.pc;+ if (jit_thumb_p())+ T2_CC_B(ARM_CC_EQ, 0);+ else+ _CC_B(ARM_CC_EQ, 0);+ jit_movi_i(r0, 0x80000000);+ is_nan = _jit->x.pc;+ if (jit_thumb_p())+ T2_B(0);+ else+ _B(0);+ jit_patch(fast_not_nan);+ jit_patch(slow_not_nan);+ /* << based on fragment of __aeabi_dcmpun */+#endif+ if (i0)+ swf_call(i0, fallback);+ swf_call(__aeabi_d2iz, d2iz);+ jit_movr_i(r0, _R0);+#if !NAN_TO_INT_IS_ZERO+ jit_patch(is_nan);+#endif+ swf_pop(l);+}++#define swf_rintr_f_i(_jit, r0, r1) swf_if(_jit, rintf, r0, r1)+#define swf_rintr_d_i(_jit, r0, r1) swf_id(_jit, rint, r0, r1)+#define swf_roundr_f_i(_jit, r0, r1) swf_if(_jit, roundf, r0, r1)+#define swf_roundr_d_i(_jit, r0, r1) swf_id(_jit, round, r0, r1)+#define swf_truncr_f_i(_jit, r0, r1) swf_if(_jit, (void *)0, r0, r1)+#define swf_truncr_d_i(_jit, r0, r1) swf_id(_jit, (void *)0, r0, r1)+#define swf_ceilr_f_i(_jit, r0, r1) swf_if(_jit, ceilf, r0, r1)+#define swf_ceilr_d_i(_jit, r0, r1) swf_id(_jit, ceil, r0, r1)+#define swf_floorr_f_i(_jit, r0, r1) swf_if(_jit, floorf, r0, r1)+#define swf_floorr_d_i(_jit, r0, r1) swf_id(_jit, floor, r0, r1)++__jit_inline void+swf_absr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 8);+ swf_bici(JIT_FTMP, JIT_FTMP, 0x80000000);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+}++__jit_inline void+swf_absr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 4);+ swf_bici(JIT_FTMP, JIT_FTMP, 0x80000000);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ if (r0 != r1) {+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ }+}++__jit_inline void+swf_negr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 8);+ jit_xori_i(JIT_FTMP, JIT_FTMP, 0x80000000);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+}++__jit_inline void+swf_negr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 4);+ jit_xori_i(JIT_FTMP, JIT_FTMP, 0x80000000);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ if (r0 != r1) {+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ }+}++static void+swf_ff(jit_state_t _jit, float (*i0)(float), jit_fpr_t r0, jit_fpr_t r1)+{+ swf_push(0xf);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_call(i0, fallback);+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_pop(0xf);+}++static void+swf_dd(jit_state_t _jit, double (*i0)(double), jit_fpr_t r0, jit_fpr_t r1)+{+ swf_push(0xf);+ if (!jit_thumb_p() && jit_armv5e_p())+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ }+ swf_call(i0, fallback);+ if (!jit_thumb_p() && jit_armv5e_p())+ _STRDIN(_R0, JIT_FP, swf_off(r0) + 8);+ else {+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_strin(_R1, JIT_FP, swf_off(r0) + 4);+ }+ swf_pop(0xf);+}++#define swf_sqrtr_f(_jit, r0, r1) swf_ff(_jit, sqrtf, r0, r1)+#define swf_sqrtr_d(_jit, r0, r1) swf_dd(_jit, sqrt, r0, r1)++static void+swf_fff(jit_state_t _jit, float (*i0)(float, float),+ jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_push(0xf);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r2) + 8);+ swf_call(i0, fallback);+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_pop(0xf);+}++static void+swf_ddd(jit_state_t _jit, double (*i0)(double, double),+ jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_push(0xf);+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ _LDRDIN(_R2, JIT_FP, swf_off(r2) + 8);+ }+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ swf_ldrin(_R2, JIT_FP, swf_off(r2) + 8);+ swf_ldrin(_R3, JIT_FP, swf_off(r2) + 4);+ }+ swf_call(i0, fallback);+ if (!jit_thumb_p() && jit_armv5e_p())+ _STRDIN(_R0, JIT_FP, swf_off(r0) + 8);+ else {+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_strin(_R1, JIT_FP, swf_off(r0) + 4);+ }+ swf_pop(0xf);+}++#define swf_addr_f(_jit, r0, r1, r2) swf_fff(_jit, __addsf3, r0, r1, r2)+#define swf_addr_d(_jit, r0, r1, r2) swf_ddd(_jit, __adddf3, r0, r1, r2)+#define swf_subr_f(_jit, r0, r1, r2) swf_fff(_jit, __aeabi_fsub, r0, r1, r2)+#define swf_subr_d(_jit, r0, r1, r2) swf_ddd(_jit, __aeabi_dsub, r0, r1, r2)+#define swf_mulr_f(_jit, r0, r1, r2) swf_fff(_jit, __aeabi_fmul, r0, r1, r2)+#define swf_mulr_d(_jit, r0, r1, r2) swf_ddd(_jit, __aeabi_dmul, r0, r1, r2)+#define swf_divr_f(_jit, r0, r1, r2) swf_fff(_jit, __aeabi_fdiv, r0, r1, r2)+#define swf_divr_d(_jit, r0, r1, r2) swf_ddd(_jit, __aeabi_ddiv, r0, r1, r2)++static void+swf_iff(jit_state_t _jit, int (*i0)(float, float),+ jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ int l;+ l = 0xf;+ if ((int)r0 < 4)+ /* bogus extra push to align at 8 bytes */+ l = (l & ~(1 << r0)) | 0x10;+ swf_push(l);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r2) + 8);+ swf_call(i0, fallback);+ jit_movr_i(r0, _R0);+ swf_pop(l);+}++static void+swf_idd(jit_state_t _jit, int (*i0)(double, double),+ jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ int l;+ l = 0xf;+ if ((int)r0 < 4)+ /* bogus extra push to align at 8 bytes */+ l = (l & ~(1 << r0)) | 0x10;+ swf_push(l);+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ _LDRDIN(_R2, JIT_FP, swf_off(r2) + 8);+ }+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ swf_ldrin(_R2, JIT_FP, swf_off(r2) + 8);+ swf_ldrin(_R3, JIT_FP, swf_off(r2) + 4);+ }+ swf_call(i0, fallback);+ jit_movr_i(r0, _R0);+ swf_pop(l);+}++#define swf_ltr_f(_jit, r0, r1, r2) swf_iff(_jit, __aeabi_fcmplt,r0,r1,r2)+#define swf_ltr_d(_jit, r0, r1, r2) swf_idd(_jit, __aeabi_dcmplt,r0,r1,r2)+#define swf_ler_f(_jit, r0, r1, r2) swf_iff(_jit, __aeabi_fcmple,r0,r1,r2)+#define swf_ler_d(_jit, r0, r1, r2) swf_idd(_jit, __aeabi_dcmple,r0,r1,r2)+#define swf_eqr_f(_jit, r0, r1, r2) swf_iff(_jit, __aeabi_fcmpeq,r0,r1,r2)+#define swf_eqr_d(_jit, r0, r1, r2) swf_idd(_jit, __aeabi_dcmpeq,r0,r1,r2)+#define swf_ger_f(_jit, r0, r1, r2) swf_iff(_jit, __aeabi_fcmpge,r0,r1,r2)+#define swf_ger_d(_jit, r0, r1, r2) swf_idd(_jit, __aeabi_dcmpge,r0,r1,r2)+#define swf_gtr_f(_jit, r0, r1, r2) swf_iff(_jit, __aeabi_fcmpgt,r0,r1,r2)+#define swf_gtr_d(_jit, r0, r1, r2) swf_idd(_jit, __aeabi_dcmpgt,r0,r1,r2)++__jit_inline void+swf_ner_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_iff(_jit, __aeabi_fcmpeq, r0, r1, r2);+ jit_xori_i(r0, r0, 1);+}++__jit_inline void+swf_ner_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_idd(_jit, __aeabi_dcmpeq, r0, r1, r2);+ jit_xori_i(r0, r0, 1);+}++static void+swf_iunff(jit_state_t _jit, int (*i0)(float, float),+ jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ int l;+ jit_insn *i;+ l = 0xf;+ if ((int)r0 < 4)+ /* bogus extra push to align at 8 bytes */+ l = (l & ~(1 << r0)) | 0x10;+ swf_push(l);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r2) + 8);+ swf_call(__aeabi_fcmpun, fcmpun);+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ _IT(ARM_CC_NE);+ if (r0 < 8)+ T1_MOVI(r0, 1);+ else+ T2_MOVI(r0, 1);+ i = _jit->x.pc;+ T2_CC_B(ARM_CC_NE, 0);+ }+ else {+ _CMPI(_R0, 0);+ _CC_MOVI(ARM_CC_NE, r0, 1);+ i = _jit->x.pc;+ _CC_B(ARM_CC_NE, 0);+ }+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r2) + 8);+ swf_call(i0, fallback);+ jit_movr_i(r0, _R0);+ jit_patch(i);+ swf_pop(l);+}++static void+swf_iundd(jit_state_t _jit, int (*i0)(double, double),+ jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ int l;+ jit_insn *i;+ l = 0xf;+ if ((int)r0 < 4)+ /* bogus extra push to align at 8 bytes */+ l = (l & ~(1 << r0)) | 0x10;+ swf_push(l);+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ _LDRDIN(_R2, JIT_FP, swf_off(r2) + 8);+ }+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ swf_ldrin(_R2, JIT_FP, swf_off(r2) + 8);+ swf_ldrin(_R3, JIT_FP, swf_off(r2) + 4);+ }+ swf_call(__aeabi_dcmpun, dcmpun);+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ _IT(ARM_CC_NE);+ if (r0 < 8)+ T1_MOVI(r0, 1);+ else+ T2_MOVI(r0, 1);+ i = _jit->x.pc;+ T2_CC_B(ARM_CC_NE, 0);+ }+ else {+ _CMPI(_R0, 0);+ _CC_MOVI(ARM_CC_NE, r0, 1);+ i = _jit->x.pc;+ _CC_B(ARM_CC_NE, 0);+ }+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ _LDRDIN(_R2, JIT_FP, swf_off(r2) + 8);+ }+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ swf_ldrin(_R2, JIT_FP, swf_off(r2) + 8);+ swf_ldrin(_R3, JIT_FP, swf_off(r2) + 4);+ }+ swf_call(i0, fallback);+ jit_movr_i(r0, _R0);+ jit_patch(i);+ swf_pop(l);+}++#define swf_unltr_f(_jit, r0, r1, r2) swf_iunff(_jit,__aeabi_fcmplt,r0,r1,r2)+#define swf_unltr_d(_jit, r0, r1, r2) swf_iundd(_jit,__aeabi_dcmplt,r0,r1,r2)+#define swf_unler_f(_jit, r0, r1, r2) swf_iunff(_jit,__aeabi_fcmple,r0,r1,r2)+#define swf_unler_d(_jit, r0, r1, r2) swf_iundd(_jit,__aeabi_dcmple,r0,r1,r2)+#define swf_uneqr_f(_jit, r0, r1, r2) swf_iunff(_jit,__aeabi_fcmpeq,r0,r1,r2)+#define swf_uneqr_d(_jit, r0, r1, r2) swf_iundd(_jit,__aeabi_dcmpeq,r0,r1,r2)+#define swf_unger_f(_jit, r0, r1, r2) swf_iunff(_jit,__aeabi_fcmpge,r0,r1,r2)+#define swf_unger_d(_jit, r0, r1, r2) swf_iundd(_jit,__aeabi_dcmpge,r0,r1,r2)+#define swf_ungtr_f(_jit, r0, r1, r2) swf_iunff(_jit,__aeabi_fcmpgt,r0,r1,r2)+#define swf_ungtr_d(_jit, r0, r1, r2) swf_iundd(_jit,__aeabi_dcmpgt,r0,r1,r2)++__jit_inline void+swf_ltgtr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_iunff(_jit, __aeabi_fcmpeq, r0, r1, r2);+ jit_xori_i(r0, r0, 1);+}++__jit_inline void+swf_ltgtr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_iundd(_jit, __aeabi_dcmpeq, r0, r1, r2);+ jit_xori_i(r0, r0, 1);+}++__jit_inline void+swf_ordr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_iff(_jit, __aeabi_fcmpun, r0, r1, r2);+ jit_xori_i(r0, r0, 1);+}++__jit_inline void+swf_ordr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ swf_idd(_jit, __aeabi_dcmpun, r0, r1, r2);+ jit_xori_i(r0, r0, 1);+}++#define swf_unordr_f(_jit, r0, r1, r2) swf_iunff(_jit,__aeabi_fcmpun,r0,r1,r2)+#define swf_unordr_d(_jit, r0, r1, r2) swf_iundd(_jit,__aeabi_dcmpun,r0,r1,r2)++static jit_insn *+swf_bff(jit_state_t _jit, int (*i0)(float, float), int cc,+ void *i1, jit_fpr_t r1, jit_fpr_t r2)+{+ jit_insn *l;+ int d;+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ swf_push(0xf);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r2) + 8);+ swf_call(i0, fallback);+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 1) - 2;+ assert(_s20P(d));+ T2_CC_B(cc, encode_thumb_cc_jump(d));+ }+ else {+ _CMPI(_R0, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 2) - 2;+ assert(_s24P(d));+ _CC_B(cc, d & 0x00ffffff);+ }+ return (l);+}++static jit_insn *+swf_bdd(jit_state_t _jit, int (*i0)(double, double), int cc,+ void *i1, jit_fpr_t r1, jit_fpr_t r2)+{+ jit_insn *l;+ int d;+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ swf_push(0xf);+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ _LDRDIN(_R2, JIT_FP, swf_off(r2) + 8);+ }+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ swf_ldrin(_R2, JIT_FP, swf_off(r2) + 8);+ swf_ldrin(_R3, JIT_FP, swf_off(r2) + 4);+ }+ swf_call(i0, fallback);+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 1) - 2;+ assert(_s20P(d));+ T2_CC_B(cc, encode_thumb_cc_jump(d));+ }+ else {+ _CMPI(_R0, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 2) - 2;+ assert(_s24P(d));+ _CC_B(cc, d & 0x00ffffff);+ }+ return (l);+}++#define swf_bltr_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmplt,ARM_CC_NE,i0,r0,r1)+#define swf_bltr_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmplt,ARM_CC_NE,i0,r0,r1)+#define swf_bler_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmple,ARM_CC_NE,i0,r0,r1)+#define swf_bler_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmple,ARM_CC_NE,i0,r0,r1)+#define swf_beqr_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpeq,ARM_CC_NE,i0,r0,r1)+#define swf_beqr_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpeq,ARM_CC_NE,i0,r0,r1)+#define swf_bger_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpge,ARM_CC_NE,i0,r0,r1)+#define swf_bger_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpge,ARM_CC_NE,i0,r0,r1)+#define swf_bgtr_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpgt,ARM_CC_NE,i0,r0,r1)+#define swf_bgtr_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpgt,ARM_CC_NE,i0,r0,r1)+#define swf_bner_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpeq,ARM_CC_EQ,i0,r0,r1)+#define swf_bner_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpeq,ARM_CC_EQ,i0,r0,r1)+#define swf_bunltr_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpge,ARM_CC_EQ,i0,r0,r1)+#define swf_bunltr_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpge,ARM_CC_EQ,i0,r0,r1)+#define swf_bunler_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpgt,ARM_CC_EQ,i0,r0,r1)+#define swf_bunler_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpgt,ARM_CC_EQ,i0,r0,r1)++static jit_insn *+swf_bunff(jit_state_t _jit, int eq, void *i1, jit_fpr_t r1, jit_fpr_t r2)+{+ int d;+ jit_insn *l;+ jit_insn *j0;+ jit_insn *j1;+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ swf_push(0xf);+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r2) + 8);+ swf_call(__aeabi_fcmpun, fcmpun);+ /* if unordered */+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ j0 = _jit->x.pc;+ T2_CC_B(ARM_CC_NE, 0);+ }+ else {+ _CMPI(_R0, 0);+ j0 = _jit->x.pc;+ _CC_B(ARM_CC_NE, 0);+ }+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r2) + 8);+ swf_call(__aeabi_fcmpeq, fcmpeq);+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ j1 = _jit->x.pc;+ if (eq) {+ T2_CC_B(ARM_CC_EQ, 0);+ jit_patch(j0);+ }+ else+ T2_CC_B(ARM_CC_NE, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 1) - 2;+ assert(_s24P(d));+ T2_B(encode_thumb_jump(d));+ }+ else {+ _CMPI(_R0, 0);+ j1 = _jit->x.pc;+ if (eq) {+ _CC_B(ARM_CC_EQ, 0);+ jit_patch(j0);+ }+ else+ _CC_B(ARM_CC_NE, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 2) - 2;+ assert(_s24P(d));+ _B(d & 0x00ffffff);+ }+ if (!eq)+ jit_patch(j0);+ jit_patch(j1);+ swf_pop(0xf);+ return (l);+}++static jit_insn *+swf_bundd(jit_state_t _jit, int eq, void *i1, jit_fpr_t r1, jit_fpr_t r2)+{+ int d;+ jit_insn *l;+ jit_insn *j0;+ jit_insn *j1;+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ swf_push(0xf);+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ _LDRDIN(_R2, JIT_FP, swf_off(r2) + 8);+ }+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ swf_ldrin(_R2, JIT_FP, swf_off(r2) + 8);+ swf_ldrin(_R3, JIT_FP, swf_off(r2) + 4);+ }+ swf_call(__aeabi_dcmpun, dcmpun);+ /* if unordered */+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ j0 = _jit->x.pc;+ T2_CC_B(ARM_CC_NE, 0);+ }+ else {+ _CMPI(_R0, 0);+ j0 = _jit->x.pc;+ _CC_B(ARM_CC_NE, 0);+ }+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(_R0, JIT_FP, swf_off(r1) + 8);+ _LDRDIN(_R2, JIT_FP, swf_off(r2) + 8);+ }+ else {+ swf_ldrin(_R0, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(_R1, JIT_FP, swf_off(r1) + 4);+ swf_ldrin(_R2, JIT_FP, swf_off(r2) + 8);+ swf_ldrin(_R3, JIT_FP, swf_off(r2) + 4);+ }+ swf_call(__aeabi_dcmpeq, dcmpeq);+ if (jit_thumb_p()) {+ T1_CMPI(_R0, 0);+ j1 = _jit->x.pc;+ if (eq) {+ T2_CC_B(ARM_CC_EQ, 0);+ jit_patch(j0);+ }+ else+ T2_CC_B(ARM_CC_NE, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 1) - 2;+ assert(_s24P(d));+ T2_B(encode_thumb_jump(d));+ }+ else {+ _CMPI(_R0, 0);+ j1 = _jit->x.pc;+ if (eq) {+ _CC_B(ARM_CC_EQ, 0);+ jit_patch(j0);+ }+ else+ _CC_B(ARM_CC_NE, 0);+ swf_pop(0xf);+ l = _jit->x.pc;+ d = (((int)i1 - (int)l) >> 2) - 2;+ assert(_s24P(d));+ _B(d & 0x00ffffff);+ }+ if (!eq)+ jit_patch(j0);+ jit_patch(j1);+ swf_pop(0xf);+ return (l);+}++#define swf_buneqr_f(_jit,i0,r0,r1) swf_bunff(_jit,1,i0,r0,r1)+#define swf_buneqr_d(_jit,i0,r0,r1) swf_bundd(_jit,1,i0,r0,r1)+#define swf_bunger_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmplt,ARM_CC_EQ,i0,r0,r1)+#define swf_bunger_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmplt,ARM_CC_EQ,i0,r0,r1)+#define swf_bungtr_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmple,ARM_CC_EQ,i0,r0,r1)+#define swf_bungtr_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmple,ARM_CC_EQ,i0,r0,r1)+#define swf_bltgtr_f(_jit,i0,r0,r1) swf_bunff(_jit,0,i0,r0,r1)+#define swf_bltgtr_d(_jit,i0,r0,r1) swf_bundd(_jit,0,i0,r0,r1)+#define swf_bordr_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpun,ARM_CC_EQ,i0,r0,r1)+#define swf_bordr_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpun,ARM_CC_EQ,i0,r0,r1)+#define swf_bunordr_f(_jit,i0,r0,r1) swf_bff(_jit,__aeabi_fcmpun,ARM_CC_NE,i0,r0,r1)+#define swf_bunordr_d(_jit,i0,r0,r1) swf_bdd(_jit,__aeabi_dcmpun,ARM_CC_NE,i0,r0,r1)++__jit_inline void+swf_ldr_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ jit_ldr_i(JIT_FTMP, r1);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+}++__jit_inline void+swf_ldr_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDI(JIT_TMP, r1, 0);+ _STRDIN(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ }+ else {+ jit_ldxi_i(JIT_TMP, r1, 0);+ jit_ldxi_i(JIT_FTMP, r1, 4);+ swf_strin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+}++__jit_inline void+swf_ldi_f(jit_state_t _jit, jit_fpr_t r0, void *i0)+{+ jit_ldi_i(JIT_FTMP, i0);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+}++__jit_inline void+swf_ldi_d(jit_state_t _jit, jit_fpr_t r0, void *i0)+{+ jit_movi_i(JIT_TMP, (int)i0);+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDI(JIT_TMP, JIT_TMP, 0);+ _STRDIN(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ }+ else {+ jit_ldxi_i(JIT_FTMP, JIT_TMP, 4);+ jit_ldxi_i(JIT_TMP, JIT_TMP, 0);+ swf_strin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+}++__jit_inline void+swf_ldxr_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ jit_ldxr_i(JIT_TMP, r1, r2);+ swf_strin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+}++__jit_inline void+swf_ldxr_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRD(JIT_TMP, r1, r2);+ _STRDIN(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ }+ else {+ jit_addr_i(JIT_TMP, r1, r2);+ jit_ldxi_i(JIT_FTMP, JIT_TMP, 4);+ jit_ldxi_i(JIT_TMP, JIT_TMP, 0);+ swf_strin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+}++__jit_inline void+swf_ldxi_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, int i0)+{+ jit_ldxi_i(JIT_FTMP, r1, i0);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+}++__jit_inline void+swf_ldxi_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, int i0)+{+ if (!jit_thumb_p() && jit_armv5e_p()) {+ if (i0 >= 0 && i0 <= 255)+ _LDRDI(JIT_TMP, r1, i0);+ else if (i0 < 0 && i0 >= -255)+ _LDRDIN(JIT_TMP, r1, -i0);+ else {+ jit_addi_i(JIT_FTMP, r1, i0);+ _LDRDI(JIT_TMP, JIT_FTMP, 0);+ }+ _STRDIN(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ }+ else {+ if (((jit_thumb_p() && i0 >= -255) ||+ (!jit_thumb_p() && i0 >= -4095)) && i0 + 4 <= 4095) {+ if (i0 >= 0)+ jit_ldxi_i(JIT_TMP, r1, i0);+ else if (i0 < 0)+ swf_ldrin(JIT_TMP, r1, -i0);+ i0 += 4;+ if (i0 >= 0)+ jit_ldxi_i(JIT_FTMP, r1, i0);+ else if (i0 < 0)+ swf_ldrin(JIT_FTMP, r1, -i0);+ }+ else {+ jit_addi_i(JIT_FTMP, r1, i0);+ jit_ldxi_i(JIT_TMP, JIT_FTMP, 0);+ jit_ldxi_i(JIT_FTMP, JIT_FTMP, 4);+ }+ swf_strin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+}++__jit_inline void+swf_str_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 8);+ jit_stxi_i(0, r0, JIT_FTMP);+}++__jit_inline void+swf_str_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ _STRDI(JIT_TMP, r0, 0);+ }+ else {+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 4);+ jit_stxi_i(0, r0, JIT_TMP);+ jit_stxi_i(4, r0, JIT_FTMP);+ }+}++__jit_inline void+swf_sti_f(jit_state_t _jit, void *i0, jit_fpr_t r0)+{+ jit_movi_i(JIT_TMP, (int)i0);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ jit_stxi_i(0, JIT_TMP, JIT_FTMP);+}++__jit_inline void+swf_sti_d(jit_state_t _jit, void *i0, jit_fpr_t r0)+{+ jit_movi_i(JIT_TMP, (int)i0);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ jit_stxi_i(0, JIT_TMP, JIT_FTMP);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ jit_stxi_i(4, JIT_TMP, JIT_FTMP);+}++__jit_inline void+swf_stxr_f(jit_state_t _jit, jit_gpr_t r0, jit_gpr_t r1, jit_fpr_t r2)+{+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r2) + 8);+ jit_stxr_i(r1, r0, JIT_TMP);+}++__jit_inline void+swf_stxr_d(jit_state_t _jit, jit_gpr_t r0, jit_gpr_t r1, jit_fpr_t r2)+{+ if (!jit_thumb_p() && jit_armv5e_p()) {+ _LDRDIN(JIT_TMP, JIT_FP, swf_off(r2) + 8);+ _STRD(JIT_TMP, r0, r1);+ }+ else {+ jit_addr_i(JIT_TMP, r0, r1);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r2) + 8);+ jit_stxi_i(0, JIT_TMP, JIT_FTMP);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r2) + 4);+ jit_stxi_i(4, JIT_TMP, JIT_FTMP);+ }+}++__jit_inline void+swf_stxi_f(jit_state_t _jit, int i0, jit_gpr_t r0, jit_fpr_t r1)+{+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r1) + 8);+ jit_stxi_i(i0, r0, JIT_FTMP);+}++__jit_inline void+swf_stxi_d(jit_state_t _jit, int i0, jit_gpr_t r0, jit_fpr_t r1)+{+ if (!jit_thumb_p() && jit_armv5e_p()) {+ if (i0 >= 0 && i0 <= 255) {+ _LDRDIN(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ _STRDI(JIT_TMP, r0, i0);+ }+ else if (i0 < 0 && i0 >= -255) {+ _LDRDIN(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ _STRDIN(JIT_TMP, r0, -i0);+ }+ else {+ jit_addi_i(JIT_FTMP, r0, i0);+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ jit_stxi_i(0, JIT_TMP, JIT_FTMP);+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r1) + 4);+ jit_stxi_i(4, JIT_TMP, JIT_FTMP);+ }+ }+ else {+ jit_addi_i(JIT_FTMP, r0, i0);+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r1) + 8);+ jit_stxi_i(0, JIT_FTMP, JIT_TMP);+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r1) + 4);+ jit_stxi_i(4, JIT_FTMP, JIT_TMP);+ }+}++__jit_inline void+swf_getarg_f(jit_state_t _jit, jit_fpr_t r0, int i0)+{+ if (i0 < 4)+ i0 <<= 2;+ jit_ldxi_i(JIT_FTMP, JIT_FP, i0);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+}++__jit_inline void+swf_getarg_d(jit_state_t _jit, jit_fpr_t r0, int i0)+{+ if (i0 < 4)+ i0 <<= 2;+ if (!jit_thumb_p() && jit_armv5e_p()) {+ if (i0 < 255)+ _LDRDI(JIT_TMP, JIT_FP, i0);+ else {+ jit_addi_i(JIT_FTMP, JIT_FP, i0);+ jit_ldxi_i(JIT_TMP, JIT_FTMP, 0);+ jit_ldxi_i(JIT_FTMP, JIT_FTMP, 4);+ }+ _STRDIN(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ }+ else {+ if (i0 + 4 < 4095) {+ jit_ldxi_i(JIT_TMP, JIT_FP, i0);+ jit_ldxi_i(JIT_FTMP, JIT_FP, i0 + 4);+ }+ else {+ jit_addi_i(JIT_FTMP, JIT_FP, i0);+ jit_ldxi_i(JIT_TMP, JIT_FTMP, 0);+ jit_ldxi_i(JIT_FTMP, JIT_FTMP, 4);+ }+ swf_strin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ swf_strin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+}++__jit_inline void+swf_pusharg_f(jit_state_t _jit, jit_fpr_t r0)+{+ int ofs = _jitl.nextarg_put++;+ assert(ofs < 256);+ _jitl.stack_offset -= sizeof(float);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r0) + 8);+ _jitl.arguments[ofs] = (int *)_jit->x.pc;+ _jitl.types[ofs >> 5] &= ~(1 << (ofs & 31));+ if (jit_thumb_p())+ T2_STRWI(JIT_FTMP, JIT_SP, 0);+ else+ _STRI(JIT_FTMP, JIT_SP, 0);+}+#endif+__jit_inline void+swf_pusharg_d(jit_state _jit, jit_fpr_t r0)+{+ int ofs = _jitl.nextarg_put++;+ assert(ofs < 256);+ _jitl.stack_offset -= sizeof(double);+ if (!jit_thumb_p() && jit_armv5e_p())+ _LDRDIN(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ else {+ swf_ldrin(JIT_TMP, JIT_FP, swf_off(r0) + 8);+ swf_ldrin(JIT_FTMP, JIT_FP, swf_off(r0) + 4);+ }+ _jitl.arguments[ofs] = (int *)_jit.x.pc;+ _jitl.types[ofs >> 5] |= 1 << (ofs & 31);+ /* large offsets (handled by patch_arguments) cannot be encoded in STRDI */+ if (jit_thumb_p()) {+ T2_STRWI(JIT_TMP, JIT_SP, 0);+ T2_STRWI(JIT_FTMP, JIT_SP, 0);+ }+ else {+ _STRI(JIT_TMP, JIT_SP, 0);+ _STRI(JIT_FTMP, JIT_SP, 0);+ }+}+#if 0+#define swf_retval_f(_jit, r0) swf_strin(_R0, JIT_FP, swf_off(r0) + 8)+__jit_inline void+swf_retval_d(jit_state_t _jit, jit_fpr_t r0)+{+ if (!jit_thumb_p() && jit_armv5e_p())+ _STRDIN(_R0, JIT_FP, swf_off(r0) + 8);+ else {+ swf_strin(_R0, JIT_FP, swf_off(r0) + 8);+ swf_strin(_R1, JIT_FP, swf_off(r0) + 4);+ }+}+#endif+#endif /* __lightning_fp_swf_h */
@@ -0,0 +1,1091 @@+/******************************** -*- C -*- ****************************+ *+ * Support macros for arm VFP floating-point math+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2011 Free Software Foundation, Inc.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ * Authors:+ * Paulo Cesar Pereira de Andrade+ ***********************************************************************/+++#ifndef __lightning_fp_vfp_h+#define __lightning_fp_vfp_h++#if 0 ++__jit_inline void+vfp_movr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ if (r0 != r1) {+ if (r0 == JIT_FPRET) {+ /* jit_ret() must follow! */+ if (!jit_hardfp_p())+ _VMOV_A_S(_R0, r1);+ else+ _VMOV_F32(_D0, r1);+ }+ else+ _VMOV_F32(r0, r1);+ }+}++__jit_inline void+vfp_movr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ if (r0 != r1) {+ if (r0 == JIT_FPRET) {+ /* jit_ret() must follow! */+ if (!jit_hardfp_p())+ _VMOV_AA_D(_R0, _R1, r1);+ else+ _VMOV_F64(_D0, r1);+ }+ else+ _VMOV_F64(r0, r1);+ }+}++__jit_inline void+vfp_movi_f(jit_state_t _jit, jit_fpr_t r0, float i0)+{+ union {+ int i;+ float f;+ } u;+ int code;+ u.f = i0;+ if (!jit_hardfp_p() && r0 == JIT_FPRET)+ /* jit_ret() must follow! */+ jit_movi_i(_R0, u.i);+ else {+ if (r0 == JIT_FPRET)+ r0 = _D0;+ if ((code = encode_vfp_double(1, 0, u.i, u.i)) != -1 ||+ (code = encode_vfp_double(1, 1, ~u.i, ~u.i)) != -1)+ _VIMM(code, r0);+ else {+ jit_movi_i(JIT_FTMP, u.i);+ _VMOV_S_A(r0, JIT_FTMP);+ }+ }+}++__jit_inline void+vfp_movi_d(jit_state_t _jit, jit_fpr_t r0, double i0)+{+ union {+ int i[2];+ double d;+ } u;+ int code;+ u.d = i0;+ if (!jit_hardfp_p() && r0 == JIT_FPRET) {+ /* jit_ret() must follow! */+ jit_movi_i(_R0, u.i[0]);+ jit_movi_i(_R1, u.i[1]);+ }+ else {+ if (r0 == JIT_FPRET)+ r0 = _D0;+ if ((code = encode_vfp_double(1, 0, u.i[0], u.i[1])) != -1 ||+ (code = encode_vfp_double(1, 1, ~u.i[0], ~u.i[1])) != -1)+ _VIMM(code, r0);+ else {+ jit_movi_i(JIT_TMP, u.i[0]);+ jit_movi_i(JIT_FTMP, u.i[1]);+ _VMOV_D_AA(r0, JIT_TMP, JIT_FTMP);+ }+ }+}++__jit_inline void+vfp_extr_i_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ _VMOV_V_I32(r0, r1);+ _VCVT_F32_S32(r0, r0);+}++__jit_inline void+vfp_extr_i_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ _VMOV_V_I32(r0, r1);+ _VCVT_F64_S32(r0, r0);+}++#define vfp_extr_d_f(_jit, r0, r1) _VCVT_F64_F32(r0, r1)+#define vfp_extr_f_d(_jit, r0, r1) _VCVT_F32_F64(r0, r1)++/* FIXME keeping for now, in case there exists, and/or to support+ * only 4 double precision registers */+#define vfp_get_tmp(r, n) \+ jit_fpr_t tmp; \+ if (0) { \+ tmp = r == _D0 ? _D1 : _D0; \+ _VPUSH_F##n(tmp, 2); \+ } \+ else \+ tmp = _D15+#define vfp_unget_tmp(n) \+ if (0) \+ _VPOP_F##n(tmp, 2)++__jit_inline void+vfp_rintr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 32);+ _VCVT_S32_F32(tmp, r1);+ _VMOV_A_S32(r0, tmp);+ vfp_unget_tmp(32);+}++__jit_inline void+vfp_rintr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 64);+ _VCVT_S32_F64(tmp, r1);+ _VMOV_A_S32(r0, tmp);+ vfp_unget_tmp(64);+}++__jit_inline void+vfp_roundr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 32);+ _VMOV_A_S(JIT_FTMP, r1);+ if (jit_thumb_p()) {+ T2_TSTI(JIT_FTMP, encode_thumb_immediate(0x80000000));+ _ITE(ARM_CC_NE);+ /* add -0.5 if negative */+ T2_MOVI(JIT_FTMP, encode_thumb_immediate(0xbf000000));+ /* add 0.5 if positive */+ T2_MOVI(JIT_FTMP, encode_thumb_immediate(0x3f000000));+ }+ else {+ if (jit_armv6_p())+ _TSTI(JIT_FTMP, encode_arm_immediate(0x80000000));+ else+ _ANDSI(JIT_FTMP, JIT_FTMP, encode_arm_immediate(0x80000000));+ /* add -0.5 if negative */+ _CC_MOVI(ARM_CC_NE, JIT_FTMP, encode_arm_immediate(0xbf000000));+ /* add 0.5 if positive */+ _CC_MOVI(ARM_CC_EQ, JIT_FTMP, encode_arm_immediate(0x3f000000));+ }+ _VMOV_S_A(tmp, JIT_FTMP);+ _VADD_F32(tmp, r1, tmp);+ /* truncate to zero */+ _VCVT_S32_F32(tmp, tmp);+ _VMOV_A_S32(r0, tmp);+ vfp_unget_tmp(32);+}++__jit_inline void+vfp_roundr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 64);+ _VMOV_AA_D(JIT_TMP, JIT_FTMP, r1);+ if (jit_thumb_p()) {+ T2_TSTI(JIT_FTMP, encode_thumb_immediate(0x80000000));+ T2_MOVI(JIT_FTMP, encode_thumb_immediate(0x0fe00000));+ _ITE(ARM_CC_NE);+ /* add -0.5 if negative */+ T2_ORRI(JIT_FTMP, JIT_FTMP, encode_thumb_immediate(0xb0000000));+ /* add 0.5 if positive */+ T2_ORRI(JIT_FTMP, JIT_FTMP, encode_thumb_immediate(0x30000000));+ }+ else {+ if (jit_armv6_p())+ _TSTI(JIT_FTMP, encode_arm_immediate(0x80000000));+ else+ _ANDSI(JIT_FTMP, JIT_FTMP, encode_arm_immediate(0x80000000));+ _MOVI(JIT_FTMP, encode_arm_immediate(0x0fe00000));+ /* add -0.5 if negative */+ _CC_ORRI(ARM_CC_NE, JIT_FTMP, JIT_FTMP,+ encode_arm_immediate(0xb0000000));+ /* add 0.5 if positive */+ _CC_ORRI(ARM_CC_EQ, JIT_FTMP, JIT_FTMP,+ encode_arm_immediate(0x30000000));+ }+ jit_movi_i(JIT_TMP, 0);+ _VMOV_D_AA(tmp, JIT_TMP, JIT_FTMP);+ _VADD_F64(tmp, r1, tmp);+ /* truncate to zero */+ _VCVT_S32_F64(tmp, tmp);+ _VMOV_A_S32(r0, tmp);+ vfp_unget_tmp(64);+}++#define vfp_truncr_f_i(_jit, r0, r1) vfp_rintr_f_i(_jit, r0, r1)+#define vfp_truncr_d_i(_jit, r0, r1) vfp_rintr_d_i(_jit, r0, r1)++__jit_inline void+vfp_ceilr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 32);+ _VMRS(JIT_TMP);+ if (jit_thumb_p()) {+ T2_BICI(JIT_FTMP, JIT_TMP, encode_thumb_immediate(FPSCR_RMASK));+ T2_ORRI(JIT_FTMP, JIT_FTMP, encode_thumb_immediate(FPSCR_RP));+ }+ else {+ _BICI(JIT_FTMP, JIT_TMP, encode_arm_immediate(FPSCR_RMASK));+ _ORRI(JIT_FTMP, JIT_FTMP, encode_arm_immediate(FPSCR_RP));+ }+ _VMSR(JIT_FTMP);+ _VCVTR_S32_F32(tmp, r1);+ _VMOV_A_S32(r0, tmp);+ _VMSR(JIT_TMP);+ vfp_unget_tmp(32);+}++__jit_inline void+vfp_ceilr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 64);+ _VMRS(JIT_TMP);+ if (jit_thumb_p()) {+ T2_BICI(JIT_FTMP, JIT_TMP, encode_thumb_immediate(FPSCR_RMASK));+ T2_ORRI(JIT_FTMP, JIT_FTMP, encode_thumb_immediate(FPSCR_RP));+ }+ else {+ _BICI(JIT_FTMP, JIT_TMP, encode_arm_immediate(FPSCR_RMASK));+ _ORRI(JIT_FTMP, JIT_FTMP, encode_arm_immediate(FPSCR_RP));+ }+ _VMSR(JIT_FTMP);+ _VCVTR_S32_F64(tmp, r1);+ _VMOV_A_S32(r0, tmp);+ _VMSR(JIT_TMP);+ vfp_unget_tmp(64);+}++__jit_inline void+vfp_floorr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 32);+ _VMRS(JIT_TMP);+ if (jit_thumb_p()) {+ T2_BICI(JIT_FTMP, JIT_TMP, encode_thumb_immediate(FPSCR_RMASK));+ T2_ORRI(JIT_FTMP, JIT_FTMP, encode_thumb_immediate(FPSCR_RM));+ }+ else {+ _BICI(JIT_FTMP, JIT_TMP, encode_arm_immediate(FPSCR_RMASK));+ _ORRI(JIT_FTMP, JIT_FTMP, encode_arm_immediate(FPSCR_RM));+ }+ _VMSR(JIT_FTMP);+ _VCVTR_S32_F32(tmp, r1);+ _VMOV_A_S32(r0, tmp);+ _VMSR(JIT_TMP);+ vfp_unget_tmp(32);+}++__jit_inline void+vfp_floorr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ vfp_get_tmp(r1, 64);+ _VMRS(JIT_TMP);+ if (jit_thumb_p()) {+ T2_BICI(JIT_FTMP, JIT_TMP, encode_thumb_immediate(FPSCR_RMASK));+ T2_ORRI(JIT_FTMP, JIT_FTMP, encode_thumb_immediate(FPSCR_RM));+ }+ else {+ _BICI(JIT_FTMP, JIT_TMP, encode_arm_immediate(FPSCR_RMASK));+ _ORRI(JIT_FTMP, JIT_FTMP, encode_arm_immediate(FPSCR_RM));+ }+ _VMSR(JIT_FTMP);+ _VCVTR_S32_F64(tmp, r1);+ _VMOV_A_S32(r0, tmp);+ _VMSR(JIT_TMP);+ vfp_unget_tmp(64);+}++#define vfp_absr_f(_jit, r0, r1) _VABS_F32(r0, r1)+#define vfp_absr_d(_jit, r0, r1) _VABS_F64(r0, r1)+#define vfp_negr_f(_jit, r0, r1) _VNEG_F32(r0, r1)+#define vfp_negr_d(_jit, r0, r1) _VNEG_F64(r0, r1)+#define vfp_sqrtr_f(_jit, r0, r1) _VSQRT_F32(r0, r1)+#define vfp_sqrtr_d(_jit, r0, r1) _VSQRT_F64(r0, r1)+#define vfp_addr_f(_jit, r0, r1, r2) _VADD_F32(r0, r1, r2)+#define vfp_addr_d(_jit, r0, r1, r2) _VADD_F64(r0, r1, r2)+#define vfp_subr_f(_jit, r0, r1, r2) _VSUB_F32(r0, r1, r2)+#define vfp_subr_d(_jit, r0, r1, r2) _VSUB_F64(r0, r1, r2)+#define vfp_mulr_f(_jit, r0, r1, r2) _VMUL_F32(r0, r1, r2)+#define vfp_mulr_d(_jit, r0, r1, r2) _VMUL_F64(r0, r1, r2)+#define vfp_divr_f(_jit, r0, r1, r2) _VDIV_F32(r0, r1, r2)+#define vfp_divr_d(_jit, r0, r1, r2) _VDIV_F64(r0, r1, r2)++static void+_vcmp01_x(jit_state_t _jit, int c0, int c1, jit_gpr_t r0)+{+ _VMRS(_R15);+ if (jit_thumb_p()) {+ if ((c0 ^ c1) >> 28 == 1) {+ _ITE(c0);+ if (r0 < 8) {+ T1_MOVI(r0, 0);+ T1_MOVI(r0, 1);+ }+ else {+ T2_MOVI(r0, 0);+ T2_MOVI(r0, 1);+ }+ }+ else {+ if (r0 < 8) {+ _IT(c0);+ T1_MOVI(r0, 0);+ _IT(c1);+ T1_MOVI(r0, 1);+ }+ else {+ _IT(c0);+ T2_MOVI(r0, 0);+ _IT(c1);+ T2_MOVI(r0, 1);+ }+ }+ }+ else {+ _CC_MOVI(c0, r0, 0);+ _CC_MOVI(c1, r0, 1);+ }+}++static void+_vcmp01_f(jit_state_t _jit, int c0, int c1,+ jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F32(r1, r2);+ _vcmp01_x(_jit, c0, c1, r0);+}++static void+_vcmp01_d(jit_state_t _jit, int c0, int c1,+ jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F64(r1, r2);+ _vcmp01_x(_jit, c0, c1, r0);+}++#define vfp_ltr_f(_jit,r0,r1,r2) _vcmp01_f(_jit,ARM_CC_PL,ARM_CC_MI,r0,r1,r2)+#define vfp_ltr_d(_jit,r0,r1,r2) _vcmp01_d(_jit,ARM_CC_PL,ARM_CC_MI,r0,r1,r2)+#define vfp_ler_f(_jit,r0,r1,r2) _vcmp01_f(_jit,ARM_CC_HS,ARM_CC_LS,r0,r1,r2)+#define vfp_ler_d(_jit,r0,r1,r2) _vcmp01_d(_jit,ARM_CC_HS,ARM_CC_LS,r0,r1,r2)+#define vfp_eqr_f(_jit,r0,r1,r2) _vcmp01_f(_jit,ARM_CC_NE,ARM_CC_EQ,r0,r1,r2)+#define vfp_eqr_d(_jit,r0,r1,r2) _vcmp01_d(_jit,ARM_CC_NE,ARM_CC_EQ,r0,r1,r2)+#define vfp_ger_f(_jit,r0,r1,r2) _vcmp01_f(_jit,ARM_CC_LT,ARM_CC_GE,r0,r1,r2)+#define vfp_ger_d(_jit,r0,r1,r2) _vcmp01_d(_jit,ARM_CC_LT,ARM_CC_GE,r0,r1,r2)+#define vfp_gtr_f(_jit,r0,r1,r2) _vcmp01_f(_jit,ARM_CC_LE,ARM_CC_GT,r0,r1,r2)+#define vfp_gtr_d(_jit,r0,r1,r2) _vcmp01_d(_jit,ARM_CC_LE,ARM_CC_GT,r0,r1,r2)+#define vfp_ner_f(_jit,r0,r1,r2) _vcmp01_f(_jit,ARM_CC_EQ,ARM_CC_NE,r0,r1,r2)+#define vfp_ner_d(_jit,r0,r1,r2) _vcmp01_d(_jit,ARM_CC_EQ,ARM_CC_NE,r0,r1,r2)++static void+_vcmp10_x(jit_state_t _jit, int cc, jit_gpr_t r0)+{+ if (jit_thumb_p()) {+ if (r0 < 8) {+ T1_MOVI(r0, 1);+ _VMRS(_R15);+ _IT(cc);+ T1_MOVI(r0, 0);+ }+ else {+ T2_MOVI(r0, 1);+ _VMRS(_R15);+ _IT(cc);+ T2_MOVI(r0, 0);+ }+ }+ else {+ _VMRS(_R15);+ _MOVI(r0, 1);+ _CC_MOVI(cc, r0, 0);+ }+}++static void+_vcmp_10_f(jit_state_t _jit, int cc, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F32(r1, r2);+ _vcmp10_x(_jit, cc, r0);+}++static void+_vcmp_10_d(jit_state_t _jit, int cc, jit_gpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ _VCMP_F64(r1, r2);+ _vcmp10_x(_jit, cc, r0);+}++#define vfp_unltr_f(_jit,r0,r1,r2) _vcmp_10_f(_jit,ARM_CC_GE,r0,r1,r2)+#define vfp_unltr_d(_jit,r0,r1,r2) _vcmp_10_d(_jit,ARM_CC_GE,r0,r1,r2)+#define vfp_unler_f(_jit,r0,r1,r2) _vcmp_10_f(_jit,ARM_CC_GT,r0,r1,r2)+#define vfp_unler_d(_jit,r0,r1,r2) _vcmp_10_d(_jit,ARM_CC_GT,r0,r1,r2)++static void+vfp_uneqr_x(jit_state_t _jit, jit_gpr_t r0)+{+ _VMRS(_R15);+ if (jit_thumb_p()) {+ _ITE(ARM_CC_NE);+ if (r0 < 8) {+ T1_MOVI(r0, 0);+ T1_MOVI(r0, 1);+ _IT(ARM_CC_VS);+ T1_MOVI(r0, 1);+ }+ else {+ T2_MOVI(r0, 0);+ T2_MOVI(r0, 1);+ _IT(ARM_CC_VS);+ T2_MOVI(r0, 1);+ }+ }+ else {+ _CC_MOVI(ARM_CC_NE, r0, 0);+ _CC_MOVI(ARM_CC_EQ, r0, 1);+ _CC_MOVI(ARM_CC_VS, r0, 1);+ }+}++__jit_inline void+vfp_uneqr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F32(r1, r2);+ vfp_uneqr_x(_jit, r0);+}++__jit_inline void+vfp_uneqr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F64(r1, r2);+ vfp_uneqr_x(_jit, r0);+}++static void+_vcmp_01_x(jit_state_t _jit, int cc, jit_gpr_t r0)+{+ if (jit_thumb_p()) {+ if (r0 < 8) {+ T1_MOVI(r0, 0);+ _VMRS(_R15);+ _IT(cc);+ T1_MOVI(r0, 1);+ }+ else {+ T2_MOVI(r0, 0);+ _VMRS(_R15);+ _IT(cc);+ T2_MOVI(r0, 1);+ }+ }+ else {+ _VMRS(_R15);+ _MOVI(r0, 0);+ _CC_MOVI(cc, r0, 1);+ }+}++static void+_vcmp_01_f(jit_state_t _jit, int cc, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F32(r1, r2);+ _vcmp_01_x(_jit, cc, r0);+}++static void+_vcmp_01_d(jit_state_t _jit, int cc, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F64(r1, r2);+ _vcmp_01_x(_jit, cc, r0);+}++#define vfp_unger_f(_jit,r0,r1,r2) _vcmp_01_f(_jit,ARM_CC_CS,r0,r1,r2)+#define vfp_unger_d(_jit,r0,r1,r2) _vcmp_01_d(_jit,ARM_CC_CS,r0,r1,r2)+#define vfp_ungtr_f(_jit,r0,r1,r2) _vcmp_01_f(_jit,ARM_CC_HI,r0,r1,r2)+#define vfp_ungtr_d(_jit,r0,r1,r2) _vcmp_01_d(_jit,ARM_CC_HI,r0,r1,r2)++static void+_vfp_ltgtr_x(jit_state_t _jit, jit_gpr_t r0)+{+ _VMRS(_R15);+ if (jit_thumb_p()) {+ _ITE(ARM_CC_NE);+ if (r0 < 8) {+ T1_MOVI(r0, 1);+ T1_MOVI(r0, 0);+ _IT(ARM_CC_VS);+ T1_MOVI(r0, 0);+ }+ else {+ T2_MOVI(r0, 1);+ T2_MOVI(r0, 0);+ _IT(ARM_CC_VS);+ T2_MOVI(r0, 0);+ }+ }+ else {+ _CC_MOVI(ARM_CC_NE, r0, 1);+ _CC_MOVI(ARM_CC_EQ, r0, 0);+ _CC_MOVI(ARM_CC_VS, r0, 0);+ }+}++__jit_inline void+vfp_ltgtr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F32(r1, r2);+ _vfp_ltgtr_x(_jit, r0);+}++__jit_inline void+vfp_ltgtr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F64(r1, r2);+ _vfp_ltgtr_x(_jit, r0);+}++__jit_inline void+vfp_ordr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F32(r1, r2);+ _vcmp10_x(_jit, ARM_CC_VS, r0);+}++__jit_inline void+vfp_ordr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F64(r1, r2);+ _vcmp10_x(_jit, ARM_CC_VS, r0);+}++__jit_inline void+vfp_unordr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F32(r1, r2);+ _vcmp_01_x(_jit, ARM_CC_VS, r0);+}++__jit_inline void+vfp_unordr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ _VCMP_F64(r1, r2);+ _vcmp_01_x(_jit, ARM_CC_VS, r0);+}++static jit_insn *+_vbcmp_x(jit_state_t _jit, int cc, jit_insn *i0)+{+ jit_insn *l;+ long d;+ _VMRS(_R15);+ l = _jit->x.pc;+ if (jit_thumb_p()) {+ d = (((long)i0 - (long)l) >> 1) - 2;+ assert(_s20P(d));+ T2_CC_B(cc, encode_thumb_cc_jump(d));+ }+ else {+ d = (((long)i0 - (long)l) >> 2) - 2;+ assert(_s24P(d));+ _CC_B(cc, d & 0x00ffffff);+ }+ return (l);+}++__jit_inline jit_insn *+_vbcmp_f(jit_state_t _jit, int cc, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F32(r0, r1);+ return (_vbcmp_x(_jit, cc, i0));+}++__jit_inline jit_insn *+_vbcmp_d(jit_state_t _jit, int cc, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F64(r0, r1);+ return (_vbcmp_x(_jit, cc, i0));+}++#define vfp_bltr_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_MI,i0,r0,r1)+#define vfp_bltr_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_MI,i0,r0,r1)+#define vfp_bler_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_LS,i0,r0,r1)+#define vfp_bler_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_LS,i0,r0,r1)+#define vfp_beqr_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_EQ,i0,r0,r1)+#define vfp_beqr_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_EQ,i0,r0,r1)+#define vfp_bger_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_GE,i0,r0,r1)+#define vfp_bger_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_GE,i0,r0,r1)+#define vfp_bgtr_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_GT,i0,r0,r1)+#define vfp_bgtr_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_GT,i0,r0,r1)+#define vfp_bner_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_NE,i0,r0,r1)+#define vfp_bner_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_NE,i0,r0,r1)++static jit_insn *+_vbncmp_x(jit_state_t _jit, int cc, jit_insn *i0)+{+ jit_insn *i;+ jit_insn *l;+ long d;+ _VMRS(_R15);+ i = _jit->x.pc;+ if (jit_thumb_p()) {+ T2_CC_B(cc, 0);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 1) - 2;+ assert(_s24P(d));+ T2_B(encode_thumb_jump(d));+ }+ else {+ _CC_B(cc, 0);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 2) - 2;+ assert(_s24P(d));+ _B(d & 0x00ffffff);+ }+ jit_patch(i);+ return (l);+}++__jit_inline jit_insn *+_vbncmp_f(jit_state_t _jit, int cc, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F32(r0, r1);+ return (_vbncmp_x(_jit, cc, i0));+}++__jit_inline jit_insn *+_vbncmp_d(jit_state_t _jit, int cc, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F64(r0, r1);+ return (_vbncmp_x(_jit, cc, i0));+}++#define vfp_bunltr_f(_jit,i0,r0,r1) _vbncmp_f(_jit,ARM_CC_GE,i0,r0,r1)+#define vfp_bunltr_d(_jit,i0,r0,r1) _vbncmp_d(_jit,ARM_CC_GE,i0,r0,r1)+#define vfp_bunler_f(_jit,i0,r0,r1) _vbncmp_f(_jit,ARM_CC_GT,i0,r0,r1)+#define vfp_bunler_d(_jit,i0,r0,r1) _vbncmp_d(_jit,ARM_CC_GT,i0,r0,r1)++static jit_insn *+vfp_buneqr_x(jit_state_t _jit, jit_insn *i0)+{+ jit_insn *i;+ jit_insn *j;+ jit_insn *l;+ long d;+ _VMRS(_R15);+ i = _jit->x.pc;+ if (jit_thumb_p()) {+ T2_CC_B(ARM_CC_VS, 0);+ j = _jit->x.pc;+ T2_CC_B(ARM_CC_NE, 0);+ jit_patch(i);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 1) - 2;+ assert(_s20P(d));+ T2_B(encode_thumb_jump(d));+ }+ else {+ _CC_B(ARM_CC_VS, 0);+ j = _jit->x.pc;+ _CC_B(ARM_CC_NE, 0);+ jit_patch(i);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 2) - 2;+ assert(_s24P(d));+ _B(d & 0x00ffffff);+ }+ jit_patch(j);+ return (l);+}++__jit_inline jit_insn *+vfp_buneqr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F32(r0, r1);+ return (vfp_buneqr_x(_jit, i0));+}++__jit_inline jit_insn *+vfp_buneqr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F64(r0, r1);+ return (vfp_buneqr_x(_jit, i0));+}++static jit_insn *+vfp_bunger_x(jit_state_t _jit, jit_insn *i0)+{+ jit_insn *i;+ jit_insn *l;+ long d;+ _VMRS(_R15);+ i = _jit->x.pc;+ if (jit_thumb_p()) {+ T2_CC_B(ARM_CC_MI, 0);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 1) - 2;+ assert(_s20P(d));+ T2_CC_B(ARM_CC_HS, encode_thumb_cc_jump(d));++ }+ else {+ _CC_B(ARM_CC_MI, 0);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 2) - 2;+ assert(_s24P(d));+ _CC_B(ARM_CC_HS, d & 0x00ffffff);+ }+ jit_patch(i);+ return (l);+}++__jit_inline jit_insn *+vfp_bunger_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F32(r0, r1);+ return (vfp_bunger_x(_jit, i0));+}++__jit_inline jit_insn *+vfp_bunger_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F64(r0, r1);+ return (vfp_bunger_x(_jit, i0));+}++#define vfp_bungtr_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_HI,i0,r0,r1)+#define vfp_bungtr_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_HI,i0,r0,r1)++static jit_insn *+vfp_bltgtr_x(jit_state_t _jit, jit_insn *i0)+{+ jit_insn *i;+ jit_insn *j;+ jit_insn *l;+ long d;+ _VMRS(_R15);+ i = _jit->x.pc;+ if (jit_thumb_p()) {+ T2_CC_B(ARM_CC_VS, 0);+ j = _jit->x.pc;+ T2_CC_B(ARM_CC_EQ, 0);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 1) - 2;+ assert(_s24P(d));+ T2_B(encode_thumb_jump(d));+ }+ else {+ _CC_B(ARM_CC_VS, 0);+ j = _jit->x.pc;+ _CC_B(ARM_CC_EQ, 0);+ l = _jit->x.pc;+ d = (((long)i0 - (long)l) >> 2) - 2;+ assert(_s24P(d));+ _B(d & 0x00ffffff);+ }+ jit_patch(i);+ jit_patch(j);+ return (l);+}++__jit_inline jit_insn *+vfp_bltgtr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F32(r0, r1);+ return (vfp_bltgtr_x(_jit, i0));+}++__jit_inline jit_insn *+vfp_bltgtr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ _VCMP_F64(r0, r1);+ return (vfp_bltgtr_x(_jit, i0));+}++#define vfp_bordr_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_VC,i0,r0,r1)+#define vfp_bordr_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_VC,i0,r0,r1)+#define vfp_bunordr_f(_jit,i0,r0,r1) _vbcmp_f(_jit,ARM_CC_VS,i0,r0,r1)+#define vfp_bunordr_d(_jit,i0,r0,r1) _vbcmp_d(_jit,ARM_CC_VS,i0,r0,r1)+#define vfp_ldr_f(_jit, r0, r1) _VLDR_F32(r0, r1, 0)+#define vfp_ldr_d(_jit, r0, r1) _VLDR_F64(r0, r1, 0)++__jit_inline void+vfp_ldi_f(jit_state_t _jit, jit_fpr_t r0, void *i0)+{+ jit_movi_i(JIT_FTMP, (int)i0);+ _VLDR_F32(r0, JIT_FTMP, 0);+}++__jit_inline void+vfp_ldi_d(jit_state_t _jit, jit_fpr_t r0, void *i0)+{+ jit_movi_i(JIT_FTMP, (int)i0);+ _VLDR_F64(r0, JIT_FTMP, 0);+}++__jit_inline void+vfp_ldxr_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ jit_addr_i(JIT_FTMP, r1, r2);+ _VLDR_F32(r0, JIT_FTMP, 0);+}++__jit_inline void+vfp_ldxr_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ jit_addr_i(JIT_FTMP, r1, r2);+ _VLDR_F64(r0, JIT_FTMP, 0);+}++__jit_inline void+vfp_ldxi_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, int i0)+{+ if (i0 >= 0) {+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VLDR_F32(r0, r1, i0);+ else {+ jit_addi_i(JIT_FTMP, r1, i0);+ _VLDR_F32(r0, JIT_FTMP, 0);+ }+ }+ else {+ i0 = -i0;+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VLDRN_F32(r0, r1, i0);+ else {+ jit_subi_i(JIT_FTMP, r1, i0);+ _VLDR_F32(r0, JIT_FTMP, 0);+ }+ }+}++__jit_inline void+vfp_ldxi_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, int i0)+{+ if (i0 >= 0) {+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VLDR_F64(r0, r1, i0);+ else {+ jit_addi_i(JIT_FTMP, r1, i0);+ _VLDR_F64(r0, JIT_FTMP, 0);+ }+ }+ else {+ i0 = -i0;+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VLDRN_F64(r0, r1, i0);+ else {+ jit_subi_i(JIT_FTMP, r1, i0);+ _VLDR_F64(r0, JIT_FTMP, 0);+ }+ }+}++#define vfp_str_f(_jit, r0, r1) _VSTR_F32(r1, r0, 0)+#define vfp_str_d(_jit, r0, r1) _VSTR_F64(r1, r0, 0)++__jit_inline void+vfp_sti_f(jit_state_t _jit, void *i0, jit_fpr_t r0)+{+ jit_movi_i(JIT_FTMP, (int)i0);+ _VSTR_F32(r0, JIT_FTMP, 0);+}++__jit_inline void+vfp_sti_d(jit_state_t _jit, void *i0, jit_fpr_t r0)+{+ jit_movi_i(JIT_FTMP, (int)i0);+ _VSTR_F64(r0, JIT_FTMP, 0);+}++__jit_inline void+vfp_stxr_f(jit_state_t _jit, jit_gpr_t r0, jit_gpr_t r1, jit_fpr_t r2)+{+ jit_addr_i(JIT_FTMP, r0, r1);+ _VSTR_F32(r2, JIT_FTMP, 0);+}++__jit_inline void+vfp_stxr_d(jit_state_t _jit, jit_gpr_t r0, jit_gpr_t r1, jit_fpr_t r2)+{+ jit_addr_i(JIT_FTMP, r0, r1);+ _VSTR_F64(r2, JIT_FTMP, 0);+}++__jit_inline void+vfp_stxi_f(jit_state_t _jit, int i0, jit_gpr_t r0, jit_fpr_t r1)+{+ if (i0 >= 0) {+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VSTR_F32(r1, r0, i0);+ else {+ jit_addi_i(JIT_FTMP, r0, i0);+ _VSTR_F32(r1, JIT_FTMP, 0);+ }+ }+ else {+ i0 = -i0;+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VSTRN_F32(r1, r0, i0);+ else {+ jit_subi_i(JIT_FTMP, r0, i0);+ _VSTR_F32(r1, JIT_FTMP, 0);+ }+ }+}++__jit_inline void+vfp_stxi_d(jit_state_t _jit, int i0, jit_gpr_t r0, jit_fpr_t r1)+{+ if (i0 >= 0) {+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VSTR_F64(r1, r0, i0);+ else {+ jit_addi_i(JIT_FTMP, r0, i0);+ _VSTR_F64(r1, JIT_FTMP, 0);+ }+ }+ else {+ i0 = -i0;+ assert(!(i0 & 3));+ i0 >>= 2;+ if (i0 < 256)+ _VSTRN_F64(r1, r0, i0);+ else {+ jit_subi_i(JIT_FTMP, r0, i0);+ _VSTR_F64(r1, JIT_FTMP, 0);+ }+ }+}++__jit_inline void+vfp_getarg_f(jit_state_t _jit, jit_fpr_t r0, int i0)+{+ if (jit_hardfp_p()) {+ if (i0 < 16) {+ if (r0 != (jit_fpr_t)i0)+ _VMOV_F32(r0, (jit_fpr_t)i0);+ return;+ }+ }+ else if (i0 < 4) {+ /* registers are already saved on stack and argument registers+ * may have been clobbered */+#if 0+ _VMOV_S_A(r0, i0);+#else+ vfp_ldxi_f(_jit, r0, JIT_FP, i0 << 2);+#endif+ return;+ }+ vfp_ldxi_f(_jit, r0, JIT_FP, i0);+}++__jit_inline void+vfp_getarg_d(jit_state_t _jit, jit_fpr_t r0, int i0)+{+ if (jit_hardfp_p()) {+ if (i0 < 16) {+ if (r0 != (jit_fpr_t)i0)+ _VMOV_F64(r0, (jit_fpr_t)i0);+ return;+ }+ }+ else if (i0 < 4) {+ /* registers are already saved on stack and argument registers+ * may have been clobbered */+#if 0+ _VMOV_D_AA(r0, i0, i0 + 1);+#else+ vfp_ldxi_d(_jit, r0, JIT_FP, i0 << 2);+#endif+ return;+ }+ vfp_ldxi_d(_jit, r0, JIT_FP, i0);+}++__jit_inline void+vfp_pusharg_f(jit_state_t _jit, jit_fpr_t r0)+{+ int ofs = _jitl.nextarg_put++;+ assert(ofs < 256);+ _jitl.stack_offset -= sizeof(float);+ _jitl.arguments[ofs] = (int *)_jit->x.pc;+ _jitl.types[ofs >> 5] &= ~(1 << (ofs & 31));+ _VSTR_F32(r0, JIT_SP, 0);+}+#endif+__jit_inline void+vfp_pusharg_d(jit_state _jit, jit_fpr_t r0)+{+ int ofs = _jitl.nextarg_put++;+ assert(ofs < 256);+ _jitl.stack_offset -= sizeof(double);+ _jitl.arguments[ofs] = (int *)_jit.x.pc;+ _jitl.types[ofs >> 5] |= 1 << (ofs & 31);+ _VSTR_F64(r0, JIT_SP, 0);+}+#if 0+__jit_inline void+vfp_retval_f(jit_state_t _jit, jit_fpr_t r0)+{+ if (jit_hardfp_p()) {+ if (r0 != _D0)+ _VMOV_F32(r0, _D0);+ }+ else+ _VMOV_S_A(r0, _R0);+}++__jit_inline void+vfp_retval_d(jit_state_t _jit, jit_fpr_t r0)+{+ if (jit_hardfp_p()) {+ if (r0 != _D0)+ _VMOV_F64(r0, _D0);+ }+ else+ _VMOV_D_AA(r0, _R0, _R1);+}++#undef vfp_unget_tmp+#undef vfp_get_tmp+#endif++#endif /* __lightning_fp_vfp_h */
@@ -0,0 +1,1104 @@+/******************************** -*- C -*- ****************************+ *+ * Floating-point support (arm)+ *+ ***********************************************************************/++/***********************************************************************+ *+ * Copyright 2011 Free Software Foundation, Inc.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ * Authors:+ * Paulo Cesar Pereira de Andrade+ ***********************************************************************/++#ifndef __lightning_fp_arm_h+#define __lightning_fp_arm_h++#define JIT_FPR_NUM 6++static const jit_fpr_t+jit_soft_order[6] = {+ _D0, _D1, _D2, _D3, _D4, _D5+};+static const jit_fpr_t+jit_hard_order[6] = {+ _D8, _D9, _D10, _D11, _D12, _D13+};+#define JIT_FPR(n) \+ (jit_hardfp_p() ? jit_hard_order[n] : jit_soft_order[n])++#include "arm/fp-swf.h"+#include "arm/fp-vfp.h"++#if 0+#define jit_movr_f(r0, r1) arm_movr_f(_jit, r0, r1)+__jit_inline void+arm_movr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ if (jit_swf_p()) swf_movr_f(_jit, r0, r1);+ else vfp_movr_f(_jit, r0, r1);+}++#define jit_movr_d(r0, r1) arm_movr_d(_jit, r0, r1)+__jit_inline void+arm_movr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ if (jit_swf_p()) swf_movr_d(_jit, r0, r1);+ else vfp_movr_d(_jit, r0, r1);+}++#define jit_movi_f(r0, i0) arm_movi_f(_jit, r0, i0)+__jit_inline void+arm_movi_f(jit_state_t _jit, jit_fpr_t r0, float i0)+{+ if (jit_swf_p()) swf_movi_f(_jit, r0, i0);+ else vfp_movi_f(_jit, r0, i0);+}++#define jit_movi_d(r0, i0) arm_movi_d(_jit, r0, i0)+__jit_inline void+arm_movi_d(jit_state_t _jit, jit_fpr_t r0, double i0)+{+ if (jit_swf_p()) swf_movi_d(_jit, r0, i0);+ else vfp_movi_d(_jit, r0, i0);+}++#define jit_extr_i_f(r0, r1) arm_extr_i_f(_jit, r0, r1)+__jit_inline void+arm_extr_i_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_extr_i_f(_jit, r0, r1);+ else vfp_extr_i_f(_jit, r0, r1);+}++#define jit_extr_i_d(r0, r1) arm_extr_i_d(_jit, r0, r1)+__jit_inline void+arm_extr_i_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_extr_i_d(_jit, r0, r1);+ else vfp_extr_i_d(_jit, r0, r1);+}++#define jit_extr_d_f(r0, r1) arm_extr_d_f(_jit, r0, r1)+static void+arm_extr_d_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) swf_extr_d_f(_jit, r0, r1);+ else vfp_extr_d_f(_jit, r0, r1);+}++#define jit_extr_f_d(r0, r1) arm_extr_f_d(_jit, r0, r1)+static void+arm_extr_f_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ if (jit_swf_p()) swf_extr_f_d(_jit, r0, r1);+ else vfp_extr_f_d(_jit, r0, r1);+}++#define jit_rintr_f_i(r0, r1) arm_rintr_f_i(_jit, r0, r1)+static void+arm_rintr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_rintr_f_i(_jit, r0, r1);+ else vfp_rintr_f_i(_jit, r0, r1);+}++#define jit_rintr_d_i(r0, r1) arm_rintr_d_i(_jit, r0, r1)+static void+arm_rintr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_rintr_d_i(_jit, r0, r1);+ else vfp_rintr_d_i(_jit, r0, r1);+}++#define jit_roundr_f_i(r0, r1) arm_roundr_f_i(_jit, r0, r1)+static void+arm_roundr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_roundr_f_i(_jit, r0, r1);+ else vfp_roundr_f_i(_jit, r0, r1);+}++#define jit_roundr_d_i(r0, r1) arm_roundr_d_i(_jit, r0, r1)+static void+arm_roundr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_roundr_d_i(_jit, r0, r1);+ else vfp_roundr_d_i(_jit, r0, r1);+}++#define jit_truncr_f_i(r0, r1) arm_truncr_f_i(_jit, r0, r1)+static void+arm_truncr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_truncr_f_i(_jit, r0, r1);+ else vfp_truncr_f_i(_jit, r0, r1);+}++#define jit_truncr_d_i(r0, r1) arm_truncr_d_i(_jit, r0, r1)+static void+arm_truncr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_truncr_d_i(_jit, r0, r1);+ else vfp_truncr_d_i(_jit, r0, r1);+}++#define jit_ceilr_f_i(r0, r1) arm_ceilr_f_i(_jit, r0, r1)+static void+arm_ceilr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_ceilr_f_i(_jit, r0, r1);+ else vfp_ceilr_f_i(_jit, r0, r1);+}++#define jit_ceilr_d_i(r0, r1) arm_ceilr_d_i(_jit, r0, r1)+static void+arm_ceilr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_ceilr_d_i(_jit, r0, r1);+ else vfp_ceilr_d_i(_jit, r0, r1);+}++#define jit_floorr_f_i(r0, r1) arm_floorr_f_i(_jit, r0, r1)+static void+arm_floorr_f_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_floorr_f_i(_jit, r0, r1);+ else vfp_floorr_f_i(_jit, r0, r1);+}++#define jit_floorr_d_i(r0, r1) arm_floorr_d_i(_jit, r0, r1)+static void+arm_floorr_d_i(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_floorr_d_i(_jit, r0, r1);+ else vfp_floorr_d_i(_jit, r0, r1);+}++#define jit_absr_f(r0, r1) arm_absr_f(_jit, r0, r1)+static void+arm_absr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) swf_absr_f(_jit, r0, r1);+ else vfp_absr_f(_jit, r0, r1);+}++#define jit_absr_d(r0, r1) arm_absr_d(_jit, r0, r1)+static void+arm_absr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) swf_absr_d(_jit, r0, r1);+ else vfp_absr_d(_jit, r0, r1);+}++#define jit_negr_f(r0, r1) arm_negr_f(_jit, r0, r1)+static void+arm_negr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) swf_negr_f(_jit, r0, r1);+ else vfp_negr_f(_jit, r0, r1);+}++#define jit_negr_d(r0, r1) arm_negr_d(_jit, r0, r1)+static void+arm_negr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) swf_negr_d(_jit, r0, r1);+ else vfp_negr_d(_jit, r0, r1);+}++#define jit_sqrtr_f(r0, r1) arm_sqrtr_f(_jit, r0, r1)+static void+arm_sqrtr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) swf_sqrtr_f(_jit, r0, r1);+ else vfp_sqrtr_f(_jit, r0, r1);+}++#define jit_sqrtr_d(r0, r1) arm_sqrtr_d(_jit, r0, r1)+static void+arm_sqrtr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) swf_sqrtr_d(_jit, r0, r1);+ else vfp_sqrtr_d(_jit, r0, r1);+}++#define jit_addr_f(r0, r1, r2) arm_addr_f(_jit, r0, r1, r2)+static void+arm_addr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_addr_f(_jit, r0, r1, r2);+ else vfp_addr_f(_jit, r0, r1, r2);+}++#define jit_addr_d(r0, r1, r2) arm_addr_d(_jit, r0, r1, r2)+static void+arm_addr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_addr_d(_jit, r0, r1, r2);+ else vfp_addr_d(_jit, r0, r1, r2);+}++#define jit_subr_f(r0, r1, r2) arm_subr_f(_jit, r0, r1, r2)+static void+arm_subr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_subr_f(_jit, r0, r1, r2);+ else vfp_subr_f(_jit, r0, r1, r2);+}++#define jit_subr_d(r0, r1, r2) arm_subr_d(_jit, r0, r1, r2)+static void+arm_subr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_subr_d(_jit, r0, r1, r2);+ else vfp_subr_d(_jit, r0, r1, r2);+}++#define jit_mulr_f(r0, r1, r2) arm_mulr_f(_jit, r0, r1, r2)+static void+arm_mulr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_mulr_f(_jit, r0, r1, r2);+ else vfp_mulr_f(_jit, r0, r1, r2);+}++#define jit_mulr_d(r0, r1, r2) arm_mulr_d(_jit, r0, r1, r2)+static void+arm_mulr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_mulr_d(_jit, r0, r1, r2);+ else vfp_mulr_d(_jit, r0, r1, r2);+}++#define jit_divr_f(r0, r1, r2) arm_divr_f(_jit, r0, r1, r2)+static void+arm_divr_f(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_divr_f(_jit, r0, r1, r2);+ else vfp_divr_f(_jit, r0, r1, r2);+}++#define jit_divr_d(r0, r1, r2) arm_divr_d(_jit, r0, r1, r2)+static void+arm_divr_d(jit_state_t _jit, jit_fpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_divr_d(_jit, r0, r1, r2);+ else vfp_divr_d(_jit, r0, r1, r2);+}++#define jit_ltr_f(r0, r1, r2) arm_ltr_f(_jit, r0, r1, r2)+__jit_inline void+arm_ltr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ltr_f(_jit, r0, r1, r2);+ else vfp_ltr_f(_jit, r0, r1, r2);+}++#define jit_ltr_d(r0, r1, r2) arm_ltr_d(_jit, r0, r1, r2)+__jit_inline void+arm_ltr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ltr_d(_jit, r0, r1, r2);+ else vfp_ltr_d(_jit, r0, r1, r2);+}++#define jit_ler_f(r0, r1, r2) arm_ler_f(_jit, r0, r1, r2)+__jit_inline void+arm_ler_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ler_f(_jit, r0, r1, r2);+ else vfp_ler_f(_jit, r0, r1, r2);+}++#define jit_ler_d(r0, r1, r2) arm_ler_d(_jit, r0, r1, r2)+__jit_inline void+arm_ler_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ler_d(_jit, r0, r1, r2);+ else vfp_ler_d(_jit, r0, r1, r2);+}++#define jit_eqr_f(r0, r1, r2) arm_eqr_f(_jit, r0, r1, r2)+__jit_inline void+arm_eqr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_eqr_f(_jit, r0, r1, r2);+ else vfp_eqr_f(_jit, r0, r1, r2);+}++#define jit_eqr_d(r0, r1, r2) arm_eqr_d(_jit, r0, r1, r2)+__jit_inline void+arm_eqr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_eqr_d(_jit, r0, r1, r2);+ else vfp_eqr_d(_jit, r0, r1, r2);+}++#define jit_ger_f(r0, r1, r2) arm_ger_f(_jit, r0, r1, r2)+__jit_inline void+arm_ger_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ger_f(_jit, r0, r1, r2);+ else vfp_ger_f(_jit, r0, r1, r2);+}++#define jit_ger_d(r0, r1, r2) arm_ger_d(_jit, r0, r1, r2)+__jit_inline void+arm_ger_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ger_d(_jit, r0, r1, r2);+ else vfp_ger_d(_jit, r0, r1, r2);+}++#define jit_gtr_f(r0, r1, r2) arm_gtr_f(_jit, r0, r1, r2)+__jit_inline void+arm_gtr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_gtr_f(_jit, r0, r1, r2);+ else vfp_gtr_f(_jit, r0, r1, r2);+}++#define jit_gtr_d(r0, r1, r2) arm_gtr_d(_jit, r0, r1, r2)+__jit_inline void+arm_gtr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_gtr_d(_jit, r0, r1, r2);+ else vfp_gtr_d(_jit, r0, r1, r2);+}++#define jit_ner_f(r0, r1, r2) arm_ner_f(_jit, r0, r1, r2)+__jit_inline void+arm_ner_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ner_f(_jit, r0, r1, r2);+ else vfp_ner_f(_jit, r0, r1, r2);+}++#define jit_ner_d(r0, r1, r2) arm_ner_d(_jit, r0, r1, r2)+__jit_inline void+arm_ner_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ner_d(_jit, r0, r1, r2);+ else vfp_ner_d(_jit, r0, r1, r2);+}++#define jit_unltr_f(r0, r1, r2) arm_unltr_f(_jit, r0, r1, r2)+__jit_inline void+arm_unltr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unltr_f(_jit, r0, r1, r2);+ else vfp_unltr_f(_jit, r0, r1, r2);+}++#define jit_unltr_d(r0, r1, r2) arm_unltr_d(_jit, r0, r1, r2)+__jit_inline void+arm_unltr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unltr_d(_jit, r0, r1, r2);+ else vfp_unltr_d(_jit, r0, r1, r2);+}++#define jit_unler_f(r0, r1, r2) arm_unler_f(_jit, r0, r1, r2)+__jit_inline void+arm_unler_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unler_f(_jit, r0, r1, r2);+ else vfp_unler_f(_jit, r0, r1, r2);+}++#define jit_unler_d(r0, r1, r2) arm_unler_d(_jit, r0, r1, r2)+__jit_inline void+arm_unler_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unler_d(_jit, r0, r1, r2);+ else vfp_unler_d(_jit, r0, r1, r2);+}++#define jit_uneqr_f(r0, r1, r2) arm_uneqr_f(_jit, r0, r1, r2)+__jit_inline void+arm_uneqr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_uneqr_f(_jit, r0, r1, r2);+ else vfp_uneqr_f(_jit, r0, r1, r2);+}++#define jit_uneqr_d(r0, r1, r2) arm_uneqr_d(_jit, r0, r1, r2)+__jit_inline void+arm_uneqr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_uneqr_d(_jit, r0, r1, r2);+ else vfp_uneqr_d(_jit, r0, r1, r2);+}++#define jit_unger_f(r0, r1, r2) arm_unger_f(_jit, r0, r1, r2)+__jit_inline void+arm_unger_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unger_f(_jit, r0, r1, r2);+ else vfp_unger_f(_jit, r0, r1, r2);+}++#define jit_unger_d(r0, r1, r2) arm_unger_d(_jit, r0, r1, r2)+__jit_inline void+arm_unger_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unger_d(_jit, r0, r1, r2);+ else vfp_unger_d(_jit, r0, r1, r2);+}++#define jit_ungtr_f(r0, r1, r2) arm_ungtr_f(_jit, r0, r1, r2)+__jit_inline void+arm_ungtr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ungtr_f(_jit, r0, r1, r2);+ else vfp_ungtr_f(_jit, r0, r1, r2);+}++#define jit_ungtr_d(r0, r1, r2) arm_ungtr_d(_jit, r0, r1, r2)+__jit_inline void+arm_ungtr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ungtr_d(_jit, r0, r1, r2);+ else vfp_ungtr_d(_jit, r0, r1, r2);+}++#define jit_ltgtr_f(r0, r1, r2) arm_ltgtr_f(_jit, r0, r1, r2)+__jit_inline void+arm_ltgtr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ltgtr_f(_jit, r0, r1, r2);+ else vfp_ltgtr_f(_jit, r0, r1, r2);+}++#define jit_ltgtr_d(r0, r1, r2) arm_ltgtr_d(_jit, r0, r1, r2)+__jit_inline void+arm_ltgtr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ltgtr_d(_jit, r0, r1, r2);+ else vfp_ltgtr_d(_jit, r0, r1, r2);+}++#define jit_ordr_f(r0, r1, r2) arm_ordr_f(_jit, r0, r1, r2)+__jit_inline void+arm_ordr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ordr_f(_jit, r0, r1, r2);+ else vfp_ordr_f(_jit, r0, r1, r2);+}++#define jit_ordr_d(r0, r1, r2) arm_ordr_d(_jit, r0, r1, r2)+__jit_inline void+arm_ordr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_ordr_d(_jit, r0, r1, r2);+ else vfp_ordr_d(_jit, r0, r1, r2);+}++#define jit_unordr_f(r0, r1, r2) arm_unordr_f(_jit, r0, r1, r2)+__jit_inline void+arm_unordr_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unordr_f(_jit, r0, r1, r2);+ else vfp_unordr_f(_jit, r0, r1, r2);+}++#define jit_unordr_d(r0, r1, r2) arm_unordr_d(_jit, r0, r1, r2)+__jit_inline void+arm_unordr_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1, jit_fpr_t r2)+{+ assert(r1 != JIT_FPRET && r2 != JIT_FPRET);+ if (jit_swf_p()) swf_unordr_d(_jit, r0, r1, r2);+ else vfp_unordr_d(_jit, r0, r1, r2);+}++#define jit_bltr_f(i0, r0, r1) arm_bltr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bltr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bltr_f(_jit, i0, r0, r1));+ return (vfp_bltr_f(_jit, i0, r0, r1));+}++#define jit_bltr_d(i0, r0, r1) arm_bltr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bltr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bltr_d(_jit, i0, r0, r1));+ return (vfp_bltr_d(_jit, i0, r0, r1));+}++#define jit_bler_f(i0, r0, r1) arm_bler_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bler_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bler_f(_jit, i0, r0, r1));+ return (vfp_bler_f(_jit, i0, r0, r1));+}++#define jit_bler_d(i0, r0, r1) arm_bler_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bler_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bler_d(_jit, i0, r0, r1));+ return (vfp_bler_d(_jit, i0, r0, r1));+}++#define jit_beqr_f(i0, r0, r1) arm_beqr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_beqr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_beqr_f(_jit, i0, r0, r1));+ return (vfp_beqr_f(_jit, i0, r0, r1));+}++#define jit_beqr_d(i0, r0, r1) arm_beqr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_beqr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_beqr_d(_jit, i0, r0, r1));+ return (vfp_beqr_d(_jit, i0, r0, r1));+}++#define jit_bger_f(i0, r0, r1) arm_bger_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bger_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bger_f(_jit, i0, r0, r1));+ return (vfp_bger_f(_jit, i0, r0, r1));+}++#define jit_bger_d(i0, r0, r1) arm_bger_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bger_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bger_d(_jit, i0, r0, r1));+ return (vfp_bger_d(_jit, i0, r0, r1));+}++#define jit_bgtr_f(i0, r0, r1) arm_bgtr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bgtr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bgtr_f(_jit, i0, r0, r1));+ return (vfp_bgtr_f(_jit, i0, r0, r1));+}++#define jit_bgtr_d(i0, r0, r1) arm_bgtr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bgtr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bgtr_d(_jit, i0, r0, r1));+ return (vfp_bgtr_d(_jit, i0, r0, r1));+}++#define jit_bner_f(i0, r0, r1) arm_bner_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bner_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bner_f(_jit, i0, r0, r1));+ return (vfp_bner_f(_jit, i0, r0, r1));+}++#define jit_bner_d(i0, r0, r1) arm_bner_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bner_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bner_d(_jit, i0, r0, r1));+ return (vfp_bner_d(_jit, i0, r0, r1));+}++#define jit_bunltr_f(i0, r0, r1) arm_bunltr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunltr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunltr_f(_jit, i0, r0, r1));+ return (vfp_bunltr_f(_jit, i0, r0, r1));+}++#define jit_bunltr_d(i0, r0, r1) arm_bunltr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunltr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunltr_d(_jit, i0, r0, r1));+ return (vfp_bunltr_d(_jit, i0, r0, r1));+}++#define jit_bunler_f(i0, r0, r1) arm_bunler_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunler_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunler_f(_jit, i0, r0, r1));+ return (vfp_bunler_f(_jit, i0, r0, r1));+}++#define jit_bunler_d(i0, r0, r1) arm_bunler_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunler_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunler_d(_jit, i0, r0, r1));+ return (vfp_bunler_d(_jit, i0, r0, r1));+}++#define jit_buneqr_f(i0, r0, r1) arm_buneqr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_buneqr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_buneqr_f(_jit, i0, r0, r1));+ return (vfp_buneqr_f(_jit, i0, r0, r1));+}++#define jit_buneqr_d(i0, r0, r1) arm_buneqr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_buneqr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_buneqr_d(_jit, i0, r0, r1));+ return (vfp_buneqr_d(_jit, i0, r0, r1));+}++#define jit_bunger_f(i0, r0, r1) arm_bunger_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunger_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunger_f(_jit, i0, r0, r1));+ return (vfp_bunger_f(_jit, i0, r0, r1));+}++#define jit_bunger_d(i0, r0, r1) arm_bunger_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunger_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunger_d(_jit, i0, r0, r1));+ return (vfp_bunger_d(_jit, i0, r0, r1));+}++#define jit_bungtr_f(i0, r0, r1) arm_bungtr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bungtr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bungtr_f(_jit, i0, r0, r1));+ return (vfp_bungtr_f(_jit, i0, r0, r1));+}++#define jit_bungtr_d(i0, r0, r1) arm_bungtr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bungtr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bungtr_d(_jit, i0, r0, r1));+ return (vfp_bungtr_d(_jit, i0, r0, r1));+}++#define jit_bltgtr_f(i0, r0, r1) arm_bltgtr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bltgtr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bltgtr_f(_jit, i0, r0, r1));+ return (vfp_bltgtr_f(_jit, i0, r0, r1));+}++#define jit_bltgtr_d(i0, r0, r1) arm_bltgtr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bltgtr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bltgtr_d(_jit, i0, r0, r1));+ return (vfp_bltgtr_d(_jit, i0, r0, r1));+}++#define jit_bordr_f(i0, r0, r1) arm_bordr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bordr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bordr_f(_jit, i0, r0, r1));+ return (vfp_bordr_f(_jit, i0, r0, r1));+}++#define jit_bordr_d(i0, r0, r1) arm_bordr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bordr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bordr_d(_jit, i0, r0, r1));+ return (vfp_bordr_d(_jit, i0, r0, r1));+}++#define jit_bunordr_f(i0, r0, r1) arm_bunordr_f(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunordr_f(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunordr_f(_jit, i0, r0, r1));+ return (vfp_bunordr_f(_jit, i0, r0, r1));+}++#define jit_bunordr_d(i0, r0, r1) arm_bunordr_d(_jit, i0, r0, r1)+__jit_inline jit_insn *+arm_bunordr_d(jit_state_t _jit, jit_insn *i0, jit_fpr_t r0, jit_fpr_t r1)+{+ assert(r0 != JIT_FPRET && r1 != JIT_FPRET);+ if (jit_swf_p()) return (swf_bunordr_d(_jit, i0, r0, r1));+ return (vfp_bunordr_d(_jit, i0, r0, r1));+}++#define jit_ldr_f(r0, r1) arm_ldr_f(_jit, r0, r1)+__jit_inline void+arm_ldr_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldr_f(_jit, r0, r1);+ else vfp_ldr_f(_jit, r0, r1);+}++#define jit_ldr_d(r0, r1) arm_ldr_d(_jit, r0, r1)+__jit_inline void+arm_ldr_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldr_d(_jit, r0, r1);+ else vfp_ldr_d(_jit, r0, r1);+}++#define jit_ldi_f(r0, i0) arm_ldi_f(_jit, r0, i0)+__jit_inline void+arm_ldi_f(jit_state_t _jit, jit_fpr_t r0, void *i0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldi_f(_jit, r0, i0);+ else vfp_ldi_f(_jit, r0, i0);+}++#define jit_ldi_d(r0, i0) arm_ldi_d(_jit, r0, i0)+__jit_inline void+arm_ldi_d(jit_state_t _jit, jit_fpr_t r0, void *i0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldi_d(_jit, r0, i0);+ else vfp_ldi_d(_jit, r0, i0);+}++#define jit_ldxr_f(r0, r1, r2) arm_ldxr_f(_jit, r0, r1, r2)+__jit_inline void+arm_ldxr_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldxr_f(_jit, r0, r1, r2);+ else vfp_ldxr_f(_jit, r0, r1, r2);+}++#define jit_ldxr_d(r0, r1, r2) arm_ldxr_d(_jit, r0, r1, r2)+__jit_inline void+arm_ldxr_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldxr_d(_jit, r0, r1, r2);+ else vfp_ldxr_d(_jit, r0, r1, r2);+}++#define jit_ldxi_f(r0, r1, i0) arm_ldxi_f(_jit, r0, r1, i0)+__jit_inline void+arm_ldxi_f(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, int i0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldxi_f(_jit, r0, r1, i0);+ else vfp_ldxi_f(_jit, r0, r1, i0);+}++#define jit_ldxi_d(r0, r1, i0) arm_ldxi_d(_jit, r0, r1, i0)+__jit_inline void+arm_ldxi_d(jit_state_t _jit, jit_fpr_t r0, jit_gpr_t r1, int i0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_ldxi_d(_jit, r0, r1, i0);+ else vfp_ldxi_d(_jit, r0, r1, i0);+}++#define jit_str_f(r0, r1) arm_str_f(_jit, r0, r1)+__jit_inline void+arm_str_f(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_str_f(_jit, r0, r1);+ else vfp_str_f(_jit, r0, r1);+}++#define jit_str_d(r0, r1) arm_str_d(_jit, r0, r1)+__jit_inline void+arm_str_d(jit_state_t _jit, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_str_d(_jit, r0, r1);+ else vfp_str_d(_jit, r0, r1);+}++#define jit_sti_f(i0, r0) arm_sti_f(_jit, i0, r0)+__jit_inline void+arm_sti_f(jit_state_t _jit, void *i0, jit_fpr_t r0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_sti_f(_jit, i0, r0);+ else vfp_sti_f(_jit, i0, r0);+}++#define jit_sti_d(i0, r0) arm_sti_d(_jit, i0, r0)+__jit_inline void+arm_sti_d(jit_state_t _jit, void *i0, jit_fpr_t r0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_sti_d(_jit, i0, r0);+ else vfp_sti_d(_jit, i0, r0);+}++#define jit_stxr_f(r0, r1, r2) arm_stxr_f(_jit, r0, r1, r2)+__jit_inline void+arm_stxr_f(jit_state_t _jit, jit_gpr_t r0, jit_gpr_t r1, jit_fpr_t r2)+{+ assert(r2 != JIT_FPRET);+ if (jit_swf_p()) swf_stxr_f(_jit, r0, r1, r2);+ else vfp_stxr_f(_jit, r0, r1, r2);+}++#define jit_stxr_d(r0, r1, r2) arm_stxr_d(_jit, r0, r1, r2)+__jit_inline void+arm_stxr_d(jit_state_t _jit, jit_gpr_t r0, jit_gpr_t r1, jit_fpr_t r2)+{+ assert(r2 != JIT_FPRET);+ if (jit_swf_p()) swf_stxr_d(_jit, r0, r1, r2);+ else vfp_stxr_d(_jit, r0, r1, r2);+}++#define jit_stxi_f(i0, r0, r1) arm_stxi_f(_jit, i0, r0, r1)+__jit_inline void+arm_stxi_f(jit_state_t _jit, int i0, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_stxi_f(_jit, i0, r0, r1);+ else vfp_stxi_f(_jit, i0, r0, r1);+}++#define jit_stxi_d(i0, r0, r1) arm_stxi_d(_jit, i0, r0, r1)+__jit_inline void+arm_stxi_d(jit_state_t _jit, int i0, jit_gpr_t r0, jit_fpr_t r1)+{+ assert(r1 != JIT_FPRET);+ if (jit_swf_p()) swf_stxi_d(_jit, i0, r0, r1);+ else vfp_stxi_d(_jit, i0, r0, r1);+}++#define jit_prolog_f(i0) do {} while (0)+#define jit_prolog_d(i0) do {} while (0)++#define jit_prepare_f(i0) arm_prepare_f(_jit, i0)+__jit_inline void+arm_prepare_f(jit_state_t _jit, int i0)+{+ assert(i0 >= 0);+ _jitl.stack_offset += i0 << 2;+}+#endif+#define jit_prepare_d(i0) \+ (assert(i0 >= 0), \+ _jitl.stack_offset += i0 << 3)+#if 0+#define jit_arg_f() arm_arg_f(_jit)+__jit_inline int+arm_arg_f(jit_state_t _jit)+{+ int ofs;+ if (jit_hardfp_p()) {+ ofs = _jitl.nextarg_getf++;+ if (ofs < 16)+ return (ofs);+ }+ else {+ ofs = _jitl.nextarg_get++;+ if (ofs < 4)+ return (ofs);+ }+ ofs = _jitl.framesize;+ _jitl.framesize += sizeof(int);+ return (ofs);+}++#define jit_arg_d() arm_arg_d(_jit)+__jit_inline int+arm_arg_d(jit_state_t _jit)+{+ int ofs;+ if (jit_hardfp_p()) {+ if (_jitl.nextarg_getf & 1)+ ++_jitl.nextarg_getf;+ ofs = _jitl.nextarg_getf;+ _jitl.nextarg_getf += 2;+ if (ofs < 16)+ return (ofs);+ }+ else {+ if (_jitl.nextarg_get & 1)+ ++_jitl.nextarg_get;+ ofs = _jitl.nextarg_get;+ _jitl.nextarg_get += 2;+ if (ofs < 4)+ return (ofs);+ }+ if (_jitl.framesize & 7)+ _jitl.framesize += 4;+ ofs = _jitl.framesize;+ _jitl.framesize += sizeof(double);+ return (ofs);+}++#define jit_getarg_f(r0, i0) arm_getarg_f(_jit, r0, i0)+__jit_inline void+arm_getarg_f(jit_state_t _jit, jit_fpr_t r0, int i0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_getarg_f(_jit, r0, i0);+ else vfp_getarg_f(_jit, r0, i0);+}++#define jit_getarg_d(r0, i0) arm_getarg_d(_jit, r0, i0)+__jit_inline void+arm_getarg_d(jit_state_t _jit, jit_fpr_t r0, int i0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_getarg_d(_jit, r0, i0);+ else vfp_getarg_d(_jit, r0, i0);+}++#define jit_pusharg_f(r0) arm_pusharg_f(_jit, r0)+__jit_inline void+arm_pusharg_f(jit_state_t _jit, jit_fpr_t r0)+{+ assert(r0 != JIT_FPRET);+ if (jit_swf_p()) swf_pusharg_f(_jit, r0);+ else vfp_pusharg_f(_jit, r0);+}+#endif+#define jit_pusharg_d(r0) \+ (assert(r0 != JIT_FPRET), \+ jit_swf_p() ? swf_pusharg_d(_jit, r0) \+ : vfp_pusharg_d(_jit, r0))+#if 0+#define jit_retval_f(r0) arm_retval_f(_jit, r0)+__jit_inline void+arm_retval_f(jit_state_t _jit, jit_fpr_t r0)+{+ if (r0 != JIT_FPRET) {+ if (jit_swf_p()) swf_retval_f(_jit, r0);+ else vfp_retval_f(_jit, r0);+ }+ /* else assume chaining call to jit_retval_f as done in tests/funcfp.c */+}++#define jit_retval_d(r0) arm_retval_d(_jit, r0)+__jit_inline void+arm_retval_d(jit_state_t _jit, jit_fpr_t r0)+{+ if (r0 != JIT_FPRET) {+ if (jit_swf_p()) swf_retval_d(_jit, r0);+ else vfp_retval_d(_jit, r0);+ }+ /* else assume chaining call to jit_retval_d as done in tests/funcfp.c */+}+#else+#define jit_ldxi_d(r0, r1, i0) 0+#define jit_movi_d(r0, i0) 0+#define jit_bner_d(i0, r0, r1) 0+#endif+#endif /* __lightning_fp_arm_h */
@@ -0,0 +1,193 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler for the arm+ *+ ***********************************************************************/++/***********************************************************************+ *+ * Copyright 2011 Free Software Foundation+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ * Authors:+ * Paulo Cesar Pereira de Andrade+ ***********************************************************************/++#ifndef __lightning_funcs_h+#define __lightning_funcs_h++#if defined(__linux__)+# include <stdio.h>+# include <string.h>+#endif++#include <stdlib.h>+#include <unistd.h>+#include <sys/mman.h>++#if defined(ios_HOST_OS) || defined (darwin_HOST_OS)+extern void sys_icache_invalidate(void *start, size_t len);++static void+jit_flush_code(void *start, void *end)+{+ mprotect(start, (char *)end - (char *)start,+ PROT_READ | PROT_WRITE | PROT_EXEC);+ sys_icache_invalidate(start, (char *)end-(char *)start);+}+#else+extern void __clear_cache(void*, void*);++static void+jit_flush_code(void *start, void *end)+{+ mprotect(start, (char *)end - (char *)start,+ PROT_READ | PROT_WRITE | PROT_EXEC);+ __clear_cache(start, end);+}+#endif++__attribute__((constructor)) static void+jit_get_cpu(void)+{+#if defined(__linux__)+ FILE *fp;+ char *ptr;+ char buf[128];+ static int initialized;++ if (initialized)+ return;+ initialized = 1;+ if ((fp = fopen("/proc/cpuinfo", "r")) == NULL)+ return;++ while (fgets(buf, sizeof(buf), fp)) {+ if (strncmp(buf, "CPU architecture:", 17) == 0) {+ jit_cpu.version = strtol(buf + 17, &ptr, 10);+ while (*ptr) {+ if (*ptr == 'T' || *ptr == 't') {+ ++ptr;+ jit_cpu.thumb = 1;+ }+ else if (*ptr == 'E' || *ptr == 'e') {+ jit_cpu.extend = 1;+ ++ptr;+ }+ else+ ++ptr;+ }+ }+ else if (strncmp(buf, "Features\t:", 10) == 0) {+ if ((ptr = strstr(buf + 10, "vfpv")))+ jit_cpu.vfp = strtol(ptr + 4, NULL, 0);+ if ((ptr = strstr(buf + 10, "neon")))+ jit_cpu.neon = 1;+ if ((ptr = strstr(buf + 10, "thumb")))+ jit_cpu.thumb = 1;+ }+ }+ fclose(fp);+#endif+#if defined(__ARM_PCS_VFP)+ if (!jit_cpu.vfp)+ jit_cpu.vfp = 3;+ if (!jit_cpu.version)+ jit_cpu.version = 7;+ jit_cpu.abi = 1;+#endif+ /* armv6t2 todo (software float and thumb2) */+ if (!jit_cpu.vfp && jit_cpu.thumb)+ jit_cpu.thumb = 0;+}++extern int __aeabi_idivmod(int, int);+extern unsigned __aeabi_uidivmod(unsigned, unsigned);++#pragma push_macro("_jit")+#ifdef _jit+#undef _jit+#endif+#define _jit (*jit)+static void+arm_divmod(jit_state* jit, int div, int sign,+ jit_gpr_t r0, jit_gpr_t r1, jit_gpr_t r2)+{+ int d;+ int l;+ void *p;+ l = 0xf;+ if ((int)r0 < 4)+ /* bogus extra push to align at 8 bytes */+ l = (l & ~(1 << r0)) | 0x10;+#ifdef USE_THUMB_CODE+ T1_PUSH(l);+#else+ _PUSH(l);+#endif+ if (r1 == _R1 && r2 == _R0) {+ jit_movr_i(JIT_FTMP, _R0);+ jit_movr_i(_R0, _R1);+ jit_movr_i(_R1, JIT_FTMP);+ } else if (r2 == _R0) {+ jit_movr_i(_R1, r2);+ jit_movr_i(_R0, r1);+ } else {+ jit_movr_i(_R0, r1);+ jit_movr_i(_R1, r2);+ }+ p = (sign) ? (void*) __aeabi_idivmod : (void*) __aeabi_uidivmod;+ if (!jit_exchange_p()) {+#ifdef USE_THUMB_CODE+ d = (((int)p - (int)_jit.x.pc) >> 1) - 2;+#else+ d = (((int)p - (int)_jit.x.pc) >> 2) - 2;+#endif+ if (_s24P(d)) {+#ifdef USE_THUMB_CODE+ T2_BLI(encode_thumb_jump(d));+#else+ _BLI(d & 0x00ffffff);+#endif+ }+ else+ goto fallback;+ } else {+fallback:+ jit_movi_i(JIT_FTMP, (int)p);+#ifdef USE_THUMB_CODE+ T1_BLX(JIT_FTMP);+#else+ _BLX(JIT_FTMP);+#endif+ }+ if (div) {+ jit_movr_i(r0, _R0);+ } else {+ jit_movr_i(r0, _R1);+ }+#ifdef USE_THUMB_CODE+ T1_POP(l);+#else+ _POP(l);+#endif+}+#pragma pop_macro("_jit")++#endif /* __lightning_funcs_h */
@@ -0,0 +1,207 @@+/******************************** -*- C -*- ****************************+ *+ * Dynamic assembler support+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ ***********************************************************************/+++#ifndef __lightning_asm_common_h_+#define __lightning_asm_common_h_+++#ifndef _ASM_SAFETY+#define JITFAIL(MSG) 0+#else+#if (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L) || (defined __GNUC__ && (__GNUC__ == 3 ? __GNUC_MINOR__ >= 2 : __GNUC__ > 3))+#define JITFAIL(MSG) jit_fail(MSG, __FILE__, __LINE__, __func__)+#elif defined __GNUC__+#define JITFAIL(MSG) jit_fail(MSG, __FILE__, __LINE__, __FUNCTION__)+#else+#define JITFAIL(MSG) jit_fail(MSG, __FILE__, __LINE__, "(unknown)")+#endif+#endif++#if (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L) || (defined __GNUC__ && (__GNUC__ == 3 ? __GNUC_MINOR__ >= 2 : __GNUC__ > 3))+#define JITSORRY(MSG) jit_fail("sorry, unimplemented: " MSG, __FILE__, __LINE__, __func__)+#elif defined __GNUC__+#define JITSORRY(MSG) jit_fail("sorry, unimplemented: " MSG, __FILE__, __LINE__, __FUNCTION__)+#else+#define JITSORRY(MSG) jit_fail("sorry, unimplemented: " MSG, __FILE__, __LINE__, "(unknown)")+#endif++#ifdef __GNUC__+#define JIT_UNUSED __attribute__((__unused__))+#else+#define JIT_UNUSED+#endif+++/* NextStep 2.0 cc is really gcc 1.93 but it defines __GNUC__ = 2 and+ does not implement __extension__. But that compiler doesn't define+ __GNUC_MINOR__. */+#ifdef __GNUC__+#if __GNUC__ < 2 || (defined(__NeXT__) && !__GNUC_MINOR__)+#define __extension__+#endif++#define _TEMPD(type, var) ++#define _TEMP(type, var, val, body) __extension__ ({ \+ register struct { type var } _jitl; _jitl.var = val; \+ body; \+})++#else++/* Between loading a global and calling a subroutine, we choose the lesser+ * evil. */+#define _TEMPD(type, var) static type var;+#define _TEMP(type, var, val, body) ((var = val), body)++#endif++typedef char _sc;+typedef unsigned char _uc;+typedef unsigned short _us;+typedef unsigned int _ui;+typedef long _sl;+typedef unsigned long _ul;++#define _jit_UC(X) ((_uc )(X))+#define _jit_US(X) ((_us )(X))+#define _jit_UI(X) ((_ui )(X))+#define _jit_SI(X) ((int )(X))+#define _jit_SL(X) ((_sl )(X))+#define _jit_UL(X) ((_ul )(X))+# define _PUC(X) ((_uc *)(X))+# define _PUS(X) ((_us *)(X))+# define _PUI(X) ((_ui *)(X))+# define _PSI(X) ((int *)(X))+# define _PSL(X) ((_sl *)(X))+# define _PUL(X) ((_ul *)(X))++#define _jit_B(B) _jit_UL(((*_jit.x.uc_pc++)= _jit_UC((B)& 0xff)))+#define _jit_W(W) _jit_UL(((*_jit.x.us_pc++)= _jit_US((W)&0xffff)))+#define _jit_I(I) _jit_UL(((*_jit.x.ui_pc++)= _jit_UI((I) )))+#define _jit_L(L) _jit_UL(((*_jit.x.ul_pc++)= _jit_UL((L) )))+#define _jit_I_noinc(I) _jit_UL(((*_jit.x.ui_pc)= _jit_UI((I) )))++#define _MASK(N) ((unsigned long)((1L<<(N)))-1L)+#define _siP(N,I) (!((((unsigned long)(I))^(((unsigned long)(I))<<1))&~_MASK(N)))+#define _uiP(N,I) (!(((unsigned long)(I))&~_MASK(N)))+#define _suiP(N,I) (_siP(N,I) | _uiP(N,I))++#ifndef _ASM_SAFETY+#define _ck_s(W,I) (_jit_UL(I) & _MASK(W))+#define _ck_u(W,I) (_jit_UL(I) & _MASK(W))+#define _ck_su(W,I) (_jit_UL(I) & _MASK(W))+#define _ck_d(W,I) (_jit_UL(I) & _MASK(W))+#else+#define _ck_s(W,I) (_siP(W,I) ? (_jit_UL(I) & _MASK(W)) : JITFAIL( "signed integer `"#I"' too large for "#W"-bit field"))+#define _ck_u(W,I) (_uiP(W,I) ? (_jit_UL(I) & _MASK(W)) : JITFAIL("unsigned integer `"#I"' too large for "#W"-bit field"))+#define _ck_su(W,I) (_suiP(W,I) ? (_jit_UL(I) & _MASK(W)) : JITFAIL( "integer `"#I"' too large for "#W"-bit field"))+#define _ck_d(W,I) (_siP(W,I) ? (_jit_UL(I) & _MASK(W)) : JITFAIL( "displacement `"#I"' too large for "#W"-bit field"))+#endif++#define _s0P(I) ((I)==0)+#define _s8P(I) _siP(8,I)+#define _s16P(I) _siP(16,I)+#define _s20P(I) _siP(20,I)+#define _s24P(I) _siP(24,I)+#define _s32P(I) _siP(32,I)+#define _u8P(I) _uiP(8,I)+#define _u16P(I) _uiP(16,I)+#define _u32P(I) _uiP(32,I)++#define _su8(I) _ck_su(8,I)+#define _su16(I) _ck_su(16,I)++#define _s1(I) _ck_s( 1,I)+#define _s2(I) _ck_s( 2,I)+#define _s3(I) _ck_s( 3,I)+#define _s4(I) _ck_s( 4,I)+#define _s5(I) _ck_s( 5,I)+#define _s6(I) _ck_s( 6,I)+#define _s7(I) _ck_s( 7,I)+#define _s8(I) _ck_s( 8,I)+#define _s9(I) _ck_s( 9,I)+#define _s10(I) _ck_s(10,I)+#define _s11(I) _ck_s(11,I)+#define _s12(I) _ck_s(12,I)+#define _s13(I) _ck_s(13,I)+#define _s14(I) _ck_s(14,I)+#define _s15(I) _ck_s(15,I)+#define _s16(I) _ck_s(16,I)+#define _s17(I) _ck_s(17,I)+#define _s18(I) _ck_s(18,I)+#define _s19(I) _ck_s(19,I)+#define _s20(I) _ck_s(20,I)+#define _s21(I) _ck_s(21,I)+#define _s22(I) _ck_s(22,I)+#define _s23(I) _ck_s(23,I)+#define _s24(I) _ck_s(24,I)+#define _s25(I) _ck_s(25,I)+#define _s26(I) _ck_s(26,I)+#define _s27(I) _ck_s(27,I)+#define _s28(I) _ck_s(28,I)+#define _s29(I) _ck_s(29,I)+#define _s30(I) _ck_s(30,I)+#define _s31(I) _ck_s(31,I)+#define _u1(I) _ck_u( 1,I)+#define _u2(I) _ck_u( 2,I)+#define _u3(I) _ck_u( 3,I)+#define _u4(I) _ck_u( 4,I)+#define _u5(I) _ck_u( 5,I)+#define _u6(I) _ck_u( 6,I)+#define _u7(I) _ck_u( 7,I)+#define _u8(I) _ck_u( 8,I)+#define _u9(I) _ck_u( 9,I)+#define _u10(I) _ck_u(10,I)+#define _u11(I) _ck_u(11,I)+#define _u12(I) _ck_u(12,I)+#define _u13(I) _ck_u(13,I)+#define _u14(I) _ck_u(14,I)+#define _u15(I) _ck_u(15,I)+#define _u16(I) _ck_u(16,I)+#define _u17(I) _ck_u(17,I)+#define _u18(I) _ck_u(18,I)+#define _u19(I) _ck_u(19,I)+#define _u20(I) _ck_u(20,I)+#define _u21(I) _ck_u(21,I)+#define _u22(I) _ck_u(22,I)+#define _u23(I) _ck_u(23,I)+#define _u24(I) _ck_u(24,I)+#define _u25(I) _ck_u(25,I)+#define _u26(I) _ck_u(26,I)+#define _u27(I) _ck_u(27,I)+#define _u28(I) _ck_u(28,I)+#define _u29(I) _ck_u(29,I)+#define _u30(I) _ck_u(30,I)+#define _u31(I) _ck_u(31,I)++#endif /* __lightning_asm_common_h */
@@ -0,0 +1,638 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer support+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2003 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/+++#ifndef __lightning_core_common_h_+#define __lightning_core_common_h_++typedef struct {+ union {+ jit_insn *pc;+ _uc *uc_pc;+ _us *us_pc;+ _ui *ui_pc;+ _ul *ul_pc;+ } x;+ struct jit_fp *fp;+ struct jit_local_state jitl;+} jit_state;++#define JIT_NOREG (-1)+#define JIT_R0 JIT_R(0)+#define JIT_R1 JIT_R(1)+#define JIT_R2 JIT_R(2)+#define JIT_V0 JIT_V(0)+#define JIT_V1 JIT_V(1)+#define JIT_V2 JIT_V(2)+#define JIT_FPR0 JIT_FPR(0)+#define JIT_FPR1 JIT_FPR(1)+#define JIT_FPR2 JIT_FPR(2)+#define JIT_FPR3 JIT_FPR(3)+#define JIT_FPR4 JIT_FPR(4)+#define JIT_FPR5 JIT_FPR(5)++#define _jitl _jit.jitl++#define jit_get_ip() (*(jit_code *) &_jit.x.pc)+#define jit_set_ip(ptr) (_jit.x.pc = (ptr), jit_get_ip ())+#define jit_get_label() (_jit.x.pc)+#define jit_forward() (_jit.x.pc)++#define jit_field(struc, f) ( ((long) (&((struc *) 8)->f) ) - 8)+#define jit_ptr_field(struc_p, f) ( ((long) (&((struc_p) 8)->f) ) - 8)++/* realignment via N-byte no-ops */++#ifndef jit_align+#define jit_align(n)+#endif++/* jit_code: union of many possible function pointer types. Returned+ * by jit_get_ip().+ */+typedef union jit_code { + char *ptr;+ void (*vptr)(void);+ char (*cptr)(void);+ unsigned char (*ucptr)(void);+ short (*sptr)(void);+ unsigned short (*usptr)(void);+ int (*iptr)(void);+ unsigned int (*uiptr)(void);+ long (*lptr)(void);+ unsigned long (*ulptr)(void);+ void * (*pptr)(void);+ float (*fptr)(void);+ double (*dptr)(void);+} jit_code;++#ifndef jit_fill_delay_after+#define jit_fill_delay_after(branch) (branch)+#endif++#define jit_delay(insn, branch) ((insn), jit_fill_delay_after(branch))+++/* ALU synonyms */+#define jit_addi_ui(d, rs, is) jit_addi_i((d), (rs), (is)) +#define jit_addr_ui(d, s1, s2) jit_addr_i((d), (s1), (s2))+#define jit_addci_ui(d, rs, is) jit_addci_i((d), (rs), (is)) +#define jit_addcr_ui(d, s1, s2) jit_addcr_i((d), (s1), (s2))+#define jit_addxi_ui(d, rs, is) jit_addxi_i((d), (rs), (is)) +#define jit_addxr_ui(d, s1, s2) jit_addxr_i((d), (s1), (s2))+#define jit_andi_ui(d, rs, is) jit_andi_i((d), (rs), (is)) +#define jit_andr_ui(d, s1, s2) jit_andr_i((d), (s1), (s2))+#define jit_lshi_ui(d, rs, is) jit_lshi_i((d), (rs), (is)) +#define jit_lshr_ui(d, s1, s2) jit_lshr_i((d), (s1), (s2))+#define jit_movi_ui(d, rs) jit_movi_i((d), (rs))+#define jit_movr_ui(d, rs) jit_movr_i((d), (rs))+#define jit_ori_ui(d, rs, is) jit_ori_i((d), (rs), (is)) +#define jit_orr_ui(d, s1, s2) jit_orr_i((d), (s1), (s2))+#define jit_rsbi_ui(d, rs, is) jit_rsbi_i((d), (rs), (is)) +#define jit_rsbr_ui(d, s1, s2) jit_rsbr_i((d), (s1), (s2))+#define jit_subi_ui(d, rs, is) jit_subi_i((d), (rs), (is)) +#define jit_subr_ui(d, s1, s2) jit_subr_i((d), (s1), (s2))+#define jit_subci_ui(d, rs, is) jit_subci_i((d), (rs), (is)) +#define jit_subcr_ui(d, s1, s2) jit_subcr_i((d), (s1), (s2))+#define jit_subxi_ui(d, rs, is) jit_subxi_i((d), (rs), (is)) +#define jit_subxr_ui(d, s1, s2) jit_subxr_i((d), (s1), (s2))+#define jit_xori_ui(d, rs, is) jit_xori_i((d), (rs), (is)) +#define jit_xorr_ui(d, s1, s2) jit_xorr_i((d), (s1), (s2))++#define jit_addi_ul(d, rs, is) jit_addi_l((d), (rs), (is)) +#define jit_addr_ul(d, s1, s2) jit_addr_l((d), (s1), (s2))+#define jit_addci_ul(d, rs, is) jit_addci_l((d), (rs), (is)) +#define jit_addcr_ul(d, s1, s2) jit_addcr_l((d), (s1), (s2))+#define jit_addxi_ul(d, rs, is) jit_addxi_l((d), (rs), (is)) +#define jit_addxr_ul(d, s1, s2) jit_addxr_l((d), (s1), (s2))+#define jit_andi_ul(d, rs, is) jit_andi_l((d), (rs), (is)) +#define jit_andr_ul(d, s1, s2) jit_andr_l((d), (s1), (s2))+#define jit_lshi_ul(d, rs, is) jit_lshi_l((d), (rs), (is)) +#define jit_lshr_ul(d, s1, s2) jit_lshr_l((d), (s1), (s2))+#define jit_movi_ul(d, rs) jit_movi_l((d), (rs))+#define jit_movr_ul(d, rs) jit_movr_l((d), (rs))+#define jit_ori_ul(d, rs, is) jit_ori_l((d), (rs), (is)) +#define jit_orr_ul(d, s1, s2) jit_orr_l((d), (s1), (s2))+#define jit_rsbi_ul(d, rs, is) jit_rsbi_l((d), (rs), (is)) +#define jit_rsbr_ul(d, s1, s2) jit_rsbr_l((d), (s1), (s2))+#define jit_subi_ul(d, rs, is) jit_subi_l((d), (rs), (is)) +#define jit_subr_ul(d, s1, s2) jit_subr_l((d), (s1), (s2))+#define jit_subci_ul(d, rs, is) jit_subci_l((d), (rs), (is)) +#define jit_subcr_ul(d, s1, s2) jit_subcr_l((d), (s1), (s2))+#define jit_subxi_ui(d, rs, is) jit_subxi_i((d), (rs), (is)) +#define jit_subxi_ul(d, rs, is) jit_subxi_l((d), (rs), (is)) +#define jit_subxr_ui(d, s1, s2) jit_subxr_i((d), (s1), (s2))+#define jit_subxr_ul(d, s1, s2) jit_subxr_i((d), (s1), (s2))+#define jit_xori_ul(d, rs, is) jit_xori_l((d), (rs), (is)) +#define jit_xorr_ul(d, s1, s2) jit_xorr_l((d), (s1), (s2))++#define jit_addr_p(d, s1, s2) jit_addr_ul((d), (s1), (s2))+#define jit_addi_p(d, rs, is) (jit_addi_ul((d), (rs), (long) (is)), _jit.x.pc)+#define jit_movr_p(d, rs) jit_movr_ul((d), (rs))+#define jit_subr_p(d, s1, s2) jit_subr_ul((d), (s1), (s2))+#define jit_subi_p(d, rs, is) jit_subi_ul((d), (rs), (long) (is))+#define jit_rsbi_p(d, rs, is) jit_rsbi_ul((d), (rs), (long) (is))++#ifndef jit_movi_p+#define jit_movi_p(d, is) (jit_movi_ul((d), (long) (is)), _jit.x.pc)+#endif++#define jit_patch(pv) jit_patch_at ((pv), (_jit.x.pc))++#ifndef jit_addci_i+#define jit_addci_i(d, rs, is) jit_addi_i((d), (rs), (is)) +#define jit_addcr_i(d, s1, s2) jit_addr_i((d), (s1), (s2))+#define jit_addci_l(d, rs, is) jit_addi_l((d), (rs), (is)) +#define jit_addcr_l(d, s1, s2) jit_addr_l((d), (s1), (s2))+#endif++#ifndef jit_subcr_i+#define jit_subcr_i(d, s1, s2) jit_subr_i((d), (s1), (s2))+#endif++/* NEG is not mandatory -- pick an appropriate implementation */+#ifndef jit_negr_i+# ifdef JIT_RZERO+# define jit_negr_i(d, rs) jit_subr_i((d), JIT_RZERO, (rs))+# define jit_negr_l(d, rs) jit_subr_l((d), JIT_RZERO, (rs))+# else /* !JIT_RZERO */+# ifndef jit_rsbi_i+# define jit_negr_i(d, rs) (jit_xori_i((d), (rs), -1), jit_addi_l((d), (d), 1))+# define jit_negr_l(d, rs) (jit_xori_l((d), (rs), -1), jit_addi_l((d), (d), 1))+# else /* jit_rsbi_i */+# define jit_negr_i(d, rs) jit_rsbi_i((d), (rs), 0)+# define jit_negr_l(d, rs) jit_rsbi_l((d), (rs), 0)+# endif /* jit_rsbi_i */+# endif /* !JIT_RZERO */+#endif /* !jit_negr_i */++/* RSB is not mandatory */+#ifndef jit_rsbi_i+# define jit_rsbi_i(d, rs, is) (jit_subi_i((d), (rs), (is)), jit_negr_i((d), (d)))++# ifndef jit_rsbi_l+# define jit_rsbi_l(d, rs, is) (jit_subi_l((d), (rs), (is)), jit_negr_l((d), (d)))+# endif+#endif++/* Common 'shortcut' implementations */+#ifndef jit_subi_i+#define jit_subi_i(d, rs, is) jit_addi_i((d), (rs), -(is))+#endif+#define jit_subi_l(d, rs, is) jit_addi_l((d), (rs), -(is))+#ifndef jit_subci_i+#define jit_subci_i(d, rs, is) jit_addci_i((d), (rs), -(is))+#endif+#define jit_subci_l(d, rs, is) jit_addci_l((d), (rs), -(is))+#define jit_rsbr_f(d, s1, s2) jit_subr_f((d), (s2), (s1))+#define jit_rsbr_d(d, s1, s2) jit_subr_d((d), (s2), (s1))+#ifndef jit_rsbr_i+#define jit_rsbr_i(d, s1, s2) jit_subr_i((d), (s2), (s1))+#endif+#define jit_rsbr_l(d, s1, s2) jit_subr_l((d), (s2), (s1))+#define jit_rsbr_p(d, s1, s2) jit_subr_p((d), (s2), (s1))++/* Unary */+#define jit_notr_c(d, rs) jit_xori_c((d), (rs), 255)+#define jit_notr_uc(d, rs) jit_xori_c((d), (rs), 255)+#define jit_notr_s(d, rs) jit_xori_s((d), (rs), 65535)+#define jit_notr_us(d, rs) jit_xori_s((d), (rs), 65535)+#ifndef jit_notr_i+#define jit_notr_i(d, rs) jit_xori_i((d), (rs), ~0)+#endif+#define jit_notr_ui(d, rs) jit_xori_i((d), (rs), ~0)+#define jit_notr_l(d, rs) jit_xori_l((d), (rs), ~0L)+#define jit_notr_ul(d, rs) jit_xori_l((d), (rs), ~0L)++#ifndef jit_extr_c_ui+#define jit_extr_c_ui(d, rs) jit_andi_ui((d), (rs), 0xFF)+#endif+#ifndef jit_extr_s_ui+#define jit_extr_s_ui(d, rs) jit_andi_ui((d), (rs), 0xFFFF)+#endif+#ifndef jit_extr_c_i+#define jit_extr_c_i(d, rs) (jit_lshi_i((d), (rs), 24), jit_rshi_i((d), (d), 24))+#endif+#ifndef jit_extr_s_i+#define jit_extr_s_i(d, rs) (jit_lshi_i((d), (rs), 16), jit_rshi_i((d), (d), 16))+#endif++#ifdef jit_addi_l /* sizeof(long) != sizeof(int) */+#ifndef jit_extr_c_l+#define jit_extr_c_l(d, rs) (jit_lshi_l((d), (rs), 56), jit_rshi_l((d), (d), 56))+#endif+#ifndef jit_extr_s_l+#define jit_extr_s_l(d, rs) (jit_lshi_l((d), (rs), 48), jit_rshi_l((d), (d), 48))+#endif+#ifndef jit_extr_i_l+#define jit_extr_i_l(d, rs) (jit_lshi_l((d), (rs), 32), jit_rshi_l((d), (d), 32))+#endif+#ifndef jit_extr_c_ul+#define jit_extr_c_ul(d, rs) jit_andi_l((d), (rs), 0xFF)+#endif+#ifndef jit_extr_s_ul+#define jit_extr_s_ul(d, rs) jit_andi_l((d), (rs), 0xFFFF)+#endif+#ifndef jit_extr_i_ul+#define jit_extr_i_ul(d, rs) jit_andi_l((d), (rs), 0xFFFFFFFFUL)+#endif+#endif++#define jit_extr_c_s(d, rs) jit_extr_c_i((d), (rs))+#define jit_extr_c_us(d, rs) jit_extr_c_ui((d), (rs))+#define jit_extr_uc_s(d, rs) jit_extr_uc_i((d), (rs))+#define jit_extr_uc_us(d, rs) jit_extr_uc_ui((d), (rs))+#define jit_extr_uc_i(d, rs) jit_extr_c_ui((d), (rs))+#define jit_extr_uc_ui(d, rs) jit_extr_c_ui((d), (rs))+#define jit_extr_us_i(d, rs) jit_extr_s_ui((d), (rs))+#define jit_extr_us_ui(d, rs) jit_extr_s_ui((d), (rs))+#define jit_extr_uc_l(d, rs) jit_extr_c_ul((d), (rs))+#define jit_extr_uc_ul(d, rs) jit_extr_c_ul((d), (rs))+#define jit_extr_us_l(d, rs) jit_extr_s_ul((d), (rs))+#define jit_extr_us_ul(d, rs) jit_extr_s_ul((d), (rs))+#define jit_extr_ui_l(d, rs) jit_extr_i_ul((d), (rs))+#define jit_extr_ui_ul(d, rs) jit_extr_i_ul((d), (rs))+++/* NTOH/HTON is not mandatory for big endian architectures */+#ifndef jit_ntoh_ui /* big endian */+#define jit_ntoh_ui(d, rs) ((d) == (rs) ? (void)0 : jit_movr_i((d), (rs)))+#define jit_ntoh_us(d, rs) ((d) == (rs) ? (void)0 : jit_movr_i((d), (rs)))+#endif /* big endian */++/* hton is a synonym for ntoh */+#define jit_hton_ui(d, rs) jit_ntoh_ui((d), (rs))+#define jit_hton_us(d, rs) jit_ntoh_us((d), (rs))++/* Stack synonyms */+#define jit_pushr_ui(rs) jit_pushr_i(rs)+#define jit_popr_ui(rs) jit_popr_i(rs) +#define jit_pushr_ul(rs) jit_pushr_l(rs)+#define jit_popr_ul(rs) jit_popr_l(rs) +#define jit_pushr_p(rs) jit_pushr_ul(rs)+#define jit_popr_p(rs) jit_popr_ul(rs) ++#define jit_prepare(nint) jit_prepare_i((nint))+#define jit_pusharg_c(rs) jit_pusharg_i(rs)+#define jit_pusharg_s(rs) jit_pusharg_i(rs)+#define jit_pusharg_uc(rs) jit_pusharg_i(rs)+#define jit_pusharg_us(rs) jit_pusharg_i(rs)+#define jit_pusharg_ui(rs) jit_pusharg_i(rs)+#define jit_pusharg_ul(rs) jit_pusharg_l(rs)+#define jit_pusharg_p(rs) jit_pusharg_ul(rs)++/* Memory synonyms */++#ifdef JIT_RZERO+#ifndef jit_ldi_c+#define jit_ldi_c(rd, is) jit_ldxi_c((rd), JIT_RZERO, (is)) +#define jit_sti_c(id, rs) jit_stxi_c((id), JIT_RZERO, (rs)) +#define jit_ldi_s(rd, is) jit_ldxi_s((rd), JIT_RZERO, (is)) +#define jit_sti_s(id, rs) jit_stxi_s((id), JIT_RZERO, (rs)) +#define jit_ldi_i(rd, is) jit_ldxi_i((rd), JIT_RZERO, (is)) +#define jit_sti_i(id, rs) jit_stxi_i((id), JIT_RZERO, (rs)) +#define jit_ldi_l(rd, is) jit_ldxi_l((rd), JIT_RZERO, (is)) +#define jit_sti_l(id, rs) jit_stxi_l((id), JIT_RZERO, (rs)) +#define jit_ldi_uc(rd, is) jit_ldxi_uc((rd), JIT_RZERO, (is)) +#define jit_ldi_us(rd, is) jit_ldxi_us((rd), JIT_RZERO, (is)) +#define jit_ldi_ui(rd, is) jit_ldxi_ui((rd), JIT_RZERO, (is)) +#define jit_ldi_ul(rd, is) jit_ldxi_ul((rd), JIT_RZERO, (is)) +#endif++#ifndef jit_ldr_c+#define jit_ldr_c(rd, rs) jit_ldxr_c((rd), JIT_RZERO, (rs)) +#define jit_str_c(rd, rs) jit_stxr_c(JIT_RZERO, (rd), (rs)) +#define jit_ldr_s(rd, rs) jit_ldxr_s((rd), JIT_RZERO, (rs)) +#define jit_str_s(rd, rs) jit_stxr_s(JIT_RZERO, (rd), (rs)) +#define jit_ldr_i(rd, rs) jit_ldxr_i((rd), JIT_RZERO, (rs)) +#define jit_str_i(rd, rs) jit_stxr_i(JIT_RZERO, (rd), (rs)) +#define jit_ldr_l(rd, rs) jit_ldxr_l((rd), JIT_RZERO, (rs)) +#define jit_str_l(rd, rs) jit_stxr_l(JIT_RZERO, (rd), (rs)) +#define jit_ldr_uc(rd, rs) jit_ldxr_uc((rd), JIT_RZERO, (rs)) +#define jit_ldr_us(rd, rs) jit_ldxr_us((rd), JIT_RZERO, (rs)) +#define jit_ldr_ui(rd, rs) jit_ldxr_ui((rd), JIT_RZERO, (rs)) +#define jit_ldr_ul(rd, rs) jit_ldxr_ul((rd), JIT_RZERO, (rs)) +#endif+#endif++#define jit_str_uc(rd, rs) jit_str_c((rd), (rs))+#define jit_sti_uc(id, rs) jit_sti_c((id), (rs))+#define jit_stxr_uc(d1, d2, rs) jit_stxr_c((d1), (d2), (rs))+#define jit_stxi_uc(id, rd, is) jit_stxi_c((id), (rd), (is))++#define jit_str_us(rd, rs) jit_str_s((rd), (rs))+#define jit_sti_us(id, rs) jit_sti_s((id), (rs))+#define jit_stxr_us(d1, d2, rs) jit_stxr_s((d1), (d2), (rs))+#define jit_stxi_us(id, rd, is) jit_stxi_s((id), (rd), (is))++#define jit_str_ui(rd, rs) jit_str_i((rd), (rs))+#define jit_sti_ui(id, rs) jit_sti_i((id), (rs))+#define jit_stxr_ui(d1, d2, rs) jit_stxr_i((d1), (d2), (rs))+#define jit_stxi_ui(id, rd, is) jit_stxi_i((id), (rd), (is))++#define jit_str_ul(rd, rs) jit_str_l((rd), (rs))+#define jit_sti_ul(id, rs) jit_sti_l((id), (rs))+#define jit_stxr_ul(d1, d2, rs) jit_stxr_l((d1), (d2), (rs))+#define jit_stxi_ul(id, rd, is) jit_stxi_l((id), (rd), (is))++#define jit_str_p(rd, rs) jit_str_l((rd), (rs))+#define jit_sti_p(id, rs) jit_sti_l((id), (rs))+#define jit_stxr_p(d1, d2, rs) jit_stxr_l((d1), (d2), (rs))+#define jit_stxi_p(id, rd, is) jit_stxi_l((id), (rd), (is))++#define jit_ldr_p(rd, rs) jit_ldr_l((rd), (rs))+#define jit_ldi_p(rd, is) jit_ldi_l((rd), (is))+#define jit_ldxr_p(rd, s1, s2) jit_ldxr_l((rd), (s1), (s2))+#define jit_ldxi_p(rd, rs, is) jit_ldxi_l((rd), (rs), (is))+++/* Boolean & branch synonyms */+#define jit_eqr_ui(d, s1, s2) jit_eqr_i((d), (s1), (s2))+#define jit_eqi_ui(d, rs, is) jit_eqi_i((d), (rs), (is))+#define jit_ner_ui(d, s1, s2) jit_ner_i((d), (s1), (s2))+#define jit_nei_ui(d, rs, is) jit_nei_i((d), (rs), (is))++#define jit_eqr_ul(d, s1, s2) jit_eqr_l((d), (s1), (s2))+#define jit_eqi_ul(d, rs, is) jit_eqi_l((d), (rs), (is))+#define jit_ner_ul(d, s1, s2) jit_ner_l((d), (s1), (s2))+#define jit_nei_ul(d, rs, is) jit_nei_l((d), (rs), (is))++#define jit_beqr_ui(label, s1, s2) jit_beqr_i((label), (s1), (s2))+#define jit_beqi_ui(label, rs, is) jit_beqi_i((label), (rs), (is))+#define jit_bner_ui(label, s1, s2) jit_bner_i((label), (s1), (s2))+#define jit_bnei_ui(label, rs, is) jit_bnei_i((label), (rs), (is))+#define jit_bmcr_ui(label, s1, s2) jit_bmcr_i((label), (s1), (s2))+#define jit_bmci_ui(label, rs, is) jit_bmci_i((label), (rs), (is))+#define jit_bmsr_ui(label, s1, s2) jit_bmsr_i((label), (s1), (s2))+#define jit_bmsi_ui(label, rs, is) jit_bmsi_i((label), (rs), (is))++#define jit_beqr_ul(label, s1, s2) jit_beqr_l((label), (s1), (s2))+#define jit_beqi_ul(label, rs, is) jit_beqi_l((label), (rs), (is))+#define jit_bner_ul(label, s1, s2) jit_bner_l((label), (s1), (s2))+#define jit_bnei_ul(label, rs, is) jit_bnei_l((label), (rs), (is))+#define jit_bmcr_ul(label, s1, s2) jit_bmcr_l((label), (s1), (s2))+#define jit_bmci_ul(label, rs, is) jit_bmci_l((label), (rs), (is))+#define jit_bmsr_ul(label, s1, s2) jit_bmsr_l((label), (s1), (s2))+#define jit_bmsi_ul(label, rs, is) jit_bmsi_l((label), (rs), (is))++#define jit_ltr_p(d, s1, s2) jit_ltr_ul((d), (s1), (s2))+#define jit_lti_p(d, rs, is) jit_lti_ul((d), (rs), (is))+#define jit_ler_p(d, s1, s2) jit_ler_ul((d), (s1), (s2))+#define jit_lei_p(d, rs, is) jit_lei_ul((d), (rs), (is))+#define jit_gtr_p(d, s1, s2) jit_gtr_ul((d), (s1), (s2))+#define jit_gti_p(d, rs, is) jit_gti_ul((d), (rs), (is))+#define jit_ger_p(d, s1, s2) jit_ger_ul((d), (s1), (s2))+#define jit_gei_p(d, rs, is) jit_gei_ul((d), (rs), (is))+#define jit_eqr_p(d, s1, s2) jit_eqr_ul((d), (s1), (s2))+#define jit_eqi_p(d, rs, is) jit_eqi_ul((d), (rs), (is))+#define jit_ner_p(d, s1, s2) jit_ner_ul((d), (s1), (s2))+#define jit_nei_p(d, rs, is) jit_nei_ul((d), (rs), (is))++#define jit_bltr_p(label, s1, s2) jit_bltr_ul((label), (s1), (s2))+#define jit_blti_p(label, rs, is) jit_blti_ul((label), (rs), (is))+#define jit_bler_p(label, s1, s2) jit_bler_ul((label), (s1), (s2))+#define jit_blei_p(label, rs, is) jit_blei_ul((label), (rs), (is))+#define jit_bgtr_p(label, s1, s2) jit_bgtr_ul((label), (s1), (s2))+#define jit_bgti_p(label, rs, is) jit_bgti_ul((label), (rs), (is))+#define jit_bger_p(label, s1, s2) jit_bger_ul((label), (s1), (s2))+#define jit_bgei_p(label, rs, is) jit_bgei_ul((label), (rs), (is))+#define jit_beqr_p(label, s1, s2) jit_beqr_ul((label), (s1), (s2))+#define jit_beqi_p(label, rs, is) jit_beqi_ul((label), (rs), (is))+#define jit_bner_p(label, s1, s2) jit_bner_ul((label), (s1), (s2))+#define jit_bnei_p(label, rs, is) jit_bnei_ul((label), (rs), _jit_UL(is))++#define jit_retval_ui(rd) jit_retval_i((rd))+#define jit_retval_uc(rd) jit_retval_i((rd))+#define jit_retval_us(rd) jit_retval_i((rd))+#define jit_retval_ul(rd) jit_retval_l((rd))+#define jit_retval_p(rd) jit_retval_ul((rd))+#define jit_retval_c(rd) jit_retval_i((rd))+#define jit_retval_s(rd) jit_retval_i((rd))++/* This was a bug, but we keep it. */+#define jit_retval(rd) jit_retval_i ((rd))++#ifndef jit_finish+#define jit_finish(sub) jit_calli(sub)+#endif++#ifndef jit_finishr+#define jit_finishr(reg) jit_callr(reg)+#endif++#ifndef jit_prolog+#define jit_prolog(numargs)+#endif++#ifndef jit_leaf+#define jit_leaf(numargs) jit_prolog(numargs)+#endif++#ifndef jit_getarg_c+#ifndef JIT_FP+#define jit_getarg_c(reg, ofs) jit_extr_c_i ((reg), (ofs))+#define jit_getarg_i(reg, ofs) jit_movr_i ((reg), (ofs))+#define jit_getarg_l(reg, ofs) jit_movr_l ((reg), (ofs))+#define jit_getarg_p(reg, ofs) jit_movr_p ((reg), (ofs))+#define jit_getarg_s(reg, ofs) jit_extr_s_i ((reg), (ofs))+#define jit_getarg_uc(reg, ofs) jit_extr_uc_ui((reg), (ofs))+#define jit_getarg_ui(reg, ofs) jit_movr_ui ((reg), (ofs))+#define jit_getarg_ul(reg, ofs) jit_extr_uc_ul((reg), (ofs))+#define jit_getarg_us(reg, ofs) jit_extr_us_ul((reg), (ofs))+#else+#define jit_getarg_c(reg, ofs) jit_ldxi_c((reg), JIT_FP, (ofs));+#define jit_getarg_uc(reg, ofs) jit_ldxi_uc((reg), JIT_FP, (ofs));+#define jit_getarg_s(reg, ofs) jit_ldxi_s((reg), JIT_FP, (ofs));+#define jit_getarg_us(reg, ofs) jit_ldxi_us((reg), JIT_FP, (ofs));+#define jit_getarg_i(reg, ofs) jit_ldxi_i((reg), JIT_FP, (ofs));+#define jit_getarg_ui(reg, ofs) jit_ldxi_ui((reg), JIT_FP, (ofs));+#define jit_getarg_l(reg, ofs) jit_ldxi_l((reg), JIT_FP, (ofs));+#define jit_getarg_ul(reg, ofs) jit_ldxi_ul((reg), JIT_FP, (ofs));+#define jit_getarg_p(reg, ofs) jit_ldxi_p((reg), JIT_FP, (ofs));+#endif+#endif++#ifndef jit_setarg_p+#ifdef JIT_FP+#define jit_setarg_p(reg, ofs) jit_stxi_p((ofs), JIT_FP, (reg));+#endif+#endif+++/* Common definitions when sizeof(long) = sizeof(int) */+#ifndef jit_addi_l+#define JIT_LONG_IS_INT++/* ALU */+#define jit_addi_l(d, rs, is) jit_addi_i((d), (rs), (is)) +#define jit_addr_l(d, s1, s2) jit_addr_i((d), (s1), (s2))+#define jit_addci_l(d, rs, is) jit_addci_i((d), (rs), (is)) +#define jit_addcr_l(d, s1, s2) jit_addcr_i((d), (s1), (s2))+#define jit_addxi_l(d, rs, is) jit_addxi_i((d), (rs), (is)) +#define jit_addxr_l(d, s1, s2) jit_addxr_i((d), (s1), (s2))+#define jit_andi_l(d, rs, is) jit_andi_i((d), (rs), (is)) +#define jit_andr_l(d, s1, s2) jit_andr_i((d), (s1), (s2))+#define jit_divi_l(d, rs, is) jit_divi_i((d), (rs), (is)) +#define jit_divr_l(d, s1, s2) jit_divr_i((d), (s1), (s2))+#define jit_hmuli_l(d, rs, is) jit_hmuli_i((d), (rs), (is)) +#define jit_hmulr_l(d, s1, s2) jit_hmulr_i((d), (s1), (s2))+#define jit_lshi_l(d, rs, is) jit_lshi_i((d), (rs), (is)) +#define jit_lshr_l(d, s1, s2) jit_lshr_i((d), (s1), (s2))+#define jit_modi_l(d, rs, is) jit_modi_i((d), (rs), (is)) +#define jit_modr_l(d, s1, s2) jit_modr_i((d), (s1), (s2))+#define jit_muli_l(d, rs, is) jit_muli_i((d), (rs), (is)) +#define jit_mulr_l(d, s1, s2) jit_mulr_i((d), (s1), (s2))+#define jit_ori_l(d, rs, is) jit_ori_i((d), (rs), (is)) +#define jit_orr_l(d, s1, s2) jit_orr_i((d), (s1), (s2))+#define jit_rshi_l(d, rs, is) jit_rshi_i((d), (rs), (is)) +#define jit_rshr_l(d, s1, s2) jit_rshr_i((d), (s1), (s2))+#define jit_subr_l(d, s1, s2) jit_subr_i((d), (s1), (s2))+#define jit_subcr_l(d, s1, s2) jit_subcr_i((d), (s1), (s2))+#define jit_subxi_l(d, rs, is) jit_subxi_i((d), (rs), (is)) +#define jit_subxr_l(d, s1, s2) jit_subxr_i((d), (s1), (s2))+#define jit_xori_l(d, rs, is) jit_xori_i((d), (rs), (is)) +#define jit_xorr_l(d, s1, s2) jit_xorr_i((d), (s1), (s2))++#ifndef jit_rsbi_l+#define jit_rsbi_l(d, rs, is) jit_rsbi_i((d), (rs), (is)) +#endif++#define jit_divi_ul(d, rs, is) jit_divi_ui((d), (rs), (is)) +#define jit_divr_ul(d, s1, s2) jit_divr_ui((d), (s1), (s2))+#define jit_hmuli_ul(d, rs, is) jit_hmuli_ui((d), (rs), (is)) +#define jit_hmulr_ul(d, s1, s2) jit_hmulr_ui((d), (s1), (s2))+#define jit_modi_ul(d, rs, is) jit_modi_ui((d), (rs), (is)) +#define jit_modr_ul(d, s1, s2) jit_modr_ui((d), (s1), (s2))+#define jit_muli_ul(d, rs, is) jit_muli_ui((d), (rs), (is)) +#define jit_mulr_ul(d, s1, s2) jit_mulr_ui((d), (s1), (s2))+#define jit_rshi_ul(d, rs, is) jit_rshi_ui((d), (rs), (is)) +#define jit_rshr_ul(d, s1, s2) jit_rshr_ui((d), (s1), (s2))++/* Sign/Zero extension */+#define jit_extr_c_l(d, rs) jit_extr_c_i(d, rs)+#define jit_extr_c_ul(d, rs) jit_extr_c_ui(d, rs)+#define jit_extr_s_l(d, rs) jit_extr_s_i(d, rs)+#define jit_extr_s_ul(d, rs) jit_extr_s_ui(d, rs)+#define jit_extr_i_l(d, rs) jit_movr_i(d, rs)+#define jit_extr_i_ul(d, rs) jit_movr_i(d, rs)++/* Unary */+#define jit_movi_l(d, rs) jit_movi_i((d), (rs))+#define jit_movr_l(d, rs) jit_movr_i((d), (rs))++/* Stack */+#define jit_pushr_l(rs) jit_pushr_i(rs)+#define jit_popr_l(rs) jit_popr_i(rs) +#define jit_pusharg_l(rs) jit_pusharg_i(rs)++/* Memory */+#ifndef JIT_RZERO+#define jit_ldr_l(d, rs) jit_ldr_i((d), (rs))+#define jit_ldi_l(d, is) jit_ldi_i((d), (is))+#define jit_str_l(d, rs) jit_str_i((d), (rs))+#define jit_sti_l(d, is) jit_sti_i((d), (is))+#define jit_ldr_ui(d, rs) jit_ldr_i((d), (rs))+#define jit_ldi_ui(d, is) jit_ldi_i((d), (is))+#define jit_ldr_ul(d, rs) jit_ldr_ui((d), (rs))+#define jit_ldi_ul(d, is) jit_ldi_ui((d), (is))+#endif++#define jit_ldxr_l(d, s1, s2) jit_ldxr_i((d), (s1), (s2))+#define jit_ldxi_l(d, rs, is) jit_ldxi_i((d), (rs), (is))+#define jit_stxr_l(d, s1, s2) jit_stxr_i((d), (s1), (s2))+#define jit_stxi_l(d, rs, is) jit_stxi_i((d), (rs), (is))+#define jit_ldxr_ui(d, s1, s2) jit_ldxr_i((d), (s1), (s2))+#define jit_ldxi_ui(d, rs, is) jit_ldxi_i((d), (rs), (is))+#define jit_ldxr_ul(d, s1, s2) jit_ldxr_ui((d), (s1), (s2))+#define jit_ldxi_ul(d, rs, is) jit_ldxi_ui((d), (rs), (is))+++/* Boolean */+#define jit_ltr_l(d, s1, s2) jit_ltr_i((d), (s1), (s2))+#define jit_lti_l(d, rs, is) jit_lti_i((d), (rs), (is))+#define jit_ler_l(d, s1, s2) jit_ler_i((d), (s1), (s2))+#define jit_lei_l(d, rs, is) jit_lei_i((d), (rs), (is))+#define jit_gtr_l(d, s1, s2) jit_gtr_i((d), (s1), (s2))+#define jit_gti_l(d, rs, is) jit_gti_i((d), (rs), (is))+#define jit_ger_l(d, s1, s2) jit_ger_i((d), (s1), (s2))+#define jit_gei_l(d, rs, is) jit_gei_i((d), (rs), (is))+#define jit_eqr_l(d, s1, s2) jit_eqr_i((d), (s1), (s2))+#define jit_eqi_l(d, rs, is) jit_eqi_i((d), (rs), (is))+#define jit_ner_l(d, s1, s2) jit_ner_i((d), (s1), (s2))+#define jit_nei_l(d, rs, is) jit_nei_i((d), (rs), (is))+#define jit_ltr_ul(d, s1, s2) jit_ltr_ui((d), (s1), (s2))+#define jit_lti_ul(d, rs, is) jit_lti_ui((d), (rs), (is))+#define jit_ler_ul(d, s1, s2) jit_ler_ui((d), (s1), (s2))+#define jit_lei_ul(d, rs, is) jit_lei_ui((d), (rs), (is))+#define jit_gtr_ul(d, s1, s2) jit_gtr_ui((d), (s1), (s2))+#define jit_gti_ul(d, rs, is) jit_gti_ui((d), (rs), (is))+#define jit_ger_ul(d, s1, s2) jit_ger_ui((d), (s1), (s2))+#define jit_gei_ul(d, rs, is) jit_gei_ui((d), (rs), (is))++/* Branches */+#define jit_bltr_l(label, s1, s2) jit_bltr_i((label), (s1), (s2))+#define jit_blti_l(label, rs, is) jit_blti_i((label), (rs), (is))+#define jit_bler_l(label, s1, s2) jit_bler_i((label), (s1), (s2))+#define jit_blei_l(label, rs, is) jit_blei_i((label), (rs), (is))+#define jit_bgtr_l(label, s1, s2) jit_bgtr_i((label), (s1), (s2))+#define jit_bgti_l(label, rs, is) jit_bgti_i((label), (rs), (is))+#define jit_bger_l(label, s1, s2) jit_bger_i((label), (s1), (s2))+#define jit_bgei_l(label, rs, is) jit_bgei_i((label), (rs), (is))+#define jit_beqr_l(label, s1, s2) jit_beqr_i((label), (s1), (s2))+#define jit_beqi_l(label, rs, is) jit_beqi_i((label), (rs), (is))+#define jit_bner_l(label, s1, s2) jit_bner_i((label), (s1), (s2))+#define jit_bnei_l(label, rs, is) jit_bnei_i((label), (rs), (is))+#define jit_bmcr_l(label, s1, s2) jit_bmcr_i((label), (s1), (s2))+#define jit_bmci_l(label, rs, is) jit_bmci_i((label), (rs), (is))+#define jit_bmsr_l(label, s1, s2) jit_bmsr_i((label), (s1), (s2))+#define jit_bmsi_l(label, rs, is) jit_bmsi_i((label), (rs), (is))+#define jit_boaddr_l(label, s1, s2) jit_boaddr_i((label), (s1), (s2))+#define jit_boaddi_l(label, rs, is) jit_boaddi_i((label), (rs), (is))+#define jit_bosubr_l(label, s1, s2) jit_bosubr_i((label), (s1), (s2))+#define jit_bosubi_l(label, rs, is) jit_bosubi_i((label), (rs), (is))+#define jit_bltr_ul(label, s1, s2) jit_bltr_ui((label), (s1), (s2))+#define jit_blti_ul(label, rs, is) jit_blti_ui((label), (rs), (is))+#define jit_bler_ul(label, s1, s2) jit_bler_ui((label), (s1), (s2))+#define jit_blei_ul(label, rs, is) jit_blei_ui((label), (rs), (is))+#define jit_bgtr_ul(label, s1, s2) jit_bgtr_ui((label), (s1), (s2))+#define jit_bgti_ul(label, rs, is) jit_bgti_ui((label), (rs), (is))+#define jit_bger_ul(label, s1, s2) jit_bger_ui((label), (s1), (s2))+#define jit_bgei_ul(label, rs, is) jit_bgei_ui((label), (rs), (is))+#define jit_boaddr_ul(label, s1, s2) jit_boaddr_ui((label), (s1), (s2))+#define jit_boaddi_ul(label, rs, is) jit_boaddi_ui((label), (rs), (is))+#define jit_bosubr_ul(label, s1, s2) jit_bosubr_ui((label), (s1), (s2))+#define jit_bosubi_ul(label, rs, is) jit_bosubi_ui((label), (rs), (is))++#define jit_retval_l(rd) jit_retval_i((rd))++#endif++#endif /* __lightning_core_common_h_ */
@@ -0,0 +1,86 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer floating-point interface+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++#define JIT_FPR0 JIT_FPR(0)+#define JIT_FPR1 JIT_FPR(1)+#define JIT_FPR2 JIT_FPR(2)+#define JIT_FPR3 JIT_FPR(3)+#define JIT_FPR4 JIT_FPR(4)+#define JIT_FPR5 JIT_FPR(5)++#ifdef JIT_RZERO+#ifndef jit_ldi_f+#define jit_ldi_f(rd, is) jit_ldxi_f((rd), JIT_RZERO, (is))+#define jit_sti_f(id, rs) jit_stxi_f((id), JIT_RZERO, (rs))+#define jit_ldi_d(rd, is) jit_ldxi_d((rd), JIT_RZERO, (is))+#define jit_sti_d(id, rs) jit_stxi_d((id), JIT_RZERO, (rs))+#endif++#ifndef jit_ldr_f+#define jit_ldr_f(rd, rs) jit_ldxr_f((rd), JIT_RZERO, (rs))+#define jit_str_f(rd, rs) jit_stxr_f((rd), JIT_RZERO, (rs))+#define jit_ldr_d(rd, rs) jit_ldxr_d((rd), JIT_RZERO, (rs))+#define jit_str_d(rd, rs) jit_stxr_d((rd), JIT_RZERO, (rs))+#endif+#endif++#ifndef jit_addr_f+#define jit_addr_f(rd,s1,s2) jit_addr_d(rd,s1,s2)+#define jit_subr_f(rd,s1,s2) jit_subr_d(rd,s1,s2)+#define jit_mulr_f(rd,s1,s2) jit_mulr_d(rd,s1,s2)+#define jit_divr_f(rd,s1,s2) jit_divr_d(rd,s1,s2)+#define jit_movr_f(rd,rs) jit_movr_d(rd,rs)+#define jit_abs_f(rd,rs) jit_abs_d(rd,rs)+#define jit_negr_f(rd,rs) jit_negr_d(rd,rs)+#define jit_sqrt_f(rd,rs) jit_sqrt_d(rd,rs)+#define jit_extr_f_d(rs, rd)+#define jit_extr_d_f(rs, rd)+#define jit_extr_i_f(rd, rs) jit_extr_i_d(rd, rs)+#define jit_roundr_f_i(rd, rs) jit_roundr_d_i(rd, rs)+#define jit_floorr_f_i(rd, rs) jit_floorr_d_i(rd, rs)+#define jit_ceilr_f_i(rd, rs) jit_ceilr_d_i(rd, rs)+#define jit_truncr_f_i(rd, rs) jit_truncr_d_i(rd, rs)+#define jit_ltr_f(d, s1, s2) jit_ltr_d(d, s1, s2)+#define jit_ler_f(d, s1, s2) jit_ler_d(d, s1, s2)+#define jit_eqr_f(d, s1, s2) jit_eqr_d(d, s1, s2)+#define jit_ner_f(d, s1, s2) jit_ner_d(d, s1, s2)+#define jit_ger_f(d, s1, s2) jit_ger_d(d, s1, s2)+#define jit_gtr_f(d, s1, s2) jit_gtr_d(d, s1, s2)+#define jit_unltr_f(d, s1, s2) jit_unltr_d(d, s1, s2)+#define jit_unler_f(d, s1, s2) jit_unler_d(d, s1, s2)+#define jit_uneqr_f(d, s1, s2) jit_uneqr_d(d, s1, s2)+#define jit_ltgtr_f(d, s1, s2) jit_ltgtr_d(d, s1, s2)+#define jit_unger_f(d, s1, s2) jit_unger_d(d, s1, s2)+#define jit_ungtr_f(d, s1, s2) jit_ungtr_d(d, s1, s2)+#define jit_ordr_f(d, s1, s2) jit_ordr_d(d, s1, s2)+#define jit_unordr_f(d, s1, s2) jit_unordr_d(d, s1, s2)+#define jit_retval_f(rs) jit_retval_d(rs)+#endif
@@ -0,0 +1,54 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer inline functions (common part)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++#ifndef __lightning_funcs_common_h+#define __lightning_funcs_common_h++#include <stdio.h>+#include <stdlib.h>++static int jit_fail(const char *, const char*, int, const char *) JIT_UNUSED;++int+jit_fail(const char *msg, const char *file, int line, const char *function)+{+ fprintf(stderr, "%s: In function `%s':\n", file, function);+ fprintf(stderr, "%s:%d: %s\n", file, line, msg);+ abort();+}+++#ifndef jit_start_pfx+#define jit_start_pfx() ( (jit_insn*)0x4)+#define jit_end_pfx() ( (jit_insn*)0x0)+#endif++#endif /* __lightning_funcs_common_h */
@@ -0,0 +1,125 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler for the i386+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2003 Gwenole Beauchesne+ * Copyright 2006 Free Software Foundation, Inc.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ *+ * GNU lightning is distributed in the hope that it will be useful, but+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ *+ * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/+++++#ifndef __lightning_asm_h+#define __lightning_asm_h++#ifndef LIGHTNING_DEBUG++/* OPCODE + i = immediate operand+ * + r = register operand+ * + m = memory operand (disp,base,index,scale)+ * + sr/sm = a star preceding a register or memory+ */++#if !_ASM_SAFETY+# define _r1(R) _rN(R)+# define _r2(R) _rN(R)+# define _r4(R) _rN(R)+# define _r8(R) _rN(R)+# define _rM(R) _rN(R)+# define _rX(R) _rN(R)+#else+/* _r1() used to check only for _AL and _AH but there is+ * usage of _CL and _DL when _*AX is already an operand */+# define _r1(R) \+ /* Valid 32 bit register? */ \+ ((!((R) & ~0x77) \+ /* 32, 16 or 8 bit register? */ \+ && (((_rC(R) == 0x40 || _rC(R) == 0x30 || _rC(R) == 0x10) \+ /* Yes. Register is _AL, _CL or _DL? */ \+ && ( (_rN(R) | 0x10) == _AL \+ || (_rN(R) | 0x10) == _CL \+ || (_rN(R) | 0x10) == _DL)) \+ /* No. Register is _AH? */ \+ || ((_rC(R) == 0x20 && (_rN(R) | 0x20) == _AH)))) \+ ? _rN(R) : JITFAIL("bad 8-bit register " #R))+# define _r2(R) \+ /* Valid 32 bit register? */ \+ ((!((R) & ~0x77) \+ /* 32, 16 or 8 bit register? */ \+ && (_rC(R) == 0x40 || _rC(R) == 0x30 || _rC(R) == 0x10)) \+ ? _rN(R) : JITFAIL("bad 16-bit register " #R))+# define _r4(R) \+ /* Valid 32 bit register? */ \+ ((!((R) & ~0x77) \+ /* 32, 16 or 8 bit register? */ \+ && (_rC(R) == 0x40 || _rC(R) == 0x30 || _rC(R) == 0x10)) \+ ? _rN(R) : JITFAIL("bad 32-bit register " #R))+# define _r8(R) \+ JITFAIL("bad 64-bit register " #R)+# define _rM(R) \+ /* Valid MMX register? */ \+ ((!((R) & ~0x67) && _rC(R) == 0x60) \+ ? _rN(R) : JITFAIL("bad MMX register " #R))+# define _rX(R) \+ /* Valid SSE register? */ \+ ((!((R) & ~0x77) && _rC(R) == 0x70) \+ ? _rN(R) : JITFAIL("bad SSE register " #R))+#endif++#define _rA(R) _r4(R)++#define jit_check8(rs) ((_rN(rs) | _AL) == _AL)+#define jit_reg8(rs) \+ ((jit_reg16(rs) == _SI || jit_reg16(rs) == _DI) \+ ? _AL : (_rN(rs) | _AL))+#define jit_reg16(rs) (_rN(rs) | _AX)++/* Use RIP-addressing in 64-bit mode, if possible */+#define _r_X( R, D,B,I,S,O) (_r0P(I) ? (_r0P(B) ? _r_D (R,D ) : \+ (_rsp12P(B) ? _r_DBIS(R,D,_ESP,_ESP,1) : \+ _r_DB (R,D, B ))) : \+ (_r0P(B) ? _r_4IS (R,D, I,S) : \+ (!_rspP(I) ? _r_DBIS(R,D, B, I,S) : \+ JITFAIL("illegal index register: %esp"))))+#define _m32only(X) (X)+#define _m64only(X) JITFAIL("invalid instruction in 32-bit mode")+#define _m64(X) ((void)0)++#define _AH 0x24+#define _CH 0x25+#define _DH 0x26+#define _BH 0x27++#define CALLsr(R) CALLLsr(R)+#define JMPsr(R) JMPLsr(R)++#define DECWr(RD) (_d16(), _Or (0x48,_r2(RD) ))+#define DECLr(RD) _Or (0x48,_r4(RD) )+#define INCWr(RD) (_d16(), _Or (0x40,_r2(RD) ))+#define INCLr(RD) _Or (0x40,_r4(RD) )++#endif+#endif /* __lightning_asm_h */
@@ -0,0 +1,430 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler for the x86-64+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2003 Gwenole Beauchesne+ * Copyright 2006 Free Software Foundation, Inc.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ *+ * GNU lightning is distributed in the hope that it will be useful, but+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ *+ * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/+++++#ifndef __lightning_asm_h+#define __lightning_asm_h++#ifndef LIGHTNING_DEBUG++/* OPCODE + i = immediate operand+ * + r = register operand+ * + m = memory operand (disp,base,index,scale)+ * + sr/sm = a star preceding a register or memory+ */++#if !_ASM_SAFETY+# define _r1(R) _rN(R)+# define _r2(R) _rN(R)+# define _r4(R) _rN(R)+# define _r8(R) _rN(R)+# define _rM(R) _rN(R)+# define _rX(R) _rN(R)+#else+# define _r1(R) \+ /* Valid 64 bit register? */ \+ ((!((R) & ~0xff) \+ /* 64, 32, 16 or 8 bit register? */ \+ && (_rC(R) == 0x50 || _rC(R) == 0x40 \+ || _rC(R) == 0x30 || _rC(R) == 0x10)) \+ ? _rN(R) : JITFAIL("bad 8-bit register " #R))+# define _r2(R) \+ /* Valid 64 bit register? */ \+ ((!((R) & ~0xff) \+ /* 64, 32, 16 or 8 bit register? */ \+ && (_rC(R) == 0x50 || _rC(R) == 0x40 \+ || _rC(R) == 0x30 || _rC(R) == 0x10)) \+ ? _rN(R) : JITFAIL("bad 16-bit register " #R))+# define _r4(R) \+ /* Valid 64 bit register? */ \+ ((!((R) & ~0xff) \+ /* 64, 32, 16 or 8 bit register? */ \+ && (_rC(R) == 0x50 || _rC(R) == 0x40 \+ || _rC(R) == 0x30 || _rC(R) == 0x10)) \+ ? _rN(R) : JITFAIL("bad 32-bit register " #R))+# define _r8(R) \+ /* Valid 64 bit register? */ \+ ((!((R) & ~0xff) \+ /* 64, 32, 16 or 8 bit register? */ \+ && (_rC(R) == 0x50 || _rC(R) == 0x40 \+ || _rC(R) == 0x30 || _rC(R) == 0x10)) \+ ? _rN(R) : JITFAIL("bad 64-bit register " #R))+# define _rM(R) \+ /* Valid MMX* register? */ \+ ((!((R) & ~0x6f) && _rC(R) == 0x60) \+ ? _rN(R) : JITFAIL("bad MMX register " #R))+# define _rX(R) \+ /* Valid SSE2 register? */ \+ ((!((R) & ~0x7f) && _rC(R) == 0x70) \+ ? _rN(R) : JITFAIL("bad SSE2 register " #R))+#endif++#define _rA(R) _r8(R)++#define jit_check8(rs) 1+#define jit_reg8(rs) (_rR(rs) | _AL)+#define jit_reg16(rs) (_rR(rs) | _AX)++/* Use RIP-addressing in 64-bit mode, if possible */+#if 0+#define _x86_RIP_addressing_possible(D,O) (X86_RIP_RELATIVE_ADDR && \+ ((unsigned long)x86_get_target() + 4 + (O) - (D) <= 0xffffffff))++#define _r_X( R, D,B,I,S,O) (_r0P(I) ? (_r0P(B) ? (!X86_TARGET_64BIT ? _r_D(R,D) : \+ (_x86_RIP_addressing_possible(D, O) ? \+ _r_D(R, (D) - ((unsigned long)x86_get_target() + 4 + (O))) : \+ _r_DSIB(R,D))) : \+ _r_DSIB(R,D )) : \+ (_rIP(B) ? _r_D (R,D ) : \+ (_rsp12P(B) ? _r_DBIS(R,D,_RSP,_RSP,1) : \+ _r_DB (R,D, B )))) : \+ (_r0P(B) ? _r_4IS (R,D, I,S) : \+ (!_rspP(I) ? _r_DBIS(R,D, B, I,S) : \+ JITFAIL("illegal index register: %esp"))))+#else+#define _r_X( R, D,B,I,S,O) (_r0P(I) ? (_r0P(B) ? _r_DSIB(R,D ) : \+ (_rIP(B) ? _r_D (R,D ) : \+ (_rsp12P(B) ? _r_DBIS(R,D,_RSP,_RSP,1) : \+ _r_DB (R,D, B )))) : \+ (_r0P(B) ? _r_4IS (R,D, I,S) : \+ (!_rspP(I) ? _r_DBIS(R,D, B, I,S) : \+ JITFAIL("illegal index register: %esp"))))+#endif+++#define _m32only(X) (JITFAIL("invalid instruction in 64-bit mode"))+#define _m64only(X) (X)+#define _m64(X) (X)++#define _SPL 0x14+#define _BPL 0x15+#define _SIL 0x16+#define _DIL 0x17+#define _R8B 0x18+#define _R9B 0x19+#define _R10B 0x1A+#define _R11B 0x1B+#define _R12B 0x1C+#define _R13B 0x1D+#define _R14B 0x1E+#define _R15B 0x1F++#define _R8W 0x38+#define _R9W 0x39+#define _R10W 0x3A+#define _R11W 0x3B+#define _R12W 0x3C+#define _R13W 0x3D+#define _R14W 0x3E+#define _R15W 0x3F+#define _R8D 0x48+#define _R9D 0x49+#define _R10D 0x4A+#define _R11D 0x4B+#define _R12D 0x4C+#define _R13D 0x4D+#define _R14D 0x4E+#define _R15D 0x4F++#define _RAX 0x50+#define _RCX 0x51+#define _RDX 0x52+#define _RBX 0x53+#define _RSP 0x54+#define _RBP 0x55+#define _RSI 0x56+#define _RDI 0x57+#define _R8 0x58+#define _R9 0x59+#define _R10 0x5A+#define _R11 0x5B+#define _R12 0x5C+#define _R13 0x5D+#define _R14 0x5E+#define _R15 0x5F+#define _RIP -2++#define _r1e8lP(R) ((int)(R) >= _SPL && (int)(R) <= _DIL)++#define DECWr(RD) (_d16(), _REXLrr(0, RD), _O_Mrm (0xff ,_b11,_b001 ,_r2(RD) ))+#define DECLr(RD) (_REXLrr(0, RD), _O_Mrm (0xff ,_b11,_b001 ,_r4(RD) ))+#define INCWr(RD) (_d16(), _REXLrr(0, RD), _O_Mrm (0xff ,_b11,_b000 ,_r2(RD) ))+#define INCLr(RD) (_REXLrr(0, RD), _O_Mrm (0xff ,_b11,_b000 ,_r4(RD) ))++#define ADCQrr(RS, RD) _ALUQrr(X86_ADC, RS, RD)+#define ADCQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_ADC, MD, MB, MI, MS, RD)+#define ADCQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_ADC, RS, MD, MB, MI, MS)+#define ADCQir(IM, RD) _ALUQir(X86_ADC, IM, RD)+#define ADCQim(IM, MD, MB, MI, MS) _ALUQim(X86_ADC, IM, MD, MB, MI, MS)++#define ADDQrr(RS, RD) _ALUQrr(X86_ADD, RS, RD)+#define ADDQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_ADD, MD, MB, MI, MS, RD)+#define ADDQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_ADD, RS, MD, MB, MI, MS)+#define ADDQir(IM, RD) _ALUQir(X86_ADD, IM, RD)+#define ADDQim(IM, MD, MB, MI, MS) _ALUQim(X86_ADD, IM, MD, MB, MI, MS)++#define ANDQrr(RS, RD) _ALUQrr(X86_AND, RS, RD)+#define ANDQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_AND, MD, MB, MI, MS, RD)+#define ANDQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_AND, RS, MD, MB, MI, MS)+#define ANDQir(IM, RD) _ALUQir(X86_AND, IM, RD)+#define ANDQim(IM, MD, MB, MI, MS) _ALUQim(X86_AND, IM, MD, MB, MI, MS)++#define CMPQrr(RS, RD) _ALUQrr(X86_CMP, RS, RD)+#define CMPQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_CMP, MD, MB, MI, MS, RD)+#define CMPQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_CMP, RS, MD, MB, MI, MS)+#define CMPQir(IM, RD) _ALUQir(X86_CMP, IM, RD)+#define CMPQim(IM, MD, MB, MI, MS) _ALUQim(X86_CMP, IM, MD, MB, MI, MS)++#define ORQrr(RS, RD) _ALUQrr(X86_OR, RS, RD)+#define ORQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_OR, MD, MB, MI, MS, RD)+#define ORQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_OR, RS, MD, MB, MI, MS)+#define ORQir(IM, RD) _ALUQir(X86_OR, IM, RD)+#define ORQim(IM, MD, MB, MI, MS) _ALUQim(X86_OR, IM, MD, MB, MI, MS)++#define SBBQrr(RS, RD) _ALUQrr(X86_SBB, RS, RD)+#define SBBQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_SBB, MD, MB, MI, MS, RD)+#define SBBQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_SBB, RS, MD, MB, MI, MS)+#define SBBQir(IM, RD) _ALUQir(X86_SBB, IM, RD)+#define SBBQim(IM, MD, MB, MI, MS) _ALUQim(X86_SBB, IM, MD, MB, MI, MS)++#define SUBQrr(RS, RD) _ALUQrr(X86_SUB, RS, RD)+#define SUBQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_SUB, MD, MB, MI, MS, RD)+#define SUBQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_SUB, RS, MD, MB, MI, MS)+#define SUBQir(IM, RD) _ALUQir(X86_SUB, IM, RD)+#define SUBQim(IM, MD, MB, MI, MS) _ALUQim(X86_SUB, IM, MD, MB, MI, MS)++#define XORQrr(RS, RD) _ALUQrr(X86_XOR, RS, RD)+#define XORQmr(MD, MB, MI, MS, RD) _ALUQmr(X86_XOR, MD, MB, MI, MS, RD)+#define XORQrm(RS, MD, MB, MI, MS) _ALUQrm(X86_XOR, RS, MD, MB, MI, MS)+#define XORQir(IM, RD) _ALUQir(X86_XOR, IM, RD)+#define XORQim(IM, MD, MB, MI, MS) _ALUQim(X86_XOR, IM, MD, MB, MI, MS)++#define ROLQir(IM, RD) _ROTSHIQir(X86_ROL, IM, RD)+#define ROLQim(IM, MD, MB, MI, MS) _ROTSHIQim(X86_ROL, IM, MD, MB, MI, MS)+#define ROLQrr(RS, RD) _ROTSHIQrr(X86_ROL, RS, RD)+#define ROLQrm(RS, MD, MB, MI, MS) _ROTSHIQrm(X86_ROL, RS, MD, MB, MI, MS)++#define RORQir(IM, RD) _ROTSHIQir(X86_ROR, IM, RD)+#define RORQim(IM, MD, MB, MI, MS) _ROTSHIQim(X86_ROR, IM, MD, MB, MI, MS)+#define RORQrr(RS, RD) _ROTSHIQrr(X86_ROR, RS, RD)+#define RORQrm(RS, MD, MB, MI, MS) _ROTSHIQrm(X86_ROR, RS, MD, MB, MI, MS)++#define RCLQir(IM, RD) _ROTSHIQir(X86_RCL, IM, RD)+#define RCLQim(IM, MD, MB, MI, MS) _ROTSHIQim(X86_RCL, IM, MD, MB, MI, MS)+#define RCLQrr(RS, RD) _ROTSHIQrr(X86_RCL, RS, RD)+#define RCLQrm(RS, MD, MB, MI, MS) _ROTSHIQrm(X86_RCL, RS, MD, MB, MI, MS)++#define RCRQir(IM, RD) _ROTSHIQir(X86_RCR, IM, RD)+#define RCRQim(IM, MD, MB, MI, MS) _ROTSHIQim(X86_RCR, IM, MD, MB, MI, MS)+#define RCRQrr(RS, RD) _ROTSHIQrr(X86_RCR, RS, RD)+#define RCRQrm(RS, MD, MB, MI, MS) _ROTSHIQrm(X86_RCR, RS, MD, MB, MI, MS)++#define SHLQir(IM, RD) _ROTSHIQir(X86_SHL, IM, RD)+#define SHLQim(IM, MD, MB, MI, MS) _ROTSHIQim(X86_SHL, IM, MD, MB, MI, MS)+#define SHLQrr(RS, RD) _ROTSHIQrr(X86_SHL, RS, RD)+#define SHLQrm(RS, MD, MB, MI, MS) _ROTSHIQrm(X86_SHL, RS, MD, MB, MI, MS)++#define SHRQir(IM, RD) _ROTSHIQir(X86_SHR, IM, RD)+#define SHRQim(IM, MD, MB, MI, MS) _ROTSHIQim(X86_SHR, IM, MD, MB, MI, MS)+#define SHRQrr(RS, RD) _ROTSHIQrr(X86_SHR, RS, RD)+#define SHRQrm(RS, MD, MB, MI, MS) _ROTSHIQrm(X86_SHR, RS, MD, MB, MI, MS)++#define SALQir SHLQir+#define SALQim SHLQim+#define SALQrr SHLQrr+#define SALQrm SHLQrm++#define SARQir(IM, RD) _ROTSHIQir(X86_SAR, IM, RD)+#define SARQim(IM, MD, MB, MI, MS) _ROTSHIQim(X86_SAR, IM, MD, MB, MI, MS)+#define SARQrr(RS, RD) _ROTSHIQrr(X86_SAR, RS, RD)+#define SARQrm(RS, MD, MB, MI, MS) _ROTSHIQrm(X86_SAR, RS, MD, MB, MI, MS)++#define BTQir(IM, RD) _BTQir(X86_BT, IM, RD)+#define BTQim(IM, MD, MB, MI, MS) _BTQim(X86_BT, IM, MD, MB, MI, MS)+#define BTQrr(RS, RD) _BTQrr(X86_BT, RS, RD)+#define BTQrm(RS, MD, MB, MI, MS) _BTQrm(X86_BT, RS, MD, MB, MI, MS)++#define BTCQir(IM, RD) _BTQir(X86_BTC, IM, RD)+#define BTCQim(IM, MD, MB, MI, MS) _BTQim(X86_BTC, IM, MD, MB, MI, MS)+#define BTCQrr(RS, RD) _BTQrr(X86_BTC, RS, RD)+#define BTCQrm(RS, MD, MB, MI, MS) _BTQrm(X86_BTC, RS, MD, MB, MI, MS)++#define BTRQir(IM, RD) _BTQir(X86_BTR, IM, RD)+#define BTRQim(IM, MD, MB, MI, MS) _BTQim(X86_BTR, IM, MD, MB, MI, MS)+#define BTRQrr(RS, RD) _BTQrr(X86_BTR, RS, RD)+#define BTRQrm(RS, MD, MB, MI, MS) _BTQrm(X86_BTR, RS, MD, MB, MI, MS)++#define BTSQir(IM, RD) _BTQir(X86_BTS, IM, RD)+#define BTSQim(IM, MD, MB, MI, MS) _BTQim(X86_BTS, IM, MD, MB, MI, MS)+#define BTSQrr(RS, RD) _BTQrr(X86_BTS, RS, RD)+#define BTSQrm(RS, MD, MB, MI, MS) _BTQrm(X86_BTS, RS, MD, MB, MI, MS)++#define LEAQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _O_r_X (0x8d ,_r8(RD) ,MD,MB,MI,MS ))++#define MOVQrr(RS, RD) (_REXQrr(RS, RD), _O_Mrm (0x89 ,_b11,_r8(RS),_r8(RD) ))+#define MOVQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _O_r_X (0x8b ,_r8(RD) ,MD,MB,MI,MS ))+#define MOVQrm(RS, MD, MB, MI, MS) (_REXQrm(RS, MB, MI), _O_r_X (0x89 ,_r8(RS) ,MD,MB,MI,MS ))+#define MOVQir(IM, R) (_REXQrr(0, R), _Or_Q (0xb8,_r8(R) ,IM ))+#define MOVQim(IM, MD, MB, MI, MS) (_REXQrm(0, MB, MI), _O_X_L (0xc7 ,MD,MB,MI,MS ,IM ))++#define NOTQr(RS) _UNARYQr(X86_NOT, RS)+#define NOTQm(MD, MB, MI, MS) _UNARYQm(X86_NOT, MD, MB, MI, MS)++#define NEGQr(RS) _UNARYQr(X86_NEG, RS)+#define NEGQm(MD, MB, MI, MS) _UNARYQm(X86_NEG, MD, MB, MI, MS)++#define MULQr(RS) _UNARYQr(X86_MUL, RS)+#define MULQm(MD, MB, MI, MS) _UNARYQm(X86_MUL, MD, MB, MI, MS)++#define IMULQr(RS) _UNARYQr(X86_IMUL, RS)+#define IMULQm(MD, MB, MI, MS) _UNARYQm(X86_IMUL, MD, MB, MI, MS)++#define DIVQr(RS) _UNARYQr(X86_DIV, RS)+#define DIVQm(MD, MB, MI, MS) _UNARYQm(X86_DIV, MD, MB, MI, MS)++#define IDIVQr(RS) _UNARYQr(X86_IDIV, RS)+#define IDIVQm(MD, MB, MI, MS) _UNARYQm(X86_IDIV, MD, MB, MI, MS)++#define IMULQir(IM, RD) IMULQirr(IM, RD, RD)+#define IMULQrr(RS, RD) (_REXQrr(RD, RS), _OO_Mrm (0x0faf ,_b11,_r8(RD),_r8(RS) ))+#define IMULQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0faf ,_r8(RD) ,MD,MB,MI,MS ))+#define IMULQirr(IM,RS,RD) (_REXQrr(RD, RS), _Os_Mrm_sL (0x69 ,_b11,_r8(RS),_r8(RD) ,IM ))+#define IMULQimr(IM,MD,MB,MI,MS,RD) (_REXQmr(MB, MI, RD), _Os_r_X_sL (0x69 ,_r8(RD) ,MD,MB,MI,MS ,IM ))++#define CALLQsr(R) (_REXQrr(0, R), _O_Mrm (0xff ,_b11,_b010,_r8(R) ))+#define JMPQsr(R) (_REXQrr(0, R), _O_Mrm (0xff ,_b11,_b100,_r8(R) ))++#define CMOVQrr(CC,RS,RD) (_REXQrr(RD, RS), _OO_Mrm (0x0f40|(CC) ,_b11,_r8(RD),_r8(RS) ))+#define CMOVQmr(CC,MD,MB,MI,MS,RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0f40|(CC) ,_r8(RD) ,MD,MB,MI,MS ))++#define POPQr(RD) _m64only((_REXQr(RD), _Or (0x58,_r8(RD) )))+#define POPQm(MD, MB, MI, MS) _m64only((_REXQm(MB, MI), _O_r_X (0x8f ,_b000 ,MD,MB,MI,MS )))++#define PUSHQr(RS) _m64only((_REXQr(RS), _Or (0x50,_r8(RS) )))+#define PUSHQm(MD, MB, MI, MS) _m64only((_REXQm(MB, MI), _O_r_X (0xff ,_b110 ,MD,MB,MI,MS )))+#define PUSHQi(IM) _m64only( _Os_sL (0x68 ,IM ))++#define TESTQrr(RS, RD) (_REXQrr(RS, RD), _O_Mrm (0x85 ,_b11,_r8(RS),_r8(RD) ))+#define TESTQrm(RS, MD, MB, MI, MS) (_REXQrm(RS, MB, MI), _O_r_X (0x85 ,_r8(RS) ,MD,MB,MI,MS ))+#define TESTQir(IM, RD) \+ /* Immediate fits in 32 bits? */ \+ (_s32P((long)(IM)) \+ /* Yes. Immediate does not fit in 8 bits and reg is %rax? */ \+ ? (!_s8P(IM) && (RD) == _RAX \+ ? (_REXQrr(0, RD), _O_L(0xa9, IM)) \+ : (_REXQrr(0, RD), _O_Mrm_L(0xf7, _b11, _b000, _r8(RD), IM))) \+ /* No. Need immediate in a register */ \+ : (MOVQir(IM, JIT_REXTMP), TESTQrr(JIT_REXTMP, RD)))+#define TESTQim(IM, MD, MB, MI, MS) (_REXQrm(0, MB, MI), _O_r_X_L (0xf7 ,_b000 ,MD,MB,MI,MS ,IM ))++#define CMPXCHGQrr(RS, RD) (_REXQrr(RS, RD), _OO_Mrm (0x0fb1 ,_b11,_r8(RS),_r8(RD) ))+#define CMPXCHGQrm(RS, MD, MB, MI, MS) (_REXQrm(RS, MB, MI), _OO_r_X (0x0fb1 ,_r8(RS) ,MD,MB,MI,MS ))++#define XADDQrr(RS, RD) (_REXQrr(RS, RD), _OO_Mrm (0x0fc1 ,_b11,_r8(RS),_r8(RD) ))+#define XADDQrm(RS, MD, MB, MI, MS) (_REXQrm(RS, MB, MI), _OO_r_X (0x0fc1 ,_r8(RS) ,MD,MB,MI,MS ))++#define XCHGQrr(RS, RD) (_REXQrr(RS, RD), _O_Mrm (0x87 ,_b11,_r8(RS),_r8(RD) ))+#define XCHGQrm(RS, MD, MB, MI, MS) (_REXQrm(RS, MB, MI), _O_r_X (0x87 ,_r8(RS) ,MD,MB,MI,MS ))++#define DECQm(MD, MB, MI, MS) (_REXQrm(0, MB, MI), _O_r_X (0xff ,_b001 ,MD,MB,MI,MS ))+#define DECQr(RD) (_REXQrr(0, RD), _O_Mrm (0xff ,_b11,_b001 ,_r8(RD) ))+#define INCQm(MD, MB, MI, MS) (_REXQrm(0, MB, MI), _O_r_X (0xff ,_b000 ,MD,MB,MI,MS ))+#define INCQr(RD) (_REXQrr(0, RD), _O_Mrm (0xff ,_b11,_b000 ,_r8(RD) ))++#define BSFQrr(RS, RD) (_REXQrr(RD, RS), _OO_Mrm (0x0fbc ,_b11,_r8(RD),_r8(RS) ))+#define BSFQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0fbc ,_r8(RD) ,MD,MB,MI,MS ))++#define BSRQrr(RS, RD) (_REXQrr(RD, RS), _OO_Mrm (0x0fbd ,_b11,_r8(RD),_r8(RS) ))+#define BSRQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0fbd ,_r8(RD) ,MD,MB,MI,MS ))++#define MOVSBQrr(RS, RD) (_REXQrr(RD, RS), _OO_Mrm (0x0fbe ,_b11,_r8(RD),_r1(RS) ))+#define MOVSBQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0fbe ,_r8(RD) ,MD,MB,MI,MS ))++#define MOVZBQrr(RS, RD) (_REXQrr(RD, RS), _OO_Mrm (0x0fb6 ,_b11,_r8(RD),_r1(RS) ))+#define MOVZBQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0fb6 ,_r8(RD) ,MD,MB,MI,MS ))++#define MOVSWQrr(RS, RD) (_REXQrr(RD, RS), _OO_Mrm (0x0fbf ,_b11,_r8(RD),_r2(RS) ))+#define MOVSWQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0fbf ,_r8(RD) ,MD,MB,MI,MS ))++#define MOVZWQrr(RS, RD) (_REXQrr(RD, RS), _OO_Mrm (0x0fb7 ,_b11,_r8(RD),_r2(RS) ))+#define MOVZWQmr(MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _OO_r_X (0x0fb7 ,_r8(RD) ,MD,MB,MI,MS ))++#define MOVSLQrr(RS, RD) _m64only((_REXQrr(RD, RS), _O_Mrm (0x63 ,_b11,_r8(RD),_r4(RS) )))+#define MOVSLQmr(MD, MB, MI, MS, RD) _m64only((_REXQmr(MB, MI, RD), _O_r_X (0x63 ,_r8(RD) ,MD,MB,MI,MS )))++#define BSWAPQr(R) (_REXQrr(0, R), _OOr (0x0fc8,_r8(R) ))++++#define __SSEQrr(OP,RS,RSA,RD,RDA) (_REXQrr(RD, RS), _OO_Mrm (0x0f00|(OP) ,_b11,RDA(RD),RSA(RS) ))+#define __SSEQmr(OP,MD,MB,MI,MS,RD,RDA) (_REXQmr(MB, MI, RD), _OO_r_X (0x0f00|(OP) ,RDA(RD) ,MD,MB,MI,MS ))+#define __SSEQrm(OP,RS,RSA,MD,MB,MI,MS) (_REXQrm(RS, MB, MI), _OO_r_X (0x0f00|(OP) ,RSA(RS) ,MD,MB,MI,MS ))+#define __SSEQ1rm(OP,RS,RSA,MD,MB,MI,MS) (_REXQrm(RS, MB, MI), _OO_r_X (0x0f01|(OP) ,RSA(RS) ,MD,MB,MI,MS ))++#define _SSEQrr(PX,OP,RS,RSA,RD,RDA) (_jit_B(PX), __SSEQrr(OP, RS, RSA, RD, RDA))+#define _SSEQmr(PX,OP,MD,MB,MI,MS,RD,RDA) (_jit_B(PX), __SSEQmr(OP, MD, MB, MI, MS, RD, RDA))+#define _SSEQrm(PX,OP,RS,RSA,MD,MB,MI,MS) (_jit_B(PX), __SSEQrm(OP, RS, RSA, MD, MB, MI, MS))+#define _SSEQ1rm(PX,OP,RS,RSA,MD,MB,MI,MS) (_jit_B(PX), __SSEQ1rm(OP, RS, RSA, MD, MB, MI, MS))++#define CVTTSS2SIQrr(RS, RD) _SSEQrr(0xf3, X86_SSE_CVTTSI, RS,_rX, RD,_r8)+#define CVTTSS2SIQmr(MD, MB, MI, MS, RD) _SSEQmr(0xf3, X86_SSE_CVTTSI, MD, MB, MI, MS, RD,_r8)+#define CVTTSD2SIQrr(RS, RD) _SSEQrr(0xf2, X86_SSE_CVTTSI, RS,_rX, RD,_r8)+#define CVTTSD2SIQmr(MD, MB, MI, MS, RD) _SSEQmr(0xf2, X86_SSE_CVTTSI, MD, MB, MI, MS, RD,_r8)++#define CVTSS2SIQrr(RS, RD) _SSEQrr(0xf3, X86_SSE_CVTSI, RS,_rX, RD,_r8)+#define CVTSS2SIQmr(MD, MB, MI, MS, RD) _SSEQmr(0xf3, X86_SSE_CVTSI, MD, MB, MI, MS, RD,_r8)+#define CVTSD2SIQrr(RS, RD) _SSEQrr(0xf2, X86_SSE_CVTSI, RS,_rX, RD,_r8)+#define CVTSD2SIQmr(MD, MB, MI, MS, RD) _SSEQmr(0xf2, X86_SSE_CVTSI, MD, MB, MI, MS, RD,_r8)++#define CVTSI2SSQrr(RS, RD) _SSEQrr(0xf3, X86_SSE_CVTIS, RS,_r8, RD,_rX)+#define CVTSI2SSQmr(MD, MB, MI, MS, RD) _SSEQmr(0xf3, X86_SSE_CVTIS, MD, MB, MI, MS, RD,_rX)+#define CVTSI2SDQrr(RS, RD) _SSEQrr(0xf2, X86_SSE_CVTIS, RS,_r8, RD,_rX)+#define CVTSI2SDQmr(MD, MB, MI, MS, RD) _SSEQmr(0xf2, X86_SSE_CVTIS, MD, MB, MI, MS, RD,_rX)++#define MOVDQXrr(RS, RD) _SSEQrr(0x66, 0x6e, RS,_r8, RD,_rX)+#define MOVDQXmr(MD, MB, MI, MS, RD) _SSEQmr(0x66, 0x6e, MD, MB, MI, MS, RD,_rX)++#define MOVDXQrr(RS, RD) _SSEQrr(0x66, 0x7e, RS,_rX, RD,_r8)+#define MOVDXQrm(RS, MD, MB, MI, MS) _SSEQrm(0x66, 0x7e, RS,_rX, MD, MB, MI, MS)+#define MOVDQMrr(RS, RD) __SSEQrr( 0x6e, RS,_r8, RD,_rM)+#define MOVDQMmr(MD, MB, MI, MS, RD) __SSEQmr( 0x6e, MD, MB, MI, MS, RD,_rM)+#define MOVDMQrr(RS, RD) __SSEQrr( 0x7e, RS,_rM, RD,_r8)+#define MOVDMQrm(RS, MD, MB, MI, MS) __SSEQrm( 0x7e, RS,_rM, MD, MB, MI, MS)++++#define CALLsr(R) CALLQsr(R)+#define JMPsr(R) JMPQsr(R)++#endif+#endif /* __lightning_asm_h */
@@ -0,0 +1,1606 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler for the i386+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 1999, 2000, 2001, 2002 Ian Piumarta+ * Copyright 2003 Gwenole Beauchesne+ * Copyright 2006 Free Software Foundation+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ ***********************************************************************/+++++#ifndef __lightning_asm_i386_h+#define __lightning_asm_i386_h++/* OPCODE + i = immediate operand+ * + r = register operand+ * + m = memory operand (disp,base,index,scale)+ * + sr/sm = a star preceding a register or memory+ */++typedef _uc jit_insn;++#ifndef LIGHTNING_DEBUG+#define _b00 0+#define _b01 1+#define _b10 2+#define _b11 3++#define _b000 0+#define _b001 1+#define _b010 2+#define _b011 3+#define _b100 4+#define _b101 5+#define _b110 6+#define _b111 7++/*** REGISTERS ***/ /* [size,,number] */++#define _NOREG 0++#define _AL 0x10+#define _CL 0x11+#define _DL 0x12+#define _BL 0x13++#define _AX 0x30+#define _CX 0x31+#define _DX 0x32+#define _BX 0x33+#define _SP 0x34+#define _BP 0x35+#define _SI 0x36+#define _DI 0x37++#define _EAX 0x40+#define _ECX 0x41+#define _EDX 0x42+#define _EBX 0x43+#define _ESP 0x44+#define _EBP 0x45+#define _ESI 0x46+#define _EDI 0x47++#define _MM0 0x60+#define _MM1 0x61+#define _MM2 0x62+#define _MM3 0x63+#define _MM4 0x64+#define _MM5 0x65+#define _MM6 0x66+#define _MM7 0x67++#define _XMM0 0x70+#define _XMM1 0x71+#define _XMM2 0x72+#define _XMM3 0x73+#define _XMM4 0x74+#define _XMM5 0x75+#define _XMM6 0x76+#define _XMM7 0x77+#define _XMM8 0x78+#define _XMM9 0x79+#define _XMM10 0x7a+#define _XMM11 0x7b+#define _XMM12 0x7c+#define _XMM13 0x7d+#define _XMM14 0x7e+#define _XMM15 0x7f++#define _ST0 0+#define _ST1 1+#define _ST2 2+#define _ST3 3+#define _ST4 4+#define _ST5 5+#define _ST6 6+#define _ST7 7++#define _r0P(R) ((int)(R) == (int)_NOREG)+#define _rIP(R) ((int)(R) == (int)_RIP)++#define _rC(R) ((R) & 0xf0)+#define _rR(R) ((R) & 0x0f)+#define _rN(R) ((R) & 0x07)+#define _rXP(R) ((R) > 0 && _rR(R) > 7)++#define _rbpP(R) (_rR(R) == _rR(_EBP))+#define _rspP(R) (_rR(R) == _rR(_ESP))+#define _rbp13P(R) (_rN(R) == _rN(_EBP))+#define _rsp12P(R) (_rN(R) == _rN(_ESP))++/*** ASSEMBLER ***/++#define _OFF4(D) (_jit_UL(D) - _jit_UL(_jit.x.pc))+#define _CKD8(D) _ck_d(8, ((_uc) _OFF4(D)) )++#define _D8(D) (_jit_B(0), ((*(_PUC(_jit.x.pc)-1))= _CKD8(D)))+#define _D32(D) (_jit_I(0), ((*(_PUI(_jit.x.pc)-1))= _OFF4(D)))++#ifndef _ASM_SAFETY+# define _M(M) (M)+# define _r(R) (R)+# define _m(M) (M)+# define _s(S) (S)+# define _i(I) (I)+# define _b(B) (B)+# define _noESP(I,OK) (OK)+#else+# define _M(M) (((M)>3) ? JITFAIL("internal error: mod = " #M) : (M))+# define _r(R) (((R)>7) ? JITFAIL("internal error: reg = " #R) : (R))+# define _m(M) (((M)>7) ? JITFAIL("internal error: r/m = " #M) : (M))+# define _s(S) (((S)>3) ? JITFAIL("internal error: memory scale = " #S) : (S))+# define _i(I) (((I)>7) ? JITFAIL("internal error: memory index = " #I) : (I))+# define _b(B) (((B)>7) ? JITFAIL("internal error: memory base = " #B) : (B))+# define _noESP(I,OK) (((I)==_ESP) ? JITFAIL("illegal index register: %esp") : (OK))+#endif++#define _Mrm(Md,R,M) _jit_B((_M(Md)<<6)|(_r(R)<<3)|_m(M))+#define _SIB(Sc,I, B) _jit_B((_s(Sc)<<6)|(_i(I)<<3)|_b(B))++#define _SCL(S) ((((S)==1) ? _b00 : \+ (((S)==2) ? _b01 : \+ (((S)==4) ? _b10 : \+ (((S)==8) ? _b11 : JITFAIL("illegal scale: " #S))))))++/* memory subformats - urgh! */++/* _r_D() is RIP addressing mode if X86_TARGET_64BIT, use _r_DSIB() instead */+#define _r_D( R, D ) (_Mrm(_b00,_rN(R),_b101 ) ,_jit_I((long)(D)))+#define _r_DSIB(R, D ) (_Mrm(_b00,_rN(R),_b100 ),_SIB(_SCL(1),_b100 ,_b101 ),_jit_I((long)(D)))+#define _r_0B( R, B ) (_Mrm(_b00,_rN(R),_rA(B)) )+#define _r_0BIS(R, B,I,S) (_Mrm(_b00,_rN(R),_b100 ),_SIB(_SCL(S),_rA(I),_rA(B)) )+#define _r_1B( R, D,B ) (_Mrm(_b01,_rN(R),_rA(B)) ,_jit_B((long)(D)))+#define _r_1BIS(R, D,B,I,S) (_Mrm(_b01,_rN(R),_b100 ),_SIB(_SCL(S),_rA(I),_rA(B)),_jit_B((long)(D)))+#define _r_4B( R, D,B ) (_Mrm(_b10,_rN(R),_rA(B)) ,_jit_I((long)(D)))+#define _r_4IS( R, D,I,S) (_Mrm(_b00,_rN(R),_b100 ),_SIB(_SCL(S),_rA(I),_b101 ),_jit_I((long)(D)))+#define _r_4BIS(R, D,B,I,S) (_Mrm(_b10,_rN(R),_b100 ),_SIB(_SCL(S),_rA(I),_rA(B)),_jit_I((long)(D)))++#define _r_DB( R, D,B ) ((_s0P(D) && (!_rbp13P(B)) ? _r_0B (R, B ) : (_s8P(D) ? _r_1B( R,D,B ) : _r_4B( R,D,B ))))+#define _r_DBIS(R, D,B,I,S) ((_s0P(D) && (!_rbp13P(B)) ? _r_0BIS(R, B,I,S) : (_s8P(D) ? _r_1BIS(R,D,B,I,S) : _r_4BIS(R,D,B,I,S))))++++/* --- Instruction formats ------------------------------------------------- */++/* _format Opcd ModR/M dN(rB,rI,Sc) imm... */++#define _d16() ( _jit_B(0x66 ) )+#define _O( OP ) ( _jit_B( OP ) )+#define _Or( OP,R ) ( _jit_B( (OP)|_r(R)) )+#define _OO( OP ) ( _jit_B((OP)>>8), _jit_B( (OP) ) )+#define _OOr( OP,R ) ( _jit_B((OP)>>8), _jit_B( (OP)|_r(R)) )+#define _Os( OP,B ) ( _s8P(B) ? _jit_B(((OP)|_b10)) : _jit_B(OP) )+#define _sW( W ) ( _s8P(W) ? _jit_B(W):_jit_W(W) )+#define _sL( L ) ( _s8P(L) ? _jit_B(L):_jit_I(L) )+#define _sWO( W ) ( _s8P(W) ? 1 : 2 )+#define _sLO( L ) ( _s8P(L) ? 1 : 4 )+#define _O_B( OP ,B ) ( _O ( OP ) ,_jit_B(B) )+#define _O_W( OP ,W ) ( _O ( OP ) ,_jit_W(W) )+#define _O_L( OP ,L ) ( _O ( OP ) ,_jit_I(L) )+#define _O_D8( OP ,D ) ( _O ( OP ) ,_D8(D) )+#define _O_D32( OP ,D ) ( _O ( OP ) ,_D32(D) )+#define _OO_D32( OP ,D ) ( _OO ( OP ) ,_D32(D) )+#define _Os_sW( OP ,W ) ( _Os ( OP,W) ,_sW(W) )+#define _Os_sL( OP ,L ) ( _Os ( OP,L) ,_sL(L) )+#define _O_W_B( OP ,W,B) ( _O ( OP ) ,_jit_W(W),_jit_B(B))+#define _Or_B( OP,R ,B ) ( _Or ( OP,R) ,_jit_B(B) )+#define _Or_W( OP,R ,W ) ( _Or ( OP,R) ,_jit_W(W) )+#define _Or_L( OP,R ,L ) ( _Or ( OP,R) ,_jit_I(L) )+#define _Or_Q( OP,R ,Q ) ( _Or ( OP,R) ,_jit_L(Q) )+#define _O_Mrm( OP ,MO,R,M ) ( _O ( OP ),_Mrm(MO,R,M ) )+#define _OO_Mrm( OP ,MO,R,M ) ( _OO ( OP ),_Mrm(MO,R,M ) )+#define _O_Mrm_B( OP ,MO,R,M ,B ) ( _O ( OP ),_Mrm(MO,R,M ) ,_jit_B(B) )+#define _O_Mrm_W( OP ,MO,R,M ,W ) ( _O ( OP ),_Mrm(MO,R,M ) ,_jit_W(W) )+#define _O_Mrm_L( OP ,MO,R,M ,L ) ( _O ( OP ),_Mrm(MO,R,M ) ,_jit_I(L) )+#define _OO_Mrm_B( OP ,MO,R,M ,B ) ( _OO ( OP ),_Mrm(MO,R,M ) ,_jit_B(B) )+#define _Os_Mrm_sW(OP ,MO,R,M ,W ) ( _Os ( OP,W),_Mrm(MO,R,M ),_sW(W) )+#define _Os_Mrm_sL(OP ,MO,R,M ,L ) ( _Os ( OP,L),_Mrm(MO,R,M ),_sL(L) )+#define _O_r_X( OP ,R ,MD,MB,MI,MS ) ( _O ( OP ),_r_X( R ,MD,MB,MI,MS,0) )+#define _OO_r_X( OP ,R ,MD,MB,MI,MS ) ( _OO ( OP ),_r_X( R ,MD,MB,MI,MS,0) )+#define _O_r_X_B( OP ,R ,MD,MB,MI,MS,B ) ( _O ( OP ),_r_X( R ,MD,MB,MI,MS,1) ,_jit_B(B) )+#define _O_r_X_W( OP ,R ,MD,MB,MI,MS,W ) ( _O ( OP ),_r_X( R ,MD,MB,MI,MS,2) ,_jit_W(W) )+#define _O_r_X_L( OP ,R ,MD,MB,MI,MS,L ) ( _O ( OP ),_r_X( R ,MD,MB,MI,MS,4) ,_jit_I(L) )+#define _OO_r_X_B( OP ,R ,MD,MB,MI,MS,B ) ( _OO ( OP ),_r_X( R ,MD,MB,MI,MS,1) ,_jit_B(B) )+#define _Os_r_X_sW(OP ,R ,MD,MB,MI,MS,W ) ( _Os ( OP,W),_r_X( R ,MD,MB,MI,MS,_sWO(W)),_sW(W))+#define _Os_r_X_sL(OP ,R ,MD,MB,MI,MS,L ) ( _Os ( OP,L),_r_X( R ,MD,MB,MI,MS,_sLO(L)),_sL(L))+#define _O_X_B( OP ,MD,MB,MI,MS,B ) ( _O_r_X_B( OP ,0 ,MD,MB,MI,MS ,B) )+#define _O_X_W( OP ,MD,MB,MI,MS,W ) ( _O_r_X_W( OP ,0 ,MD,MB,MI,MS ,W) )+#define _O_X_L( OP ,MD,MB,MI,MS,L ) ( _O_r_X_L( OP ,0 ,MD,MB,MI,MS ,L) )+++/* --- REX prefixes -------------------------------------------------------- */+++#define _BIT(X) (!!(X))+#define _d64(W,R,X,B) (_jit_B(0x40|(W)<<3|(R)<<2|(X)<<1|(B)))++#define __REXwrxb(L,W,R,X,B) ((W|R|X|B) || (L) ? (void)_d64(W,R,X,B) : ((void)0))+#define __REXwrx_(L,W,R,X,MR) (__REXwrxb(L,W,R,X,_BIT(_rIP(MR)?0:_rXP(MR))))+#define __REXw_x_(L,W,R,X,MR) (__REXwrx_(L,W,_BIT(_rXP(R)),X,MR))+#define __REX_reg(RR) (__REXwrxb(0,0,0,00,_BIT(_rXP(RR))))+#define __REX_mem(MB,MI) (__REXwrxb(0,0,0,_BIT(_rXP(MI)),_BIT(_rXP(MB))))++/* FIXME: can't mix new (SPL,BPL,SIL,DIL) with (AH,BH,CH,DH) */+#define _REXBrr(RR,MR) _m64(__REXw_x_(_r1e8lP(RR)||_r1e8lP(MR),0,RR,0,MR))+#define _REXBmr(MB,MI,RD) _m64(__REXw_x_(_r1e8lP(RD)||_r1e8lP(MB),0,RD,_BIT(_rXP(MI)),MB))+#define _REXBrm(RS,MB,MI) _REXBmr(MB,MI,RS)++#define _REXBLrr(RR,MR) _m64(__REXw_x_(_r1e8lP(MR),0,RR,0,MR))+#define _REXLrr(RR,MR) _m64(__REXw_x_(0,0,RR,0,MR))+#define _REXLmr(MB,MI,RD) _m64(__REXw_x_(0,0,RD,_BIT(_rXP(MI)),MB))+#define _REXLrm(RS,MB,MI) _REXLmr(MB,MI,RS)+#define _REXLr(RR) _m64(__REX_reg(RR))+#define _REXLm(MB,MI) _m64(__REX_mem(MB,MI))++#define _REXQrr(RR,MR) _m64only(__REXw_x_(0,1,RR,0,MR))+#define _REXQmr(MB,MI,RD) _m64only(__REXw_x_(0,1,RD,_BIT(_rXP(MI)),MB))+#define _REXQrm(RS,MB,MI) _REXQmr(MB,MI,RS)+#define _REXQr(RR) _m64only(__REX_reg(RR))+#define _REXQm(MB,MI) _m64only(__REX_mem(MB,MI))+++/* ========================================================================= */+/* --- Fully-qualified intrinsic instructions ------------------------------ */+/* ========================================================================= */++/* OPCODE + i = immediate operand+ * + r = register operand+ * + m = memory operand (disp,base,index,scale)+ * + sr/sm = a star preceding a register or memory+ * + 0 = top of stack register (for FPU instructions)+ *+ * NOTE in x86-64 mode: a memory operand with only a valid+ * displacement value will lead to the expect absolute mode. If+ * RIP addressing is necessary, X86_RIP shall be used as the base+ * register argument.+ */++/* --- ALU instructions ---------------------------------------------------- */++enum {+ X86_ADD = 0,+ X86_OR = 1,+ X86_ADC = 2,+ X86_SBB = 3,+ X86_AND = 4,+ X86_SUB = 5,+ X86_XOR = 6,+ X86_CMP = 7,+};++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define _ALUBrr(OP,RS, RD) (_REXBrr(RS, RD), _O_Mrm (((OP) << 3) ,_b11,_r1(RS),_r1(RD) ))+#define _ALUBmr(OP, MD, MB, MI, MS, RD) (_REXBmr(MB, MI, RD), _O_r_X (((OP) << 3) + 2,_r1(RD) ,MD,MB,MI,MS ))+#define _ALUBrm(OP, RS, MD, MB, MI, MS) (_REXBrm(RS, MB, MI), _O_r_X (((OP) << 3) , ,_r1(RS) ,MD,MB,MI,MS ))+#define _ALUBir(OP, IM, RD) ((RD) == _AL ? \+ (_REXBrr(0, RD), _O_B (((OP) << 3) + 4 ,_su8(IM))) : \+ (_REXBrr(0, RD), _O_Mrm_B (0x80 ,_b11,OP ,_r1(RD) ,_su8(IM))) )+#define _ALUBim(OP, IM, MD, MB, MI, MS) (_REXBrm(0, MB, MI), _O_r_X_B (0x80 ,OP ,MD,MB,MI,MS ,_su8(IM)))++#define _ALUWrr(OP, RS, RD) (_d16(), _REXLrr(RS, RD), _O_Mrm (((OP) << 3) + 1,_b11,_r2(RS),_r2(RD) ))+#define _ALUWmr(OP, MD, MB, MI, MS, RD) (_d16(), _REXLmr(MB, MI, RD), _O_r_X (((OP) << 3) + 3 ,_r2(RD) ,MD,MB,MI,MS ))+#define _ALUWrm(OP, RS, MD, MB, MI, MS) (_d16(), _REXLrm(RS, MB, MI), _O_r_X (((OP) << 3) + 1 ,_r2(RS) ,MD,MB,MI,MS ))+#define _ALUWir(OP, IM, RD) ((RD) == _AX ? \+ (_d16(), _REXLrr(0, RD), _O_W (((OP) << 3) + 5 ,_su16(IM))) : \+ (_d16(), _REXLrr(0, RD), _Os_Mrm_sW (0x81 ,_b11,OP ,_r2(RD) ,_su16(IM))) )+#define _ALUWim(OP, IM, MD, MB, MI, MS) (_d16(), _REXLrm(0, MB, MI), _Os_r_X_sW (0x81 ,OP ,MD,MB,MI,MS ,_su16(IM)))++#define _ALULrr(OP, RS, RD) (_REXLrr(RS, RD), _O_Mrm (((OP) << 3) + 1,_b11,_r4(RS),_r4(RD) ))+#define _ALULmr(OP, MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _O_r_X (((OP) << 3) + 3 ,_r4(RD) ,MD,MB,MI,MS ))+#define _ALULrm(OP, RS, MD, MB, MI, MS) (_REXLrm(RS, MB, MI), _O_r_X (((OP) << 3) + 1 ,_r4(RS) ,MD,MB,MI,MS ))+#define _ALULir(OP, IM, RD) (!_s8P(IM) && (RD) == _EAX ? \+ (_REXLrr(0, RD), _O_L (((OP) << 3) + 5 ,IM )) : \+ (_REXLrr(0, RD), _Os_Mrm_sL (0x81 ,_b11,OP ,_r4(RD) ,IM )) )+#define _ALULim(OP, IM, MD, MB, MI, MS) (_REXLrm(0, MB, MI), _Os_r_X_sL (0x81 ,OP ,MD,MB,MI,MS ,IM ))++#define _ALUQrr(OP, RS, RD) (_REXQrr(RS, RD), _O_Mrm (((OP) << 3) + 1,_b11,_r8(RS),_r8(RD) ))+#define _ALUQmr(OP, MD, MB, MI, MS, RD) (_REXQmr(MB, MI, RD), _O_r_X (((OP) << 3) + 3 ,_r8(RD) ,MD,MB,MI,MS ))+#define _ALUQrm(OP, RS, MD, MB, MI, MS) (_REXQrm(RS, MB, MI), _O_r_X (((OP) << 3) + 1 ,_r8(RS) ,MD,MB,MI,MS ))+#define _ALUQir(OP, IM, RD) \+ /* Immediate fits in 32 bits? */ \+ (_s32P((long)(IM)) \+ /* Yes. Immediate does not fit in 8 bits and reg is %rax? */ \+ ? (!_s8P(IM) && (RD) == _RAX \+ ? (_REXQrr(0, RD), _O_L(((OP) << 3) + 5, IM)) \+ : (_REXQrr(0, RD), _Os_Mrm_sL(0x81, _b11, OP, _r8(RD), IM))) \+ /* No. Need immediate in a register */ \+ : (MOVQir(IM, JIT_REXTMP), _ALUQrr(OP, JIT_REXTMP, RD)))+#define _ALUQim(OP, IM, MD, MB, MI, MS) (_REXQrm(0, MB, MI), _Os_r_X_sL (0x81 ,OP ,MD,MB,MI,MS ,IM ))++#define ADCBrr(RS, RD) _ALUBrr(X86_ADC, RS, RD)+#define ADCBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_ADC, MD, MB, MI, MS, RD)+#define ADCBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_ADC, RS, MD, MB, MI, MS)+#define ADCBir(IM, RD) _ALUBir(X86_ADC, IM, RD)+#define ADCBim(IM, MD, MB, MI, MS) _ALUBim(X86_ADC, IM, MD, MB, MI, MS)++#define ADCWrr(RS, RD) _ALUWrr(X86_ADC, RS, RD)+#define ADCWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_ADC, MD, MB, MI, MS, RD)+#define ADCWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_ADC, RS, MD, MB, MI, MS)+#define ADCWir(IM, RD) _ALUWir(X86_ADC, IM, RD)+#define ADCWim(IM, MD, MB, MI, MS) _ALUWim(X86_ADC, IM, MD, MB, MI, MS)++#define ADCLrr(RS, RD) _ALULrr(X86_ADC, RS, RD)+#define ADCLmr(MD, MB, MI, MS, RD) _ALULmr(X86_ADC, MD, MB, MI, MS, RD)+#define ADCLrm(RS, MD, MB, MI, MS) _ALULrm(X86_ADC, RS, MD, MB, MI, MS)+#define ADCLir(IM, RD) _ALULir(X86_ADC, IM, RD)+#define ADCLim(IM, MD, MB, MI, MS) _ALULim(X86_ADC, IM, MD, MB, MI, MS)+++#define ADDBrr(RS, RD) _ALUBrr(X86_ADD, RS, RD)+#define ADDBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_ADD, MD, MB, MI, MS, RD)+#define ADDBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_ADD, RS, MD, MB, MI, MS)+#define ADDBir(IM, RD) _ALUBir(X86_ADD, IM, RD)+#define ADDBim(IM, MD, MB, MI, MS) _ALUBim(X86_ADD, IM, MD, MB, MI, MS)++#define ADDWrr(RS, RD) _ALUWrr(X86_ADD, RS, RD)+#define ADDWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_ADD, MD, MB, MI, MS, RD)+#define ADDWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_ADD, RS, MD, MB, MI, MS)+#define ADDWir(IM, RD) _ALUWir(X86_ADD, IM, RD)+#define ADDWim(IM, MD, MB, MI, MS) _ALUWim(X86_ADD, IM, MD, MB, MI, MS)++#define ADDLrr(RS, RD) _ALULrr(X86_ADD, RS, RD)+#define ADDLmr(MD, MB, MI, MS, RD) _ALULmr(X86_ADD, MD, MB, MI, MS, RD)+#define ADDLrm(RS, MD, MB, MI, MS) _ALULrm(X86_ADD, RS, MD, MB, MI, MS)+#define ADDLir(IM, RD) _ALULir(X86_ADD, IM, RD)+#define ADDLim(IM, MD, MB, MI, MS) _ALULim(X86_ADD, IM, MD, MB, MI, MS)+++#define ANDBrr(RS, RD) _ALUBrr(X86_AND, RS, RD)+#define ANDBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_AND, MD, MB, MI, MS, RD)+#define ANDBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_AND, RS, MD, MB, MI, MS)+#define ANDBir(IM, RD) _ALUBir(X86_AND, IM, RD)+#define ANDBim(IM, MD, MB, MI, MS) _ALUBim(X86_AND, IM, MD, MB, MI, MS)++#define ANDWrr(RS, RD) _ALUWrr(X86_AND, RS, RD)+#define ANDWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_AND, MD, MB, MI, MS, RD)+#define ANDWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_AND, RS, MD, MB, MI, MS)+#define ANDWir(IM, RD) _ALUWir(X86_AND, IM, RD)+#define ANDWim(IM, MD, MB, MI, MS) _ALUWim(X86_AND, IM, MD, MB, MI, MS)++#define ANDLrr(RS, RD) _ALULrr(X86_AND, RS, RD)+#define ANDLmr(MD, MB, MI, MS, RD) _ALULmr(X86_AND, MD, MB, MI, MS, RD)+#define ANDLrm(RS, MD, MB, MI, MS) _ALULrm(X86_AND, RS, MD, MB, MI, MS)+#define ANDLir(IM, RD) _ALULir(X86_AND, IM, RD)+#define ANDLim(IM, MD, MB, MI, MS) _ALULim(X86_AND, IM, MD, MB, MI, MS)+++#define CMPBrr(RS, RD) _ALUBrr(X86_CMP, RS, RD)+#define CMPBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_CMP, MD, MB, MI, MS, RD)+#define CMPBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_CMP, RS, MD, MB, MI, MS)+#define CMPBir(IM, RD) _ALUBir(X86_CMP, IM, RD)+#define CMPBim(IM, MD, MB, MI, MS) _ALUBim(X86_CMP, IM, MD, MB, MI, MS)++#define CMPWrr(RS, RD) _ALUWrr(X86_CMP, RS, RD)+#define CMPWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_CMP, MD, MB, MI, MS, RD)+#define CMPWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_CMP, RS, MD, MB, MI, MS)+#define CMPWir(IM, RD) _ALUWir(X86_CMP, IM, RD)+#define CMPWim(IM, MD, MB, MI, MS) _ALUWim(X86_CMP, IM, MD, MB, MI, MS)++#define CMPLrr(RS, RD) _ALULrr(X86_CMP, RS, RD)+#define CMPLmr(MD, MB, MI, MS, RD) _ALULmr(X86_CMP, MD, MB, MI, MS, RD)+#define CMPLrm(RS, MD, MB, MI, MS) _ALULrm(X86_CMP, RS, MD, MB, MI, MS)+#define CMPLir(IM, RD) _ALULir(X86_CMP, IM, RD)+#define CMPLim(IM, MD, MB, MI, MS) _ALULim(X86_CMP, IM, MD, MB, MI, MS)+++#define ORBrr(RS, RD) _ALUBrr(X86_OR, RS, RD)+#define ORBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_OR, MD, MB, MI, MS, RD)+#define ORBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_OR, RS, MD, MB, MI, MS)+#define ORBir(IM, RD) _ALUBir(X86_OR, IM, RD)+#define ORBim(IM, MD, MB, MI, MS) _ALUBim(X86_OR, IM, MD, MB, MI, MS)++#define ORWrr(RS, RD) _ALUWrr(X86_OR, RS, RD)+#define ORWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_OR, MD, MB, MI, MS, RD)+#define ORWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_OR, RS, MD, MB, MI, MS)+#define ORWir(IM, RD) _ALUWir(X86_OR, IM, RD)+#define ORWim(IM, MD, MB, MI, MS) _ALUWim(X86_OR, IM, MD, MB, MI, MS)++#define ORLrr(RS, RD) _ALULrr(X86_OR, RS, RD)+#define ORLmr(MD, MB, MI, MS, RD) _ALULmr(X86_OR, MD, MB, MI, MS, RD)+#define ORLrm(RS, MD, MB, MI, MS) _ALULrm(X86_OR, RS, MD, MB, MI, MS)+#define ORLir(IM, RD) _ALULir(X86_OR, IM, RD)+#define ORLim(IM, MD, MB, MI, MS) _ALULim(X86_OR, IM, MD, MB, MI, MS)+++#define SBBBrr(RS, RD) _ALUBrr(X86_SBB, RS, RD)+#define SBBBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_SBB, MD, MB, MI, MS, RD)+#define SBBBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_SBB, RS, MD, MB, MI, MS)+#define SBBBir(IM, RD) _ALUBir(X86_SBB, IM, RD)+#define SBBBim(IM, MD, MB, MI, MS) _ALUBim(X86_SBB, IM, MD, MB, MI, MS)++#define SBBWrr(RS, RD) _ALUWrr(X86_SBB, RS, RD)+#define SBBWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_SBB, MD, MB, MI, MS, RD)+#define SBBWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_SBB, RS, MD, MB, MI, MS)+#define SBBWir(IM, RD) _ALUWir(X86_SBB, IM, RD)+#define SBBWim(IM, MD, MB, MI, MS) _ALUWim(X86_SBB, IM, MD, MB, MI, MS)++#define SBBLrr(RS, RD) _ALULrr(X86_SBB, RS, RD)+#define SBBLmr(MD, MB, MI, MS, RD) _ALULmr(X86_SBB, MD, MB, MI, MS, RD)+#define SBBLrm(RS, MD, MB, MI, MS) _ALULrm(X86_SBB, RS, MD, MB, MI, MS)+#define SBBLir(IM, RD) _ALULir(X86_SBB, IM, RD)+#define SBBLim(IM, MD, MB, MI, MS) _ALULim(X86_SBB, IM, MD, MB, MI, MS)+++#define SUBBrr(RS, RD) _ALUBrr(X86_SUB, RS, RD)+#define SUBBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_SUB, MD, MB, MI, MS, RD)+#define SUBBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_SUB, RS, MD, MB, MI, MS)+#define SUBBir(IM, RD) _ALUBir(X86_SUB, IM, RD)+#define SUBBim(IM, MD, MB, MI, MS) _ALUBim(X86_SUB, IM, MD, MB, MI, MS)++#define SUBWrr(RS, RD) _ALUWrr(X86_SUB, RS, RD)+#define SUBWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_SUB, MD, MB, MI, MS, RD)+#define SUBWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_SUB, RS, MD, MB, MI, MS)+#define SUBWir(IM, RD) _ALUWir(X86_SUB, IM, RD)+#define SUBWim(IM, MD, MB, MI, MS) _ALUWim(X86_SUB, IM, MD, MB, MI, MS)++#define SUBLrr(RS, RD) _ALULrr(X86_SUB, RS, RD)+#define SUBLmr(MD, MB, MI, MS, RD) _ALULmr(X86_SUB, MD, MB, MI, MS, RD)+#define SUBLrm(RS, MD, MB, MI, MS) _ALULrm(X86_SUB, RS, MD, MB, MI, MS)+#define SUBLir(IM, RD) _ALULir(X86_SUB, IM, RD)+#define SUBLim(IM, MD, MB, MI, MS) _ALULim(X86_SUB, IM, MD, MB, MI, MS)+++#define XORBrr(RS, RD) _ALUBrr(X86_XOR, RS, RD)+#define XORBmr(MD, MB, MI, MS, RD) _ALUBmr(X86_XOR, MD, MB, MI, MS, RD)+#define XORBrm(RS, MD, MB, MI, MS) _ALUBrm(X86_XOR, RS, MD, MB, MI, MS)+#define XORBir(IM, RD) _ALUBir(X86_XOR, IM, RD)+#define XORBim(IM, MD, MB, MI, MS) _ALUBim(X86_XOR, IM, MD, MB, MI, MS)++#define XORWrr(RS, RD) _ALUWrr(X86_XOR, RS, RD)+#define XORWmr(MD, MB, MI, MS, RD) _ALUWmr(X86_XOR, MD, MB, MI, MS, RD)+#define XORWrm(RS, MD, MB, MI, MS) _ALUWrm(X86_XOR, RS, MD, MB, MI, MS)+#define XORWir(IM, RD) _ALUWir(X86_XOR, IM, RD)+#define XORWim(IM, MD, MB, MI, MS) _ALUWim(X86_XOR, IM, MD, MB, MI, MS)++#define XORLrr(RS, RD) _ALULrr(X86_XOR, RS, RD)+#define XORLmr(MD, MB, MI, MS, RD) _ALULmr(X86_XOR, MD, MB, MI, MS, RD)+#define XORLrm(RS, MD, MB, MI, MS) _ALULrm(X86_XOR, RS, MD, MB, MI, MS)+#define XORLir(IM, RD) _ALULir(X86_XOR, IM, RD)+#define XORLim(IM, MD, MB, MI, MS) _ALULim(X86_XOR, IM, MD, MB, MI, MS)++++/* --- Shift/Rotate instructions ------------------------------------------- */++enum {+ X86_ROL = 0,+ X86_ROR = 1,+ X86_RCL = 2,+ X86_RCR = 3,+ X86_SHL = 4,+ X86_SHR = 5,+ X86_SAR = 7,+};++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define _ROTSHIBir(OP,IM,RD) ((IM) == 1 ? \+ (_REXBrr(0, RD), _O_Mrm (0xd0 ,_b11,OP,_r1(RD) )) : \+ (_REXBrr(0, RD), _O_Mrm_B (0xc0 ,_b11,OP,_r1(RD) ,_u8(IM))) )+#define _ROTSHIBim(OP,IM,MD,MB,MI,MS) ((IM) == 1 ? \+ (_REXBrm(0, MB, MI), _O_r_X (0xd0 ,OP ,MD,MB,MI,MS )) : \+ (_REXBrm(0, MB, MI), _O_r_X_B (0xc0 ,OP ,MD,MB,MI,MS ,_u8(IM))) )+#define _ROTSHIBrr(OP,RS,RD) (((RS) == _CL) ? \+ (_REXBrr(RS, RD), _O_Mrm (0xd2 ,_b11,OP,_r1(RD) )) : \+ JITFAIL("source register must be CL" ) )+#define _ROTSHIBrm(OP,RS,MD,MB,MI,MS) (((RS) == _CL) ? \+ (_REXBrm(RS, MB, MI), _O_r_X (0xd2 ,OP ,MD,MB,MI,MS )) : \+ JITFAIL("source register must be CL" ) )++#define _ROTSHIWir(OP,IM,RD) ((IM) == 1 ? \+ (_d16(), _REXLrr(0, RD), _O_Mrm (0xd1 ,_b11,OP,_r2(RD) )) : \+ (_d16(), _REXLrr(0, RD), _O_Mrm_B (0xc1 ,_b11,OP,_r2(RD) ,_u8(IM))) )+#define _ROTSHIWim(OP,IM,MD,MB,MI,MS) ((IM) == 1 ? \+ (_d16(), _REXLrm(0, MB, MI), _O_r_X (0xd1 ,OP ,MD,MB,MI,MS )) : \+ (_d16(), _REXLrm(0, MB, MI), _O_r_X_B (0xc1 ,OP ,MD,MB,MI,MS ,_u8(IM))) )+#define _ROTSHIWrr(OP,RS,RD) (((RS) == _CL) ? \+ (_d16(), _REXLrr(RS, RD), _O_Mrm (0xd3 ,_b11,OP,_r2(RD) )) : \+ JITFAIL("source register must be CL" ) )+#define _ROTSHIWrm(OP,RS,MD,MB,MI,MS) (((RS) == _CL) ? \+ (_d16(), _REXLrm(RS, MB, MI), _O_r_X (0xd3 ,OP ,MD,MB,MI,MS )) : \+ JITFAIL("source register must be CL" ) )++#define _ROTSHILir(OP,IM,RD) ((IM) == 1 ? \+ (_REXLrr(0, RD), _O_Mrm (0xd1 ,_b11,OP,_r4(RD) )) : \+ (_REXLrr(0, RD), _O_Mrm_B (0xc1 ,_b11,OP,_r4(RD) ,_u8(IM))) )+#define _ROTSHILim(OP,IM,MD,MB,MI,MS) ((IM) == 1 ? \+ (_REXLrm(0, MB, MI), _O_r_X (0xd1 ,OP ,MD,MB,MI,MS )) : \+ (_REXLrm(0, MB, MI), _O_r_X_B (0xc1 ,OP ,MD,MB,MI,MS ,_u8(IM))) )+#define _ROTSHILrr(OP,RS,RD) (((RS) == _CL) ? \+ (_REXLrr(RS, RD), _O_Mrm (0xd3 ,_b11,OP,_r4(RD) )) : \+ JITFAIL("source register must be CL" ) )+#define _ROTSHILrm(OP,RS,MD,MB,MI,MS) (((RS) == _CL) ? \+ (_REXLrm(RS, MB, MI), _O_r_X (0xd3 ,OP ,MD,MB,MI,MS )) : \+ JITFAIL("source register must be CL" ) )++#define _ROTSHIQir(OP,IM,RD) ((IM) == 1 ? \+ (_REXQrr(0, RD), _O_Mrm (0xd1 ,_b11,OP,_r8(RD) )) : \+ (_REXQrr(0, RD), _O_Mrm_B (0xc1 ,_b11,OP,_r8(RD) ,_u8(IM))) )+#define _ROTSHIQim(OP,IM,MD,MB,MI,MS) ((IM) == 1 ? \+ (_REXQrm(0, MB, MI), _O_r_X (0xd1 ,OP ,MD,MB,MI,MS )) : \+ (_REXQrm(0, MB, MI), _O_r_X_B (0xc1 ,OP ,MD,MB,MI,MS ,_u8(IM))) )+#define _ROTSHIQrr(OP,RS,RD) (((RS) == _CL) ? \+ (_REXQrr(RS, RD), _O_Mrm (0xd3 ,_b11,OP,_r8(RD) )) : \+ JITFAIL("source register must be CL" ) )+#define _ROTSHIQrm(OP,RS,MD,MB,MI,MS) (((RS) == _CL) ? \+ (_REXQrm(RS, MB, MI), _O_r_X (0xd3 ,OP ,MD,MB,MI,MS )) : \+ JITFAIL("source register must be CL" ) )++#define ROLBir(IM, RD) _ROTSHIBir(X86_ROL, IM, RD)+#define ROLBim(IM, MD, MB, MI, MS) _ROTSHIBim(X86_ROL, IM, MD, MB, MI, MS)+#define ROLBrr(RS, RD) _ROTSHIBrr(X86_ROL, RS, RD)+#define ROLBrm(RS, MD, MB, MI, MS) _ROTSHIBrm(X86_ROL, RS, MD, MB, MI, MS)++#define ROLWir(IM, RD) _ROTSHIWir(X86_ROL, IM, RD)+#define ROLWim(IM, MD, MB, MI, MS) _ROTSHIWim(X86_ROL, IM, MD, MB, MI, MS)+#define ROLWrr(RS, RD) _ROTSHIWrr(X86_ROL, RS, RD)+#define ROLWrm(RS, MD, MB, MI, MS) _ROTSHIWrm(X86_ROL, RS, MD, MB, MI, MS)++#define ROLLir(IM, RD) _ROTSHILir(X86_ROL, IM, RD)+#define ROLLim(IM, MD, MB, MI, MS) _ROTSHILim(X86_ROL, IM, MD, MB, MI, MS)+#define ROLLrr(RS, RD) _ROTSHILrr(X86_ROL, RS, RD)+#define ROLLrm(RS, MD, MB, MI, MS) _ROTSHILrm(X86_ROL, RS, MD, MB, MI, MS)+++#define RORBir(IM, RD) _ROTSHIBir(X86_ROR, IM, RD)+#define RORBim(IM, MD, MB, MI, MS) _ROTSHIBim(X86_ROR, IM, MD, MB, MI, MS)+#define RORBrr(RS, RD) _ROTSHIBrr(X86_ROR, RS, RD)+#define RORBrm(RS, MD, MB, MI, MS) _ROTSHIBrm(X86_ROR, RS, MD, MB, MI, MS)++#define RORWir(IM, RD) _ROTSHIWir(X86_ROR, IM, RD)+#define RORWim(IM, MD, MB, MI, MS) _ROTSHIWim(X86_ROR, IM, MD, MB, MI, MS)+#define RORWrr(RS, RD) _ROTSHIWrr(X86_ROR, RS, RD)+#define RORWrm(RS, MD, MB, MI, MS) _ROTSHIWrm(X86_ROR, RS, MD, MB, MI, MS)++#define RORLir(IM, RD) _ROTSHILir(X86_ROR, IM, RD)+#define RORLim(IM, MD, MB, MI, MS) _ROTSHILim(X86_ROR, IM, MD, MB, MI, MS)+#define RORLrr(RS, RD) _ROTSHILrr(X86_ROR, RS, RD)+#define RORLrm(RS, MD, MB, MI, MS) _ROTSHILrm(X86_ROR, RS, MD, MB, MI, MS)+++#define RCLBir(IM, RD) _ROTSHIBir(X86_RCL, IM, RD)+#define RCLBim(IM, MD, MB, MI, MS) _ROTSHIBim(X86_RCL, IM, MD, MB, MI, MS)+#define RCLBrr(RS, RD) _ROTSHIBrr(X86_RCL, RS, RD)+#define RCLBrm(RS, MD, MB, MI, MS) _ROTSHIBrm(X86_RCL, RS, MD, MB, MI, MS)++#define RCLWir(IM, RD) _ROTSHIWir(X86_RCL, IM, RD)+#define RCLWim(IM, MD, MB, MI, MS) _ROTSHIWim(X86_RCL, IM, MD, MB, MI, MS)+#define RCLWrr(RS, RD) _ROTSHIWrr(X86_RCL, RS, RD)+#define RCLWrm(RS, MD, MB, MI, MS) _ROTSHIWrm(X86_RCL, RS, MD, MB, MI, MS)++#define RCLLir(IM, RD) _ROTSHILir(X86_RCL, IM, RD)+#define RCLLim(IM, MD, MB, MI, MS) _ROTSHILim(X86_RCL, IM, MD, MB, MI, MS)+#define RCLLrr(RS, RD) _ROTSHILrr(X86_RCL, RS, RD)+#define RCLLrm(RS, MD, MB, MI, MS) _ROTSHILrm(X86_RCL, RS, MD, MB, MI, MS)+++#define RCRBir(IM, RD) _ROTSHIBir(X86_RCR, IM, RD)+#define RCRBim(IM, MD, MB, MI, MS) _ROTSHIBim(X86_RCR, IM, MD, MB, MI, MS)+#define RCRBrr(RS, RD) _ROTSHIBrr(X86_RCR, RS, RD)+#define RCRBrm(RS, MD, MB, MI, MS) _ROTSHIBrm(X86_RCR, RS, MD, MB, MI, MS)++#define RCRWir(IM, RD) _ROTSHIWir(X86_RCR, IM, RD)+#define RCRWim(IM, MD, MB, MI, MS) _ROTSHIWim(X86_RCR, IM, MD, MB, MI, MS)+#define RCRWrr(RS, RD) _ROTSHIWrr(X86_RCR, RS, RD)+#define RCRWrm(RS, MD, MB, MI, MS) _ROTSHIWrm(X86_RCR, RS, MD, MB, MI, MS)++#define RCRLir(IM, RD) _ROTSHILir(X86_RCR, IM, RD)+#define RCRLim(IM, MD, MB, MI, MS) _ROTSHILim(X86_RCR, IM, MD, MB, MI, MS)+#define RCRLrr(RS, RD) _ROTSHILrr(X86_RCR, RS, RD)+#define RCRLrm(RS, MD, MB, MI, MS) _ROTSHILrm(X86_RCR, RS, MD, MB, MI, MS)+++#define SHLBir(IM, RD) _ROTSHIBir(X86_SHL, IM, RD)+#define SHLBim(IM, MD, MB, MI, MS) _ROTSHIBim(X86_SHL, IM, MD, MB, MI, MS)+#define SHLBrr(RS, RD) _ROTSHIBrr(X86_SHL, RS, RD)+#define SHLBrm(RS, MD, MB, MI, MS) _ROTSHIBrm(X86_SHL, RS, MD, MB, MI, MS)++#define SHLWir(IM, RD) _ROTSHIWir(X86_SHL, IM, RD)+#define SHLWim(IM, MD, MB, MI, MS) _ROTSHIWim(X86_SHL, IM, MD, MB, MI, MS)+#define SHLWrr(RS, RD) _ROTSHIWrr(X86_SHL, RS, RD)+#define SHLWrm(RS, MD, MB, MI, MS) _ROTSHIWrm(X86_SHL, RS, MD, MB, MI, MS)++#define SHLLir(IM, RD) _ROTSHILir(X86_SHL, IM, RD)+#define SHLLim(IM, MD, MB, MI, MS) _ROTSHILim(X86_SHL, IM, MD, MB, MI, MS)+#define SHLLrr(RS, RD) _ROTSHILrr(X86_SHL, RS, RD)+#define SHLLrm(RS, MD, MB, MI, MS) _ROTSHILrm(X86_SHL, RS, MD, MB, MI, MS)+++#define SHRBir(IM, RD) _ROTSHIBir(X86_SHR, IM, RD)+#define SHRBim(IM, MD, MB, MI, MS) _ROTSHIBim(X86_SHR, IM, MD, MB, MI, MS)+#define SHRBrr(RS, RD) _ROTSHIBrr(X86_SHR, RS, RD)+#define SHRBrm(RS, MD, MB, MI, MS) _ROTSHIBrm(X86_SHR, RS, MD, MB, MI, MS)++#define SHRWir(IM, RD) _ROTSHIWir(X86_SHR, IM, RD)+#define SHRWim(IM, MD, MB, MI, MS) _ROTSHIWim(X86_SHR, IM, MD, MB, MI, MS)+#define SHRWrr(RS, RD) _ROTSHIWrr(X86_SHR, RS, RD)+#define SHRWrm(RS, MD, MB, MI, MS) _ROTSHIWrm(X86_SHR, RS, MD, MB, MI, MS)++#define SHRLir(IM, RD) _ROTSHILir(X86_SHR, IM, RD)+#define SHRLim(IM, MD, MB, MI, MS) _ROTSHILim(X86_SHR, IM, MD, MB, MI, MS)+#define SHRLrr(RS, RD) _ROTSHILrr(X86_SHR, RS, RD)+#define SHRLrm(RS, MD, MB, MI, MS) _ROTSHILrm(X86_SHR, RS, MD, MB, MI, MS)+++#define SALBir SHLBir+#define SALBim SHLBim+#define SALBrr SHLBrr+#define SALBrm SHLBrm++#define SALWir SHLWir+#define SALWim SHLWim+#define SALWrr SHLWrr+#define SALWrm SHLWrm++#define SALLir SHLLir+#define SALLim SHLLim+#define SALLrr SHLLrr+#define SALLrm SHLLrm+++#define SARBir(IM, RD) _ROTSHIBir(X86_SAR, IM, RD)+#define SARBim(IM, MD, MB, MI, MS) _ROTSHIBim(X86_SAR, IM, MD, MB, MI, MS)+#define SARBrr(RS, RD) _ROTSHIBrr(X86_SAR, RS, RD)+#define SARBrm(RS, MD, MB, MI, MS) _ROTSHIBrm(X86_SAR, RS, MD, MB, MI, MS)++#define SARWir(IM, RD) _ROTSHIWir(X86_SAR, IM, RD)+#define SARWim(IM, MD, MB, MI, MS) _ROTSHIWim(X86_SAR, IM, MD, MB, MI, MS)+#define SARWrr(RS, RD) _ROTSHIWrr(X86_SAR, RS, RD)+#define SARWrm(RS, MD, MB, MI, MS) _ROTSHIWrm(X86_SAR, RS, MD, MB, MI, MS)++#define SARLir(IM, RD) _ROTSHILir(X86_SAR, IM, RD)+#define SARLim(IM, MD, MB, MI, MS) _ROTSHILim(X86_SAR, IM, MD, MB, MI, MS)+#define SARLrr(RS, RD) _ROTSHILrr(X86_SAR, RS, RD)+#define SARLrm(RS, MD, MB, MI, MS) _ROTSHILrm(X86_SAR, RS, MD, MB, MI, MS)++++/* --- Bit test instructions ----------------------------------------------- */++enum {+ X86_BT = 4,+ X86_BTS = 5,+ X86_BTR = 6,+ X86_BTC = 7,+};++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define _BTWir(OP, IM, RD) (_d16(), _REXLrr(0, RD), _OO_Mrm_B (0x0fba ,_b11,OP ,_r2(RD) ,_u8(IM)))+#define _BTWim(OP, IM, MD, MB, MI, MS) (_d16(), _REXLrm(0, MB, MI), _OO_r_X_B (0x0fba ,OP ,MD,MB,MI,MS ,_u8(IM)))+#define _BTWrr(OP, RS, RD) (_d16(), _REXLrr(RS, RD), _OO_Mrm (0x0f83|((OP)<<3),_b11,_r2(RS),_r2(RD) ))+#define _BTWrm(OP, RS, MD, MB, MI, MS) (_d16(), _REXLrm(RS, MB, MI), _OO_r_X (0x0f83|((OP)<<3) ,_r2(RS) ,MD,MB,MI,MS ))++#define _BTLir(OP, IM, RD) (_REXLrr(0, RD), _OO_Mrm_B (0x0fba ,_b11,OP ,_r4(RD) ,_u8(IM)))+#define _BTLim(OP, IM, MD, MB, MI, MS) (_REXLrm(0, MB, MI), _OO_r_X_B (0x0fba ,OP ,MD,MB,MI,MS ,_u8(IM)))+#define _BTLrr(OP, RS, RD) (_REXLrr(RS, RD), _OO_Mrm (0x0f83|((OP)<<3),_b11,_r4(RS),_r4(RD) ))+#define _BTLrm(OP, RS, MD, MB, MI, MS) (_REXLrm(RS, MB, MI), _OO_r_X (0x0f83|((OP)<<3) ,_r4(RS) ,MD,MB,MI,MS ))++#define _BTQir(OP, IM, RD) (_REXQrr(0, RD), _OO_Mrm_B (0x0fba ,_b11,OP ,_r8(RD) ,_u8(IM)))+#define _BTQim(OP, IM, MD, MB, MI, MS) (_REXQrm(0, MB, MI), _OO_r_X_B (0x0fba ,OP ,MD,MB,MI,MS ,_u8(IM)))+#define _BTQrr(OP, RS, RD) (_REXQrr(RS, RD), _OO_Mrm (0x0f83|((OP)<<3),_b11,_r8(RS),_r8(RD) ))+#define _BTQrm(OP, RS, MD, MB, MI, MS) (_REXQrm(RS, MB, MI), _OO_r_X (0x0f83|((OP)<<3) ,_r8(RS) ,MD,MB,MI,MS ))++#define BTWir(IM, RD) _BTWir(X86_BT, IM, RD)+#define BTWim(IM, MD, MB, MI, MS) _BTWim(X86_BT, IM, MD, MI, MS)+#define BTWrr(RS, RD) _BTWrr(X86_BT, RS, RD)+#define BTWrm(RS, MD, MB, MI, MS) _BTWrm(X86_BT, RS, MD, MB, MI, MS)++#define BTLir(IM, RD) _BTLir(X86_BT, IM, RD)+#define BTLim(IM, MD, MB, MI, MS) _BTLim(X86_BT, IM, MD, MB, MI, MS)+#define BTLrr(RS, RD) _BTLrr(X86_BT, RS, RD)+#define BTLrm(RS, MD, MB, MI, MS) _BTLrm(X86_BT, RS, MD, MB, MI, MS)+++#define BTCWir(IM, RD) _BTWir(X86_BTC, IM, RD)+#define BTCWim(IM, MD, MB, MI, MS) _BTWim(X86_BTC, IM, MD, MI, MS)+#define BTCWrr(RS, RD) _BTWrr(X86_BTC, RS, RD)+#define BTCWrm(RS, MD, MB, MI, MS) _BTWrm(X86_BTC, RS, MD, MB, MI, MS)++#define BTCLir(IM, RD) _BTLir(X86_BTC, IM, RD)+#define BTCLim(IM, MD, MB, MI, MS) _BTLim(X86_BTC, IM, MD, MB, MI, MS)+#define BTCLrr(RS, RD) _BTLrr(X86_BTC, RS, RD)+#define BTCLrm(RS, MD, MB, MI, MS) _BTLrm(X86_BTC, RS, MD, MB, MI, MS)+++#define BTRWir(IM, RD) _BTWir(X86_BTR, IM, RD)+#define BTRWim(IM, MD, MB, MI, MS) _BTWim(X86_BTR, IM, MD, MI, MS)+#define BTRWrr(RS, RD) _BTWrr(X86_BTR, RS, RD)+#define BTRWrm(RS, MD, MB, MI, MS) _BTWrm(X86_BTR, RS, MD, MB, MI, MS)++#define BTRLir(IM, RD) _BTLir(X86_BTR, IM, RD)+#define BTRLim(IM, MD, MB, MI, MS) _BTLim(X86_BTR, IM, MD, MB, MI, MS)+#define BTRLrr(RS, RD) _BTLrr(X86_BTR, RS, RD)+#define BTRLrm(RS, MD, MB, MI, MS) _BTLrm(X86_BTR, RS, MD, MB, MI, MS)+++#define BTSWir(IM, RD) _BTWir(X86_BTS, IM, RD)+#define BTSWim(IM, MD, MB, MI, MS) _BTWim(X86_BTS, IM, MD, MI, MS)+#define BTSWrr(RS, RD) _BTWrr(X86_BTS, RS, RD)+#define BTSWrm(RS, MD, MB, MI, MS) _BTWrm(X86_BTS, RS, MD, MB, MI, MS)++#define BTSLir(IM, RD) _BTLir(X86_BTS, IM, RD)+#define BTSLim(IM, MD, MB, MI, MS) _BTLim(X86_BTS, IM, MD, MB, MI, MS)+#define BTSLrr(RS, RD) _BTLrr(X86_BTS, RS, RD)+#define BTSLrm(RS, MD, MB, MI, MS) _BTLrm(X86_BTS, RS, MD, MB, MI, MS)++++/* --- Move instructions --------------------------------------------------- */++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define MOVBrr(RS, RD) (_REXBrr(RS, RD), _O_Mrm (0x88 ,_b11,_r1(RS),_r1(RD) ))+#define MOVBmr(MD, MB, MI, MS, RD) (_REXBmr(MB, MI, RD), _O_r_X (0x8a ,_r1(RD) ,MD,MB,MI,MS ))+#define MOVBrm(RS, MD, MB, MI, MS) (_REXBrm(RS, MB, MI), _O_r_X (0x88 ,_r1(RS) ,MD,MB,MI,MS ))+#define MOVBir(IM, R) (_REXBrr(0, R), _Or_B (0xb0,_r1(R) ,_su8(IM)))+#define MOVBim(IM, MD, MB, MI, MS) (_REXBrm(0, MB, MI), _O_X_B (0xc6 ,MD,MB,MI,MS ,_su8(IM)))++#define MOVWrr(RS, RD) (_d16(), _REXLrr(RS, RD), _O_Mrm (0x89 ,_b11,_r2(RS),_r2(RD) ))+#define MOVWmr(MD, MB, MI, MS, RD) (_d16(), _REXLmr(MB, MI, RD), _O_r_X (0x8b ,_r2(RD) ,MD,MB,MI,MS ))+#define MOVWrm(RS, MD, MB, MI, MS) (_d16(), _REXLrm(RS, MB, MI), _O_r_X (0x89 ,_r2(RS) ,MD,MB,MI,MS ))+#define MOVWir(IM, R) (_d16(), _REXLrr(0, R), _Or_W (0xb8,_r2(R) ,_su16(IM)))+#define MOVWim(IM, MD, MB, MI, MS) (_d16(), _REXLrm(0, MB, MI), _O_X_W (0xc7 ,MD,MB,MI,MS ,_su16(IM)))++#define MOVLrr(RS, RD) (_REXLrr(RS, RD), _O_Mrm (0x89 ,_b11,_r4(RS),_r4(RD) ))+#define MOVLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _O_r_X (0x8b ,_r4(RD) ,MD,MB,MI,MS ))+#define MOVLrm(RS, MD, MB, MI, MS) (_REXLrm(RS, MB, MI), _O_r_X (0x89 ,_r4(RS) ,MD,MB,MI,MS ))+#define MOVLir(IM, R) (_REXLrr(0, R), _Or_L (0xb8,_r4(R) ,IM ))+#define MOVLim(IM, MD, MB, MI, MS) (_REXLrm(0, MB, MI), _O_X_L (0xc7 ,MD,MB,MI,MS ,IM ))++++/* --- Unary and Multiply/Divide instructions ------------------------------ */++enum {+ X86_NOT = 2,+ X86_NEG = 3,+ X86_MUL = 4,+ X86_IMUL = 5,+ X86_DIV = 6,+ X86_IDIV = 7,+};++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define _UNARYBr(OP, RS) (_REXBrr(0, RS), _O_Mrm (0xf6 ,_b11,OP ,_r1(RS) ))+#define _UNARYBm(OP, MD, MB, MI, MS) (_REXBrm(0, MB, MI), _O_r_X (0xf6 ,OP ,MD,MB,MI,MS ))+#define _UNARYWr(OP, RS) (_d16(), _REXLrr(0, RS), _O_Mrm (0xf7 ,_b11,OP ,_r2(RS) ))+#define _UNARYWm(OP, MD, MB, MI, MS) (_d16(), _REXLmr(MB, MI, 0), _O_r_X (0xf7 ,OP ,MD,MB,MI,MS ))+#define _UNARYLr(OP, RS) (_REXLrr(0, RS), _O_Mrm (0xf7 ,_b11,OP ,_r4(RS) ))+#define _UNARYLm(OP, MD, MB, MI, MS) (_REXLmr(MB, MI, 0), _O_r_X (0xf7 ,OP ,MD,MB,MI,MS ))+#define _UNARYQr(OP, RS) (_REXQrr(0, RS), _O_Mrm (0xf7 ,_b11,OP ,_r8(RS) ))+#define _UNARYQm(OP, MD, MB, MI, MS) (_REXQmr(MB, MI, 0), _O_r_X (0xf7 ,OP ,MD,MB,MI,MS ))++#define NOTBr(RS) _UNARYBr(X86_NOT, RS)+#define NOTBm(MD, MB, MI, MS) _UNARYBm(X86_NOT, MD, MB, MI, MS)+#define NOTWr(RS) _UNARYWr(X86_NOT, RS)+#define NOTWm(MD, MB, MI, MS) _UNARYWm(X86_NOT, MD, MB, MI, MS)+#define NOTLr(RS) _UNARYLr(X86_NOT, RS)+#define NOTLm(MD, MB, MI, MS) _UNARYLm(X86_NOT, MD, MB, MI, MS)++#define NEGBr(RS) _UNARYBr(X86_NEG, RS)+#define NEGBm(MD, MB, MI, MS) _UNARYBm(X86_NEG, MD, MB, MI, MS)+#define NEGWr(RS) _UNARYWr(X86_NEG, RS)+#define NEGWm(MD, MB, MI, MS) _UNARYWm(X86_NEG, MD, MB, MI, MS)+#define NEGLr(RS) _UNARYLr(X86_NEG, RS)+#define NEGLm(MD, MB, MI, MS) _UNARYLm(X86_NEG, MD, MB, MI, MS)++#define MULBr(RS) _UNARYBr(X86_MUL, RS)+#define MULBm(MD, MB, MI, MS) _UNARYBm(X86_MUL, MD, MB, MI, MS)+#define MULWr(RS) _UNARYWr(X86_MUL, RS)+#define MULWm(MD, MB, MI, MS) _UNARYWm(X86_MUL, MD, MB, MI, MS)+#define MULLr(RS) _UNARYLr(X86_MUL, RS)+#define MULLm(MD, MB, MI, MS) _UNARYLm(X86_MUL, MD, MB, MI, MS)++#define IMULBr(RS) _UNARYBr(X86_IMUL, RS)+#define IMULBm(MD, MB, MI, MS) _UNARYBm(X86_IMUL, MD, MB, MI, MS)+#define IMULWr(RS) _UNARYWr(X86_IMUL, RS)+#define IMULWm(MD, MB, MI, MS) _UNARYWm(X86_IMUL, MD, MB, MI, MS)+#define IMULLr(RS) _UNARYLr(X86_IMUL, RS)+#define IMULLm(MD, MB, MI, MS) _UNARYLm(X86_IMUL, MD, MB, MI, MS)++#define DIVBr(RS) _UNARYBr(X86_DIV, RS)+#define DIVBm(MD, MB, MI, MS) _UNARYBm(X86_DIV, MD, MB, MI, MS)+#define DIVWr(RS) _UNARYWr(X86_DIV, RS)+#define DIVWm(MD, MB, MI, MS) _UNARYWm(X86_DIV, MD, MB, MI, MS)+#define DIVLr(RS) _UNARYLr(X86_DIV, RS)+#define DIVLm(MD, MB, MI, MS) _UNARYLm(X86_DIV, MD, MB, MI, MS)++#define IDIVBr(RS) _UNARYBr(X86_IDIV, RS)+#define IDIVBm(MD, MB, MI, MS) _UNARYBm(X86_IDIV, MD, MB, MI, MS)+#define IDIVWr(RS) _UNARYWr(X86_IDIV, RS)+#define IDIVWm(MD, MB, MI, MS) _UNARYWm(X86_IDIV, MD, MB, MI, MS)+#define IDIVLr(RS) _UNARYLr(X86_IDIV, RS)+#define IDIVLm(MD, MB, MI, MS) _UNARYLm(X86_IDIV, MD, MB, MI, MS)++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define IMULWrr(RS, RD) (_d16(), _REXLrr(RD, RS), _OO_Mrm (0x0faf ,_b11,_r2(RD),_r2(RS) ))+#define IMULWmr(MD, MB, MI, MS, RD) (_d16(), _REXLmr(MB, MI, RD), _OO_r_X (0x0faf ,_r2(RD) ,MD,MB,MI,MS ))++#define IMULWirr(IM,RS,RD) (_d16(), _REXLrr(RS, RD), _Os_Mrm_sW (0x69 ,_b11,_r2(RS),_r2(RD) ,_su16(IM) ))+#define IMULWimr(IM,MD,MB,MI,MS,RD) (_d16(), _REXLmr(MB, MI, RD), _Os_r_X_sW (0x69 ,_r2(RD) ,MD,MB,MI,MS ,_su16(IM) ))++#define IMULLir(IM, RD) (_REXLrr(0, RD), _Os_Mrm_sL (0x69 ,_b11,_r4(RD),_r4(RD) ,IM ))+#define IMULLrr(RS, RD) (_REXLrr(RD, RS), _OO_Mrm (0x0faf ,_b11,_r4(RD),_r4(RS) ))+#define IMULLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0faf ,_r4(RD) ,MD,MB,MI,MS ))+++#define IMULLirr(IM,RS,RD) (_REXLrr(RS, RD), _Os_Mrm_sL (0x69 ,_b11,_r4(RS),_r4(RD) ,IM ))+#define IMULLimr(IM,MD,MB,MI,MS,RD) (_REXLmr(MB, MI, RD), _Os_r_X_sL (0x69 ,_r4(RD) ,MD,MB,MI,MS ,IM ))++++/* --- Control Flow related instructions ----------------------------------- */++enum {+ X86_CC_O = 0x0,+ X86_CC_NO = 0x1,+ X86_CC_NAE = 0x2,+ X86_CC_B = 0x2,+ X86_CC_C = 0x2,+ X86_CC_AE = 0x3,+ X86_CC_NB = 0x3,+ X86_CC_NC = 0x3,+ X86_CC_E = 0x4,+ X86_CC_Z = 0x4,+ X86_CC_NE = 0x5,+ X86_CC_NZ = 0x5,+ X86_CC_BE = 0x6,+ X86_CC_NA = 0x6,+ X86_CC_A = 0x7,+ X86_CC_NBE = 0x7,+ X86_CC_S = 0x8,+ X86_CC_NS = 0x9,+ X86_CC_P = 0xa,+ X86_CC_PE = 0xa,+ X86_CC_NP = 0xb,+ X86_CC_PO = 0xb,+ X86_CC_L = 0xc,+ X86_CC_NGE = 0xc,+ X86_CC_GE = 0xd,+ X86_CC_NL = 0xd,+ X86_CC_LE = 0xe,+ X86_CC_NG = 0xe,+ X86_CC_G = 0xf,+ X86_CC_NLE = 0xf,+};++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++/* FIXME: no prefix is availble to encode a 32-bit operand size in 64-bit+ mode */+#define CALLm(M) _O_D32 (0xe8 ,(int)(M) )+#define CALLLsr(R) (_REXLrr(0, R), _O_Mrm (0xff ,_b11,_b010,_r4(R) ))+#define CALLsm(D,B,I,S) (_REXLrm(0, B, I), _O_r_X (0xff ,_b010 ,(int)(D),B,I,S ))++/* FIXME: no prefix is availble to encode a 32-bit operand size in 64-bit+ mode */+#define JMPSm(M) _O_D8 (0xeb ,(int)(M) )+#define JMPm(M) _O_D32 (0xe9 ,(M) )+#define JMPLsr(R) (_REXLrr(0, R), _O_Mrm (0xff ,_b11,_b100,_r4(R) ))+#define JMPsm(D,B,I,S) (_REXLrm(0, B, I), _O_r_X (0xff ,_b100 ,(int)(D),B,I,S ))++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */+#define JCCSii(CC, D) _O_B (0x70|(CC) ,(_sc)(int)(D) )+#define JCCSim(CC, D) _O_D8 (0x70|(CC) ,(int)(D) )+#define JOSm(D) JCCSim(0x0, D)+#define JNOSm(D) JCCSim(0x1, D)+#define JBSm(D) JCCSim(0x2, D)+#define JCSm(D) JCCSim(0x2, D)+#define JNAESm(D) JCCSim(0x2, D)+#define JNBSm(D) JCCSim(0x3, D)+#define JNCSm(D) JCCSim(0x3, D)+#define JAESm(D) JCCSim(0x3, D)+#define JESm(D) JCCSim(0x4, D)+#define JZSm(D) JCCSim(0x4, D)+#define JNESm(D) JCCSim(0x5, D)+#define JNZSm(D) JCCSim(0x5, D)+#define JBESm(D) JCCSim(0x6, D)+#define JNASm(D) JCCSim(0x6, D)+#define JNBESm(D) JCCSim(0x7, D)+#define JASm(D) JCCSim(0x7, D)+#define JSSm(D) JCCSim(0x8, D)+#define JNSSm(D) JCCSim(0x9, D)+#define JPSm(D) JCCSim(0xa, D)+#define JPESm(D) JCCSim(0xa, D)+#define JNPSm(D) JCCSim(0xb, D)+#define JPOSm(D) JCCSim(0xb, D)+#define JLSm(D) JCCSim(0xc, D)+#define JNGESm(D) JCCSim(0xc, D)+#define JNLSm(D) JCCSim(0xd, D)+#define JGESm(D) JCCSim(0xd, D)+#define JLESm(D) JCCSim(0xe, D)+#define JNGSm(D) JCCSim(0xe, D)+#define JNLESm(D) JCCSim(0xf, D)+#define JGSm(D) JCCSim(0xf, D)++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */+#define JCCim(CC, D) _OO_D32 (0x0f80|(CC) ,(long)(D) )+#define JOm(D) JCCim(0x0, D)+#define JNOm(D) JCCim(0x1, D)+#define JBm(D) JCCim(0x2, D)+#define JCm(D) JCCim(0x2, D)+#define JNAEm(D) JCCim(0x2, D)+#define JNBm(D) JCCim(0x3, D)+#define JNCm(D) JCCim(0x3, D)+#define JAEm(D) JCCim(0x3, D)+#define JEm(D) JCCim(0x4, D)+#define JZm(D) JCCim(0x4, D)+#define JNEm(D) JCCim(0x5, D)+#define JNZm(D) JCCim(0x5, D)+#define JBEm(D) JCCim(0x6, D)+#define JNAm(D) JCCim(0x6, D)+#define JNBEm(D) JCCim(0x7, D)+#define JAm(D) JCCim(0x7, D)+#define JSm(D) JCCim(0x8, D)+#define JNSm(D) JCCim(0x9, D)+#define JPm(D) JCCim(0xa, D)+#define JPEm(D) JCCim(0xa, D)+#define JNPm(D) JCCim(0xb, D)+#define JPOm(D) JCCim(0xb, D)+#define JLm(D) JCCim(0xc, D)+#define JNGEm(D) JCCim(0xc, D)+#define JNLm(D) JCCim(0xd, D)+#define JGEm(D) JCCim(0xd, D)+#define JLEm(D) JCCim(0xe, D)+#define JNGm(D) JCCim(0xe, D)+#define JNLEm(D) JCCim(0xf, D)+#define JGm(D) JCCim(0xf, D)++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */+#define SETCCir(CC, RD) (_REXBrr(0, RD), _OO_Mrm (0x0f90|(CC) ,_b11,_b000,_r1(RD) ))+#define SETOr(RD) SETCCir(0x0,RD)+#define SETNOr(RD) SETCCir(0x1,RD)+#define SETBr(RD) SETCCir(0x2,RD)+#define SETNAEr(RD) SETCCir(0x2,RD)+#define SETNBr(RD) SETCCir(0x3,RD)+#define SETAEr(RD) SETCCir(0x3,RD)+#define SETEr(RD) SETCCir(0x4,RD)+#define SETZr(RD) SETCCir(0x4,RD)+#define SETNEr(RD) SETCCir(0x5,RD)+#define SETNZr(RD) SETCCir(0x5,RD)+#define SETBEr(RD) SETCCir(0x6,RD)+#define SETNAr(RD) SETCCir(0x6,RD)+#define SETNBEr(RD) SETCCir(0x7,RD)+#define SETAr(RD) SETCCir(0x7,RD)+#define SETSr(RD) SETCCir(0x8,RD)+#define SETNSr(RD) SETCCir(0x9,RD)+#define SETPr(RD) SETCCir(0xa,RD)+#define SETPEr(RD) SETCCir(0xa,RD)+#define SETNPr(RD) SETCCir(0xb,RD)+#define SETPOr(RD) SETCCir(0xb,RD)+#define SETLr(RD) SETCCir(0xc,RD)+#define SETNGEr(RD) SETCCir(0xc,RD)+#define SETNLr(RD) SETCCir(0xd,RD)+#define SETGEr(RD) SETCCir(0xd,RD)+#define SETLEr(RD) SETCCir(0xe,RD)+#define SETNGr(RD) SETCCir(0xe,RD)+#define SETNLEr(RD) SETCCir(0xf,RD)+#define SETGr(RD) SETCCir(0xf,RD)++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */+#define SETCCim(CC,MD,MB,MI,MS) (_REXBrm(0, MB, MI), _OO_r_X (0x0f90|(CC) ,_b000 ,MD,MB,MI,MS ))+#define SETOm(D, B, I, S) SETCCim(0x0, D, B, I, S)+#define SETNOm(D, B, I, S) SETCCim(0x1, D, B, I, S)+#define SETBm(D, B, I, S) SETCCim(0x2, D, B, I, S)+#define SETNAEm(D, B, I, S) SETCCim(0x2, D, B, I, S)+#define SETNBm(D, B, I, S) SETCCim(0x3, D, B, I, S)+#define SETAEm(D, B, I, S) SETCCim(0x3, D, B, I, S)+#define SETEm(D, B, I, S) SETCCim(0x4, D, B, I, S)+#define SETZm(D, B, I, S) SETCCim(0x4, D, B, I, S)+#define SETNEm(D, B, I, S) SETCCim(0x5, D, B, I, S)+#define SETNZm(D, B, I, S) SETCCim(0x5, D, B, I, S)+#define SETBEm(D, B, I, S) SETCCim(0x6, D, B, I, S)+#define SETNAm(D, B, I, S) SETCCim(0x6, D, B, I, S)+#define SETNBEm(D, B, I, S) SETCCim(0x7, D, B, I, S)+#define SETAm(D, B, I, S) SETCCim(0x7, D, B, I, S)+#define SETSm(D, B, I, S) SETCCim(0x8, D, B, I, S)+#define SETNSm(D, B, I, S) SETCCim(0x9, D, B, I, S)+#define SETPm(D, B, I, S) SETCCim(0xa, D, B, I, S)+#define SETPEm(D, B, I, S) SETCCim(0xa, D, B, I, S)+#define SETNPm(D, B, I, S) SETCCim(0xb, D, B, I, S)+#define SETPOm(D, B, I, S) SETCCim(0xb, D, B, I, S)+#define SETLm(D, B, I, S) SETCCim(0xc, D, B, I, S)+#define SETNGEm(D, B, I, S) SETCCim(0xc, D, B, I, S)+#define SETNLm(D, B, I, S) SETCCim(0xd, D, B, I, S)+#define SETGEm(D, B, I, S) SETCCim(0xd, D, B, I, S)+#define SETLEm(D, B, I, S) SETCCim(0xe, D, B, I, S)+#define SETNGm(D, B, I, S) SETCCim(0xe, D, B, I, S)+#define SETNLEm(D, B, I, S) SETCCim(0xf, D, B, I, S)+#define SETGm(D, B, I, S) SETCCim(0xf, D, B, I, S)++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */+#define CMOVWrr(CC,RS,RD) (_d16(), _REXLrr(RD, RS), _OO_Mrm (0x0f40|(CC) ,_b11,_r2(RD),_r2(RS) ))+#define CMOVWmr(CC,MD,MB,MI,MS,RD) (_d16(), _REXLmr(MB, MI, RD), _OO_r_X (0x0f40|(CC) ,_r2(RD) ,MD,MB,MI,MS ))+#define CMOVLrr(CC,RS,RD) (_REXLrr(RD, RS), _OO_Mrm (0x0f40|(CC) ,_b11,_r4(RD),_r4(RS) ))+#define CMOVLmr(CC,MD,MB,MI,MS,RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0f40|(CC) ,_r4(RD) ,MD,MB,MI,MS ))+++/* --- Push/Pop instructions ----------------------------------------------- */++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define POPWr(RD) _m32only((_d16(), _Or (0x58,_r2(RD) )))+#define POPWm(MD, MB, MI, MS) _m32only((_d16(), _O_r_X (0x8f ,_b000 ,MD,MB,MI,MS )))++#define POPLr(RD) _m32only( _Or (0x58,_r4(RD) ))+#define POPLm(MD, MB, MI, MS) _m32only( _O_r_X (0x8f ,_b000 ,MD,MB,MI,MS ))+++#define PUSHWr(RS) _m32only((_d16(), _Or (0x50,_r2(RS) )))+#define PUSHWm(MD, MB, MI, MS) _m32only((_d16(), _O_r_X (0xff, ,_b110 ,MD,MB,MI,MS )))+#define PUSHWi(IM) _m32only((_d16(), _Os_sW (0x68 ,IM )))++#define PUSHLr(RS) _m32only( _Or (0x50,_r4(RS) ))+#define PUSHLm(MD, MB, MI, MS) _m32only( _O_r_X (0xff ,_b110 ,MD,MB,MI,MS ))+#define PUSHLi(IM) _m32only( _Os_sL (0x68 ,IM ))+++#define POPA_() (_d16(), _O (0x61 ))+#define POPAD_() _O (0x61 )++#define PUSHA_() (_d16(), _O (0x60 ))+#define PUSHAD_() _O (0x60 )++#define POPF_() _O (0x9d )+#define PUSHF_() _O (0x9c )+++/* --- Test instructions --------------------------------------------------- */++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define TESTBrr(RS, RD) (_REXBrr(RS, RD), _O_Mrm (0x84 ,_b11,_r1(RS),_r1(RD) ))+#define TESTBrm(RS, MD, MB, MI, MS) (_REXBrm(RS, MB, MI), _O_r_X (0x84 ,_r1(RS) ,MD,MB,MI,MS ))+#define TESTBir(IM, RD) ((RD) == _AL ? \+ (_REXBrr(0, RD), _O_B (0xa8 ,_u8(IM))) : \+ (_REXBrr(0, RD), _O_Mrm_B (0xf6 ,_b11,_b000 ,_r1(RD) ,_u8(IM))) )+#define TESTBim(IM, MD, MB, MI, MS) (_REXBrm(0, MB, MI), _O_r_X_B (0xf6 ,_b000 ,MD,MB,MI,MS ,_u8(IM)))++#define TESTWrr(RS, RD) (_d16(), _REXLrr(RS, RD), _O_Mrm (0x85 ,_b11,_r2(RS),_r2(RD) ))+#define TESTWrm(RS, MD, MB, MI, MS) (_d16(), _REXLrm(RS, MB, MI), _O_r_X (0x85 ,_r2(RS) ,MD,MB,MI,MS ))+#define TESTWir(IM, RD) ((RD) == _AX ? \+ (_d16(), _REXLrr(0, RD), _O_W (0xa9 ,_u16(IM))) : \+ (_d16(), _REXLrr(0, RD), _O_Mrm_W (0xf7 ,_b11,_b000 ,_r2(RD) ,_u16(IM))) )+#define TESTWim(IM, MD, MB, MI, MS) (_d16(), _REXLrm(0, MB, MI), _O_r_X_W (0xf7 ,_b000 ,MD,MB,MI,MS ,_u16(IM)))++#define TESTLrr(RS, RD) (_REXLrr(RS, RD), _O_Mrm (0x85 ,_b11,_r4(RS),_r4(RD) ))+#define TESTLrm(RS, MD, MB, MI, MS) (_REXLrm(RS, MB, MI), _O_r_X (0x85 ,_r4(RS) ,MD,MB,MI,MS ))+#define TESTLir(IM, RD) (!_s8P(IM) && (RD) == _EAX ? \+ (_REXLrr(0, RD), _O_L (0xa9 ,IM )) : \+ (_REXLrr(0, RD), _O_Mrm_L (0xf7 ,_b11,_b000 ,_r4(RD) ,IM )) )+#define TESTLim(IM, MD, MB, MI, MS) (_REXLrm(0, MB, MI), _O_r_X_L (0xf7 ,_b000 ,MD,MB,MI,MS ,IM ))++++/* --- Exchange instructions ----------------------------------------------- */++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define CMPXCHGBrr(RS, RD) (_REXBrr(RS, RD), _OO_Mrm (0x0fb0 ,_b11,_r1(RS),_r1(RD) ))+#define CMPXCHGBrm(RS, MD, MB, MI, MS) (_REXBrm(RS, MB, MI), _OO_r_X (0x0fb0 ,_r1(RS) ,MD,MB,MI,MS ))++#define CMPXCHGWrr(RS, RD) (_d16(), _REXLrr(RS, RD), _OO_Mrm (0x0fb1 ,_b11,_r2(RS),_r2(RD) ))+#define CMPXCHGWrm(RS, MD, MB, MI, MS) (_d16(), _REXLrm(RS, MB, MI), _OO_r_X (0x0fb1 ,_r2(RS) ,MD,MB,MI,MS ))++#define CMPXCHGLrr(RS, RD) (_REXLrr(RS, RD), _OO_Mrm (0x0fb1 ,_b11,_r4(RS),_r4(RD) ))+#define CMPXCHGLrm(RS, MD, MB, MI, MS) (_REXLrm(RS, MB, MI), _OO_r_X (0x0fb1 ,_r4(RS) ,MD,MB,MI,MS ))+++#define XADDBrr(RS, RD) (_REXBrr(RS, RD), _OO_Mrm (0x0fc0 ,_b11,_r1(RS),_r1(RD) ))+#define XADDBrm(RS, MD, MB, MI, MS) (_REXBrm(RS, MB, MI), _OO_r_X (0x0fc0 ,_r1(RS) ,MD,MB,MI,MS ))++#define XADDWrr(RS, RD) (_d16(), _REXLrr(RS, RD), _OO_Mrm (0x0fc1 ,_b11,_r2(RS),_r2(RD) ))+#define XADDWrm(RS, MD, MB, MI, MS) (_d16(), _REXLrm(RS, MB, MI), _OO_r_X (0x0fc1 ,_r2(RS) ,MD,MB,MI,MS ))++#define XADDLrr(RS, RD) (_REXLrr(RS, RD), _OO_Mrm (0x0fc1 ,_b11,_r4(RS),_r4(RD) ))+#define XADDLrm(RS, MD, MB, MI, MS) (_REXLrm(RS, MB, MI), _OO_r_X (0x0fc1 ,_r4(RS) ,MD,MB,MI,MS ))+++#define XCHGBrr(RS, RD) (_REXBrr(RS, RD), _O_Mrm (0x86 ,_b11,_r1(RS),_r1(RD) ))+#define XCHGBrm(RS, MD, MB, MI, MS) (_REXBrm(RS, MB, MI), _O_r_X (0x86 ,_r1(RS) ,MD,MB,MI,MS ))++#define XCHGWrr(RS, RD) (_d16(), _REXLrr(RS, RD), _O_Mrm (0x87 ,_b11,_r2(RS),_r2(RD) ))+#define XCHGWrm(RS, MD, MB, MI, MS) (_d16(), _REXLrm(RS, MB, MI), _O_r_X (0x87 ,_r2(RS) ,MD,MB,MI,MS ))++#define XCHGLrr(RS, RD) (_REXLrr(RS, RD), _O_Mrm (0x87 ,_b11,_r4(RS),_r4(RD) ))+#define XCHGLrm(RS, MD, MB, MI, MS) (_REXLrm(RS, MB, MI), _O_r_X (0x87 ,_r4(RS) ,MD,MB,MI,MS ))++++/* --- Increment/Decrement instructions ------------------------------------ */++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define DECBm(MD, MB, MI, MS) (_REXBrm(0, MB, MI), _O_r_X (0xfe ,_b001 ,MD,MB,MI,MS ))+#define DECBr(RD) (_REXBrr(0, RD), _O_Mrm (0xfe ,_b11,_b001 ,_r1(RD) ))++#define DECWm(MD, MB, MI, MS) (_d16(), _REXLrm(0, MB, MI), _O_r_X (0xff ,_b001 ,MD,MB,MI,MS ))++#define DECLm(MD, MB, MI, MS) (_REXLrm(0, MB, MI), _O_r_X (0xff ,_b001 ,MD,MB,MI,MS ))+++#define INCBm(MD, MB, MI, MS) (_REXBrm(0, MB, MI), _O_r_X (0xfe ,_b000 ,MD,MB,MI,MS ))+#define INCBr(RD) (_REXBrr(0, RD), _O_Mrm (0xfe ,_b11,_b000 ,_r1(RD) ))++#define INCWm(MD, MB, MI, MS) (_d16(), _REXLrm(0, MB, MI), _O_r_X (0xff ,_b000 ,MD,MB,MI,MS ))++#define INCLm(MD, MB, MI, MS) (_REXLrm(0, MB, MI), _O_r_X (0xff ,_b000 ,MD,MB,MI,MS ))++++/* --- Misc instructions --------------------------------------------------- */++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define BSFWrr(RS, RD) (_d16(), _REXLrr(RD, RS), _OO_Mrm (0x0fbc ,_b11,_r2(RD),_r2(RS) ))+#define BSFWmr(MD, MB, MI, MS, RD) (_d16(), _REXLmr(MB, MI, RD), _OO_r_X (0x0fbc ,_r2(RD) ,MD,MB,MI,MS ))+#define BSRWrr(RS, RD) (_d16(), _REXLrr(RD, RS), _OO_Mrm (0x0fbd ,_b11,_r2(RD),_r2(RS) ))+#define BSRWmr(MD, MB, MI, MS, RD) (_d16(), _REXLmr(MB, MI, RD), _OO_r_X (0x0fbd ,_r2(RD) ,MD,MB,MI,MS ))++#define BSFLrr(RS, RD) (_REXLrr(RD, RS), _OO_Mrm (0x0fbc ,_b11,_r4(RD),_r4(RS) ))+#define BSFLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0fbc ,_r4(RD) ,MD,MB,MI,MS ))+#define BSRLrr(RS, RD) (_REXLrr(RD, RS), _OO_Mrm (0x0fbd ,_b11,_r4(RD),_r4(RS) ))+#define BSRLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0fbd ,_r4(RD) ,MD,MB,MI,MS ))+++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define MOVSBWrr(RS, RD) (_d16(), _REXBLrr(RD, RS), _OO_Mrm (0x0fbe ,_b11,_r2(RD),_r1(RS) ))+#define MOVSBWmr(MD, MB, MI, MS, RD) (_d16(), _REXLmr(MB, MI, RD), _OO_r_X (0x0fbe ,_r2(RD) ,MD,MB,MI,MS ))+#define MOVZBWrr(RS, RD) (_d16(), _REXBLrr(RD, RS), _OO_Mrm (0x0fb6 ,_b11,_r2(RD),_r1(RS) ))+#define MOVZBWmr(MD, MB, MI, MS, RD) (_d16(), _REXLmr(MB, MI, RD), _OO_r_X (0x0fb6 ,_r2(RD) ,MD,MB,MI,MS ))++#define MOVSBLrr(RS, RD) (_REXBLrr(RD, RS), _OO_Mrm (0x0fbe ,_b11,_r4(RD),_r1(RS) ))+#define MOVSBLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0fbe ,_r4(RD) ,MD,MB,MI,MS ))+#define MOVZBLrr(RS, RD) (_REXBLrr(RD, RS), _OO_Mrm (0x0fb6 ,_b11,_r4(RD),_r1(RS) ))+#define MOVZBLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0fb6 ,_r4(RD) ,MD,MB,MI,MS ))+++#define MOVSWLrr(RS, RD) (_REXLrr(RD, RS), _OO_Mrm (0x0fbf ,_b11,_r4(RD),_r2(RS) ))+#define MOVSWLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0fbf ,_r4(RD) ,MD,MB,MI,MS ))+#define MOVZWLrr(RS, RD) (_REXLrr(RD, RS), _OO_Mrm (0x0fb7 ,_b11,_r4(RD),_r2(RS) ))+#define MOVZWLmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _OO_r_X (0x0fb7 ,_r4(RD) ,MD,MB,MI,MS ))++++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define LEALmr(MD, MB, MI, MS, RD) (_REXLmr(MB, MI, RD), _O_r_X (0x8d ,_r4(RD) ,MD,MB,MI,MS ))++#define BSWAPLr(R) (_REXLrr(0, R), _OOr (0x0fc8,_r4(R) ))++#define CLC_() _O (0xf8 )+#define STC_() _O (0xf9 )++#define CMC_() _O (0xf5 )+#define CLD_() _O (0xfc )+#define STD_() _O (0xfd )++#define CBTW_() (_d16(), _O (0x98 ))+#define CWTL_() _O (0x98 )+#define CLTQ_() _m64only(_REXQrr(0, 0), _O (0x98 ))++#define CBW_() CBTW_()+#define CWDE_() CWTL_()+#define CDQE_() CLTQ_()++#define CWTD_() (_d16(), _O (0x99 ))+#define CLTD_() _O (0x99 )+#define CQTO_() _m64only(_REXQrr(0, 0), _O (0x99 ))++#define CWD_() CWTD_()+#define CDQ_() CLTD_()+#define CQO_() CQTO_()++#define LAHF_() _m32only( _O (0x9f ))+#define SAHF_() _m32only( _O (0x9e ))++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define CPUID_() _OO (0x0fa2 )+#define RDTSC_() _OO (0xff31 )++#define ENTERii(W, B) _O_W_B (0xc8 ,_su16(W),_su8(B))++#define LEAVE_() _O (0xc9 )+#define RET_() _O (0xc3 )+#define RETi(IM) _O_W (0xc2 ,_su16(IM))++#define NOP_() _O (0x90 )++/* x87 instructions -- yay, we found a use for octal constants :-) */++#define ESCmi(D,B,I,S,OP) (_REXLrm(0,B,I), _O_r_X(0xd8|(OP >> 3), (OP & 7), D,B,I,S))+#define ESCri(RD,OP) _O_Mrm(0xd8|(OP >> 3), _b11, (OP & 7), RD)++#define ESCrri(RS,RD,OP) ((RS) == _ST0 ? ESCri(RD,(OP|040)) \+ : (RD) == _ST0 ? ESCri(RS,OP) \+ : JITFAIL ("coprocessor instruction without st0"))++#define FLDSm(D,B,I,S) ESCmi(D,B,I,S,010) /* fld m32real */+#define FILDLm(D,B,I,S) ESCmi(D,B,I,S,030) /* fild m32int */+#define FLDLm(D,B,I,S) ESCmi(D,B,I,S,050) /* fld m64real */+#define FILDWm(D,B,I,S) ESCmi(D,B,I,S,070) /* fild m16int */+#define FSTSm(D,B,I,S) ESCmi(D,B,I,S,012) /* fst m32real */+#define FISTLm(D,B,I,S) ESCmi(D,B,I,S,032) /* fist m32int */+#define FSTLm(D,B,I,S) ESCmi(D,B,I,S,052) /* fst m64real */+#define FISTWm(D,B,I,S) ESCmi(D,B,I,S,072) /* fist m16int */+#define FSTPSm(D,B,I,S) ESCmi(D,B,I,S,013) /* fstp m32real */+#define FISTPLm(D,B,I,S) ESCmi(D,B,I,S,033) /* fistp m32int */+#define FSTPLm(D,B,I,S) ESCmi(D,B,I,S,053) /* fstp m64real */+#define FISTPWm(D,B,I,S) ESCmi(D,B,I,S,073) /* fistp m16int */+#define FLDTm(D,B,I,S) ESCmi(D,B,I,S,035) /* fld m80real */+#define FILDQm(D,B,I,S) ESCmi(D,B,I,S,075) /* fild m64int */+#define FSTPTm(D,B,I,S) ESCmi(D,B,I,S,037) /* fstp m80real */+#define FISTPQm(D,B,I,S) ESCmi(D,B,I,S,077) /* fistp m64int */++#define FADDrr(RS,RD) ESCrri(RS,RD,000)+#define FMULrr(RS,RD) ESCrri(RS,RD,001)+#define FSUBrr(RS,RD) ESCrri(RS,RD,004)+#define FSUBRrr(RS,RD) ESCrri(RS,RD,005)+#define FDIVrr(RS,RD) ESCrri(RS,RD,006)+#define FDIVRrr(RS,RD) ESCrri(RS,RD,007)++#define FLDr(RD) ESCri(RD,010)+#define FXCHr(RD) ESCri(RD,011)+#define FFREEr(RD) ESCri(RD,050)+#define FSTr(RD) ESCri(RD,052)+#define FSTPr(RD) ESCri(RD,053)+#define FCOMr(RD) ESCri(RD,002)+#define FCOMPr(RD) ESCri(RD,003)+#define FCOMIr(RD) ESCri(RD,036)+#define FCOMIPr(RD) ESCri(RD,076)+#define FUCOMr(RD) ESCri(RD,054)+#define FUCOMPr(RD) ESCri(RD,055)+#define FUCOMIr(RD) ESCri(RD,035)+#define FUCOMIPr(RD) ESCri(RD,075)+#define FADDPr(RD) ESCri(RD,060)+#define FMULPr(RD) ESCri(RD,061)+#define FSUBPr(RD) ESCri(RD,064)+#define FSUBRPr(RD) ESCri(RD,065)+#define FDIVPr(RD) ESCri(RD,066)+#define FDIVRPr(RD) ESCri(RD,067)++#define FNSTSWr(RD) ((RD == _AX || RD == _EAX) ? _OO (0xdfe0) \+ : JITFAIL ("AX or EAX expected"))+/* N byte NOPs */+#define NOPi(N) ((( (N) >= 8) ? (_jit_B(0x8d),_jit_B(0xb4),_jit_B(0x26),_jit_I(0x00),_jit_B(0x90)) : (void) 0), \+ (( ((N)&7) == 7) ? (_jit_B(0x8d),_jit_B(0xb4),_jit_B(0x26),_jit_I(0x00)) : \+ ( ((N)&7) == 6) ? (_jit_B(0x8d),_jit_B(0xb6),_jit_I(0x00)) : \+ ( ((N)&7) == 5) ? (_jit_B(0x90),_jit_B(0x8d),_jit_B(0x74),_jit_B(0x26),_jit_B(0x00)) : \+/* leal 0(,%esi), %esi */ ( ((N)&7) == 4) ? (_jit_B(0x8d),_jit_B(0x74),_jit_B(0x26),_jit_B(0x00)) : \+/* leal (,%esi), %esi */ ( ((N)&7) == 3) ? (_jit_B(0x8d),_jit_B(0x76),_jit_B(0x00)) : \+/* movl %esi, %esi */ ( ((N)&7) == 2) ? (_jit_B(0x89),_jit_B(0xf6)) : \+ ( ((N)&7) == 1) ? (_jit_B(0x90)) : \+ ( ((N)&7) == 0) ? 0 : \+ JITFAIL(".align argument too large")))+++/* --- Media 128-bit instructions ------------------------------------------ */++enum {+ X86_SSE_MOV = 0x10,+ X86_SSE_MOVLP = 0x12,+ X86_SSE_MOVHP = 0x16,+ X86_SSE_MOVA = 0x28,+ X86_SSE_CVTIS = 0x2a,+ X86_SSE_CVTTSI = 0x2c,+ X86_SSE_CVTSI = 0x2d,+ X86_SSE_UCOMI = 0x2e,+ X86_SSE_COMI = 0x2f,+ X86_SSE_SQRT = 0x51,+ X86_SSE_RSQRT = 0x52,+ X86_SSE_RCP = 0x53,+ X86_SSE_AND = 0x54,+ X86_SSE_ANDN = 0x55,+ X86_SSE_OR = 0x56,+ X86_SSE_XOR = 0x57,+ X86_SSE_ADD = 0x58,+ X86_SSE_MUL = 0x59,+ X86_SSE_CVTSD = 0x5a,+ X86_SSE_CVTDT = 0x5b,+ X86_SSE_SUB = 0x5c,+ X86_SSE_MIN = 0x5d,+ X86_SSE_DIV = 0x5e,+ X86_SSE_MAX = 0x5f,+ X86_SSE_MOV2 = 0xd6+};++/* _format Opcd ,Mod ,r ,m ,mem=dsp+sib ,imm... */++#define __SSELrr(OP,RS,RSA,RD,RDA) (_REXLrr(RD, RS), _OO_Mrm (0x0f00|(OP) ,_b11,RDA(RD),RSA(RS) ))+#define __SSELmr(OP,MD,MB,MI,MS,RD,RDA) (_REXLmr(MB, MI, RD), _OO_r_X (0x0f00|(OP) ,RDA(RD) ,MD,MB,MI,MS ))+#define __SSELrm(OP,RS,RSA,MD,MB,MI,MS) (_REXLrm(RS, MB, MI), _OO_r_X (0x0f00|(OP) ,RSA(RS) ,MD,MB,MI,MS ))+#define __SSEL1rm(OP,RS,RSA,MD,MB,MI,MS) (_REXLrm(RS, MB, MI), _OO_r_X (0x0f01|(OP) ,RSA(RS) ,MD,MB,MI,MS ))++#define _SSELrr(PX,OP,RS,RSA,RD,RDA) (_jit_B(PX), __SSELrr(OP, RS, RSA, RD, RDA))+#define _SSELmr(PX,OP,MD,MB,MI,MS,RD,RDA) (_jit_B(PX), __SSELmr(OP, MD, MB, MI, MS, RD, RDA))+#define _SSELrm(PX,OP,RS,RSA,MD,MB,MI,MS) (_jit_B(PX), __SSELrm(OP, RS, RSA, MD, MB, MI, MS))+#define _SSEL1rm(PX,OP,RS,RSA,MD,MB,MI,MS) (_jit_B(PX), __SSEL1rm(OP, RS, RSA, MD, MB, MI, MS))++#define _SSEPSrr(OP,RS,RD) __SSELrr ( OP, RS,_rX, RD,_rX)+#define _SSEPSmr(OP,MD,MB,MI,MS,RD) __SSELmr ( OP, MD, MB, MI, MS, RD,_rX)+#define _SSEPSrm(OP,RS,MD,MB,MI,MS) __SSELrm ( OP, RS,_rX, MD, MB, MI, MS)+#define _SSEPS1rm(OP,RS,MD,MB,MI,MS) __SSEL1rm( OP, RS,_rX, MD, MB, MI, MS)++#define _SSEPDrr(OP,RS,RD) _SSELrr (0x66, OP, RS,_rX, RD,_rX)+#define _SSEPDmr(OP,MD,MB,MI,MS,RD) _SSELmr (0x66, OP, MD, MB, MI, MS, RD,_rX)+#define _SSEPDrm(OP,RS,MD,MB,MI,MS) _SSELrm (0x66, OP, RS,_rX, MD, MB, MI, MS)+#define _SSEPD1rm(OP,RS,MD,MB,MI,MS) _SSEL1rm(0x66, OP, RS,_rX, MD, MB, MI, MS)++#define _SSESSrr(OP,RS,RD) _SSELrr (0xf3, OP, RS,_rX, RD,_rX)+#define _SSESSmr(OP,MD,MB,MI,MS,RD) _SSELmr (0xf3, OP, MD, MB, MI, MS, RD,_rX)+#define _SSESSrm(OP,RS,MD,MB,MI,MS) _SSELrm (0xf3, OP, RS,_rX, MD, MB, MI, MS)+#define _SSESS1rm(OP,RS,MD,MB,MI,MS) _SSEL1rm(0xf3, OP, RS,_rX, MD, MB, MI, MS)++#define _SSESDrr(OP,RS,RD) _SSELrr (0xf2, OP, RS,_rX, RD,_rX)+#define _SSESDmr(OP,MD,MB,MI,MS,RD) _SSELmr (0xf2, OP, MD, MB, MI, MS, RD,_rX)+#define _SSESDrm(OP,RS,MD,MB,MI,MS) _SSELrm (0xf2, OP, RS,_rX, MD, MB, MI, MS)+#define _SSESD1rm(OP,RS,MD,MB,MI,MS) _SSEL1rm(0xf2, OP, RS,_rX, MD, MB, MI, MS)++#define ADDPSrr(RS, RD) _SSEPSrr(X86_SSE_ADD, RS, RD)+#define ADDPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_ADD, MD, MB, MI, MS, RD)+#define ADDPDrr(RS, RD) _SSEPDrr(X86_SSE_ADD, RS, RD)+#define ADDPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_ADD, MD, MB, MI, MS, RD)++#define ADDSSrr(RS, RD) _SSESSrr(X86_SSE_ADD, RS, RD)+#define ADDSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_ADD, MD, MB, MI, MS, RD)+#define ADDSDrr(RS, RD) _SSESDrr(X86_SSE_ADD, RS, RD)+#define ADDSDmr(MD, MB, MI, MS, RD) _SSESDmr(X86_SSE_ADD, MD, MB, MI, MS, RD)++#define ANDNPSrr(RS, RD) _SSEPSrr(X86_SSE_ANDN, RS, RD)+#define ANDNPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_ANDN, MD, MB, MI, MS, RD)+#define ANDNPDrr(RS, RD) _SSEPDrr(X86_SSE_ANDN, RS, RD)+#define ANDNPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_ANDN, MD, MB, MI, MS, RD)++#define ANDNSSrr ANDNPSrr+#define ANDNSSmr ANDNPSrr+#define ANDNSDrr ANDNPDrr+#define ANDNSDmr ANDNPDrr++#define ANDPSrr(RS, RD) _SSEPSrr(X86_SSE_AND, RS, RD)+#define ANDPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_AND, MD, MB, MI, MS, RD)+#define ANDPDrr(RS, RD) _SSEPDrr(X86_SSE_AND, RS, RD)+#define ANDPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_AND, MD, MB, MI, MS, RD)++#define ANDSSrr ANDPSrr+#define ANDSSmr ANDPSrr+#define ANDSDrr ANDPDrr+#define ANDSDmr ANDPDrr++#define DIVPSrr(RS, RD) _SSEPSrr(X86_SSE_DIV, RS, RD)+#define DIVPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_DIV, MD, MB, MI, MS, RD)+#define DIVPDrr(RS, RD) _SSEPDrr(X86_SSE_DIV, RS, RD)+#define DIVPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_DIV, MD, MB, MI, MS, RD)++#define DIVSSrr(RS, RD) _SSESSrr(X86_SSE_DIV, RS, RD)+#define DIVSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_DIV, MD, MB, MI, MS, RD)+#define DIVSDrr(RS, RD) _SSESDrr(X86_SSE_DIV, RS, RD)+#define DIVSDmr(MD, MB, MI, MS, RD) _SSESDmr(X86_SSE_DIV, MD, MB, MI, MS, RD)++#define MAXPSrr(RS, RD) _SSEPSrr(X86_SSE_MAX, RS, RD)+#define MAXPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_MAX, MD, MB, MI, MS, RD)+#define MAXPDrr(RS, RD) _SSEPDrr(X86_SSE_MAX, RS, RD)+#define MAXPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_MAX, MD, MB, MI, MS, RD)++#define MAXSSrr(RS, RD) _SSESSrr(X86_SSE_MAX, RS, RD)+#define MAXSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_MAX, MD, MB, MI, MS, RD)+#define MAXSDrr(RS, RD) _SSESDrr(X86_SSE_MAX, RS, RD)+#define MAXSDmr(MD, MB, MI, MS, RD) _SSESDmr(X86_SSE_MAX, MD, MB, MI, MS, RD)++#define MINPSrr(RS, RD) _SSEPSrr(X86_SSE_MIN, RS, RD)+#define MINPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_MIN, MD, MB, MI, MS, RD)+#define MINPDrr(RS, RD) _SSEPDrr(X86_SSE_MIN, RS, RD)+#define MINPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_MIN, MD, MB, MI, MS, RD)++#define MINSSrr(RS, RD) _SSESSrr(X86_SSE_MIN, RS, RD)+#define MINSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_MIN, MD, MB, MI, MS, RD)+#define MINSDrr(RS, RD) _SSESDrr(X86_SSE_MIN, RS, RD)+#define MINSDmr(MD, MB, MI, MS, RD) _SSESDmr(X86_SSE_MIN, MD, MB, MI, MS, RD)++#define MULPSrr(RS, RD) _SSEPSrr(X86_SSE_MUL, RS, RD)+#define MULPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_MUL, MD, MB, MI, MS, RD)+#define MULPDrr(RS, RD) _SSEPDrr(X86_SSE_MUL, RS, RD)+#define MULPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_MUL, MD, MB, MI, MS, RD)++#define MULSSrr(RS, RD) _SSESSrr(X86_SSE_MUL, RS, RD)+#define MULSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_MUL, MD, MB, MI, MS, RD)+#define MULSDrr(RS, RD) _SSESDrr(X86_SSE_MUL, RS, RD)+#define MULSDmr(MD, MB, MI, MS, RD) _SSESDmr(X86_SSE_MUL, MD, MB, MI, MS, RD)++#define ORPSrr(RS, RD) _SSEPSrr(X86_SSE_OR, RS, RD)+#define ORPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_OR, MD, MB, MI, MS, RD)+#define ORPDrr(RS, RD) _SSEPDrr(X86_SSE_OR, RS, RD)+#define ORPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_OR, MD, MB, MI, MS, RD)++#define ORSSrr ORPSrr+#define ORSSmr ORPSrr+#define ORSDrr ORPDrr+#define ORSDmr ORPDrr++#define RCPPSrr(RS, RD) _SSEPSrr(X86_SSE_RCP, RS, RD)+#define RCPPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_RCP, MD, MB, MI, MS, RD)+#define RCPSSrr(RS, RD) _SSESSrr(X86_SSE_RCP, RS, RD)+#define RCPSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_RCP, MD, MB, MI, MS, RD)++#define RSQRTPSrr(RS, RD) _SSEPSrr(X86_SSE_RSQRT, RS, RD)+#define RSQRTPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_RSQRT, MD, MB, MI, MS, RD)+#define RSQRTSSrr(RS, RD) _SSESSrr(X86_SSE_RSQRT, RS, RD)+#define RSQRTSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_RSQRT, MD, MB, MI, MS, RD)++#define SQRTPSrr(RS, RD) _SSEPSrr(X86_SSE_SQRT, RS, RD)+#define SQRTPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_SQRT, MD, MB, MI, MS, RD)+#define SQRTPDrr(RS, RD) _SSEPDrr(X86_SSE_SQRT, RS, RD)+#define SQRTPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_SQRT, MD, MB, MI, MS, RD)++#define SQRTSSrr(RS, RD) _SSESSrr(X86_SSE_SQRT, RS, RD)+#define SQRTSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_SQRT, MD, MB, MI, MS, RD)+#define SQRTSDrr(RS, RD) _SSESDrr(X86_SSE_SQRT, RS, RD)+#define SQRTSDmr(MD, MB, MI, MS, RD) _SSESDmr(X86_SSE_SQRT, MD, MB, MI, MS, RD)++#define SUBPSrr(RS, RD) _SSEPSrr(X86_SSE_SUB, RS, RD)+#define SUBPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_SUB, MD, MB, MI, MS, RD)+#define SUBPDrr(RS, RD) _SSEPDrr(X86_SSE_SUB, RS, RD)+#define SUBPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_SUB, MD, MB, MI, MS, RD)++#define SUBSSrr(RS, RD) _SSESSrr(X86_SSE_SUB, RS, RD)+#define SUBSSmr(MD, MB, MI, MS, RD) _SSESSmr(X86_SSE_SUB, MD, MB, MI, MS, RD)+#define SUBSDrr(RS, RD) _SSESDrr(X86_SSE_SUB, RS, RD)+#define SUBSDmr(MD, MB, MI, MS, RD) _SSESDmr(X86_SSE_SUB, MD, MB, MI, MS, RD)++#define XORPSrr(RS, RD) _SSEPSrr(X86_SSE_XOR, RS, RD)+#define XORPSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_XOR, MD, MB, MI, MS, RD)+#define XORPDrr(RS, RD) _SSEPDrr(X86_SSE_XOR, RS, RD)+#define XORPDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_XOR, MD, MB, MI, MS, RD)++#define XORSSrr XORPSrr+#define XORSSmr XORPSrr+#define XORSDrr XORPDrr+#define XORSDmr XORPDrr++/* No prefixes here. */+#define COMISSrr(RS, RD) _SSEPSrr(X86_SSE_COMI, RS, RD)+#define COMISSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_COMI, MD, MB, MI, MS, RD)+#define COMISDrr(RS, RD) _SSEPDrr(X86_SSE_COMI, RS, RD)+#define COMISDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_COMI, MD, MB, MI, MS, RD)++/* No prefixes here. */+#define UCOMISSrr(RS, RD) _SSEPSrr(X86_SSE_UCOMI, RS, RD)+#define UCOMISSmr(MD, MB, MI, MS, RD) _SSEPSmr(X86_SSE_UCOMI, MD, MB, MI, MS, RD)+#define UCOMISDrr(RS, RD) _SSEPDrr(X86_SSE_UCOMI, RS, RD)+#define UCOMISDmr(MD, MB, MI, MS, RD) _SSEPDmr(X86_SSE_UCOMI, MD, MB, MI, MS, RD)++#define MOVSSrr(RS, RD) _SSESSrr (X86_SSE_MOV, RS, RD)+#define MOVSSmr(MD, MB, MI, MS, RD) _SSESSmr (X86_SSE_MOV, MD, MB, MI, MS, RD)+#define MOVSSrm(RS, MD, MB, MI, MS) _SSESS1rm(X86_SSE_MOV, RS, MD, MB, MI, MS)++#define MOVSDrr(RS, RD) _SSESDrr (X86_SSE_MOV, RS, RD)+#define MOVSDmr(MD, MB, MI, MS, RD) _SSESDmr (X86_SSE_MOV, MD, MB, MI, MS, RD)+#define MOVSDrm(RS, MD, MB, MI, MS) _SSESD1rm(X86_SSE_MOV, RS, MD, MB, MI, MS)++#define MOVAPSrr(RS, RD) _SSEPSrr (X86_SSE_MOVA, RS, RD)+#define MOVAPSmr(MD, MB, MI, MS, RD) _SSEPSmr (X86_SSE_MOVA, MD, MB, MI, MS, RD)+#define MOVAPSrm(RS, MD, MB, MI, MS) _SSEPS1rm(X86_SSE_MOVA, RS, MD, MB, MI, MS)++#define MOVAPDrr(RS, RD) _SSEPDrr (X86_SSE_MOVA, RS, RD)+#define MOVAPDmr(MD, MB, MI, MS, RD) _SSEPDmr (X86_SSE_MOVA, MD, MB, MI, MS, RD)+#define MOVAPDrm(RS, MD, MB, MI, MS) _SSEPD1rm(X86_SSE_MOVA, RS, MD, MB, MI, MS)++#define CVTPS2PIrr(RS, RD) __SSELrr( X86_SSE_CVTSI, RS,_rX, RD,_rM)+#define CVTPS2PImr(MD, MB, MI, MS, RD) __SSELmr( X86_SSE_CVTSI, MD, MB, MI, MS, RD,_rM)+#define CVTPD2PIrr(RS, RD) _SSELrr(0x66, X86_SSE_CVTSI, RS,_rX, RD,_rM)+#define CVTPD2PImr(MD, MB, MI, MS, RD) _SSELmr(0x66, X86_SSE_CVTSI, MD, MB, MI, MS, RD,_rM)++#define CVTPI2PSrr(RS, RD) __SSELrr( X86_SSE_CVTIS, RS,_rM, RD,_rX)+#define CVTPI2PSmr(MD, MB, MI, MS, RD) __SSELmr( X86_SSE_CVTIS, MD, MB, MI, MS, RD,_rX)+#define CVTPI2PDrr(RS, RD) _SSELrr(0x66, X86_SSE_CVTIS, RS,_rM, RD,_rX)+#define CVTPI2PDmr(MD, MB, MI, MS, RD) _SSELmr(0x66, X86_SSE_CVTIS, MD, MB, MI, MS, RD,_rX)++#define CVTPS2PDrr(RS, RD) __SSELrr( X86_SSE_CVTSD, RS,_rX, RD,_rX)+#define CVTPS2PDmr(MD, MB, MI, MS, RD) __SSELmr( X86_SSE_CVTSD, MD, MB, MI, MS, RD,_rX)+#define CVTPD2PSrr(RS, RD) _SSELrr(0x66, X86_SSE_CVTSD, RS,_rX, RD,_rX)+#define CVTPD2PSmr(MD, MB, MI, MS, RD) _SSELmr(0x66, X86_SSE_CVTSD, MD, MB, MI, MS, RD,_rX)++#define CVTSS2SDrr(RS, RD) _SSELrr(0xf3, X86_SSE_CVTSD, RS,_rX, RD,_rX)+#define CVTSS2SDmr(MD, MB, MI, MS, RD) _SSELmr(0xf3, X86_SSE_CVTSD, MD, MB, MI, MS, RD,_rX)+#define CVTSD2SSrr(RS, RD) _SSELrr(0xf2, X86_SSE_CVTSD, RS,_rX, RD,_rX)+#define CVTSD2SSmr(MD, MB, MI, MS, RD) _SSELmr(0xf2, X86_SSE_CVTSD, MD, MB, MI, MS, RD,_rX)++#define CVTTSS2SILrr(RS, RD) _SSELrr(0xf3, X86_SSE_CVTTSI, RS,_rX, RD,_r4)+#define CVTTSS2SILmr(MD, MB, MI, MS, RD) _SSELmr(0xf3, X86_SSE_CVTTSI, MD, MB, MI, MS, RD,_r4)+#define CVTTSD2SILrr(RS, RD) _SSELrr(0xf2, X86_SSE_CVTTSI, RS,_rX, RD,_r4)+#define CVTTSD2SILmr(MD, MB, MI, MS, RD) _SSELmr(0xf2, X86_SSE_CVTTSI, MD, MB, MI, MS, RD,_r4)++#define CVTSS2SILrr(RS, RD) _SSELrr(0xf3, X86_SSE_CVTSI, RS,_rX, RD,_r4)+#define CVTSS2SILmr(MD, MB, MI, MS, RD) _SSELmr(0xf3, X86_SSE_CVTSI, MD, MB, MI, MS, RD,_r4)+#define CVTSD2SILrr(RS, RD) _SSELrr(0xf2, X86_SSE_CVTSI, RS,_rX, RD,_r4)+#define CVTSD2SILmr(MD, MB, MI, MS, RD) _SSELmr(0xf2, X86_SSE_CVTSI, MD, MB, MI, MS, RD,_r4)++#define CVTSI2SSLrr(RS, RD) _SSELrr(0xf3, X86_SSE_CVTIS, RS,_r4, RD,_rX)+#define CVTSI2SSLmr(MD, MB, MI, MS, RD) _SSELmr(0xf3, X86_SSE_CVTIS, MD, MB, MI, MS, RD,_rX)+#define CVTSI2SDLrr(RS, RD) _SSELrr(0xf2, X86_SSE_CVTIS, RS,_r4, RD,_rX)+#define CVTSI2SDLmr(MD, MB, MI, MS, RD) _SSELmr(0xf2, X86_SSE_CVTIS, MD, MB, MI, MS, RD,_rX)++#define MOVDLXrr(RS, RD) _SSELrr(0x66, 0x6e, RS,_r4, RD,_rX)+#define MOVDLXmr(MD, MB, MI, MS, RD) _SSELmr(0x66, 0x6e, MD, MB, MI, MS, RD,_rX)++#define MOVDXLrr(RS, RD) _SSELrr(0x66, 0x7e, RS,_rX, RD,_r4)+#define MOVDXLrm(RS, MD, MB, MI, MS) _SSELrm(0x66, 0x7e, RS,_rX, MD, MB, MI, MS)++#define MOVDLMrr(RS, RD) __SSELrr( 0x6e, RS,_r4, RD,_rM)+#define MOVDLMmr(MD, MB, MI, MS, RD) __SSELmr( 0x6e, MD, MB, MI, MS, RD,_rM)++#define MOVDMLrr(RS, RD) __SSELrr( 0x7e, RS,_rM, RD,_r4)+#define MOVDMLrm(RS, MD, MB, MI, MS) __SSELrm( 0x7e, RS,_rM, MD, MB, MI, MS)++#define MOVDQ2Qrr(RS, RD) _SSELrr(0xf2, X86_SSE_MOV2, RS,_rX, RD,_rM)+#define MOVQ2DQrr(RS, RD) _SSELrr(0xf3, X86_SSE_MOV2, RS,_rM, RD,_rX)+#define MOVHLPSrr(RS, RD) __SSELrr( X86_SSE_MOVLP, RS,_rX, RD,_rX)+#define MOVLHPSrr(RS, RD) __SSELrr( X86_SSE_MOVHP, RS,_rX, RD,_rX)++#define MOVDQArr(RS, RD) _SSELrr(0x66, 0x6f, RS,_rX, RD,_rX)+#define MOVDQAmr(MD, MB, MI, MS, RD) _SSELmr(0x66, 0x6f, MD, MB, MI, MS, RD,_rX)+#define MOVDQArm(RS, MD, MB, MI, MS) _SSELrm(0x66, 0x7f, RS,_rX, MD, MB, MI, MS)++#define MOVDQUrr(RS, RD) _SSELrr(0xf3, 0x6f, RS,_rX, RD,_rX)+#define MOVDQUmr(MD, MB, MI, MS, RD) _SSELmr(0xf3, 0x6f, MD, MB, MI, MS, RD,_rX)+#define MOVDQUrm(RS, MD, MB, MI, MS) _SSELrm(0xf3, 0x7f, RS,_rX, MD, MB, MI, MS)++#define MOVHPDmr(MD, MB, MI, MS, RD) _SSELmr (0x66, X86_SSE_MOVHP, MD, MB, MI, MS, RD,_rX)+#define MOVHPDrm(RS, MD, MB, MI, MS) _SSEL1rm(0x66, X86_SSE_MOVHP, RS,_rX, MD, MB, MI, MS)+#define MOVHPSmr(MD, MB, MI, MS, RD) __SSELmr ( X86_SSE_MOVHP, MD, MB, MI, MS, RD,_rX)+#define MOVHPSrm(RS, MD, MB, MI, MS) __SSEL1rm( X86_SSE_MOVHP, RS,_rX, MD, MB, MI, MS)++#define MOVLPDmr(MD, MB, MI, MS, RD) _SSELmr (0x66, X86_SSE_MOVLP, MD, MB, MI, MS, RD,_rX)+#define MOVLPDrm(RS, MD, MB, MI, MS) _SSEL1rm(0x66, X86_SSE_MOVLP, RS,_rX, MD, MB, MI, MS)+#define MOVLPSmr(MD, MB, MI, MS, RD) __SSELmr ( X86_SSE_MOVLP, MD, MB, MI, MS, RD,_rX)+#define MOVLPSrm(RS, MD, MB, MI, MS) __SSEL1rm( X86_SSE_MOVLP, RS,_rX, MD, MB, MI, MS)++/*** References: */+/* */+/* [1] "Intel Architecture Software Developer's Manual Volume 1: Basic Architecture", */+/* Intel Corporation 1997. */+/* */+/* [2] "Intel Architecture Software Developer's Manual Volume 2: Instruction Set Reference", */+/* Intel Corporation 1997. */++#if LIGHTNING_CROSS \+ ? LIGHTNING_TARGET == LIGHTNING_X86_64 \+ : defined (__x86_64__)+#include "i386/asm-64.h"+#else+#include "i386/asm-32.h"+#endif++#endif+#endif /* __lightning_asm_i386_h */
@@ -0,0 +1,177 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer (i386 version)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.+ * Written by Paolo Bonzini and Matthew Flatt.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ *+ * GNU lightning is distributed in the hope that it will be useful, but+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ *+ * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_core_h+#define __lightning_core_h++#define JIT_CAN_16 1+#define JIT_AP _EBP++#define JIT_R_NUM 3+#define JIT_R(i) (_EAX + (i))+#define JIT_V_NUM 3+#define JIT_V(i) ((i) == 0 ? _EBX : _ESI + (i) - 1)++struct jit_local_state {+ int framesize;+ int argssize;+ int alloca_offset;+ int alloca_slack;+ jit_insn *finish_ref;+};++/* Whether a register is used for the user-accessible registers. */+#define jit_save(reg) 1++#define jit_base_prolog() (_jitl.framesize = 20, _jitl.alloca_offset = _jitl.alloca_slack = 0, _jitl.argssize = 0, \+ PUSHLr(_EBX), PUSHLr(_ESI), PUSHLr(_EDI), PUSHLr(_EBP), MOVLrr(_ESP, _EBP))+#define jit_base_ret(ofs) \+ (((ofs) < 0 ? LEAVE_() : POPLr(_EBP)), \+ POPLr(_EDI), POPLr(_ESI), POPLr(_EBX), RET_())++/* Used internally. SLACK is used by the Darwin ABI which keeps the stack+ aligned to 16-bytes. */++#define jit_allocai_internal(amount, slack) \+ (((amount) < _jitl.alloca_slack \+ ? (void)0 \+ : (void)(_jitl.alloca_slack += (amount) + (slack), \+ ((amount) + (slack) == sizeof (int) \+ ? PUSHLr(_EAX) \+ : SUBLir((amount) + (slack), _ESP)))), \+ _jitl.alloca_slack -= (amount), \+ _jitl.alloca_offset -= (amount))+ +/* Stack */+#define jit_pushr_i(rs) PUSHLr(rs)+#define jit_popr_i(rs) POPLr(rs)++/* The += in argssize allows for stack pollution */++#ifdef __APPLE__+/* Stack must stay 16-byte aligned: */+# define jit_prepare_i(ni) (((ni & 0x3) \+ ? (void)SUBLir(4 * ((((ni) + 3) & ~(0x3)) - (ni)), JIT_SP) \+ : (void)0), \+ _jitl.argssize += (((ni) + 3) & ~(0x3)))++#define jit_allocai(n) \+ jit_allocai_internal ((n), (_jitl.alloca_slack - (n)) & 15)++#define jit_prolog(n) (jit_base_prolog(), jit_subi_i (JIT_SP, JIT_SP, 12))+#define jit_ret() jit_base_ret (-12)++#else+# define jit_prepare_i(ni) (_jitl.argssize += (ni))++#define jit_allocai(n) \+ jit_allocai_internal ((n), 0)++#define jit_prolog(n) jit_base_prolog()+#define jit_ret() jit_base_ret (_jitl.alloca_offset)+#endif++#define jit_bare_ret() RET_()++#define jit_calli(label) (CALLm( ((unsigned long) (label))), _jit.x.pc)+#define jit_callr(reg) CALLsr(reg)++#define jit_pusharg_i(rs) PUSHLr(rs)+#define jit_finish(sub) (_jitl.finish_ref = jit_calli((sub)), ADDLir(sizeof(long) * _jitl.argssize, JIT_SP), _jitl.argssize = 0, _jitl.finish_ref)+#define jit_finishr(reg) (jit_callr((reg)), ADDLir(sizeof(long) * _jitl.argssize, JIT_SP), _jitl.argssize = 0)++#define jit_arg_c() ((_jitl.framesize += sizeof(int)) - sizeof(int))+#define jit_arg_uc() ((_jitl.framesize += sizeof(int)) - sizeof(int))+#define jit_arg_s() ((_jitl.framesize += sizeof(int)) - sizeof(int))+#define jit_arg_us() ((_jitl.framesize += sizeof(int)) - sizeof(int))+#define jit_arg_i() ((_jitl.framesize += sizeof(int)) - sizeof(int))+#define jit_arg_ui() ((_jitl.framesize += sizeof(int)) - sizeof(int))+#define jit_arg_l() ((_jitl.framesize += sizeof(long)) - sizeof(long))+#define jit_arg_ul() ((_jitl.framesize += sizeof(long)) - sizeof(long))+#define jit_arg_p() ((_jitl.framesize += sizeof(long)) - sizeof(long))++#define jit_movi_p(d, is) (MOVLir (((long)(is)), (d)), _jit.x.pc)+#define jit_patch_long_at(jump_pc,v) (*_PSL((jump_pc) - sizeof(long)) = _jit_SL((jit_insn *)(v) - (jump_pc)))+#define jit_patch_at(jump_pc,v) jit_patch_long_at(jump_pc, v)+#define jit_patch_calli(jump_pc,v) jit_patch_long_at(jump_pc, v)++/* Memory */+#define jit_replace(s, rep, op) \+ (jit_pushr_i(rep), \+ MOVLrr((s), (rep)), \+ op, jit_popr_i(rep))++#define jit_movbrm(rs, dd, db, di, ds) \+ (jit_check8(rs) \+ ? MOVBrm(jit_reg8(rs), dd, db, di, ds) \+ : jit_replace(rs, \+ ((dd != _EAX && db != _EAX && di != _EAX) ? _EAX : \+ ((dd != _ECX && db != _ECX && di != _ECX) ? _ECX : _EDX)), \+ MOVBrm(((dd != _EAX && db != _EAX && di != _EAX) ? _AL : \+ ((dd != _ECX && db != _ECX && di != _ECX) ? _CL : _DL)), \+ dd, db, di, ds)))++#define jit_ldr_c(d, rs) MOVSBLmr(0, (rs), 0, 0, (d))+#define jit_ldxr_c(d, s1, s2) MOVSBLmr(0, (s1), (s2), 1, (d))+ +#define jit_ldr_s(d, rs) MOVSWLmr(0, (rs), 0, 0, (d))+#define jit_ldxr_s(d, s1, s2) MOVSWLmr(0, (s1), (s2), 1, (d))+ +#define jit_ldi_c(d, is) MOVSBLmr((is), 0, 0, 0, (d))+#define jit_ldxi_c(d, rs, is) MOVSBLmr((is), (rs), 0, 0, (d))++#define jit_ldi_uc(d, is) MOVZBLmr((is), 0, 0, 0, (d))+#define jit_ldxi_uc(d, rs, is) MOVZBLmr((is), (rs), 0, 0, (d))++#define jit_sti_c(id, rs) jit_movbrm((rs), (id), 0, 0, 0)+#define jit_stxi_c(id, rd, rs) jit_movbrm((rs), (id), (rd), 0, 0)++#define jit_ldi_s(d, is) MOVSWLmr((is), 0, 0, 0, (d))+#define jit_ldxi_s(d, rs, is) MOVSWLmr((is), (rs), 0, 0, (d))++#define jit_ldi_us(d, is) MOVZWLmr((is), 0, 0, 0, (d))+#define jit_ldxi_us(d, rs, is) MOVZWLmr((is), (rs), 0, 0, (d))++#define jit_sti_s(id, rs) MOVWrm(jit_reg16(rs), (id), 0, 0, 0)+#define jit_stxi_s(id, rd, rs) MOVWrm(jit_reg16(rs), (id), (rd), 0, 0)++#define jit_ldi_i(d, is) MOVLmr((is), 0, 0, 0, (d))+#define jit_ldxi_i(d, rs, is) MOVLmr((is), (rs), 0, 0, (d))++#define jit_ldr_i(d, rs) MOVLmr(0, (rs), 0, 0, (d))+#define jit_ldxr_i(d, s1, s2) MOVLmr(0, (s1), (s2), 1, (d))+ +#define jit_sti_i(id, rs) MOVLrm((rs), (id), 0, 0, 0)+#define jit_stxi_i(id, rd, rs) MOVLrm((rs), (id), (rd), 0, 0)++#endif /* __lightning_core_h */
@@ -0,0 +1,499 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer (i386 version)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.+ * Written by Paolo Bonzini and Matthew Flatt.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ *+ * GNU lightning is distributed in the hope that it will be useful, but+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ *+ * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_core_h+#define __lightning_core_h++/* Used to implement ldc, stc, ... */+#define JIT_CAN_16 0+#define JIT_REXTMP _R12++/* Number or integer argument registers */+#define JIT_ARG_MAX 6++/* Number of float argument registers */+#define JIT_FP_ARG_MAX 8++#define JIT_R_NUM 3+#define JIT_R(i) ((i) == 0 ? _EAX : _R9 + (i))+#define JIT_V_NUM 3+#define JIT_V(i) ((i) == 0 ? _EBX : _R12 + (i))++struct jit_local_state {+ int long_jumps;+ int nextarg_getfp;+ int nextarg_putfp;+ int nextarg_geti;+ int nextarg_puti;+ int framesize;+ int argssize;+ int fprssize;+ int alloca_offset;+ int alloca_slack;+ jit_insn *finish_ref;+};++/* Whether a register in the "low" bank is used for the user-accessible+ registers. */+#define jit_save(reg) ((reg) == _EAX || (reg) == _EBX)++/* Keep the stack 16-byte aligned, the SSE hardware prefers it this way. */+#define jit_allocai_internal(amount, slack) \+ (((amount) < _jitl.alloca_slack \+ ? 0 \+ : (_jitl.alloca_slack += (amount) + (slack), \+ SUBQir((amount) + (slack), _ESP))), \+ _jitl.alloca_slack -= (amount), \+ _jitl.alloca_offset -= (amount))++#define jit_allocai(n) \+ jit_allocai_internal ((n), (_jitl.alloca_slack - (n)) & 15)++/* 3-parameter operation */+#define jit_qopr_(d, s1, s2, op1d, op2d) \+ ( ((s2) == (d)) ? op1d : \+ ( (((s1) == (d)) ? (void)0 : (void)MOVQrr((s1), (d))), op2d ) \+ )++/* 3-parameter operation, with immediate. TODO: fix the case where mmediate+ does not fit! */+#define jit_qop_small(d, s1, op2d) \+ (((s1) == (d)) ? op2d : (MOVQrr((s1), (d)), op2d))+#define jit_qop_(d, s1, is, op2d, op2i) \+ (_s32P((long)(is)) \+ ? jit_qop_small ((d), (s1), (op2d)) \+ : (MOVQir ((is), JIT_REXTMP), jit_qop_small ((d), (s1), (op2i))))++#define jit_bra_qr(s1, s2, op) (CMPQrr(s2, s1), op, _jit.x.pc)+#define _jit_bra_l(rs, is, op) (CMPQir(is, rs), op, _jit.x.pc)++#define jit_bra_l(rs, is, op) (_s32P((long)(is)) \+ ? _jit_bra_l(rs, is, op) \+ : (MOVQir(is, JIT_REXTMP), jit_bra_qr(rs, JIT_REXTMP, op)))++/* When CMP with 0 can be replaced with TEST */+#define jit_bra_l0(rs, is, op, op0) \+ ( (is) == 0 ? (TESTQrr(rs, rs), op0, _jit.x.pc) : jit_bra_l(rs, is, op))++#define jit_reduceQ(op, is, rs) \+ (_u8P(is) ? jit_reduce_(op##Bir(is, jit_reg8(rs))) : \+ jit_reduce_(op##Qir(is, rs)) )++#define jit_addi_l(d, rs, is) \+ /* Value is not zero? */ \+ ((is) \+ /* Yes. Value is unsigned and fits in signed 32 bits? */ \+ ? (_uiP(31, is) \+ /* Yes. d == rs? */ \+ ? jit_opi_((d), (rs), \+ /* Yes. Use add opcode */ \+ ADDQir((is), (d)), \+ /* No. Use lea opcode */ \+ LEAQmr((is), (rs), 0, 0, (d))) \+ /* No. Need value in a register */ \+ : (jit_movi_l(JIT_REXTMP, is), \+ jit_addr_l(d, rs, JIT_REXTMP))) \+ : jit_opi_((d),(rs),0,jit_movr_l(d, rs)))+#define jit_addr_l(d, s1, s2) jit_opo_((d), (s1), (s2), ADDQrr((s2), (d)), ADDQrr((s1), (d)), LEAQmr(0, (s1), (s2), 1, (d)) )+#define jit_addci_l(d, rs, is) jit_qop_ ((d), (rs), (is), ADCQir((is), (d)), ADCQrr(JIT_REXTMP, (d)))+#define jit_addcr_l(d, s1, s2) jit_qopr_((d), (s1), (s2), ADCQrr((s1), (d)), ADCQrr((s2), (d)) )+#define jit_addxi_l(d, rs, is) jit_qop_ ((d), (rs), (is), ADDQir((is), (d)), ADDQrr(JIT_REXTMP, (d)))+#define jit_addxr_l(d, s1, s2) jit_qopr_((d), (s1), (s2), ADDQrr((s1), (d)), ADDQrr((s2), (d)) )+#define jit_andi_l(d, rs, is) jit_qop_ ((d), (rs), (is), ANDQir((is), (d)), ANDQrr(JIT_REXTMP, (d)))+#define jit_andr_l(d, s1, s2) jit_qopr_((d), (s1), (s2), ANDQrr((s1), (d)), ANDQrr((s2), (d)) )+#define jit_orr_l(d, s1, s2) jit_qopr_((d), (s1), (s2), ORQrr((s1), (d)), ORQrr((s2), (d)) )+#define jit_subr_l(d, s1, s2) jit_qopr_((d), (s1), (s2), (SUBQrr((s1), (d)), NEGQr(d)), SUBQrr((s2), (d)) )+#define jit_xorr_l(d, s1, s2) jit_qopr_((d), (s1), (s2), XORQrr((s1), (d)), XORQrr((s2), (d)) )++/* These can sometimes use byte or word versions! */+#define jit_ori_l(d, rs, is) jit_qop_ ((d), (rs), (is), jit_reduceQ(OR, (is), (d)), ORQrr(JIT_REXTMP, (d)) )+#define jit_xori_l(d, rs, is) jit_qop_ ((d), (rs), (is), jit_reduceQ(XOR, (is), (d)), XORQrr(JIT_REXTMP, (d)) )++#define jit_lshi_l(d, rs, is) ((is) <= 3 ? LEAQmr(0, 0, (rs), 1 << (is), (d)) : jit_qop_small ((d), (rs), SHLQir((is), (d)) ))+#define jit_rshi_l(d, rs, is) jit_qop_small ((d), (rs), SARQir((is), (d)) )+#define jit_rshi_ul(d, rs, is) jit_qop_small ((d), (rs), SHRQir((is), (d)) )+#define jit_lshr_l(d, r1, r2) jit_shift((d), (r1), (r2), SHLQrr)+#define jit_rshr_l(d, r1, r2) jit_shift((d), (r1), (r2), SARQrr)+#define jit_rshr_ul(d, r1, r2) jit_shift((d), (r1), (r2), SHRQrr)+++/* Stack */+#define jit_pushr_i(rs) PUSHQr(rs)+#define jit_popr_i(rs) POPQr(rs)++/* A return address is 8 bytes, plus 5 registers = 40 bytes, total = 48 bytes. */+#define jit_prolog(n) (_jitl.framesize = ((n) & 1) ? 56 : 48, _jitl.nextarg_getfp = _jitl.nextarg_geti = 0, _jitl.alloca_offset = 0, \+ PUSHQr(_EBX), PUSHQr(_R12), PUSHQr(_R13), PUSHQr(_R14), PUSHQr(_EBP), MOVQrr(_ESP, _EBP))++#define jit_calli(sub) (MOVQir((long) (sub), JIT_REXTMP), _jitl.finish_ref = _jit.x.pc, CALLsr(JIT_REXTMP), _jitl.finish_ref)+#define jit_callr(reg) CALLsr((reg))++#define jit_prepare_i(ni) (_jitl.nextarg_puti = (ni), \+ _jitl.argssize = _jitl.nextarg_puti > JIT_ARG_MAX \+ ? _jitl.nextarg_puti - JIT_ARG_MAX : 0)+#define jit_pusharg_i(rs) (--_jitl.nextarg_puti >= JIT_ARG_MAX \+ ? PUSHQr(rs) : MOVQrr(rs, jit_arg_reg_order[_jitl.nextarg_puti]))++#define jit_finish(sub) (_jitl.fprssize \+ ? (MOVBir(_jitl.fprssize, _AL), _jitl.fprssize = 0) \+ : MOVBir(0, _AL), \+ ((_jitl.argssize & 1) \+ ? (PUSHQr(_EAX), ++_jitl.argssize) : 0), \+ jit_calli(sub), \+ (_jitl.argssize \+ ? (ADDQir(sizeof(long) * _jitl.argssize, JIT_SP), _jitl.argssize = 0) \+ : 0), \+ _jitl.finish_ref)+#define jit_reg_is_arg(reg) ((reg) == _ECX || (reg) == _EDX)++#define jit_finishr(reg) (_jitl.fprssize \+ ? (MOVBir(_jitl.fprssize, _AL), _jitl.fprssize = 0) \+ : MOVBir(0, _AL), \+ ((_jitl.argssize & 1) \+ ? (PUSHQr(_EAX), ++_jitl.argssize) : 0), \+ (jit_reg_is_arg((reg)) \+ ? (MOVQrr(reg, JIT_REXTMP), \+ jit_callr(JIT_REXTMP)) \+ : jit_callr(reg)), \+ (_jitl.argssize \+ ? (ADDQir(sizeof(long) * _jitl.argssize, JIT_SP), _jitl.argssize = 0) \+ : 0))++#define jit_retval_l(rd) ((void)jit_movr_l ((rd), _EAX))+#define jit_arg_i() (_jitl.nextarg_geti < JIT_ARG_MAX \+ ? _jitl.nextarg_geti++ \+ : (int) ((_jitl.framesize += sizeof(long)) - sizeof(long)))+#define jit_arg_c() jit_arg_i()+#define jit_arg_uc() jit_arg_i()+#define jit_arg_s() jit_arg_i()+#define jit_arg_us() jit_arg_i()+#define jit_arg_ui() jit_arg_i()+#define jit_arg_l() jit_arg_i()+#define jit_arg_ul() jit_arg_i()+#define jit_arg_p() jit_arg_i()++#define jit_getarg_c(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_extr_c_l((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_c((reg), JIT_FP, (ofs)))+#define jit_getarg_uc(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_extr_uc_ul((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_uc((reg), JIT_FP, (ofs)))+#define jit_getarg_s(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_extr_s_l((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_s((reg), JIT_FP, (ofs)))+#define jit_getarg_us(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_extr_us_ul((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_us((reg), JIT_FP, (ofs)))+#define jit_getarg_i(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_movr_l((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_i((reg), JIT_FP, (ofs)))+#define jit_getarg_ui(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_movr_ul((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_ui((reg), JIT_FP, (ofs)))+#define jit_getarg_l(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_movr_l((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_l((reg), JIT_FP, (ofs)))+#define jit_getarg_ul(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_movr_ul((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_ul((reg), JIT_FP, ofs))+#define jit_getarg_p(reg, ofs) ((ofs) < JIT_ARG_MAX \+ ? jit_movr_p((reg), jit_arg_reg_order[(ofs)]) \+ : jit_ldxi_p((reg), JIT_FP, (ofs)))++static int jit_arg_reg_order[] = { _EDI, _ESI, _EDX, _ECX, _R8D, _R9D };++#define jit_negr_l(d, rs) jit_opi_((d), (rs), NEGQr(d), (XORQrr((d), (d)), SUBQrr((rs), (d))) )+#define jit_movr_l(d, rs) ((void)((rs) == (d) ? 0 : MOVQrr((rs), (d))))+#define jit_movi_p(d, is) (MOVQir(((long)(is)), (d)), _jit.x.pc)+#define jit_movi_l(d, is) \+ /* Value is not zero? */ \+ ((is) \+ /* Yes. Value is unsigned and fits in signed 32 bits? */ \+ ? (_uiP(31, is) \+ /* Yes. Use 32 bits opcode */ \+ ? MOVLir(is, (d)) \+ /* No. Use 64 bits opcode */ \+ : MOVQir(is, (d))) \+ /* No. Set register to zero. */ \+ : XORQrr ((d), (d)))++#define jit_bmsr_l(label, s1, s2) (TESTQrr((s1), (s2)), JNZm(label), _jit.x.pc)+#define jit_bmcr_l(label, s1, s2) (TESTQrr((s1), (s2)), JZm(label), _jit.x.pc)+#define jit_boaddr_l(label, s1, s2) (ADDQrr((s2), (s1)), JOm(label), _jit.x.pc)+#define jit_bosubr_l(label, s1, s2) (SUBQrr((s2), (s1)), JOm(label), _jit.x.pc)+#define jit_boaddr_ul(label, s1, s2) (ADDQrr((s2), (s1)), JCm(label), _jit.x.pc)+#define jit_bosubr_ul(label, s1, s2) (SUBQrr((s2), (s1)), JCm(label), _jit.x.pc)++#define jit_boaddi_l(label, rs, is) (ADDQir((is), (rs)), JOm(label), _jit.x.pc)+#define jit_bosubi_l(label, rs, is) (SUBQir((is), (rs)), JOm(label), _jit.x.pc)+#define jit_boaddi_ul(label, rs, is) (ADDQir((is), (rs)), JCm(label), _jit.x.pc)+#define jit_bosubi_ul(label, rs, is) (SUBQir((is), (rs)), JCm(label), _jit.x.pc)++#define jit_patch_long_at(jump_pc,v) (*_PSL((jump_pc) - sizeof(long)) = _jit_SL((jit_insn *)(v)))+#define jit_patch_short_at(jump_pc,v) (*_PSI((jump_pc) - sizeof(int)) = _jit_SI((jit_insn *)(v) - (jump_pc)))+#define jit_patch_at(jump_pc,v) (_jitl.long_jumps ? jit_patch_long_at((jump_pc)-3, v) : jit_patch_short_at(jump_pc, v))+#define jit_patch_calli(pa,pv) (*_PSL((pa) - sizeof(long)) = _jit_SL((pv)))+#define jit_ret() (LEAVE_(), POPQr(_R14), POPQr(_R13), POPQr(_R12), POPQr(_EBX), RET_())+#define jit_bare_ret() RET_()++/* Memory */++/* Used to implement ldc, stc, ... We have SIL and friends which simplify it all. */+#define jit_movbrm(rs, dd, db, di, ds) MOVBrm(jit_reg8(rs), dd, db, di, ds)++#define jit_ldr_c(d, rs) MOVSBQmr(0, (rs), 0, 0, (d))+#define jit_ldxr_c(d, s1, s2) MOVSBQmr(0, (s1), (s2), 1, (d))+ +#define jit_ldr_s(d, rs) MOVSWQmr(0, (rs), 0, 0, (d))+#define jit_ldxr_s(d, s1, s2) MOVSWQmr(0, (s1), (s2), 1, (d))+ +#define jit_ldi_c(d, is) (_u32P((long)(is)) ? MOVSBQmr((is), 0, 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldr_c(d, JIT_REXTMP)))+#define jit_ldxi_c(d, rs, is) (_u32P((long)(is)) ? MOVSBQmr((is), (rs), 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldxr_c(d, rs, JIT_REXTMP)))++#define jit_ldi_uc(d, is) (_u32P((long)(is)) ? MOVZBLmr((is), 0, 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldr_uc(d, JIT_REXTMP)))+#define jit_ldxi_uc(d, rs, is) (_u32P((long)(is)) ? MOVZBLmr((is), (rs), 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldxr_uc(d, rs, JIT_REXTMP)))++#define jit_sti_c(id, rs) (_u32P((long)(id)) ? MOVBrm(jit_reg8(rs), (id), 0, 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_str_c(JIT_REXTMP, rs)))+#define jit_stxi_c(id, rd, rs) (_u32P((long)(id)) ? MOVBrm(jit_reg8(rs), (id), (rd), 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_stxr_c(JIT_REXTMP, rd, rs)))++#define jit_ldi_s(d, is) (_u32P((long)(is)) ? MOVSWQmr((is), 0, 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldr_s(d, JIT_REXTMP)))+#define jit_ldxi_s(d, rs, is) (_u32P((long)(is)) ? MOVSWQmr((is), (rs), 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldxr_s(d, rs, JIT_REXTMP)))++#define jit_ldi_us(d, is) (_u32P((long)(is)) ? MOVZWLmr((is), 0, 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldr_us(d, JIT_REXTMP)))+#define jit_ldxi_us(d, rs, is) (_u32P((long)(is)) ? MOVZWLmr((is), (rs), 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldxr_us(d, rs, JIT_REXTMP)))++#define jit_sti_s(id, rs) (_u32P((long)(id)) ? MOVWrm(jit_reg16(rs), (id), 0, 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_str_s(JIT_REXTMP, rs)))+#define jit_stxi_s(id, rd, rs) (_u32P((long)(id)) ? MOVWrm(jit_reg16(rs), (id), (rd), 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_stxr_s(JIT_REXTMP, rd, rs)))++#define jit_ldi_ui(d, is) (_u32P((long)(is)) ? MOVLmr((is), 0, 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldr_ui(d, JIT_REXTMP)))+#define jit_ldxi_ui(d, rs, is) (_u32P((long)(is)) ? MOVLmr((is), (rs), 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldxr_ui(d, rs, JIT_REXTMP)))++#define jit_ldi_i(d, is) (_u32P((long)(is)) ? MOVSLQmr((is), 0, 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldr_i(d, JIT_REXTMP)))+#define jit_ldxi_i(d, rs, is) (_u32P((long)(is)) ? MOVSLQmr((is), (rs), 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldxr_i(d, rs, JIT_REXTMP)))++#define jit_sti_i(id, rs) (_u32P((long)(id)) ? MOVLrm((rs), (id), 0, 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_str_i(JIT_REXTMP, rs)))+#define jit_stxi_i(id, rd, rs) (_u32P((long)(id)) ? MOVLrm((rs), (id), (rd), 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_stxr_i(JIT_REXTMP, rd, rs)))++#define jit_ldi_l(d, is) (_u32P((long)(is)) ? MOVQmr((is), 0, 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldr_l(d, JIT_REXTMP)))+#define jit_ldxi_l(d, rs, is) (_u32P((long)(is)) ? MOVQmr((is), (rs), 0, 0, (d)) : (jit_movi_l(JIT_REXTMP, is), jit_ldxr_l(d, rs, JIT_REXTMP)))++#define jit_sti_l(id, rs) (_u32P((long)(id)) ? MOVQrm((rs), (id), 0, 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_str_l(JIT_REXTMP, rs)))+#define jit_stxi_l(id, rd, rs) (_u32P((long)(id)) ? MOVQrm((rs), (id), (rd), 0, 0) : (jit_movi_l(JIT_REXTMP, id), jit_stxr_l(JIT_REXTMP, rd, rs)))++#define jit_ldr_ui(d, rs) MOVLmr(0, (rs), 0, 0, (d))+#define jit_ldxr_ui(d, s1, s2) MOVLmr(0, (s1), (s2), 1, (d))++#define jit_ldr_i(d, rs) MOVSLQmr(0, (rs), 0, 0, (d))+#define jit_ldxr_i(d, s1, s2) MOVSLQmr(0, (s1), (s2), 1, (d))++#define jit_ldr_l(d, rs) MOVQmr(0, (rs), 0, 0, (d))+#define jit_ldxr_l(d, s1, s2) MOVQmr(0, (s1), (s2), 1, (d))++#define jit_str_l(rd, rs) MOVQrm((rs), 0, (rd), 0, 0)+#define jit_stxr_l(d1, d2, rs) MOVQrm((rs), 0, (d1), (d2), 1)++#define jit_blti_l(label, rs, is) jit_bra_l0((rs), (is), JLm(label), JSm(label) )+#define jit_blei_l(label, rs, is) jit_bra_l ((rs), (is), JLEm(label) )+#define jit_bgti_l(label, rs, is) jit_bra_l ((rs), (is), JGm(label) )+#define jit_bgei_l(label, rs, is) jit_bra_l0((rs), (is), JGEm(label), JNSm(label) )+#define jit_beqi_l(label, rs, is) jit_bra_l0((rs), (is), JEm(label), JEm(label) )+#define jit_bnei_l(label, rs, is) jit_bra_l0((rs), (is), JNEm(label), JNEm(label) )+#define jit_blti_ul(label, rs, is) jit_bra_l ((rs), (is), JBm(label) )+#define jit_blei_ul(label, rs, is) jit_bra_l0((rs), (is), JBEm(label), JEm(label) )+#define jit_bgti_ul(label, rs, is) jit_bra_l0((rs), (is), JAm(label), JNEm(label) )+#define jit_bgei_ul(label, rs, is) jit_bra_l ((rs), (is), JAEm(label) )+#define jit_bmsi_l(label, rs, is) (jit_reduceQ(TEST, (is), (rs)), JNZm(label), _jit.x.pc)+#define jit_bmci_l(label, rs, is) (jit_reduceQ(TEST, (is), (rs)), JZm(label), _jit.x.pc)++#define jit_pushr_l(rs) jit_pushr_i(rs)+#define jit_popr_l(rs) jit_popr_i(rs)++#define jit_pusharg_l(rs) jit_pusharg_i(rs)+#define jit_retval_l(rd) ((void)jit_movr_l ((rd), _EAX))+#define jit_bltr_l(label, s1, s2) jit_bra_qr((s1), (s2), JLm(label) )+#define jit_bler_l(label, s1, s2) jit_bra_qr((s1), (s2), JLEm(label) )+#define jit_bgtr_l(label, s1, s2) jit_bra_qr((s1), (s2), JGm(label) )+#define jit_bger_l(label, s1, s2) jit_bra_qr((s1), (s2), JGEm(label) )+#define jit_beqr_l(label, s1, s2) jit_bra_qr((s1), (s2), JEm(label) )+#define jit_bner_l(label, s1, s2) jit_bra_qr((s1), (s2), JNEm(label) )+#define jit_bltr_ul(label, s1, s2) jit_bra_qr((s1), (s2), JBm(label) )+#define jit_bler_ul(label, s1, s2) jit_bra_qr((s1), (s2), JBEm(label) )+#define jit_bgtr_ul(label, s1, s2) jit_bra_qr((s1), (s2), JAm(label) )+#define jit_bger_ul(label, s1, s2) jit_bra_qr((s1), (s2), JAEm(label) )++/* Bool operations. */+#define jit_bool_qr(d, s1, s2, op) \+ (jit_replace8(d, CMPQrr(s2, s1), op))++#define jit_bool_qi(d, rs, is, op) \+ (jit_replace8(d, CMPQir(is, rs), op))++/* When CMP with 0 can be replaced with TEST */+#define jit_bool_qi0(d, rs, is, op, op0) \+ ((is) != 0 \+ ? (jit_replace8(d, CMPQir(is, rs), op)) \+ : (jit_replace8(d, TESTQrr(rs, rs), op0)))++#define jit_ltr_l(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETLr )+#define jit_ler_l(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETLEr )+#define jit_gtr_l(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETGr )+#define jit_ger_l(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETGEr )+#define jit_eqr_l(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETEr )+#define jit_ner_l(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETNEr )+#define jit_ltr_ul(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETBr )+#define jit_ler_ul(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETBEr )+#define jit_gtr_ul(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETAr )+#define jit_ger_ul(d, s1, s2) jit_bool_qr((d), (s1), (s2), SETAEr )++#define jit_lti_l(d, rs, is) jit_bool_qi0((d), (rs), (is), SETLr, SETSr )+#define jit_lei_l(d, rs, is) jit_bool_qi ((d), (rs), (is), SETLEr )+#define jit_gti_l(d, rs, is) jit_bool_qi ((d), (rs), (is), SETGr )+#define jit_gei_l(d, rs, is) jit_bool_qi0((d), (rs), (is), SETGEr, SETNSr )+#define jit_eqi_l(d, rs, is) jit_bool_qi0((d), (rs), (is), SETEr, SETEr )+#define jit_nei_l(d, rs, is) jit_bool_qi0((d), (rs), (is), SETNEr, SETNEr )+#define jit_lti_ul(d, rs, is) jit_bool_qi ((d), (rs), (is), SETBr )+#define jit_lei_ul(d, rs, is) jit_bool_qi0((d), (rs), (is), SETBEr, SETEr )+#define jit_gti_ul(d, rs, is) jit_bool_qi0((d), (rs), (is), SETAr, SETNEr )+#define jit_gei_ul(d, rs, is) jit_bool_qi0((d), (rs), (is), SETAEr, INCLr )++/* Multiplication/division. */+#define jit_mulr_ul_(s1, s2) \+ jit_qopr_(_RAX, s1, s2, MULQr(s1), MULQr(s2))++#define jit_mulr_l_(s1, s2) \+ jit_qopr_(_RAX, s1, s2, IMULQr(s1), IMULQr(s2))++#define jit_muli_l_(is, rs) \+ (MOVQir(is, rs == _RAX ? _RDX : _RAX), \+ IMULQr(rs == _RAX ? _RDX : rs))++#define jit_muli_ul_(is, rs) \+ (MOVQir(is, rs == _RAX ? _RDX : _RAX), \+ IMULQr(rs == _RAX ? _RDX : rs))++#define jit_divi_l_(result, d, rs, is) \+ (jit_might (d, _RAX, jit_pushr_l(_RAX)), \+ jit_might (d, _RCX, jit_pushr_l(_RCX)), \+ jit_might (d, _RDX, jit_pushr_l(_RDX)), \+ jit_might (rs, _RAX, MOVQrr(rs, _RAX)), \+ jit_might (rs, _RDX, MOVQrr(rs, _RDX)), \+ MOVQir(is, _RCX), \+ SARQir(63, _RDX), \+ IDIVQr(_RCX), \+ jit_might(d, result, MOVQrr(result, d)), \+ jit_might(d, _RDX, jit_popr_l(_RDX)), \+ jit_might(d, _RCX, jit_popr_l(_RCX)), \+ jit_might(d, _RAX, jit_popr_l(_RAX)))++#define jit_divr_l_(result, d, s1, s2) \+ (jit_might (d, _RAX, jit_pushr_l(_RAX)), \+ jit_might (d, _RCX, jit_pushr_l(_RCX)), \+ jit_might (d, _RDX, jit_pushr_l(_RDX)), \+ ((s1 == _RCX) ? jit_pushr_l(_RCX) : 0), \+ jit_might (s2, _RCX, MOVQrr(s2, _RCX)), \+ ((s1 == _RCX) ? jit_popr_l(_RDX) : \+ jit_might (s1, _RDX, MOVQrr(s1, _RDX))), \+ MOVQrr(_RDX, _RAX), \+ SARQir(63, _RDX), \+ IDIVQr(_RCX), \+ jit_might(d, result, MOVQrr(result, d)), \+ jit_might(d, _RDX, jit_popr_l(_RDX)), \+ jit_might(d, _RCX, jit_popr_l(_RCX)), \+ jit_might(d, _RAX, jit_popr_l(_RAX)))++#define jit_divi_ul_(result, d, rs, is) \+ (jit_might (d, _RAX, jit_pushr_l(_RAX)), \+ jit_might (d, _RCX, jit_pushr_l(_RCX)), \+ jit_might (d, _RDX, jit_pushr_l(_RDX)), \+ jit_might (rs, _RAX, MOVQrr(rs, _RAX)), \+ MOVQir(is, _RCX), \+ XORQrr(_RDX, _RDX), \+ DIVQr(_RCX), \+ jit_might(d, result, MOVQrr(result, d)), \+ jit_might(d, _RDX, jit_popr_l(_RDX)), \+ jit_might(d, _RCX, jit_popr_l(_RCX)), \+ jit_might(d, _RAX, jit_popr_l(_RAX)))++#define jit_divr_ul_(result, d, s1, s2) \+ (jit_might (d, _RAX, jit_pushr_l(_RAX)), \+ jit_might (d, _RCX, jit_pushr_l(_RCX)), \+ jit_might (d, _RDX, jit_pushr_l(_RDX)), \+ ((s1 == _RCX) ? jit_pushr_l(_RCX) : 0), \+ jit_might (s2, _RCX, MOVQrr(s2, _RCX)), \+ ((s1 == _RCX) ? jit_popr_l(_RAX) : \+ jit_might (s1, _RAX, MOVQrr(s1, _RAX))), \+ XORQrr(_RDX, _RDX), \+ DIVQr(_RCX), \+ jit_might(d, result, MOVQrr(result, d)), \+ jit_might(d, _RDX, jit_popr_l(_RDX)), \+ jit_might(d, _RCX, jit_popr_l(_RCX)), \+ jit_might(d, _RAX, jit_popr_l(_RAX)))++#define jit_muli_l(d, rs, is) jit_qop_ ((d), (rs), (is), IMULQir((is), (d)), IMULQrr(JIT_REXTMP, (d)) )+#define jit_mulr_l(d, s1, s2) jit_qopr_((d), (s1), (s2), IMULQrr((s1), (d)), IMULQrr((s2), (d)) )++/* As far as low bits are concerned, signed and unsigned multiplies are+ exactly the same. */+#define jit_muli_ul(d, rs, is) jit_qop_ ((d), (rs), (is), IMULQir((is), (d)), IMULQrr(JIT_REXTMP, (d)) )+#define jit_mulr_ul(d, s1, s2) jit_qopr_((d), (s1), (s2), IMULQrr((s1), (d)), IMULQrr((s2), (d)) )++#define jit_hmuli_l(d, rs, is) \+ ((d) == _RDX ? ( jit_pushr_l(_RAX), jit_muli_l_((is), (rs)), jit_popr_l(_RAX) ) : \+ ((d) == _RAX ? (jit_pushr_l(_RDX), jit_muli_l_((is), (rs)), MOVQrr(_RDX, _RAX), jit_popr_l(_RDX) ) : \+ (jit_pushr_l(_RDX), jit_pushr_l(_RAX), jit_muli_l_((is), (rs)), MOVQrr(_RDX, (d)), jit_popr_l(_RAX), jit_popr_l(_RDX) )))++#define jit_hmulr_l(d, s1, s2) \+ ((d) == _RDX ? ( jit_pushr_l(_RAX), jit_mulr_l_((s1), (s2)), jit_popr_l(_RAX) ) : \+ ((d) == _RAX ? (jit_pushr_l(_RDX), jit_mulr_l_((s1), (s2)), MOVQrr(_RDX, _RAX), jit_popr_l(_RDX) ) : \+ (jit_pushr_l(_RDX), jit_pushr_l(_RAX), jit_mulr_l_((s1), (s2)), MOVQrr(_RDX, (d)), jit_popr_l(_RAX), jit_popr_l(_RDX) )))++#define jit_hmuli_ul(d, rs, is) \+ ((d) == _RDX ? ( jit_pushr_l(_RAX), jit_muli_ul_((is), (rs)), jit_popr_l(_RAX) ) : \+ ((d) == _RAX ? (jit_pushr_l(_RDX), jit_muli_ul_((is), (rs)), MOVQrr(_RDX, _RAX), jit_popr_l(_RDX) ) : \+ (jit_pushr_l(_RDX), jit_pushr_l(_RAX), jit_muli_ul_((is), (rs)), MOVQrr(_RDX, (d)), jit_popr_l(_RAX), jit_popr_l(_RDX) )))++#define jit_hmulr_ul(d, s1, s2) \+ ((d) == _RDX ? ( jit_pushr_l(_RAX), jit_mulr_ul_((s1), (s2)), jit_popr_l(_RAX) ) : \+ ((d) == _RAX ? (jit_pushr_l(_RDX), jit_mulr_ul_((s1), (s2)), MOVQrr(_RDX, _RAX), jit_popr_l(_RDX) ) : \+ (jit_pushr_l(_RDX), jit_pushr_l(_RAX), jit_mulr_ul_((s1), (s2)), MOVQrr(_RDX, (d)), jit_popr_l(_RAX), jit_popr_l(_RDX) )))++#define jit_divi_l(d, rs, is) jit_divi_l_(_RAX, (d), (rs), (is))+#define jit_divi_ul(d, rs, is) jit_divi_ul_(_RAX, (d), (rs), (is))+#define jit_modi_l(d, rs, is) jit_divi_l_(_RDX, (d), (rs), (is))+#define jit_modi_ul(d, rs, is) jit_divi_ul_(_RDX, (d), (rs), (is))+#define jit_divr_l(d, s1, s2) jit_divr_l_(_RAX, (d), (s1), (s2))+#define jit_divr_ul(d, s1, s2) jit_divr_ul_(_RAX, (d), (s1), (s2))+#define jit_modr_l(d, s1, s2) jit_divr_l_(_RDX, (d), (s1), (s2))+#define jit_modr_ul(d, s1, s2) jit_divr_ul_(_RDX, (d), (s1), (s2))++#endif /* __lightning_core_h */
@@ -0,0 +1,366 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer (i386 version)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.+ * Written by Paolo Bonzini and Matthew Flatt.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ *+ * GNU lightning is distributed in the hope that it will be useful, but+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ *+ * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_core_i386_h+#define __lightning_core_i386_h++#define JIT_FP _EBP+#define JIT_SP _ESP+#define JIT_RET _EAX+++/* 3-parameter operation */+#define jit_opr_(d, s1, s2, op1d, op2d) \+ ( (s2 == d) ? op1d : \+ ( ((s1 == d) ? (void)0 : (void)MOVLrr(s1, d)), op2d ) \+ )++/* 3-parameter operation, with immediate */+#define jit_op_(d, s1, op2d) \+ ((s1 == d) ? op2d : (MOVLrr(s1, d), op2d))++/* 3-parameter operation, optimizable */+#define jit_opo_(d, s1, s2, op1d, op2d, op12d) \+ ((s2 == d) ? op2d : \+ ((s1 == d) ? op1d : op12d))++/* 3-parameter operation, optimizable, with immediate */+#define jit_opi_(d, rs, opdi, opdri) \+ ((rs == d) ? opdi : opdri)++/* For LT, LE, ... */+#define jit_replace8(d, cmp, op) \+ (jit_check8(d) \+ ? ((cmp), \+ MOVLir(0, (d)), \+ op(_rR(d) | _AL)) \+ : (jit_pushr_i(_EAX), (cmp), \+ MOVLir(0, _EAX), \+ op(_AL), MOVLrr(_EAX, (d)), jit_popr_i(_EAX)))++#define jit_bool_r(d, s1, s2, op) \+ (jit_replace8(d, CMPLrr(s2, s1), op))++#define jit_bool_i(d, rs, is, op) \+ (jit_replace8(d, CMPLir(is, rs), op))++/* When CMP with 0 can be replaced with TEST */+#define jit_bool_i0(d, rs, is, op, op0) \+ ((is) != 0 \+ ? (jit_replace8(d, CMPLir(is, rs), op)) \+ : (jit_replace8(d, TESTLrr(rs, rs), op0)))++/* For BLT, BLE, ... */+#define jit_bra_r(s1, s2, op) (CMPLrr(s2, s1), op, _jit.x.pc)+#define jit_bra_i(rs, is, op) (CMPLir(is, rs), op, _jit.x.pc)++/* When CMP with 0 can be replaced with TEST */+#define jit_bra_i0(rs, is, op, op0) \+ ( (is) == 0 ? (TESTLrr(rs, rs), op0, _jit.x.pc) : (CMPLir(is, rs), op, _jit.x.pc))++/* Reduce arguments of XOR/OR/TEST */+#define jit_reduce_(op) op+#define jit_reduce(op, is, rs) \+ (_u8P(is) && jit_check8(rs) ? jit_reduce_(op##Bir(is, jit_reg8(rs))) : \+ (_u16P(is) && JIT_CAN_16 ? jit_reduce_(op##Wir(is, jit_reg16(rs))) : \+ jit_reduce_(op##Lir(is, rs)) ))++/* Helper macros for MUL/DIV/IDIV */+#define jit_might(d, s1, op) \+ ((s1 == d) ? 0 : op)++#define jit_mulr_ui_(s1, s2) jit_opr_(_EAX, s1, s2, MULLr(s1), MULLr(s2))+#define jit_mulr_i_(s1, s2) jit_opr_(_EAX, s1, s2, IMULLr(s1), IMULLr(s2))+++#define jit_muli_i_(is, rs) \+ (MOVLir(is, rs == _EAX ? _EDX : _EAX), \+ IMULLr(rs == _EAX ? _EDX : rs))++#define jit_muli_ui_(is, rs) \+ (MOVLir(is, rs == _EAX ? _EDX : _EAX), \+ IMULLr(rs == _EAX ? _EDX : rs))++#define jit_divi_i_(result, d, rs, is) \+ (jit_might (d, _EAX, jit_pushr_i(_EAX)), \+ jit_might (d, _ECX, jit_pushr_i(_ECX)), \+ jit_might (d, _EDX, jit_pushr_i(_EDX)), \+ jit_might (rs, _EAX, MOVLrr(rs, _EAX)), \+ jit_might (rs, _EDX, MOVLrr(rs, _EDX)), \+ MOVLir(is, _ECX), \+ SARLir(31, _EDX), \+ IDIVLr(_ECX), \+ jit_might(d, result, MOVLrr(result, d)), \+ jit_might(d, _EDX, jit_popr_i(_EDX)), \+ jit_might(d, _ECX, jit_popr_i(_ECX)), \+ jit_might(d, _EAX, jit_popr_i(_EAX)))++#define jit_divr_i_(result, d, s1, s2) \+ (jit_might (d, _EAX, jit_pushr_i(_EAX)), \+ jit_might (d, _ECX, jit_pushr_i(_ECX)), \+ jit_might (d, _EDX, jit_pushr_i(_EDX)), \+ ((s1 == _ECX) ? jit_pushr_i(_ECX) : 0), \+ jit_might (s2, _ECX, MOVLrr(s2, _ECX)), \+ ((s1 == _ECX) ? jit_popr_i(_EDX) : \+ jit_might (s1, _EDX, MOVLrr(s1, _EDX))), \+ MOVLrr(_EDX, _EAX), \+ SARLir(31, _EDX), \+ IDIVLr(_ECX), \+ jit_might(d, result, MOVLrr(result, d)), \+ jit_might(d, _EDX, jit_popr_i(_EDX)), \+ jit_might(d, _ECX, jit_popr_i(_ECX)), \+ jit_might(d, _EAX, jit_popr_i(_EAX)))++#define jit_divi_ui_(result, d, rs, is) \+ (jit_might (d, _EAX, jit_pushr_i(_EAX)), \+ jit_might (d, _ECX, jit_pushr_i(_ECX)), \+ jit_might (d, _EDX, jit_pushr_i(_EDX)), \+ jit_might (rs, _EAX, MOVLrr(rs, _EAX)), \+ MOVLir(is, _ECX), \+ XORLrr(_EDX, _EDX), \+ DIVLr(_ECX), \+ jit_might(d, result, MOVLrr(result, d)), \+ jit_might(d, _EDX, jit_popr_i(_EDX)), \+ jit_might(d, _ECX, jit_popr_i(_ECX)), \+ jit_might(d, _EAX, jit_popr_i(_EAX)))++#define jit_divr_ui_(result, d, s1, s2) \+ (jit_might (d, _EAX, jit_pushr_i(_EAX)), \+ jit_might (d, _ECX, jit_pushr_i(_ECX)), \+ jit_might (d, _EDX, jit_pushr_i(_EDX)), \+ ((s1 == _ECX) ? jit_pushr_i(_ECX) : 0), \+ jit_might (s2, _ECX, MOVLrr(s2, _ECX)), \+ ((s1 == _ECX) ? jit_popr_i(_EAX) : \+ jit_might (s1, _EAX, MOVLrr(s1, _EAX))), \+ XORLrr(_EDX, _EDX), \+ DIVLr(_ECX), \+ jit_might(d, result, MOVLrr(result, d)), \+ jit_might(d, _EDX, jit_popr_i(_EDX)), \+ jit_might(d, _ECX, jit_popr_i(_ECX)), \+ jit_might(d, _EAX, jit_popr_i(_EAX)))+++/* ALU */+#define jit_addi_i(d, rs, is) jit_opi_((d), (rs), ADDLir((is), (d)), LEALmr((is), (rs), 0, 0, (d)) )+#define jit_addr_i(d, s1, s2) jit_opo_((d), (s1), (s2), ADDLrr((s2), (d)), ADDLrr((s1), (d)), LEALmr(0, (s1), (s2), 1, (d)) )+#define jit_addci_i(d, rs, is) jit_op_ ((d), (rs), ADDLir((is), (d)) )+#define jit_addcr_i(d, s1, s2) jit_opr_((d), (s1), (s2), ADDLrr((s1), (d)), ADDLrr((s2), (d)) )+#define jit_addxi_i(d, rs, is) jit_op_ ((d), (rs), ADCLir((is), (d)) )+#define jit_addxr_i(d, s1, s2) jit_opr_((d), (s1), (s2), ADCLrr((s1), (d)), ADCLrr((s2), (d)) )+#define jit_andi_i(d, rs, is) jit_op_ ((d), (rs), ANDLir((is), (d)) )+#define jit_andr_i(d, s1, s2) jit_opr_((d), (s1), (s2), ANDLrr((s1), (d)), ANDLrr((s2), (d)) )+#define jit_orr_i(d, s1, s2) jit_opr_((d), (s1), (s2), ORLrr((s1), (d)), ORLrr((s2), (d)) )+#define jit_subr_i(d, s1, s2) jit_opr_((d), (s1), (s2), (SUBLrr((s1), (d)), NEGLr(d)), SUBLrr((s2), (d)) )+#define jit_subcr_i(d, s1, s2) jit_subr_i((d), (s1), (s2))+#define jit_subxr_i(d, s1, s2) jit_opr_((d), (s1), (s2), SBBLrr((s1), (d)), SBBLrr((s2), (d)) )+#define jit_subxi_i(d, rs, is) jit_op_ ((d), (rs), SBBLir((is), (d)) )+#define jit_xorr_i(d, s1, s2) jit_opr_((d), (s1), (s2), XORLrr((s1), (d)), XORLrr((s2), (d)) )+++/* These can sometimes use byte or word versions! */+#define jit_ori_i(d, rs, is) jit_op_ ((d), (rs), jit_reduce(OR, (is), (d)) )+#define jit_xori_i(d, rs, is) jit_op_ ((d), (rs), jit_reduce(XOR, (is), (d)) )++#define jit_muli_i(d, rs, is) jit_op_ ((d), (rs), IMULLir((is), (d)) )+#define jit_mulr_i(d, s1, s2) jit_opr_((d), (s1), (s2), IMULLrr((s1), (d)), IMULLrr((s2), (d)) )++/* As far as low bits are concerned, signed and unsigned multiplies are+ exactly the same. */+#define jit_muli_ui(d, rs, is) jit_op_ ((d), (rs), IMULLir((is), (d)) )+#define jit_mulr_ui(d, s1, s2) jit_opr_((d), (s1), (s2), IMULLrr((s1), (d)), IMULLrr((s2), (d)) )++#define jit_hmuli_i(d, rs, is) \+ ((d) == _EDX ? ( jit_pushr_i(_EAX), jit_muli_i_((is), (rs)), jit_popr_i(_EAX) ) : \+ ((d) == _EAX ? (jit_pushr_i(_EDX), jit_muli_i_((is), (rs)), MOVLrr(_EDX, _EAX), jit_popr_i(_EDX) ) : \+ (jit_pushr_i(_EDX), jit_pushr_i(_EAX), jit_muli_i_((is), (rs)), MOVLrr(_EDX, (d)), jit_popr_i(_EAX), jit_popr_i(_EDX) )))++#define jit_hmulr_i(d, s1, s2) \+ ((d) == _EDX ? ( jit_pushr_i(_EAX), jit_mulr_i_((s1), (s2)), jit_popr_i(_EAX) ) : \+ ((d) == _EAX ? (jit_pushr_i(_EDX), jit_mulr_i_((s1), (s2)), MOVLrr(_EDX, _EAX), jit_popr_i(_EDX) ) : \+ (jit_pushr_i(_EDX), jit_pushr_i(_EAX), jit_mulr_i_((s1), (s2)), MOVLrr(_EDX, (d)), jit_popr_i(_EAX), jit_popr_i(_EDX) )))++#define jit_hmuli_ui(d, rs, is) \+ ((d) == _EDX ? ( jit_pushr_i(_EAX), jit_muli_ui_((is), (rs)), jit_popr_i(_EAX) ) : \+ ((d) == _EAX ? (jit_pushr_i(_EDX), jit_muli_ui_((is), (rs)), MOVLrr(_EDX, _EAX), jit_popr_i(_EDX) ) : \+ (jit_pushr_i(_EDX), jit_pushr_i(_EAX), jit_muli_ui_((is), (rs)), MOVLrr(_EDX, (d)), jit_popr_i(_EAX), jit_popr_i(_EDX) )))++#define jit_hmulr_ui(d, s1, s2) \+ ((d) == _EDX ? ( jit_pushr_i(_EAX), jit_mulr_ui_((s1), (s2)), jit_popr_i(_EAX) ) : \+ ((d) == _EAX ? (jit_pushr_i(_EDX), jit_mulr_ui_((s1), (s2)), MOVLrr(_EDX, _EAX), jit_popr_i(_EDX) ) : \+ (jit_pushr_i(_EDX), jit_pushr_i(_EAX), jit_mulr_ui_((s1), (s2)), MOVLrr(_EDX, (d)), jit_popr_i(_EAX), jit_popr_i(_EDX) )))++#define jit_divi_i(d, rs, is) jit_divi_i_(_EAX, (d), (rs), (is))+#define jit_divi_ui(d, rs, is) jit_divi_ui_(_EAX, (d), (rs), (is))+#define jit_modi_i(d, rs, is) jit_divi_i_(_EDX, (d), (rs), (is))+#define jit_modi_ui(d, rs, is) jit_divi_ui_(_EDX, (d), (rs), (is))+#define jit_divr_i(d, s1, s2) jit_divr_i_(_EAX, (d), (s1), (s2))+#define jit_divr_ui(d, s1, s2) jit_divr_ui_(_EAX, (d), (s1), (s2))+#define jit_modr_i(d, s1, s2) jit_divr_i_(_EDX, (d), (s1), (s2))+#define jit_modr_ui(d, s1, s2) jit_divr_ui_(_EDX, (d), (s1), (s2))+++/* Shifts */+#define jit_shift(d, s1, s2, m) \+ ((d) == _ECX || (d) == (s2) \+ ? ((s2) == _EAX \+ ? jit_fixd(d, _EDX, jit_shift2(_EDX, s1, s2, m)) \+ : jit_fixd(d, _EAX, jit_shift2(_EAX, s1, s2, m))) \+ : jit_shift2(d, s1, s2, m))++/* Shift operation, assuming d != s2 or ECX */+#define jit_shift2(d, s1, s2, m) \+ jit_op_(d, s1, jit_cfixs(s2, _ECX, m(_CL, d)))++/* Substitute x for destination register d */+#define jit_fixd(d, x, op) \+ (jit_pushr_i(x), op, jit_movr_i(d, x), jit_popr_i(x))++/* Conditionally substitute y for source register s */+#define jit_cfixs(s, y, op) \+ ((s) == (y) ? op : \+ (jit_pushr_i(y), jit_movr_i(y, s), op, jit_popr_i(y)))++#define jit_lshi_i(d, rs, is) ((is) <= 3 ? LEALmr(0, 0, (rs), 1 << (is), (d)) : jit_op_ ((d), (rs), SHLLir((is), (d)) ))+#define jit_rshi_i(d, rs, is) jit_op_ ((d), (rs), SARLir((is), (d)) )+#define jit_rshi_ui(d, rs, is) jit_op_ ((d), (rs), SHRLir((is), (d)) )+#define jit_lshr_i(d, r1, r2) jit_shift((d), (r1), (r2), SHLLrr)+#define jit_rshr_i(d, r1, r2) jit_shift((d), (r1), (r2), SARLrr)+#define jit_rshr_ui(d, r1, r2) jit_shift((d), (r1), (r2), SHRLrr)++/* Stack */+#define jit_retval_i(rd) ((void)jit_movr_i ((rd), _EAX))++/* Unary */+#define jit_negr_i(d, rs) jit_opi_((d), (rs), NEGLr(d), (XORLrr((d), (d)), SUBLrr((rs), (d))) )++#define jit_movr_i(d, rs) ((void)((rs) == (d) ? 0 : MOVLrr((rs), (d))))+#define jit_movi_i(d, is) ((is) ? MOVLir((is), (d)) : XORLrr ((d), (d)) )+#define jit_patch_movi(pa,pv) (*_PSL((pa) - sizeof(long)) = _jit_SL((pv)))++#define jit_ntoh_ui(d, rs) jit_op_((d), (rs), BSWAPLr(d))+#define jit_ntoh_us(d, rs) jit_op_((d), (rs), RORWir(8, d))++/* Boolean */+#define jit_ltr_i(d, s1, s2) jit_bool_r((d), (s1), (s2), SETLr )+#define jit_ler_i(d, s1, s2) jit_bool_r((d), (s1), (s2), SETLEr )+#define jit_gtr_i(d, s1, s2) jit_bool_r((d), (s1), (s2), SETGr )+#define jit_ger_i(d, s1, s2) jit_bool_r((d), (s1), (s2), SETGEr )+#define jit_eqr_i(d, s1, s2) jit_bool_r((d), (s1), (s2), SETEr )+#define jit_ner_i(d, s1, s2) jit_bool_r((d), (s1), (s2), SETNEr )+#define jit_ltr_ui(d, s1, s2) jit_bool_r((d), (s1), (s2), SETBr )+#define jit_ler_ui(d, s1, s2) jit_bool_r((d), (s1), (s2), SETBEr )+#define jit_gtr_ui(d, s1, s2) jit_bool_r((d), (s1), (s2), SETAr )+#define jit_ger_ui(d, s1, s2) jit_bool_r((d), (s1), (s2), SETAEr )++#define jit_lti_i(d, rs, is) jit_bool_i0((d), (rs), (is), SETLr, SETSr )+#define jit_lei_i(d, rs, is) jit_bool_i ((d), (rs), (is), SETLEr )+#define jit_gti_i(d, rs, is) jit_bool_i ((d), (rs), (is), SETGr )+#define jit_gei_i(d, rs, is) jit_bool_i0((d), (rs), (is), SETGEr, SETNSr )+#define jit_eqi_i(d, rs, is) jit_bool_i0((d), (rs), (is), SETEr, SETEr )+#define jit_nei_i(d, rs, is) jit_bool_i0((d), (rs), (is), SETNEr, SETNEr )+#define jit_lti_ui(d, rs, is) jit_bool_i ((d), (rs), (is), SETBr )+#define jit_lei_ui(d, rs, is) jit_bool_i0((d), (rs), (is), SETBEr, SETEr )+#define jit_gti_ui(d, rs, is) jit_bool_i0((d), (rs), (is), SETAr, SETNEr )+#define jit_gei_ui(d, rs, is) jit_bool_i0((d), (rs), (is), SETAEr, INCLr )++/* Jump */+#define jit_bltr_i(label, s1, s2) jit_bra_r((s1), (s2), JLm(label) )+#define jit_bler_i(label, s1, s2) jit_bra_r((s1), (s2), JLEm(label) )+#define jit_bgtr_i(label, s1, s2) jit_bra_r((s1), (s2), JGm(label) )+#define jit_bger_i(label, s1, s2) jit_bra_r((s1), (s2), JGEm(label) )+#define jit_beqr_i(label, s1, s2) jit_bra_r((s1), (s2), JEm(label) )+#define jit_bner_i(label, s1, s2) jit_bra_r((s1), (s2), JNEm(label) )+#define jit_bltr_ui(label, s1, s2) jit_bra_r((s1), (s2), JBm(label) )+#define jit_bler_ui(label, s1, s2) jit_bra_r((s1), (s2), JBEm(label) )+#define jit_bgtr_ui(label, s1, s2) jit_bra_r((s1), (s2), JAm(label) )+#define jit_bger_ui(label, s1, s2) jit_bra_r((s1), (s2), JAEm(label) )+#define jit_bmsr_i(label, s1, s2) (TESTLrr((s1), (s2)), JNZm(label), _jit.x.pc)+#define jit_bmcr_i(label, s1, s2) (TESTLrr((s1), (s2)), JZm(label), _jit.x.pc)+#define jit_boaddr_i(label, s1, s2) (ADDLrr((s2), (s1)), JOm(label), _jit.x.pc)+#define jit_bosubr_i(label, s1, s2) (SUBLrr((s2), (s1)), JOm(label), _jit.x.pc)+#define jit_boaddr_ui(label, s1, s2) (ADDLrr((s2), (s1)), JCm(label), _jit.x.pc)+#define jit_bosubr_ui(label, s1, s2) (SUBLrr((s2), (s1)), JCm(label), _jit.x.pc)++#define jit_blti_i(label, rs, is) jit_bra_i0((rs), (is), JLm(label), JSm(label) )+#define jit_blei_i(label, rs, is) jit_bra_i ((rs), (is), JLEm(label) )+#define jit_bgti_i(label, rs, is) jit_bra_i ((rs), (is), JGm(label) )+#define jit_bgei_i(label, rs, is) jit_bra_i0((rs), (is), JGEm(label), JNSm(label) )+#define jit_beqi_i(label, rs, is) jit_bra_i0((rs), (is), JEm(label), JEm(label) )+#define jit_bnei_i(label, rs, is) jit_bra_i0((rs), (is), JNEm(label), JNEm(label) )+#define jit_blti_ui(label, rs, is) jit_bra_i ((rs), (is), JBm(label) )+#define jit_blei_ui(label, rs, is) jit_bra_i0((rs), (is), JBEm(label), JEm(label) )+#define jit_bgti_ui(label, rs, is) jit_bra_i0((rs), (is), JAm(label), JNEm(label) )+#define jit_bgei_ui(label, rs, is) jit_bra_i ((rs), (is), JAEm(label) )+#define jit_boaddi_i(label, rs, is) (ADDLir((is), (rs)), JOm(label), _jit.x.pc)+#define jit_bosubi_i(label, rs, is) (SUBLir((is), (rs)), JOm(label), _jit.x.pc)+#define jit_boaddi_ui(label, rs, is) (ADDLir((is), (rs)), JCm(label), _jit.x.pc)+#define jit_bosubi_ui(label, rs, is) (SUBLir((is), (rs)), JCm(label), _jit.x.pc)++#define jit_bmsi_i(label, rs, is) (jit_reduce(TEST, (is), (rs)), JNZm(label), _jit.x.pc)+#define jit_bmci_i(label, rs, is) (jit_reduce(TEST, (is), (rs)), JZm(label), _jit.x.pc)++#define jit_jmpi(label) (JMPm( ((unsigned long) (label))), _jit.x.pc)+#define jit_jmpr(reg) JMPsr(reg)++/* Memory */+#define jit_ldr_uc(d, rs) MOVZBLmr(0, (rs), 0, 0, (d))+#define jit_ldxr_uc(d, s1, s2) MOVZBLmr(0, (s1), (s2), 1, (d))+ +#define jit_str_c(rd, rs) jit_movbrm((rs), 0, (rd), 0, 0)+#define jit_stxr_c(d1, d2, rs) jit_movbrm((rs), 0, (d1), (d2), 1)+ +#define jit_ldr_us(d, rs) MOVZWLmr(0, (rs), 0, 0, (d))+#define jit_ldxr_us(d, s1, s2) MOVZWLmr(0, (s1), (s2), 1, (d))+ +#define jit_str_s(rd, rs) MOVWrm(jit_reg16(rs), 0, (rd), 0, 0)+#define jit_stxr_s(d1, d2, rs) MOVWrm(jit_reg16(rs), 0, (d1), (d2), 1)+ +#define jit_str_i(rd, rs) MOVLrm((rs), 0, (rd), 0, 0)+#define jit_stxr_i(d1, d2, rs) MOVLrm((rs), 0, (d1), (d2), 1)+ +/* Extra */+#define jit_nop() NOP_()++#define _jit_alignment(pc, n) (((pc ^ _MASK(4)) + 1) & _MASK(n))+#define jit_align(n) NOPi(_jit_alignment(_jit_UL(_jit.x.pc), (n)))+++#if LIGHTNING_CROSS \+ ? LIGHTNING_TARGET == LIGHTNING_X86_64 \+ : defined (__x86_64__)+#include "i386/core-64.h"+#else+#include "i386/core-32.h"+#endif++#endif /* __lightning_core_i386_h */
@@ -0,0 +1,356 @@+/******************************** -*- C -*- ****************************+ *+ * Support macros for the i386 math coprocessor+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2004, 2008 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ ***********************************************************************/+++#ifndef __lightning_fp_h+#define __lightning_fp_h++/* We really must map the x87 stack onto a flat register file. In practice,+ we can provide something sensible and make it work on the x86 using the+ stack like a file of eight registers.++ We use six or seven registers so as to have some freedom+ for floor, ceil, round, (and log, tan, atn and exp).++ Not hard at all, basically play with FXCH. FXCH is mostly free,+ so the generated code is not bad. Of course we special case when one+ of the operands turns out to be ST0.++ Here are the macros that actually do the trick. */++#define JIT_FPR_NUM 6+#define JIT_FPRET 0+#define JIT_FPR(i) (i)++#define jit_fxch(rs, op) (((rs) != 0 ? FXCHr(rs) : 0), \+ op, ((rs) != 0 ? FXCHr(rs) : 0))++#define jit_fp_unary(rd, s1, op) \+ ((rd) == (s1) ? jit_fxch ((rd), op) \+ : (rd) == 0 ? (FSTPr (0), FLDr ((s1)-1), op) \+ : (FLDr ((s1)), op, FSTPr ((rd) + 1)))++#define jit_fp_binary(rd, s1, s2, op, opr) \+ ((rd) == (s1) ? \+ ((s2) == 0 ? opr(0, (rd)) \+ : (s2) == (s1) ? jit_fxch((rd), op(0, 0)) \+ : jit_fxch((rd), op((s2), 0))) \+ : (rd) == (s2) ? \+ ((s1) == 0 ? op(0, (rd)) \+ : jit_fxch((rd), opr((s1), 0))) \+ : (FLDr (s1), op((s2)+1, 0), FSTPr((rd)+1)))++#define jit_addr_d(rd,s1,s2) jit_fp_binary((rd),(s1),(s2),FADDrr,FADDrr)+#define jit_subr_d(rd,s1,s2) jit_fp_binary((rd),(s1),(s2),FSUBrr,FSUBRrr)+#define jit_mulr_d(rd,s1,s2) jit_fp_binary((rd),(s1),(s2),FMULrr,FMULrr)+#define jit_divr_d(rd,s1,s2) jit_fp_binary((rd),(s1),(s2),FDIVrr,FDIVRrr)++#define jit_abs_d(rd,rs) jit_fp_unary ((rd), (rs), _OO (0xd9e1))+#define jit_negr_d(rd,rs) jit_fp_unary ((rd), (rs), _OO (0xd9e0))+#define jit_sqrt_d(rd,rs) jit_fp_unary ((rd), (rs), _OO (0xd9fa))++/* - moves:++ move FPR0 to FPR3+ FST ST3++ move FPR3 to FPR0+ FXCH ST3+ FST ST3++ move FPR3 to FPR1+ FLD ST3+ FSTP ST2 Stack is rotated, so FPRn becomes STn+1 */++#define jit_movr_d(rd,s1) \+ ((s1) == (rd) ? 0 \+ : (s1) == 0 ? FSTr ((rd)) \+ : (rd) == 0 ? (FXCHr ((s1)), FSTr ((s1))) \+ : (FLDr ((s1)), FSTPr ((rd)+1)))++/* - loads:++ load into FPR0+ FSTP ST0+ FLD [FUBAR]++ load into FPR3+ FSTP ST3 Save old st0 into destination register+ FLD [FUBAR]+ FXCH ST3 Get back old st0++ (and similarly for immediates, using the stack) */++#define jit_movi_f(rd,immf) \+ (_O (0x68), \+ *((float *) _jit.x.pc) = (float) immf, \+ _jit.x.uc_pc += sizeof (float), \+ jit_ldr_f((rd), _ESP), \+ ADDLir(4, _ESP))++union jit_double_imm {+ double d;+ int i[2];+};++#define jit_movi_d(rd,immd) \+ (_O (0x68), \+ _jit.x.uc_pc[4] = 0x68, \+ ((union jit_double_imm *) (_jit.x.uc_pc + 5))->d = (double) immd, \+ *((int *) _jit.x.uc_pc) = ((union jit_double_imm *) (_jit.x.uc_pc + 5))->i[1], \+ _jit.x.uc_pc += 9, \+ jit_ldr_d((rd), _ESP), \+ ADDLir(8, _ESP))++#define jit_ldi_f(rd, is) \+ ((rd) == 0 ? (FSTPr (0), FLDSm((is), 0, 0, 0)) \+ : (FLDSm((is), 0, 0, 0), FSTPr ((rd) + 1)))++#define jit_ldi_d(rd, is) \+ ((rd) == 0 ? (FSTPr (0), FLDLm((is), 0, 0, 0)) \+ : (FLDLm((is), 0, 0, 0), FSTPr ((rd) + 1)))++#define jit_ldr_f(rd, rs) \+ ((rd) == 0 ? (FSTPr (0), FLDSm(0, (rs), 0, 0)) \+ : (FLDSm(0, (rs), 0, 0), FSTPr ((rd) + 1)))++#define jit_ldr_d(rd, rs) \+ ((rd) == 0 ? (FSTPr (0), FLDLm(0, (rs), 0, 0)) \+ : (FLDLm(0, (rs), 0, 0), FSTPr ((rd) + 1)))++#define jit_ldxi_f(rd, rs, is) \+ ((rd) == 0 ? (FSTPr (0), FLDSm((is), (rs), 0, 0)) \+ : (FLDSm((is), (rs), 0, 0), FSTPr ((rd) + 1)))++#define jit_ldxi_d(rd, rs, is) \+ ((rd) == 0 ? (FSTPr (0), FLDLm((is), (rs), 0, 0)) \+ : (FLDLm((is), (rs), 0, 0), FSTPr ((rd) + 1)))++#define jit_ldxr_f(rd, s1, s2) \+ ((rd) == 0 ? (FSTPr (0), FLDSm(0, (s1), (s2), 1)) \+ : (FLDSm(0, (s1), (s2), 1), FSTPr ((rd) + 1)))++#define jit_ldxr_d(rd, s1, s2) \+ ((rd) == 0 ? (FSTPr (0), FLDLm(0, (s1), (s2), 1)) \+ : (FLDLm(0, (s1), (s2), 1), FSTPr ((rd) + 1)))++#define jit_extr_i_d(rd, rs) (PUSHLr((rs)), \+ ((rd) == 0 ? (FSTPr (0), FILDLm(0, _ESP, 0, 0)) \+ : (FILDLm(0, _ESP, 0, 0), FSTPr ((rd) + 1))), \+ POPLr((rs)))++#define jit_stxi_f(id, rd, rs) jit_fxch ((rs), FSTSm((id), (rd), 0, 0))+#define jit_stxr_f(d1, d2, rs) jit_fxch ((rs), FSTSm(0, (d1), (d2), 1))+#define jit_stxi_d(id, rd, rs) jit_fxch ((rs), FSTLm((id), (rd), 0, 0))+#define jit_stxr_d(d1, d2, rs) jit_fxch ((rs), FSTLm(0, (d1), (d2), 1))+#define jit_sti_f(id, rs) jit_fxch ((rs), FSTSm((id), 0, 0, 0))+#define jit_str_f(rd, rs) jit_fxch ((rs), FSTSm(0, (rd), 0, 0))+#define jit_sti_d(id, rs) jit_fxch ((rs), FSTLm((id), 0, 0, 0))+#define jit_str_d(rd, rs) jit_fxch ((rs), FSTLm(0, (rd), 0, 0))++/* ABI */+#define jit_retval_d(rd) FSTPr((rd) + 1)++/* Assume round to near mode */+#define jit_floorr_d_i(rd, rs) \+ (FLDr (rs), jit_floor2((rd), ((rd) == _EDX ? _EAX : _EDX)))++#define jit_ceilr_d_i(rd, rs) \+ (FLDr (rs), jit_ceil2((rd), ((rd) == _EDX ? _EAX : _EDX)))++#define jit_truncr_d_i(rd, rs) \+ (FLDr (rs), jit_trunc2((rd), ((rd) == _EDX ? _EAX : _EDX)))++#define jit_calc_diff(ofs) \+ FISTLm(ofs, _ESP, 0, 0), \+ FILDLm(ofs, _ESP, 0, 0), \+ FSUBRPr(1), \+ FSTPSm(4+ofs, _ESP, 0, 0) \++/* The real meat */+#define jit_floor2(rd, aux) \+ (PUSHLr(aux), \+ SUBLir(8, _ESP), \+ jit_calc_diff(0), \+ POPLr(rd), /* floor in rd */ \+ POPLr(aux), /* x-round(x) in aux */ \+ ADDLir(0x7FFFFFFF, aux), /* carry if x-round(x) < -0 */ \+ SBBLir(0, rd), /* subtract 1 if carry */ \+ POPLr(aux))++#define jit_ceil2(rd, aux) \+ (PUSHLr(aux), \+ SUBLir(8, _ESP), \+ jit_calc_diff(0), \+ POPLr(rd), /* floor in rd */ \+ POPLr(aux), /* x-round(x) in aux */ \+ TESTLrr(aux, aux), \+ SETGr(jit_reg8(aux)), \+ SHRLir(1, aux), \+ ADCLir(0, rd), \+ POPLr(aux))++/* a mingling of the two above */+#define jit_trunc2(rd, aux) \+ (PUSHLr(aux), \+ SUBLir(12, _ESP), \+ FSTSm(0, _ESP, 0, 0), \+ jit_calc_diff(4), \+ POPLr(aux), \+ POPLr(rd), \+ TESTLrr(aux, aux), \+ POPLr(aux), \+ JSSm(_jit.x.pc + 11), \+ ADDLir(0x7FFFFFFF, aux), /* 6 */ \+ SBBLir(0, rd), /* 3 */ \+ JMPSm(_jit.x.pc + 10), /* 2 */ \+ TESTLrr(aux, aux), /* 2 */ \+ SETGr(jit_reg8(aux)), /* 3 */ \+ SHRLir(1, aux), /* 2 */ \+ ADCLir(0, rd), /* 3 */ \+ POPLr(aux))++/* the easy one */+#define jit_roundr_d_i(rd, rs) \+ (PUSHLr(_EAX), \+ jit_fxch ((rs), FISTLm(0, _ESP, 0, 0)), \+ POPLr((rd)))++#define jit_fp_test(d, s1, s2, n, _and, res) \+ (((s1) == 0 ? FUCOMr((s2)) : (FLDr((s1)), FUCOMPr((s2) + 1))), \+ ((d) != _EAX ? MOVLrr(_EAX, (d)) : 0), \+ FNSTSWr(_EAX), \+ SHRLir(n, _EAX), \+ ((_and) ? ANDLir((_and), _EAX) : MOVLir(0, _EAX)), \+ res, \+ ((d) != _EAX ? _O (0x90 + ((d) & 7)) : 0)) /* xchg */++#define jit_fp_btest(d, s1, s2, n, _and, cmp, res) \+ (((s1) == 0 ? FUCOMr((s2)) : (FLDr((s1)), FUCOMPr((s2) + 1))), \+ PUSHLr(_EAX), \+ FNSTSWr(_EAX), \+ SHRLir(n, _EAX), \+ ((_and) ? ANDLir ((_and), _EAX) : 0), \+ ((cmp) ? CMPLir ((cmp), _EAX) : 0), \+ POPLr(_EAX), \+ res ((d)), \+ _jit.x.pc)++#define jit_nothing_needed(x)++/* After FNSTSW we have 1 if <, 40 if =, 0 if >, 45 if unordered. Here+ is how to map the values of the status word's high byte to the+ conditions.++ < = > unord valid values condition+ gt no no yes no 0 STSW & 45 == 0+ lt yes no no no 1 STSW & 45 == 1+ eq no yes no no 40 STSW & 45 == 40+ unord no no no yes 45 bit 2 == 1++ ge no yes no no 0, 40 bit 0 == 0+ unlt yes no no yes 1, 45 bit 0 == 1+ ltgt yes no yes no 0, 1 bit 6 == 0+ uneq no yes no yes 40, 45 bit 6 == 1+ le yes yes no no 1, 40 odd parity for STSW & 41+ ungt no no yes yes 0, 45 even parity for STSW & 41++ unle yes yes no yes 1, 40, 45 STSW & 45 != 0+ unge no yes yes yes 0, 40, 45 STSW & 45 != 1+ ne yes no yes yes 0, 1, 45 STSW & 45 != 40+ ord yes yes yes no 0, 1, 40 bit 2 == 0++ lt, le, ungt, unge are actually computed as gt, ge, unlt, unle with+ the operands swapped; it is more efficient this way. */++#define jit_gtr_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 8, 0x45, SETZr (_AL))+#define jit_ger_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 9, 0, SBBBir (-1, _AL))+#define jit_unler_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 8, 0x45, SETNZr (_AL))+#define jit_unltr_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 9, 0, ADCBir (0, _AL))+#define jit_ltr_d(d, s1, s2) jit_fp_test((d), (s2), (s1), 8, 0x45, SETZr (_AL))+#define jit_ler_d(d, s1, s2) jit_fp_test((d), (s2), (s1), 9, 0, SBBBir (-1, _AL))+#define jit_unger_d(d, s1, s2) jit_fp_test((d), (s2), (s1), 8, 0x45, SETNZr (_AL))+#define jit_ungtr_d(d, s1, s2) jit_fp_test((d), (s2), (s1), 9, 0, ADCBir (0, _AL))+#define jit_eqr_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 8, 0x45, (CMPBir (0x40, _AL), SETEr (_AL)))+#define jit_ner_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 8, 0x45, (CMPBir (0x40, _AL), SETNEr (_AL)))+#define jit_ltgtr_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 15, 0, SBBBir (-1, _AL))+#define jit_uneqr_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 15, 0, ADCBir (0, _AL))+#define jit_ordr_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 11, 0, SBBBir (-1, _AL))+#define jit_unordr_d(d, s1, s2) jit_fp_test((d), (s1), (s2), 11, 0, ADCBir (0, _AL))++#define jit_bgtr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 8, 0x45, 0, JZm)+#define jit_bger_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 9, 0, 0, JNCm)+#define jit_bunler_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 8, 0x45, 0, JNZm)+#define jit_bunltr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 9, 0, 0, JCm)+#define jit_bltr_d(d, s1, s2) jit_fp_btest((d), (s2), (s1), 8, 0x45, 0, JZm)+#define jit_bler_d(d, s1, s2) jit_fp_btest((d), (s2), (s1), 9, 0, 0, JNCm)+#define jit_bunger_d(d, s1, s2) jit_fp_btest((d), (s2), (s1), 8, 0x45, 0, JNZm)+#define jit_bungtr_d(d, s1, s2) jit_fp_btest((d), (s2), (s1), 9, 0, 0, JCm)+#define jit_beqr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 8, 0x45, 0x40, JZm)+#define jit_bner_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 8, 0x45, 0x40, JNZm)+#define jit_bltgtr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 15, 0, 0, JNCm)+#define jit_buneqr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 15, 0, 0, JCm)+#define jit_bordr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 11, 0, 0, JNCm)+#define jit_bunordr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 11, 0, 0, JCm)++#define jit_pusharg_d(rs) (jit_subi_i(JIT_SP,JIT_SP,sizeof(double)), jit_str_d(JIT_SP,(rs)))+#define jit_pusharg_f(rs) (jit_subi_i(JIT_SP,JIT_SP,sizeof(float)), jit_str_f(JIT_SP,(rs)))+++#if 0+#define jit_sin() _OO(0xd9fe) /* fsin */+#define jit_cos() _OO(0xd9ff) /* fcos */+#define jit_tan() (_OO(0xd9f2), /* fptan */ \+ FSTPr(0)) /* fstp st */+#define jit_atn() (_OO(0xd9e8), /* fld1 */ \+ _OO(0xd9f3)) /* fpatan */+#define jit_exp() (_OO(0xd9ea), /* fldl2e */ \+ FMULPr(1), /* fmulp */ \+ _OO(0xd9c0), /* fld st */ \+ _OO(0xd9fc), /* frndint */ \+ _OO(0xdce9), /* fsubr */ \+ FXCHr(1), /* fxch st(1) */ \+ _OO(0xd9f0), /* f2xm1 */ \+ _OO(0xd9e8), /* fld1 */ \+ _OO(0xdec1), /* faddp */ \+ _OO(0xd9fd), /* fscale */ \+ FSTPr(1)) /* fstp st(1) */+#define jit_log() (_OO(0xd9ed), /* fldln2 */ \+ FXCHr(1), /* fxch st(1) */ \+ _OO(0xd9f1)) /* fyl2x */+#endif++#define jit_prepare_f(nf) (_jitl.argssize += (nf))+#define jit_prepare_d(nd) (_jitl.argssize += 2 * (nd))+#define jit_arg_f() ((_jitl.framesize += sizeof(float)) - sizeof(float))+#define jit_arg_d() ((_jitl.framesize += sizeof(double)) - sizeof(double))++#endif /* __lightning_fp_h */
@@ -0,0 +1,325 @@+/******************************** -*- C -*- ****************************+ *+ * Support macros for SSE floating-point math+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2006 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ ***********************************************************************/+++#ifndef __lightning_fp_h+#define __lightning_fp_h++#include <float.h>++#define JIT_FPR_NUM 7+#define JIT_FPRET _XMM0+#define JIT_FPR(i) (_XMM8 + (i))+#define JIT_FPTMP _XMM15++/* Either use a temporary register that is finally AND/OR/XORed with RS = RD,+ or use RD as the temporary register and to the AND/OR/XOR with RS. */+#define jit_unop_tmp(rd, rs, op) \+ ( (rs) == (rd) \+ ? op((rd), JIT_FPTMP, JIT_FPTMP)) \+ : op((rd), (rd), (rs)))++#define jit_unop_f(rd, rs, op) \+ ((rs) == (rd) ? op((rd)) : (MOVSSrr ((rs), (rd)), op((rd))))++#define jit_unop_d(rd, rs, op) \+ ((rs) == (rd) ? op((rd)) : (MOVSDrr ((rs), (rd)), op((rd))))++#define jit_3opc_f(rd, s1, s2, op) \+ ( (s1) == (rd) ? op((s2), (rd)) \+ : ((s2) == (rd) ? op((s1), (rd)) \+ : (MOVSSrr ((s1), (rd)), op((s2), (rd)))))++#define jit_3opc_d(rd, s1, s2, op) \+ ( (s1) == (rd) ? op((s2), (rd)) \+ : ((s2) == (rd) ? op((s1), (rd)) \+ : (MOVSDrr ((s1), (rd)), op((s2), (rd)))))++#define jit_3op_f(rd, s1, s2, op) \+ ( (s1) == (rd) ? op((s2), (rd)) \+ : ((s2) == (rd) \+ ? (MOVSSrr ((rd), JIT_FPTMP), MOVSSrr ((s1), (rd)), op(JIT_FPTMP, (rd))) \+ : (MOVSSrr ((s1), (rd)), op((s2), (rd)))))++#define jit_3op_d(rd, s1, s2, op) \+ ( (s1) == (rd) ? op((s2), (rd)) \+ : ((s2) == (rd) \+ ? (MOVSDrr ((rd), JIT_FPTMP), MOVSDrr ((s1), (rd)), op(JIT_FPTMP, (rd))) \+ : (MOVSDrr ((s1), (rd)), op((s2), (rd)))))++#define jit_addr_f(rd,s1,s2) jit_3opc_f((rd), (s1), (s2), ADDSSrr)+#define jit_subr_f(rd,s1,s2) jit_3op_f((rd), (s1), (s2), SUBSSrr)+#define jit_mulr_f(rd,s1,s2) jit_3opc_f((rd), (s1), (s2), MULSSrr)+#define jit_divr_f(rd,s1,s2) jit_3op_f((rd), (s1), (s2), DIVSSrr)++#define jit_addr_d(rd,s1,s2) jit_3opc_d((rd), (s1), (s2), ADDSDrr)+#define jit_subr_d(rd,s1,s2) jit_3op_d((rd), (s1), (s2), SUBSDrr)+#define jit_mulr_d(rd,s1,s2) jit_3opc_d((rd), (s1), (s2), MULSDrr)+#define jit_divr_d(rd,s1,s2) jit_3op_d((rd), (s1), (s2), DIVSDrr)++#define jit_movr_f(rd,rs) MOVSSrr((rs), (rd))+#define jit_movr_d(rd,rs) MOVSDrr((rs), (rd))++/* either pcmpeqd %xmm7, %xmm7 / psrld $1, %xmm7 / andps %xmm7, %RD (if RS = RD)+ or pcmpeqd %RD, %RD / psrld $1, %RD / andps %RS, %RD (if RS != RD) */+#define _jit_abs_f(rd,cnst,rs) \+ (PCMPEQDrr((cnst), (cnst)), PSRLDir (1, (cnst)), ANDPSrr ((rs), (rd)))+#define _jit_neg_f(rd,cnst,rs) \+ (PCMPEQDrr((cnst), (cnst)), PSLLDir (31, (cnst)), XORPSrr ((rs), (rd)))+#define jit_abs_f(rd,rs) jit_unop_tmp ((rd), (rs), _jit_abs_f)+#define jit_neg_f(rd,rs) jit_unop_tmp ((rd), (rs), _jit_neg_f)++#define _jit_abs_d(rd,cnst,rs) \+ (PCMPEQDrr((cnst), (cnst)), PSRLQir (1, (cnst)), ANDPDrr ((rs), (rd)))+#define _jit_neg_d(rd,cnst,rs) \+ (PCMPEQDrr((cnst), (cnst)), PSLLQir (63, (cnst)), XORPDrr ((rs), (rd)))+#define jit_abs_d(rd,rs) jit_unop_tmp ((rd), (rs), _jit_abs_d)+#define jit_neg_d(rd,rs) jit_unop_tmp ((rd), (rs), _jit_neg_d)++#define jit_sqrt_d(rd,rs) SQRTSSrr((rs), (rd))+#define jit_sqrt_f(rd,rs) SQRTSDrr((rs), (rd))++#define _jit_ldi_f(d, is) MOVSSmr((is), 0, 0, 0, (d))+#define _jit_ldxi_f(d, rs, is) MOVSSmr((is), (rs), 0, 0, (d))+#define jit_ldr_f(d, rs) MOVSSmr(0, (rs), 0, 0, (d))+#define jit_ldxr_f(d, s1, s2) MOVSSmr(0, (s1), (s2), 1, (d))++#define _jit_sti_f(id, rs) MOVSSrm((rs), (id), 0, 0, 0)+#define _jit_stxi_f(id, rd, rs) MOVSSrm((rs), (id), (rd), 0, 0)+#define jit_str_f(rd, rs) MOVSSrm((rs), 0, (rd), 0, 0)+#define jit_stxr_f(d1, d2, rs) MOVSSrm((rs), 0, (d1), (d2), 1)++#define jit_ldi_f(d, is) (_u32P((long)(is)) ? _jit_ldi_f((d), (is)) : (jit_movi_l(JIT_REXTMP, (is)), jit_ldr_f((d), JIT_REXTMP)))+#define jit_sti_f(id, rs) (_u32P((long)(id)) ? _jit_sti_f((id), (rs)) : (jit_movi_l(JIT_REXTMP, (id)), jit_str_f (JIT_REXTMP, (rs))))+#define jit_ldxi_f(d, rs, is) (_u32P((long)(is)) ? _jit_ldxi_f((d), (rs), (is)) : (jit_movi_l(JIT_REXTMP, (is)), jit_ldxr_f((d), (rs), JIT_REXTMP)))+#define jit_stxi_f(id, rd, rs) (_u32P((long)(id)) ? _jit_stxi_f((id), (rd), (rs)) : (jit_movi_l(JIT_REXTMP, (id)), jit_stxr_f (JIT_REXTMP, (rd), (rs))))++#define _jit_ldi_d(d, is) MOVSDmr((is), 0, 0, 0, (d))+#define _jit_ldxi_d(d, rs, is) MOVSDmr((is), (rs), 0, 0, (d))+#define jit_ldr_d(d, rs) MOVSDmr(0, (rs), 0, 0, (d))+#define jit_ldxr_d(d, s1, s2) MOVSDmr(0, (s1), (s2), 1, (d))++#define _jit_sti_d(id, rs) MOVSDrm((rs), (id), 0, 0, 0)+#define _jit_stxi_d(id, rd, rs) MOVSDrm((rs), (id), (rd), 0, 0)+#define jit_str_d(rd, rs) MOVSDrm((rs), 0, (rd), 0, 0)+#define jit_stxr_d(d1, d2, rs) MOVSDrm((rs), 0, (d1), (d2), 1)++#define jit_ldi_d(d, is) (_u32P((long)(is)) ? _jit_ldi_d((d), (is)) : (jit_movi_l(JIT_REXTMP, (is)), jit_ldr_d((d), JIT_REXTMP)))+#define jit_sti_d(id, rs) (_u32P((long)(id)) ? _jit_sti_d((id), (rs)) : (jit_movi_l(JIT_REXTMP, (id)), jit_str_d (JIT_REXTMP, (rs))))+#define jit_ldxi_d(d, rs, is) (_u32P((long)(is)) ? _jit_ldxi_d((d), (rs), (is)) : (jit_movi_l(JIT_REXTMP, (is)), jit_ldxr_d((d), (rs), JIT_REXTMP)))+#define jit_stxi_d(id, rd, rs) (_u32P((long)(id)) ? _jit_stxi_d((id), (rd), (rs)) : (jit_movi_l(JIT_REXTMP, (id)), jit_stxr_d (JIT_REXTMP, (rd), (rs))))+++#define jit_movi_f(rd,immf) \+ ((immf) == 0.0 ? XORSSrr ((rd), (rd)) : \+ (PUSHQi (0x12345678L), \+ *((float *) (_jit.x.uc_pc - 4)) = (float) immf, \+ jit_ldr_f((rd), _ESP), \+ ADDQir(8, _ESP)))++union jit_double_imm {+ double d;+ long l;+};++#define jit_movi_d(rd,immd) \+ ((immd) == 0.0 ? XORSDrr ((rd), (rd)) : \+ (_O (0x50), \+ MOVQir (0x123456789abcdef0L, _EAX), \+ ((union jit_double_imm *) (_jit.x.uc_pc - 8))->d = (double) immd, \+ _O (0x50), jit_ldr_d((rd), _ESP), \+ _O (0x58), _O (0x58)))++#define jit_extr_i_d(rd, rs) CVTSI2SDLrr((rs), (rd))+#define jit_extr_i_f(rd, rs) CVTSI2SSLrr((rs), (rd))+#define jit_extr_l_d(rd, rs) CVTSI2SDQrr((rs), (rd))+#define jit_extr_l_f(rd, rs) CVTSI2SSQrr((rs), (rd))+#define jit_extr_f_d(rd, rs) CVTSS2SDrr((rs), (rd))+#define jit_extr_d_f(rd, rs) CVTSD2SSrr((rs), (rd))+#define jit_roundr_d_i(rd, rs) CVTSD2SILrr((rs), (rd))+#define jit_roundr_f_i(rd, rs) CVTSS2SILrr((rs), (rd))+#define jit_roundr_d_l(rd, rs) CVTSD2SIQrr((rs), (rd))+#define jit_roundr_f_l(rd, rs) CVTSS2SIQrr((rs), (rd))+#define jit_truncr_d_i(rd, rs) CVTTSD2SILrr((rs), (rd))+#define jit_truncr_f_i(rd, rs) CVTTSS2SILrr((rs), (rd))+#define jit_truncr_d_l(rd, rs) CVTTSD2SIQrr((rs), (rd))+#define jit_truncr_f_l(rd, rs) CVTTSS2SIQrr((rs), (rd))+++#define jit_ceilr_f_i(rd, rs) do { \+ jit_roundr_f_i ((rd), (rs)); \+ jit_extr_i_f (JIT_FPTMP, (rd)); \+ UCOMISSrr ((rs), JIT_FPTMP); \+ ADCLir (0, (rd)); \+ } while (0)++#define jit_ceilr_d_i(rd, rs) do { \+ jit_roundr_d_i ((rd), (rs)); \+ jit_extr_i_d (JIT_FPTMP, (rd)); \+ UCOMISDrr ((rs), JIT_FPTMP); \+ ADCLir (0, (rd)); \+ } while (0)++#define jit_ceilr_f_l(rd, rs) do { \+ jit_roundr_f_l ((rd), (rs)); \+ jit_extr_l_f (JIT_FPTMP, (rd)); \+ UCOMISSrr ((rs), JIT_FPTMP); \+ ADCLir (0, (rd)); \+ } while (0)++#define jit_ceilr_d_l(rd, rs) do { \+ jit_roundr_d_l ((rd), (rs)); \+ jit_extr_l_d (JIT_FPTMP, (rd)); \+ UCOMISDrr ((rs), JIT_FPTMP); \+ ADCLir (0, (rd)); \+ } while (0)++#define jit_floorr_f_i(rd, rs) do { \+ jit_roundr_f_i ((rd), (rs)); \+ jit_extr_i_f (JIT_FPTMP, (rd)); \+ UCOMISSrr (JIT_FPTMP, (rs)); \+ SBBLir (0, (rd)); \+ } while (0)++#define jit_floorr_d_i(rd, rs) do { \+ jit_roundr_d_i ((rd), (rs)); \+ jit_extr_i_d (JIT_FPTMP, (rd)); \+ UCOMISDrr (JIT_FPTMP, (rs)); \+ SBBLir (0, (rd)); \+ } while (0)++#define jit_floorr_f_l(rd, rs) do { \+ jit_roundr_f_l ((rd), (rs)); \+ jit_extr_l_f (JIT_FPTMP, (rd)); \+ UCOMISSrr (JIT_FPTMP, (rs)); \+ SBBLir (0, (rd)); \+ } while (0)++#define jit_floorr_d_l(rd, rs) do { \+ jit_roundr_d_l ((rd), (rs)); \+ jit_extr_l_d (JIT_FPTMP, (rd)); \+ UCOMISDrr (JIT_FPTMP, (rs)); \+ SBBLir (0, (rd)); \+ } while (0)++#define jit_bltr_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JAm ((d)), _jit.x.pc)+#define jit_bler_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JAEm ((d)), _jit.x.pc)+#define jit_beqr_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), _OO (0x7a06), JEm ((d)), _jit.x.pc)+#define jit_bner_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), _OO (0x7a02), _OO (0x7405), JMPm (((d))), _jit.x.pc) /* JP to JMP, JZ past JMP */+#define jit_bger_f(d, s1, s2) (UCOMISSrr ((s2), (s1)), JAEm ((d)), _jit.x.pc)+#define jit_bgtr_f(d, s1, s2) (UCOMISSrr ((s2), (s1)), JAm ((d)), _jit.x.pc)+#define jit_bunltr_f(d, s1, s2) (UCOMISSrr ((s2), (s1)), JNAEm ((d)), _jit.x.pc)+#define jit_bunler_f(d, s1, s2) (UCOMISSrr ((s2), (s1)), JNAm ((d)), _jit.x.pc)+#define jit_buneqr_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JEm ((d)), _jit.x.pc)+#define jit_bltgtr_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JNEm ((d)), _jit.x.pc)+#define jit_bunger_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JNAm ((d)), _jit.x.pc)+#define jit_bungtr_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JNAEm ((d)), _jit.x.pc)+#define jit_bordr_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JNPm ((d)), _jit.x.pc)+#define jit_bunordr_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), JPm ((d)), _jit.x.pc)++#define jit_bltr_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JAm ((d)), _jit.x.pc)+#define jit_bler_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JAEm ((d)), _jit.x.pc)+#define jit_beqr_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), _OO (0x7a06), JEm ((d)), _jit.x.pc)+#define jit_bner_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), _OO (0x7a02), _OO (0x7405), JMPm (((d))), _jit.x.pc) /* JP to JMP, JZ past JMP */ +#define jit_bger_d(d, s1, s2) (UCOMISDrr ((s2), (s1)), JAEm ((d)), _jit.x.pc)+#define jit_bgtr_d(d, s1, s2) (UCOMISDrr ((s2), (s1)), JAm ((d)), _jit.x.pc)+#define jit_bunltr_d(d, s1, s2) (UCOMISDrr ((s2), (s1)), JNAEm ((d)), _jit.x.pc, _jit.x.pc)+#define jit_bunler_d(d, s1, s2) (UCOMISDrr ((s2), (s1)), JNAm ((d)), _jit.x.pc)+#define jit_buneqr_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JEm ((d)), _jit.x.pc)+#define jit_bltgtr_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JNEm ((d)), _jit.x.pc)+#define jit_bunger_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JNAm ((d)), _jit.x.pc)+#define jit_bungtr_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JNAEm ((d)), _jit.x.pc)+#define jit_bordr_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JNPm ((d)), _jit.x.pc)+#define jit_bunordr_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), JPm ((d)), _jit.x.pc)++#define jit_ltr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETAr (jit_reg8((d))))+#define jit_ler_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETAEr (jit_reg8((d))))+#define jit_eqr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), _OO(0x7a03), SETEr (jit_reg8((d))))+#define jit_ner_f(d, s1, s2) (UCOMISSrr ((s1), (s2)), MOVLir (1, (d)), _OO(0x7a03), SETNEr (jit_reg8((d))))+#define jit_ger_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s2), (s1)), SETAEr (jit_reg8((d))))+#define jit_gtr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s2), (s1)), SETAr (jit_reg8((d))))+#define jit_unltr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s2), (s1)), SETNAEr (jit_reg8((d))))+#define jit_unler_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s2), (s1)), SETNAr (jit_reg8((d))))+#define jit_uneqr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETEr (jit_reg8((d))))+#define jit_ltgtr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETNEr (jit_reg8((d))))+#define jit_unger_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETNAr (jit_reg8((d))))+#define jit_ungtr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETNAEr (jit_reg8((d))))+#define jit_ordr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETNPr (jit_reg8((d))))+#define jit_unordr_f(d, s1, s2) (XORLrr ((d), (d)), UCOMISSrr ((s1), (s2)), SETPr (jit_reg8((d))))++#define jit_ltr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETAr (jit_reg8((d))))+#define jit_ler_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETAEr (jit_reg8((d))))+#define jit_eqr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), _OO(0x7a03), SETEr (jit_reg8((d))))+#define jit_ner_d(d, s1, s2) (UCOMISDrr ((s1), (s2)), MOVLir (1, (d)), _OO(0x7a03), SETNEr (jit_reg8((d))))+#define jit_ger_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s2), (s1)), SETAEr (jit_reg8((d))))+#define jit_gtr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s2), (s1)), SETAr (jit_reg8((d))))+#define jit_unltr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s2), (s1)), SETNAEr (jit_reg8((d))))+#define jit_unler_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s2), (s1)), SETNAr (jit_reg8((d))))+#define jit_uneqr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETEr (jit_reg8((d))))+#define jit_ltgtr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETNEr (jit_reg8((d))))+#define jit_unger_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETNAr (jit_reg8((d))))+#define jit_ungtr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETNAEr (jit_reg8((d))))+#define jit_ordr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETNPr (jit_reg8((d))))+#define jit_unordr_d(d, s1, s2) (XORLrr ((d), (d)), UCOMISDrr ((s1), (s2)), SETPr (jit_reg8((d))))++#define jit_prepare_f(num) ((_jitl.nextarg_putfp + (num) > JIT_FP_ARG_MAX \+ ? (_jitl.argssize += _jitl.nextarg_putfp + (num) - JIT_FP_ARG_MAX, \+ _jitl.fprssize = JIT_FP_ARG_MAX) \+ : (_jitl.fprssize += (num))), \+ _jitl.nextarg_putfp += (num))+#define jit_prepare_d(num) ((_jitl.nextarg_putfp + (num) > JIT_FP_ARG_MAX \+ ? (_jitl.argssize += _jitl.nextarg_putfp + (num) - JIT_FP_ARG_MAX, \+ _jitl.fprssize = JIT_FP_ARG_MAX) \+ : (_jitl.fprssize += (num))), \+ _jitl.nextarg_putfp += (num))++#define jit_arg_f() (_jitl.nextarg_getfp < JIT_FP_ARG_MAX \+ ? _jitl.nextarg_getfp++ \+ : ((_jitl.framesize += sizeof(double)) - sizeof(double)))+#define jit_arg_d() (_jitl.nextarg_getfp < JIT_FP_ARG_MAX \+ ? _jitl.nextarg_getfp++ \+ : ((_jitl.framesize += sizeof(double)) - sizeof(double)))++#define jit_getarg_f(reg, ofs) ((ofs) < JIT_FP_ARG_MAX \+ ? jit_movr_f((reg), _XMM0 + (ofs)) \+ : jit_ldxi_f((reg), JIT_FP, (ofs)))+#define jit_getarg_d(reg, ofs) ((ofs) < JIT_FP_ARG_MAX \+ ? jit_movr_d((reg), _XMM0 + (ofs)) \+ : jit_ldxi_d((reg), JIT_FP, (ofs)))++#define jit_pusharg_f(rs) (--_jitl.nextarg_putfp >= JIT_FP_ARG_MAX \+ ? (SUBQir(sizeof(double), JIT_SP), jit_str_f(JIT_SP,(rs))) \+ : jit_movr_f(_XMM0 + _jitl.nextarg_putfp, (rs)))+#define jit_pusharg_d(rs) (--_jitl.nextarg_putfp >= JIT_FP_ARG_MAX \+ ? (SUBQir(sizeof(double), JIT_SP), jit_str_d(JIT_SP,(rs))) \+ : jit_movr_d(_XMM0 + _jitl.nextarg_putfp, (rs)))++#endif /* __lightning_fp_h */
@@ -0,0 +1,45 @@+/******************************** -*- C -*- ****************************+ *+ * Floating-point support (i386)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2008 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_fp_i386_h+#define __lightning_fp_i386_h++#if LIGHTNING_CROSS \+ ? LIGHTNING_TARGET == LIGHTNING_X86_64 \+ : defined (__x86_64__)+#include "i386/fp-64.h"+#else+#include "i386/fp-32.h"+#endif++#endif /* __lightning_fp_i386_h */
@@ -0,0 +1,92 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer inline functions (i386)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2006 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 3, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,+ * MA 02110-1301, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_funcs_h+#define __lightning_funcs_h++#if defined(__linux__) || defined(__APPLE__)+#include <unistd.h>+#include <sys/mman.h>+#endif++static void+jit_flush_code(void *dest, void *end)+{+ /* On the x86, the PROT_EXEC bits are not handled by the MMU.+ However, the kernel can emulate this by setting the code+ segment's limit to the end address of the highest page+ whose PROT_EXEC bit is set.++ Linux kernels that do so and that disable by default the+ execution of the data and stack segment are becoming more+ and more common (Fedora, for example), so we implement our+ jit_flush_code as an mprotect. */+#if defined(__linux__) || defined(__APPLE__)+ static unsigned long prev_page = 0, prev_length = 0;+ unsigned long page, length;+#ifdef PAGESIZE+ const int page_size = PAGESIZE;+#else+ static int page_size = -1;+ if (page_size == -1)+ page_size = getpagesize();+#endif++ page = (long) dest & ~(page_size - 1);+ length = ((char *) end - (char *) page + page_size - 1) & ~(page_size - 1);++ /* Simple-minded attempt at optimizing the common case where a single+ chunk of memory is used to compile multiple functions. */+ if (page >= prev_page && page + length <= prev_page + prev_length)+ return;++ mprotect ((void *) page, length, PROT_READ | PROT_WRITE | PROT_EXEC);++ /* See if we can extend the previously mprotect'ed memory area towards+ higher addresses: the starting address remains the same as before. */+ if (page >= prev_page && page <= prev_page + prev_length)+ prev_length = page + length - prev_page;++ /* See if we can extend the previously mprotect'ed memory area towards+ lower addresses: the highest address remains the same as before. */+ else if (page < prev_page && page + length >= prev_page+ && page + length <= prev_page + prev_length)+ prev_length += prev_page - page, prev_page = page;++ /* Nothing to do, replace the area. */+ else+ prev_page = page, prev_length = length;+#endif+}++#endif /* __lightning_funcs_h */
@@ -0,0 +1,647 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler for the PowerPC+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 1999, 2000, 2001, 2002 Ian Piumarta+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++#ifndef __lightning_asm_h+#define __lightning_asm_h++/* <imm> = [0-9]+ | (.+) -> add i, one parameter (imm)+ * <reg> = r<imm> -> add r, one parameter (imm)+ * <mem> = <imm>(<reg>) -> add m, two parameters (imm,reg)+ * <idx> = <reg>(<reg>) -> add x, two parameters (reg,reg)+ *+ * `x' operands have two forms. For example `stwu source, rega(regb)'+ * could be written as either+ * STWUrx(source, rega, regb)+ * or+ * STWUXrrr(source, rega, regb)+ */++++/*** a brief NOTE about halfwords and "shifted" operands+ *+ * LOGICAL insns require UNSIGNED args in 0..65535, whether or not shifted+ *+ * ARITHMETIC insns require SIGNED args in -32768..32767, even when shifted+ * + * as a special case: "lis/addis" also accepts UNSIGNED arguments in+ * 0..65535 since it is often used immediately before "ori" to load a 32-bit+ * constant (this is consistent with the GNU rs/6000 and PowerPC assemblers)+ * + * thus: lis rD, expression@hi+ * ori rD, rD, expression@lo ; load 32-bit constant+ */++typedef unsigned int jit_insn;++#ifndef LIGHTNING_DEBUG+#define _cr0 0+#define _cr1 1+#define _cr2 2+#define _cr3 3+#define _cr4 4+#define _cr5 5+#define _cr6 6+#define _cr7 7++#define _lt 0+#define _gt 1+#define _eq 2+#define _so 3+#define _un 3++#define _d16(D) (_ck_d(16,(_jit_UL(D)-_jit_UL(_jit.x.pc))) & ~3)+#define _d26(D) (_ck_d(26,(_jit_UL(D)-_jit_UL(_jit.x.pc))) & ~3)++/* primitive instruction forms [1, Section A.4] */++#define _FB( OP, BD,AA,LK ) (_jit_I_noinc((_u6(OP)<<26)| _d26(BD)| (_u1(AA)<<1)|_u1(LK)), _jit.x.pc++, 0)+#define _FBA( OP, BD,AA,LK ) _jit_I((_u6(OP)<<26)| (_u26(BD)&~3)| (_u1(AA)<<1)|_u1(LK))+#define _BB( OP,BO,BI, BD,AA,LK ) (_jit_I_noinc((_u6(OP)<<26)|(_u5(BO)<<21)|(_u5(BI)<<16)| _d16(BD)| (_u1(AA)<<1)|_u1(LK)), _jit.x.pc++, 0)+#define _D( OP,RD,RA, DD ) _jit_I((_u6(OP)<<26)|(_u5(RD)<<21)|(_u5(RA)<<16)| _s16(DD) )+#define _Du( OP,RD,RA, DD ) _jit_I((_u6(OP)<<26)|(_u5(RD)<<21)|(_u5(RA)<<16)| _u16(DD) )+#define _Ds( OP,RD,RA, DD ) _jit_I((_u6(OP)<<26)|(_u5(RD)<<21)|(_u5(RA)<<16)| _su16(DD) )+#define _X( OP,RD,RA,RB, XO,RC ) _jit_I((_u6(OP)<<26)|(_u5(RD)<<21)|(_u5(RA)<<16)|( _u5(RB)<<11)| (_u10(XO)<<1)|_u1(RC))+#define _XL( OP,BO,BI, XO,LK ) _jit_I((_u6(OP)<<26)|(_u5(BO)<<21)|(_u5(BI)<<16)|( _u5(00)<<11)| (_u10(XO)<<1)|_u1(LK))+#define _XFX( OP,RD, SR,XO ) _jit_I((_u6(OP)<<26)|(_u5(RD)<<21)| (_u10(SR)<<11)| (_u10(XO)<<1)|_u1(00))+#define _XO( OP,RD,RA,RB,OE,XO,RC ) _jit_I((_u6(OP)<<26)|(_u5(RD)<<21)|(_u5(RA)<<16)|( _u5(RB)<<11)|(_u1(OE)<<10)|( _u9(XO)<<1)|_u1(RC))+#define _M( OP,RS,RA,SH,MB,ME,RC ) _jit_I((_u6(OP)<<26)|(_u5(RS)<<21)|(_u5(RA)<<16)|( _u5(SH)<<11)|(_u5(MB)<< 6)|( _u5(ME)<<1)|_u1(RC))+++/* special purpose registers (form XFX) [1, Section 8.2, page 8-138] */++#define SPR_LR ((8<<5)|(0))++/* +++ intrinsic instructions */++#define ADDrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 266, 0)+#define ADD_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 266, 1)+#define ADDCrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 10, 0)+#define ADDC_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 10, 1)+#define ADDErrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 138, 0)+#define ADDE_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 138, 1)+#define ADDOrrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 266, 0)+#define ADDO_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 266, 1)+#define ADDIrri(RD, RA, IMM) _D (14, RD, RA, IMM)+#define ADDICrri(RD, RA, IMM) _D (12, RD, RA, IMM)+#define ADDIC_rri(RD, RA, IMM) _D (13, RD, RA, IMM)+#define ADDISrri(RD, RA, IMM) _Ds (15, RD, RA, IMM)++#define ANDrrr(RA, RS, RB) _X (31, RS, RA, RB, 28, 0)+#define AND_rrr(RA, RS, RB) _X (31, RS, RA, RB, 28, 1)+#define ANDCrrr(RA, RS, RB) _X (31, RS, RA, RB, 60, 0)+#define ANDC_rrr(RA, RS, RB) _X (31, RS, RA, RB, 60, 1)+#define ANDI_rri(RA, RS, IMM) _Du (28, RS, RA, IMM)+#define ANDIS_rri(RA, RS, IMM) _Du (29, RS, RA, IMM)++#define Bi(BD) _FB (18, BD, 0, 0)+#define BAi(BD) _FBA (18, BD, 1, 0)+#define BLi(BD) _FB (18, BD, 0, 1)+#define BLAi(BD) _FBA (18, BD, 1, 1)++#define BCiii(BO,BI,BD) _BB (16, BO, BI, BD, 0, 0)+#define BCAiii(BO,BI,BD) _BB (16, BO, BI, BD, 1, 0)+#define BCLiii(BO,BI,BD) _BB (16, BO, BI, BD, 0, 1)+#define BCLAiii(BO,BI,BD) _BB (16, BO, BI, BD, 1, 1)++#define BCCTRii(BO,BI) _XL (19, BO, BI, 528, 0)+#define BCCTRLii(BO,BI) _XL (19, BO, BI, 528, 1)++#define BCLRii(BO,BI) _XL (19, BO, BI, 16, 0)+#define BCLRLii(BO,BI) _XL (19, BO, BI, 16, 1)++#define CMPiirr(CR, LL, RA, RB) _X (31, ((CR)<<2)|(LL), RA, RB, 0, 0)+#define CMPIiiri(CR, LL, RA, IMM) _D (11, ((CR)<<2)|(LL), RA, IMM)++#define CMPLiirr(CR, LL, RA, RB) _X (31, ((CR)<<2)|(LL), RA, RB, 32, 0)+#define CMPLIiiri(CR, LL, RA, IMM) _D (10, ((CR)<<2)|(LL), RA, IMM)++#define CRANDiii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 257, 0)+#define CRANDCiii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 129, 0)+#define CREQViii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 289, 0)+#define CRNANDiii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 225, 0)+#define CRNORiii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 33, 0)+#define CRORiii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 449, 0)+#define CRORCiii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 417, 0)+#define CRXORiii(CRD,CRA,CRB) _X (19, CRD, CRA, CRB, 193, 0)++#define DCBSTrr(RA,RB) _X (31, 00, RA, RB, 54, 0)++#define DIVWrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 491, 0)+#define DIVW_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 491, 1)+#define DIVWOrrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 491, 0)+#define DIVWO_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 491, 1)++#define DIVWUrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 459, 0)+#define DIVWU_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 459, 1)+#define DIVWUOrrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 459, 0)+#define DIVWUO_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 459, 1)++#define EQVrrr(Ra,RS,RB) _X (31, RS, RA, RB, 284, 0)+#define EQV_rrr(Ra,RS,RB) _X (31, RS, RA, RB, 284, 1)++#define EXTSBrr(RA,RS) _X (31, RS, RA, 0, 954, 0)+#define EXTSB_rr(RA,RS) _X (31, RS, RA, 0, 954, 1)++#define EXTSHrr(RA,RS) _X (31, RS, RA, 0, 922, 0)+#define EXTSH_rr(RA,RS) _X (31, RS, RA, 0, 922, 1)++#define ICBIrr(RA,RB) _X (31, 00, RA, RB, 982, 0)++#define ISYNC() _X (19, 00, 00, 00, 150, 0)++#define LBZrm(RD,ID,RA) _D (34, RD, RA, ID)+#define LBZUrm(RD,ID,RA) _D (35, RD, RA, ID)+#define LBZUXrrr(RD,RA,RB) _X (31, RD, RA, RB, 119, 0)+#define LBZXrrr(RD,RA,RB) _X (31, RD, RA, RB, 87, 0)++#define LHArm(RD,ID,RA) _D (42, RD, RA, ID)+#define LHAUrm(RD,ID,RA) _D (43, RD, RA, ID)+#define LHAUXrrr(RD,RA,RB) _X (31, RD, RA, RB, 375, 0)+#define LHAXrrr(RD,RA,RB) _X (31, RD, RA, RB, 343, 0)+#define LHBRXrrr(RD,RA,RB) _X (31, RD, RA, RB, 790, 0)++#define LHZrm(RD,ID,RA) _D (40, RD, RA, ID)+#define LHZUrm(RD,ID,RA) _D (41, RD, RA, ID)+#define LHZUXrrr(RD,RA,RB) _X (31, RD, RA, RB, 311, 0)+#define LHZXrrr(RD,RA,RB) _X (31, RD, RA, RB, 279, 0)++#define LMWrm(RD,ID,RA) _D (46, RD, RA, ID)++#define LWBRXrrr(RD,RA,RB) _X (31, RD, RA, RB, 534, 0)++#define LWZrm(RD, DISP, RA) _D (32, RD, RA, DISP)+#define LWZUrm(RD, DISP, RA) _D (33, RD, RA, DISP)+#define LWZUXrrr(RD, RA, RB) _X (31, RD, RA, RB, 56, 0)+#define LWZXrrr(RD, RA, RB) _X (31, RD, RA, RB, 23, 0)++#define MCRFii(CD,CS) _X (19, ((CD)<<2), ((CS)<<2), 0, 0, 0)++#define MFCRr(RD) _X (31, RD, 0, 0, 19, 0)+#define MCRXRi(RD) _XFX (31, (RD)<<2, 0, 512)++#define MFSPRri(RD, SPR) _XFX (31, RD, (SPR)<<5, 339)+#define MTSPRir(SPR, RS) _XFX (31, RS, (SPR)<<5, 467)++#define MULHWrrr(RD,RA,RB) _XO (31, RD, RA, RB, 0, 75, 0)+#define MULHW_rrr(RD,RA,RB) _XO (31, RD, RA, RB, 0, 75, 1)+#define MULHWUrrr(RD,RA,RB) _XO (31, RD, RA, RB, 0, 11, 0)+#define MULHWU_rrr(RD,RA,RB) _XO (31, RD, RA, RB, 0, 11, 1)++#define MULLIrri(RD,RA,IM) _D (07, RD, RA, IM)++#define MULLWrrr(RD,RA,RB) _XO (31, RD, RA, RB, 0, 235, 0)+#define MULLW_rrr(RD,RA,RB) _XO (31, RD, RA, RB, 0, 235, 1)+#define MULLWOrrr(RD,RA,RB) _XO (31, RD, RA, RB, 1, 235, 0)+#define MULLWO_rrr(RD,RA,RB) _XO (31, RD, RA, RB, 1, 235, 1)++#define NANDrrr(RA,RS,RB) _X (31, RS, RA, RB, 476, 0)+#define NAND_rrr(RA,RS,RB) _X (31, RS, RA, RB, 476, 1)++#define NEGrr(RD,RA) _XO (31, RD, RA, 0, 0, 104, 0)+#define NEG_rr(RD,RA) _XO (31, RD, RA, 0, 0, 104, 1)+#define NEGOrr(RD,RA) _XO (31, RD, RA, 0, 1, 104, 0)+#define NEGO_rr(RD,RA) _XO (31, RD, RA, 0, 1, 104, 1)++#define NORrrr(RA,RS,RB) _X (31, RS, RA, RB, 124, 0)+#define NOR_rrr(RA,RS,RB) _X (31, RS, RA, RB, 124, 1)++#define ORrrr(RA,RS,RB) _X (31, RS, RA, RB, 444, 0)+#define OR_rrr(RA,RS,RB) _X (31, RS, RA, RB, 444, 1)+#define ORCrrr(RA,RS,RB) _X (31, RS, RA, RB, 412, 0)+#define ORC_rrr(RA,RS,RB) _X (31, RS, RA, RB, 412, 1)+#define ORIrri(RA,RS,IM) _Du (24, RS, RA, IM)+#define ORISrri(RA,RS,IM) _Du (25, RS, RA, IM)++#define RLWIMIrriii(RA,RS,SH,MB,ME) _M (20, RS, RA, SH, MB, ME, 0)+#define RLWIMI_rriii(RA,RS,SH,MB,ME) _M (20, RS, RA, SH, MB, ME, 1)++#define RLWINMrriii(RA,RS,SH,MB,ME) _M (21, RS, RA, SH, MB, ME, 0)+#define RLWINM_rriii(RA,RS,SH,MB,ME) _M (21, RS, RA, SH, MB, ME, 1)++#define RLWNMrrrii(RA,RS,RB,MB,ME) _M (23, RS, RA, RB, MB, ME, 0)+#define RLWNM_rrrii(RA,RS,RB,MB,ME) _M (23, RS, RA, RB, MB, ME, 1)++#define SLWrrr(RA,RS,RB) _X (31, RS, RA, RB, 24, 0)+#define SLW_rrr(RA,RS,RB) _X (31, RS, RA, RB, 24, 1)++#define SRAWrrr(RA,RS,RB) _X (31, RS, RA, RB, 792, 0)+#define SRAW_rrr(RA,RS,RB) _X (31, RS, RA, RB, 792, 1)++#define SRAWIrri(RD, RS, SH) _X (31, RS, RD, SH, 824, 0)+#define SRAWI_rri(RD, RS, SH) _X (31, RS, RD, SH, 824, 1)++#define SRWrrr(RA,RS,RB) _X (31, RS, RA, RB, 536, 0)+#define SRW_rrr(RA,RS,RB) _X (31, RS, RA, RB, 536, 1)++#define STBrm(RS,ID,RA) _D (38, RS, RA, ID)+#define STBUrm(RS,ID,RA) _D (39, RS, RA, ID)+#define STBUXrrr(RS,RA,RB) _X (31, RS, RA, RB, 247, 0)+#define STBXrrr(RS,RA,RB) _X (31, RS, RA, RB, 215, 0)++#define STHrm(RS,ID,RA) _D (44, RS, RA, ID)+#define STHUrm(RS,ID,RA) _D (45, RS, RA, ID)+#define STHBRXrrr(RS,RA,RB) _X (31, RS, RA, RB, 918, 0)+#define STHUXrrr(RS,RA,RB) _X (31, RS, RA, RB, 439, 0)+#define STHXrrr(RS,RA,RB) _X (31, RS, RA, RB, 407, 0)++#define STMWrm(RS,ID,RA) _D (47, RS, RA, ID)++#define STWrm(RS,ID,RA) _D (36, RS, RA, ID)+#define STWBRXrrr(RS,RA,RB) _X (31, RS, RA, RB, 662, 0)+#define STWCXrrr(RS,RA,RB) _X (31, RS, RA, RB, 150, 0)+#define STWCX_rrr(RS,RA,RB) _X (31, RS, RA, RB, 150, 1)+#define STWUrm(RS,ID,RA) _D (37, RS, RA, ID)+#define STWUXrrr(RS,RA,RB) _X (31, RS, RA, RB, 183, 0)+#define STWXrrr(RS,RA,RB) _X (31, RS, RA, RB, 151, 0)++#define SUBFrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 40, 0)+#define SUBF_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 40, 1)+#define SUBFrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 40, 0)+#define SUBF_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 40, 1)+#define SUBFErrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 136, 0)+#define SUBFE_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 136, 1)+#define SUBFCrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 8, 0)+#define SUBFC_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 8, 1)+#define SUBFCOrrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 8, 0)+#define SUBFCO_rrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 8, 1)+#define SUBFICrri(RD, RA, IMM) _D (8, RD, RA, IMM)++#define ADDrrr(RD, RA, RB) _XO (31, RD, RA, RB, 0, 266, 0)+#define ADDOrrr(RD, RA, RB) _XO (31, RD, RA, RB, 1, 266, 0)+#define ADDIrri(RD, RA, IMM) _D (14, RD, RA, IMM)+#define ADDISrri(RD, RA, IMM) _Ds (15, RD, RA, IMM)++#define SYNC() _X (31, 00, 00, 00, 598, 0)++#define TWirr(TO,RA,RB) _X (31, TO, RA, RB, 4, 0)+#define TWIiri(TO,RA,IM) _D (03, TO, RA, IM)++#define XORrrr(RA,RS,RB) _X (31, RS, RA, RB, 316, 0)+#define XOR_rrr(RA,RS,RB) _X (31, RS, RA, RB, 316, 1)+#define XORIrri(RA,RS,IM) _Du (26, RS, RA, IM)+#define XORISrri(RA,RS,IM) _Du (27, RS, RA, IM)++/* simplified mnemonics [1, Appendix F] */++#define MOVEIri2(R,H,L) (LISri(R,H), (L ? ORIrri(R,R,L) : 0))+#define MOVEIri(R,I) (_siP(16,I) ? LIri(R,I) : \+ MOVEIri2(R, _HI(I), _LO(I)) )++#define SUBIrri(RD,RA,IM) ADDIrri(RD,RA,-_LO((IM))) /* [1, Section F.2.1] */+#define SUBISrri(RD,RA,IM) ADDISrri(RD,RA,-_LO((IM)))+#define SUBICrri(RD,RA,IM) ADDICrri(RD,RA,-_LO((IM)))+#define SUBIC_rri(RD,RA,IM) ADDIC_rri(RD,RA,-_LO((IM)))++#define SUBrrr(RD,RA,RB) SUBFrrr(RD,RB,RA) /* [1, Section F.2.2] */+#define SUBOrrr(RD,RA,RB) SUBFOrrr(RD,RB,RA)+#define SUB_rrr(RD,RA,RB) SUBF_rrr(RD,RB,RA)+#define SUBCrrr(RD,RA,RB) SUBFCrrr(RD,RB,RA)+#define SUBCOrrr(RD,RA,RB) SUBFCOrrr(RD,RB,RA)+#define SUBC_rrr(RD,RA,RB) SUBFC_rrr(RD,RB,RA)+#define SUBErrr(RD,RA,RB) SUBFErrr(RD,RB,RA)+#define SUBE_rrr(RD,RA,RB) SUBFE_rrr(RD,RB,RA)++#define CMPWIiri(C,RA,IM) CMPIiiri(C,0,RA,IM) /* [1, Table F-2] */+#define CMPWirr(C,RA,RB) CMPiirr(C,0,RA,RB)+#define CMPLWIiri(C,RA,IM) CMPLIiiri(C,0,RA,IM)+#define CMPLWirr(C,RA,RB) CMPLiirr(C,0,RA,RB)++#define CMPWIri(RA,IM) CMPWIiri(0,RA,IM) /* with implicit _cr0 */+#define CMPWrr(RA,RB) CMPWirr(0,RA,RB)+#define CMPLWIri(RA,IM) CMPLWIiri(0,RA,IM)+#define CMPLWrr(RA,RB) CMPLWirr(0,RA,RB)++#define EXTLWIrrii(RA,RS,N,B) RLWINMrriii(RA, RS, B, 0, (N)-1) /* [1, Table F-3] */+#define EXTRWIrrii(RA,RS,N,B) RLWINMrriii(RA, RS, (B)+(N), 32-(N), 31)+#define INSLWIrrii(RA,RS,N,B) RLWIMIrriii(RA, RS, 32-(B), B, (B)+(N)-1)+#define INSRWIrrii(RA,RS,N,B) RLWIMIrriii(RA, RS, 32-((B)+(N)), B, (B)+(N)-1)+#define ROTLWIrri(RA,RS,N) RLWINMrriii(RA, RS, N, 0, 31)+#define ROTRWIrri(RA,RS,N) RLWINMrriii(RA, RS, 32-(N), 0, 31)+#define ROTLWrrr(RA,RS,RB) RLWNMrrrii( RA, RS, RB, 0, 31)+#define SLWIrri(RA,RS,N) RLWINMrriii(RA, RS, N, 0, 31-(N))+#define SRWIrri(RA,RS,N) RLWINMrriii(RA, RS, 32-(N), N, 31)+#define CLRLWIrri(RA,RS,N) RLWINMrriii(RA, RS, 0, N, 31)+#define CLRRWIrri(RA,RS,N) RLWINMrriii(RA, RS, 0, 0, 31-(N))+#define CLRLSLWIrrii(RA,RS,B,N) RLWINMrriii(RA, RS, N, (B)-(N), 31-(N))+++/* 9 below inverts the branch condition and the branch prediction.+ * This has an incestuous knowledge of JIT_AUX */+#define BC_EXT(A, C, D) (_siP(16, _jit_UL(D)-_jit_UL(_jit.x.pc)) \+ ? BCiii((A), (C), (D)) \+ : (BCiii((A)^9, (C), _jit.x.pc+5), \+ LISri(JIT_AUX,_HI(D)), \+ ORIrri(JIT_AUX,JIT_AUX,_LO(D)), \+ MTLRr(JIT_AUX), BLR() ))++#define B_EXT(D) (_siP(16, _jit_UL(D)-_jit_UL(_jit.x.pc)) \+ ? Bi((D)) \+ : (LISri(JIT_AUX,_HI(D)), \+ ORIrri(JIT_AUX,JIT_AUX,_LO(D)), \+ MTLRr(JIT_AUX), BLR()) )++#define BTii(C,D) BC_EXT(12, C, D) /* [1, Table F-5] */+#define BFii(C,D) BC_EXT( 4, C, D)+#define BDNZi(D) BCiii(16, 0, D)+#define BDNZTii(C,D) BC_EXT( 8, C, D)+#define BDNZFii(C,D) BC_EXT( 0, C, D)+#define BDZi(D) BCiii(18, 0, D)+#define BDZTii(C,D) BC_EXT(10, C, D)+#define BDZFii(C,D) BC_EXT( 2, C, D)+ +#define BCTR() BCCTRii(20, 0) /* [1, Table F-6] */+#define BCTRL() BCCTRLii(20, 0)+ +#define BLR() BCLRii(20, 0) /* [1, Table F-6] */+#define BLRL() BCLRLii(20, 0)+ ++#define BLTLRi(CR) BCLRii(12, ((CR)<<2)+0) /* [1, Table F-10] */+#define BLELRi(CR) BCLRii( 4, ((CR)<<2)+1)+#define BEQLRi(CR) BCLRii(12, ((CR)<<2)+2)+#define BGELRi(CR) BCLRii( 4, ((CR)<<2)+0)+#define BGTLRi(CR) BCLRii(12, ((CR)<<2)+1)+#define BNLLRi(CR) BCLRii( 4, ((CR)<<2)+0)+#define BNELRi(CR) BCLRii( 4, ((CR)<<2)+2)+#define BNGLRi(CR) BCLRii( 4, ((CR)<<2)+1)+#define BSOLRi(CR) BCLRii(12, ((CR)<<2)+3)+#define BNSLRi(CR) BCLRii( 4, ((CR)<<2)+3)+#define BUNLRi(CR) BCLRii(12, ((CR)<<2)+3)+#define BNULRi(CR) BCLRii( 4, ((CR)<<2)+3)+ +#define BLTLRLi(CR) BCLRLii(12, ((CR)<<2)+0) /* [1, Table F-10] */+#define BLELRLi(CR) BCLRLii( 4, ((CR)<<2)+1)+#define BEQLRLi(CR) BCLRLii(12, ((CR)<<2)+2)+#define BGELRLi(CR) BCLRLii( 4, ((CR)<<2)+0)+#define BGTLRLi(CR) BCLRLii(12, ((CR)<<2)+1)+#define BNLLRLi(CR) BCLRLii( 4, ((CR)<<2)+0)+#define BNELRLi(CR) BCLRLii( 4, ((CR)<<2)+2)+#define BNGLRLi(CR) BCLRLii( 4, ((CR)<<2)+1)+#define BSOLRLi(CR) BCLRLii(12, ((CR)<<2)+3)+#define BNSLRLi(CR) BCLRLii( 4, ((CR)<<2)+3)+#define BUNLRLi(CR) BCLRLii(12, ((CR)<<2)+3)+#define BNULRLi(CR) BCLRLii( 4, ((CR)<<2)+3)+ +#define BLTCTRi(CR) BCCTRii(12, ((CR)<<2)+0) /* [1, Table F-10] */+#define BLECTRi(CR) BCCTRii( 4, ((CR)<<2)+1)+#define BEQCTRi(CR) BCCTRii(12, ((CR)<<2)+2)+#define BGECTRi(CR) BCCTRii( 4, ((CR)<<2)+0)+#define BGTCTRi(CR) BCCTRii(12, ((CR)<<2)+1)+#define BNLCTRi(CR) BCCTRii( 4, ((CR)<<2)+0)+#define BNECTRi(CR) BCCTRii( 4, ((CR)<<2)+2)+#define BNGCTRi(CR) BCCTRii( 4, ((CR)<<2)+1)+#define BSOCTRi(CR) BCCTRii(12, ((CR)<<2)+3)+#define BNSCTRi(CR) BCCTRii( 4, ((CR)<<2)+3)+#define BUNCTRi(CR) BCCTRii(12, ((CR)<<2)+3)+#define BNUCTRi(CR) BCCTRii( 4, ((CR)<<2)+3)+ +#define BLTCTRLi(CR) BCCTRLii(12, ((CR)<<2)+0) /* [1, Table F-10] */+#define BLECTRLi(CR) BCCTRLii( 4, ((CR)<<2)+1)+#define BEQCTRLi(CR) BCCTRLii(12, ((CR)<<2)+2)+#define BGECTRLi(CR) BCCTRLii( 4, ((CR)<<2)+0)+#define BGTCTRLi(CR) BCCTRLii(12, ((CR)<<2)+1)+#define BNLCTRLi(CR) BCCTRLii( 4, ((CR)<<2)+0)+#define BNECTRLi(CR) BCCTRLii( 4, ((CR)<<2)+2)+#define BNGCTRLi(CR) BCCTRLii( 4, ((CR)<<2)+1)+#define BSOCTRLi(CR) BCCTRLii(12, ((CR)<<2)+3)+#define BNSCTRLi(CR) BCCTRLii( 4, ((CR)<<2)+3)+#define BUNCTRLi(CR) BCCTRLii(12, ((CR)<<2)+3)+#define BNUCTRLi(CR) BCCTRLii( 4, ((CR)<<2)+3)+ ++#define BLTLR() BLTLRi(0) /* with implicit _cr0 */+#define BLELR() BLELRi(0) +#define BEQLR() BEQLRi(0) +#define BGELR() BGELRi(0) +#define BGTLR() BGTLRi(0) +#define BNLLR() BNLLRi(0) +#define BNELR() BNELRi(0) +#define BNGLR() BNGLRi(0) +#define BSOLR() BSOLRi(0) +#define BNSLR() BNSLRi(0) +#define BUNLR() BUNLRi(0) +#define BNULR() BNULRi(0) + +#define BLTLRL() BLTLRLi(0) +#define BLELRL() BLELRLi(0) +#define BEQLRL() BEQLRLi(0) +#define BGELRL() BGELRLi(0) +#define BGTLRL() BGTLRLi(0) +#define BNLLRL() BNLLRLi(0) +#define BNELRL() BNELRLi(0) +#define BNGLRL() BNGLRLi(0) +#define BSOLRL() BSOLRLi(0) +#define BNSLRL() BNSLRLi(0) +#define BUNLRL() BUNLRLi(0) +#define BNULRL() BNULRLi(0) + +#define BLTCTR() BLTCTRi(0) +#define BLECTR() BLECTRi(0) +#define BEQCTR() BEQCTRi(0) +#define BGECTR() BGECTRi(0) +#define BGTCTR() BGTCTRi(0) +#define BNLCTR() BNLCTRi(0) +#define BNECTR() BNECTRi(0) +#define BNGCTR() BNGCTRi(0) +#define BSOCTR() BSOCTRi(0) +#define BNSCTR() BNSCTRi(0) +#define BUNCTR() BUNCTRi(0) +#define BNUCTR() BNUCTRi(0) + +#define BLTCTRL() BLTCTRLi(0)+#define BLECTRL() BLECTRLi(0)+#define BEQCTRL() BEQCTRLi(0)+#define BGECTRL() BGECTRLi(0)+#define BGTCTRL() BGTCTRLi(0)+#define BNLCTRL() BNLCTRLi(0)+#define BNECTRL() BNECTRLi(0)+#define BNGCTRL() BNGCTRLi(0)+#define BSOCTRL() BSOCTRLi(0)+#define BNSCTRL() BNSCTRLi(0)+#define BUNCTRL() BUNCTRLi(0)+#define BNUCTRL() BNUCTRLi(0)+++#define BLTii(C,D) BC_EXT(12, ((C)<<2)+0, D) /* [1, Table F-11] */+#define BNLii(C,D) BC_EXT( 4, ((C)<<2)+0, D)+#define BGEii(C,D) BC_EXT( 4, ((C)<<2)+0, D)+#define BGTii(C,D) BC_EXT(12, ((C)<<2)+1, D)+#define BNGii(C,D) BC_EXT( 4, ((C)<<2)+1, D)+#define BLEii(C,D) BC_EXT( 4, ((C)<<2)+1, D)+#define BEQii(C,D) BC_EXT(12, ((C)<<2)+2, D)+#define BNEii(C,D) BC_EXT( 4, ((C)<<2)+2, D)+#define BSOii(C,D) BC_EXT(12, ((C)<<2)+3, D)+#define BNSii(C,D) BC_EXT( 4, ((C)<<2)+3, D)+#define BUNii(C,D) BC_EXT(12, ((C)<<2)+3, D)+#define BNUii(C,D) BC_EXT( 4, ((C)<<2)+3, D)++#define BLTi(D) BLTii(0,D) /* with implicit _cr0 */+#define BLEi(D) BLEii(0,D)+#define BEQi(D) BEQii(0,D)+#define BGEi(D) BGEii(0,D)+#define BGTi(D) BGTii(0,D)+#define BNLi(D) BNLii(0,D)+#define BNEi(D) BNEii(0,D)+#define BNGi(D) BNGii(0,D)+#define BSOi(D) BSOii(0,D)+#define BNSi(D) BNSii(0,D)+#define BUNi(D) BUNii(0,D)+#define BNUi(D) BNUii(0,D)++#define BLTLii(C,D) BCLiii(12, ((C)<<2)+0, D) /* [1, Table F-??] */+#define BLELii(C,D) BCLiii( 4, ((C)<<2)+1, D)+#define BEQLii(C,D) BCLiii(12, ((C)<<2)+2, D)+#define BGELii(C,D) BCLiii( 4, ((C)<<2)+0, D)+#define BGTLii(C,D) BCLiii(12, ((C)<<2)+1, D)+#define BNLLii(C,D) BCLiii( 4, ((C)<<2)+0, D)+#define BNELii(C,D) BCLiii( 4, ((C)<<2)+2, D)+#define BNGLii(C,D) BCLiii( 4, ((C)<<2)+1, D)+#define BSOLii(C,D) BCLiii(12, ((C)<<2)+3, D)+#define BNSLii(C,D) BCLiii( 4, ((C)<<2)+3, D)+#define BUNLii(C,D) BCLiii(12, ((C)<<2)+3, D)+#define BNULii(C,D) BCLiii( 4, ((C)<<2)+3, D)++#define BLTLi(D) BLTLii(0,D) /* with implicit _cr0 */+#define BLELi(D) BLELii(0,D)+#define BEQLi(D) BEQLii(0,D)+#define BGELi(D) BGELii(0,D)+#define BGTLi(D) BGTLii(0,D)+#define BNLLi(D) BNLLii(0,D)+#define BNELi(D) BNELii(0,D)+#define BNGLi(D) BNGLii(0,D)+#define BSOLi(D) BSOLii(0,D)+#define BNSLi(D) BNSLii(0,D)+#define BUNLi(D) BUNLii(0,D)+#define BNULi(D) BNULii(0,D)++/* Note: there are many tens of other simplified branches that are not (yet?) defined here */++#define CRSETi(BX) CREQViii(BX, BX, BX) /* [1, Table F-15] */+#define CRCLRi(BX) CRXORiii(BX, BX, BX)+#define CRMOVEii(BX,BY) CRORiii(BX, BY, BY)+#define CRNOTii(BX,BY) CRNORiii(BX, BY, BY)+ +#define MTLRr(RS) MTSPRir(8, RS) /* [1, Table F-20] */+#define MFLRr(RD) MFSPRri(RD, 8)+#define MTCTRr(RS) MTSPRir(9, RS)+#define MFCTRr(RD) MFSPRri(RD, 9)+#define MTXERr(RS) MTSPRir(1, RS)+#define MFXERr(RD) MFSPRri(RD, 1)+ +#define NOP() ORIrri(0, 0, 0) /* [1, Section F.9] */+#define LIri(RD,IM) ADDIrri(RD, 0, IM)+#define LISri(RD,IM) ADDISrri(RD, 0, IM)+#define LArm(RD,D,RA) ADDIrri(RD, RA, D)+#define LArrr(RD,RB,RA) ADDIrrr(RD, RA, RB)+#define MRrr(RA,RS) ORrrr(RA, RS, RS)+#define NOTrr(RA,RS) NORrrr(RA, RS, RS)++/* alternative parenthesised forms of extended indexed load/store insns */++#define LBZUrx(RD,RA,RB) LBZUXrrr(RD,RA,RB)+#define LBZrx(RD,RA,RB) LBZXrrr(RD,RA,RB)+#define LHAUrx(RD,RA,RB) LHAUXrrr(RD,RA,RB)+#define LHArx(RD,RA,RB) LHAXrrr(RD,RA,RB)+#define LHBRrx(RD,RA,RB) LHBRXrrr(RD,RA,RB)+#define LHZUrx(RD,RA,RB) LHZUXrrr(RD,RA,RB)+#define LHZrx(RD,RA,RB) LHZXrrr(RD,RA,RB)+#define LWBRrx(RD,RA,RB) LWBRXrrr(RD,RA,RB)+#define LWZUrx(RD, RA, RB) LWZUXrrr(RD, RA, RB)+#define LWZrx(RD, RA, RB) LWZXrrr(RD, RA, RB)+#define STBUrx(RD,RA,RB) STBUXrrr(RD,RA,RB)+#define STBrx(RD,RA,RB) STBXrrr(RD,RA,RB)+#define STHBRrx(RS,RA,RB) STHBRXrrr(RS,RA,RB)+#define STHUrx(RS,RA,RB) STHUXrrr(RS,RA,RB)+#define STHrx(RS,RA,RB) STHXrrr(RS,RA,RB)+#define STWBRrx(RS,RA,RB) STWBRXrrr(RS,RA,RB)+#define STWCrx(RS,RA,RB) STWCXrrr(RS,RA,RB)+#define STWCX_rx(RS,RA,RB) STWCX_rrr(RS,RA,RB)+#define STWUrx(RS,RA,RB) STWUXrrr(RS,RA,RB)+#define STWrx(RS,RA,RB) STWXrrr(RS,RA,RB)+#define LArx(RD,RB,RA) LArrr(RD,RB,RA) +++#define _LO(I) (_jit_UL(I) & _MASK(16))+#define _HI(I) (_jit_UL(I) >> (16))++#define _A(OP,RD,RA,RB,RC,XO,RCx) _jit_I((_u6(OP)<<26)|(_u5(RD)<<21)|(_u5(RA)<<16)|( _u5(RB)<<11)|_u5(RC)<<6|(_u5(XO)<<1)|_u1(RCx))++#define LFDrri(RD,RA,imm) _D(50,RD,RA,imm)+#define LFDUrri(RD,RA,imm) _D(51,RD,RA,imm)+#define LFDUxrrr(RD,RA,RB) _X(31,RD,RA,RB,631,0)+#define LFDxrrr(RD,RA,RB) _X(31,RD,RA,RB,599,0)++#define LFSrri(RD,RA,imm) _D(48,RD,RA,imm)+#define LFSUrri(RD,RA,imm) _D(49,RD,RA,imm)+#define LFSUxrrr(RD,RA,RB) _X(31,RD,RA,RB,567,0)+#define LFSxrrr(RD,RA,RB) _X(31,RD,RA,RB,535,0)++#define STFDrri(RS,RA,imm) _D(54,RS,RA,imm)+#define STFDUrri(RS,RA,imm) _D(55,RS,RA,imm)+#define STFDUxrrr(RS,RA,RB) _X(31,RS,RA,RB,759,0)+#define STFDxrrr(RS,RA,RB) _X(31,RS,RA,RB,727,0)++#define STFSrri(RS,RA,imm) _D(52,RS,RA,imm)+#define STFSUrri(RS,RA,imm) _D(53,RS,RA,imm)+#define STFSUxrrr(RS,RA,RB) _X(31,RS,RA,RB,695,0)+#define STFSxrrr(RS,RA,RB) _X(31,RS,RA,RB,663,0)+#define STFIWXrrr(RS,RA,RB) _X(31,RS,RA,RB,983,0)++#define FADDDrrr(RD,RA,RB) _A(63,RD,RA,RB,0,21,0)+#define FADDSrrr(RD,RA,RB) _A(59,RD,RA,RB,0,21,0)+#define FSUBDrrr(RD,RA,RB) _A(63,RD,RA,RB,0,20,0)+#define FSUBSrrr(RD,RA,RB) _A(59,RD,RA,RB,0,20,0)+#define FMULDrrr(RD,RA,RC) _A(63,RD,RA,0,RC,25,0)+#define FMULSrrr(RD,RA,RC) _A(59,RD,RA,0,RC,25,0)+#define FDIVDrrr(RD,RA,RB) _A(63,RD,RA,RB,0,18,0)+#define FDIVSrrr(RD,RA,RB) _A(59,RD,RA,RB,0,25,0)+#define FSQRTDrr(RD,RB) _A(63,RD,0,RB,0,22,0)+#define FSQRTSrr(RD,RB) _A(59,RD,0,RB,0,22,0)+#define FSELrrrr(RD,RA,RB,RC) _A(63,RD,RA,RB,RC,23,0)+#define FCTIWrr(RD,RB) _X(63,RD,0,RB,14,0)+#define FCTIWZrr(RD,RB) _X(63,RD,0,RB,15,0)+#define FRSPrr(RD,RB) _X(63,RD,0,RB,12,0)+#define FABSrr(RD,RB) _X(63,RD,0,RB,264,0)+#define FNABSrr(RD,RB) _X(63,RD,0,RB,136,0)+#define FNEGrr(RD,RB) _X(63,RD,0,RB,40,0)+#define FMOVErr(RD,RB) _X(63,RD,0,RB,72,0)+#define FCMPOrrr(CR,RA,RB) _X(63,_u3((CR)<<2),RA,RB,32,0)+#define FCMPUrrr(CR,RA,RB) _X(63,_u3((CR)<<2),RA,RB,0,0)+#define MTFSFIri(CR,IMM) _X(63,_u5((CR)<<2),0,_u5((IMM)<<1),134,0)++/*** References:+ *+ * [1] "PowerPC Microprocessor Family: The Programming Environments For 32-Bit Microprocessors", Motorola, 1997.+ */+++#endif+#endif /* __ccg_asm_ppc_h */
@@ -0,0 +1,298 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer (PowerPC version)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/+++++#ifndef __lightning_core_h+#define __lightning_core_h++struct jit_local_state {+ int nextarg_puti; /* number of integer args */+ int nextarg_putf; /* number of float args */+ int nextarg_putd; /* number of double args */+ int nextarg_geti; /* Next r20-r25 reg. to be read */+ int nextarg_getd; /* The FP args are picked up from FPR1 -> FPR10 */+ int nbArgs; /* Number of arguments for the prolog */+};++#define JIT_SP 1+#define JIT_RET 3+#define JIT_R_NUM 3+#define JIT_V_NUM 7+#define JIT_R(i) (9+(i))+#define JIT_V(i) (31-(i))+#define JIT_AUX JIT_V(JIT_V_NUM) /* for 32-bit operands & shift counts */++#define jit_pfx_start() (_jit.jitl.trampolines)+#define jit_pfx_end() (_jit.jitl.free)++/* If possible, use the `small' instruction (rd, rs, imm)+ * else load imm into r26 and use the `big' instruction (rd, rs, r26)+ */+#define jit_chk_ims(imm, small, big) (_siP(16,(imm)) ? (small) : (MOVEIri(JIT_AUX, imm), (big)) )+#define jit_chk_imu(imm, small, big) (_uiP(16,(imm)) ? (small) : (MOVEIri(JIT_AUX, imm), (big)) )+#define jit_chk_imu15(imm, small, big) (_uiP(15,(imm)) ? (small) : (MOVEIri(JIT_AUX, imm), (big)) )++#define jit_big_ims(imm, big) (MOVEIri(JIT_AUX, imm), (big))+#define jit_big_imu(imm, big) (MOVEIri(JIT_AUX, imm), (big))++/* Helper macros for branches */+#define jit_s_brai(rs, is, jmp) (jit_chk_ims (is, CMPWIri(rs, is), CMPWrr(rs, JIT_AUX)), jmp, _jit.x.pc)+#define jit_s_brar(s1, s2, jmp) ( CMPWrr(s1, s2), jmp, _jit.x.pc)+#define jit_u_brai(rs, is, jmp) (jit_chk_imu (is, CMPLWIri(rs, is), CMPLWrr(rs, JIT_AUX)), jmp, _jit.x.pc)+#define jit_u_brar(s1, s2, jmp) ( CMPLWrr(s1, s2), jmp, _jit.x.pc)++/* Helper macros for boolean tests. */+#define jit_sbooli(d, rs, is, jmp) (jit_chk_ims (is, CMPWIri (rs, is), CMPWrr(rs, JIT_AUX)), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)))+#define jit_sboolr(d, s1, s2, jmp) ( CMPWrr (s1, s2), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)))+#define jit_sbooli2(d, rs, is, jmp) (jit_chk_ims (is, CMPWIri (rs, is), CMPWrr(rs, JIT_AUX)), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)), XORIrri((d), (d), 1))+#define jit_sboolr2(d, s1, s2, jmp) ( CMPWrr (s1, s2), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)), XORIrri((d), (d), 1))+#define jit_ubooli(d, rs, is, jmp) (jit_chk_imu (is, CMPLWIri(rs, is), CMPLWrr(rs, JIT_AUX)), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)))+#define jit_uboolr(d, s1, s2, jmp) ( CMPLWrr (s1, s2), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)))+#define jit_ubooli2(d, rs, is, jmp) (jit_chk_imu (is, CMPLWIri(rs, is), CMPLWrr(rs, JIT_AUX)), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)), XORIrri((d), (d), 1))+#define jit_uboolr2(d, s1, s2, jmp) ( CMPLWrr (s1, s2), MFCRr((d)), EXTRWIrrii((d), (d), 1, (jmp)), XORIrri((d), (d), 1))++/* modulus with immediate+ * movei r26, imm+ * mtlr r31+ * divw r31, rs, r26 (or divwu)+ * mullw r31, r31, r26+ * sub rs, rs, r26+ * mflr r31+ */++#define _jit_mod(div, rs, imm) (MOVEIri(JIT_AUX, (imm)), MTLRr(31), (div), \+ MULLWrrr(31, 31, JIT_AUX), SUBrrr((rs), (rs), JIT_AUX), \+ MFLRr(31))++/* Patch a movei instruction made of a LIS at lis_pc and an ORI at ori_pc. */+#define jit_patch_movei(lis_pc, ori_pc, dest) \+ (*(lis_pc) &= ~_MASK(16), *(lis_pc) |= _HI(dest), \+ *(ori_pc) &= ~_MASK(16), *(ori_pc) |= _LO(dest)) \++/* Patch a branch instruction */+#define jit_patch_branch(jump_pc,pv) \+ (*(jump_pc) &= ~_MASK(16) | 3, \+ *(jump_pc) |= (_jit_UL(pv) - _jit_UL(jump_pc)) & _MASK(16))++#define jit_patch_ucbranch(jump_pc,pv) \+ (*(jump_pc) &= ~_MASK(26) | 3, \+ (*(jump_pc) |= (_jit_UL((pv)) - _jit_UL(jump_pc)) & _MASK(26)))++#define _jit_b_encoding (18 << 26)+#define _jit_blr_encoding ((19 << 26) | (20 << 21) | (00 << 16) | (00 << 11) | (16 << 1))+#define _jit_is_ucbranch(a) (((*(a) & (63<<26)) == _jit_b_encoding))++#define jit_patch_at(jump_pc, value) ( \+ ((*(jump_pc - 1) & ~1) == _jit_blr_encoding) \+ ? jit_patch_movei(((jump_pc) - 4), ((jump_pc) - 3), (value)) \+ : ( _jit_is_ucbranch((jump_pc) - 1) \+ ? jit_patch_ucbranch((jump_pc) - 1, (value)) \+ : jit_patch_branch((jump_pc) - 1, (value))))++#define jit_patch_movi(movi_pc, val) \+ jit_patch_movei((movi_pc) - 2, (movi_pc) - 1, (val))++#define jit_arg_c() (_jitl.nextarg_geti--)+#define jit_arg_i() (_jitl.nextarg_geti--)+#define jit_arg_l() (_jitl.nextarg_geti--)+#define jit_arg_p() (_jitl.nextarg_geti--)+#define jit_arg_s() (_jitl.nextarg_geti--)+#define jit_arg_uc() (_jitl.nextarg_geti--)+#define jit_arg_ui() (_jitl.nextarg_geti--)+#define jit_arg_ul() (_jitl.nextarg_geti--)+#define jit_arg_us() (_jitl.nextarg_geti--)++/* Check Mach-O-Runtime documentation: Must skip GPR(s) whenever "corresponding" FPR is used */+#define jit_arg_f() (_jitl.nextarg_geti-- ,_jitl.nextarg_getd++)+#define jit_arg_d() (_jitl.nextarg_geti-=2,_jitl.nextarg_getd++)++#define jit_addi_i(d, rs, is) jit_chk_ims((is), ADDICrri((d), (rs), (is)), ADDrrr((d), (rs), JIT_AUX))+#define jit_addr_i(d, s1, s2) ADDrrr((d), (s1), (s2))+#define jit_addci_i(d, rs, is) jit_chk_ims((is), ADDICrri((d), (rs), (is)), ADDCrrr((d), (rs), JIT_AUX))+#define jit_addcr_i(d, s1, s2) ADDCrrr((d), (s1), (s2))+#define jit_addxi_i(d, rs, is) (MOVEIri(JIT_AUX, (is)), ADDErrr((d), (rs), JIT_AUX))+#define jit_addxr_i(d, s1, s2) ADDErrr((d), (s1), (s2))+#define jit_andi_i(d, rs, is) jit_chk_imu((is), ANDI_rri((d), (rs), (is)), ANDrrr((d), (rs), JIT_AUX))+#define jit_andr_i(d, s1, s2) ANDrrr((d), (s1), (s2))+#define jit_bmsi_i(label, rs, is) (jit_chk_imu((is), ANDI_rri(JIT_AUX, (rs), (is)), AND_rrr(JIT_AUX, (rs), JIT_AUX)), BGTi((label)), _jit.x.pc)+#define jit_bmci_i(label, rs, is) (jit_chk_imu((is), ANDI_rri(JIT_AUX, (rs), (is)), AND_rrr(JIT_AUX, (rs), JIT_AUX)), BEQi((label)), _jit.x.pc)+#define jit_bmsr_i(label, s1, s2) ( AND_rrr(JIT_AUX, (s1), (s2)), BGTi((label)), _jit.x.pc)+#define jit_bmcr_i(label, s1, s2) ( AND_rrr(JIT_AUX, (s1), (s2)), BEQi((label)), _jit.x.pc)+#define jit_beqi_i(label, rs, is) jit_s_brai((rs), (is), BEQi((label)) )+#define jit_beqr_i(label, s1, s2) jit_s_brar((s1), (s2), BEQi((label)) )+#define jit_bgei_i(label, rs, is) jit_s_brai((rs), (is), BGEi((label)) )+#define jit_bgei_ui(label, rs, is) jit_u_brai((rs), (is), BGEi((label)) )+#define jit_bger_i(label, s1, s2) jit_s_brar((s1), (s2), BGEi((label)) )+#define jit_bger_ui(label, s1, s2) jit_u_brar((s1), (s2), BGEi((label)) )+#define jit_bgti_i(label, rs, is) jit_s_brai((rs), (is), BGTi((label)) )+#define jit_bgti_ui(label, rs, is) jit_u_brai((rs), (is), BGTi((label)) )+#define jit_bgtr_i(label, s1, s2) jit_s_brar((s1), (s2), BGTi((label)) )+#define jit_bgtr_ui(label, s1, s2) jit_u_brar((s1), (s2), BGTi((label)) )+#define jit_blei_i(label, rs, is) jit_s_brai((rs), (is), BLEi((label)) )+#define jit_blei_ui(label, rs, is) jit_u_brai((rs), (is), BLEi((label)) )+#define jit_bler_i(label, s1, s2) jit_s_brar((s1), (s2), BLEi((label)) )+#define jit_bler_ui(label, s1, s2) jit_u_brar((s1), (s2), BLEi((label)) )+#define jit_blti_i(label, rs, is) jit_s_brai((rs), (is), BLTi((label)) )+#define jit_blti_ui(label, rs, is) jit_u_brai((rs), (is), BLTi((label)) )+#define jit_bltr_i(label, s1, s2) jit_s_brar((s1), (s2), BLTi((label)) )+#define jit_bltr_ui(label, s1, s2) jit_u_brar((s1), (s2), BLTi((label)) )+#define jit_bnei_i(label, rs, is) jit_s_brai((rs), (is), BNEi((label)) )+#define jit_bner_i(label, s1, s2) jit_s_brar((s1), (s2), BNEi((label)) )+#define jit_boaddi_i(label, rs, is) (MOVEIri(JIT_AUX, (is)), ADDOrrr((rs), (rs), JIT_AUX), MCRXRi(0), BGTi((label)), _jit.x.pc) /* GT = bit 1 of XER = OV */+#define jit_bosubi_i(label, rs, is) (MOVEIri(JIT_AUX, (is)), SUBCOrrr((rs), (rs), JIT_AUX), MCRXRi(0), BGTi((label)), _jit.x.pc)+#define jit_boaddr_i(label, s1, s2) ( ADDOrrr((s1), (s1), (s2)), MCRXRi(0), BGTi((label)), _jit.x.pc)+#define jit_bosubr_i(label, s1, s2) ( SUBCOrrr((s1), (s1), (s2)), MCRXRi(0), BGTi((label)), _jit.x.pc)+#define jit_boaddi_ui(label, rs, is) (jit_chk_ims ((is), ADDICri((rs), (rs), is), ADDCrr((rs), JIT_AUX)), MCRXRi(0), BEQi((label)), _jit.x.pc) /* EQ = bit 2 of XER = CA */+#define jit_bosubi_ui(label, rs, is) (jit_chk_ims ((is), SUBICri((rs), (rs), is), SUBCrr((rs), JIT_AUX)), MCRXRi(0), BEQi((label)), _jit.x.pc)+#define jit_boaddr_ui(label, s1, s2) ( ADDCrr((s1), (s1), (s2)), MCRXRi(0), BEQi((label)), _jit.x.pc)+#define jit_bosubr_ui(label, s1, s2) ( SUBCrr((s1), (s1), (s2)), MCRXRi(0), BEQi((label)), _jit.x.pc)+#define jit_calli(label) (jit_movi_p(JIT_AUX, (label)), MTCTRr(JIT_AUX), BCTRL(), _jitl.nextarg_puti = _jitl.nextarg_putf = _jitl.nextarg_putd = 0, _jit.x.pc)+#define jit_callr(reg) (MTCTRr(reg), BCTRL())+#define jit_divi_i(d, rs, is) jit_big_ims((is), DIVWrrr ((d), (rs), JIT_AUX))+#define jit_divi_ui(d, rs, is) jit_big_imu((is), DIVWUrrr((d), (rs), JIT_AUX))+#define jit_divr_i(d, s1, s2) DIVWrrr ((d), (s1), (s2))+#define jit_divr_ui(d, s1, s2) DIVWUrrr((d), (s1), (s2))+#define jit_eqi_i(d, rs, is) (jit_chk_ims((is), SUBIrri(JIT_AUX, (rs), (is)), SUBrrr(JIT_AUX, (rs), JIT_AUX)), SUBFICrri((d), JIT_AUX, 0), ADDErrr((d), (d), JIT_AUX))+#define jit_eqr_i(d, s1, s2) (SUBrrr(JIT_AUX, (s1), (s2)), SUBFICrri((d), JIT_AUX, 0), ADDErrr((d), (d), JIT_AUX))+#define jit_extr_c_i(d, rs) EXTSBrr((d), (rs))+#define jit_extr_s_i(d, rs) EXTSHrr((d), (rs))+#define jit_gei_i(d, rs, is) jit_sbooli2((d), (rs), (is), _lt)+#define jit_gei_ui(d, rs, is) jit_ubooli2((d), (rs), (is), _lt)+#define jit_ger_i(d, s1, s2) jit_sboolr2((d), (s1), (s2), _lt)+#define jit_ger_ui(d, s1, s2) jit_uboolr2((d), (s1), (s2), _lt)+#define jit_gti_i(d, rs, is) jit_sbooli ((d), (rs), (is), _gt)+#define jit_gti_ui(d, rs, is) jit_ubooli ((d), (rs), (is), _gt)+#define jit_gtr_i(d, s1, s2) jit_sboolr ((d), (s1), (s2), _gt)+#define jit_gtr_ui(d, s1, s2) jit_uboolr ((d), (s1), (s2), _gt)+#define jit_hmuli_i(d, rs, is) jit_big_ims((is), MULHWrrr ((d), (rs), JIT_AUX))+#define jit_hmuli_ui(d, rs, is) jit_big_imu((is), MULHWUrrr((d), (rs), JIT_AUX))+#define jit_hmulr_i(d, s1, s2) MULHWrrr ((d), (s1), (s2))+#define jit_hmulr_ui(d, s1, s2) MULHWUrrr((d), (s1), (s2))+#define jit_jmpi(label) (B_EXT((label)), _jit.x.pc)+#define jit_jmpr(reg) (MTLRr(reg), BLR())+#define jit_ldxi_c(d, rs, is) (jit_ldxi_uc((d), (rs), (is)), jit_extr_c_i((d), (d)))+#define jit_ldxr_c(d, s1, s2) (jit_ldxr_uc((d), (s1), (s2)), jit_extr_c_i((d), (d)))+#define jit_ldxi_i(d, rs, is) jit_chk_ims((d), LWZrm((d), (is), (rs)), LWZrx((d), JIT_AUX, (rs)))+#define jit_ldxi_s(d, rs, is) jit_chk_ims((d), LHArm((d), (is), (rs)), LHArx((d), JIT_AUX, (rs)))+#define jit_ldxi_uc(d, rs, is) jit_chk_ims((d), LBZrm((d), (is), (rs)), LBZrx((d), JIT_AUX, (rs)))+#define jit_ldxi_us(d, rs, is) jit_chk_ims((d), LHZrm((d), (is), (rs)), LHZrx((d), JIT_AUX, (rs)))+#define jit_ldxr_i(d, s1, s2) LWZrx((d), (s1), (s2))+#define jit_ldxr_s(d, s1, s2) LHArx((d), (s1), (s2))+#define jit_ldxr_uc(d, s1, s2) LBZrx((d), (s1), (s2))+#define jit_ldxr_us(d, s1, s2) LHZrx((d), (s1), (s2))+#define jit_lei_i(d, rs, is) jit_sbooli2((d), (rs), (is), _gt )+#define jit_lei_ui(d, rs, is) jit_ubooli2((d), (rs), (is), _gt )+#define jit_ler_i(d, s1, s2) jit_sboolr2((d), (s1), (s2), _gt )+#define jit_ler_ui(d, s1, s2) jit_uboolr2((d), (s1), (s2), _gt )+#define jit_lshi_i(d, rs, is) SLWIrri((d), (rs), (is))+#define jit_lshr_i(d, s1, s2) (ANDI_rri(JIT_AUX, (s2), 31), SLWrrr ((d), (s1), JIT_AUX))+#define jit_lti_i(d, rs, is) jit_sbooli ((d), (rs), (is), _lt )+#define jit_lti_ui(d, rs, is) jit_ubooli ((d), (rs), (is), _lt )+#define jit_ltr_i(d, s1, s2) jit_sboolr ((d), (s1), (s2), _lt )+#define jit_ltr_ui(d, s1, s2) jit_uboolr ((d), (s1), (s2), _lt )+#define jit_modi_i(d, rs, is) _jit_mod(jit_divi_i (31, (rs), JIT_AUX), (rs), (is))+#define jit_modi_ui(d, rs, is) _jit_mod(jit_divi_ui(31, (rs), JIT_AUX), (rs), (is))+#define jit_modr_i(d, s1, s2) (DIVWrrr(JIT_AUX, (s1), (s2)), MULLWrrr(JIT_AUX, JIT_AUX, (s2)), SUBrrr((d), (s1), JIT_AUX))+#define jit_modr_ui(d, s1, s2) (DIVWUrrr(JIT_AUX, (s1), (s2)), MULLWrrr(JIT_AUX, JIT_AUX, (s2)), SUBrrr((d), (s1), JIT_AUX))+#define jit_movi_i(d, is) MOVEIri((d), (is))+#define jit_movi_p(d, is) (LISri((d), _HI((is))),ORIrri((d),(d),_LO((is))),_jit.x.pc)++#define jit_movr_i(d, rs) MRrr((d), (rs))+#define jit_muli_i(d, rs, is) jit_chk_ims ((is), MULLIrri((d), (rs), (is)), MULLWrrr((d), (rs), JIT_AUX))+#define jit_muli_ui(d, rs, is) jit_chk_imu15((is), MULLIrri((d), (rs), (is)), MULLWrrr((d), (rs), JIT_AUX))+#define jit_mulr_i(d, s1, s2) MULLWrrr((d), (s1), (s2))+#define jit_mulr_ui(d, s1, s2) MULLWrrr((d), (s1), (s2))+#define jit_nei_i(d, rs, is) (jit_chk_ims((is), SUBIrri(JIT_AUX, (rs), (is)), SUBrrr(JIT_AUX, (rs), JIT_AUX)), ADDICrri((d), JIT_AUX, -1), SUBFErrr((d), (d), JIT_AUX))+#define jit_ner_i(d, s1, s2) (SUBrrr(JIT_AUX, (s1), (s2)), ADDICrri((d), JIT_AUX, -1), SUBFErrr((d), (d), JIT_AUX))+#define jit_nop() NOP()+#define jit_ori_i(d, rs, is) jit_chk_imu((is), ORIrri((d), (rs), (is)), ORrrr((d), (rs), JIT_AUX))+#define jit_orr_i(d, s1, s2) ORrrr((d), (s1), (s2))+#define jit_popr_i(rs) (LWZrm((rs), 0, 1), ADDIrri(1, 1, 4))+#define jit_prepare_i(numi) (_jitl.nextarg_puti = numi)+#define jit_prepare_f(numf) (_jitl.nextarg_putf = numf)+#define jit_prepare_d(numd) (_jitl.nextarg_putd = numd)+#define jit_prolog(n) _jit_prolog(&_jit, (n))+#define jit_pushr_i(rs) STWUrm((rs), -4, 1)+#define jit_pusharg_i(rs) (--_jitl.nextarg_puti, MRrr((3 + _jitl.nextarg_putd * 2 + _jitl.nextarg_putf + _jitl.nextarg_puti), (rs)))+#define jit_ret() _jit_epilog(&_jit)+#define jit_retval_i(rd) MRrr((rd), 3)+#define jit_rsbi_i(d, rs, is) jit_chk_ims((is), SUBFICrri((d), (rs), (is)), SUBFCrrr((d), (rs), JIT_AUX))+#define jit_rshi_i(d, rs, is) SRAWIrri((d), (rs), (is))+#define jit_rshi_ui(d, rs, is) SRWIrri ((d), (rs), (is))+#define jit_rshr_i(d, s1, s2) (ANDI_rri(JIT_AUX, (s2), 31), SRAWrrr ((d), (s1), JIT_AUX))+#define jit_rshr_ui(d, s1, s2) (ANDI_rri(JIT_AUX, (s2), 31), SRWrrr ((d), (s1), JIT_AUX))+#define jit_stxi_c(id, rd, rs) jit_chk_ims((id), STBrm((rs), (id), (rd)), STBrx((rs), (rd), JIT_AUX))+#define jit_stxi_i(id, rd, rs) jit_chk_ims((id), STWrm((rs), (id), (rd)), STWrx((rs), (rd), JIT_AUX))+#define jit_stxi_s(id, rd, rs) jit_chk_ims((id), STHrm((rs), (id), (rd)), STHrx((rs), (rd), JIT_AUX))+#define jit_stxr_c(d1, d2, rs) STBrx((rs), (d1), (d2))+#define jit_stxr_i(d1, d2, rs) STWrx((rs), (d1), (d2))+#define jit_stxr_s(d1, d2, rs) STHrx((rs), (d1), (d2))+#define jit_subr_i(d, s1, s2) SUBrrr((d), (s1), (s2))+#define jit_subcr_i(d, s1, s2) SUBCrrr((d), (s1), (s2))+#define jit_subxi_i(d, rs, is) jit_big_ims((is), SUBErrr((d), (rs), JIT_AUX))+#define jit_subxr_i(d, s1, s2) SUBErrr((d), (s1), (s2))+#define jit_xori_i(d, rs, is) jit_chk_imu((is), XORIrri((d), (rs), (is)), XORrrr((d), (rs), JIT_AUX))+#define jit_xorr_i(d, s1, s2) XORrrr((d), (s1), (s2))++/* Cannot use JIT_RZERO because having 0 in a register field on the PowerPC+ * does not mean `a register whose value is 0', but rather `no register at+ * all' */++#define jit_negr_i(d, rs) jit_rsbi_i((d), (rs), 0)+#define jit_negr_l(d, rs) jit_rsbi_l((d), (rs), 0)+#define jit_ldr_c(rd, rs) jit_ldxr_c((rd), 0, (rs)) +#define jit_str_c(rd, rs) jit_stxr_c(0, (rd), (rs)) +#define jit_ldr_s(rd, rs) jit_ldxr_s((rd), 0, (rs)) +#define jit_str_s(rd, rs) jit_stxr_s(0, (rd), (rs)) +#define jit_ldr_i(rd, rs) jit_ldxr_i((rd), 0, (rs)) +#define jit_str_i(rd, rs) jit_stxr_i(0, (rd), (rs)) +#define jit_ldr_uc(rd, rs) jit_ldxr_uc((rd), 0, (rs)) +#define jit_ldr_us(rd, rs) jit_ldxr_us((rd), 0, (rs)) ++/* e.g.+ * 0x01234567 _HA << 16 = 0x01230000 _LA = 0x00004567 _HA << 16 + LA = 0x01234567+ * 0x89abcdef _HA << 16 = 0x89ac0000 _LA = 0xffffcdef _HA << 16 + LA = 0x89abcdef+ */+#define _HA(addr) ((_jit_UL(addr) >> 16) + (_jit_US(_jit_UL(addr)) >> 15))+#define _LA(addr) (_jit_UL(addr) - (_HA(addr) << 16))++#define jit_ldi_c(rd, is) (LISri(JIT_AUX, _HA(is)), jit_ldxi_c((rd), JIT_AUX, _LA(is)))+#define jit_sti_c(id, rs) (LISri(JIT_AUX, _HA(id)), jit_stxi_c(_LA(id), JIT_AUX, (rs)))+#define jit_ldi_s(rd, is) (LISri(JIT_AUX, _HA(is)), jit_ldxi_s((rd), JIT_AUX, _LA(is)))+#define jit_sti_s(id, rs) (LISri(JIT_AUX, _HA(id)), jit_stxi_s(_LA(id), JIT_AUX, (rs)))+#define jit_ldi_i(rd, is) (LISri(JIT_AUX, _HA(is)), jit_ldxi_i((rd), JIT_AUX, _LA(is)))+#define jit_sti_i(id, rs) (LISri(JIT_AUX, _HA(id)), jit_stxi_i(_LA(id), JIT_AUX, (rs)))+#define jit_ldi_uc(rd, is) (LISri(JIT_AUX, _HA(is)), jit_ldxi_uc((rd), JIT_AUX, _LA(is)))+#define jit_ldi_us(rd, is) (LISri(JIT_AUX, _HA(is)), jit_ldxi_us((rd), JIT_AUX, _LA(is)))++#endif /* __lightning_core_h */
@@ -0,0 +1,211 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler & support macros for the Sparc math unit+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/+++++#ifndef __lightning_asm_fp_h+#define __lightning_asm_fp_h+++#define JIT_FPR_NUM 6+#define JIT_FPR(i) (8+(i))++#define JIT_FPFR 0++/* Make space for 1 or 2 words, store address in REG */+#define jit_data(REG, D1) (_FBA (18, 8, 0, 1), _jit_L(D1), MFLRr(REG))++#define jit_addr_d(rd,s1,s2) FADDDrrr((rd),(s1),(s2))+#define jit_subr_d(rd,s1,s2) FSUBDrrr((rd),(s1),(s2))+#define jit_mulr_d(rd,s1,s2) FMULDrrr((rd),(s1),(s2))+#define jit_divr_d(rd,s1,s2) FDIVDrrr((rd),(s1),(s2))++#define jit_addr_f(rd,s1,s2) FADDSrrr((rd),(s1),(s2))+#define jit_subr_f(rd,s1,s2) FSUBSrrr((rd),(s1),(s2))+#define jit_mulr_f(rd,s1,s2) FMULSrrr((rd),(s1),(s2))+#define jit_divr_f(rd,s1,s2) FDIVSrrr((rd),(s1),(s2))++#define jit_movr_d(rd,rs) ( (rd) == (rs) ? 0 : FMOVErr((rd),(rs)))+#define jit_movi_d(reg0,d) do { \+ double _v = (d); \+ _FBA (18, 12, 0, 1); \+ memcpy(_jit.x.uc_pc, &_v, sizeof (double)); \+ _jit.x.uc_pc += sizeof (double); \+ MFLRr (JIT_AUX); \+ jit_ldxi_d((reg0), JIT_AUX, 0); \+ } while(0) +++#define jit_movr_f(rd,rs) ( (rd) == (rs) ? 0 : FMOVErr((rd),(rs)))+#define jit_movi_f(reg0,f) do { \+ float _v = (f); \+ _FBA (18, 8, 0, 1); \+ memcpy(_jit.x.uc_pc, &_v, sizeof (float)); \+ _jit.x.uc_pc += sizeof (float); \+ MFLRr (JIT_AUX); \+ jit_ldxi_f((reg0), JIT_AUX, 0); \+ } while(0) +++#define jit_abs_d(rd,rs) FABSrr((rd),(rs))+#define jit_negr_d(rd,rs) FNEGrr((rd),(rs))+#define jit_sqrt_d(rd,rs) FSQRTDrr((rd),(rs))+++#define jit_ldxi_f(reg0, rs, is) (_siP(16,(is)) ? LFSrri((reg0),(rs),(is)) : (MOVEIri(JIT_AUX,(is)),LFSxrrr((reg0),(rs),JIT_AUX))) +#define jit_ldxi_d(reg0, rs, is) (_siP(16,(is)) ? LFDrri((reg0),(rs),(is)) : (MOVEIri(JIT_AUX,(is)),LFDxrrr((reg0),(rs),JIT_AUX)))+#define jit_ldxr_f(reg0, s1, s2) LFSxrrr((reg0),(s1),(s2))+#define jit_ldxr_d(reg0, s1, s2) LFDxrrr((reg0),(s1),(s2))+#define jit_ldi_f(reg0, is) (_siP(16,(is)) ? LFSrri((reg0),0,(is)) : (MOVEIri(JIT_AUX,(is)),LFSrri((reg0),JIT_AUX,0)))+#define jit_ldi_d(reg0, is) (_siP(16,(is)) ? LFDrri((reg0),0,(is)) : (MOVEIri(JIT_AUX,(is)),LFDrri((reg0),JIT_AUX,0)))+#define jit_ldr_f(reg0, rs) LFSrri((reg0),(rs),0)+#define jit_ldr_d(reg0, rs) LFDrri((reg0),(rs),0)+#define jit_stxi_f(id, rd, reg0) (_siP(16,(id)) ? STFSrri((reg0),(rd),(id)) : (MOVEIri(JIT_AUX,(id)),STFSrri((reg0),(rd),JIT_AUX))) +#define jit_stxi_d(id, rd, reg0) (_siP(16,(id)) ? STFDrri((reg0),(rd),(id)) : (MOVEIri(JIT_AUX,(id)),STFDrri((reg0),(rd),JIT_AUX))) +#define jit_stxr_f(d1, d2, reg0) STFSxrrr((reg0),(d1),(d2))+#define jit_stxr_d(d1, d2, reg0) STFDxrrr((reg0),(d1),(d2))+#define jit_sti_f(id, reg0) (_siP(16,(id)) ? STFSrri((reg0),0,(id)) : (MOVEIri(JIT_AUX,(id)),STFSrri((reg0),JIT_AUX,0)))+#define jit_sti_d(id, reg0) (_siP(16,(id)) ? STFDrri((reg0),0,(id)) : (MOVEIri(JIT_AUX,(id)),STFDrri((reg0),JIT_AUX,0)))+#define jit_str_f(rd, reg0) STFSrri((reg0),(rd),0)+#define jit_str_d(rd, reg0) STFDrri((reg0),(rd),0)++#define jit_fpboolr(d, s1, s2, rcbit) ( \+ FCMPOrrr(_cr0,(s1),(s2)), \+ MFCRr((d)), \+ EXTRWIrrii((d), (d), 1, (rcbit)))++#define jit_fpboolr_neg(d, s1, s2,rcbit) ( \+ FCMPOrrr(_cr0,(s1),(s2)), \+ MFCRr((d)), \+ EXTRWIrrii((d), (d), 1, (rcbit)), \+ XORIrri((d), (d), 1))++#define jit_fpboolur(d, s1, s2, rcbit) ( \+ FCMPUrrr(_cr0,(s1),(s2)), \+ MFCRr((d)), \+ EXTRWIrrii((d), (d), 1, (rcbit)))++#define jit_fpboolur_neg(d, s1, s2,rcbit) ( \+ FCMPUrrr(_cr0,(s1),(s2)), \+ MFCRr((d)), \+ EXTRWIrrii((d), (d), 1, (rcbit)), \+ XORIrri((d), (d), 1))++#define jit_fpboolur_or(d, s1, s2, bit1, bit2) (\+ FCMPUrrr(_cr0,(s1),(s2)), \+ CRORiii((bit1), (bit1), (bit2)), \+ MFCRr((d)), \+ EXTRWIrrii((d), (d), 1, (bit1)))++#define jit_gtr_d(d, s1, s2) jit_fpboolr ((d),(s1),(s2),_gt) +#define jit_ger_d(d, s1, s2) jit_fpboolr_neg((d),(s1),(s2),_lt) +#define jit_ltr_d(d, s1, s2) jit_fpboolr ((d),(s1),(s2),_lt) +#define jit_ler_d(d, s1, s2) jit_fpboolr_neg((d),(s1),(s2),_gt) +#define jit_eqr_d(d, s1, s2) jit_fpboolr ((d),(s1),(s2),_eq) +#define jit_ner_d(d, s1, s2) jit_fpboolr_neg((d),(s1),(s2),_eq)+#define jit_unordr_d(d, s1, s2) jit_fpboolur ((d),(s1),(s2),_un)+#define jit_ordr_d(d, s1, s2) jit_fpboolur_neg((d),(s1),(s2),_un)+#define jit_unler_d(d, s1, s2) jit_fpboolur_neg ((d), (s1), (s2), _gt)+#define jit_unltr_d(d, s1, s2) jit_fpboolur_or ((d), (s1), (s2), _un, _lt)+#define jit_unger_d(d, s1, s2) jit_fpboolur_neg ((d), (s1), (s2), _lt)+#define jit_ungtr_d(d, s1, s2) jit_fpboolur_or ((d), (s1), (s2), _un, _gt)+#define jit_ltgtr_d(d, s1, s2) jit_fpboolur_or ((d), (s1), (s2), _gt, _lt)+#define jit_uneqr_d(d, s1, s2) jit_fpboolur_or ((d), (s1), (s2), _un, _eq)++#define jit_fpbr(d, s1, s2, rcbit) ( \+ FCMPOrrr(_cr0,(s1),(s2)), \+ BTii ((rcbit), (d)))++#define jit_fpbr_neg(d, s1, s2,rcbit) ( \+ FCMPOrrr(_cr0,(s1),(s2)), \+ BFii ((rcbit), (d)))++#define jit_fpbur(d, s1, s2, rcbit) ( \+ FCMPUrrr(_cr0,(s1),(s2)), \+ BTii ((rcbit), (d)))++#define jit_fpbur_neg(d, s1, s2,rcbit) ( \+ FCMPUrrr(_cr0,(s1),(s2)), \+ BFii ((rcbit), (d)))++#define jit_fpbur_or(d, s1, s2, bit1, bit2) ( \+ FCMPUrrr(_cr0,(s1),(s2)), \+ CRORiii((bit1), (bit1), (bit2)), \+ BTii ((bit1), (d)))++#define jit_bgtr_d(d, s1, s2) jit_fpbr ((d),(s1),(s2),_gt) +#define jit_bger_d(d, s1, s2) jit_fpbr_neg((d),(s1),(s2),_lt) +#define jit_bltr_d(d, s1, s2) jit_fpbr ((d),(s1),(s2),_lt) +#define jit_bler_d(d, s1, s2) jit_fpbr_neg((d),(s1),(s2),_gt) +#define jit_beqr_d(d, s1, s2) jit_fpbr ((d),(s1),(s2),_eq) +#define jit_bner_d(d, s1, s2) jit_fpbr_neg((d),(s1),(s2),_eq)+#define jit_bunordr_d(d, s1, s2) jit_fpbur ((d),(s1),(s2),_un)+#define jit_bordr_d(d, s1, s2) jit_fpbur_neg((d),(s1),(s2),_un)+#define jit_bunler_d(d, s1, s2) jit_fpbur_neg ((d), (s1), (s2), _gt)+#define jit_bunltr_d(d, s1, s2) jit_fpbur_or ((d), (s1), (s2), _un, _lt)+#define jit_bunger_d(d, s1, s2) jit_fpbur_neg ((d), (s1), (s2), _lt)+#define jit_bungtr_d(d, s1, s2) jit_fpbur_or ((d), (s1), (s2), _un, _gt)+#define jit_bltgtr_d(d, s1, s2) jit_fpbur_or ((d), (s1), (s2), _gt, _lt)+#define jit_buneqr_d(d, s1, s2) jit_fpbur_or ((d), (s1), (s2), _un, _eq)++#define jit_getarg_f(rd, ofs) jit_movr_f((rd),(ofs))+#define jit_getarg_d(rd, ofs) jit_movr_d((rd),(ofs))+#define jit_pusharg_d(rs) (_jitl.nextarg_putd--,jit_movr_d((_jitl.nextarg_putf+_jitl.nextarg_putd+1), (rs)))+#define jit_pusharg_f(rs) (_jitl.nextarg_putf--,jit_movr_f((_jitl.nextarg_putf+_jitl.nextarg_putd+1), (rs)))+#define jit_retval_d(op1) jit_movr_d(1, (op1))+#define jit_retval_f(op1) jit_movr_f(1, (op1))+++#define jit_floorr_d_i(rd,rs) (MTFSFIri(7,3), \+ FCTIWrr(7,(rs)), \+ MOVEIri(JIT_AUX,-4), \+ STFIWXrrr(7,JIT_SP,JIT_AUX), \+ LWZrm((rd),-4,JIT_SP))++#define jit_ceilr_d_i(rd,rs) (MTFSFIri(7,2), \+ FCTIWrr(7,(rs)), \+ MOVEIri(JIT_AUX,-4), \+ STFIWXrrr(7,JIT_SP,JIT_AUX), \+ LWZrm((rd),-4,JIT_SP))++#define jit_roundr_d_i(rd,rs) (MTFSFIri(7,0), \+ FCTIWrr(7,(rs)), \+ MOVEIri(JIT_AUX,-4), \+ STFIWXrrr(7,JIT_SP,JIT_AUX), \+ LWZrm((rd),-4,JIT_SP))++#define jit_truncr_d_i(rd,rs) (FCTIWZrr(7,(rs)), \+ MOVEIri(JIT_AUX,-4), \+ STFIWXrrr(7,JIT_SP,JIT_AUX), \+ LWZrm((rd),-4,JIT_SP))++#endif /* __lightning_asm_h */
@@ -0,0 +1,164 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer inline functions (PowerPC)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_funcs_h+#define __lightning_funcs_h++#if !defined(__GNUC__) && !defined(__GNUG__)+#error Go get GNU C, I do not know how to flush the cache+#error with this compiler.+#else+static void+jit_flush_code(void *start, void *end)+{+#ifndef LIGHTNING_CROSS+ register char *ddest, *idest;++ static int cache_line_size;+ if (cache_line_size == 0) {+ char buffer[8192];+ int i, probe;++ /* Find out the size of a cache line by zeroing one */+ memset(buffer, 0xFF, 8192);+ __asm__ __volatile__ ("dcbz 0,%0" : : "r"(buffer + 4096));++ /* Probe for the beginning of the cache line. */+ for(i = 0, probe = 4096; probe; probe >>= 1)+ if (buffer[i | probe] != 0x00)+ i |= probe;++ /* i is now just before the start of the cache line */+ i++;+ for(cache_line_size = 1; i + cache_line_size < 8192; cache_line_size <<= 1)+ if (buffer[i + cache_line_size] != 0x00)+ break;+ }++ start -= ((long) start) & (cache_line_size - 1);+ end -= ((long) end) & (cache_line_size - 1);++ /* Force data cache write-backs */+ for (ddest = (char *) start; ddest <= (char *) end; ddest += cache_line_size) {+ __asm__ __volatile__ ("dcbst 0,%0" : : "r"(ddest));+ }+ __asm__ __volatile__ ("sync" : : );++ /* Now invalidate the instruction cache */+ for (idest = (char *) start; idest <= (char *) end; idest += cache_line_size) {+ __asm__ __volatile__ ("icbi 0,%0" : : "r"(idest));+ }+ __asm__ __volatile__ ("isync" : : );+#endif /* !LIGHTNING_CROSS */+}+#endif /* __GNUC__ || __GNUG__ */++#define _jit (*jit)++static void+_jit_epilog(jit_state *jit)+{+ int n = _jitl.nbArgs;+ int frame_size, ofs;+ int first_saved_reg = JIT_AUX - n;+ int num_saved_regs = 32 - first_saved_reg;++ frame_size = 24 + 32 + num_saved_regs * 4; /* r24..r31 + args */+ frame_size += 15; /* the stack must be quad-word */+ frame_size &= ~15; /* aligned */++#ifdef _CALL_DARWIN+ LWZrm(0, frame_size + 8, 1); /* lwz r0, x+8(r1) (ret.addr.) */+#else+ LWZrm(0, frame_size + 4, 1); /* lwz r0, x+4(r1) (ret.addr.) */+#endif+ MTLRr(0); /* mtspr LR, r0 */++ ofs = frame_size - num_saved_regs * 4;+ LMWrm(first_saved_reg, ofs, 1); /* lmw rI, ofs(r1) */+ ADDIrri(1, 1, frame_size); /* addi r1, r1, x */+ BLR(); /* blr */+}++/* Emit a prolog for a function.+ Upon entrance to the trampoline:+ - LR = address where the real code for the function lies+ - R3-R8 = parameters+ Upon finishing the trampoline:+ - R0 = return address for the function+ - R25-R20 = parameters (order is reversed, 1st argument is R25)+ + The +32 in frame_size computation is to accound for the parameter area of+ a function frame. ++ On PPC the frame must have space to host the arguments of any callee.+ However, as it currently stands, the argument to jit_trampoline (n) is+ the number of arguments of the caller we generate. Therefore, the+ callee can overwrite a part of the stack (saved register area when it+ flushes its own parameter on the stack. The addition of a constant + offset = 32 is enough to hold eight 4 bytes arguments. This is less+ than perfect but is a reasonable work around for now. + Better solution must be investigated. */+static void+_jit_prolog(jit_state *jit, int n)+{+ int frame_size;+ int ofs, i;+ int first_saved_reg = JIT_AUX - n;+ int num_saved_regs = 32 - first_saved_reg;++ _jitl.nextarg_geti = JIT_AUX - 1;+ _jitl.nextarg_getd = 1;+ _jitl.nbArgs = n;++ frame_size = 24 + 32 + num_saved_regs * 4; /* r27..r31 + args */+ frame_size += 15; /* the stack must be quad-word */+ frame_size &= ~15; /* aligned */++ MFLRr(0);+ STWUrm(1, -frame_size, 1); /* stwu r1, -x(r1) */++ ofs = frame_size - num_saved_regs * 4;+ STMWrm(first_saved_reg, ofs, 1); /* stmw rI, ofs(r1) */+#ifdef _CALL_DARWIN+ STWrm(0, frame_size + 8, 1); /* stw r0, x+8(r1) */+#else+ STWrm(0, frame_size + 4, 1); /* stw r0, x+4(r1) */+#endif+ for (i = 0; i < n; i++)+ MRrr(JIT_AUX-1-i, 3+i); /* save parameters below r24 */+}++#undef _jit++#endif /* __lightning_funcs_h */
@@ -0,0 +1,383 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler for the SPARC+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 1999, 2000, 2001, 2002 Ian Piumarta+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++++++#ifndef __lightning_asm_h+#define __lightning_asm_h+++/* <imm> = [0-9]+ -> add i, one parameter (imm)+ * <reg> = %<imm> -> add r, one parameter (imm or _Rr(imm) )+ * %g<imm> -> add r, one parameter (imm or _Rg(imm) )+ * %o<imm> -> add r, one parameter (imm+8 or _Ro(imm) )+ * %l<imm> -> add r, one parameter (imm+16 or _Rl(imm) )+ * %i<imm> -> add r, one parameter (imm+24 or _Ri(imm) )+ * <mem> = <imm>(<reg>) -> add m, two parameters (reg,imm)+ * <idx> = <reg>(<reg>) -> add x, two parameters (reg,reg)+ */+++typedef unsigned int jit_insn;++#ifndef LIGHTNING_DEBUG+#define _d30(BD) ((_jit_UL(BD) - _jit_UL(_jit.x.pc))>>2)+#define _d22(BD) _ck_d(22, _d30(BD))++#define _HI(I) (_jit_UL(I) >> (10))+#define _LO(I) (_jit_UL(I) & _MASK(10))++/* register names */++#define _y 0+#define _psr 1++#define _Rr(N) ( 0+(N))+#define _Rg(N) ( 0+(N))+#define _Ro(N) ( 8+(N))+#define _Rl(N) (16+(N))+#define _Ri(N) (24+(N))++/* instruction formats -- Figure 5-1, page 44 in */+/* SPARC International, "The SPARC Architecture Manual, Version 8", Prentice-Hall, 1992. */++#define _0i(RD, OP2, IMM) _jit_I((0<<30)| (_u5(RD)<<25)|(_u3(OP2)<<22)| _u22(IMM))+#define _0( A, CC, OP2, DSP) _jit_I((0<<30)|(_u1(A)<<29)|(_u4(CC)<<25)|(_u3(OP2)<<22)| _d22(DSP))+#define _0d( A, CC, OP2, DSP) _jit_I((0<<30)|(_u1(A)<<29)|(_u4(CC)<<25)|(_u3(OP2)<<22)| _u22(DSP))++#define _1( DSP) _jit_I((1<<30)| _d30(DSP))++#define _2( RD, OP3, RS1, I, ASI, RS2) _jit_I((2<<30)| (_u5(RD)<<25)|(_u6(OP3)<<19)|(_u5(RS1)<<14)|(_u1(I)<<13)|(_u8(ASI)<<5)|_u5 (RS2))+#define _2i(RD, OP3, RS1, I, IMM) _jit_I((2<<30)| (_u5(RD)<<25)|(_u6(OP3)<<19)|(_u5(RS1)<<14)|(_u1(I)<<13)| _s13(IMM))+#define _2f(RD, OP3, RS1, OPF, RS2) _jit_I((2<<30)| (_u5(RD)<<25)|(_u6(OP3)<<19)|(_u5(RS1)<<14)| (_u9(OPF)<<5)|_u5 (RS2))++#define _3( RD, OP3, RS1, I, ASI, RS2) _jit_I((3<<30)| (_u5(RD)<<25)|(_u6(OP3)<<19)|(_u5(RS1)<<14)|(_u1(I)<<13)|(_u8(ASI)<<5)|_u5 (RS2))+#define _3i(RD, OP3, RS1, I, IMM) _jit_I((3<<30)| (_u5(RD)<<25)|(_u6(OP3)<<19)|(_u5(RS1)<<14)|(_u1(I)<<13)| _s13(IMM))++#define _FP1(RD, RS1, OPF, RS2) _2f((RD), 52, (RS1), (OPF), (RS2))+#define _FP2(RD, RS1, OPF, RS2) _2f((RD), 53, (RS1), (OPF), (RS2))++/* basic instructions [Section B, page 87] */++#define ADDrrr(RS1, RS2, RD) _2 ((RD), 0, (RS1), 0, 0, (RS2))+#define ADDrir(RS1, IMM, RD) _2i ((RD), 0, (RS1), 1, (IMM))+#define ADDCCrrr(RS1, RS2, RD) _2 ((RD), 16, (RS1), 0, 0, (RS2))+#define ADDCCrir(RS1, IMM, RD) _2i ((RD), 16, (RS1), 1, (IMM))+#define ADDXrrr(RS1, RS2, RD) _2 ((RD), 8, (RS1), 0, 0, (RS2))+#define ADDXrir(RS1, IMM, RD) _2i ((RD), 8, (RS1), 1, (IMM))+#define ADDXCCrrr(RS1, RS2, RD) _2 ((RD), 24, (RS1), 0, 0, (RS2))+#define ADDXCCrir(RS1, IMM, RD) _2i ((RD), 24, (RS1), 1, (IMM))+#define ANDrrr(RS1, RS2, RD) _2 ((RD), 1, (RS1), 0, 0, (RS2))+#define ANDrir(RS1, IMM, RD) _2i ((RD), 1, (RS1), 1, (IMM))+#define ANDCCrrr(RS1, RS2, RD) _2 ((RD), 17, (RS1), 0, 0, (RS2))+#define ANDCCrir(RS1, IMM, RD) _2i ((RD), 17, (RS1), 1, (IMM))++#define BNi(DISP) _0 (0, 0, 2, (DISP))+#define BN_Ai(DISP) _0 (1, 0, 2, (DISP))+#define BEi(DISP) _0 (0, 1, 2, (DISP))+#define BE_Ai(DISP) _0 (1, 1, 2, (DISP))+#define BLEi(DISP) _0 (0, 2, 2, (DISP))+#define BLE_Ai(DISP) _0 (1, 2, 2, (DISP))+#define BLi(DISP) _0 (0, 3, 2, (DISP))+#define BL_Ai(DISP) _0 (1, 3, 2, (DISP))+#define BLEUi(DISP) _0 (0, 4, 2, (DISP))+#define BLEU_Ai(DISP) _0 (1, 4, 2, (DISP))+#define BCSi(DISP) _0 (0, 5, 2, (DISP))+#define BCS_Ai(DISP) _0 (1, 5, 2, (DISP))+#define BNEGi(DISP) _0 (0, 6, 2, (DISP))+#define BNEG_Ai(DISP) _0 (1, 6, 2, (DISP))+#define BVSi(DISP) _0 (0, 7, 2, (DISP))+#define BVS_Ai(DISP) _0 (1, 7, 2, (DISP))+#define BAi(DISP) _0 (0, 8, 2, (DISP))+#define BA_Ai(DISP) _0 (1, 8, 2, (DISP))+#define BNEi(DISP) _0 (0, 9, 2, (DISP))+#define BNE_Ai(DISP) _0 (1, 9, 2, (DISP))+#define BGi(DISP) _0 (0, 10, 2, (DISP))+#define BG_Ai(DISP) _0 (1, 10, 2, (DISP))+#define BGEi(DISP) _0 (0, 11, 2, (DISP))+#define BGE_Ai(DISP) _0 (1, 11, 2, (DISP))+#define BGUi(DISP) _0 (0, 12, 2, (DISP))+#define BGU_Ai(DISP) _0 (1, 12, 2, (DISP))+#define BCCi(DISP) _0 (0, 13, 2, (DISP))+#define BCC_Ai(DISP) _0 (1, 13, 2, (DISP))+#define BPOSi(DISP) _0 (0, 14, 2, (DISP))+#define BPOS_Ai(DISP) _0 (1, 14, 2, (DISP))+#define BVCi(DISP) _0 (0, 15, 2, (DISP))+#define BVC_Ai(DISP) _0 (1, 15, 2, (DISP))++#define CALLi(DISP) _1 ((DISP))++#define FLUSHrr(RS1, RS2) _2 (0, 0x3b, (RS1), 0, 0, (RS2))+#define FLUSHir(IMM, RS1) _2i (0, 0x3b, (RS1), 1, (IMM))++#define JMPLxr(RS1, RS2, RD) _2 ((RD), 56, (RS1), 0, 0, (RS2))+#define JMPLmr(RS1, IMM, RD) _2i ((RD), 56, (RS1), 1, (IMM))++#define LDxr(RS1, RS2, RD) _3 ((RD), 0, (RS1), 0, 0, (RS2))+#define LDmr(RS1, IMM, RD) _3i ((RD), 0, (RS1), 1, (IMM))+#define LDUBxr(RS1, RS2, RD) _3 ((RD), 1, (RS1), 0, 0, (RS2))+#define LDUBmr(RS1, IMM, RD) _3i ((RD), 1, (RS1), 1, (IMM))+#define LDUHxr(RS1, RS2, RD) _3 ((RD), 2, (RS1), 0, 0, (RS2))+#define LDUHmr(RS1, IMM, RD) _3i ((RD), 2, (RS1), 1, (IMM))+#define LDDxr(RS1, RS2, RD) _3 ((RD), 3, (RS1), 0, 0, (RS2))+#define LDDmr(RS1, IMM, RD) _3i ((RD), 3, (RS1), 1, (IMM))+#define LDSBxr(RS1, RS2, RD) _3 ((RD), 9, (RS1), 0, 0, (RS2))+#define LDSBmr(RS1, IMM, RD) _3i ((RD), 9, (RS1), 1, (IMM))+#define LDSHxr(RS1, RS2, RD) _3 ((RD), 10, (RS1), 0, 0, (RS2))+#define LDSHmr(RS1, IMM, RD) _3i ((RD), 10, (RS1), 1, (IMM))++#define ORrrr(RS1, RS2, RD) _2 ((RD), 2, (RS1), 0, 0, (RS2))+#define ORrir(RS1, IMM, RD) _2i ((RD), 2, (RS1), 1, (IMM))+#define ORCCrrr(RS1, RS2, RD) _2 ((RD), 18, (RS1), 0, 0, (RS2))+#define ORCCrir(RS1, IMM, RD) _2i ((RD), 18, (RS1), 1, (IMM))++#define RDir(RS, RD) _2 ((RD), (RS)|0x28, 0, 0, 0,0)+#define RESTORErrr(RS1, RS2, RD) _2 ((RD), 61, (RS1), 0, 0, (RS2))+#define RESTORErir(RS1, IMM, RD) _2i ((RD), 61, (RS1), 1, (IMM))++#define SAVErrr(RS1, RS2, RD) _2 ((RD), 60, (RS1), 0, 0, (RS2))+#define SAVErir(RS1, IMM, RD) _2i ((RD), 60, (RS1), 1, (IMM))+#define SDIVrrr(RS1, RS2, RD) _2 ((RD), 15, (RS1), 0, 0, (RS2))+#define SDIVrir(RS1, IMM, RD) _2i ((RD), 15, (RS1), 1, (IMM))+#define SDIVCCrrr(RS1, RS2, RD) _2 ((RD), 31, (RS1), 0, 0, (RS2))+#define SDIVCCrir(RS1, IMM, RD) _2i ((RD), 31, (RS1), 1, (IMM))+#define SETHIir(IMM, RD) _0i ((RD), 4, (IMM))+#define SLLrrr(RS1, RS2, RD) _2 ((RD), 37, (RS1), 0, 0, (RS2))+#define SLLrir(RS1, IMM, RD) _2i ((RD), 37, (RS1), 1, (IMM))+#define SMULrrr(RS1, RS2, RD) _2 ((RD), 11, (RS1), 0, 0, (RS2))+#define SMULrir(RS1, IMM, RD) _2i ((RD), 11, (RS1), 1, (IMM))+#define SMULCCrrr(RS1, RS2, RD) _2 ((RD), 27, (RS1), 0, 0, (RS2))+#define SMULCCrir(RS1, IMM, RD) _2i ((RD), 27, (RS1), 1, (IMM))+#define SRArrr(RS1, RS2, RD) _2 ((RD), 39, (RS1), 0, 0, (RS2))+#define SRArir(RS1, IMM, RD) _2i ((RD), 39, (RS1), 1, (IMM))+#define SRLrrr(RS1, RS2, RD) _2 ((RD), 38, (RS1), 0, 0, (RS2))+#define SRLrir(RS1, IMM, RD) _2i ((RD), 38, (RS1), 1, (IMM))+#define STrx(RS, RD1, RD2) _3 ((RS), 4, (RD1), 0, 0, (RD2))+#define STrm(RS, RD, IMM) _3i ((RS), 4, (RD), 1, (IMM))+#define STBrx(RS, RD1, RD2) _3 ((RS), 5, (RD1), 0, 0, (RD2))+#define STBrm(RS, RD, IMM) _3i ((RS), 5, (RD), 1, (IMM))+#define STBAR() _0i (0, 0x28, 15, 0, 0)+#define STHrx(RS, RD1, RD2) _3 ((RS), 6, (RD1), 0, 0, (RD2))+#define STHrm(RS, RD, IMM) _3i ((RS), 6, (RD), 1, (IMM))+#define STDrx(RS, RD1, RD2) _3 ((RS), 7, (RD1), 0, 0, (RD2))+#define STDrm(RS, RD, IMM) _3i ((RS), 7, (RD), 1, (IMM))+#define SUBrrr(RS1, RS2, RD) _2 ((RD), 4, (RS1), 0, 0, (RS2))+#define SUBrir(RS1, IMM, RD) _2i ((RD), 4, (RS1), 1, (IMM))+#define SUBCCrrr(RS1, RS2, RD) _2 ((RD), 20, (RS1), 0, 0, (RS2))+#define SUBCCrir(RS1, IMM, RD) _2i ((RD), 20, (RS1), 1, (IMM))+#define SUBXrrr(RS1, RS2, RD) _2 ((RD), 12, (RS1), 0, 0, (RS2))+#define SUBXrir(RS1, IMM, RD) _2i ((RD), 12, (RS1), 1, (IMM))+#define SUBXCCrrr(RS1, RS2, RD) _2 ((RD), 28, (RS1), 0, 0, (RS2))+#define SUBXCCrir(RS1, IMM, RD) _2i ((RD), 28, (RS1), 1, (IMM))++#define UDIVrrr(RS1, RS2, RD) _2 ((RD), 14, (RS1), 0, 0, (RS2))+#define UDIVrir(RS1, IMM, RD) _2i ((RD), 14, (RS1), 1, (IMM))+#define UDIVCCrrr(RS1, RS2, RD) _2 ((RD), 30, (RS1), 0, 0, (RS2))+#define UDIVCCrir(RS1, IMM, RD) _2i ((RD), 30, (RS1), 1, (IMM))+#define UMULrrr(RS1, RS2, RD) _2 ((RD), 10, (RS1), 0, 0, (RS2))+#define UMULrir(RS1, IMM, RD) _2i ((RD), 10, (RS1), 1, (IMM))+#define UMULCCrrr(RS1, RS2, RD) _2 ((RD), 26, (RS1), 0, 0, (RS2))+#define UMULCCrir(RS1, IMM, RD) _2i ((RD), 26, (RS1), 1, (IMM))++#define WRrri(RS1, RS2, RD) _2 (0, (RD)|0x30, RS1, 0, 0, (RS2))+#define WRrii(RS1, IMM, RD) _2i (0, (RD)|0x30, RS1, 1, (IMM))++#define XORrrr(RS1, RS2, RD) _2 ((RD), 3, (RS1), 0, 0, (RS2))+#define XORrir(RS1, IMM, RD) _2i ((RD), 3, (RS1), 1, (IMM))+#define XORCCrrr(RS1, RS2, RD) _2 ((RD), 19, (RS1), 0, 0, (RS2))+#define XORCCrir(RS1, IMM, RD) _2i ((RD), 19, (RS1), 1, (IMM))++/* synonyms */++#define Bi(DISP) BAi((DISP))+#define B_Ai(DISP) BA_Ai((DISP))+#define BNZi(DISP) BNEi((DISP))+#define BNZ_Ai(DISP) BNE_Ai((DISP))+#define BZi(DISP) BEi((DISP))+#define BZ_Ai(DISP) BE_Ai((DISP))+#define BGEUi(DISP) BCCi((DISP))+#define BGEU_Ai(DISP) BCC_Ai((DISP))+#define BLUi(DISP) BCSi((DISP))+#define BLU_Ai(DISP) BCS_Ai((DISP))++#define LDUWxr(RS1, RS2, RD) LDxr((RS1), (RS2), (RD))+#define LDUWmr(RS1, IMM, RD) LDmr((RS1), (IMM), (RD))+#define LDSWxr(RS1, RS2, RD) LDxr((RS1), (RS2), (RD))+#define LDSWmr(RS1, IMM, RD) LDmr((RS1), (IMM), (RD))++#define STWrx(RS, RD1, RD2) STrx((RS), (RD1), (RD2))+#define STWrm(RS, RD, IMM) STrm((RS), (RD), (IMM))++/* synthetic instructions [Table A-1, page 85] */++#define BCLRrr(R,S) ANDNrrr((R), (S), (S))+#define BCLRir(I,R) ANDNrir((R), (I), (R))+#define BSETrr(R,S) ORrrr((R), (S), (S))+#define BSETir(I,R) ORrir((R), (I), (R))+#define BTOGrr(R,S) XORrrr((R), (S), (S))+#define BTOGir(I,R) XORrir((R), (I), (R))+#define BTSTrr(R,S) ANDCCrrr((R), (S), 0)+#define BTSTir(I,R) ANDCCrir((R), (I), 0)++#define CALLm(R,I) JMPLmr((R), (I), _Ro(7))+#define CALLx(R,S) JMPLxr((R), (S), _Ro(7))++#define CLRr(R) ORrrr(0, 0, (R))+#define CLRBm(R,I) STBrm(0, (R), (I))+#define CLRBx(R,S) STBrm(0, (R), (S))+#define CLRHm(R,I) STHrm(0, (R), (I))+#define CLRHx(R,S) STHrm(0, (R), (S))+#define CLRm(R,I) STrm(0, (R), (I))+#define CLRx(R,S) STrm(0, (R), (S))++#define CMPrr(RS1, RS2) SUBCCrrr((RS1), (RS2), 0)+#define CMPri(RS1, IMM) SUBCCrir((RS1), (IMM), 0)++#define DECr(R) SUBrir((R), 1, (R))+#define DECir(I,R) SUBrir((R), (I), (R))+#define DECCCr(R) SUBCCrir((R), 1, (R))+#define DECCCir(I,R) SUBCCrir((R), (I), (R))++#define INCr(R) ADDrir((R), 1, (R))+#define INCir(I,R) ADDrir((R), (I), (R))+#define INCCCr(R) ADDCCrir((R), 1, (R))+#define INCCCir(I,R) ADDCCrir((R), (I), (R))++#define JMPm(R,I) JMPLmr((R), (I), 0)+#define JMPx(R,S) JMPLxr((R), (S), 0)++#define MOVrr(R,S) ORrrr(0, (R), (S))+#define MOVir(I, R) ORrir(0, (I), (R))++#define NEGrr(R,S) SUBrrr(0, (R), (S))+#define NEGr(R) SUBrrr(0, (R), (R))+#define NOP() SETHIir(0, 0)++#define NOTrr(R,S) XNORrrr((R), 0, (S))+#define NOTr(R) XNORrrr((R), 0, (R))++#define RESTORE() RESTORErrr(0, 0, 0)+#define RET() JMPLmr(_Ri(7),8 ,0)+#define RETL() JMPLmr(_Ro(7),8 ,0)++#define SAVE() SAVErrr(0, 0, 0)+#define SETir(I,R) (_siP(13,(I)) ? MOVir((I),(R)) : SETir2(_HI(I), _LO(I), (R)))+#define SETir2(H,L,R) (SETHIir(H,R), (L ? ORrir(R,L,R) : 0))++/* BNZ,a executes the delay instruction if NZ (so skips if Z)+ * BZ,a executes the delay instruction if Z (so skips if NZ). */+#define SKIPZ() _0d (1, 9, 2, 2) /* BNZ,a .+8 */+#define SKIPNZ() _0d (1, 1, 2, 2) /* BZ,a .+8 */+#define SKIP() _0d (1, 0, 2, 0) /* BN,a . */++#define TSTr(R) ORCCrrr(0, (R), 0)++#define WRii(IMM, RD) WRrii(0, (IMM), (RD))+#define WRri(RS2, RD) WRrri(0, (RS2), (RD))++#define LDFSRx(RS1, RS2) _3 (0, 33, (RS1), 0, 0, (RS2))+#define LDFSRm(RS1, IMM) _3i (0, 33, (RS1), 1, (IMM))+#define STFSRx(RD1, RD2) _3 (0, 37, (RD1), 0, 0, (RD2))+#define STFSRm(RD, IMM) _3i (0, 37, (RD), 1, (IMM))++#define FITODrr(FRS, FRD) _FP1((FRD), 0, 200, (FRS))+#define FITOSrr(FRS, FRD) _FP1((FRD), 0, 196, (FRS))+#define FDTOIrr(FRS, FRD) _FP1((FRD), 0, 210, (FRS))+#define FSTOIrr(FRS, FRD) _FP1((FRD), 0, 209, (FRS))+#define FSTODrr(FRS, FRD) _FP1((FRD), 0, 201, (FRS))+#define FDTOSrr(FRS, FRD) _FP1((FRD), 0, 198, (FRS))+#define FMOVSrr(FRS, FRD) _FP1((FRD), 0, 1, (FRS))+#define FNEGSrr(FRS, FRD) _FP1((FRD), 0, 5, (FRS))+#define FABSSrr(FRS, FRD) _FP1((FRD), 0, 9, (FRS))+#define FMOVDrr(FRS, FRD) _FP1((FRD), 0, 2, (FRS))+#define FNEGDrr(FRS, FRD) _FP1((FRD), 0, 6, (FRS))+#define FABSDrr(FRS, FRD) _FP1((FRD), 0, 10, (FRS))+#define FSQRTDrr(FRS, FRD) _FP1((FRD), 0, 42, (FRS))+#define FSQRTSrr(FRS, FRD) _FP1((FRD), 0, 41, (FRS))++#define FADDSrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 65, (FRS2))+#define FSUBSrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 69, (FRS2))+#define FMULSrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 73, (FRS2))+#define FDIVSrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 77, (FRS2))++#define FADDDrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 66, (FRS2))+#define FSUBDrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 70, (FRS2))+#define FMULDrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 74, (FRS2))+#define FDIVDrrr(FRS1, FRS2, FRD) _FP1((FRD), (FRS1), 78, (FRS2))++#define FCMPSrr(FRS1, FRS2) _FP2(0, (FRS1), 81, (FRS2))+#define FCMPDrr(FRS1, FRS2) _FP2(0, (FRS1), 82, (FRS2))++#define LDFxr(RS1, RS2, RD) _3 ((RD), 32, (RS1), 0, 0, (RS2))+#define LDFmr(RS1, IMM, RD) _3i ((RD), 32, (RS1), 1, (IMM))+#define LDDFxr(RS1, RS2, RD) _3 ((RD), 35, (RS1), 0, 0, (RS2))+#define LDDFmr(RS1, IMM, RD) _3i ((RD), 35, (RS1), 1, (IMM))+#define STFrx(RS, RD1, RD2) _3 ((RS), 36, (RD1), 0, 0, (RD2))+#define STFrm(RS, RD1, IMM) _3i ((RS), 36, (RD1), 1, (IMM))+#define STDFrx(RS, RD1, RD2) _3 ((RS), 39, (RD1), 0, 0, (RD2))+#define STDFrm(RS, RD1, IMM) _3i ((RS), 39, (RD1), 1, (IMM))++#define FBNi(DISP) _0 (0, 0, 6, (DISP))+#define FBN_Ai(DISP) _0 (1, 0, 6, (DISP))+#define FBNEi(DISP) _0 (0, 1, 6, (DISP))+#define FBNE_Ai(DISP) _0 (1, 1, 6, (DISP))+#define FBLGi(DISP) _0 (0, 2, 6, (DISP))+#define FBLG_Ai(DISP) _0 (1, 2, 6, (DISP))+#define FBULi(DISP) _0 (0, 3, 6, (DISP))+#define FBUL_Ai(DISP) _0 (1, 3, 6, (DISP))+#define FBLi(DISP) _0 (0, 4, 6, (DISP))+#define FBL_Ai(DISP) _0 (1, 4, 6, (DISP))+#define FBUGi(DISP) _0 (0, 5, 6, (DISP))+#define FBUG_Ai(DISP) _0 (1, 5, 6, (DISP))+#define FBGi(DISP) _0 (0, 6, 6, (DISP))+#define FBG_Ai(DISP) _0 (1, 6, 6, (DISP))+#define FBUi(DISP) _0 (0, 7, 6, (DISP))+#define FBU_Ai(DISP) _0 (1, 7, 6, (DISP))+#define FBAi(DISP) _0 (0, 8, 6, (DISP))+#define FBA_Ai(DISP) _0 (1, 8, 6, (DISP))+#define FBEi(DISP) _0 (0, 9, 6, (DISP))+#define FBE_Ai(DISP) _0 (1, 9, 6, (DISP))+#define FBUEi(DISP) _0 (0, 10, 6, (DISP))+#define FBUE_Ai(DISP) _0 (1, 10, 6, (DISP))+#define FBGEi(DISP) _0 (0, 11, 6, (DISP))+#define FBGE_Ai(DISP) _0 (1, 11, 6, (DISP))+#define FBUGEi(DISP) _0 (0, 12, 6, (DISP))+#define FBUGE_Ai(DISP) _0 (1, 12, 6, (DISP))+#define FBLEi(DISP) _0 (0, 13, 6, (DISP))+#define FBLE_Ai(DISP) _0 (1, 13, 6, (DISP))+#define FBULEi(DISP) _0 (0, 14, 6, (DISP))+#define FBULE_Ai(DISP) _0 (1, 14, 6, (DISP))+#define FBOi(DISP) _0 (0, 15, 6, (DISP))+#define FBO_Ai(DISP) _0 (1, 15, 6, (DISP))++#endif+#endif /* __ccg_asm_sparc_h */
@@ -0,0 +1,265 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer (Sparc version)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/+++#ifndef __lightning_core_h+#define __lightning_core_h++#define JIT_R_NUM 3+#define JIT_V_NUM 6+#define JIT_R(i) ((i) ? _Rl((i) - 1) : _Rg(2))+#define JIT_V(i) _Rl((i)+2)++#define JIT_BIG _Rg(1) /* %g1 used to make 32-bit operands */+#define JIT_BIG2 _Ro(7) /* %o7 used to make 32-bit compare operands */+#define JIT_SP _Ro(6)+#define JIT_RZERO _Rg(0)+#define JIT_RET _Ri(0)++/* Delay slot scheduling: jmp generates branches with annulled delay+ * slots; we toggle the annul bit if we can fill the slot. CALLs and+ * cond. branches have a different meaning for the annul bit, so we+ * automatically generate a NOP and eventually copy the delay insn onto+ * it. Delay slots in RET are already used for RESTORE, so we don't+ * schedule them.+ *+ * ,--- _jit.x.pc+ * insn X X before+ * cmp branch insn X X after (branch)+ * `--- _jit.x.pc + * call insn insn X after (call)+ * `--- _jit.x.pc + */++struct jit_local_state {+ int nextarg_put; /* Next %o reg. to be written */+ int nextarg_get; /* Next %i reg. to be read */+ jit_insn delay;+};++#define jit_fill_delay_after(branch) (_jitl.delay = *--_jit.x.pc, \+ ((branch) == _jit.x.pc /* check if NOP was inserted */ \+ ? (_jit.x.pc[-1] ^= 1<<29) /* no if branch, toggle annul bit */ \+ : (_jit.x.pc[-1] = _jitl.delay)), /* yes if call, replace NOP with delay insn */ \+ *_jit.x.pc = _jitl.delay, _jit.x.pc - 1) /* return addr of delay insn */++/* If possible, use the `small' instruction (rs, imm, rd)+ * else load imm into %l6 and use the `big' instruction (rs, %l6, rd)+ * jit_chk_imm2 uses %l7 instead of %l6 to avoid conflicts when using delay slots+ */+#define jit_chk_imm(imm, small, big) (_siP(13,(imm)) ? (small) : (SETir((imm), JIT_BIG), (big)) )+#define jit_chk_imm2(imm, small, big) (_siP(13,(imm)) ? (small) : (SETir((imm), JIT_BIG2), (big)) )++/* Helper macros for branches */+#define jit_branchi(rs, is, jmp, nop) (jit_chk_imm2(is, CMPri(rs, is), CMPrr(rs, JIT_BIG2)), jmp, nop, _jit.x.pc - 1)+#define jit_branchr(s1, s2, jmp, nop) ( CMPrr(s1, s2), jmp, nop, _jit.x.pc - 1)++/* Helper macros for boolean tests -- delay slot sets d to 1;+ * taken branch leaves it to 1, not-taken branch resets it to 0 */+#define jit_booli(d, rs, is, jmp) (jit_chk_imm (is, CMPri(rs, is), CMPrr(rs, JIT_BIG)), jmp, MOVir(1, (d)), MOVir(0, (d)))+#define jit_boolr(d, s1, s2, jmp) ( CMPrr(s1, s2), jmp, MOVir(1, (d)), MOVir(0, (d)))++/* Helper macros for division+ * The architecture specifies that there must be 3 instructions between *+ * a y register write and a use of it for correct results. */+#define jit_prepare_y(rs, is) (SRArir(rs, 31, JIT_BIG), WRri(JIT_BIG, _y), NOP(), NOP(), NOP(), _jit.x.pc -= jit_immsize(is))+#define jit_clr_y(rs, is) ( WRri(0, _y), NOP(), NOP(), NOP(), _jit.x.pc -= jit_immsize(is))++#define jit_modr(jit_div, jit_mul, d, s1, s2) \+ (jit_div (JIT_BIG, s1, s2), \+ jit_mul (JIT_BIG, JIT_BIG, s2), \+ jit_subr_i (d, s1, JIT_BIG))++#define jit_modi(jit_divi, jit_muli, jit_divr, jit_mulr, d, rs, is) \+ (_siP(13,(imm)) \+ ? (jit_divi (JIT_BIG, rs, is), \+ jit_muli (JIT_BIG, JIT_BIG, is), \+ jit_subr_i (d, rs, JIT_BIG)) \+ : (SETir ((is), JIT_BIG2), \+ jit_modr (jit_divr, jit_mulr, d, rs, JIT_BIG2)))++/* How many instruction are needed to put imm in a register. */+#define jit_immsize(imm) (!(imm) ? 0 : \+ (!_siP((imm), 13) && ((imm) & 0x3ff) ? 2 : 1))+++/* branch instructions return the address of the *delay* instruction -- this+ * is just a helper macro that makes jit_patch more readable.+ */+#define jit_patch_(jump_pc,pv) \+ (*jump_pc &= ~_MASK(22), \+ *jump_pc |= ((_jit_UL((pv)) - _jit_UL(jump_pc)) >> 2) & _MASK(22))++#define jit_patch_set(sethi_pc, or_pc, dest) \+ (*(sethi_pc) &= ~_MASK(22), *(sethi_pc) |= _HI(dest), \+ *(or_pc) &= ~_MASK(13), *(or_pc) |= _LO(dest)) \++#define jit_patch_movi(movi_pc, val) \+ jit_patch_set((movi_pc) - 2, (movi_pc) - 1, (val))++#define jit_arg_c() (_jitl.nextarg_get++)+#define jit_arg_i() (_jitl.nextarg_get++)+#define jit_arg_l() (_jitl.nextarg_get++)+#define jit_arg_p() (_jitl.nextarg_get++)+#define jit_arg_s() (_jitl.nextarg_get++)+#define jit_arg_uc() (_jitl.nextarg_get++)+#define jit_arg_ui() (_jitl.nextarg_get++)+#define jit_arg_ul() (_jitl.nextarg_get++)+#define jit_arg_us() (_jitl.nextarg_get++)+#define jit_addi_i(d, rs, is) jit_chk_imm((is), ADDrir((rs), (is), (d)), ADDrrr((rs), JIT_BIG, (d)))+#define jit_addr_i(d, s1, s2) ADDrrr((s1), (s2), (d))+#define jit_addci_i(d, rs, is) jit_chk_imm((is), ADDCCrir((rs), (is), (d)), ADDCCrrr((rs), JIT_BIG, (d)))+#define jit_addcr_i(d, s1, s2) ADDCCrrr((s1), (s2), (d))+#define jit_addxi_i(d, rs, is) jit_chk_imm((is), ADDXCCrir((rs), (is), (d)), ADDXCCrrr((rs), JIT_BIG, (d)))+#define jit_addxr_i(d, s1, s2) ADDXCCrrr((s1), (s2), (d))+#define jit_andi_i(d, rs, is) jit_chk_imm((is), ANDrir((rs), (is), (d)), ANDrrr((rs), JIT_BIG, (d)))+#define jit_andr_i(d, s1, s2) ANDrrr((s1), (s2), (d))+#define jit_beqi_i(label, rs, is) jit_branchi((rs), (is), BEi((label)), NOP() )+#define jit_beqr_i(label, s1, s2) jit_branchr((s1), (s2), BEi((label)), NOP() )+#define jit_bgei_i(label, rs, is) jit_branchi((rs), (is), BGEi((label)), NOP() )+#define jit_bgei_ui(label, rs, is) jit_branchi((rs), (is), BGEUi((label)), NOP() )+#define jit_bger_i(label, s1, s2) jit_branchr((s1), (s2), BGEi((label)), NOP() )+#define jit_bger_ui(label, s1, s2) jit_branchr((s1), (s2), BGEUi((label)), NOP() )+#define jit_bgti_i(label, rs, is) jit_branchi((rs), (is), BGi((label)), NOP() )+#define jit_bgti_ui(label, rs, is) jit_branchi((rs), (is), BGUi((label)), NOP() )+#define jit_bgtr_i(label, s1, s2) jit_branchr((s1), (s2), BGi((label)), NOP() )+#define jit_bgtr_ui(label, s1, s2) jit_branchr((s1), (s2), BGUi((label)), NOP() )+#define jit_blei_i(label, rs, is) jit_branchi((rs), (is), BLEi((label)), NOP() )+#define jit_blei_ui(label, rs, is) jit_branchi((rs), (is), BLEUi((label)), NOP() )+#define jit_bler_i(label, s1, s2) jit_branchr((s1), (s2), BLEi((label)), NOP() )+#define jit_bler_ui(label, s1, s2) jit_branchr((s1), (s2), BLEUi((label)), NOP() )+#define jit_blti_i(label, rs, is) jit_branchi((rs), (is), BLi((label)), NOP() )+#define jit_blti_ui(label, rs, is) jit_branchi((rs), (is), BLUi((label)), NOP() )+#define jit_bltr_i(label, s1, s2) jit_branchr((s1), (s2), BLi((label)), NOP() )+#define jit_bltr_ui(label, s1, s2) jit_branchr((s1), (s2), BLUi((label)), NOP() )+#define jit_bnei_i(label, rs, is) jit_branchi((rs), (is), BNEi((label)), NOP() )+#define jit_bner_i(label, s1, s2) jit_branchr((s1), (s2), BNEi((label)), NOP() )+#define jit_bmsi_i(label, rs, is) (jit_chk_imm((is), BTSTir((is), (rs)), BTSTrr((rs), JIT_BIG)), BNEi((label)), NOP(), _jit.x.pc - 1)+#define jit_bmci_i(label, rs, is) (jit_chk_imm((is), BTSTir((is), (rs)), BTSTrr((rs), JIT_BIG)), BEi((label)), NOP(), _jit.x.pc - 1)+#define jit_bmsr_i(label, s1, s2) ( BTSTrr((s1), (s2)), BNEi((label)), NOP(), _jit.x.pc - 1)+#define jit_bmcr_i(label, s1, s2) ( BTSTrr((s1), (s2)), BEi((label)), NOP(), _jit.x.pc - 1)+#define jit_boaddi_i(label, rs, is) (jit_chk_imm((is), ADDCCrir((rs), (is), (rs)), ADDCCrrr((rs), JIT_BIG, (rs))), BVSi((label)), NOP(), _jit.x.pc - 1)+#define jit_bosubi_i(label, rs, is) (jit_chk_imm((is), SUBCCrir((rs), (is), (rs)), SUBCCrrr((rs), JIT_BIG, (rs))), BVSi((label)), NOP(), _jit.x.pc - 1)+#define jit_boaddr_i(label, s1, s2) ( ADDCCrrr((s1), (s2), (s1)), BVSi((label)), NOP(), _jit.x.pc - 1)+#define jit_bosubr_i(label, s1, s2) ( SUBCCrrr((s1), (s2), (s1)), BVSi((label)), NOP(), _jit.x.pc - 1)+#define jit_boaddi_ui(label, rs, is) (jit_chk_imm((is), ADDCCrir((rs), (is), (rs)), ADDCCrrr((rs), JIT_BIG, (rs))), BCSi((label)), NOP(), _jit.x.pc - 1)+#define jit_bosubi_ui(label, rs, is) (jit_chk_imm((is), SUBCCrir((rs), (is), (rs)), SUBCCrrr((rs), JIT_BIG, (rs))), BCSi((label)), NOP(), _jit.x.pc - 1)+#define jit_boaddr_ui(label, s1, s2) ( ADDCCrrr((s1), (s2), (s1)), BCSi((label)), NOP(), _jit.x.pc - 1)+#define jit_bosubr_ui(label, s1, s2) ( SUBCCrrr((s1), (s2), (s1)), BCSi((label)), NOP(), _jit.x.pc - 1)+#define jit_calli(label) (CALLi(label), NOP(), _jit.x.pc - 1)+#define jit_callr(reg) (CALLx((reg), 0), NOP())++#define jit_divi_i(d, rs, is) (jit_prepare_y((rs), 0x12345678), SETir((is), JIT_BIG), SDIVrrr((rs), JIT_BIG, (d)) )+#define jit_divi_ui(d, rs, is) (jit_clr_y((rs), 0x12345678), SETir((is), JIT_BIG), UDIVrrr((rs), JIT_BIG, (d)) )+#define jit_divr_i(d, s1, s2) (jit_prepare_y((s1), 0), SDIVrrr((s1), (s2), (d)))+#define jit_divr_ui(d, s1, s2) (jit_clr_y((s1), 0), UDIVrrr((s1), (s2), (d)))+#define jit_eqi_i(d, rs, is) jit_chk_imm((is), \+ (SUBCCrir((rs), (is), (d)), ADDXCCrir((d), -1, JIT_BIG), SUBXrir(0,-1,(d))),\+ jit_eqr_i(d, rs, JIT_BIG))+#define jit_eqr_i(d, s1, s2) (SUBCCrrr((s1), (s2), (d)), ADDXCCrir((d), -1, JIT_BIG), SUBXrir(0,-1,(d)))+#define jit_nei_i(d, rs, is) jit_chk_imm((is), \+ (SUBCCrir((rs), (is), (d)), ADDXCCrir((d), -1, JIT_BIG), ADDXrrr(0,0,(d))),\+ jit_ner_i(d, rs, JIT_BIG))+#define jit_ner_i(d, s1, s2) (SUBCCrrr((s1), (s2), (d)), ADDXCCrir((d), -1, JIT_BIG), ADDXrrr(0,0,(d)))+#define jit_gei_i(d, rs, is) jit_booli ((d), (rs), (is), BGEi(_jit.x.pc + 3) )+#define jit_gei_ui(d, rs, is) jit_booli ((d), (rs), (is), BGEUi(_jit.x.pc + 3))+#define jit_ger_i(d, s1, s2) jit_boolr ((d), (s1), (s2), BGEi(_jit.x.pc + 3) )+#define jit_ger_ui(d, s1, s2) jit_boolr ((d), (s1), (s2), BGEUi(_jit.x.pc + 3))+#define jit_gti_i(d, rs, is) jit_booli ((d), (rs), (is), BGi(_jit.x.pc + 3) )+#define jit_gti_ui(d, rs, is) jit_booli ((d), (rs), (is), BGUi(_jit.x.pc + 3) )+#define jit_gtr_i(d, s1, s2) jit_boolr ((d), (s1), (s2), BGi(_jit.x.pc + 3) )+#define jit_gtr_ui(d, s1, s2) jit_boolr ((d), (s1), (s2), BGUi(_jit.x.pc + 3) )+#define jit_hmuli_i(d, rs, is) (jit_muli_i (JIT_BIG, (rs), (is)), RDir (_y, (d)))+#define jit_hmuli_ui(d, rs, is) (jit_muli_ui(JIT_BIG, (rs), (is)), RDir (_y, (d)))+#define jit_hmulr_i(d, s1, s2) (jit_mulr_i (JIT_BIG, (s1), (s2)), RDir (_y, (d)))+#define jit_hmulr_ui(d, s1, s2) (jit_mulr_ui(JIT_BIG, (s1), (s2)), RDir (_y, (d)))+#define jit_jmpi(label) (BA_Ai((label)), _jit.x.pc)+#define jit_jmpr(reg) (JMPx(JIT_RZERO, (reg)), NOP(), _jit.x.pc - 1)+#define jit_ldxi_c(d, rs, is) jit_chk_imm((is), LDSBmr((rs), (is), (d)), LDSBxr((rs), JIT_BIG, (d)))+#define jit_ldxi_i(d, rs, is) jit_chk_imm((is), LDSWmr((rs), (is), (d)), LDSWxr((rs), JIT_BIG, (d)))+#define jit_ldxi_s(d, rs, is) jit_chk_imm((is), LDSHmr((rs), (is), (d)), LDSHxr((rs), JIT_BIG, (d)))+#define jit_ldxi_uc(d, rs, is) jit_chk_imm((is), LDUBmr((rs), (is), (d)), LDUBxr((rs), JIT_BIG, (d)))+#define jit_ldxi_us(d, rs, is) jit_chk_imm((is), LDUHmr((rs), (is), (d)), LDUHxr((rs), JIT_BIG, (d)))+#define jit_ldxr_c(d, s1, s2) LDSBxr((s1), (s2), (d))+#define jit_ldxr_i(d, s1, s2) LDSWxr((s1), (s2), (d))+#define jit_ldxr_s(d, s1, s2) LDSHxr((s1), (s2), (d))+#define jit_ldxr_uc(d, s1, s2) LDUBxr((s1), (s2), (d))+#define jit_ldxr_us(d, s1, s2) LDUHxr((s1), (s2), (d))+#define jit_lei_i(d, rs, is) jit_booli ((d), (rs), (is), BLEi(_jit.x.pc + 3) )+#define jit_lei_ui(d, rs, is) jit_booli ((d), (rs), (is), BLEUi(_jit.x.pc + 3))+#define jit_ler_i(d, s1, s2) jit_boolr ((d), (s1), (s2), BLEi(_jit.x.pc + 3) )+#define jit_ler_ui(d, s1, s2) jit_boolr ((d), (s1), (s2), BLEUi(_jit.x.pc + 3))+#define jit_lshi_i(d, rs, is) SLLrir((rs), (is), (d))+#define jit_lshr_i(d, r1, r2) SLLrrr((r1), (r2), (d))+#define jit_lti_i(d, rs, is) jit_booli ((d), (rs), (is), BLi(_jit.x.pc + 3) )+#define jit_lti_ui(d, rs, is) jit_booli ((d), (rs), (is), BLUi(_jit.x.pc + 3) )+#define jit_ltr_i(d, s1, s2) jit_boolr ((d), (s1), (s2), BLi(_jit.x.pc + 3) )+#define jit_ltr_ui(d, s1, s2) jit_boolr ((d), (s1), (s2), BLUi(_jit.x.pc + 3) )+#define jit_modi_i(d, rs, is) jit_modi(jit_divi_i, jit_muli_i, jit_divr_i, jit_mulr_i, (d), (rs), (is))+#define jit_modi_ui(d, rs, is) jit_modi(jit_divi_ui, jit_muli_ui, jit_divr_ui, jit_mulr_ui, (d), (rs), (is))+#define jit_modr_i(d, s1, s2) jit_modr(jit_divr_i, jit_mulr_i, (d), (s1), (s2))+#define jit_modr_ui(d, s1, s2) jit_modr(jit_divr_ui, jit_mulr_ui, (d), (s1), (s2))+#define jit_movi_i(d, is) SETir((is), (d))+#define jit_movi_p(d, is) (SETir2(_HI((is)), _LO((is)), (d)), _jit.x.pc)+#define jit_movr_i(d, rs) MOVrr((rs), (d))+#define jit_muli_i(d, rs, is) jit_chk_imm((is), SMULrir((rs), (is), (d)), SMULrrr((rs), JIT_BIG, (d)))+#define jit_muli_ui(d, rs, is) jit_chk_imm((is), UMULrir((rs), (is), (d)), UMULrrr((rs), JIT_BIG, (d)))+#define jit_mulr_i(d, s1, s2) SMULrrr((s1), (s2), (d))+#define jit_mulr_ui(d, s1, s2) UMULrrr((s1), (s2), (d))+#define jit_nop() NOP()+#define jit_ori_i(d, rs, is) jit_chk_imm((is), ORrir((rs), (is), (d)), ORrrr((rs), JIT_BIG, (d)))+#define jit_orr_i(d, s1, s2) ORrrr((s1), (s2), (d))+#define jit_patch_at(delay_pc, pv) jit_patch_ (((delay_pc) - 1) , (pv))+#define jit_popr_i(rs) (LDmr(JIT_SP, 0, (rs)), ADDrir(JIT_SP, 8, JIT_SP))+#define jit_prepare_i(num) (_jitl.nextarg_put += (num))+#define jit_prolog(numargs) (SAVErir(JIT_SP, -120, JIT_SP), _jitl.nextarg_get = _Ri(0))+#define jit_pushr_i(rs) (STrm((rs), JIT_SP, -8), SUBrir(JIT_SP, 8, JIT_SP))+#define jit_pusharg_i(rs) (--_jitl.nextarg_put, MOVrr((rs), _Ro(_jitl.nextarg_put)))+#define jit_ret() (RET(), RESTORE())+#define jit_retval_i(rd) MOVrr(_Ro(0), (rd))+#define jit_rshi_i(d, rs, is) SRArir((rs), (is), (d))+#define jit_rshi_ui(d, rs, is) SRLrir((rs), (is), (d))+#define jit_rshr_i(d, r1, r2) SRArrr((r1), (r2), (d))+#define jit_rshr_ui(d, r1, r2) SRLrrr((r1), (r2), (d))+#define jit_stxi_c(id, rd, rs) jit_chk_imm((id), STBrm((rs), (rd), (id)), STBrx((rs), (rd), JIT_BIG))+#define jit_stxi_i(id, rd, rs) jit_chk_imm((id), STWrm((rs), (rd), (id)), STWrx((rs), (rd), JIT_BIG))+#define jit_stxi_s(id, rd, rs) jit_chk_imm((id), STHrm((rs), (rd), (id)), STHrx((rs), (rd), JIT_BIG))+#define jit_stxr_c(d1, d2, rs) STBrx((rs), (d1), (d2))+#define jit_stxr_i(d1, d2, rs) STWrx((rs), (d1), (d2))+#define jit_stxr_s(d1, d2, rs) STHrx((rs), (d1), (d2))+#define jit_subr_i(d, s1, s2) SUBrrr((s1), (s2), (d))+#define jit_subcr_i(d, s1, s2) SUBCCrrr((s1), (s2), (d))+#define jit_subxi_i(d, rs, is) jit_chk_imm((is), SUBXCCrir((rs), (is), (d)), SUBXCCrrr((rs), JIT_BIG, (d)))+#define jit_subxr_i(d, s1, s2) SUBXCCrrr((s1), (s2), (d))+#define jit_xori_i(d, rs, is) jit_chk_imm((is), XORrir((rs), (is), (d)), XORrrr((rs), JIT_BIG, (d)))+#define jit_xorr_i(d, s1, s2) XORrrr((s1), (s2), (d))++#endif /* __lightning_core_h */
@@ -0,0 +1,222 @@+/******************************** -*- C -*- ****************************+ *+ * Run-time assembler & support macros for the PowerPC math unit+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002, 2004 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/+++++#ifndef __lightning_asm_fp_h+#define __lightning_asm_fp_h++#include <float.h>++#define JIT_FPR_NUM 6+#define JIT_FPR(i) (30-(i)*2)+#define JIT_FPTMP 18++#define jit_addr_f(rd,s1,s2) FADDSrrr((s1), (s2), (rd))+#define jit_subr_f(rd,s1,s2) FSUBSrrr((s1), (s2), (rd))+#define jit_mulr_f(rd,s1,s2) FMULSrrr((s1), (s2), (rd))+#define jit_divr_f(rd,s1,s2) FDIVSrrr((s1), (s2), (rd))++#define jit_addr_d(rd,s1,s2) FADDDrrr((s1), (s2), (rd))+#define jit_subr_d(rd,s1,s2) FSUBDrrr((s1), (s2), (rd))+#define jit_mulr_d(rd,s1,s2) FMULDrrr((s1), (s2), (rd))+#define jit_divr_d(rd,s1,s2) FDIVDrrr((s1), (s2), (rd))++#define jit_movr_f(rd,rs) FMOVSrr((rs), (rd))+#define jit_abs_d(rd,rs) FABSSrr((rs), (rd))+#define jit_negr_d(rd,rs) FNEGSrr((rs), (rd))+#define jit_sqrt_d(rd,rs) FSQRTSrr((rs), (rd))+#define jit_movr_d(rd,rs) FMOVDrr((rs), (rd))+#define jit_abs_f(rd,rs) FABSDrr((rs), (rd))+#define jit_negr_f(rd,rs) FNEGDrr((rs), (rd))+#define jit_sqrt_f(rd,rs) FSQRTDrr((rs), (rd))+#define jit_extr_f_d(rs, rd) FSTODrr((rs), (rd))+#define jit_extr_d_f(rs, rd) FDTOSrr((rs), (rd))++#define jit_movi_f(rd,immf) \+ do { \+ float _v = (immf); \+ _1(_jit.x.pc + 3), LDFmr(_Ro(7), 8, (rd)); \+ memcpy(_jit.x.uc_pc, &_v, sizeof (float)); \+ _jit.x.uc_pc += sizeof (float); \+ } while(0)++#define jit_movi_d(rd,immd) \+ do { \+ double _v = (immd); \+ if ((long)_jit.x.pc & 4) NOP(); \+ _1(_jit.x.pc + 4); \+ LDDFmr(_Ro(7), 8, (rd)); \+ memcpy(_jit.x.uc_pc, &_v, sizeof (double)); \+ _jit.x.uc_pc += sizeof (double); \+ } while(0)+++#define jit_ldxi_f(rd, rs, is) jit_chk_imm((is), LDFmr((rs), (is), (rd)), LDFxr((rs), JIT_BIG, (rd)))+#define jit_ldxi_d(rd, rs, is) jit_chk_imm((is), LDDFmr((rs), (is), (rd)), LDDFxr((rs), JIT_BIG, (rd)))+#define jit_ldxr_f(rd, s1, s2) LDFxr((s1), (s2), (rd))+#define jit_ldxr_d(rd, s1, s2) LDDFxr((s1), (s2), (rd))+#define jit_stxi_f(id, rd, rs) jit_chk_imm((id), STFrm((rs), (rd), (id)), STFrx((rs), (rd), JIT_BIG))+#define jit_stxi_d(id, rd, rs) jit_chk_imm((id), STDFrm((rs), (rd), (id)), STDFrx((rs), (rd), JIT_BIG))+#define jit_stxr_f(d1, d2, rs) STFrx((rs), (d1), (d2))+#define jit_stxr_d(d1, d2, rs) STDFrx((rs), (d1), (d2))++#define jit_truncr_f_i(rd, rs) ( \+ _1(_jit.x.pc + 3), \+ FSTOIrr((rs), JIT_FPTMP), \+ NOP(), \+ STFrm(JIT_FPTMP, _Ro(7), 8), \+ LDmr(_Ro(7), 8, (rd)))++#define jit_truncr_d_i(rd, rs) ( \+ _1(_jit.x.pc + 3), \+ FDTOIrr((rs), JIT_FPTMP), \+ NOP(), \+ STFrm(JIT_FPTMP, _Ro(7), 8), \+ LDmr(_Ro(7), 8, (rd)))++#define jit_extr_i_d(rd, rs) (_1 (_jit.x.pc + 3), NOP(), NOP(), STrm((rs), _Ro(7), 8), LDFmr(_Ro(7), 8, (rd)), FITODrr((rd), (rd)))+#define jit_extr_i_f(rd, rs) (_1 (_jit.x.pc + 3), NOP(), NOP(), STrm((rs), _Ro(7), 8), LDFmr(_Ro(7), 8, (rd)), FITOSrr((rd), (rd)))++#define jit_do_round_f(rd, rs, fixup, mode) do { \+ jit_movi_f (JIT_FPTMP, fixup); \+ _1(_jit.x.pc + 4); \+ SETHIir(_HI(mode << 29), JIT_BIG); \+ NOP(); \+ NOP(); \+ STFSRm(_Ro(7), 8); /* store fsr */ \+ LDmr(_Ro(7), 8, rd); \+ XORrrr(rd, JIT_BIG, JIT_BIG); /* adjust mode */ \+ STrm(JIT_BIG, _Ro(7), 12); \+ LDFSRm(_Ro(7), 12); /* load fsr */ \+ FADDSrrr ((rs), JIT_FPTMP, JIT_FPTMP); \+ LDFSRm(_Ro(7), 8); \+ FSTOIrr(JIT_FPTMP, JIT_FPTMP); \+ STFrm(JIT_FPTMP, _Ro(7), 8); \+ LDmr(_Ro(7), 8, (rd)); \+ ADDCCrrr ((rd), (rd), 0); \+ SUBXrrr ((rd), 0, (rd)); \+ } while (0);++#define jit_do_round_d(rd, rs, fixup, mode) do { \+ jit_movi_d (JIT_FPTMP, fixup); \+ _1(_jit.x.pc + 4); \+ SETHIir(_HI(mode << 29), JIT_BIG); \+ NOP(); \+ NOP(); \+ STFSRm(_Ro(7), 8); /* store fsr */ \+ LDmr(_Ro(7), 8, rd); \+ XORrrr(rd, JIT_BIG, JIT_BIG); /* adjust mode */ \+ STrm(JIT_BIG, _Ro(7), 12); \+ LDFSRm(_Ro(7), 12); /* load fsr */ \+ FADDDrrr ((rs), JIT_FPTMP, JIT_FPTMP); \+ LDFSRm(_Ro(7), 8); \+ FDTOIrr(JIT_FPTMP, JIT_FPTMP); \+ STFrm(JIT_FPTMP, _Ro(7), 8); \+ LDmr(_Ro(7), 8, (rd)); \+ ADDCCrrr ((rd), (rd), 0); \+ SUBXrrr ((rd), 0, (rd)); \+ } while (0);++#define jit_roundr_f_i(rd, rs) do { \+ jit_movi_f (JIT_FPTMP, 0.5); \+ FADDSrrr ((rs), JIT_FPTMP, JIT_FPTMP); \+ jit_truncr_f_i ((rd), JIT_FPTMP); \+ ADDCCrrr ((rd), (rd), 0); \+ SUBXrrr ((rd), 0, (rd)); \+ } while (0)++#define jit_roundr_d_i(rd, rs) do { \+ jit_movi_d (JIT_FPTMP, 0.5); \+ FADDDrrr ((rs), JIT_FPTMP, JIT_FPTMP); \+ jit_truncr_d_i ((rd), JIT_FPTMP); \+ ADDCCrrr ((rd), (rd), 0); \+ SUBXrrr ((rd), 0, (rd)); \+ } while (0)++#define jit_ceilr_f_i(rd, rs) \+ jit_do_round_f ((rd), (rs), 1.0f - FLT_EPSILON, 3)++#define jit_ceilr_d_i(rd, rs) \+ jit_do_round_d ((rd), (rs), 1.0 - DBL_EPSILON, 3)++#define jit_floorr_f_i(rd, rs) \+ jit_do_round_f ((rd), (rs), FLT_EPSILON, 2)++#define jit_floorr_d_i(rd, rs) \+ jit_do_round_d ((rd), (rs), DBL_EPSILON, 2)++#define jit_ltr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBLi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ltr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBLi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ler_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBLEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ler_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBLEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_eqr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_eqr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ner_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBNEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ner_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBNEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ger_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBGEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ger_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBGEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_gtr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBGi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_gtr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBGi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_unltr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBULi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_unltr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBULi(_jit.x.pc + 3), MOVir (1, (d), MOVir (0, (d)))+#define jit_unler_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBULEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_unler_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBULEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_uneqr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBUEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_uneqr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBUEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ltgtr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBLGi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ltgtr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBLGi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_unger_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBUGEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_unger_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBUGEi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ungtr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBUGi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ungtr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBUGi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ordr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBOi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_ordr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBOi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_unordr_d(d, s1, s2) (FCMPDrr ((s1), (s2)), FBUi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))+#define jit_unordr_f(d, s1, s2) (FCMPSrr ((s1), (s2)), FBUi(_jit.x.pc + 3), MOVir (1, (d)), MOVir (0, (d)))++#define jit_prepare_f(num) (_jitl.nextarg_put += (num))+#define jit_prepare_d(num) (_jitl.nextarg_put += 2 * (num))++#define jit_arg_f() (_jitl.nextarg_get++)+#define jit_arg_d() (_jitl.nextarg_get += _jitl.nextarg_get & 1, _jitl.nextarg_get += 2, _jitl.nextarg_get - 2)++#define jit_getarg_f(rd, ofs) (STrm(ofs, _Ri(6), -24), LDFmr (_Ri(6), -24, (rd)))+#define jit_getarg_d(rd, ofs) (STDrm(ofs, _Ri(6), -24), LDDFmr (_Ri(6), -24, (rd)))++#define jit_pusharg_f(rs) (STFrm((rs), _Ri(6), -24), --_jitl.nextarg_put, LDmr (_Ri(6), -24, _Ro(_jitl.nextarg_put)))+#define jit_pusharg_d(rs) (STDFrm((rs), _Ri(6), -24), _jitl.nextarg_put -= 2, LDmr (_Ri(6), -24, _Ro(_jitl.nextarg_put)))++#define jit_retval_f(rs) jit_movr_f(0, rs)+#define jit_retval_d(rs) jit_movr_d(0, rs)++#endif /* __lightning_asm_fp_h */
@@ -0,0 +1,65 @@+/******************************** -*- C -*- ****************************+ *+ * Platform-independent layer inline functions (Sparc)+ *+ ***********************************************************************/+++/***********************************************************************+ *+ * Copyright 2000, 2001, 2002 Free Software Foundation, Inc.+ * Written by Paolo Bonzini.+ *+ * This file is part of GNU lightning.+ *+ * GNU lightning is free software; you can redistribute it and/or modify it+ * under the terms of the GNU Lesser General Public License as published+ * by the Free Software Foundation; either version 2.1, or (at your option)+ * any later version.+ * + * GNU lightning is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public+ * License for more details.+ * + * You should have received a copy of the GNU Lesser General Public License+ * along with GNU lightning; see the file COPYING.LESSER; if not, write to the+ * Free Software Foundation, 59 Temple Place - Suite 330, Boston,+ * MA 02111-1307, USA.+ *+ ***********************************************************************/++++#ifndef __lightning_funcs_h+#define __lightning_funcs_h++#if !defined(__GNUC__) && !defined(__GNUG__)+#error Go get GNU C, I do not know how to flush the cache+#error with this compiler.+#else+/* Why doesn't this compile?!?+ * static void+ * jit_flush_code(start, end)+ * void *start;+ * void *end;+ */++static void+jit_flush_code(void* start, void* end)+{+#ifndef LIGHTNING_CROSS+ register char *dest;++ __asm__ __volatile__ ("stbar");+ for (dest = (char *)start; dest <= (char *)end; dest += 4) {+ __asm__ __volatile__ ("flush %0"::"r"(dest));+ }++ /* [SPARC Architecture Manual v8, page 139, implementation note #5] */+ __asm__ __volatile__ ("nop; nop; nop; nop; nop");+#endif+}+#endif++#endif /* __lightning_core_h */
@@ -0,0 +1,1224 @@+#include "data.h"+#include "linearizer.h"+#include <gu/map.h>+#include <gu/fun.h>+#include <gu/choice.h>+#include <gu/seq.h>+#include <gu/file.h>+#include <gu/string.h>+#include <gu/assert.h>+#include <gu/utf8.h>+#include <gu/ucs.h>+#include <pgf/expr.h>+#include <pgf/literals.h>+#include <stdio.h>++//#define PGF_LINEARIZER_DEBUG++static void+pgf_lzr_add_overl_entry(PgfCncOverloadMap* overl_table,+ PgfCCat* ccat, void* entry,+ GuPool *pool)+{+ GuBuf* entries =+ gu_map_get(overl_table, ccat, GuBuf*);+ if (entries == NULL) {+ entries = gu_new_buf(void*, pool);+ gu_map_put(overl_table, ccat, GuBuf*, entries);+ }++ gu_buf_push(entries, void*, entry);+}++PGF_API void+pgf_lzr_index(PgfConcr* concr, + PgfCCat* ccat, PgfProduction prod,+ bool is_lexical,+ GuPool *pool)+{+ void* data = gu_variant_data(prod);+ switch (gu_variant_tag(prod)) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papply = data;+ PgfCncOverloadMap* overl_table =+ gu_map_get(concr->fun_indices, papply->fun->absfun->name,+ PgfCncOverloadMap*);+ if (!overl_table) {+ overl_table = gu_new_addr_map(PgfCCat*, GuBuf*, &gu_null_struct, pool);+ gu_map_put(concr->fun_indices,+ papply->fun->absfun->name, PgfCncOverloadMap*, overl_table);+ }+ pgf_lzr_add_overl_entry(overl_table, ccat, papply, pool);+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = data;+ pgf_lzr_add_overl_entry(concr->coerce_idx, ccat, pcoerce, pool);+ break;+ }+ default:+ gu_impossible();+ }+}++typedef struct {+ PgfConcr* concr;+ GuChoice* ch;+ PgfExpr expr;+ int fid;+ GuEnum en;+} PgfCnc;+++#ifdef PGF_LINEARIZER_DEBUG+static void+pgf_print_cnc_tree_vars(size_t n_vars, PgfPrintContext* context,+ GuOut* out, GuExn* err)+{+ if (n_vars > 0) {+ gu_putc('\\', out, err);+ for (;;) {+ gu_string_write(context->name, out, err);+ n_vars--;++ if (n_vars > 0)+ gu_putc(',', out, err);+ else+ break;+ }+ gu_puts(" -> ", out, err);+ }+}++PGF_INTERNAL void+pgf_print_cnc_tree(PgfCncTree ctree, GuOut* out, GuExn* err)+{+ GuVariantInfo ti = gu_variant_open(ctree);+ switch (ti.tag) {+ case PGF_CNC_TREE_APP: {+ PgfCncTreeApp* capp = ti.data;+ if (capp->n_vars+capp->n_args > 0) gu_putc('(', out, err);+ pgf_print_cnc_tree_vars(capp->n_vars, capp->context, out, err);+ gu_printf(out, err, "F%d", capp->fun->funid);+ for (size_t i = 0; i < capp->n_args; i++) {+ gu_putc(' ', out, err);+ pgf_print_cnc_tree(capp->args[i], out, err);+ }+ if (capp->n_vars+capp->n_args > 0) gu_putc(')', out, err);+ break;+ }+ case PGF_CNC_TREE_CHUNKS: {+ PgfCncTreeChunks* chunks = ti.data;+ if (chunks->n_vars+chunks->n_args > 0) gu_putc('(', out, err);+ pgf_print_cnc_tree_vars(chunks->n_vars, chunks->context, out, err);+ if (chunks->id > 0)+ gu_printf(out, err, "?%d", chunks->id);+ else+ gu_putc('?', out, err);+ for (size_t i = 0; i < chunks->n_args; i++) {+ gu_putc(' ', out, err);+ pgf_print_cnc_tree(chunks->args[i], out, err);+ }+ if (chunks->n_vars+chunks->n_args > 0) gu_putc(')', out, err);+ break;+ }+ case PGF_CNC_TREE_LIT: {+ PgfCncTreeLit* clit = ti.data;+ if (clit->n_vars > 0) gu_putc('(', out, err);+ pgf_print_cnc_tree_vars(clit->n_vars, clit->context, out, err);+ pgf_print_literal(clit->lit, out, err);+ if (clit->n_vars > 0) gu_putc(')', out, err);+ break;+ }+ case GU_VARIANT_NULL:+ gu_puts("null", out, err);+ break;+ default:+ gu_impossible();+ }+}+#endif++static PgfCncTree+pgf_cnc_resolve(PgfCnc* cnc,+ PgfPrintContext* context, PgfExpr expr,+ PgfCCat* ccat,+ GuPool* pool);++static PgfCncTree+pgf_cnc_resolve_app(PgfCnc* cnc,+ size_t n_vars, PgfPrintContext* context,+ PgfCCat* ccat, GuBuf* buf, GuBuf* args,+ GuPool* pool)+{+ GuChoiceMark mark = gu_choice_mark(cnc->ch);+ int save_fid = cnc->fid;++ size_t n_args = gu_buf_length(args);++ PgfCncTree ret = gu_null_variant;+ PgfCncTreeApp* capp =+ gu_new_flex_variant(PGF_CNC_TREE_APP,+ PgfCncTreeApp,+ args, n_args, &ret, pool);+ capp->ccat = ccat;+ capp->n_vars = n_vars;+ capp->context = context;++redo:;+ int index = gu_choice_next(cnc->ch, gu_buf_length(buf));+ if (index < 0) {+ return gu_null_variant;+ }++ PgfProductionApply* papply =+ gu_buf_get(buf, PgfProductionApply*, index);+ gu_assert(n_args == gu_seq_length(papply->args));++ capp->abs_id = papply->fun->absfun->name;+ capp->fun = papply->fun;+ capp->fid = 0;+ capp->n_args = n_args;++ for (size_t i = 0; i < n_args; i++) {+ PgfPArg* parg = gu_seq_index(papply->args, PgfPArg, i);+ PgfExpr earg = gu_buf_get(args, PgfExpr, n_args-i-1);++ PgfCCat* ccat = NULL;+ GuBuf* coercions =+ gu_map_get(cnc->concr->coerce_idx, parg->ccat, GuBuf*);+ if (coercions == NULL) {+ ccat = parg->ccat;+ } else {+ int index = gu_choice_next(cnc->ch, gu_buf_length(coercions));+ if (index < 0) {+ cnc->fid = save_fid;+ gu_choice_reset(cnc->ch, mark);+ if (!gu_choice_advance(cnc->ch))+ return gu_null_variant;+ goto redo;+ }++ PgfProductionCoerce* pcoerce =+ gu_buf_get(coercions, PgfProductionCoerce*, index);+ ccat = pcoerce->coerce;+ }++ capp->args[i] =+ pgf_cnc_resolve(cnc, context, earg, ccat, pool);+ if (gu_variant_is_null(capp->args[i])) {+ cnc->fid = save_fid;+ gu_choice_reset(cnc->ch, mark);+ if (!gu_choice_advance(cnc->ch))+ return gu_null_variant;+ goto redo;+ }+ }++ capp->fid = cnc->fid++;++ return ret;+}++static PgfCncTree+pgf_cnc_resolve_def(PgfCnc* cnc,+ size_t n_vars, PgfPrintContext* context,+ PgfCId abs_id, PgfCCat* ccat, GuString s, GuPool* pool)+{+ PgfCncTree ret = gu_null_variant;+ PgfCncTree lit = gu_null_variant;++ PgfCncTreeLit* clit =+ gu_new_variant(PGF_CNC_TREE_LIT,+ PgfCncTreeLit,+ &lit, pool);+ clit->n_vars = 0;+ clit->context = context;+ clit->fid = -1; // don't report the literal in the bracket+ PgfLiteralStr* lit_str =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(s)+1,+ &clit->lit, pool);+ strcpy((char*) lit_str->val, (char*) s);++ if (ccat == NULL || ccat->lindefs == NULL)+ return lit;++ int index =+ gu_choice_next(cnc->ch, gu_seq_length(ccat->lindefs));+ if (index < 0) {+ return ret;+ }+ PgfCncTreeApp* capp =+ gu_new_flex_variant(PGF_CNC_TREE_APP,+ PgfCncTreeApp,+ args, 1, &ret, pool);+ capp->ccat = ccat;+ capp->abs_id= abs_id;+ capp->fun = gu_seq_get(ccat->lindefs, PgfCncFun*, index);+ capp->fid = cnc->fid++;+ capp->n_vars = n_vars;+ capp->context = context;+ capp->n_args = 1;+ capp->args[0] = lit;++ return ret;+}++typedef struct {+ GuMapItor fn;+ int index;+ PgfCCat* ccat;+ GuBuf* buf;+} PgfCncItor;++static void+pgf_cnc_cat_resolve_itor(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ PgfCncItor* clo = (PgfCncItor*) fn;+ PgfCCat* ccat = (PgfCCat*) key;+ GuBuf* buf = *((GuBuf**) value);++ if (clo->index == 0) {+ clo->ccat = ccat;+ clo->buf = buf;+ }++ clo->index--;+}++PGF_API PgfCncTree+pgf_lzr_wrap_linref(PgfCncTree ctree, GuPool* pool)+{+ GuVariantInfo cti = gu_variant_open(ctree);+ switch (cti.tag) {+ case PGF_CNC_TREE_APP: {+ PgfCncTreeApp* capp = cti.data;++ assert(gu_seq_length(capp->ccat->linrefs) > 0);++ // here we must apply the linref function+ PgfCncTree new_ctree;+ PgfCncTreeApp* new_capp =+ gu_new_flex_variant(PGF_CNC_TREE_APP,+ PgfCncTreeApp,+ args, 1, &new_ctree, pool);+ new_capp->ccat = NULL;+ new_capp->abs_id = NULL;+ new_capp->fun = gu_seq_get(capp->ccat->linrefs, PgfCncFun*, 0);+ new_capp->fid = -1;+ new_capp->n_vars = 0;+ new_capp->context = NULL;+ new_capp->n_args = 1;+ new_capp->args[0] = ctree;++ ctree = new_ctree;+ break;+ }+ }++ return ctree;+}++static PgfCncTree+pgf_cnc_resolve(PgfCnc* cnc, + PgfPrintContext* context, PgfExpr expr,+ PgfCCat* ccat, + GuPool* pool)+{+ PgfCncTree ret = gu_null_variant;+ GuPool* tmp_pool = gu_new_pool();+ size_t n_vars = 0;+ GuBuf* args = gu_new_buf(PgfExpr, tmp_pool);++ for (;;) {+ GuVariantInfo i = gu_variant_open(expr);+ switch (i.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* eabs = i.data;++ PgfPrintContext* new_context = gu_new(PgfPrintContext, pool);+ new_context->name = eabs->id;+ new_context->next = context;+ context = new_context;+ + n_vars++;+ + expr = eabs->body;+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* eapp = i.data;+ gu_buf_push(args, PgfExpr, eapp->arg);+ expr = eapp->fun;+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = i.data;+ PgfCncTreeLit* clit = + gu_new_variant(PGF_CNC_TREE_LIT,+ PgfCncTreeLit,+ &ret, pool);+ clit->n_vars = n_vars;+ clit->context = context;+ clit->fid = cnc->fid++;+ clit->lit = elit->lit;+ goto done;+ }+ case PGF_EXPR_META: {+ PgfExprMeta* emeta = i.data;+ size_t n_args = gu_buf_length(args);++ PgfCncTree chunks_tree;+ PgfCncTreeChunks* chunks = + gu_new_flex_variant(PGF_CNC_TREE_CHUNKS,+ PgfCncTreeChunks,+ args, n_args, &chunks_tree, pool);+ chunks->id = emeta->id;+ chunks->n_vars = n_vars;+ chunks->context = context;+ chunks->n_args = n_args;++ for (size_t i = 0; i < n_args; i++) {+ PgfExpr earg = gu_buf_get(args, PgfExpr, n_args-i-1);+ chunks->args[i] = pgf_cnc_resolve(cnc, context, earg, NULL, pool);+ if (gu_variant_is_null(chunks->args[i])) {+ ret = gu_null_variant;+ goto done;+ }+ chunks->args[i] = + pgf_lzr_wrap_linref(chunks->args[i], pool);+ }++ if (ccat == NULL) {+ ret = chunks_tree;+ goto done;+ }+ if (ccat->lindefs == NULL) {+ goto done;+ }++ PgfCId abs_id = "?";+ if (emeta->id > 0) {+ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_new_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ gu_printf(out, err, "?%d", emeta->id);+ abs_id = gu_string_buf_freeze(sbuf, pool);+ }++ int index =+ gu_choice_next(cnc->ch, gu_seq_length(ccat->lindefs));+ if (index < 0) {+ return ret;+ }+ PgfCncTreeApp* capp =+ gu_new_flex_variant(PGF_CNC_TREE_APP,+ PgfCncTreeApp,+ args, 1, &ret, pool);+ capp->ccat = ccat;+ capp->abs_id = abs_id;+ capp->fun = gu_seq_get(ccat->lindefs, PgfCncFun*, index);+ capp->fid = cnc->fid++;+ capp->n_vars = 0;+ capp->context = context;+ capp->n_args = 1;+ capp->args[0] = chunks_tree;++ goto done;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* efun = i.data;++ PgfCncOverloadMap* overl_table =+ gu_map_get(cnc->concr->fun_indices, efun->fun, PgfCncOverloadMap*);+ if (overl_table == NULL) {+ if (ccat != NULL && ccat->lindefs == NULL) {+ goto done;+ }++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_new_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ gu_putc('[', out, err);+ gu_string_write(efun->fun, out, err);+ gu_putc(']', out, err);+ GuString s = gu_string_buf_freeze(sbuf, tmp_pool);++ ret = pgf_cnc_resolve_def(cnc, n_vars, context, efun->fun, ccat, s, pool);++ gu_pool_free(tmp_pool);+ goto done;+ }++ if (ccat == NULL) {+ size_t n_count = gu_map_count(overl_table);+ GuChoiceMark mark = gu_choice_mark(cnc->ch);++redo:;+ int index = gu_choice_next(cnc->ch, n_count);+ if (index < 0) {+ goto done;+ }++ PgfCncItor clo = { { pgf_cnc_cat_resolve_itor }, index, NULL, NULL };+ gu_map_iter(overl_table, &clo.fn, NULL);+ assert(clo.ccat != NULL && clo.buf != NULL);++ ret = pgf_cnc_resolve_app(cnc, n_vars, context, clo.ccat, clo.buf, args, pool);+ if (gu_variant_is_null(ret)) {+ gu_choice_reset(cnc->ch, mark);+ if (gu_choice_advance(cnc->ch))+ goto redo;+ }+ } else {+ GuBuf* buf =+ gu_map_get(overl_table, ccat, GuBuf*);+ if (buf == NULL) {+ goto done;+ }++ ret = pgf_cnc_resolve_app(cnc, n_vars, context, ccat, buf, args, pool);+ }+ goto done;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* evar = i.data;+ + int index = evar->var;+ PgfPrintContext* ctxt = context;+ while (index > 0) {+ assert (ctxt != NULL);+ ctxt = ctxt->next;+ index--;+ }++ ret = pgf_cnc_resolve_def(cnc, n_vars, context, ctxt->name, ccat, ctxt->name, pool);+ goto done;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = i.data;+ expr = etyped->expr;+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = i.data;+ expr = eimpl->expr;+ break;+ }+ default:+ gu_impossible();+ }+ }+ +done:+ gu_pool_free(tmp_pool);+ return ret;+}++static void+pgf_cnc_tree_enum_next(GuEnum* self, void* to, GuPool* pool)+{+ PgfCnc* lzn = gu_container(self, PgfCnc, en);+ PgfCncTree* toc = to;++ if (lzn->ch == NULL) {+ *toc = gu_null_variant;+ return;+ }++ lzn->fid = 0;++ GuChoiceMark mark = gu_choice_mark(lzn->ch);+ *toc = pgf_cnc_resolve(lzn, NULL, lzn->expr, NULL, pool);+ gu_choice_reset(lzn->ch, mark);++#ifdef PGF_LINEARIZER_DEBUG+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ if (gu_variant_is_null(*toc))+ gu_puts("*nil*\n", out, err);+ else {+ pgf_print_cnc_tree(*toc, out, err);+ gu_puts("\n", out, err);+ }+ gu_pool_free(tmp_pool);+#endif++ if (!gu_choice_advance(lzn->ch)) {+ lzn->ch = NULL;+ }+}++PGF_API PgfCncTreeEnum*+pgf_lzr_concretize(PgfConcr* concr, PgfExpr expr, GuExn* err, GuPool* pool)+{+ if (concr->fun_indices == NULL ||+ concr->coerce_idx == NULL) {+ GuExnData* err_data = gu_raise(err, PgfExn);+ if (err_data) {+ err_data->data = "The concrete syntax is not loaded";+ return NULL;+ }+ }++ PgfCnc* cnc = gu_new(PgfCnc, pool);+ cnc->concr = concr;+ cnc->expr = expr;+ cnc->fid = 0;+ cnc->ch = gu_new_choice(pool);+ cnc->en.next = pgf_cnc_tree_enum_next;+ return &cnc->en;+}++typedef struct {+ PgfConcr* concr;+ PgfLinFuncs** funcs;+ GuPool* tmp_pool;+} PgfLzr;++static PgfLzr*+pgf_new_lzr(PgfConcr* concr, PgfLinFuncs** funcs, GuPool* tmp_pool)+{+ PgfLzr* lzr = gu_new(PgfLzr, tmp_pool);+ lzr->concr = concr;+ lzr->funcs = funcs;+ lzr->tmp_pool = tmp_pool;+ return lzr;+}++typedef enum {+ PGF_CACHED_BEGIN,+ PGF_CACHED_END,+ PGF_CACHED_BIND,+ PGF_CACHED_CAPIT,+ PGF_CACHED_ALL_CAPIT,+ PGF_CACHED_NE+} PgfLzrCachedTag;++typedef struct {+ PgfLzrCachedTag tag;+ PgfCId cat;+ int fid;+ int lin_idx;+ PgfCId fun;+} PgfLzrCached;++typedef struct {+ PgfLinFuncs* funcs;+ PgfCncTreeApp* app;+ PgfSymbolKP* kp;+ GuBuf* events;+ PgfLzr* lzr;+ PgfLinFuncs** prev;+} PgfLzrCache;++static void+pgf_lzr_linearize_symbols(PgfLzr* lzr, PgfCncTreeApp* fapp,+ PgfSymbols* syms, uint16_t sym_idx);+ +static void+pgf_lzr_linearize_tree(PgfLzr* lzr, PgfCncTree ctree, size_t lin_idx);++static void+pgf_lzr_cache_flush(PgfLzrCache* cache, PgfSymbols* form)+{+ cache->lzr->funcs = cache->prev;+ pgf_lzr_linearize_symbols(cache->lzr, cache->app, form, 0);++ size_t n_cached = gu_buf_length(cache->events);+ for (size_t i = 0; i < n_cached; i++) {+ PgfLzrCached* event =+ gu_buf_index(cache->events, PgfLzrCached, i);+ + switch (event->tag) {+ case PGF_CACHED_BEGIN:+ if ((*cache->lzr->funcs)->begin_phrase) {+ (*cache->lzr->funcs)->begin_phrase(+ cache->lzr->funcs,+ event->cat,+ event->fid,+ event->lin_idx,+ event->fun);+ }+ break;+ case PGF_CACHED_END:+ if ((*cache->lzr->funcs)->end_phrase) {+ (*cache->lzr->funcs)->end_phrase(+ cache->lzr->funcs,+ event->cat,+ event->fid,+ event->lin_idx,+ event->fun);+ }+ break;+ case PGF_CACHED_BIND:+ if ((*cache->lzr->funcs)->symbol_bind) {+ (*cache->lzr->funcs)->symbol_bind(cache->lzr->funcs);+ }+ break;+ case PGF_CACHED_CAPIT:+ if ((*cache->lzr->funcs)->symbol_capit) {+ (*cache->lzr->funcs)->symbol_capit(cache->lzr->funcs, PGF_CAPIT_FIRST);+ }+ break;+ case PGF_CACHED_ALL_CAPIT:+ if ((*cache->lzr->funcs)->symbol_capit) {+ (*cache->lzr->funcs)->symbol_capit(cache->lzr->funcs, PGF_CAPIT_ALL);+ }+ break;+ case PGF_CACHED_NE:+ if ((*cache->lzr->funcs)->symbol_ne) {+ (*cache->lzr->funcs)->symbol_ne(cache->lzr->funcs);+ }+ break;+ }+ }+}++static void+pgf_lzr_cache_symbol_token(PgfLinFuncs** funcs, PgfToken tok)+{+ PgfLzrCache* cache = gu_container(funcs, PgfLzrCache, funcs);++ PgfSymbols* form = cache->kp->default_form;+ for (size_t i = 0; i < cache->kp->n_forms; i++) {+ GuStrings* prefixes = cache->kp->forms[i].prefixes;+ size_t n_prefixes = gu_seq_length(prefixes);+ for (size_t j = 0; j < n_prefixes; j++) {+ GuString prefix = gu_seq_get(prefixes, GuString, j);+ + if (gu_string_is_prefix(prefix, tok)) {+ form = cache->kp->forms[i].form;+ goto found;+ }+ }+ }+found:++ pgf_lzr_cache_flush(cache, form);+ if ((*cache->lzr->funcs)->symbol_token) {+ (*cache->lzr->funcs)->symbol_token(cache->lzr->funcs, tok);+ }+}++static void+pgf_lzr_cache_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lin_idx, PgfCId fun)+{+ PgfLzrCache* cache = gu_container(funcs, PgfLzrCache, funcs);+ PgfLzrCached* event = gu_buf_extend(cache->events);+ event->tag = PGF_CACHED_BEGIN;+ event->cat = cat;+ event->fid = fid;+ event->lin_idx = lin_idx;+ event->fun = fun;+}++static void+pgf_lzr_cache_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lin_idx, PgfCId fun)+{+ PgfLzrCache* cache = gu_container(funcs, PgfLzrCache, funcs);+ PgfLzrCached* event = gu_buf_extend(cache->events);+ event->tag = PGF_CACHED_END;+ event->cat = cat;+ event->fid = fid;+ event->lin_idx = lin_idx;+ event->fun = fun;+}++static void+pgf_lzr_cache_symbol_ne(PgfLinFuncs** funcs)+{+ PgfLzrCache* cache = gu_container(funcs, PgfLzrCache, funcs);+ PgfLzrCached* event = gu_buf_extend(cache->events);+ event->tag = PGF_CACHED_NE;+}++static void+pgf_lzr_cache_symbol_bind(PgfLinFuncs** funcs)+{+ PgfLzrCache* cache = gu_container(funcs, PgfLzrCache, funcs);+ PgfLzrCached* event = gu_buf_extend(cache->events);+ event->tag = PGF_CACHED_BIND;+}++static void+pgf_lzr_cache_symbol_capit(PgfLinFuncs** funcs, PgfCapitState capit)+{+ PgfLzrCache* cache = gu_container(funcs, PgfLzrCache, funcs);+ PgfLzrCached* event = gu_buf_extend(cache->events);+ event->tag = (capit == PGF_CAPIT_ALL) ? PGF_CACHED_ALL_CAPIT : PGF_CACHED_CAPIT;+}++static void+pgf_lzr_cache_symbol_meta(PgfLinFuncs** funcs, PgfMetaId id)+{+ PgfLzrCache* cache = gu_container(funcs, PgfLzrCache, funcs);++ pgf_lzr_cache_flush(cache, cache->kp->default_form);+ if ((*cache->lzr->funcs)->symbol_meta) {+ (*cache->lzr->funcs)->symbol_meta(cache->lzr->funcs, id);+ }+}++static PgfLinFuncs pgf_lzr_cache_funcs = {+ .symbol_token = pgf_lzr_cache_symbol_token,+ .begin_phrase = pgf_lzr_cache_begin_phrase,+ .end_phrase = pgf_lzr_cache_end_phrase,+ .symbol_ne = pgf_lzr_cache_symbol_ne,+ .symbol_bind = pgf_lzr_cache_symbol_bind,+ .symbol_capit = pgf_lzr_cache_symbol_capit,+ .symbol_meta = pgf_lzr_cache_symbol_meta+};++static void+pgf_lzr_linearize_var(PgfLzr* lzr, PgfCncTree ctree, size_t var_idx)+{+ GuVariantInfo cti = gu_variant_open(ctree);++ size_t n_vars = 0;+ PgfPrintContext* context = NULL;+ + switch (cti.tag) {+ case PGF_CNC_TREE_APP: {+ PgfCncTreeApp* fapp = cti.data;+ n_vars = fapp->n_vars;+ context = fapp->context;+ break;+ }+ case PGF_CNC_TREE_CHUNKS: {+ PgfCncTreeChunks* fchunks = cti.data;+ n_vars = fchunks->n_vars;+ context = fchunks->context;+ break;+ }+ case PGF_CNC_TREE_LIT: {+ PgfCncTreeLit* flit = cti.data;+ n_vars = flit->n_vars;+ context = flit->context;+ break;+ }+ default:+ gu_impossible();+ }++ n_vars -= var_idx+1;+ while (n_vars > 0) {+ context = context->next;+ n_vars--;+ }++ if ((*lzr->funcs)->symbol_token) {+ (*lzr->funcs)->symbol_token(lzr->funcs, context->name);+ }+}++static void+pgf_lzr_linearize_symbols(PgfLzr* lzr, PgfCncTreeApp* fapp,+ PgfSymbols* syms, uint16_t sym_idx)+{+ size_t nsyms = gu_seq_length(syms);+ for (size_t i = sym_idx; i < nsyms; i++) {+ PgfSymbol sym = gu_seq_get(syms, PgfSymbol, i);+ GuVariantInfo sym_i = gu_variant_open(sym);+ switch (sym_i.tag) {+ case PGF_SYMBOL_CAT:+ case PGF_SYMBOL_LIT: {+ if (fapp == NULL)+ return;++ PgfSymbolIdx* sidx = sym_i.data;+ gu_assert((unsigned) sidx->d < fapp->n_args);++ PgfCncTree argf = fapp->args[sidx->d];+ pgf_lzr_linearize_tree(lzr, argf, sidx->r);+ break;+ }+ case PGF_SYMBOL_VAR: {+ if (fapp == NULL)+ return;++ PgfSymbolIdx* sidx = sym_i.data;+ gu_assert((unsigned) sidx->d < fapp->n_args);++ PgfCncTree argf = fapp->args[sidx->d];+ pgf_lzr_linearize_var(lzr, argf, sidx->r);+ break;+ }+ case PGF_SYMBOL_KS: {+ PgfSymbolKS* ks = sym_i.data;+ if ((*lzr->funcs)->symbol_token) {+ (*lzr->funcs)->symbol_token(lzr->funcs, ks->token);+ }+ break;+ }+ case PGF_SYMBOL_KP: {+ // TODO: correct prefix-dependencies+ PgfSymbolKP* kp = sym_i.data;+ //gu_buf_push(pres, PgfSymbolKP*, kp);+ PgfLzrCache* cache = gu_new(PgfLzrCache, lzr->tmp_pool);+ cache->funcs = &pgf_lzr_cache_funcs;+ cache->app = fapp;+ cache->kp = kp;+ cache->events= gu_new_buf(PgfLzrCached, lzr->tmp_pool);+ cache->lzr = lzr;+ cache->prev = lzr->funcs;+ lzr->funcs = &cache->funcs;+ break;+ }+ case PGF_SYMBOL_NE: {+ if ((*lzr->funcs)->symbol_ne) {+ (*lzr->funcs)->symbol_ne(lzr->funcs);+ }+ break;+ }+ case PGF_SYMBOL_BIND:+ case PGF_SYMBOL_SOFT_BIND: {+ if ((*lzr->funcs)->symbol_bind) {+ (*lzr->funcs)->symbol_bind(lzr->funcs);+ }+ break;+ }+ case PGF_SYMBOL_SOFT_SPACE: {+ // SOFT_SPACE should be just ignored in linearization+ break;+ }+ case PGF_SYMBOL_CAPIT:+ if ((*lzr->funcs)->symbol_capit) {+ (*lzr->funcs)->symbol_capit(lzr->funcs, PGF_CAPIT_FIRST);+ }+ break;+ case PGF_SYMBOL_ALL_CAPIT:+ if ((*lzr->funcs)->symbol_capit) {+ (*lzr->funcs)->symbol_capit(lzr->funcs, PGF_CAPIT_ALL);+ }+ break;+ default:+ gu_impossible(); + }+ }+}++static void+pgf_lzr_linearize_tree(PgfLzr* lzr, PgfCncTree ctree, size_t lin_idx)+{+ GuVariantInfo cti = gu_variant_open(ctree);++ switch (cti.tag) {+ case PGF_CNC_TREE_APP: {+ PgfCncTreeApp* fapp = cti.data;+ PgfCncFun* fun = fapp->fun;++ if ((*lzr->funcs)->begin_phrase && fapp->ccat != NULL) {+ (*lzr->funcs)->begin_phrase(lzr->funcs,+ fapp->ccat->cnccat->abscat->name,+ fapp->fid, lin_idx,+ fapp->abs_id);+ }++ gu_require(lin_idx < fun->n_lins);+ pgf_lzr_linearize_symbols(lzr, fapp, fun->lins[lin_idx]->syms, 0);+ + if ((*lzr->funcs)->end_phrase && fapp->ccat != NULL) {+ (*lzr->funcs)->end_phrase(lzr->funcs,+ fapp->ccat->cnccat->abscat->name,+ fapp->fid, lin_idx,+ fapp->abs_id);+ }+ break;+ }+ case PGF_CNC_TREE_CHUNKS: {+ gu_require(lin_idx == 0);+ PgfCncTreeChunks* fchunks = cti.data;++ if (fchunks->n_args == 0) {+ if ((*lzr->funcs)->symbol_meta) {+ (*lzr->funcs)->symbol_meta(lzr->funcs, fchunks->id);+ }+ } else {+ for (size_t i = 0; i < fchunks->n_args; i++) {+ pgf_lzr_linearize_tree(lzr, fchunks->args[i], 0);+ }+ }+ break;+ }+ case PGF_CNC_TREE_LIT: {+ gu_require(lin_idx == 0);+ PgfCncTreeLit* flit = cti.data;++ PgfCId cat =+ pgf_literal_cat(lzr->concr, flit->lit)->cnccat->abscat->name;+ + if ((*lzr->funcs)->begin_phrase && flit->fid >= 0) {+ (*lzr->funcs)->begin_phrase(lzr->funcs,+ cat, flit->fid, 0,+ "");+ }++ GuVariantInfo i = gu_variant_open(flit->lit);+ PgfToken tok = NULL;+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = i.data;+ tok = lstr->val;+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = i.data;+ tok = gu_format_string(lzr->tmp_pool, "%d", lint->val);+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = i.data;+ tok = gu_format_string(lzr->tmp_pool, "%lf", lflt->val);+ break;+ }+ default:+ gu_impossible();+ }++ if ((*lzr->funcs)->symbol_token) {+ (*lzr->funcs)->symbol_token(lzr->funcs, tok);+ }++ if ((*lzr->funcs)->end_phrase && flit->fid >= 0) {+ (*lzr->funcs)->end_phrase(lzr->funcs,+ cat, flit->fid, 0,+ "");+ }++ break;+ }+ default:+ gu_impossible();+ }+}++PGF_API void+pgf_lzr_linearize(PgfConcr* concr, PgfCncTree ctree, size_t lin_idx, + PgfLinFuncs** funcs, GuPool* tmp_pool)+{+ PgfLzr* lzr = pgf_new_lzr(concr, funcs, tmp_pool);+ pgf_lzr_linearize_tree(lzr, ctree, lin_idx);+ + while (lzr->funcs != funcs) {+ PgfLzrCache* cache = gu_container(lzr->funcs, PgfLzrCache, funcs);+ pgf_lzr_cache_flush(cache, cache->kp->default_form);+ }+}++typedef struct PgfSimpleLin PgfSimpleLin;++struct PgfSimpleLin {+ PgfLinFuncs* funcs;+ bool bind;+ PgfCapitState capit;+ GuOut* out;+ GuExn* err;+};++static void+pgf_file_lzn_symbol_token(PgfLinFuncs** funcs, PgfToken tok)+{+ PgfSimpleLin* flin = gu_container(funcs, PgfSimpleLin, funcs);+ if (!gu_ok(flin->err)) {+ return;+ }++ if (flin->bind)+ flin->bind = false;+ else {+ gu_putc(' ', flin->out, flin->err);+ if (flin->capit == PGF_CAPIT_NEXT)+ flin->capit = PGF_CAPIT_NONE;+ }++ switch (flin->capit) {+ case PGF_CAPIT_NONE:+ gu_string_write(tok, flin->out, flin->err);+ break;+ case PGF_CAPIT_FIRST: {+ GuUCS c = gu_utf8_decode((const uint8_t**) &tok);+ c = gu_ucs_to_upper(c);+ gu_out_utf8(c, flin->out, flin->err);+ gu_string_write(tok, flin->out, flin->err);+ flin->capit = PGF_CAPIT_NONE;+ break;+ }+ case PGF_CAPIT_ALL:+ flin->capit = PGF_CAPIT_NEXT;+ // continue+ case PGF_CAPIT_NEXT: {+ const uint8_t* p = (uint8_t*) tok;+ while (*p) {+ GuUCS c = gu_utf8_decode(&p);+ c = gu_ucs_to_upper(c);+ gu_out_utf8(c, flin->out, flin->err);+ }+ break;+ }+ }+}++static void+pgf_file_lzn_symbol_ne(PgfLinFuncs** funcs)+{+ PgfSimpleLin* flin = gu_container(funcs, PgfSimpleLin, funcs);+ gu_raise(flin->err, PgfLinNonExist);+}++static void+pgf_file_lzn_symbol_bind(PgfLinFuncs** funcs)+{+ PgfSimpleLin* flin = gu_container(funcs, PgfSimpleLin, funcs);+ flin->bind = true;+}++static void+pgf_file_lzn_symbol_capit(PgfLinFuncs** funcs, PgfCapitState capit)+{+ PgfSimpleLin* flin = gu_container(funcs, PgfSimpleLin, funcs);+ flin->capit = capit;+}++static void+pgf_file_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId id)+{+ PgfSimpleLin* flin = gu_container(funcs, PgfSimpleLin, funcs);+ if (!gu_ok(flin->err)) {+ return;+ }++ if (flin->bind)+ flin->bind = false;+ else {+ gu_putc(' ', flin->out, flin->err);+ if (flin->capit == PGF_CAPIT_NEXT)+ flin->capit = PGF_CAPIT_NONE;+ }++ gu_putc('?', flin->out, flin->err);++ switch (flin->capit) {+ case PGF_CAPIT_FIRST:+ flin->capit = PGF_CAPIT_NONE;+ break;+ case PGF_CAPIT_ALL:+ flin->capit = PGF_CAPIT_NEXT;+ break;+ default:;+ }+}++static PgfLinFuncs pgf_file_lin_funcs = {+ .symbol_token = pgf_file_lzn_symbol_token,+ .begin_phrase = NULL,+ .end_phrase = NULL,+ .symbol_ne = pgf_file_lzn_symbol_ne,+ .symbol_bind = pgf_file_lzn_symbol_bind,+ .symbol_capit = pgf_file_lzn_symbol_capit,+ .symbol_meta = pgf_file_lzn_symbol_meta+};++PGF_API void+pgf_lzr_linearize_simple(PgfConcr* concr, PgfCncTree ctree, size_t lin_idx,+ GuOut* out, GuExn* err,+ GuPool* tmp_pool)+{+ PgfSimpleLin flin = {+ .funcs = &pgf_file_lin_funcs,+ .bind = true,+ .capit = PGF_CAPIT_NONE,+ .out = out,+ .err = err+ };+ pgf_lzr_linearize(concr, ctree, lin_idx, &flin.funcs, tmp_pool);+}++PGF_API void+pgf_lzr_get_table(PgfConcr* concr, PgfCncTree ctree, + size_t* n_lins, GuString** labels)+{+ static GuString s_label = "s";++ GuVariantInfo cti = gu_variant_open(ctree);++ switch (cti.tag) {+ case PGF_CNC_TREE_APP: {+ PgfCncTreeApp* fapp = cti.data;+ + PgfCncCat* cnccat = fapp->ccat->cnccat;+ *n_lins = cnccat->n_lins;+ *labels = cnccat->labels;+ break;+ }+ case PGF_CNC_TREE_LIT:+ case PGF_CNC_TREE_CHUNKS: {+ *n_lins = 1;+ *labels = &s_label;+ break;+ }+ default:+ gu_impossible();+ }++}++PGF_API void+pgf_linearize(PgfConcr* concr, PgfExpr expr, GuOut* out, GuExn* err)+{+ GuPool* tmp_pool = gu_local_pool();++ GuEnum* cts =+ pgf_lzr_concretize(concr, expr, err, tmp_pool);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return;+ }++ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (!gu_variant_is_null(ctree)) {+ ctree = pgf_lzr_wrap_linref(ctree, tmp_pool);+ pgf_lzr_linearize_simple(concr, ctree, 0, out, err, tmp_pool);+ }++ gu_pool_free(tmp_pool);+}++PGF_INTERNAL GuString+pgf_get_tokens(PgfSymbols* syms, uint16_t sym_idx, GuPool* pool)+{+ GuPool* tmp_pool = gu_new_pool();+ GuExn* err = gu_new_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ PgfSimpleLin flin = {+ .funcs = &pgf_file_lin_funcs,+ .bind = true,+ .capit = false,+ .out = out,+ .err = err+ };++ PgfLzr* lzr = pgf_new_lzr(NULL, &flin.funcs, tmp_pool);+ pgf_lzr_linearize_symbols(lzr, NULL, syms, sym_idx);+ + while (lzr->funcs != &flin.funcs) {+ PgfLzrCache* cache = gu_container(lzr->funcs, PgfLzrCache, funcs);+ pgf_lzr_cache_flush(cache, cache->kp->default_form);+ }++ GuString tokens = gu_ok(err) ? gu_string_buf_freeze(sbuf, pool)+ : "";++ gu_pool_free(tmp_pool);++ return tokens;+}
@@ -0,0 +1,127 @@+#ifndef PGF_LINEARIZER_H_+#define PGF_LINEARIZER_H_++#include <gu/enum.h>++/// Linearization of abstract syntax trees.++//+// PgfCncTree+//++/// A concrete syntax tree+typedef GuVariant PgfCncTree;++#ifdef PGF_DATA_H_++typedef enum {+ PGF_CNC_TREE_APP,+ PGF_CNC_TREE_CHUNKS,+ PGF_CNC_TREE_LIT,+} PgfCncTreeTag;++typedef struct {+ PgfCCat* ccat;+ PgfCId abs_id;+ PgfCncFun* fun;+ int fid;++ size_t n_vars;+ PgfPrintContext* context;++ size_t n_args;+ PgfCncTree args[];+} PgfCncTreeApp;++typedef struct {+ PgfMetaId id;++ size_t n_vars;+ PgfPrintContext* context;++ size_t n_args;+ PgfCncTree args[];+} PgfCncTreeChunks;++typedef struct {+ size_t n_vars;+ PgfPrintContext* context;++ int fid;+ PgfLiteral lit;+} PgfCncTreeLit;++#endif++/// An enumeration of #PgfCncTree trees.+typedef GuEnum PgfCncTreeEnum;++/// Begin enumerating concrete syntax variants.+PGF_API_DECL PgfCncTreeEnum*+pgf_lzr_concretize(PgfConcr* concr, PgfExpr expr, GuExn* err, GuPool* pool);++typedef struct {+ char nothing[0]; // Empty struct+} PgfLinNonExist;++PGF_API_DECL PgfCncTree+pgf_lzr_wrap_linref(PgfCncTree ctree, GuPool* pool);++++typedef struct PgfLinFuncs PgfLinFuncs;++typedef enum {+ PGF_CAPIT_NONE,+ PGF_CAPIT_FIRST,+ PGF_CAPIT_ALL,+ PGF_CAPIT_NEXT+} PgfCapitState;++struct PgfLinFuncs+{+ /// Output tokens+ void (*symbol_token)(PgfLinFuncs** self, PgfToken tok);++ /// Begin phrase+ void (*begin_phrase)(PgfLinFuncs** self, PgfCId cat, int fid, size_t lindex, PgfCId fun);++ /// End phrase+ void (*end_phrase)(PgfLinFuncs** self, PgfCId cat, int fid, size_t lindex, PgfCId fun);++ /// handling nonExist+ void (*symbol_ne)(PgfLinFuncs** self);++ /// token binding+ void (*symbol_bind)(PgfLinFuncs** self);++ /// capitalization+ void (*symbol_capit)(PgfLinFuncs** self, PgfCapitState capit);+ + /// meta variable+ void (*symbol_meta)(PgfLinFuncs** self, PgfMetaId id);+};++/// Linearize a concrete syntax tree.+PGF_API_DECL void+pgf_lzr_linearize(PgfConcr* concr, PgfCncTree ctree, size_t lin_idx, + PgfLinFuncs** funcs, GuPool* tmp_pool);++/// Linearize a concrete syntax tree as space-separated tokens.+PGF_API_DECL void+pgf_lzr_linearize_simple(PgfConcr* concr, PgfCncTree ctree, size_t lin_idx, + GuOut* out, GuExn* err,+ GuPool* tmp_pool);+++PGF_API_DECL void+pgf_lzr_get_table(PgfConcr* concr, PgfCncTree ctree, + size_t* n_lins, GuString** labels);++#ifdef PGF_DATA_H_+// Used internally in the parser+PGF_INTERNAL_DECL GuString+pgf_get_tokens(PgfSymbols* sym, uint16_t sym_idx, GuPool* pool);+#endif++#endif
@@ -0,0 +1,489 @@+#include <gu/in.h>+#include <gu/utf8.h>+#include <pgf/literals.h>+#include <wctype.h>+++static PgfExprProb*+pgf_match_string_lit(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ gu_assert(lin_idx == 0);++ const uint8_t* buf = (uint8_t*) (sentence + *poffset);+ const uint8_t* p = buf;+ size_t len = 0;+ while (*p && !gu_ucs_is_space(gu_utf8_decode(&p))) {+ len = p - buf;+ }++ if (len > 0) {+ PgfExprProb* ep = gu_new(PgfExprProb, out_pool);+ ep->prob = 0;++ PgfExprLit *expr_lit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &ep->expr, out_pool);++ PgfLiteralStr *lit_str =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, len+1,+ &expr_lit->lit, out_pool);+ memcpy(lit_str->val, buf, len);+ lit_str->val[len] = 0;++ *poffset += len;+ return ep;+ } else {+ return NULL;+ }+}++static void+pgf_predict_empty_next(GuEnum* self, void* to, GuPool* pool)+{+ *((PgfTokenProb**) to) = NULL;+}++static GuEnum*+pgf_predict_empty(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString prefix,+ GuPool *out_pool)+{+ GuEnum* en = gu_new(GuEnum, out_pool);+ en->next = pgf_predict_empty_next;+ return en;+}++static PgfLiteralCallback pgf_string_literal_callback =+ { pgf_match_string_lit, pgf_predict_empty } ;++++static PgfExprProb*+pgf_match_int_lit(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ gu_assert(lin_idx == 0);++ const uint8_t* buf = (uint8_t*) (sentence + *poffset);+ const uint8_t* p = buf;+ size_t len = 0;+ while (*p && !gu_ucs_is_space(gu_utf8_decode(&p))) {+ len = p - buf;+ }++ if (len > 0) {+ GuPool* tmp_pool = gu_local_pool();+ PgfToken tok = gu_malloc(tmp_pool, len+1);+ memcpy((char*) tok, buf, len);+ ((char*) tok)[len] = 0;++ int val;+ if (!gu_string_to_int(tok, &val)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }+ + gu_pool_free(tmp_pool);++ PgfExprProb* ep = gu_new(PgfExprProb, out_pool);+ ep->prob = 0;++ PgfExprLit *expr_lit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &ep->expr, out_pool);+ PgfLiteralInt *lit_int =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &expr_lit->lit, out_pool);+ lit_int->val = val;++ *poffset += len;+ return ep;+ } else {+ return NULL;+ }+}++static PgfLiteralCallback pgf_int_literal_callback =+ { pgf_match_int_lit, pgf_predict_empty } ;++++static PgfExprProb*+pgf_match_float_lit(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ gu_assert(lin_idx == 0);++ const uint8_t* buf = (uint8_t*) (sentence + *poffset);+ const uint8_t* p = buf;+ size_t len = 0;+ while (*p && !gu_ucs_is_space(gu_utf8_decode(&p))) {+ len = p - buf;+ }++ if (len > 0) {+ GuPool* tmp_pool = gu_local_pool();+ PgfToken tok = gu_malloc(tmp_pool, len+1);+ memcpy((char*) tok, buf, len);+ ((char*) tok)[len] = 0;++ double val;+ if (!gu_string_to_double(tok, &val)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }+ + gu_pool_free(tmp_pool);++ PgfExprProb* ep = gu_new(PgfExprProb, out_pool);+ ep->prob = 0;++ PgfExprLit *expr_lit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &ep->expr, out_pool);+ PgfLiteralFlt *lit_flt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &expr_lit->lit, out_pool);+ lit_flt->val = val;++ *poffset += len;+ return ep;+ } else {+ return NULL;+ }+}++static PgfLiteralCallback pgf_float_literal_callback =+ { pgf_match_float_lit, pgf_predict_empty } ;++typedef struct {+ PgfMorphoCallback callback;+ PgfAbstr* abstract;+ PgfExpr expr;+ bool is_known;+ GuPool* out_pool;+} PgfMatchMorphoCallback;++static void+pgf_match_name_morpho_callback(PgfMorphoCallback* self_,+ PgfCId lemma, GuString analysis, prob_t prob,+ GuExn* err)+{+ PgfMatchMorphoCallback* self =+ gu_container(self_, PgfMatchMorphoCallback, callback);++ PgfAbsFun* absfun =+ gu_seq_binsearch(self->abstract->funs, pgf_absfun_order, PgfAbsFun, lemma);+ if (absfun != NULL) {+ if (strcmp(absfun->type->cid, "PN") == 0) {+ self->expr = absfun->ep.expr;+ } else if (strcmp(absfun->type->cid, "Weekday") == 0) {+ PgfExprApp *expr_app =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &self->expr, self->out_pool);+ GuString con = "weekdayPN";+ PgfExprFun *expr_fun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(con)+1,+ &expr_app->fun, self->out_pool);+ strcpy(expr_fun->fun, con);+ expr_app->arg = absfun->ep.expr;+ } else if (strcmp(absfun->type->cid, "Month") == 0) {+ PgfExprApp *expr_app =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &self->expr, self->out_pool);+ GuString con = "monthPN";+ PgfExprFun *expr_fun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(con)+1,+ &expr_app->fun, self->out_pool);+ strcpy(expr_fun->fun, con);+ expr_app->arg = absfun->ep.expr;+ } else {+ self->is_known = true;+ }+ }+}++static PgfExprProb*+pgf_match_name_lit(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ if (lin_idx != 0)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuStringBuf *sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ GuExn* err = gu_new_exn(tmp_pool);++ const uint8_t* buf = (uint8_t*) (sentence + *poffset);+ const uint8_t* p = buf;++ int i = 0;+ GuUCS ucs = gu_utf8_decode(&p);+ while (gu_ucs_is_upper(ucs)) {+ if (i > 0)+ gu_putc(' ', out, err);+ gu_out_utf8(ucs, out, err);+ *poffset = p - ((uint8_t*) sentence);++ ucs = gu_utf8_decode(&p);+ while (ucs != 0 && !gu_ucs_is_space(ucs)) {+ gu_out_utf8(ucs, out, err);+ *poffset = p - ((uint8_t*) sentence);++ ucs = gu_utf8_decode(&p);+ }++ i++;++ while (gu_ucs_is_space(ucs))+ ucs = gu_utf8_decode(&p);+ }++ PgfExprProb* ep = NULL;+ if (i > 0) {+ GuString name = gu_string_buf_freeze(sbuf, tmp_pool);++ // Detect I and I'm in English+ GuString concr_name = pgf_concrete_name(concr);+ size_t concr_name_len = strlen(concr_name);+ if (concr_name_len >= 3 && strcmp(concr_name+concr_name_len-3,"Eng") == 0) {+ if (strcmp(name, "I") == 0 || strcmp(name, "I'm") == 0) {+ gu_pool_free(tmp_pool);+ return NULL;+ }+ }++ PgfMatchMorphoCallback clo = { { pgf_match_name_morpho_callback }, + concr->abstr,+ gu_null_variant,+ false,+ out_pool+ };+ pgf_lookup_morpho(concr, name, &clo.callback, NULL);++ if (clo.is_known) {+ return NULL;+ }++ if (gu_variant_is_null(clo.expr)) {+ PgfExprApp *expr_app1 =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &clo.expr, out_pool);+ GuString con1 = "SymbPN";+ PgfExprFun *expr_fun1 =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(con1)+1,+ &expr_app1->fun, out_pool);+ strcpy(expr_fun1->fun, con1);+ PgfExprApp *expr_app2 =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &expr_app1->arg, out_pool);+ GuString con2 = "MkSymb";+ PgfExprFun *expr_fun2 =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(con2)+1,+ &expr_app2->fun, out_pool);+ strcpy(expr_fun2->fun, con2);+ PgfExprLit *expr_lit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &expr_app2->arg, out_pool);+ PgfLiteralStr *lit_str =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(name)+1,+ &expr_lit->lit, out_pool);+ strcpy(lit_str->val, name);+ }+ + ep = gu_new(PgfExprProb, out_pool);+ ep->prob = 0;+ ep->expr = clo.expr;+ }++ gu_pool_free(tmp_pool);++ return ep;+}++PGF_API PgfLiteralCallback pgf_nerc_literal_callback =+ { pgf_match_name_lit, pgf_predict_empty } ;++static void+pgf_match_unknown_morpho_callback(PgfMorphoCallback* self_,+ PgfCId lemma, GuString analysis, prob_t prob,+ GuExn* err)+{+ PgfMatchMorphoCallback* self =+ gu_container(self_, PgfMatchMorphoCallback, callback);+ self->is_known = true;+}++static PgfExprProb*+pgf_match_unknown_lit(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ const uint8_t* buf = (uint8_t*) (sentence + *poffset);+ const uint8_t* p = buf;++ PgfExprProb* ep = NULL;++ GuUCS ucs = gu_utf8_decode(&p);+ if (!gu_ucs_is_upper(ucs)) {+ GuPool* tmp_pool = gu_local_pool();+ GuStringBuf *sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ GuExn* err = gu_new_exn(tmp_pool);++ gu_out_utf8(ucs, out, err);+ *poffset = p - ((uint8_t*) sentence);++ ucs = gu_utf8_decode(&p);+ while (ucs != 0 && !gu_ucs_is_space(ucs)) {+ gu_out_utf8(ucs, out, err);+ *poffset = p - ((uint8_t*) sentence);++ ucs = gu_utf8_decode(&p);+ }+ + GuString word = gu_string_buf_freeze(sbuf, tmp_pool);++ PgfMatchMorphoCallback clo = { { pgf_match_unknown_morpho_callback }, + concr->abstr,+ gu_null_variant,+ false,+ out_pool+ };+ pgf_lookup_morpho(concr, word, &clo.callback, NULL);++ if (!clo.is_known) {+ ep = gu_new(PgfExprProb, out_pool);+ ep->prob = 0;++ PgfExprApp *expr_app =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &ep->expr, out_pool);+ GuString con = "MkSymb";+ PgfExprFun *expr_fun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(con)+1,+ &expr_app->fun, out_pool);+ strcpy(expr_fun->fun, con);+ PgfExprLit *expr_lit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &expr_app->arg, out_pool);+ PgfLiteralStr *lit_str =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(word)+1,+ &expr_lit->lit, out_pool);+ strcpy(lit_str->val, word);+ }+ + gu_pool_free(tmp_pool);+ }++ return ep;+}++PGF_API PgfLiteralCallback pgf_unknown_literal_callback =+ { pgf_match_unknown_lit, pgf_predict_empty } ;++PgfCallbacksMap*+pgf_new_callbacks_map(PgfConcr* concr, GuPool *pool)+{+ int fid;+ PgfCCat* ccat;+ + PgfCallbacksMap* callbacks = + gu_new_addr_map(PgfCncCat*, PgfLiteralCallback*, &gu_null_struct, pool);++ fid = -1;+ ccat = gu_map_get(concr->ccats, &fid, PgfCCat*);+ if (ccat != NULL)+ gu_map_put(callbacks, ccat->cnccat, + PgfLiteralCallback*, &pgf_string_literal_callback);++ fid = -2;+ ccat = gu_map_get(concr->ccats, &fid, PgfCCat*);+ if (ccat != NULL)+ gu_map_put(callbacks, ccat->cnccat, + PgfLiteralCallback*, &pgf_int_literal_callback);++ fid = -3;+ ccat = gu_map_get(concr->ccats, &fid, PgfCCat*);+ if (ccat != NULL)+ gu_map_put(callbacks, ccat->cnccat, + PgfLiteralCallback*, &pgf_float_literal_callback);++ return callbacks;+}++void+pgf_callbacks_map_add_literal(PgfConcr* concr, PgfCallbacksMap* callbacks,+ PgfCId cat, PgfLiteralCallback* callback)+{+ PgfCncCat* cnccat =+ gu_map_get(concr->cnccats, cat, PgfCncCat*);+ if (cnccat == NULL)+ return;++ gu_map_put(callbacks, cnccat,+ PgfLiteralCallback*, callback);+}++PGF_INTERNAL PgfCCat*+pgf_literal_cat(PgfConcr* concr, PgfLiteral lit)+{+ int fid;++ switch (gu_variant_tag(lit)) {+ case PGF_LITERAL_STR:+ fid = -1;+ break;+ case PGF_LITERAL_INT:+ fid = -2;+ break;+ case PGF_LITERAL_FLT:+ fid = -3;+ break;+ default:+ gu_impossible();+ return NULL;+ }++ return gu_map_get(concr->ccats, &fid, PgfCCat*);+}
@@ -0,0 +1,15 @@+#ifndef PGF_LITERALS_H_+#define PGF_LITERALS_H_+ +#include <pgf/data.h>++// literal for named entities recognition+PGF_API_DECL extern PgfLiteralCallback pgf_nerc_literal_callback;++// literal for finding unknown words+PGF_API_DECL extern PgfLiteralCallback pgf_unknown_literal_callback;++PGF_INTERNAL_DECL PgfCCat*+pgf_literal_cat(PgfConcr* concr, PgfLiteral lit);++#endif // PGF_LITERALS_H_
@@ -0,0 +1,1064 @@+#include <gu/map.h>+#include <gu/mem.h>+#include <gu/utf8.h>+#include <gu/file.h>+#include <gu/string.h>+#include <gu/choice.h>+#include <pgf/data.h>+#include <pgf/linearizer.h>+#include <stdio.h>+#include <stdlib.h>+#include <math.h>+#if defined(__MINGW32__) || defined(_MSC_VER)+#include <malloc.h>+#endif++//#define PGF_LOOKUP_DEBUG+//#define PGF_LINEARIZER_DEBUG++typedef struct {+ PgfAbsFun* fun;+ size_t arg_idx;+} PgfAbsBottomUpEntry;++typedef struct {+ PgfAbsFun* fun;+ size_t count;+ PgfMetaId args[0];+} PgfAbsProduction;++#ifdef PGF_LOOKUP_DEBUG+static void+pgf_print_abs_production(PgfMetaId id,+ PgfAbsProduction* prod,+ GuOut* out, GuExn* err)+{+ gu_printf(out,err,"?%d = %s",id,prod->fun->name);+ size_t n_hypos = gu_seq_length(prod->fun->type->hypos);+ for (size_t i = 0; i < n_hypos; i++) {+ gu_printf(out,err," ?%d", prod->args[i]);+ }+ gu_printf(out,err," <%d>\n",prod->count);+}++static void+pgf_print_abs_productions(GuBuf* prods,+ GuOut* out, GuExn* err)+{+ size_t n_prods = gu_buf_length(prods);+ for (size_t id = 1; id < n_prods; id++) {+ GuBuf* id_prods = gu_buf_get(prods, GuBuf*, id);+ size_t n_id_prods = gu_buf_length(id_prods);+ for (size_t i = 0; i < n_id_prods; i++) {+ PgfAbsProduction* prod = + gu_buf_get(id_prods, PgfAbsProduction*, i);+ pgf_print_abs_production(id, prod, out, err);+ }+ }+}+#endif++#ifdef PGF_LINEARIZER_DEBUG+PGF_INTERNAL_DECL void+pgf_print_cnc_tree(PgfCncTree ctree, GuOut* out, GuExn* err);+#endif++static void+pgf_lookup_index_syms(GuMap* lexicon_idx, PgfSymbols* syms, PgfAbsFun* absfun, GuPool* pool) {+ size_t n_syms = gu_seq_length(syms);+ for (size_t j = 0; j < n_syms; j++) {+ PgfSymbol sym = gu_seq_get(syms, PgfSymbol, j);+ GuVariantInfo i = gu_variant_open(sym);+ switch (i.tag) {+ case PGF_SYMBOL_KP: {+ PgfSymbolKP* skp = (PgfSymbolKP*) i.data;+ pgf_lookup_index_syms(lexicon_idx, skp->default_form, absfun, pool);+ for (size_t k = 0; k < skp->n_forms; k++) {+ pgf_lookup_index_syms(lexicon_idx, skp->forms[k].form, absfun, pool);+ }+ break;+ }+ case PGF_SYMBOL_KS: {+ PgfSymbolKS* sks = (PgfSymbolKS*) i.data;+ GuBuf* funs = gu_map_get(lexicon_idx, sks->token, GuBuf*);+ if (funs == NULL) {+ funs = gu_new_buf(PgfAbsFun*, pool);+ gu_map_put(lexicon_idx, sks->token, GuBuf*, funs);+ }++ bool found = false;+ size_t n_funs = gu_buf_length(funs);+ for (size_t l = 0; l < n_funs; l++) {+ PgfAbsFun* absfun1 = gu_buf_get(funs, PgfAbsFun*, l);+ if (absfun1 == absfun) {+ found = true;+ break;+ }+ }+ if (!found)+ gu_buf_push(funs, PgfAbsFun*, absfun);+ break;+ }+ }+ }+}++typedef struct {+ GuMap* function_idx;+ GuMap* meta_ids;+ GuBuf* spine;+ GuPool* pool;+} PgfSpineBuilder;++typedef struct {+ PgfToken token;+ size_t n_funs;+ PgfAbsFun** funs;+} PgfInputToken;++static PgfAbsProduction*+pgf_lookup_new_production(PgfAbsFun* fun, GuPool *pool)+{+ size_t n_hypos = fun->type->hypos ? gu_seq_length(fun->type->hypos) : 0;+ PgfAbsProduction* prod = gu_new_flex(pool, PgfAbsProduction, args, n_hypos);+ prod->fun = fun;+ prod->count = 0;+ for (size_t i = 0; i < n_hypos; i++) {+ prod->args[i] = 0;+ }+ return prod;+}++static void+pgf_lookup_add_production(PgfSpineBuilder* builder, PgfMetaId id, PgfAbsProduction* prod)+{+ GuBuf* prods = gu_buf_get(builder->spine, GuBuf*, id);+ gu_buf_push(prods, PgfAbsProduction*, prod);+}++static PgfMetaId+pgf_lookup_add_spine_nodes(PgfSpineBuilder* builder, PgfCId cat) {+ PgfMetaId meta_id = gu_map_get(builder->meta_ids, cat, PgfMetaId);+ if (meta_id != 0) {+ return meta_id;+ }++ meta_id = gu_buf_length(builder->spine);+ gu_buf_push(builder->spine, GuBuf*, gu_new_buf(PgfAbsProduction*, builder->pool));++ gu_map_put(builder->meta_ids, cat, PgfMetaId, meta_id);++ GuBuf* entries = gu_map_get(builder->function_idx, cat, GuBuf*);+ if (entries != NULL) {+ size_t n_entries = gu_buf_length(entries);+ for (size_t i = 0; i < n_entries; i++) {+ PgfAbsBottomUpEntry* entry = gu_buf_index(entries, PgfAbsBottomUpEntry, i);++ PgfMetaId id = pgf_lookup_add_spine_nodes(builder, entry->fun->type->cid);+ + PgfAbsProduction* prod = pgf_lookup_new_production(entry->fun, builder->pool);+ prod->args[entry->arg_idx] = meta_id;+ + pgf_lookup_add_production(builder, id, prod);+ }+ }++ return meta_id;+}++static void+pgf_lookup_add_spine_leaf(PgfSpineBuilder* builder, PgfAbsFun *fun)+{ + PgfMetaId id = pgf_lookup_add_spine_nodes(builder, fun->type->cid);+ PgfAbsProduction* prod = pgf_lookup_new_production(fun, builder->pool);+ prod->count = 1;++ pgf_lookup_add_production(builder, id, prod);+}++static GuBuf*+pgf_lookup_build_spine(GuMap* function_idx,+ PgfInputToken* tok, PgfType* typ, PgfMetaId* meta_id,+ GuPool* pool)+{+ PgfSpineBuilder builder;+ builder.function_idx = function_idx;+ builder.meta_ids = gu_new_string_map(PgfMetaId, &gu_null_struct, pool);+ builder.spine = gu_new_buf(GuBuf*, pool);+ builder.pool = pool;++ gu_buf_push(builder.spine, GuBuf*, NULL);++ for (size_t i = 0; i < tok->n_funs; i++) {+ pgf_lookup_add_spine_leaf(&builder, tok->funs[i]);+ }++ *meta_id = gu_map_get(builder.meta_ids, typ->cid, PgfMetaId);++ return builder.spine;+}++typedef PgfMetaId PgfPair[2];++static bool+pgf_pair_eq_fn(GuEquality* self, const void* p1, const void* p2)+{+ (void) self;+ const PgfMetaId* ip1 = p1;+ const PgfMetaId* ip2 = p2;+ return (ip1[0] == ip2[0] && ip1[1] == ip2[1]);+}++static GuHash+pgf_pair_hash_fn(GuHasher* self, const void* p)+{+ (void) self;+ const PgfMetaId* ip = p;+ return (GuHash) (((ip[1] & 0xFFFF) << 16) | (ip[0] & 0xFFFF));+}++static GuHasher+pgf_pair_hasher[1] = {+ {+ { pgf_pair_eq_fn },+ pgf_pair_hash_fn+ }+};++static PgfMetaId+pgf_lookup_merge_cats(GuBuf* spine, GuMap* pairs,+ PgfMetaId meta_id1, GuBuf* spine1,+ PgfMetaId meta_id2, GuBuf* spine2,+ GuPool* pool)+{+ if (meta_id1 == 0 && meta_id2 == 0)+ return 0;++ PgfPair pair;+ pair[0] = meta_id1;+ pair[1] = meta_id2;+ PgfMetaId meta_id = gu_map_get(pairs, &pair, PgfMetaId);+ if (meta_id != 0)+ return meta_id;++ meta_id = gu_buf_length(spine);+ GuBuf* id_prods = gu_new_buf(PgfAbsProduction*, pool);+ gu_buf_push(spine, GuBuf*, id_prods);++ gu_map_put(pairs, &pair, PgfMetaId, meta_id);++ GuBuf* id_prods1 = gu_buf_get(spine1, GuBuf*, meta_id1);+ GuBuf* id_prods2 = gu_buf_get(spine2, GuBuf*, meta_id2);+ size_t n_id_prods1 = (meta_id1 == 0) ? 0 : gu_buf_length(id_prods1);+ size_t n_id_prods2 = (meta_id2 == 0) ? 0 : gu_buf_length(id_prods2);++ if (meta_id1 != 0) {+ for (size_t i = 0; i < n_id_prods1; i++) {+ PgfAbsProduction* prod1 =+ gu_buf_get(id_prods1, PgfAbsProduction*, i);+ int count = 0;+ for (size_t j = 0; j < n_id_prods2; j++) {+ PgfAbsProduction* prod2 =+ gu_buf_get(id_prods2, PgfAbsProduction*, j);+ if (prod1->fun == prod2->fun) {+ PgfAbsProduction* prod =+ pgf_lookup_new_production(prod1->fun, pool);+ prod->count = prod1->count+prod2->count;+ size_t n_hypos = gu_seq_length(prod->fun->type->hypos);+ for (size_t l = 0; l < n_hypos; l++) {+ prod->args[l] =+ pgf_lookup_merge_cats(spine, pairs,+ prod1->args[l], spine1,+ prod2->args[l], spine2,+ pool);+ }+ gu_buf_push(id_prods, PgfAbsProduction*, prod);++ count++;+ }+ }++ if (count == 0) {+ PgfAbsProduction* prod =+ pgf_lookup_new_production(prod1->fun, pool);+ prod->count = prod1->count;+ size_t n_hypos = gu_seq_length(prod->fun->type->hypos);+ for (size_t l = 0; l < n_hypos; l++) {+ prod->args[l] =+ pgf_lookup_merge_cats(spine, pairs,+ prod1->args[l], spine1,+ 0, spine2,+ pool);+ }+ gu_buf_push(id_prods, PgfAbsProduction*, prod);+ }+ }+ }++ if (meta_id2 != 0) {+ for (size_t i = 0; i < n_id_prods2; i++) {+ PgfAbsProduction* prod2 =+ gu_buf_get(id_prods2, PgfAbsProduction*, i);+ bool found = false;+ for (size_t j = 0; j < n_id_prods1; j++) {+ PgfAbsProduction* prod1 =+ gu_buf_get(id_prods1, PgfAbsProduction*, j);+ if (prod1->fun == prod2->fun) {+ found = true;+ break;+ }+ }++ if (!found) {+ PgfAbsProduction* prod =+ pgf_lookup_new_production(prod2->fun, pool);+ prod->count = prod2->count;+ size_t n_hypos = gu_seq_length(prod->fun->type->hypos);+ for (size_t l = 0; l < n_hypos; l++) {+ prod->args[l] =+ pgf_lookup_merge_cats(spine, pairs,+ 0, spine1,+ prod2->args[l], spine2,+ pool);+ }+ gu_buf_push(id_prods, PgfAbsProduction*, prod);+ }+ }+ }++ return meta_id;+}++static GuBuf*+pgf_lookup_merge(PgfMetaId meta_id1, GuBuf* spine1,+ PgfMetaId meta_id2, GuBuf* spine2,+ PgfMetaId* meta_id,+ GuPool* pool, GuPool* out_pool)+{+ GuBuf* spine = gu_new_buf(GuBuf*, out_pool);+ gu_buf_push(spine, GuBuf*, NULL);++ GuMap* pairs = gu_new_map(PgfPair, pgf_pair_hasher, PgfMetaId, &gu_null_struct, pool);++ *meta_id =+ pgf_lookup_merge_cats(spine, pairs,+ meta_id1, spine1,+ meta_id2, spine2,+ out_pool);++ return spine;+}++typedef struct {+ PgfLinFuncs* funcs;+ PgfConcr* concr;+ GuBuf* join;+ PgfMetaId start_id;+ GuChoice* choice;+ GuBuf* expr_tokens;+ GuBuf* ctrees;+ int max_fid;+ PgfAbsFun** curr_absfun;+ GuPool* pool;+} PgfLookupState;++struct PgfItemConts {+ size_t count;+};++typedef struct {+ GuEnum en;+ double max;+ size_t index;+ GuBuf* ctrees;+ GuPool* out_pool;+} PgfLookupEnum;++static void+gu_ccat_fini(GuFinalizer* fin)+{+ PgfCCat* cat = gu_container(fin, PgfCCat, fin);+ if (cat->prods != NULL)+ gu_seq_free(cat->prods);+}++static PgfCCat*+pgf_lookup_new_ccat(PgfLookupState* st, PgfCCat* ccat)+{+ PgfCCat* new_ccat = gu_new_flex(st->pool, PgfCCat, fin, 1);+ new_ccat->cnccat = ccat->cnccat;+ new_ccat->lindefs = ccat->lindefs;+ new_ccat->linrefs = ccat->linrefs;+ new_ccat->viterbi_prob = 0;+ new_ccat->fid = st->max_fid++;+ new_ccat->conts = gu_new(PgfItemConts, st->pool);+ new_ccat->conts->count = 0;+ new_ccat->answers = NULL;+ new_ccat->prods = NULL;+ new_ccat->n_synprods = 0;++ new_ccat->fin[0].fn = gu_ccat_fini;+ gu_pool_finally(st->pool, new_ccat->fin);++ return new_ccat;+}++static PgfCCat*+pgf_lookup_concretize(PgfLookupState* st, GuMap* cache, PgfMetaId meta_id, PgfCCat *ccat);++static PgfCCat*+pgf_lookup_concretize_coercions(PgfLookupState* st, GuMap* cache,+ PgfMetaId meta_id, PgfCCat* ccat,+ GuBuf* coercions)+{+ PgfPair pair;+ pair[0] = meta_id;+ pair[1] = ccat->fid;+ PgfCCat** pnew_ccat = gu_map_find(cache, &pair);+ if (pnew_ccat != NULL)+ return *pnew_ccat;++ PgfCCat* new_ccat = NULL;++ size_t n_coercions = gu_buf_length(coercions);+ for (size_t i = 0; i < n_coercions; i++) {+ PgfProductionCoerce* pcoerce =+ gu_buf_get(coercions, PgfProductionCoerce*, i);++ PgfCCat* new_coerce =+ pgf_lookup_concretize(st, cache, meta_id, pcoerce->coerce);+ if (new_coerce == NULL)+ continue;++ if (new_ccat == NULL) {+ new_ccat = pgf_lookup_new_ccat(st, ccat);+ }++ PgfProduction cnc_prod;+ PgfProductionCoerce* new_pcoerce =+ gu_new_variant(PGF_PRODUCTION_COERCE,+ PgfProductionCoerce,+ &cnc_prod, st->pool);+ new_pcoerce->coerce = new_coerce;++ size_t count = (new_coerce->conts == NULL) ? 0 : new_coerce->conts->count;+ if (count > new_ccat->conts->count) {+ new_ccat->conts->count = new_coerce->conts->count;+ new_ccat->n_synprods = 0;+ }++ if (new_ccat->prods == NULL || new_ccat->n_synprods >= gu_seq_length(new_ccat->prods)) {+ new_ccat->prods = gu_realloc_seq(new_ccat->prods, PgfProduction, new_ccat->n_synprods+(n_coercions-i));+ }+ + if (count == new_ccat->conts->count) {+ gu_seq_set(new_ccat->prods, PgfProduction, new_ccat->n_synprods++, cnc_prod);+ }++#ifdef PGF_LOOKUP_DEBUG+ {+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ gu_printf(out,err,"C%d -> _[C%d] <%d>\n",new_ccat->fid,new_coerce->fid,new_coerce->conts ? new_coerce->conts->count : 0);+ gu_pool_free(tmp_pool);+ }+#endif+ }++ gu_map_put(cache, &pair, PgfCCat*, new_ccat);++ return new_ccat;+}++static PgfCCat*+pgf_lookup_concretize(PgfLookupState* st, GuMap* cache, PgfMetaId meta_id, PgfCCat *ccat)+{+ if (meta_id == 0) {+ // if there is no lindef for this ccat then we can't use it for + // linearization of a metavariable+ if (ccat->lindefs == NULL || gu_seq_length(ccat->lindefs) == 0)+ return NULL;+ return ccat;+ }++ PgfPair pair;+ pair[0] = meta_id;+ pair[1] = ccat->fid;+ PgfCCat** pnew_ccat = gu_map_find(cache, &pair);+ if (pnew_ccat != NULL) {+ // check for loops+ if (*pnew_ccat == (PgfCCat*) &gu_null_struct)+ return NULL;+ return *pnew_ccat;+ }++ // put a marker to detect loops+ gu_map_put(cache, &pair, PgfCCat*, (PgfCCat*) &gu_null_struct);++ PgfCCat* new_ccat = NULL;++ GuBuf* id_prods = gu_buf_get(st->join, GuBuf*, meta_id);++ size_t n_id_prods = gu_buf_length(id_prods);+ for (size_t i = 0; i < n_id_prods; i++) {+ PgfAbsProduction* prod =+ gu_buf_get(id_prods, PgfAbsProduction*, i);++ PgfCncOverloadMap* overl_table =+ gu_map_get(st->concr->fun_indices, prod->fun->name, PgfCncOverloadMap*);+ if (overl_table == NULL)+ continue;++ GuBuf* buf =+ gu_map_get(overl_table, ccat, GuBuf*);+ if (buf == NULL)+ continue;++ size_t n_prods = gu_buf_length(buf);+ for (size_t j = 0; j < n_prods; j++) {+ PgfProductionApply* papply =+ gu_buf_get(buf, PgfProductionApply*, j);++ size_t count = prod->count;++ size_t n_args = gu_seq_length(papply->args);+ GuSeq* new_args = gu_new_seq(PgfPArg, n_args, st->pool);+ for (size_t k = 0; k < n_args; k++) {+ PgfPArg* parg = gu_seq_index(papply->args, PgfPArg, k);+ PgfPArg* new_parg = gu_seq_index(new_args, PgfPArg, k);++ new_parg->hypos = parg->hypos;++ GuBuf* coercions =+ gu_map_get(st->concr->coerce_idx, parg->ccat, GuBuf*);+ if (coercions == NULL) {+ new_parg->ccat =+ pgf_lookup_concretize(st, cache, prod->args[k], parg->ccat);+ } else {+ new_parg->ccat =+ pgf_lookup_concretize_coercions(st, cache, prod->args[k], parg->ccat, coercions);+ }++ if (new_parg->ccat == NULL)+ goto skip;++ if (new_parg->ccat->conts != NULL)+ count += new_parg->ccat->conts->count;+ }++ if (new_ccat == NULL) {+ new_ccat = pgf_lookup_new_ccat(st, ccat);+ }++ PgfProduction cnc_prod;+ PgfProductionApply* new_papp = + gu_new_variant(PGF_PRODUCTION_APPLY,+ PgfProductionApply,+ &cnc_prod, st->pool);+ new_papp->fun = papply->fun;+ new_papp->args = new_args;+ + if (count > new_ccat->conts->count) {+ new_ccat->conts->count = count;+ new_ccat->n_synprods = 0;+ }++ if (new_ccat->prods == NULL || new_ccat->n_synprods >= gu_seq_length(new_ccat->prods)) {+ new_ccat->prods = gu_realloc_seq(new_ccat->prods, PgfProduction, new_ccat->n_synprods+(n_prods-j));+ }++ if (count == new_ccat->conts->count) {+ gu_seq_set(new_ccat->prods, PgfProduction, new_ccat->n_synprods++, cnc_prod);+ }++#ifdef PGF_LOOKUP_DEBUG+ {+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);++ gu_printf(out,err,"C%d -> F%d[",new_ccat->fid,new_papp->fun->funid);++ size_t n_args = gu_seq_length(new_papp->args);+ for (size_t l = 0; l < n_args; l++) {+ if (l > 0)+ gu_putc(',',out,err);++ PgfPArg arg = gu_seq_get(new_papp->args, PgfPArg, l);++ if (arg.hypos != NULL) {+ size_t n_hypos = gu_seq_length(arg.hypos);+ for (size_t r = 0; r < n_hypos; r++) {+ if (r > 0)+ gu_putc(' ',out,err);+ PgfCCat *hypo = gu_seq_get(arg.hypos, PgfCCat*, r);+ gu_printf(out,err,"C%d",hypo->fid);+ }+ }++ gu_printf(out,err,"C%d",arg.ccat->fid);+ }+ gu_printf(out,err,"] <%d>\n", count);+ gu_pool_free(tmp_pool);+ }+#endif++skip:;+ }+ }++ gu_map_put(cache, &pair, PgfCCat*, new_ccat);++ return new_ccat;+}++static PgfCncTree+pgf_lookup_extract(PgfLookupState* st, PgfCCat* ccat)+{+ PgfCncTree ret;++ if (ccat->fid < st->concr->total_cats) {+ int index =+ gu_choice_next(st->choice, gu_seq_length(ccat->lindefs));++ PgfCncTreeApp* capp =+ gu_new_flex_variant(PGF_CNC_TREE_APP,+ PgfCncTreeApp,+ args, 1, &ret, st->pool);+ capp->ccat = ccat;+ capp->fun = gu_seq_get(ccat->lindefs, PgfCncFun*, index);+ capp->fid = 0;+ capp->n_vars = 0;+ capp->context = NULL;+ capp->n_args = 1;++ PgfCncTreeChunks* chunks =+ gu_new_flex_variant(PGF_CNC_TREE_CHUNKS,+ PgfCncTreeChunks,+ args, 0, &capp->args[0], st->pool);+ chunks->id = 0;+ chunks->n_vars = 0;+ chunks->context = NULL;+ chunks->n_args = 0;+ } else {+ int index =+ gu_choice_next(st->choice, ccat->n_synprods);++ PgfProduction prod = + gu_seq_get(ccat->prods, PgfProduction, index);++ GuVariantInfo i = gu_variant_open(prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papply = i.data;++ size_t n_args = gu_seq_length(papply->args);+ PgfCncTreeApp* capp =+ gu_new_flex_variant(PGF_CNC_TREE_APP,+ PgfCncTreeApp,+ args, n_args, &ret, st->pool);+ capp->ccat = ccat;+ capp->fun = papply->fun;+ capp->fid = 0;+ capp->n_vars = 0;+ capp->context = NULL;+ capp->n_args = n_args;++ for (size_t i = 0; i < n_args; i++) {+ PgfPArg* arg = gu_seq_index(papply->args, PgfPArg, i);+ capp->args[i] = pgf_lookup_extract(st, arg->ccat);+ }+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = i.data;+ ret = pgf_lookup_extract(st, pcoerce->coerce);+ break;+ }+ default:+ gu_impossible();+ }+ }++ return ret;+}++static GuBuf*+pgf_lookup_tokenize(GuMap* lexicon_idx, GuString sentence, GuPool* pool)+{ + GuBuf* tokens = gu_new_buf(PgfInputToken, pool);++ GuUCS c = ' ';+ const uint8_t* p = (const uint8_t*) sentence;+ for (;;) {+ while (gu_ucs_is_space(c)) {+ c = gu_utf8_decode(&p);+ }+ if (c == 0)+ break;++ const uint8_t* start = p-1;+ if (strchr(".!?,:",c) != NULL)+ c = gu_utf8_decode(&p);+ else {+ while (c != 0 && strchr(".!?,:",c) == NULL && !gu_ucs_is_space(c)) {+ c = gu_utf8_decode(&p);+ }+ }+ const uint8_t* end = p-1;++ PgfInputToken* tok = gu_buf_extend(tokens);++ size_t len = end-start;+ tok->token = gu_malloc(pool, len+1);+ memcpy((uint8_t*) tok->token, start, len);+ ((uint8_t*) tok->token)[len] = 0;++ GuBuf* funs = gu_map_get(lexicon_idx, tok->token, GuBuf*);+ if (funs != NULL) {+ tok->n_funs = gu_buf_length(funs);+ tok->funs = gu_buf_data(funs);+ } else {+ tok->n_funs = 0;+ tok->funs = NULL;+ }+ }++ return tokens;+}++static double+pgf_lookup_compute_kernel_helper(GuBuf* sentence_tokens, GuBuf* expr_tokens,+ double* matrix, size_t i, size_t j)+{+ size_t dim = gu_buf_length(sentence_tokens)+1;++ double score = matrix[i + dim*j];++ if (score < 0) {+ score = 0;+ for (size_t l = 0; l < i; l++) {+ matrix[l + dim*j] = score;+ for (size_t k = j; k > 0; k--) {+ PgfInputToken* sentence_token = gu_buf_index(sentence_tokens, PgfInputToken, l);+ PgfInputToken* expr_token = gu_buf_index(expr_tokens, PgfInputToken, k-1);++ if (sentence_token->token != NULL && expr_token->token != NULL &&+ strcmp(sentence_token->token, expr_token->token) == 0) {+ score += 1 + pgf_lookup_compute_kernel_helper(sentence_tokens, expr_tokens, matrix, l, k-1);+ } else {+ bool match = false;+ for (size_t i = 0; i < sentence_token->n_funs; i++) {+ for (size_t j = 0; j < expr_token->n_funs; j++) {+ if (sentence_token->funs[i] == expr_token->funs[j]) {+ match = true;+ goto done;+ }+ }+ }+ done:+ if (match) {+ score += 0.5 + pgf_lookup_compute_kernel_helper(sentence_tokens, expr_tokens, matrix, l, k-1);+ }+ }+ }+ }+ matrix[i + dim*j] = score;+ }++ return score;+}++static double+pgf_lookup_compute_kernel(GuBuf* sentence_tokens, GuBuf* expr_tokens)+{+ size_t n_sentence_tokens = gu_buf_length(sentence_tokens);+ size_t n_expr_tokens = gu_buf_length(expr_tokens);+ size_t size = (n_sentence_tokens+1)*(n_expr_tokens+1);+ double* matrix = alloca(size*sizeof(double));++ for (size_t i = 0; i < size; i++) {+ matrix[i] = -1;+ }++ return+ pgf_lookup_compute_kernel_helper(sentence_tokens,expr_tokens,matrix,+ n_sentence_tokens,n_expr_tokens);+}++typedef struct {+ PgfCncTree ctree;+ double score;+} PgfCncTreeScore;++static void+pgf_lookup_ctree_to_expr(PgfCncTree ctree, PgfExprProb* ep,+ GuPool* out_pool)+{+ size_t n_args = 0;+ PgfCncTree* args = NULL;++ GuVariantInfo cti = gu_variant_open(ctree);+ switch (cti.tag) {+ case PGF_CNC_TREE_APP: {+ PgfCncTreeApp* fapp = cti.data;+ *ep = fapp->fun->absfun->ep;+ n_args = fapp->n_args;+ args = fapp->args;+ break;+ }+ case PGF_CNC_TREE_CHUNKS: {+ PgfCncTreeChunks* fchunks = cti.data;+ n_args = fchunks->n_args;+ args = fchunks->args;++ ep->expr = gu_new_variant_i(out_pool, + PGF_EXPR_META, PgfExprMeta,+ .id = fchunks->id);+ ep->prob = 0;+ break;+ }+/* case PGF_CNC_TREE_LIT: {+ PgfCncTreeLit* flit = cti.data;+ break;+ }*/+ default:+ gu_impossible();+ }+ + if (gu_variant_is_null(ep->expr)) {+ gu_assert(n_args==1);+ pgf_lookup_ctree_to_expr(args[0], ep, out_pool);+ } else {+ for (size_t i = 0; i < n_args; i++) {+ PgfExprProb ep_arg;+ pgf_lookup_ctree_to_expr(args[i], &ep_arg, out_pool);++ + ep->expr = gu_new_variant_i(out_pool,+ PGF_EXPR_APP,+ PgfExprApp,+ ep->expr, ep_arg.expr);+ ep->prob += ep_arg.prob;+ }+ }+}++static void+pgf_lookup_enum_next(GuEnum* self, void* to, GuPool* pool)+{+ PgfLookupEnum* st = gu_container(self, PgfLookupEnum, en);+ PgfCncTreeScore* cts = NULL;++ while (st->index < gu_buf_length(st->ctrees)) {+ cts = gu_buf_index(st->ctrees, PgfCncTreeScore, st->index);+ st->index++;+ if (cts->score == st->max) {+ PgfExprProb* ep = gu_new(PgfExprProb, st->out_pool);+ pgf_lookup_ctree_to_expr(cts->ctree, ep, st->out_pool);+ *((PgfExprProb**) to) = ep;+ return;+ }+ }++ *((PgfExprProb**) to) = NULL;+}++static void+pgf_lookup_symbol_token(PgfLinFuncs** self, PgfToken token)+{+ PgfLookupState* st = gu_container(self, PgfLookupState, funcs);+ PgfInputToken* tok = gu_buf_extend(st->expr_tokens);+ tok->token = token;+ tok->n_funs = st->curr_absfun ? 1 : 0;+ tok->funs = st->curr_absfun;+}++static void+pgf_lookup_begin_phrase(PgfLinFuncs** self, PgfCId cat, int fid, size_t lindex, PgfCId funname)+{+ PgfLookupState* st = gu_container(self, PgfLookupState, funcs);+ + PgfAbsFun* absfun = gu_seq_binsearch(st->concr->abstr->funs, pgf_absfun_order, PgfAbsFun, funname);+ if (absfun != NULL) {+ st->curr_absfun = gu_new(PgfAbsFun*, st->pool);+ *st->curr_absfun = absfun;+ } else {+ st->curr_absfun = NULL;+ }+}++static void+pgf_lookup_end_phrase(PgfLinFuncs** self, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfLookupState* st = gu_container(self, PgfLookupState, funcs);+ st->curr_absfun = NULL;+}++static void+pgf_lookup_symbol_meta(PgfLinFuncs** self, PgfMetaId meta_id)+{+ PgfLookupState* st = gu_container(self, PgfLookupState, funcs);+ PgfInputToken* tok = gu_buf_extend(st->expr_tokens);+ tok->token = NULL;+ tok->n_funs = 0;+}++static PgfLinFuncs pgf_lookup_lin_funcs = {+ .symbol_token = pgf_lookup_symbol_token,+ .begin_phrase = pgf_lookup_begin_phrase,+ .end_phrase = pgf_lookup_end_phrase,+ .symbol_ne = NULL,+ .symbol_bind = NULL,+ .symbol_capit = NULL,+ .symbol_meta = pgf_lookup_symbol_meta+};++PGF_API GuEnum*+pgf_lookup_sentence(PgfConcr* concr, PgfType* typ, GuString sentence, GuPool* pool, GuPool* out_pool)+{+ //// building search indices //+ GuMap* lexicon_idx = gu_new_string_map(GuBuf*, &gu_null_struct, pool);+ size_t n_cncfuns = gu_seq_length(concr->cncfuns);+ for (size_t i = 0; i < n_cncfuns; i++) {+ PgfCncFun* cncfun = gu_seq_get(concr->cncfuns, PgfCncFun*, i);+ for (size_t lin_idx = 0; lin_idx < cncfun->n_lins; lin_idx++) {+ pgf_lookup_index_syms(lexicon_idx, cncfun->lins[lin_idx]->syms, cncfun->absfun, pool);+ }+ }++ GuMap* function_idx = gu_new_string_map(GuBuf*, &gu_null_struct, pool);+ size_t n_funs = gu_seq_length(concr->abstr->funs);+ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun* fun = gu_seq_index(concr->abstr->funs, PgfAbsFun, i);++ size_t n_hypos = gu_seq_length(fun->type->hypos);+ for (size_t j = 0; j < n_hypos; j++) {+ PgfHypo* hypo = gu_seq_index(fun->type->hypos, PgfHypo, j);+ + GuBuf* funs = gu_map_get(function_idx, hypo->type->cid, GuBuf*);+ if (funs == NULL) {+ funs = gu_new_buf(PgfAbsBottomUpEntry, pool);+ gu_map_put(function_idx, hypo->type->cid, GuBuf*, funs);+ }++ PgfAbsBottomUpEntry* entry = gu_buf_extend(funs);+ entry->fun = fun;+ entry->arg_idx = j;+ }+ }+ ///////////////////////////////++ GuPool *work_pool = gu_new_pool();++ GuBuf* sentence_tokens =+ pgf_lookup_tokenize(lexicon_idx, sentence, work_pool);++ PgfMetaId meta_id1 = 0;+ GuBuf* join = gu_new_buf(GuBuf*, pool);+ gu_buf_push(join, GuBuf*, NULL);++ size_t n_tokens = gu_buf_length(sentence_tokens);+ for (size_t i = 0; i < n_tokens; i++) {+ PgfInputToken* tok = gu_buf_index(sentence_tokens, PgfInputToken, i);++ PgfMetaId meta_id2 = 0;+ GuBuf* spine =+ pgf_lookup_build_spine(function_idx,+ tok, typ, &meta_id2,+ work_pool);++ join = pgf_lookup_merge(meta_id1, join, meta_id2, spine, &meta_id1, work_pool, pool);+ }++#ifdef PGF_LOOKUP_DEBUG+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ pgf_print_abs_productions(join, out, err);+ gu_putc('\n',out,err);+ gu_pool_free(tmp_pool);+#endif++ PgfLookupState st;+ st.funcs = &pgf_lookup_lin_funcs;+ st.concr = concr;+ st.join = join;+ st.start_id= meta_id1;+ st.choice = gu_new_choice(work_pool);+ st.expr_tokens=gu_new_buf(PgfInputToken, work_pool);+ st.ctrees = gu_new_buf(PgfCncTreeScore, pool);+ st.curr_absfun= NULL;+ st.max_fid = concr->total_cats;+ st.pool = pool;++ GuMap* cache = gu_new_map(PgfPair, pgf_pair_hasher, PgfCCat*, &gu_null_struct, pool);++ double sentence_value =+ pgf_lookup_compute_kernel(sentence_tokens, sentence_tokens);++ double max = 0;++ PgfCncCat* cnccat =+ gu_map_get(concr->cnccats, typ->cid, PgfCncCat*);+ size_t n_ccats = (cnccat) ? gu_seq_length(cnccat->cats) : 0;+ for (size_t i = 0; i < n_ccats; i++) {+ PgfCCat* ccat = gu_seq_get(cnccat->cats, PgfCCat*, i);+ PgfCCat* new_ccat = pgf_lookup_concretize(&st, cache, st.start_id, ccat);+ if (new_ccat == NULL)+ continue;++ GuChoiceMark mark = gu_choice_mark(st.choice);++ for (;;) {+ PgfCncTreeScore* cts = gu_buf_extend(st.ctrees);+ cts->ctree =+ pgf_lookup_extract(&st, new_ccat);++ cts->ctree = pgf_lzr_wrap_linref(cts->ctree, st.pool);+ pgf_lzr_linearize(concr, cts->ctree, 0, &st.funcs, st.pool);++ double value = pgf_lookup_compute_kernel(sentence_tokens, st.expr_tokens);+ double expr_value = pgf_lookup_compute_kernel(st.expr_tokens, st.expr_tokens);+ cts->score =+ value / sqrt(sentence_value * expr_value);++ gu_buf_flush(st.expr_tokens);++#ifdef PGF_LINEARIZER_DEBUG+ {+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ pgf_lzr_linearize_simple(concr, cts->ctree, 0,+ out, err, tmp_pool);+ gu_putc('\n', out, err);+ pgf_print_cnc_tree(cts->ctree, out, err);+ gu_printf(out, err, " [%.1f/sqrt(%.1f*%.1f)=%f]\n\n", value, sentence_value, expr_value, cts->score);+ gu_pool_free(tmp_pool);+ }+#endif++ if (cts->score > max) {+ max = cts->score;+ }++ gu_choice_reset(st.choice, mark);++ if (!gu_choice_advance(st.choice))+ break;+ }+ }++ gu_pool_free(work_pool);+++ PgfLookupEnum* lenum = gu_new(PgfLookupEnum, pool);+ lenum->en.next = pgf_lookup_enum_next;+ lenum->max = max;+ lenum->index = 0;+ lenum->ctrees = st.ctrees;+ lenum->out_pool= out_pool;+ return &lenum->en;+}
@@ -0,0 +1,2611 @@+#include <pgf/data.h>+#include <pgf/expr.h>+#include <pgf/linearizer.h>+#include <gu/enum.h>+#include <gu/seq.h>+#include <gu/assert.h>+#include <gu/choice.h>+#include <gu/file.h>+#include <gu/utf8.h>+#include <math.h>+#include <stdlib.h>++//#define PGF_PARSER_DEBUG+//#define PGF_COUNTS_DEBUG+//#define PGF_RESULT_DEBUG++typedef GuBuf PgfItemBuf;++typedef struct PgfParseState PgfParseState;++struct PgfItemConts {+ PgfCCat* ccat;+ size_t lin_idx;+ PgfParseState* state;+ prob_t outside_prob;+ PgfItemBuf* items;+ int ref_count; // how many items point to this cont?+};++typedef GuSeq PgfItemContss;+typedef GuMap PgfContsMap;+typedef GuMap PgfGenCatMap;++typedef GuBuf PgfCCatBuf;++typedef struct {+ PgfConcr* concr;+ GuPool* pool; // this pool is used for structures internal to the parser+ GuPool* out_pool; // this pool is used for the allocating the final abstract trees+ GuString sentence; // the sentence to be parsed+ bool case_sensitive;+ GuBuf* expr_queue; // during the extraction of abstract trees we push them in this queue+ int max_fid;+ PgfParseState *before;+ PgfParseState *after;+ PgfToken prefix;+ PgfTokenProb* tp;+ PgfExprEnum en; // enumeration for the generated trees/tokens+#ifdef PGF_COUNTS_DEBUG+ int item_full_count;+ int item_real_count;+ int cont_full_count;+ int ccat_full_count;+ int prod_full_count;+#endif+ PgfItem* free_item;++ prob_t heuristic_factor;+ PgfCallbacksMap* callbacks;+ PgfOracleCallback* oracle;+} PgfParsing;++typedef enum { BIND_NONE, BIND_HARD, BIND_SOFT } BIND_TYPE;++typedef struct {+ PgfProductionIdx* idx;+ size_t offset;+ size_t sym_idx;+} PgfLexiconIdxEntry;++typedef GuBuf PgfLexiconIdx;++struct PgfParseState {+ PgfParseState* next;++ PgfItemBuf* agenda;+ PgfContsMap* conts_map;+ PgfGenCatMap* generated_cats;++ bool needs_bind;+ size_t start_offset;+ size_t end_offset;++ prob_t viterbi_prob;++ PgfLexiconIdx* lexicon_idx;+};++typedef struct PgfAnswers {+ GuBuf* conts;+ GuBuf* exprs;+ prob_t outside_prob;+} PgfAnswers;++typedef struct {+ PgfAnswers* answers;+ PgfExprProb ep;+ PgfPArgs* args;+ size_t arg_idx;+} PgfExprState;++typedef struct PgfItemBase PgfItemBase;++struct PgfItem {+ union {+ PgfItemConts* conts;+ PgfItem *next; // used to collect released items+ };++ PgfProduction prod;+ PgfPArgs* args;+ PgfSymbol curr_sym;+ uint16_t sym_idx;+ uint8_t alt_idx; // position in the pre alternative+ uint8_t alt; // the number of the alternative+ prob_t inside_prob;+};++static PgfSymbol+pgf_prev_extern_sym(PgfSymbol sym)+{+ GuVariantInfo i = gu_variant_open(sym);+ switch (i.tag) {+ case PGF_SYMBOL_CAT:+ return *((PgfSymbol*) (((PgfSymbolCat*) i.data)+1));+ case PGF_SYMBOL_KP:+ return *((PgfSymbol*) (((PgfSymbolKP*) i.data)+1));+ case PGF_SYMBOL_KS: {+ PgfSymbolKS* sks = (PgfSymbolKS*) i.data;+ size_t tok_len = strlen(sks->token);+ return *((PgfSymbol*) (((uint8_t*) sks)+sizeof(PgfSymbolKS)+tok_len+1));+ }+ case PGF_SYMBOL_LIT:+ return *((PgfSymbol*) (((PgfSymbolLit*) i.data)+1));+ case PGF_SYMBOL_VAR:+ return *((PgfSymbol*) (((PgfSymbolVar*) i.data)+1));+ case PGF_SYMBOL_BIND:+ case PGF_SYMBOL_SOFT_BIND:+ case PGF_SYMBOL_SOFT_SPACE:+ return *((PgfSymbol*) (((PgfSymbolBIND*) i.data)+1));+ case PGF_SYMBOL_CAPIT:+ case PGF_SYMBOL_ALL_CAPIT:+ return *((PgfSymbol*) (((PgfSymbolCAPIT*) i.data)+1));+ case PGF_SYMBOL_NE:+ return *((PgfSymbol*) (((PgfSymbolNE*) i.data)+1));+ default:+ gu_impossible();+ return gu_null_variant;+ }+}++static PgfSymbol+pgf_collect_extern_tok(PgfParsing* ps, size_t start_offset, size_t end_offset)+{+ PgfSymbol sym = gu_null_variant;++ const uint8_t* start = (uint8_t*) ps->sentence+start_offset;+ const uint8_t* end = (uint8_t*) ps->sentence+end_offset;++ const uint8_t* p = start;+ GuUCS ucs = gu_utf8_decode(&p);+ while (start < end) {+ size_t len = 0;+ while (p <= end && !gu_ucs_is_space(ucs)) {+ len = (p - start);+ ucs = gu_utf8_decode(&p);+ }++ PgfSymbol new_sym;+ PgfSymbolKS* sks = (PgfSymbolKS*)+ gu_alloc_variant(PGF_SYMBOL_KS,+ sizeof(PgfSymbol)+sizeof(PgfSymbolKS)+len+1,+ gu_alignof(PgfSymbolKS),+ &new_sym, ps->pool);+ memcpy((char*) sks->token, start, len);+ ((char*) sks->token)[len] = 0;+ *((PgfSymbol*) (((uint8_t*) sks)+sizeof(PgfSymbolKS)+len+1)) = sym;+ sym = new_sym;++ start = p;+ while (gu_ucs_is_space(ucs)) {+ start = p;+ ucs = gu_utf8_decode(&p);+ }+ }++ return sym;+}++static size_t+pgf_item_symbols_length(PgfItem* item)+{+ GuVariantInfo i = gu_variant_open(item->prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ return gu_seq_length(papp->fun->lins[item->conts->lin_idx]->syms);+ }+ case PGF_PRODUCTION_COERCE: {+ return 1;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = i.data;+ PgfSymbols* syms;++ if (pext->lins != NULL &&+ (syms = gu_seq_get(pext->lins,PgfSymbols*,item->conts->lin_idx)) != NULL) {+ return gu_seq_length(syms);+ } else {+ int seq_len = 0;+ PgfSymbol sym = item->curr_sym;+ while (!gu_variant_is_null(sym)) {+ seq_len++;+ sym = pgf_prev_extern_sym(sym);+ }+ + return seq_len;+ }+ }+ default:+ gu_impossible();+ return 0;+ }+}++static PgfSymbols*+pgf_extern_syms_get(PgfItem* item, GuPool* pool)+{+ int syms_len = pgf_item_symbols_length(item);++ PgfSymbols* syms =+ gu_new_seq(PgfSymbol, syms_len, pool);+ PgfSymbol sym = item->curr_sym;+ while (!gu_variant_is_null(sym)) {+ gu_seq_set(syms, PgfSymbol, --syms_len, sym);+ sym = pgf_prev_extern_sym(sym);+ }+ + return syms;+}++PGF_INTERNAL void+pgf_print_fid(int fid, GuOut* out, GuExn* err);++PGF_INTERNAL_DECL void+pgf_print_symbol(PgfSymbol sym, GuOut *out, GuExn *err);++#ifdef PGF_PARSER_DEBUG+static void+pgf_item_symbols(PgfItem* item,+ size_t* lin_idx, PgfSymbols** syms,+ GuPool* pool) {+ *lin_idx = item->conts->lin_idx;++ GuVariantInfo i = gu_variant_open(item->prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ *syms = papp->fun->lins[item->conts->lin_idx]->syms;+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfSymbol sym =+ gu_new_variant_i(pool, PGF_SYMBOL_CAT,+ PgfSymbolCat,+ .d = 0, .r = item->conts->lin_idx);+ *syms = gu_new_seq(PgfSymbol, 1, pool);+ gu_seq_set(*syms, PgfSymbol, 0, sym);+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = i.data;+ + if (pext->lins == NULL ||+ (*syms = gu_seq_get(pext->lins, PgfSymbols*, item->conts->lin_idx)) == NULL) {+ *syms = pgf_extern_syms_get(item, pool);+ }+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_print_production_args(PgfPArgs* args,+ GuOut* out, GuExn* err)+{+ size_t n_args = gu_seq_length(args);+ for (size_t j = 0; j < n_args; j++) {+ if (j > 0)+ gu_putc(',',out,err);++ PgfPArg arg = gu_seq_get(args, PgfPArg, j);++ if (arg.hypos != NULL &&+ gu_seq_length(arg.hypos) > 0) {+ size_t n_hypos = gu_seq_length(arg.hypos);+ for (size_t k = 0; k < n_hypos; k++) {+ PgfCCat *hypo = gu_seq_get(arg.hypos, PgfCCat*, k);+ pgf_print_fid(hypo->fid, out, err);+ gu_putc(' ',out,err);+ }+ gu_puts("-> ",out,err);+ }++ pgf_print_fid(arg.ccat->fid, out, err);+ }+}++static void+pgf_print_production(int fid, PgfProduction prod, + GuOut *out, GuExn* err, GuPool* pool)+{+ pgf_print_fid(fid, out, err);+ gu_puts(" -> ", out, err);+ + GuVariantInfo i = gu_variant_open(prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ gu_printf(out,err,"F%d(",papp->fun->funid);+ if (papp->fun->ep != NULL) {+ pgf_print_expr(papp->fun->ep->expr, NULL, 0, out, err);+ } else {+ PgfPArg* parg = gu_seq_index(papp->args, PgfPArg, 0);+ gu_printf(out,err,"linref %s", parg->ccat->cnccat->abscat->name);+ }+ gu_printf(out,err,")[");+ pgf_print_production_args(papp->args,out,err);+ gu_printf(out,err,"]\n");+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = i.data;+ gu_puts("_[",out,err);+ pgf_print_fid(pcoerce->coerce->fid, out, err);+ gu_printf("]\n",out,err);+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = i.data;+ gu_printf(out,err,"<extern>(");+ pgf_print_expr(pext->ep->expr, NULL, 0, out, err);+ gu_printf(out,err,")[]\n");+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_print_item_seq(PgfItem *item,+ GuOut *out, GuExn* err, GuPool* pool)+{+ size_t lin_idx;+ PgfSymbols* syms = NULL;+ pgf_item_symbols(item, &lin_idx, &syms, pool);++ gu_printf(out, err, "%d : ",lin_idx);++ size_t index;+ for (index = 0; index < gu_seq_length(syms); index++) {+ if (item->sym_idx == index)+ gu_printf(out, err, " . ");++ PgfSymbol sym = gu_seq_get(syms, PgfSymbol, index);+ pgf_print_symbol(sym, out, err);+ }++ if (item->sym_idx == index)+ gu_printf(out, err, " .");+}++static void+pgf_print_range(PgfParseState* start, PgfParseState* end, GuOut* out, GuExn* err)+{+ gu_printf(out, err, "%d-%d",+ (start != NULL) ? start->end_offset : 0,+ (start == end) ? end->end_offset : end->start_offset);+}++static void+pgf_print_item(PgfItem* item, PgfParseState* state, GuOut* out, GuExn* err, GuPool* pool)+{+ gu_putc('[', out, err);+ pgf_print_range(item->conts->state, state, out, err);+ gu_puts("; ", out, err);+ pgf_print_fid(item->conts->ccat->fid, out, err);+ gu_puts(" -> ", out, err);++ GuVariantInfo i = gu_variant_open(item->prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ PgfCncFun* fun = papp->fun;+ gu_printf(out, err, "F%d(", fun->funid);+ if (fun->ep != NULL) {+ pgf_print_expr(fun->ep->expr, NULL, 0, out, err);+ } else {+ PgfPArg* parg = gu_seq_index(item->args, PgfPArg, 0);+ gu_printf(out,err,"linref %s", parg->ccat->cnccat->abscat->name);+ }+ gu_printf(out, err, ")[");+ pgf_print_production_args(item->args, out, err);+ gu_printf(out, err, "]; ");+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ gu_puts("_[", out, err);+ pgf_print_fid(gu_seq_index(item->args, PgfPArg, 0)->ccat->fid, out, err);+ gu_puts("]; ", out, err);+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = i.data;+ gu_printf(out, err, "<extern>");+ if (pext->ep != NULL) {+ gu_printf(out, err, "(");+ pgf_print_expr(pext->ep->expr, NULL, 0, out, err);+ gu_printf(out, err, ")");+ }+ gu_printf(out, err, "[");+ pgf_print_production_args(item->args, out, err);+ gu_printf(out, err, "]; ");+ break;+ }+ default:+ gu_impossible();+ }+ + pgf_print_item_seq(item, out, err, pool);+ gu_printf(out, err, "; %f+%f=%f]\n",+ item->inside_prob,+ item->conts->outside_prob,+ item->inside_prob+item->conts->outside_prob);+}++#ifdef PGF_RESULT_DEBUG+static void+pgf_print_expr_state(PgfExprState* st,+ GuOut* out, GuExn* err, GuBuf* stack)+{+ gu_buf_push(stack, int, (gu_seq_length(st->args) - st->arg_idx - 1));++ if (gu_buf_length(st->answers->conts) > 0) {+ PgfExprState* cont = gu_buf_get(st->answers->conts, PgfExprState*, 0);+ if (cont != NULL)+ pgf_print_expr_state(cont, out, err, stack);+ }++ gu_puts(" (", out, err);+ if (gu_variant_is_null(st->ep.expr))+ gu_puts("_", out, err);+ else+ pgf_print_expr(st->ep.expr, NULL, 0, out, err);+}++static void+pgf_print_expr_state0(PgfExprState* st,+ GuOut* out, GuExn* err, GuPool* tmp_pool)+{ + gu_printf(out, err, "[%f+%f=%f]",+ st->ep.prob,+ st->answers->outside_prob,+ st->answers->outside_prob+st->ep.prob);++ size_t n_args = gu_seq_length(st->args);++ GuBuf* stack = gu_new_buf(int, tmp_pool);+ if (n_args > 0)+ gu_buf_push(stack, int, n_args - st->arg_idx);++ if (gu_buf_length(st->answers->conts) > 0) {+ PgfExprState* cont =+ gu_buf_get(st->answers->conts, PgfExprState*, 0);+ if (cont != NULL)+ pgf_print_expr_state(cont, out, err, stack);+ }++ if (n_args > 0)+ gu_puts(" (", out, err);+ else+ gu_puts(" ", out, err);++ if (gu_variant_is_null(st->ep.expr))+ gu_puts("_", out, err);+ else+ pgf_print_expr(st->ep.expr, NULL, 0, out, err);++ size_t n_counts = gu_buf_length(stack);+ for (size_t i = 0; i < n_counts; i++) {+ int count = gu_buf_get(stack, int, i);+ while (count-- > 0)+ gu_puts(" ?", out, err);+ + gu_puts(")", out, err);+ }+ gu_puts("\n", out, err);+}+#endif+#endif++static int+cmp_string(GuString* psent, GuString tok, bool case_sensitive)+{+ for (;;) {+ GuUCS c2 = gu_utf8_decode((const uint8_t**) &tok);+ if (c2 == 0)+ return 0;++ const uint8_t* p = (uint8_t*) *psent;+ GuUCS c1 = gu_utf8_decode(&p);+ if (c1 == 0)+ return -1;++ if (!case_sensitive)+ c1 = gu_ucs_to_lower(c1);++ if (c1 != c2)+ return (c1-c2);++ *psent = (GuString) p;+ }+}++static bool+skip_space(GuString* psent)+{+ const uint8_t* p = (uint8_t*) *psent;+ if (!gu_ucs_is_space(gu_utf8_decode(&p)))+ return false;++ *psent = (GuString) p;+ return true;+}++static int+cmp_item_prob(GuOrder* self, const void* a, const void* b)+{+ PgfItem *item1 = *((PgfItem **) a);+ PgfItem *item2 = *((PgfItem **) b);++ prob_t prob1 = item1->inside_prob + item1->conts->outside_prob;+ prob_t prob2 = item2->inside_prob + item2->conts->outside_prob;+ + return (prob1>prob2) - (prob1<prob2);+}++static GuOrder+pgf_item_prob_order[1] = { { cmp_item_prob } };++static int+cmp_item_production_idx_entry(GuOrder* self, const void* a, const void* b)+{+ PgfProductionIdxEntry *entry1 = (PgfProductionIdxEntry *) a;+ PgfProductionIdxEntry *entry2 = (PgfProductionIdxEntry *) b;++ if (entry1->ccat->fid < entry2->ccat->fid)+ return -1;+ else if (entry1->ccat->fid > entry2->ccat->fid)+ return 1;+ else if (entry1->lin_idx < entry2->lin_idx)+ return -1;+ else if (entry1->lin_idx > entry2->lin_idx)+ return 1;+ else+ return 0;+}++static GuOrder+pgf_production_idx_entry_order[1] = { { cmp_item_production_idx_entry } };++static inline PgfItemContss*+pgf_parsing_get_contss(PgfParseState* state, PgfCCat* cat, GuPool *pool)+{+ return gu_map_get(state->conts_map, cat, PgfItemContss*);+}++static PgfItemConts*+pgf_parsing_get_conts(PgfParseState* state,+ PgfCCat* ccat, size_t lin_idx,+ GuPool *pool)+{+ gu_require(lin_idx < ccat->cnccat->n_lins);++ PgfItemContss* contss = + pgf_parsing_get_contss(state, ccat, pool);+ if (contss == NULL) {+ size_t n_lins = ccat->cnccat->n_lins;+ contss = gu_new_seq(PgfItemConts*, n_lins, pool);+ for (size_t i = 0; i < n_lins; i++) {+ gu_seq_set(contss, PgfItemConts*, i, NULL);+ }+ gu_map_put(state->conts_map, ccat, PgfItemContss*, contss);+ }++ PgfItemConts* conts = gu_seq_get(contss, PgfItemConts*, lin_idx);+ if (!conts) {+ conts = gu_new(PgfItemConts, pool);+ conts->ccat = ccat;+ conts->lin_idx = lin_idx;+ conts->state = state;+ conts->items = gu_new_buf(PgfItem*, pool);+ conts->outside_prob = 0;+ conts->ref_count = 0;+ gu_seq_get(contss, PgfItemConts*, lin_idx) = conts;+ +#ifdef PGF_COUNTS_DEBUG+ if (state != NULL) {+ state->ps->cont_full_count++;+ }+#endif+ }+ return conts;+}++static void+gu_ccat_fini(GuFinalizer* fin)+{+ PgfCCat* cat = gu_container(fin, PgfCCat, fin);+ if (cat->prods != NULL)+ gu_seq_free(cat->prods);+}++static PgfCCat*+pgf_parsing_create_completed(PgfParsing* ps, PgfParseState* state, + PgfItemConts* conts,+ prob_t viterbi_prob)+{+ PgfCCat* cat = gu_new_flex(ps->pool, PgfCCat, fin, 1);+ cat->cnccat = conts->ccat->cnccat;+ cat->lindefs = conts->ccat->lindefs;+ cat->linrefs = conts->ccat->linrefs;+ cat->viterbi_prob = viterbi_prob;+ cat->fid = ps->max_fid++;+ cat->conts = conts;+ cat->answers = NULL;+ cat->prods = NULL;+ cat->n_synprods = 0;+ gu_map_put(state->generated_cats, conts, PgfCCat*, cat);+ + cat->fin[0].fn = gu_ccat_fini;+ gu_pool_finally(ps->pool, cat->fin);++#ifdef PGF_COUNTS_DEBUG+ state->ps->ccat_full_count++;+#endif++ return cat;+}++static PgfCCat*+pgf_parsing_get_completed(PgfParseState* state, PgfItemConts* conts)+{+ return gu_map_get(state->generated_cats, conts, PgfCCat*);+}++static void+pgf_item_set_curr_symbol(PgfItem* item, GuPool* pool)+{+ GuVariantInfo i = gu_variant_open(item->prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ PgfCncFun* fun = papp->fun;+ gu_assert(item->conts->lin_idx < fun->n_lins);+ PgfSymbols* syms = fun->lins[item->conts->lin_idx]->syms;+ gu_assert(item->sym_idx <= gu_seq_length(syms));+ if (item->sym_idx == gu_seq_length(syms)) {+ item->curr_sym = gu_null_variant;+ } else {+ item->curr_sym = gu_seq_get(syms, PgfSymbol, item->sym_idx);+ }+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ gu_assert(item->sym_idx <= 1);+ if (item->sym_idx == 1) {+ item->curr_sym = gu_null_variant;+ } else {+ item->curr_sym = gu_new_variant_i(pool, PGF_SYMBOL_CAT,+ PgfSymbolCat,+ .d = 0, .r = item->conts->lin_idx);+ }+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ break;+ }+ default:+ gu_impossible();+ }+}++static PgfItem*+pgf_new_item(PgfParsing* ps, PgfItemConts* conts, PgfProduction prod)+{+ PgfItem* item;+ if (ps->free_item == NULL)+ item = gu_new(PgfItem, ps->pool);+ else {+ item = ps->free_item;+ ps->free_item = ps->free_item->next;+ }++ GuVariantInfo pi = gu_variant_open(prod);+ switch (pi.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = pi.data;+ item->args = papp->args;+ item->inside_prob = papp->fun->ep->prob;+ + int n_args = gu_seq_length(item->args);+ for (int i = 0; i < n_args; i++) {+ PgfPArg *arg = gu_seq_index(item->args, PgfPArg, i);+ item->inside_prob += arg->ccat->viterbi_prob;+ }+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = pi.data;+ item->args = gu_new_seq(PgfPArg, 1, ps->pool);+ PgfPArg* parg = gu_seq_index(item->args, PgfPArg, 0);+ parg->hypos = NULL;+ parg->ccat = pcoerce->coerce;+ item->inside_prob = pcoerce->coerce->viterbi_prob;+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = pi.data;+ item->args = gu_empty_seq();+ item->inside_prob = pext->ep->prob;+ break;+ }+ default:+ gu_impossible();+ }+ item->conts = conts;+ item->prod = prod;+ item->curr_sym = gu_null_variant;+ item->sym_idx = 0;+ item->alt_idx = 0;+ item->alt = 0;++ conts->ref_count++;++ pgf_item_set_curr_symbol(item, ps->pool);++#ifdef PGF_COUNTS_DEBUG+ ps->item_full_count++;+ ps->item_real_count++;+#endif++ return item;+}++static PgfItem*+pgf_item_copy(PgfItem* item, PgfParsing* ps)+{+ PgfItem* copy;+ if (ps == NULL || ps->free_item == NULL)+ copy = gu_new(PgfItem, ps->pool);+ else {+ copy = ps->free_item;+ ps->free_item = ps->free_item->next;+ }+ memcpy(copy, item, sizeof(PgfItem));++#ifdef PGF_COUNTS_DEBUG+ if (ps != NULL) {+ ps->item_full_count++;+ ps->item_real_count++;+ }+#endif++ item->conts->ref_count++;++ return copy;+}++static PgfItem*+pgf_item_update_arg(PgfItem* item, size_t d, PgfCCat *new_ccat,+ PgfParsing *ps)+{+ PgfCCat *old_ccat =+ gu_seq_index(item->args, PgfPArg, d)->ccat;++ PgfItem* new_item = pgf_item_copy(item, ps);+ size_t nargs = gu_seq_length(item->args);+ new_item->args = gu_new_seq(PgfPArg, nargs, ps->pool);+ memcpy(gu_seq_data(new_item->args), gu_seq_data(item->args),+ nargs * sizeof(PgfPArg));+ gu_seq_set(new_item->args, PgfPArg, d,+ ((PgfPArg) { .hypos = NULL, .ccat = new_ccat }));+ new_item->inside_prob += + new_ccat->viterbi_prob - old_ccat->viterbi_prob;++ return new_item;+}++static void+pgf_item_advance(PgfItem* item, GuPool* pool)+{+ if (GU_LIKELY(item->alt == 0)) {+ item->sym_idx++;+ pgf_item_set_curr_symbol(item, pool);+ }+ else+ item->alt_idx++;+}++static void+pgf_item_free(PgfParsing* ps, PgfItem* item)+{+ PgfItemConts* conts = item->conts;+ conts->ref_count--;+ do {+ if (conts->ref_count != 0)+ break;++ conts = conts->ccat->conts;+ } while (conts != NULL);++ if (conts == NULL) {+ size_t n_items = gu_buf_length(item->conts->items);+ for (size_t i = 0; i < n_items; i++) {+ PgfItem* cont = gu_buf_get(item->conts->items, PgfItem*, i);+ if (cont == NULL)+ continue;++ pgf_item_free(ps, cont);+ }+ }++#ifdef PGF_PARSER_DEBUG+ memset(item, 0, sizeof(*item));+#endif+ item->next = ps->free_item;+ ps->free_item = item;+#ifdef PGF_COUNTS_DEBUG+ ps->item_real_count--;+#endif+}++static void+pgf_result_predict(PgfParsing* ps, + PgfExprState* cont, PgfCCat* ccat);++static void+pgf_result_production(PgfParsing* ps, + PgfAnswers* answers, PgfProduction prod);++static void+pgf_parsing_combine(PgfParsing* ps,+ PgfParseState* before, PgfParseState* after,+ PgfItem* cont, PgfCCat* cat, int lin_idx)+{+ PgfItem* item = NULL;+ switch (gu_variant_tag(cont->curr_sym)) {+ case PGF_SYMBOL_CAT: {+ PgfSymbolCat* scat = gu_variant_data(cont->curr_sym);+ item = pgf_item_update_arg(cont, scat->d, cat, ps);+ break;+ }+ case PGF_SYMBOL_LIT: {+ PgfSymbolLit* slit = gu_variant_data(cont->curr_sym);+ item = pgf_item_update_arg(cont, slit->d, cat, ps);+ break;+ }+ default:+ gu_impossible();+ }++ pgf_item_advance(item, ps->pool);+ gu_buf_heap_push(before->agenda, pgf_item_prob_order, &item);+}++static void+pgf_parsing_production(PgfParsing* ps, PgfParseState* state,+ PgfItemConts* conts, PgfProduction prod)+{+ PgfItem* item =+ pgf_new_item(ps, conts, prod);+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);+}++static PgfProduction+pgf_parsing_new_production(PgfItem* item, PgfExprProb *ep, GuPool *pool)+{+ GuVariantInfo i = gu_variant_open(item->prod);+ PgfProduction prod = gu_null_variant;+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ PgfProductionApply* new_papp = + gu_new_variant(PGF_PRODUCTION_APPLY,+ PgfProductionApply,+ &prod, pool);+ new_papp->fun = papp->fun;+ new_papp->args = item->args;+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* new_pcoerce =+ gu_new_variant(PGF_PRODUCTION_COERCE,+ PgfProductionCoerce,+ &prod, pool);+ PgfPArg* parg = gu_seq_index(item->args, PgfPArg, 0);+ new_pcoerce->coerce = parg->ccat;+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = i.data;++ if (pext->lins == NULL ||+ gu_seq_get(pext->lins,PgfSymbols*,item->conts->lin_idx) == NULL) {+ PgfSymbols* syms =+ pgf_extern_syms_get(item, pool);++ size_t n_lins = item->conts->ccat->cnccat->n_lins;++ PgfProductionExtern* new_pext = (PgfProductionExtern*)+ gu_new_variant(PGF_PRODUCTION_EXTERN,+ PgfProductionExtern,+ &prod, pool);+ new_pext->ep = ep;+ new_pext->lins = gu_new_seq(PgfSymbols*, n_lins, pool);++ if (pext->lins == NULL) {+ for (size_t i = 0; i < n_lins; i++) {+ gu_seq_set(new_pext->lins,PgfSymbols*,i,NULL);+ }+ } else {+ for (size_t i = 0; i < n_lins; i++) {+ gu_seq_set(new_pext->lins,PgfSymbols*,i,+ gu_seq_get(pext->lins,PgfSymbols*,i));+ }+ }+ gu_seq_set(new_pext->lins,PgfSymbols*,item->conts->lin_idx,syms);+ } else {+ prod = item->prod;+ }+ break;+ }+ default:+ gu_impossible();+ }+ + return prod;+}++static void+pgf_parsing_complete(PgfParsing* ps, PgfItem* item, PgfExprProb *ep)+{+ if (ps->oracle && ps->oracle->complete) {+ // ask the oracle whether to complete+ if (!ps->oracle->complete(ps->oracle,+ item->conts->ccat->cnccat->abscat->name,+ item->conts->ccat->cnccat->labels[item->conts->lin_idx],+ ps->before->end_offset))+ return;+ }++ PgfProduction prod =+ pgf_parsing_new_production(item, ep, ps->pool);+#ifdef PGF_COUNTS_DEBUG+ ps->prod_full_count++;+#endif++ PgfCCat* tmp_ccat = pgf_parsing_get_completed(ps->before, item->conts);+ PgfCCat* ccat = tmp_ccat;+ if (ccat == NULL) {+ ccat = pgf_parsing_create_completed(ps, ps->before, item->conts, item->inside_prob);+ }++ if (ccat->prods == NULL || ccat->n_synprods >= gu_seq_length(ccat->prods)) {+ ccat->prods = gu_realloc_seq(ccat->prods, PgfProduction, ccat->n_synprods+1);+ }+ gu_seq_set(ccat->prods, PgfProduction, ccat->n_synprods++, prod);++#ifdef PGF_PARSER_DEBUG+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ if (tmp_ccat == NULL) {+ gu_printf(out, err, "[");+ pgf_print_range(item->conts->state, ps->before, out, err);+ gu_puts("; ", out, err);+ pgf_print_fid(item->conts->ccat->fid, out, err);+ gu_printf(out, err, "; %d; ",+ item->conts->lin_idx);+ pgf_print_fid(ccat->fid, out, err);+ gu_puts("]\n", out, err);+ }+ pgf_print_production(ccat->fid, prod, out, err, tmp_pool);+ gu_pool_free(tmp_pool);+#endif++ if (item->conts->ccat->fid == -5) {+ if (ps->before->end_offset == strlen(ps->sentence)) {+ PgfPArg* parg = gu_seq_index(item->args, PgfPArg, 0);+ pgf_result_predict(ps, NULL, parg->ccat);+ }+ return;+ }++ if (tmp_ccat != NULL) {+ PgfItemContss* contss =+ pgf_parsing_get_contss(ps->before, ccat, ps->pool);+ if (contss != NULL) {+ size_t n_contss = gu_seq_length(contss);+ for (size_t i = 0; i < n_contss; i++) {+ PgfItemConts* conts2 = gu_seq_get(contss, PgfItemConts*, i);+ /* If there are continuations for+ * linearization index i, then (cat, i) has+ * already been predicted. Add the new+ * production immediately to the agenda,+ * i.e. process it. */+ if (conts2) {+ pgf_parsing_production(ps, ps->before, conts2, prod);+ }+ }+ }++ // The category has already been created. If it has also been+ // predicted already, then process a new item for this production.+ PgfParseState* state = ps->after;+ while (state != NULL) {+ PgfItemContss* contss =+ pgf_parsing_get_contss(state, ccat, ps->pool);+ if (contss != NULL) {+ size_t n_contss = gu_seq_length(contss);+ for (size_t i = 0; i < n_contss; i++) {+ PgfItemConts* conts2 = gu_seq_get(contss, PgfItemConts*, i);+ /* If there are continuations for+ * linearization index i, then (cat, i) has+ * already been predicted. Add the new+ * production immediately to the agenda,+ * i.e. process it. */+ if (conts2) {+ pgf_parsing_production(ps, state, conts2, prod);+ }+ }+ }++ state = state->next;+ }+ + if (ccat->answers != NULL) {+ pgf_result_production(ps, ccat->answers, prod);+ }+ } else {+ size_t n_conts = gu_buf_length(item->conts->items);+ for (size_t i = 0; i < n_conts; i++) {+ PgfItem* cont = gu_buf_get(item->conts->items, PgfItem*, i);+ pgf_parsing_combine(ps, ps->before, ps->after, cont, ccat, item->conts->lin_idx);+ }+ }+}++static int+pgf_symbols_cmp(GuString* psent, PgfSymbols* syms, size_t* sym_idx, bool case_sensitive)+{+ size_t n_syms = gu_seq_length(syms);+ while (*sym_idx < n_syms) {+ PgfSymbol sym = gu_seq_get(syms, PgfSymbol, *sym_idx);++ if (*sym_idx > 0) {+ if (!skip_space(psent)) {+ if (**psent == 0)+ return -1;+ return 1;+ }++ while (**psent != 0) {+ if (!skip_space(psent))+ break;+ }+ }++ GuVariantInfo inf = gu_variant_open(sym);+ switch (inf.tag) {+ case PGF_SYMBOL_CAT:+ case PGF_SYMBOL_LIT:+ case PGF_SYMBOL_VAR: {+ if (**psent == 0)+ return -1;+ return 1;+ }+ case PGF_SYMBOL_KS: {+ PgfSymbolKS* pks = inf.data;+ if (**psent == 0)+ return -1;++ int cmp = cmp_string(psent, pks->token, case_sensitive);+ if (cmp != 0)+ return cmp;+ break;+ }+ case PGF_SYMBOL_KP:+ case PGF_SYMBOL_BIND:+ case PGF_SYMBOL_NE:+ case PGF_SYMBOL_SOFT_BIND:+ case PGF_SYMBOL_SOFT_SPACE:+ case PGF_SYMBOL_CAPIT:+ case PGF_SYMBOL_ALL_CAPIT: {+ return -1;+ }+ default:+ gu_impossible();+ }++ (*sym_idx)++;+ }++ return 0;+}++static void+pgf_parsing_lookahead(PgfParsing *ps, PgfParseState* state,+ int i, int j, ptrdiff_t min, ptrdiff_t max)+{+ // This is a variation of a binary search algorithm which+ // can retrieve all prefixes of a string with minimal+ // comparisons, i.e. there is no need to lookup every+ // prefix separately.++ while (i <= j) {+ int k = (i+j) / 2;+ PgfSequence* seq = gu_seq_index(ps->concr->sequences, PgfSequence, k);++ GuString start = ps->sentence + state->end_offset;+ GuString current = start;+ size_t sym_idx = 0;+ int cmp = pgf_symbols_cmp(¤t, seq->syms, &sym_idx, ps->case_sensitive);+ if (cmp < 0) {+ j = k-1;+ } else if (cmp > 0) {+ ptrdiff_t len = current - start;++ if (min <= len)+ pgf_parsing_lookahead(ps, state, i, k-1, min, len);++ if (len+1 <= max)+ pgf_parsing_lookahead(ps, state, k+1, j, len+1, max);++ break;+ } else {+ ptrdiff_t len = current - start;++ if (min <= len-1)+ pgf_parsing_lookahead(ps, state, i, k-1, min, len-1);++ if (seq->idx != NULL) {+ PgfLexiconIdxEntry* entry = gu_buf_extend(state->lexicon_idx);+ entry->idx = seq->idx;+ entry->offset = (size_t) (current - ps->sentence);+ entry->sym_idx = sym_idx;+ }++ if (len+1 <= max)+ pgf_parsing_lookahead(ps, state, k+1, j, len+1, max);++ break;+ }+ }+}++static PgfParseState*+pgf_new_parse_state(PgfParsing* ps, size_t start_offset,+ BIND_TYPE bind_type,+ prob_t viterbi_prob)+{+ PgfParseState** pstate;+ if (ps->before == NULL && start_offset == 0)+ pstate = &ps->before;+ else {+ if (bind_type != BIND_NONE) {+ if (ps->before->start_offset == start_offset &&+ ps->before->end_offset == start_offset &&+ !ps->before->needs_bind)+ return ps->before;+ } else {+ if (ps->before->start_offset == start_offset)+ return ps->before;+ }++ pstate = &ps->after;+ while (*pstate != NULL) {+ if (bind_type != BIND_NONE) {+ if ((*pstate)->start_offset == start_offset &&+ (*pstate)->end_offset == start_offset &&+ !(*pstate)->needs_bind)+ return *pstate;+ } else {+ if ((*pstate)->start_offset == start_offset)+ return *pstate;+ }+ if ((*pstate)->start_offset > start_offset)+ break;+ pstate = &(*pstate)->next;+ }+ }++ size_t end_offset = start_offset;+ GuString current = ps->sentence + end_offset;+ while (skip_space(¤t)) {+ end_offset++;+ }++ if (bind_type == BIND_HARD && start_offset != end_offset)+ return NULL;++ PgfParseState* state = gu_new(PgfParseState, ps->pool);+ state->next = *pstate;+ state->agenda = gu_new_buf(PgfItem*, ps->pool);+ state->generated_cats = gu_new_addr_map(PgfItemConts*, PgfCCat*, &gu_null_struct, ps->pool);+ state->conts_map = gu_new_addr_map(PgfCCat*, PgfItemContss*, &gu_null_struct, ps->pool);+ state->needs_bind = (bind_type == BIND_NONE) &&+ (start_offset == end_offset);+ state->start_offset = start_offset;+ state->end_offset = end_offset;+ state->viterbi_prob = viterbi_prob;+ state->lexicon_idx =+ gu_new_buf(PgfLexiconIdxEntry, ps->pool);++ if (ps->before == NULL && start_offset == 0)+ state->needs_bind = false;++ if (gu_seq_length(ps->concr->sequences) > 0) {+ // Add epsilon lexical rules to the bottom up index+ PgfSequence* seq = gu_seq_index(ps->concr->sequences, PgfSequence, 0);+ if (gu_seq_length(seq->syms) == 0 && seq->idx != NULL) {+ PgfLexiconIdxEntry* entry = gu_buf_extend(state->lexicon_idx);+ entry->idx = seq->idx;+ entry->offset = state->start_offset;+ entry->sym_idx= 0;+ }++ // Add non-epsilon lexical rules to the bottom up index+ if (!state->needs_bind) {+ pgf_parsing_lookahead(ps, state,+ 0, gu_seq_length(ps->concr->sequences)-1,+ 1, strlen(ps->sentence)-state->end_offset);+ }+ }+++ *pstate = state;++ return state;+}++static void+pgf_parsing_add_transition(PgfParsing* ps, PgfToken tok, PgfItem* item)+{ + GuString current = ps->sentence + ps->before->end_offset;++ if (ps->prefix != NULL && *current == 0) {+ if (gu_string_is_prefix(ps->prefix, tok)) {+ PgfProductionApply* papp = gu_variant_data(item->prod);++ ps->tp = gu_new(PgfTokenProb, ps->out_pool);+ ps->tp->tok = tok;+ ps->tp->cat = item->conts->ccat->cnccat->abscat->name;+ ps->tp->fun = papp->fun->absfun->name;+ ps->tp->prob = item->inside_prob + item->conts->outside_prob;+ }+ } else {+ if (!ps->before->needs_bind && cmp_string(¤t, tok, ps->case_sensitive) == 0) {+ PgfParseState* state =+ pgf_new_parse_state(ps, (current - ps->sentence),+ BIND_NONE,+ item->inside_prob+item->conts->outside_prob);+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);+ } else {+ pgf_item_free(ps, item);+ }+ }+}++static void+pgf_parsing_predict_lexeme(PgfParsing* ps, PgfItemConts* conts,+ PgfProductionIdxEntry* entry,+ size_t offset, size_t sym_idx)+{+ GuVariantInfo i = { PGF_PRODUCTION_APPLY, entry->papp };+ PgfProduction prod = gu_variant_close(i);+ PgfItem* item =+ pgf_new_item(ps, conts, prod);+ PgfSymbols* syms = entry->papp->fun->lins[conts->lin_idx]->syms;+ item->sym_idx = sym_idx;+ pgf_item_set_curr_symbol(item, ps->pool);+ prob_t prob = item->inside_prob+item->conts->outside_prob;+ PgfParseState* state =+ pgf_new_parse_state(ps, offset, BIND_NONE, prob);+ if (state->viterbi_prob > prob) {+ state->viterbi_prob = prob;+ }+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);+}++static void+pgf_parsing_td_predict(PgfParsing* ps,+ PgfItem* item, PgfCCat* ccat, size_t lin_idx)+{+ PgfItemConts* conts = + pgf_parsing_get_conts(ps->before, ccat, lin_idx, ps->pool);+ gu_buf_push(conts->items, PgfItem*, item);++ if (gu_buf_length(conts->items) == 1) {+ /* First time we encounter this linearization+ * of this category at the current position,+ * so predict it. */++ if (ps->oracle != NULL && ps->oracle->predict) {+ // if there is an oracle ask him if this prediction is appropriate+ if (!ps->oracle->predict(ps->oracle,+ ccat->cnccat->abscat->name,+ ccat->cnccat->labels[lin_idx],+ ps->before->end_offset))+ return;+ }++ conts->outside_prob =+ item->inside_prob-conts->ccat->viterbi_prob++ item->conts->outside_prob;++ if (ps->prefix != NULL) {+ // We do completion:+ // - top-down prediction for both syntactic and lexical rules+ size_t n_prods;+ if (ccat->fid < ps->concr->total_cats) // in grammar+ n_prods = gu_seq_length(ccat->prods);+ else+ n_prods = ccat->n_synprods;+ for (size_t i = 0; i < n_prods; i++) {+ PgfProduction prod =+ gu_seq_get(ccat->prods, PgfProduction, i);+ pgf_parsing_production(ps, ps->before, conts, prod);+ }+ } else {+ // Top-down prediction for syntactic rules+ for (size_t i = 0; i < ccat->n_synprods; i++) {+ PgfProduction prod =+ gu_seq_get(ccat->prods, PgfProduction, i);+ pgf_parsing_production(ps, ps->before, conts, prod);+ }++ // Bottom-up prediction for lexical and epsilon rules+ size_t n_idcs = gu_buf_length(ps->before->lexicon_idx);+ for (size_t i = 0; i < n_idcs; i++) {+ PgfLexiconIdxEntry* lentry =+ gu_buf_index(ps->before->lexicon_idx, PgfLexiconIdxEntry, i);++ PgfProductionIdxEntry key;+ key.ccat = ccat;+ key.lin_idx = lin_idx;+ key.papp = NULL;+ PgfProductionIdxEntry* value =+ gu_seq_binsearch(gu_buf_data_seq(lentry->idx),+ pgf_production_idx_entry_order,+ PgfProductionIdxEntry, &key);++ if (value != NULL) {+ pgf_parsing_predict_lexeme(ps, conts, value, lentry->offset, lentry->sym_idx);++ PgfProductionIdxEntry* start =+ gu_buf_data(lentry->idx);+ PgfProductionIdxEntry* end =+ start + gu_buf_length(lentry->idx)-1;++ PgfProductionIdxEntry* left = value-1;+ while (left >= start &&+ value->ccat->fid == left->ccat->fid &&+ value->lin_idx == left->lin_idx) {+ pgf_parsing_predict_lexeme(ps, conts, left, lentry->offset, lentry->sym_idx);+ left--;+ }++ PgfProductionIdxEntry* right = value+1;+ while (right <= end &&+ value->ccat->fid == right->ccat->fid &&+ value->lin_idx == right->lin_idx) {+ pgf_parsing_predict_lexeme(ps, conts, right, lentry->offset, lentry->sym_idx);+ right++;+ }+ }+ }+ }+ } else {+ /* If it has already been completed, combine. */++ PgfCCat* completed =+ pgf_parsing_get_completed(ps->before, conts);+ if (completed) {+ pgf_parsing_combine(ps, ps->before, ps->after, item, completed, lin_idx);+ }++ PgfParseState* state = ps->after;+ while (state != NULL) {+ PgfCCat* completed =+ pgf_parsing_get_completed(state, conts);+ if (completed) {+ pgf_parsing_combine(ps, state, state->next, item, completed, lin_idx);+ }++ state = state->next;+ }+ }+}++static void+pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym);++static void+pgf_parsing_pre(PgfParsing* ps, PgfItem* item, PgfSymbols* syms)+{+ if (item->alt_idx < gu_seq_length(syms)) {+ PgfSymbol sym = gu_seq_get(syms, PgfSymbol, item->alt_idx);+ pgf_parsing_symbol(ps, item, sym);+ } else {+ item->alt = 0;+ pgf_item_advance(item, ps->pool);+ gu_buf_heap_push(ps->before->agenda, pgf_item_prob_order, &item);+ }+}++static void+pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym)+{+ switch (gu_variant_tag(sym)) {+ case PGF_SYMBOL_CAT: {+ PgfSymbolCat* scat = gu_variant_data(sym);+ PgfPArg* parg = gu_seq_index(item->args, PgfPArg, scat->d);+ + if (parg->ccat->prods == NULL) {+ // empty category+ pgf_item_free(ps, item);+ return;+ }++ pgf_parsing_td_predict(ps, item, parg->ccat, scat->r);+ break;+ }+ case PGF_SYMBOL_KS: {+ PgfSymbolKS* sks = gu_variant_data(sym);+ pgf_item_advance(item, ps->pool);+ pgf_parsing_add_transition(ps, sks->token, item);+ break;+ }+ case PGF_SYMBOL_KP: {+ PgfSymbolKP* skp = gu_variant_data(sym);++ PgfSymbol sym;+ if (item->alt == 0) {+ PgfItem* new_item;++ new_item = pgf_item_copy(item, ps);+ new_item->alt = 1;+ new_item->alt_idx = 0;+ pgf_parsing_pre(ps, new_item, skp->default_form);++ for (size_t i = 0; i < skp->n_forms; i++) {+ PgfSymbols* syms = skp->forms[i].form;+ PgfSymbols* syms2 = skp->default_form;+ bool skip = false; /*pgf_tokens_equal(toks, toks2);+ for (size_t j = 0; j < i; j++) {+ PgfTokens* toks2 = skp->forms[j].form;+ skip |= pgf_tokens_equal(toks, toks2);+ }*/+ if (!skip) {+ new_item = pgf_item_copy(item, ps);+ new_item->alt = i+2;+ new_item->alt_idx = 0;+ pgf_parsing_pre(ps, new_item, syms);+ }+ }+ } else {+ PgfSymbols* syms =+ (item->alt == 1) ? skp->default_form : + skp->forms[item->alt-2].form;+ pgf_parsing_pre(ps, item, syms);+ }+ break;+ }+ case PGF_SYMBOL_LIT: {+ PgfSymbolLit* slit = gu_variant_data(sym);+ PgfPArg* parg = gu_seq_index(item->args, PgfPArg, slit->d);++ if (parg->ccat->fid >= ps->concr->total_cats) {+ pgf_parsing_td_predict(ps, item, parg->ccat, slit->r);+ }+ else {+ PgfItemConts* conts = + pgf_parsing_get_conts(ps->before,+ parg->ccat, slit->r,+ ps->pool);+ gu_buf_push(conts->items, PgfItem*, item);++ if (gu_buf_length(conts->items) == 1) {+ /* This is the first time when we encounter this + * literal category so we must call the callback */++ bool match = false;+ if (!ps->before->needs_bind) {+ size_t start = ps->before->end_offset;+ size_t offset = start;+ PgfExprProb *ep = NULL;++ if (ps->oracle != NULL && ps->oracle->literal) {+ ep = ps->oracle->literal(ps->oracle,+ parg->ccat->cnccat->abscat->name,+ parg->ccat->cnccat->labels[slit->r],+ &offset,+ ps->out_pool);+ } else {+ PgfLiteralCallback* callback =+ gu_map_get(ps->callbacks,+ parg->ccat->cnccat,+ PgfLiteralCallback*);++ if (callback != NULL) {+ ep = callback->match(callback, ps->concr,+ slit->r,+ ps->sentence, &offset,+ ps->out_pool);+ }+ }++ if (ep != NULL) {+ PgfProduction prod;+ PgfProductionExtern* pext =+ gu_new_variant(PGF_PRODUCTION_EXTERN,+ PgfProductionExtern,+ &prod, ps->pool);+ pext->ep = ep;+ pext->lins = NULL;++ PgfItem* item =+ pgf_new_item(ps, conts, prod);+ item->curr_sym = pgf_collect_extern_tok(ps,start,offset);+ item->sym_idx = pgf_item_symbols_length(item);+ PgfParseState* state =+ pgf_new_parse_state(ps, offset, BIND_NONE,+ item->inside_prob+item->conts->outside_prob);+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);+ match = true;+ }+ }++ if (!match) {+ pgf_item_free(ps, item);+ }+ } else {+ /* If it has already been completed, combine. */++ PgfCCat* completed =+ pgf_parsing_get_completed(ps->before, conts);+ if (completed) {+ pgf_parsing_combine(ps, ps->before, ps->after, item, completed, slit->r);+ }+ + PgfParseState* state = ps->after;+ while (state != NULL) {+ PgfCCat* completed =+ pgf_parsing_get_completed(state, conts);+ if (completed) {+ pgf_parsing_combine(ps, state, state->next, item, completed, slit->r);+ }++ state = state->next;+ }+ }+ }+ break;+ }+ case PGF_SYMBOL_VAR:+ // XXX TODO proper support+ break;+ case PGF_SYMBOL_NE: {+ // Nothing can match with a non-existant token+ pgf_item_free(ps, item);+ break;+ }+ case PGF_SYMBOL_BIND: {+ if (ps->before->start_offset == ps->before->end_offset &&+ ps->before->needs_bind) {+ PgfParseState* state =+ pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD, + item->inside_prob+item->conts->outside_prob);+ if (state != NULL) {+ pgf_item_advance(item, ps->pool);+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);+ } else {+ pgf_item_free(ps, item);+ }+ } else {+ pgf_item_free(ps, item);+ }+ break;+ }+ case PGF_SYMBOL_SOFT_BIND:+ case PGF_SYMBOL_SOFT_SPACE: {+ if (ps->before->start_offset == ps->before->end_offset) {+ if (ps->before->needs_bind) {+ PgfParseState* state =+ pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD,+ item->inside_prob+item->conts->outside_prob);+ if (state != NULL) {+ pgf_item_advance(item, ps->pool);+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);+ } else {+ pgf_item_free(ps, item);+ }+ } else {+ pgf_item_free(ps, item);+ }+ } else {+ pgf_item_advance(item, ps->pool);+ gu_buf_heap_push(ps->before->agenda, pgf_item_prob_order, &item);+ }+ break;+ }+ case PGF_SYMBOL_CAPIT:+ case PGF_SYMBOL_ALL_CAPIT: {+ pgf_item_advance(item, ps->pool);+ pgf_parsing_symbol(ps, item, item->curr_sym);+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_parsing_item(PgfParsing* ps, PgfItem* item)+{+#ifdef PGF_PARSER_DEBUG+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ pgf_print_item(item, ps->before, out, err, tmp_pool);+ gu_pool_free(tmp_pool);+#endif++ GuVariantInfo i = gu_variant_open(item->prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ PgfCncFun* fun = papp->fun;+ PgfSymbols* syms = fun->lins[item->conts->lin_idx]->syms;+ if (item->sym_idx == gu_seq_length(syms)) {+ pgf_parsing_complete(ps, item, NULL);+ pgf_item_free(ps, item);+ } else {+ pgf_parsing_symbol(ps, item, item->curr_sym);+ }+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = i.data;+ switch (item->sym_idx) {+ case 0:+ if (pcoerce->coerce->prods == NULL) {+ // empty category+ pgf_item_free(ps, item);+ return;+ }++ pgf_parsing_td_predict(ps, item,+ pcoerce->coerce,+ item->conts->lin_idx);+ break;+ case 1:+ pgf_parsing_complete(ps, item, NULL);+ pgf_item_free(ps, item);+ break;+ default:+ gu_impossible();+ }+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = i.data;++ PgfSymbols* syms;+ if (pext->lins != NULL &&+ (syms = gu_seq_get(pext->lins,PgfSymbols*,item->conts->lin_idx)) != NULL) {+ if (item->sym_idx == gu_seq_length(syms)) {+ pgf_parsing_complete(ps, item, NULL);+ pgf_item_free(ps, item);+ } else {+ PgfSymbol sym =+ gu_seq_get(syms, PgfSymbol, item->sym_idx);+ pgf_parsing_symbol(ps, item, sym);+ }+ } else {+ pgf_parsing_complete(ps, item, pext->ep);+ pgf_item_free(ps, item);+ }+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_parsing_set_default_factors(PgfParsing* ps, PgfAbstr* abstr)+{+ PgfFlag* flag;+ + flag =+ gu_seq_binsearch(abstr->aflags, pgf_flag_order, PgfFlag, "heuristic_search_factor");+ if (flag != NULL) {+ GuVariantInfo pi = gu_variant_open(flag->value);+ gu_assert (pi.tag == PGF_LITERAL_FLT);+ ps->heuristic_factor = ((PgfLiteralFlt*) pi.data)->val;+ }+}++static PgfParsing*+pgf_new_parsing(PgfConcr* concr, GuString sentence,+ PgfCallbacksMap* callbacks, PgfOracleCallback* oracle,+ GuPool* pool, GuPool* out_pool)+{+ PgfParsing* ps = gu_new(PgfParsing, pool);+ ps->concr = concr;+ ps->pool = pool;+ ps->out_pool = out_pool;+ ps->sentence = sentence;+ ps->case_sensitive =+ (gu_seq_binsearch(concr->cflags, pgf_flag_order, PgfFlag, "case_sensitive") == NULL);+ ps->expr_queue = gu_new_buf(PgfExprState*, pool);+ ps->max_fid = concr->total_cats;+ ps->before = NULL;+ ps->after = NULL;+#ifdef PGF_COUNTS_DEBUG+ ps->item_full_count = 0;+ ps->item_real_count = 0;+ ps->cont_full_count = 0;+ ps->ccat_full_count = 0;+ ps->prod_full_count = 0;+#endif+ ps->prefix = NULL;+ ps->tp = NULL;+ ps->free_item = NULL;+ ps->heuristic_factor = 0;+ ps->callbacks = callbacks;+ ps->oracle = oracle;++ pgf_parsing_set_default_factors(ps, concr->abstr);++ return ps;+}++#ifdef PGF_COUNTS_DEBUG+static void +pgf_parsing_print_counts(PgfParsing* ps)+{+ printf("%d\t%d\t%d\t%d\t%d\n", + ps->item_full_count, + ps->item_real_count, + ps->cont_full_count,+ ps->ccat_full_count,+ ps->prod_full_count);+}+#endif++static int+cmp_expr_state(GuOrder* self, const void* a, const void* b)+{+ PgfExprState *s1 = *((PgfExprState **) a);+ PgfExprState *s2 = *((PgfExprState **) b);++ prob_t prob1 = s1->answers->outside_prob+s1->ep.prob;+ prob_t prob2 = s2->answers->outside_prob+s2->ep.prob;++ return (prob1>prob2) - (prob1<prob2);+}++static GuOrder+pgf_expr_state_order = { cmp_expr_state };++static void+pgf_result_production(PgfParsing* ps,+ PgfAnswers* answers, PgfProduction prod)+{+ GuVariantInfo pi = gu_variant_open(prod);+ switch (pi.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = pi.data;++ PgfExprState *st = gu_new(PgfExprState, ps->pool);+ st->answers = answers;+ st->ep = *papp->fun->ep;+ st->args = papp->args;+ st->arg_idx = 0;++ size_t n_args = gu_seq_length(st->args);+ for (size_t k = 0; k < n_args; k++) {+ PgfPArg* parg = gu_seq_index(st->args, PgfPArg, k);+ st->ep.prob += parg->ccat->viterbi_prob;+ }++ gu_buf_heap_push(ps->expr_queue, &pgf_expr_state_order, &st);+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = pi.data;++ PgfCCat* ccat = pcoerce->coerce;++ PgfExprState *st = gu_new(PgfExprState, ps->pool);+ st->answers = answers;+ st->ep.expr = gu_null_variant;+ st->ep.prob = ccat->viterbi_prob;+ st->args = gu_empty_seq();+ st->arg_idx = 0;++ pgf_result_predict(ps, st, ccat);+ break;+ }+ case PGF_PRODUCTION_EXTERN: {+ PgfProductionExtern* pext = pi.data;++ PgfExprState *st = gu_new(PgfExprState, ps->pool);+ st->answers = answers;+ st->ep = *pext->ep;+ st->args = gu_empty_seq();+ st->arg_idx = 0;++ gu_buf_heap_push(ps->expr_queue, &pgf_expr_state_order, &st);+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_result_predict(PgfParsing* ps, + PgfExprState* cont, PgfCCat* ccat)+{+ prob_t outside_prob = 0;+ if (cont != NULL) {+ cont->ep.prob -= ccat->viterbi_prob;+ outside_prob =+ cont->answers->outside_prob+cont->ep.prob;+ }++ PgfAnswers* answers = ccat->answers;+ if (answers == NULL) {+ answers = gu_new(PgfAnswers, ps->pool);+ answers->conts = gu_new_buf(PgfExprState*, ps->pool);+ answers->exprs = gu_new_buf(PgfExprProb*, ps->pool);+ answers->outside_prob = outside_prob;++ ccat->answers = answers;+ }++ gu_buf_push(answers->conts, PgfExprState*, cont);++ if (gu_buf_length(answers->conts) == 1) {+ if (ccat->prods == NULL)+ return;++ // Generation+ for (size_t i = 0; i < ccat->n_synprods; i++) {+ PgfProduction prod =+ gu_seq_get(ccat->prods, PgfProduction, i);+ pgf_result_production(ps, answers, prod);+ }+ } else {+ size_t n_exprs = gu_buf_length(answers->exprs);+ for (size_t i = 0; i < n_exprs; i++) {+ PgfExprProb* ep = gu_buf_get(answers->exprs, PgfExprProb*, i);++ PgfExprState* st = gu_new(PgfExprState, ps->pool);+ st->answers = cont->answers;+ st->ep.expr =+ gu_variant_is_null(cont->ep.expr) ?+ ep->expr :+ gu_new_variant_i(ps->out_pool, + PGF_EXPR_APP, PgfExprApp,+ .fun = cont->ep.expr,+ .arg = ep->expr);+ st->ep.prob = cont->ep.prob+ep->prob;+ st->args = cont->args;+ st->arg_idx = cont->arg_idx+1;++ gu_buf_heap_push(ps->expr_queue, &pgf_expr_state_order, &st);+ }+ }+}++static bool+pgf_parse_result_is_new(PgfExprState* st)+{+ // we have found a complete abstract tree but we must check+ // whether this is not a duplication. Since the trees are+ // generated in probability order it is enough to check only+ // trees with the same probability.++ size_t i = gu_buf_length(st->answers->exprs);+ while (i-- > 0) {+ PgfExprProb* ep = + gu_buf_get(st->answers->exprs, PgfExprProb*, i);++ if (ep->prob < st->ep.prob)+ break;++ if (pgf_expr_eq(ep->expr, st->ep.expr))+ return false;+ }++ return true;+}++static PgfParsing*+pgf_parsing_init(PgfConcr* concr, PgfCId cat, + GuString sentence,+ double heuristic_factor,+ PgfCallbacksMap* callbacks, PgfOracleCallback* oracle,+ GuExn* err, GuPool* pool, GuPool* out_pool)+{+ PgfCncCat* cnccat =+ gu_map_get(concr->cnccats, cat, PgfCncCat*);+ if (!cnccat) {+ GuExnData* exn = gu_raise(err, PgfExn);+ exn->data = "Unknown start category";+ return NULL;+ }++ PgfParsing* ps =+ pgf_new_parsing(concr, sentence, callbacks, oracle, pool, out_pool);++ if (heuristic_factor >= 0) {+ ps->heuristic_factor = heuristic_factor;+ }++ PgfParseState* state =+ pgf_new_parse_state(ps, 0, BIND_SOFT, 0);++ int fidString = -1;+ PgfCCat* start_ccat = gu_new(PgfCCat, ps->pool);+ start_ccat->cnccat = gu_map_get(concr->ccats, &fidString, PgfCCat*)->cnccat;+ start_ccat->lindefs = NULL;+ start_ccat->linrefs = NULL;+ start_ccat->viterbi_prob = 0;+ start_ccat->fid = -5;+ start_ccat->conts = NULL;+ start_ccat->answers = NULL;+ start_ccat->prods = NULL;+ start_ccat->n_synprods = 0;++#ifdef PGF_COUNTS_DEBUG+ state->ps->ccat_full_count++;+#endif++ PgfItemConts* conts =+ pgf_parsing_get_conts(state, start_ccat, 0, ps->pool);+ gu_buf_push(conts->items, PgfItem*, NULL);++#ifdef PGF_COUNTS_DEBUG+ ps->cont_full_count++;+#endif++ size_t n_ccats = gu_seq_length(cnccat->cats);+ for (size_t i = 0; i < n_ccats; i++) {+ PgfCCat* ccat = gu_seq_get(cnccat->cats, PgfCCat*, i);+ if (ccat != NULL) {+ PgfPArgs* args = gu_new_seq(PgfPArg, 1, ps->pool);+ gu_seq_set(args, PgfPArg, 0, ((PgfPArg) { .hypos = NULL, .ccat = ccat }));++ size_t n_funs = gu_seq_length(ccat->linrefs);+ for (size_t j = 0; j < n_funs; j++) {+ PgfProduction prod = gu_null_variant;+ PgfProductionApply* new_papp =+ gu_new_variant(PGF_PRODUCTION_APPLY,+ PgfProductionApply,+ &prod, pool);+ new_papp->fun = gu_seq_get(ccat->linrefs, PgfCncFun*, j);+ new_papp->args = args;++ PgfItem* item = gu_new(PgfItem, ps->pool);+ item->args = args;+ item->inside_prob += ccat->viterbi_prob;+ item->conts = conts;+ item->prod = prod;+ item->curr_sym = gu_null_variant;+ item->sym_idx = 0;+ item->alt_idx = 0;+ item->alt = 0;++ conts->ref_count++;++ pgf_item_set_curr_symbol(item, ps->pool);++#ifdef PGF_COUNTS_DEBUG+ ps->item_full_count++;+ ps->item_real_count++;+#endif++ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);+ }+ }+ }++ return ps;+}++static bool+pgf_parsing_proceed(PgfParsing* ps)+{+ bool has_progress = false;++ prob_t best_prob = INFINITY;+ if (gu_buf_length(ps->expr_queue) > 0) {+ best_prob = gu_buf_get(ps->expr_queue, PgfExprState*, 0)->ep.prob;+ }++ prob_t delta_prob = 0;+ PgfParseState* st = ps->before;+ while (st != NULL) {+ if (gu_buf_length(st->agenda) > 0) {+ PgfItem* item = gu_buf_get(st->agenda, PgfItem*, 0);+ prob_t item_prob =+ item->inside_prob+item->conts->outside_prob+delta_prob;+ if (item_prob < best_prob) {+ best_prob = item_prob;++ while (st != ps->before) {+ PgfParseState* tmp = ps->before->next;+ ps->before->next = ps->after;+ ps->after = ps->before;+ ps->before = tmp;+ }+ + has_progress = true;+ }+ }++ prob_t state_delta =+ (st->viterbi_prob-(st->next ? st->next->viterbi_prob : 0))*+ ps->heuristic_factor;+ delta_prob += state_delta;+ st = st->next;+ }++ if (has_progress) {+ PgfItem* item;+ gu_buf_heap_pop(ps->before->agenda, pgf_item_prob_order, &item);+ pgf_parsing_item(ps, item);+ }++ while (ps->after != NULL) {+ PgfParseState* tmp = ps->after->next;+ ps->after->next = ps->before;+ ps->before = ps->after;+ ps->after = tmp;+ }++ return has_progress;+}++static PgfExprProb*+pgf_parse_result_next(PgfParsing* ps)+{+ for (;;) {+ while (pgf_parsing_proceed(ps));++ if (gu_buf_length(ps->expr_queue) == 0)+ break;++ PgfExprState* st;+ gu_buf_heap_pop(ps->expr_queue, &pgf_expr_state_order, &st);++#ifdef PGF_PARSER_DEBUG+#ifdef PGF_RESULT_DEBUG+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ pgf_print_expr_state0(st, out, err, tmp_pool);+ gu_pool_free(tmp_pool);+#endif+#endif++ if (st->arg_idx < gu_seq_length(st->args)) {+ PgfCCat* ccat =+ gu_seq_index(st->args, PgfPArg, st->arg_idx)->ccat;++ if (ccat->fid < ps->concr->total_cats) {+ PgfExpr meta = gu_new_variant_i(ps->out_pool,+ PGF_EXPR_META, PgfExprMeta,+ .id = 0);++ st->ep.expr =+ gu_variant_is_null(st->ep.expr) ?+ meta :+ gu_new_variant_i(ps->out_pool, + PGF_EXPR_APP, PgfExprApp,+ .fun = st->ep.expr,+ .arg = meta);+ st->arg_idx++;+ gu_buf_heap_push(ps->expr_queue, &pgf_expr_state_order, &st);+ } else {+ pgf_result_predict(ps, st, ccat);+ }+ } else if (pgf_parse_result_is_new(st)) {+ gu_buf_push(st->answers->exprs, PgfExprProb*, &st->ep);++ size_t n_conts = gu_buf_length(st->answers->conts);+ for (size_t i = 0; i < n_conts; i++) {+ PgfExprState* st2 = gu_buf_get(st->answers->conts, PgfExprState*, i);+ + if (st2 == NULL) {+ return &st->ep;+ }++ PgfExprState* st3 = gu_new(PgfExprState, ps->pool);+ st3->answers = st2->answers;+ st3->ep.expr =+ gu_variant_is_null(st2->ep.expr) ?+ st->ep.expr :+ gu_new_variant_i(ps->out_pool,+ PGF_EXPR_APP, PgfExprApp,+ .fun = st2->ep.expr,+ .arg = st->ep.expr);+ st3->ep.prob = st2->ep.prob + st->ep.prob;+ st3->args = st2->args;+ st3->arg_idx = st2->arg_idx+1;++ gu_buf_heap_push(ps->expr_queue, &pgf_expr_state_order, &st3);+ }+ }+ }++ return NULL;+}++static void+pgf_parse_result_enum_next(GuEnum* self, void* to, GuPool* pool)+{+ PgfParsing* ps = gu_container(self, PgfParsing, en);+ *(PgfExprProb**)to = pgf_parse_result_next(ps);+}++static PgfParseError*+pgf_parsing_new_exception(PgfParsing* ps, GuPool* pool)+{+ const uint8_t* p = (uint8_t*) ps->sentence;+ const uint8_t* end = p + (ps->before ? ps->before->end_offset : 0);++ PgfParseError* err = gu_new(PgfParseError, pool);+ err->incomplete= (*end == 0);+ err->offset = 0;+ err->token_ptr = (char*) p;++ while (p < end) {+ if (gu_ucs_is_space(gu_utf8_decode(&p))) {+ err->token_ptr = (char*) p;+ }+ err->offset++;+ }++ if (err->incomplete) {+ err->token_ptr = NULL;+ err->token_len = 0;+ return err;+ }++ while (*p && !gu_ucs_is_space(gu_utf8_decode(&p))) {+ end = p;+ }++ err->token_len = ((char*)end)-err->token_ptr;++ return err;+}++PGF_API GuEnum*+pgf_parse(PgfConcr* concr, PgfType* typ, GuString sentence,+ GuExn* err, + GuPool* pool, GuPool* out_pool)+{+ PgfCallbacksMap* callbacks = pgf_new_callbacks_map(concr, out_pool); + return pgf_parse_with_heuristics(concr, typ, sentence, -1.0, callbacks, err, pool, out_pool);+}++PGF_API GuEnum*+pgf_parse_with_heuristics(PgfConcr* concr, PgfType* typ, GuString sentence,+ double heuristics,+ PgfCallbacksMap* callbacks,+ GuExn* err,+ GuPool* pool, GuPool* out_pool)+{+ if (concr->sequences == NULL ||+ concr->cnccats == NULL) {+ GuExnData* err_data = gu_raise(err, PgfExn);+ if (err_data) {+ err_data->data = "The concrete syntax is not loaded";+ return NULL;+ }+ }++ // Begin parsing a sentence with the specified category+ PgfParsing* ps =+ pgf_parsing_init(concr, typ->cid, sentence, heuristics, callbacks, NULL, err, pool, out_pool);+ if (ps == NULL) {+ return NULL;+ }++#ifdef PGF_COUNTS_DEBUG+ pgf_parsing_print_counts(ps);+#endif++ while (gu_buf_length(ps->expr_queue) == 0) {+ if (!pgf_parsing_proceed(ps)) {+ GuExnData* exn = gu_raise(err, PgfParseError);+ exn->data = (void*) pgf_parsing_new_exception(ps, exn->pool);+ return NULL;+ }++#ifdef PGF_COUNTS_DEBUG+ pgf_parsing_print_counts(ps);+#endif+ }++ // Now begin enumerating the resulting syntax trees+ ps->en.next = pgf_parse_result_enum_next;+ return &ps->en;+}++PGF_API PgfExprEnum*+pgf_parse_with_oracle(PgfConcr* concr, PgfType* typ,+ GuString sentence,+ PgfOracleCallback* oracle,+ GuExn* err,+ GuPool* pool, GuPool* out_pool)+{+ if (concr->sequences == NULL ||+ concr->cnccats == NULL) {+ GuExnData* err_data = gu_raise(err, PgfExn);+ if (err_data) {+ err_data->data = "The concrete syntax is not loaded";+ return NULL;+ }+ }++ // Begin parsing a sentence with the specified category+ PgfCallbacksMap* callbacks = pgf_new_callbacks_map(concr, out_pool); + PgfParsing* ps =+ pgf_parsing_init(concr, typ->cid, sentence, -1, callbacks, oracle, err, pool, out_pool);+ if (ps == NULL) {+ return NULL;+ }++#ifdef PGF_COUNTS_DEBUG+ pgf_parsing_print_counts(ps);+#endif++ while (gu_buf_length(ps->expr_queue) == 0) {+ if (!pgf_parsing_proceed(ps)) {+ GuExnData* exn = gu_raise(err, PgfParseError);+ exn->data = (void*) pgf_parsing_new_exception(ps, exn->pool);+ return NULL;+ }++#ifdef PGF_COUNTS_DEBUG+ pgf_parsing_print_counts(ps);+#endif+ }++ // Now begin enumerating the resulting syntax trees+ ps->en.next = pgf_parse_result_enum_next;+ return &ps->en;+}++static void+pgf_parser_completions_next(GuEnum* self, void* to, GuPool* pool)+{+ PgfParsing* ps =+ gu_container(self, PgfParsing, en);++ ps->tp = NULL;+ while (ps->tp == NULL) {+ if (!pgf_parsing_proceed(ps))+ break;+ +#ifdef PGF_COUNTS_DEBUG+ pgf_parsing_print_counts(ps);+#endif+ }++ *((PgfTokenProb**)to) = ps->tp;+}++PGF_API GuEnum*+pgf_complete(PgfConcr* concr, PgfType* type, GuString sentence, + GuString prefix, GuExn *err, GuPool* pool)+{+ if (concr->sequences == NULL ||+ concr->cnccats == NULL) {+ GuExnData* err_data = gu_raise(err, PgfExn);+ if (err_data) {+ err_data->data = "The concrete syntax is not loaded";+ return NULL;+ }+ }++ // Begin parsing a sentence with the specified category+ PgfCallbacksMap* callbacks =+ pgf_new_callbacks_map(concr, pool);+ PgfParsing* ps =+ pgf_parsing_init(concr, type->cid, sentence, -1.0, callbacks, NULL, err, pool, pool);+ if (ps == NULL) {+ return NULL;+ }++#ifdef PGF_COUNTS_DEBUG+ pgf_parsing_print_counts(ps);+#endif++ size_t len = strlen(ps->sentence);+ while (ps->before->end_offset < len) {+ if (!pgf_parsing_proceed(ps)) {+ GuExnData* exn = gu_raise(err, PgfParseError);+ exn->data = (void*) pgf_parsing_new_exception(ps, exn->pool);+ return NULL;+ }++#ifdef PGF_COUNTS_DEBUG+ pgf_parsing_print_counts(ps);+#endif+ }++ // Now begin enumerating the completions+ ps->en.next = pgf_parser_completions_next;+ ps->prefix = prefix;+ ps->tp = NULL;+ return &ps->en;+}++static void+pgf_morpho_iter(PgfProductionIdx* idx,+ PgfMorphoCallback* callback,+ GuExn* err)+{+ size_t n_entries = gu_buf_length(idx);+ for (size_t i = 0; i < n_entries; i++) {+ PgfProductionIdxEntry* entry =+ gu_buf_index(idx, PgfProductionIdxEntry, i);++ PgfCId lemma = entry->papp->fun->absfun->name;+ GuString analysis = entry->ccat->cnccat->labels[entry->lin_idx];+ + prob_t prob = entry->ccat->cnccat->abscat->prob ++ entry->papp->fun->absfun->ep.prob;+ callback->callback(callback,+ lemma, analysis, prob, err);+ if (!gu_ok(err))+ return;+ }+}++typedef struct {+ GuOrder order;+ bool case_sensitive;+} PgfSequenceOrder;++static int+pgf_sequence_cmp_fn(GuOrder* order, const void* p1, const void* p2)+{+ PgfSequenceOrder* self = gu_container(order, PgfSequenceOrder, order);+ GuString sent = (GuString) p1;+ const PgfSequence* sp2 = p2;++ size_t sym_idx = 0;+ int res = pgf_symbols_cmp(&sent, sp2->syms, &sym_idx, self->case_sensitive);+ if (res == 0 && (*sent != 0 || sym_idx != gu_seq_length(sp2->syms))) {+ res = 1;+ }++ return res;+}++PGF_API void+pgf_lookup_morpho(PgfConcr *concr, GuString sentence,+ PgfMorphoCallback* callback, GuExn* err)+{+ if (concr->sequences == NULL) {+ GuExnData* err_data = gu_raise(err, PgfExn);+ if (err_data) {+ err_data->data = "The concrete syntax is not loaded";+ return;+ }+ }++ bool case_sensitive =+ (gu_seq_binsearch(concr->cflags, pgf_flag_order, PgfFlag, "case_sensitive") == NULL);++ PgfSequenceOrder order = { { pgf_sequence_cmp_fn }, case_sensitive };+ PgfSequence* seq = (PgfSequence*)+ gu_seq_binsearch(concr->sequences, &order.order,+ PgfSequence, (void*) sentence);++ if (seq != NULL && seq->idx != NULL)+ pgf_morpho_iter(seq->idx, callback, err);+}++typedef struct {+ GuEnum en;+ PgfSequences* sequences;+ GuString prefix;+ size_t seq_idx;+} PgfFullFormState;++struct PgfFullFormEntry {+ GuString tokens;+ PgfProductionIdx* idx;+};++static void+gu_fullform_enum_next(GuEnum* self, void* to, GuPool* pool)+{+ PgfFullFormState* st = gu_container(self, PgfFullFormState, en);+ PgfFullFormEntry* entry = NULL;++ if (st->sequences != NULL) {+ size_t n_seqs = gu_seq_length(st->sequences);+ while (st->seq_idx < n_seqs) {+ PgfSequence* seq = gu_seq_index(st->sequences, PgfSequence, st->seq_idx);+ GuString tokens = pgf_get_tokens(seq->syms, 0, pool);++ if (!gu_string_is_prefix(st->prefix, tokens)) {+ st->seq_idx = n_seqs;+ break;+ }++ if (*tokens != 0 && seq->idx != NULL) {+ entry = gu_new(PgfFullFormEntry, pool);+ entry->tokens = tokens;+ entry->idx = seq->idx;++ st->seq_idx++;+ break;+ }++ st->seq_idx++;+ }+ }++ *((PgfFullFormEntry**) to) = entry;+}++PGF_API GuEnum*+pgf_fullform_lexicon(PgfConcr *concr, GuPool* pool)+{+ PgfFullFormState* st = gu_new(PgfFullFormState, pool);+ st->en.next = gu_fullform_enum_next;+ st->sequences = concr->sequences;+ st->prefix = "";+ st->seq_idx = 0;+ return &st->en;+}++PGF_API GuString+pgf_fullform_get_string(PgfFullFormEntry* entry)+{+ return entry->tokens;+}++PGF_API void+pgf_fullform_get_analyses(PgfFullFormEntry* entry,+ PgfMorphoCallback* callback, GuExn* err)+{+ pgf_morpho_iter(entry->idx, callback, err);+}++PGF_API GuEnum*+pgf_lookup_word_prefix(PgfConcr *concr, GuString prefix,+ GuPool* pool, GuExn* err)+{+ if (concr->sequences == NULL) {+ GuExnData* err_data = gu_raise(err, PgfExn);+ if (err_data) {+ err_data->data = "The concrete syntax is not loaded";+ return NULL;+ }+ }++ PgfFullFormState* state = gu_new(PgfFullFormState, pool);+ state->en.next = gu_fullform_enum_next;+ state->sequences = concr->sequences;+ state->prefix = prefix;+ state->seq_idx = 0;++ bool case_sensitive =+ (gu_seq_binsearch(concr->cflags, pgf_flag_order, PgfFlag, "case_sensitive") == NULL);++ PgfSequenceOrder order = { { pgf_sequence_cmp_fn }, case_sensitive };+ if (!gu_seq_binsearch_index(concr->sequences, &order.order,+ PgfSequence, (void*) prefix, + &state->seq_idx)) {+ state->seq_idx++;+ }++ return &state->en;+}++PGF_API void+pgf_parser_index(PgfConcr* concr, + PgfCCat* ccat, PgfProduction prod,+ bool is_lexical,+ GuPool *pool)+{+ GuVariantInfo i = gu_variant_open(prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;++ if (!is_lexical)+ break;++ for (size_t lin_idx = 0; lin_idx < papp->fun->n_lins; lin_idx++) {+ PgfSequence* seq = papp->fun->lins[lin_idx];++ size_t i = gu_buf_length(seq->idx);+ while (i > 0) {+ PgfProductionIdxEntry* entry =+ gu_buf_index(seq->idx, PgfProductionIdxEntry, i-1);++ if (entry->ccat->fid < ccat->fid)+ break;+ if (entry->lin_idx <= lin_idx)+ break;++ i--;+ }++ PgfProductionIdxEntry* entry = gu_buf_insert(seq->idx, i);+ entry->ccat = ccat;+ entry->lin_idx = lin_idx;+ entry->papp = papp;+ }+ break;+ }+ case PGF_PRODUCTION_COERCE:+ // Nothing to be done here+ break;+ default:+ gu_impossible();+ }+}++PGF_INTERNAL prob_t+pgf_ccat_set_viterbi_prob(PgfCCat* ccat) {+ if (ccat->fid < 0)+ return 0;+ + if (ccat->viterbi_prob == 0) { // uninitialized+ ccat->viterbi_prob = INFINITY; // set to infinity to avoid loops++ if (ccat->prods == NULL)+ return INFINITY;++ prob_t viterbi_prob = INFINITY;+ + size_t n_prods = gu_seq_length(ccat->prods);+ for (size_t i = 0; i < n_prods; i++) {+ PgfProduction prod =+ gu_seq_get(ccat->prods, PgfProduction, i); + + prob_t prob = 0;++ GuVariantInfo inf = gu_variant_open(prod);+ switch (inf.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = inf.data;+ prob = papp->fun->ep->prob;+ + size_t n_args = gu_seq_length(papp->args);+ for (size_t j = 0; j < n_args; j++) {+ PgfPArg* arg = gu_seq_index(papp->args, PgfPArg, j);+ prob += pgf_ccat_set_viterbi_prob(arg->ccat);+ }+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = inf.data;+ prob = pgf_ccat_set_viterbi_prob(pcoerce->coerce);+ break;+ }+ default:+ gu_impossible();+ return 0;+ }+ + if (viterbi_prob > prob)+ viterbi_prob = prob;+ }+ + ccat->viterbi_prob = viterbi_prob;+ }++ return ccat->viterbi_prob;+}
@@ -0,0 +1,220 @@+#include <pgf/pgf.h>+#include <pgf/data.h>+#include <pgf/linearizer.h>+#include <gu/enum.h>++typedef struct {+ int start, end;+ PgfCId cat;+ size_t lin_idx;+} PgfPhrase;++typedef struct {+ PgfLinFuncs* funcs;+ bool bind;+ GuOut* out;+ GuExn* err;+ int pos;+ GuBuf* marks;+ GuBuf* phrases;+ int found, matches;+ GuPool* pool;+} PgfMetricsLznState;++static void+pgf_metrics_put_space(PgfMetricsLznState* state)+{+ if (state->bind)+ state->bind = false;+ else {+ if (state->out != NULL)+ gu_putc(' ', state->out, state->err);+ state->pos++;+ }+}++static void+pgf_metrics_lzn_symbol_token(PgfLinFuncs** funcs, PgfToken tok)+{+ PgfMetricsLznState* state = gu_container(funcs, PgfMetricsLznState, funcs);++ pgf_metrics_put_space(state);+ if (state->out != NULL)+ gu_string_write(tok, state->out, state->err);++ state->pos += strlen(tok);+}++static void+pgf_metrics_lzn_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lin_index, PgfCId fun)+{+ PgfMetricsLznState* state = gu_container(funcs, PgfMetricsLznState, funcs);+ gu_buf_push(state->marks, int, state->pos);+}++static void+pgf_metrics_lzn_end_phrase1(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lin_idx, PgfCId fun)+{+ PgfMetricsLznState* state = gu_container(funcs, PgfMetricsLznState, funcs);++ int start = gu_buf_pop(state->marks, int);+ int end = state->pos;++ if (start != end) {+ PgfPhrase* phrase = gu_new(PgfPhrase, state->pool);+ phrase->start = start;+ phrase->end = end;+ phrase->cat = cat;+ phrase->lin_idx = lin_idx;+ gu_buf_push(state->phrases, PgfPhrase*, phrase);+ }+}++static void+pgf_metrics_symbol_ne(PgfLinFuncs** funcs)+{+ PgfMetricsLznState* state = gu_container(funcs, PgfMetricsLznState, funcs);+ gu_raise(state->err, PgfLinNonExist);+}++static void+pgf_metrics_symbol_bind(PgfLinFuncs** funcs)+{+ PgfMetricsLznState* state = gu_container(funcs, PgfMetricsLznState, funcs);+ state->bind = true;+}++static void+pgf_metrics_lzn_end_phrase2(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lin_idx, PgfCId fun)+{+ PgfMetricsLznState* state = gu_container(funcs, PgfMetricsLznState, funcs);++ int start = gu_buf_pop(state->marks, int);+ int end = state->pos;+ + if (start != end) { + size_t n_phrases = gu_buf_length(state->phrases);+ for (size_t i = 0; i < n_phrases; i++) {+ PgfPhrase* phrase = gu_buf_get(state->phrases, PgfPhrase*, i);+ + if (phrase->start == start &&+ phrase->end == end &&+ strcmp(phrase->cat, cat) == 0 &&+ phrase->lin_idx == lin_idx) {+ state->matches++;+ break;+ }+ }+ + state->found++;+ }+}++static void+pgf_metrics_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId meta_id)+{+ PgfMetricsLznState* state = gu_container(funcs, PgfMetricsLznState, funcs);++ pgf_metrics_put_space(state);+ if (state->out != NULL)+ gu_putc('?', state->out, state->err);++ state->pos += 1;+}++static PgfLinFuncs pgf_metrics_lin_funcs1 = {+ .symbol_token = pgf_metrics_lzn_symbol_token,+ .begin_phrase = pgf_metrics_lzn_begin_phrase,+ .end_phrase = pgf_metrics_lzn_end_phrase1,+ .symbol_ne = pgf_metrics_symbol_ne,+ .symbol_bind = pgf_metrics_symbol_bind,+ .symbol_capit = NULL,+ .symbol_meta = pgf_metrics_lzn_symbol_meta+};++static PgfLinFuncs pgf_metrics_lin_funcs2 = {+ .symbol_token = pgf_metrics_lzn_symbol_token,+ .begin_phrase = pgf_metrics_lzn_begin_phrase,+ .end_phrase = pgf_metrics_lzn_end_phrase2,+ .symbol_ne = pgf_metrics_symbol_ne,+ .symbol_bind = pgf_metrics_symbol_bind,+ .symbol_capit = NULL,+ .symbol_meta = pgf_metrics_lzn_symbol_meta+};++PGF_API bool+pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfType* type, + double *precision, double *recall, double *exact)+{+ GuPool* pool = gu_new_pool();++ GuExn* err = gu_new_exn(pool);++ GuEnum* en_lins1 =+ pgf_lzr_concretize(concr, expr, err, pool);+ if (!gu_ok(err)) {+ gu_pool_free(pool);+ return false;+ }++ PgfCncTree ctree1 = gu_next(en_lins1, PgfCncTree, pool);+ if (gu_variant_is_null(ctree1)) {+ gu_pool_free(pool);+ return false;+ }++ GuStringBuf* sbuf =+ gu_new_string_buf(pool);++ PgfMetricsLznState state;+ state.bind = true;+ state.out = gu_string_buf_out(sbuf);+ state.err = gu_new_exn(pool);+ state.funcs = &pgf_metrics_lin_funcs1;+ state.pos = 0;+ state.marks = gu_new_buf(int, pool);+ state.phrases = gu_new_buf(PgfPhrase*, pool);+ state.matches = 0;+ state.found = 0;+ state.pool = pool;++ pgf_lzr_linearize(concr, ctree1, 0, &state.funcs, pool);+ if (!gu_ok(state.err)) {+ gu_pool_free(pool);+ return false;+ }++ GuString sentence =+ gu_string_buf_freeze(sbuf, pool);++ GuEnum* en_trees =+ pgf_parse(concr, type, sentence,+ state.err, pool, pool);+ PgfExprProb* ep = gu_next(en_trees, PgfExprProb*, pool);+ if (ep == NULL) {+ gu_pool_free(pool);+ return false;+ }++ GuEnum* en_lins2 =+ pgf_lzr_concretize(concr, ep->expr, err, pool);+ PgfCncTree ctree2 = gu_next(en_lins2, PgfCncTree, pool);+ if (gu_variant_is_null(ctree2)) {+ gu_pool_free(pool);+ return false;+ }++ state.funcs = &pgf_metrics_lin_funcs2;+ state.bind = true;+ state.out = NULL;+ state.pos = 0;+ pgf_lzr_linearize(concr, ctree2, 0, &state.funcs, pool);++ *precision = ((double) state.matches)/((double) state.found);+ *recall = ((double) state.matches)/((double) gu_buf_length(state.phrases));+ *exact = pgf_expr_eq(expr, ep->expr) ? 1 : 0;++ gu_pool_free(pool);++ return true;+}
@@ -0,0 +1,267 @@+#include <pgf/pgf.h>+#include <pgf/data.h>+#include <pgf/expr.h>+#include <pgf/reader.h>+#include <pgf/writer.h>+#include <pgf/linearizer.h>+#include <gu/file.h>+#include <gu/string.h>+#include <gu/enum.h>+#include <stdio.h>+#include <math.h>++PGF_API PgfPGF*+pgf_read(const char* fpath,+ GuPool* pool, GuExn* err)+{+ FILE* infile = fopen(fpath, "rb");+ if (infile == NULL) {+ gu_raise_errno(err);+ return NULL;+ }++ GuPool* tmp_pool = gu_new_pool();++ // Create an input stream from the input file+ GuIn* in = gu_file_in(infile, tmp_pool);++ PgfReader* rdr = pgf_new_reader(in, pool, tmp_pool, err);+ PgfPGF* pgf = pgf_read_pgf(rdr);+ pgf_reader_done(rdr, pgf);++ gu_pool_free(tmp_pool);+ + fclose(infile);+ return pgf;+}++PGF_API PgfPGF*+pgf_read_in(GuIn* in,+ GuPool* pool, GuPool* tmp_pool, GuExn* err)+{+ PgfReader* rdr = pgf_new_reader(in, pool, tmp_pool, err);+ PgfPGF* pgf = pgf_read_pgf(rdr);+ pgf_reader_done(rdr, pgf);+ return pgf;+}++PGF_API_DECL void+pgf_write(PgfPGF* pgf, const char* fpath, GuExn* err)+{+ FILE* outfile = fopen(fpath, "wb");+ if (outfile == NULL) {+ gu_raise_errno(err);+ return;+ }++ GuPool* tmp_pool = gu_local_pool();++ // Create an input stream from the input file+ GuOut* out = gu_file_out(outfile, tmp_pool);++ PgfWriter* wtr = pgf_new_writer(out, tmp_pool, err);+ pgf_write_pgf(pgf, wtr);++ gu_pool_free(tmp_pool);+ + fclose(outfile);+}++PGF_API GuString+pgf_abstract_name(PgfPGF* pgf)+{+ return pgf->abstract.name;+}++PGF_API void+pgf_iter_languages(PgfPGF* pgf, GuMapItor* itor, GuExn* err)+{+ size_t n_concrs = gu_seq_length(pgf->concretes);+ for (size_t i = 0; i < n_concrs; i++) {+ PgfConcr* concr = gu_seq_index(pgf->concretes, PgfConcr, i);+ itor->fn(itor, concr->name, &concr, err);+ if (!gu_ok(err))+ break;+ }+}++PGF_API PgfConcr*+pgf_get_language(PgfPGF* pgf, PgfCId lang)+{+ return gu_seq_binsearch(pgf->concretes, pgf_concr_order, PgfConcr, lang);+}++PGF_API GuString+pgf_concrete_name(PgfConcr* concr)+{+ return concr->name;+}++PGF_API void+pgf_iter_categories(PgfPGF* pgf, GuMapItor* itor, GuExn* err)+{+ size_t n_cats = gu_seq_length(pgf->abstract.cats);+ for (size_t i = 0; i < n_cats; i++) {+ PgfAbsCat* cat = gu_seq_index(pgf->abstract.cats, PgfAbsCat, i);+ itor->fn(itor, cat->name, &cat, err);+ if (!gu_ok(err))+ break;+ }+}++PGF_API PgfType*+pgf_start_cat(PgfPGF* pgf, GuPool* pool)+{+ PgfFlag* flag =+ gu_seq_binsearch(pgf->abstract.aflags, pgf_flag_order, PgfFlag, "startcat");++ if (flag != NULL) {+ GuVariantInfo i = gu_variant_open(flag->value);+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr *lstr = (PgfLiteralStr *) i.data;+ + GuPool* tmp_pool = gu_local_pool();+ GuIn* in = gu_string_in(lstr->val,tmp_pool);+ GuExn* err = gu_new_exn(tmp_pool);+ PgfType *type = pgf_read_type(in, pool, tmp_pool, err);+ if (!gu_ok(err))+ break;+ gu_pool_free(tmp_pool);+ return type;+ }+ }+ }++ PgfType* type = gu_new_flex(pool, PgfType, exprs, 0);+ type->hypos = gu_empty_seq();+ type->cid = "S";+ type->n_exprs = 0;+ return type;+}++PGF_API PgfHypos*+pgf_category_context(PgfPGF *gr, PgfCId catname)+{+ PgfAbsCat* abscat =+ gu_seq_binsearch(gr->abstract.cats, pgf_abscat_order, PgfAbsCat, catname);+ if (abscat == NULL) {+ return NULL;+ }++ return abscat->context;+}++PGF_API prob_t+pgf_category_prob(PgfPGF* pgf, PgfCId catname)+{+ PgfAbsCat* abscat =+ gu_seq_binsearch(pgf->abstract.cats, pgf_abscat_order, PgfAbsCat, catname);+ if (abscat == NULL)+ return INFINITY;++ return abscat->prob;+}++PGF_API GuString+pgf_language_code(PgfConcr* concr)+{+ PgfFlag* flag =+ gu_seq_binsearch(concr->cflags, pgf_flag_order, PgfFlag, "language");++ if (flag == NULL)+ return "";++ GuVariantInfo i = gu_variant_open(flag->value);+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr *lstr = (PgfLiteralStr *) i.data;+ return lstr->val;+ }+ }++ return "";+}++PGF_API void+pgf_iter_functions(PgfPGF* pgf, GuMapItor* itor, GuExn* err)+{+ size_t n_funs = gu_seq_length(pgf->abstract.funs);+ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun* fun = gu_seq_index(pgf->abstract.funs, PgfAbsFun, i);+ itor->fn(itor, fun->name, &fun, err);+ if (!gu_ok(err))+ break;+ }+}++PGF_API void+pgf_iter_functions_by_cat(PgfPGF* pgf, PgfCId catname,+ GuMapItor* itor, GuExn* err) +{+ size_t n_funs = gu_seq_length(pgf->abstract.funs);+ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun* fun = gu_seq_index(pgf->abstract.funs, PgfAbsFun, i);+ + if (strcmp(fun->type->cid, catname) == 0) {+ itor->fn(itor, fun->name, &fun, err);+ if (!gu_ok(err))+ break;+ }+ }+}++PGF_API PgfType*+pgf_function_type(PgfPGF* pgf, PgfCId funname) +{+ PgfAbsFun* absfun =+ gu_seq_binsearch(pgf->abstract.funs, pgf_absfun_order, PgfAbsFun, funname);+ if (absfun == NULL)+ return NULL;++ return absfun->type;+}++PGF_API_DECL bool+pgf_function_is_constructor(PgfPGF* pgf, PgfCId funname)+{+ PgfAbsFun* absfun =+ gu_seq_binsearch(pgf->abstract.funs, pgf_absfun_order, PgfAbsFun, funname);+ if (absfun == NULL)+ return false;+ return (absfun->defns == NULL);+}++PGF_API prob_t+pgf_function_prob(PgfPGF* pgf, PgfCId funname) +{+ PgfAbsFun* absfun =+ gu_seq_binsearch(pgf->abstract.funs, pgf_absfun_order, PgfAbsFun, funname);+ if (absfun == NULL)+ return INFINITY;++ return absfun->ep.prob;+}++PGF_API GuString+pgf_print_name(PgfConcr* concr, PgfCId id)+{+ PgfCId name =+ gu_map_get(concr->printnames, id, GuString);+ return name;+}++PGF_API int+pgf_has_linearization(PgfConcr* concr, PgfCId id)+{+ PgfCncOverloadMap* overl_table =+ gu_map_get(concr->fun_indices, id, PgfCncOverloadMap*);+ return (overl_table != NULL);+}++PGF_API PgfExprProb*+pgf_fun_get_ep(void* value)+{+ PgfAbsFun* absfun = *((PgfAbsFun**) value);+ return &absfun->ep;+}
@@ -0,0 +1,270 @@+#ifndef PGF_H_+#define PGF_H_++#include <gu/exn.h>+#include <gu/mem.h>+#include <gu/map.h>+#include <gu/enum.h>+#include <gu/string.h>++#if defined(_MSC_VER)++#if defined(COMPILING_PGF)+#define PGF_API_DECL __declspec(dllexport)+#define PGF_API __declspec(dllexport)+#else+#define PGF_API_DECL __declspec(dllimport)+#define PGF_API ERROR_NOT_COMPILING_LIBPGF+#endif+#define PGF_INTERNAL_DECL+#define PGF_INTERNAL++#elif defined(__MINGW32__)++#define PGF_API_DECL+#define PGF_API++#define PGF_INTERNAL_DECL+#define PGF_INTERNAL++#else++#define PGF_API_DECL+#define PGF_API++#define PGF_INTERNAL_DECL __attribute__ ((visibility ("hidden")))+#define PGF_INTERNAL __attribute__ ((visibility ("hidden")))++#endif+++typedef GuString PgfCId;++typedef GuString PgfToken;++typedef struct PgfPGF PgfPGF;++typedef struct PgfConcr PgfConcr;++#include <pgf/expr.h>+#include <pgf/graphviz.h>++typedef GuEnum PgfExprEnum;++PGF_API_DECL PgfPGF*+pgf_read(const char* fpath,+ GuPool* pool, GuExn* err);++PGF_API_DECL PgfPGF*+pgf_read_in(GuIn* in,+ GuPool* pool, GuPool* tmp_pool, GuExn* err);++PGF_API_DECL void+pgf_concrete_load(PgfConcr* concr, GuIn* in, GuExn* err);++PGF_API_DECL void+pgf_concrete_unload(PgfConcr* concr);++PGF_API_DECL void+pgf_write(PgfPGF* pgf, const char* fpath, GuExn* err);++PGF_API_DECL GuString+pgf_abstract_name(PgfPGF*);++PGF_API_DECL void+pgf_iter_languages(PgfPGF*, GuMapItor* itor, GuExn* err);++PGF_API_DECL PgfConcr*+pgf_get_language(PgfPGF*, PgfCId lang);++PGF_API_DECL GuString+pgf_concrete_name(PgfConcr*);++PGF_API_DECL GuString+pgf_language_code(PgfConcr* concr);++PGF_API_DECL void+pgf_iter_categories(PgfPGF* pgf, GuMapItor* itor, GuExn* err);++PGF_API_DECL PgfType*+pgf_start_cat(PgfPGF* pgf, GuPool* pool);++PGF_API_DECL PgfHypos*+pgf_category_context(PgfPGF *gr, PgfCId catname);++PGF_API_DECL prob_t+pgf_category_prob(PgfPGF* pgf, PgfCId catname);++PGF_API_DECL void+pgf_iter_functions(PgfPGF* pgf, GuMapItor* itor, GuExn* err);++PGF_API_DECL void+pgf_iter_functions_by_cat(PgfPGF* pgf, PgfCId catname,+ GuMapItor* itor, GuExn* err);++PGF_API_DECL PgfType*+pgf_function_type(PgfPGF* pgf, PgfCId funname);++PGF_API_DECL bool+pgf_function_is_constructor(PgfPGF* pgf, PgfCId funname);++PGF_API_DECL prob_t+pgf_function_prob(PgfPGF* pgf, PgfCId funname);++PGF_API_DECL GuString+pgf_print_name(PgfConcr*, PgfCId id);++PGF_API_DECL int+pgf_has_linearization(PgfConcr* concr, PgfCId id);++PGF_API_DECL void+pgf_linearize(PgfConcr* concr, PgfExpr expr, GuOut* out, GuExn* err);++typedef struct {+ GuString phrase;+ size_t n_fids;+ int fids[];+} PgfAlignmentPhrase;++PGF_API_DECL GuSeq*+pgf_align_words(PgfConcr* concr, PgfExpr expr,+ GuExn* err, GuPool* pool);++PGF_API_DECL bool+pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfType* type, + double *precision, double *recall, double *exact);++PGF_API_DECL PgfExpr+pgf_compute(PgfPGF* pgf, PgfExpr expr, GuExn* err,+ GuPool* pool, GuPool* out_pool);++PGF_API_DECL PgfExprEnum*+pgf_generate_all(PgfPGF* pgf, PgfType* ty,+ GuExn* err, GuPool* pool, GuPool* out_pool);++typedef struct {+ int incomplete; // equal to !=0 if the sentence is incomplete, 0 otherwise+ size_t offset;+ const char* token_ptr;+ size_t token_len;+} PgfParseError;++PGF_API_DECL PgfExprEnum*+pgf_parse(PgfConcr* concr, PgfType* typ, GuString sentence,+ GuExn* err, GuPool* pool, GuPool* out_pool);++PGF_API_DECL GuEnum*+pgf_lookup_sentence(PgfConcr* concr, PgfType* typ, GuString sentence, GuPool* pool, GuPool* out_pool);++typedef struct PgfMorphoCallback PgfMorphoCallback;+struct PgfMorphoCallback {+ void (*callback)(PgfMorphoCallback* self,+ PgfCId lemma, GuString analysis, prob_t prob,+ GuExn* err);+};++PGF_API_DECL void+pgf_lookup_morpho(PgfConcr *concr, GuString sentence,+ PgfMorphoCallback* callback, GuExn* err);++typedef struct PgfFullFormEntry PgfFullFormEntry;++PGF_API_DECL GuEnum*+pgf_fullform_lexicon(PgfConcr *concr, GuPool* pool);++PGF_API_DECL GuString+pgf_fullform_get_string(PgfFullFormEntry* entry);++PGF_API_DECL void+pgf_fullform_get_analyses(PgfFullFormEntry* entry,+ PgfMorphoCallback* callback, GuExn* err);++PGF_API_DECL GuEnum*+pgf_lookup_word_prefix(PgfConcr *concr, GuString prefix,+ GuPool* pool, GuExn* err);++typedef GuMap PgfCallbacksMap;++PGF_API_DECL PgfExprEnum*+pgf_parse_with_heuristics(PgfConcr* concr, PgfType* typ, + GuString sentence, double heuristics,+ PgfCallbacksMap* callbacks,+ GuExn* err,+ GuPool* pool, GuPool* out_pool);++typedef struct PgfOracleCallback PgfOracleCallback;++struct PgfOracleCallback {+ bool (*predict) (PgfOracleCallback* self,+ PgfCId cat,+ GuString label,+ size_t offset);+ bool (*complete)(PgfOracleCallback* self,+ PgfCId cat,+ GuString label,+ size_t offset);+ PgfExprProb* (*literal)(PgfOracleCallback* self,+ PgfCId cat,+ GuString label,+ size_t* poffset,+ GuPool *out_pool);+};++PGF_API_DECL PgfExprEnum*+pgf_parse_with_oracle(PgfConcr* concr, PgfType* typ,+ GuString sentence,+ PgfOracleCallback* oracle,+ GuExn* err,+ GuPool* pool, GuPool* out_pool);++typedef struct {+ PgfToken tok;+ PgfCId cat;+ PgfCId fun;+ prob_t prob;+} PgfTokenProb;++PGF_API_DECL GuEnum*+pgf_complete(PgfConcr* concr, PgfType* type, GuString string, + GuString prefix, GuExn* err, GuPool* pool);++typedef struct PgfLiteralCallback PgfLiteralCallback;++struct PgfLiteralCallback {+ PgfExprProb* (*match)(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool);+ GuEnum* (*predict)(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString prefix,+ GuPool *out_pool);+};++PGF_API_DECL PgfCallbacksMap*+pgf_new_callbacks_map(PgfConcr* concr, GuPool *pool);++PGF_API_DECL void+pgf_callbacks_map_add_literal(PgfConcr* concr, PgfCallbacksMap* callbacks,+ PgfCId cat, PgfLiteralCallback* callback);++PGF_API_DECL void+pgf_print(PgfPGF* pgf, GuOut* out, GuExn* err); ++PGF_API_DECL void+pgf_check_expr(PgfPGF* gr, PgfExpr* pe, PgfType* ty,+ GuExn* exn, GuPool* pool);++PGF_API_DECL PgfType*+pgf_infer_expr(PgfPGF* gr, PgfExpr* pe, + GuExn* exn, GuPool* pool);++PGF_API_DECL void+pgf_check_type(PgfPGF* gr, PgfType** ty,+ GuExn* exn, GuPool* pool);++// internal+PGF_API_DECL PgfExprProb*+pgf_fun_get_ep(void* value);++#endif // PGF_H_
@@ -0,0 +1,408 @@+#include <pgf/data.h>+#include <stdlib.h>++typedef struct {+ GuMapItor fn;+ GuOut* out;+} PgfPrintFn;++static void+pgf_print_flags(PgfFlags* flags, GuOut *out, GuExn* err)+{+ size_t n_flags = gu_seq_length(flags);+ for (size_t i = 0; i < n_flags; i++) {+ PgfFlag* flag = gu_seq_index(flags, PgfFlag, i);+ + gu_puts(" flag ", out, err);+ pgf_print_cid(flag->name, out, err);+ gu_puts(" = ", out, err);+ pgf_print_literal(flag->value, out, err);+ gu_puts(";\n", out, err);+ }+}++static void+pgf_print_abscats(PgfAbsCats* abscats, GuOut *out, GuExn* err)+{+ size_t n_cats = gu_seq_length(abscats);+ for (size_t i = 0; i < n_cats; i++) {+ PgfAbsCat *abscat = gu_seq_index(abscats, PgfAbsCat, i);++ gu_puts(" cat ", out, err);+ pgf_print_cid(abscat->name, out, err);++ PgfPrintContext* ctxt = NULL;+ size_t n_hypos = gu_seq_length(abscat->context);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(abscat->context, PgfHypo, i);+ gu_putc(' ', out, err);+ ctxt = pgf_print_hypo(hypo, ctxt, 4, out, err);+ }++ while (ctxt != NULL) {+ PgfPrintContext* next = ctxt->next;+ free(ctxt);+ ctxt = next;+ }++ gu_printf(out, err, " ; -- %f\n", abscat->prob);+ }+}++static void+pgf_print_absfuns(PgfAbsFuns* absfuns, GuOut *out, GuExn* err)+{+ size_t n_funs = gu_seq_length(absfuns);+ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun *absfun = gu_seq_index(absfuns, PgfAbsFun, i);+ + gu_puts((absfun->defns == NULL) ? " data " : " fun ", out, err);+ pgf_print_cid(absfun->name, out, err);+ gu_puts(" : ", out, err);+ pgf_print_type(absfun->type, NULL, 0, out, err);+ gu_printf(out, err, " ; -- %f\n", absfun->ep.prob);+ }+}+static void+pgf_print_abstract(PgfAbstr* abstr, GuOut* out, GuExn* err)+{+ gu_puts("abstract ", out, err);+ pgf_print_cid(abstr->name, out, err);+ gu_puts(" {\n", out, err);++ pgf_print_flags(abstr->aflags, out, err);+ pgf_print_abscats(abstr->cats, out, err);+ pgf_print_absfuns(abstr->funs, out, err);++ gu_puts("}\n", out, err);+}++PGF_INTERNAL void+pgf_print_fid(int fid, GuOut* out, GuExn* err)+{+ if (fid == -1)+ gu_puts("CString", out, err);+ else if (fid == -2)+ gu_puts("CInt", out, err);+ else if (fid == -3)+ gu_puts("CFloat", out, err);+ else if (fid == -4)+ gu_puts("CVar", out, err);+ else if (fid == -5)+ gu_puts("CStart", out, err);+ else+ gu_printf(out, err, "C%d", fid);+}++static void+pgf_print_productions(GuMapItor* fn, const void* key, void* value,+ GuExn* err)+{+ PgfPrintFn* clo = (PgfPrintFn*) fn;+ int fid = *((int *) key);+ PgfCCat* ccat = *((PgfCCat**) value);+ GuOut *out = clo->out;++ if (ccat->prods != NULL) {+ size_t n_prods = gu_seq_length(ccat->prods);+ for (size_t i = 0; i < n_prods; i++) {+ PgfProduction prod = gu_seq_get(ccat->prods, PgfProduction, i);+ + gu_puts(" ", out, err);+ pgf_print_fid(fid, out, err);+ gu_puts(" -> ", out, err);++ GuVariantInfo i = gu_variant_open(prod);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply* papp = i.data;+ gu_printf(out,err,"F%d[",papp->fun->funid);+ size_t n_args = gu_seq_length(papp->args);+ for (size_t j = 0; j < n_args; j++) {+ if (j > 0)+ gu_putc(',',out,err);+ + PgfPArg arg = gu_seq_get(papp->args, PgfPArg, j);++ if (arg.hypos != NULL) {+ size_t n_hypos = gu_seq_length(arg.hypos);+ for (size_t k = 0; k < n_hypos; k++) {+ if (k > 0)+ gu_putc(' ',out,err);+ PgfCCat *hypo = gu_seq_get(arg.hypos, PgfCCat*, k);+ pgf_print_fid(hypo->fid, out, err);+ }+ }++ pgf_print_fid(arg.ccat->fid, out, err);+ }+ gu_printf(out,err,"]\n");+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = i.data;+ gu_puts("_[", out, err);+ pgf_print_fid(pcoerce->coerce->fid, out, err);+ gu_puts("]\n", out, err);+ break;+ }+ default:+ gu_impossible();+ }+ }+ }+}++static void+pgf_print_lindefs(GuMapItor* fn, const void* key, void* value,+ GuExn* err)+{+ PgfPrintFn* clo = (PgfPrintFn*) fn;+ int fid = *((int *) key);+ PgfCCat* ccat = *((PgfCCat**) value);+ GuOut *out = clo->out;+ + if (ccat->lindefs != NULL) {+ size_t n_lindefs = gu_seq_length(ccat->lindefs);+ for (size_t i = 0; i < n_lindefs; i++) {+ PgfCncFun* fun = gu_seq_get(ccat->lindefs, PgfCncFun*, i);+ gu_puts(" ",out,err);+ pgf_print_fid(fid, out, err);+ gu_printf(out,err," -> F%d[CVar]\n",fun->funid);+ }+ }+}++static void+pgf_print_linrefs(GuMapItor* fn, const void* key, void* value,+ GuExn* err)+{+ PgfPrintFn* clo = (PgfPrintFn*) fn;+ int fid = *((int *) key);+ PgfCCat* ccat = *((PgfCCat**) value);+ GuOut *out = clo->out;+ + if (ccat->linrefs != NULL) {+ size_t n_linrefs = gu_seq_length(ccat->linrefs);+ for (size_t i = 0; i < n_linrefs; i++) {+ PgfCncFun* fun = gu_seq_get(ccat->linrefs, PgfCncFun*, i);+ gu_printf(out,err," CVar -> F%d[",fun->funid);+ pgf_print_fid(fid, out, err);+ gu_puts("]\n", out, err);+ }+ }+}++static void+pgf_print_cncfun(PgfCncFun *cncfun, PgfSequences* sequences, + GuOut *out, GuExn *err)+{+ gu_printf(out,err," F%d := (", cncfun->funid);++ for (size_t i = 0; i < cncfun->n_lins; i++) {+ if (i > 0) gu_putc(',', out, err);++ PgfSequence* seq = cncfun->lins[i];+ gu_printf(out,err,"S%d", (seq - ((PgfSequence*) gu_seq_data(sequences))));+ }++ gu_puts(")", out, err);+ + if (cncfun->absfun != NULL) {+ gu_puts(" [", out, err);+ pgf_print_cid(cncfun->absfun->name, out, err);+ gu_puts("]", out, err);+ }+ + gu_puts("\n", out, err);+}++static void+pgf_print_token(PgfToken tok, GuOut *out, GuExn *err)+{+ gu_putc('"', out, err);+ gu_string_write(tok, out, err);+ gu_putc('"', out, err);+}++static void+pgf_print_symbols(PgfSymbols* syms, GuOut *out, GuExn *err);++PGF_INTERNAL void+pgf_print_symbol(PgfSymbol sym, GuOut *out, GuExn *err)+{+ switch (gu_variant_tag(sym)) {+ case PGF_SYMBOL_CAT: {+ PgfSymbolCat* scat = gu_variant_data(sym);+ gu_printf(out, err, "<%d,%d>", scat->d, scat->r);+ break;+ }+ case PGF_SYMBOL_KS: {+ PgfSymbolKS* sks = gu_variant_data(sym);+ pgf_print_token(sks->token, out, err);+ break;+ }+ case PGF_SYMBOL_KP: {+ PgfSymbolKP* skp = gu_variant_data(sym);++ gu_puts("pre {", out, err);+ pgf_print_symbols(skp->default_form, out, err);+ + for (size_t i = 0; i < skp->n_forms; i++) {+ gu_puts("; ", out, err);+ pgf_print_symbols(skp->forms[i].form, out, err);+ gu_puts(" / ", out, err);+ + size_t n_prefixes = gu_seq_length(skp->forms[i].prefixes);+ for (size_t j = 0; j < n_prefixes; j++) {+ if (j > 0) gu_putc(' ', out, err);+ + GuString prefix = gu_seq_get(skp->forms[i].prefixes, GuString, j);+ gu_putc('"', out, err);+ gu_string_write(prefix, out, err);+ gu_putc('"', out, err);+ }+ }+ + gu_puts("}", out, err);+ break;+ }+ case PGF_SYMBOL_LIT: {+ PgfSymbolLit *slit = gu_variant_data(sym);+ gu_printf(out, err, "{%d,%d}", slit->d, slit->r);+ break;+ }+ case PGF_SYMBOL_VAR: {+ PgfSymbolVar *svar = gu_variant_data(sym);+ gu_printf(out, err, "<%d,$%d>", svar->d, svar->r);+ break;+ }+ case PGF_SYMBOL_NE: {+ gu_puts("nonExist", out, err);+ break;+ }+ case PGF_SYMBOL_BIND: {+ gu_puts("BIND", out, err);+ break;+ }+ case PGF_SYMBOL_SOFT_BIND: {+ gu_puts("SOFT_BIND", out, err);+ break;+ }+ case PGF_SYMBOL_SOFT_SPACE: {+ gu_puts("SOFT_SPACE", out, err);+ break;+ }+ case PGF_SYMBOL_CAPIT: {+ gu_puts("CAPIT", out, err);+ break;+ }+ case PGF_SYMBOL_ALL_CAPIT: {+ gu_puts("ALL_CAPIT", out, err);+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_print_symbols(PgfSymbols* syms, GuOut *out, GuExn *err)+{+ int n_syms = gu_seq_length(syms);+ for (int i = 0; i < n_syms; i++) {+ if (i > 0) gu_putc(' ', out, err);+ + PgfSymbol sym = gu_seq_get(syms, PgfSymbol, i);+ pgf_print_symbol(sym, out, err);+ }+}++static void+pgf_print_cnccat(GuMapItor* fn, const void* key, void* value,+ GuExn* err)+{+ PgfPrintFn* clo = (PgfPrintFn*) fn;+ PgfCId name = (PgfCId) key;+ PgfCncCat* cnccat = *((PgfCncCat**) value);+ GuOut *out = clo->out;+ + gu_puts(" ", out, err);+ pgf_print_cid(name, out, err);+ gu_puts(" :=\n", out, err);+ + PgfCCat *start = gu_seq_get(cnccat->cats, PgfCCat*, 0);+ PgfCCat *end = gu_seq_get(cnccat->cats, PgfCCat*, gu_seq_length(cnccat->cats)-1);+ + gu_puts(" range [", out, err);+ pgf_print_fid(start->fid, out, err);+ gu_puts("..", out, err);+ pgf_print_fid(end->fid, out, err);+ gu_puts("]\n", out, err);+ + gu_puts(" labels [", out, err);+ for (size_t i = 0; i < cnccat->n_lins; i++) {+ if (i > 0) {+ gu_puts("\n ", out, err);+ }++ gu_string_write(cnccat->labels[i], out, err);+ }+ gu_puts("]\n", out, err);+}++static void+pgf_print_concrete(PgfConcr* concr, GuOut* out, GuExn* err)+{+ gu_puts("concrete ", out, err);+ pgf_print_cid(concr->name, out, err);+ gu_puts(" {\n", out, err);++ pgf_print_flags(concr->cflags, out, err);++ gu_puts(" productions\n", out, err);+ PgfPrintFn clo2 = { { pgf_print_productions }, out };+ gu_map_iter(concr->ccats, &clo2.fn, err);++ gu_puts(" lindefs\n", out, err);+ PgfPrintFn clo3 = { { pgf_print_lindefs }, out };+ gu_map_iter(concr->ccats, &clo3.fn, err);++ gu_puts(" linrefs\n", out, err);+ PgfPrintFn clo4 = { { pgf_print_linrefs }, out };+ gu_map_iter(concr->ccats, &clo4.fn, err);++ gu_puts(" lin\n", out, err);+ size_t n_funs = gu_seq_length(concr->cncfuns);+ for (size_t i = 0; i < n_funs; i++) {+ PgfCncFun* cncfun = gu_seq_get(concr->cncfuns, PgfCncFun*, i);+ pgf_print_cncfun(cncfun, concr->sequences, out, err);+ }++ gu_puts(" sequences\n", out, err);+ size_t n_seqs = gu_seq_length(concr->sequences);+ for (size_t i = 0; i < n_seqs; i++) {+ gu_printf(out,err," S%d := ", i);+ PgfSymbols* syms = gu_seq_index(concr->sequences, PgfSequence, i)->syms;+ pgf_print_symbols(syms, out, err);+ gu_putc('\n', out, err);+ }+ + gu_puts(" categories\n", out, err);+ PgfPrintFn clo5 = { { pgf_print_cnccat }, out };+ gu_map_iter(concr->cnccats, &clo5.fn, err);+ + gu_puts("}\n", out, err);+}++PGF_API void+pgf_print(PgfPGF* pgf, GuOut* out, GuExn* err)+{+ pgf_print_abstract(&pgf->abstract, out, err);+ + size_t n_concrs = gu_seq_length(pgf->concretes);+ for (size_t i = 0; i < n_concrs; i++) {+ PgfConcr* concr = gu_seq_index(pgf->concretes, PgfConcr, i);+ pgf_print_concrete(concr, out, err);+ }+}
@@ -0,0 +1,1366 @@+#include "data.h"+#include "expr.h"+#include "reasoner.h"+#include "reader.h"++#include <gu/defs.h>+#include <gu/map.h>+#include <gu/seq.h>+#include <gu/assert.h>+#include <gu/in.h>+#include <gu/bits.h>+#include <gu/exn.h>+#include <gu/utf8.h>+#include <math.h>+#include <stdio.h>+#include <stdlib.h>+#if defined(__MINGW32__) || defined(_MSC_VER)+#include <malloc.h>+#endif++//+// PgfReader+// ++typedef struct PgfReadTagExn PgfReadTagExn;++struct PgfReadTagExn {+ int tag;+};++PGF_INTERNAL uint8_t+pgf_read_tag(PgfReader* rdr)+{+ return gu_in_u8(rdr->in, rdr->err);+}++PGF_INTERNAL uint32_t+pgf_read_uint(PgfReader* rdr)+{+ uint32_t u = 0;+ int shift = 0;+ uint8_t b = 0;+ do {+ b = gu_in_u8(rdr->in, rdr->err);+ gu_return_on_exn(rdr->err, 0);+ u |= (b & ~0x80) << shift;+ shift += 7;+ } while (b & 0x80);+ return u;+}++PGF_INTERNAL int32_t+pgf_read_int(PgfReader* rdr)+{+ uint32_t u = pgf_read_uint(rdr);+ return gu_decode_2c32(u, rdr->err);+}++PGF_INTERNAL size_t+pgf_read_len(PgfReader* rdr)+{+ int32_t len = pgf_read_int(rdr);+ // It's crucial that we return 0 on failure, so the+ // caller can proceed without checking for error+ // immediately.+ gu_return_on_exn(rdr->err, 0);+ if (GU_UNLIKELY(len < 0)) {+ GuExnData* err_data = gu_raise(rdr->err, PgfReadTagExn);+ if (err_data) {+ PgfReadTagExn* rtag = gu_new(PgfReadTagExn, err_data->pool);+ rtag->tag = len;+ err_data->data = rtag;+ }++ return 0;+ }+ return len;+}++PGF_INTERNAL PgfCId+pgf_read_cid(PgfReader* rdr, GuPool* pool)+{+ size_t len = pgf_read_len(rdr);+ return gu_string_read_latin1(len, pool, rdr->in, rdr->err);+}++PGF_INTERNAL GuString+pgf_read_string(PgfReader* rdr)+{ + size_t len = pgf_read_len(rdr);+ return gu_string_read(len, rdr->opool, rdr->in, rdr->err);+}++PGF_INTERNAL double+pgf_read_double(PgfReader* rdr)+{+ return gu_in_f64be(rdr->in, rdr->err);+}++static void+pgf_read_tag_error(PgfReader* rdr)+{+ gu_impossible();+}++static PgfLiteral+pgf_read_literal(PgfReader* rdr)+{+ PgfLiteral lit = gu_null_variant;+ + uint8_t tag = pgf_read_tag(rdr);+ switch (tag) {+ case PGF_LITERAL_STR: {+ size_t len = pgf_read_len(rdr);+ uint8_t* buf = alloca(len*6+1);+ uint8_t* p = buf;+ for (size_t i = 0; i < len; i++) {+ gu_in_utf8_buf(&p, rdr->in, rdr->err);+ gu_return_on_exn(rdr->err, gu_null_variant);+ }+ *p++ = 0;++ PgfLiteralStr *lit_str =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, p-buf,+ &lit, rdr->opool);+ strcpy((char*) lit_str->val, (char*) buf);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt *lit_int =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &lit, rdr->opool);+ lit_int->val = pgf_read_int(rdr);+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt *lit_flt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &lit, rdr->opool);+ lit_flt->val = pgf_read_double(rdr);+ break;+ }+ default:+ pgf_read_tag_error(rdr);+ }+ return lit;+}++static PgfFlags*+pgf_read_flags(PgfReader* rdr)+{+ size_t n_flags = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfFlags* flags = gu_new_seq(PgfFlag, n_flags, rdr->opool);+ for (size_t i = 0; i < n_flags; i++) {+ PgfFlag* flag = gu_seq_index(flags, PgfFlag, i);++ flag->name = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, NULL);++ flag->value = pgf_read_literal(rdr);+ gu_return_on_exn(rdr->err, NULL);+ }++ return flags;+}++static PgfType*+pgf_read_type_(PgfReader* rdr);++static PgfExpr+pgf_read_expr_(PgfReader* rdr)+{+ PgfExpr expr = gu_null_variant;++ uint8_t tag = pgf_read_tag(rdr);+ switch (tag) {+ case PGF_EXPR_ABS:{+ PgfExprAbs *eabs =+ gu_new_variant(PGF_EXPR_ABS,+ PgfExprAbs,+ &expr, rdr->opool);++ eabs->bind_type = pgf_read_tag(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);++ eabs->id = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);++ eabs->body = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp *eapp =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &expr, rdr->opool);++ eapp->fun = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);++ eapp->arg = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit *elit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &expr, rdr->opool);+ elit->lit = pgf_read_literal(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_EXPR_META: {+ PgfExprMeta *emeta =+ gu_new_variant(PGF_EXPR_META,+ PgfExprMeta,+ &expr, rdr->opool);+ emeta->id = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_EXPR_FUN: {+ size_t len = pgf_read_len(rdr);++ PgfExprFun *efun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, len+1,+ &expr, rdr->opool);+ gu_in_bytes(rdr->in, (uint8_t*)efun->fun, len, rdr->err);+ efun->fun[len] = 0;+ + gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar *evar =+ gu_new_variant(PGF_EXPR_VAR,+ PgfExprVar,+ &expr, rdr->opool);+ evar->var = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped *etyped =+ gu_new_variant(PGF_EXPR_TYPED,+ PgfExprTyped,+ &expr, rdr->opool);+ etyped->expr = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ etyped->type = pgf_read_type_(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg *eimpl =+ gu_new_variant(PGF_EXPR_IMPL_ARG,+ PgfExprImplArg,+ &expr, rdr->opool);+ eimpl->expr = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ default:+ pgf_read_tag_error(rdr);+ }++ return expr;+}++static void+pgf_read_hypo(PgfReader* rdr, PgfHypo* hypo)+{+ hypo->bind_type = pgf_read_tag(rdr);+ gu_return_on_exn(rdr->err, );+ + hypo->cid = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, );+ + hypo->type = pgf_read_type_(rdr);+ gu_return_on_exn(rdr->err, );+}++static PgfType*+pgf_read_type_(PgfReader* rdr)+{+ size_t n_hypos = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);+ GuSeq* hypos = gu_new_seq(PgfHypo, n_hypos, rdr->opool);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(hypos, PgfHypo, i);+ pgf_read_hypo(rdr, hypo);+ gu_return_on_exn(rdr->err, NULL);+ }++ PgfCId cid = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, NULL);++ size_t n_exprs = pgf_read_len(rdr);++ PgfType* type = gu_new_flex(rdr->opool, PgfType, exprs, n_exprs);+ type->hypos = hypos;+ type->cid = cid;+ type->n_exprs = n_exprs;++ for (size_t i = 0; i < type->n_exprs; i++) {+ type->exprs[i] = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, NULL);+ }++ return type;+}++static PgfPatt+pgf_read_patt(PgfReader* rdr)+{+ PgfPatt patt = gu_null_variant;++ uint8_t tag = pgf_read_tag(rdr);+ switch (tag) {+ case PGF_PATT_APP: {+ PgfPattApp *papp =+ gu_new_variant(PGF_PATT_APP,+ PgfPattApp,+ &patt, rdr->opool);+ papp->ctor = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ + papp->n_args = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ + for (size_t i = 0; i < papp->n_args; i++) {+ papp->args[i] = pgf_read_patt(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ }+ break;+ }+ case PGF_PATT_VAR: {+ PgfPattVar *papp =+ gu_new_variant(PGF_PATT_VAR,+ PgfPattVar,+ &patt, rdr->opool);+ papp->var = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_PATT_AS: {+ PgfPattAs *pas =+ gu_new_variant(PGF_PATT_AS,+ PgfPattAs,+ &patt, rdr->opool);+ pas->var = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);++ pas->patt = pgf_read_patt(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_PATT_WILD: {+ PgfPattWild* pwild =+ gu_new_variant(PGF_PATT_WILD,+ PgfPattWild,+ &patt, rdr->opool);+ ((void) pwild);+ break;+ }+ case PGF_PATT_LIT: {+ PgfPattLit *plit =+ gu_new_variant(PGF_PATT_LIT,+ PgfPattLit,+ &patt, rdr->opool);+ plit->lit = pgf_read_literal(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_PATT_IMPL_ARG: {+ PgfPattImplArg *pimpl =+ gu_new_variant(PGF_PATT_IMPL_ARG,+ PgfPattImplArg,+ &patt, rdr->opool);+ pimpl->patt = pgf_read_patt(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_PATT_TILDE: {+ PgfPattTilde *ptilde =+ gu_new_variant(PGF_PATT_TILDE,+ PgfPattTilde,+ &patt, rdr->opool);+ ptilde->expr = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ default:+ pgf_read_tag_error(rdr);+ }++ return patt;+}++static PgfAbsFun*+pgf_read_absfun(PgfReader* rdr, PgfAbstr* abstr, PgfAbsFun* absfun)+{+ size_t len = pgf_read_len(rdr);++ PgfExprFun *efun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, len+1,+ &absfun->ep.expr, rdr->opool);+ gu_in_bytes(rdr->in, (uint8_t*)efun->fun, len, rdr->err);+ efun->fun[len] = 0;+ absfun->name = efun->fun;++ gu_return_on_exn(rdr->err, NULL);++ absfun->type = pgf_read_type_(rdr);+ gu_return_on_exn(rdr->err, NULL);++ absfun->arity = pgf_read_int(rdr);++ uint8_t tag = pgf_read_tag(rdr);+ gu_return_on_exn(rdr->err, NULL);+ switch (tag) {+ case 0:+ absfun->defns = NULL;+ if (absfun->arity == 0) {+ absfun->closure.code = abstr->eval_gates->evaluate_value;+ absfun->closure.con = &absfun->closure.code;+ } else {+ absfun->closure.code = NULL;+ }+ break;+ case 1: {+ size_t length = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ absfun->defns = gu_new_seq(PgfEquation*, length, rdr->opool);+ PgfEquation** data = gu_seq_data(absfun->defns);+ for (size_t i = 0; i < length; i++) {+ size_t n_patts = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfEquation *equ =+ gu_malloc(rdr->opool, + sizeof(PgfEquation)+sizeof(PgfPatt)*n_patts);+ equ->n_patts = n_patts;+ for (size_t j = 0; j < n_patts; j++) {+ equ->patts[j] = pgf_read_patt(rdr);+ gu_return_on_exn(rdr->err, NULL);+ }+ equ->body = pgf_read_expr_(rdr);+ gu_return_on_exn(rdr->err, NULL);++ data[i] = equ;+ }+ + // pgf_jit_function(rdr, abstr, absfun);+ break;+ }+ default:+ pgf_read_tag_error(rdr);+ break;+ }++ absfun->ep.prob = - log(pgf_read_double(rdr));++ return absfun;+}+ +static PgfAbsFuns*+pgf_read_absfuns(PgfReader* rdr, PgfAbstr* abstr)+{+ size_t n_funs = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfAbsFuns* absfuns = gu_new_seq(PgfAbsFun, n_funs, rdr->opool);++ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun* absfun = gu_seq_index(absfuns, PgfAbsFun, i);+ pgf_read_absfun(rdr, abstr, absfun);+ gu_return_on_exn(rdr->err, NULL);+ }++ return absfuns;+}++static PgfAbsCat*+pgf_read_abscat(PgfReader* rdr, PgfAbstr* abstr, PgfAbsCat* abscat)+{+ abscat->name = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, NULL);++ size_t n_hypos = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);+ abscat->context = gu_new_seq(PgfHypo, n_hypos, rdr->opool);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(abscat->context, PgfHypo, i);+ pgf_read_hypo(rdr, hypo);+ gu_return_on_exn(rdr->err, NULL);+ }++ pgf_jit_predicate(rdr, abstr, abscat);++ abscat->prob = - log(pgf_read_double(rdr));++ return abscat;+}++static PgfAbsCats*+pgf_read_abscats(PgfReader* rdr, PgfAbstr* abstr)+{+ size_t n_cats = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);+ + PgfAbsCats* abscats = gu_new_seq(PgfAbsCat, n_cats, rdr->opool);++ for (size_t i = 0; i < n_cats; i++) {+ PgfAbsCat* abscat = gu_seq_index(abscats, PgfAbsCat, i);+ pgf_read_abscat(rdr, abstr, abscat);+ gu_return_on_exn(rdr->err, NULL);+ }++ return abscats;+}++static void+pgf_read_abstract(PgfReader* rdr, PgfAbstr* abstract)+{+ abstract->name = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, );++ abstract->aflags = pgf_read_flags(rdr);+ gu_return_on_exn(rdr->err, );++ abstract->eval_gates = pgf_jit_gates(rdr);+ + abstract->funs = pgf_read_absfuns(rdr, abstract);+ gu_return_on_exn(rdr->err, );+ + abstract->cats = pgf_read_abscats(rdr, abstract);+ gu_return_on_exn(rdr->err, );++ abstract->abs_lin_fun = gu_new(PgfAbsFun, rdr->opool);+ abstract->abs_lin_fun->name = "_";+ abstract->abs_lin_fun->type = gu_new(PgfType, rdr->opool);+ abstract->abs_lin_fun->type->hypos = NULL;+ abstract->abs_lin_fun->type->cid = "_";+ abstract->abs_lin_fun->type->n_exprs = 0;+ abstract->abs_lin_fun->arity = 0;+ abstract->abs_lin_fun->defns = NULL;+ abstract->abs_lin_fun->ep.prob = INFINITY;+ abstract->abs_lin_fun->ep.expr = gu_null_variant;+}++static PgfCIdMap*+pgf_read_printnames(PgfReader* rdr)+{+ PgfCIdMap* printnames = gu_new_string_map(GuString, &gu_null_struct, rdr->opool);++ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ for (size_t i = 0; i < len; i++) {+ PgfCId name = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, NULL);++ GuString printname = pgf_read_string(rdr);+ gu_return_on_exn(rdr->err, NULL);++ gu_map_put(printnames, name, GuString, printname);+ }++ return printnames;+}++static PgfSymbols*+pgf_read_symbols(PgfReader* rdr);++static void+pgf_read_alternative(PgfReader* rdr, PgfAlternative* alt)+{+ alt->form = pgf_read_symbols(rdr);+ gu_return_on_exn(rdr->err,);++ size_t n_prefixes = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err,);++ alt->prefixes = gu_new_seq(GuString, n_prefixes, rdr->opool);+ for (size_t i = 0; i < n_prefixes; i++) {+ GuString prefix = pgf_read_string(rdr);+ gu_return_on_exn(rdr->err,);+ + gu_seq_set(alt->prefixes, GuString, i, prefix);+ }+}++static PgfSymbol+pgf_read_symbol(PgfReader* rdr)+{+ PgfSymbol sym = gu_null_variant;++ uint8_t tag = pgf_read_tag(rdr);+ switch (tag) {+ case PGF_SYMBOL_CAT: {+ PgfSymbolCat *sym_cat =+ gu_new_variant(PGF_SYMBOL_CAT,+ PgfSymbolCat,+ &sym, rdr->opool);++ sym_cat->d = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);++ sym_cat->r = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_LIT: {+ PgfSymbolLit *sym_lit =+ gu_new_variant(PGF_SYMBOL_LIT,+ PgfSymbolLit,+ &sym, rdr->opool);++ sym_lit->d = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);++ sym_lit->r = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_VAR: {+ PgfSymbolVar *sym_var =+ gu_new_variant(PGF_SYMBOL_VAR,+ PgfSymbolVar,+ &sym, rdr->opool);++ sym_var->d = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);++ sym_var->r = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_KS: {+ size_t len = pgf_read_len(rdr);+ uint8_t* buf = alloca(len*6+1);+ uint8_t* p = buf;+ for (size_t i = 0; i < len; i++) {+ gu_in_utf8_buf(&p, rdr->in, rdr->err);+ gu_return_on_exn(rdr->err, gu_null_variant);+ }+ *p++ = 0;++ PgfSymbolKS *sym_ks =+ gu_new_flex_variant(PGF_SYMBOL_KS,+ PgfSymbolKS,+ token, p-buf,+ &sym, rdr->opool);+ strcpy((char*) sym_ks->token, (char*) buf);+ break;+ }+ case PGF_SYMBOL_KP: {+ PgfSymbols* default_form = pgf_read_symbols(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);+ + size_t n_forms = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, gu_null_variant);++ PgfSymbolKP *sym_kp =+ gu_new_flex_variant(PGF_SYMBOL_KP,+ PgfSymbolKP, forms, n_forms,+ &sym, rdr->opool);+ sym_kp->default_form = default_form;+ sym_kp->n_forms = n_forms;++ for (size_t i = 0; i < sym_kp->n_forms; i++) {+ pgf_read_alternative(rdr, &sym_kp->forms[i]);+ gu_return_on_exn(rdr->err, gu_null_variant);+ }+ break;+ }+ case PGF_SYMBOL_NE: {+ gu_new_variant(PGF_SYMBOL_NE,+ PgfSymbolNE,+ &sym, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_BIND: {+ gu_new_variant(PGF_SYMBOL_BIND,+ PgfSymbolBIND,+ &sym, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_SOFT_BIND: {+ gu_new_variant(PGF_SYMBOL_SOFT_BIND,+ PgfSymbolBIND,+ &sym, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_SOFT_SPACE: {+ gu_new_variant(PGF_SYMBOL_SOFT_SPACE,+ PgfSymbolBIND,+ &sym, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_CAPIT: {+ gu_new_variant(PGF_SYMBOL_CAPIT,+ PgfSymbolCAPIT,+ &sym, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ case PGF_SYMBOL_ALL_CAPIT: {+ gu_new_variant(PGF_SYMBOL_ALL_CAPIT,+ PgfSymbolCAPIT,+ &sym, rdr->opool);+ gu_return_on_exn(rdr->err, gu_null_variant);+ break;+ }+ default:+ pgf_read_tag_error(rdr);+ }++ return sym;+}++static PgfSymbols*+pgf_read_symbols(PgfReader* rdr)+{+ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfSymbols* syms = gu_new_seq(PgfSymbol, len, rdr->opool);++ for (size_t i = 0; i < len; i++) {+ PgfSymbol sym = pgf_read_symbol(rdr);+ gu_return_on_exn(rdr->err, NULL);+ gu_seq_set(syms, PgfSymbol, i, sym);+ }++ return syms;+}++static PgfSequences*+pgf_read_sequences(PgfReader* rdr)+{+ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);+ + PgfSequences* seqs = gu_new_seq(PgfSequence, len, rdr->opool);++ for (size_t i = 0; i < len; i++) {+ PgfSymbols* syms = pgf_read_symbols(rdr);+ gu_return_on_exn(rdr->err, NULL);++ gu_seq_index(seqs, PgfSequence, i)->syms = syms;+ gu_seq_index(seqs, PgfSequence, i)->idx = NULL;+ }++ return seqs;+}++static PgfCncFun*+pgf_read_cncfun(PgfReader* rdr, PgfAbstr* abstr, PgfConcr* concr, int funid)+{+ PgfCId name = pgf_read_cid(rdr, rdr->tmp_pool);+ gu_return_on_exn(rdr->err, NULL);++ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfAbsFun* absfun =+ gu_seq_binsearch(abstr->funs, pgf_absfun_order, PgfAbsFun, name);++ PgfCncFun* cncfun = gu_new_flex(rdr->opool, PgfCncFun, lins, len);+ cncfun->absfun = absfun;+ cncfun->ep = (absfun == NULL) ? NULL : &absfun->ep;+ cncfun->funid = funid;+ cncfun->n_lins = len;++ for (size_t i = 0; i < len; i++) {+ size_t seqid = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, NULL);++ if (seqid >= gu_seq_length(concr->sequences)) {+ gu_raise(rdr->err, PgfReadExn);+ return NULL;+ }+ + cncfun->lins[i] = gu_seq_index(concr->sequences, PgfSequence, seqid);+ }++ return cncfun;+}++static PgfCncFuns*+pgf_read_cncfuns(PgfReader* rdr, PgfAbstr* abstr, PgfConcr* concr)+{+ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfCncFuns* cncfuns = gu_new_seq(PgfCncFun*, len, rdr->opool);++ for (size_t funid = 0; funid < len; funid++) {+ PgfCncFun* cncfun = pgf_read_cncfun(rdr, abstr, concr, funid);+ gu_return_on_exn(rdr->err, NULL);++ gu_seq_set(cncfuns, PgfCncFun*, funid, cncfun);+ }++ return cncfuns;+}++static PgfCCat*+pgf_read_fid(PgfReader* rdr, PgfConcr* concr)+{+ int fid = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfCCat* ccat = gu_map_get(concr->ccats, &fid, PgfCCat*);+ if (!ccat) {+ ccat = gu_new(PgfCCat, rdr->opool);+ ccat->cnccat = NULL;+ ccat->lindefs = NULL;+ ccat->linrefs = NULL;+ ccat->n_synprods = 0;+ ccat->prods = NULL;+ ccat->viterbi_prob = 0;+ ccat->fid = fid;+ ccat->conts = NULL;+ ccat->answers = NULL;++ gu_map_put(concr->ccats, &fid, PgfCCat*, ccat);+ }++ return ccat;+}++static PgfCncFun*+pgf_read_funid(PgfReader* rdr, PgfConcr* concr)+{+ size_t funid = pgf_read_int(rdr);+ gu_return_on_exn(rdr->err, NULL);++ if (funid >= gu_seq_length(concr->cncfuns)) {+ gu_raise(rdr->err, PgfReadExn);+ return NULL;+ }++ return gu_seq_get(concr->cncfuns, PgfCncFun*, funid);+}++static void+pgf_read_lindefs(PgfReader* rdr, PgfConcr* concr)+{+ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ for (size_t i = 0; i < len; i++) {+ PgfCCat* ccat = pgf_read_fid(rdr, concr);+ + size_t n_funs = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );+ + ccat->lindefs = gu_new_seq(PgfCncFun*, n_funs, rdr->opool);+ for (size_t j = 0; j < n_funs; j++) {+ PgfCncFun* fun = pgf_read_funid(rdr, concr);+ fun->absfun = concr->abstr->abs_lin_fun;+ gu_seq_set(ccat->lindefs, PgfCncFun*, j, fun);+ }+ }+}++static void+pgf_read_linrefs(PgfReader* rdr, PgfConcr* concr)+{+ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ for (size_t i = 0; i < len; i++) {+ PgfCCat* ccat = pgf_read_fid(rdr, concr);+ + size_t n_funs = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ ccat->linrefs = gu_new_seq(PgfCncFun*, n_funs, rdr->opool);+ for (size_t j = 0; j < n_funs; j++) {+ PgfCncFun* fun = pgf_read_funid(rdr, concr);+ fun->absfun = concr->abstr->abs_lin_fun;+ gu_seq_set(ccat->linrefs, PgfCncFun*, j, fun);+ }+ }+}++static void+pgf_read_parg(PgfReader* rdr, PgfConcr* concr, PgfPArg* parg)+{+ size_t n_hoas = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ parg->hypos = gu_new_seq(PgfCCat*, n_hoas, rdr->opool);+ for (size_t i = 0; i < n_hoas; i++) {+ gu_seq_set(parg->hypos, PgfCCat*, i, pgf_read_fid(rdr, concr));+ gu_return_on_exn(rdr->err, );+ }+ + parg->ccat = pgf_read_fid(rdr, concr);+ gu_return_on_exn(rdr->err, );+}++static PgfPArgs*+pgf_read_pargs(PgfReader* rdr, PgfConcr* concr)+{+ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfPArgs* pargs = gu_new_seq(PgfPArg, len, rdr->opool);+ for (size_t i = 0; i < len; i++) {+ PgfPArg* parg = gu_seq_index(pargs, PgfPArg, i);+ pgf_read_parg(rdr, concr, parg);+ }++ return pargs;+}++PGF_API bool+pgf_production_is_lexical(PgfProductionApply *papp, + GuBuf* non_lexical_buf, GuPool* pool)+{+ if (gu_seq_length(papp->args) > 0)+ return false;++ for (size_t lin_idx = 0; lin_idx < papp->fun->n_lins; lin_idx++) {+ PgfSequence* seq = papp->fun->lins[lin_idx];+ + if (seq->idx == NULL) {+ size_t n_syms = gu_seq_length(seq->syms);+ for (size_t i = 0; i < n_syms; i++) {+ PgfSymbol sym = gu_seq_get(seq->syms, PgfSymbol, i);+ GuVariantInfo inf = gu_variant_open(sym);+ if (inf.tag == PGF_SYMBOL_KP ||+ inf.tag == PGF_SYMBOL_BIND ||+ inf.tag == PGF_SYMBOL_NE ||+ inf.tag == PGF_SYMBOL_SOFT_BIND ||+ inf.tag == PGF_SYMBOL_SOFT_SPACE ||+ inf.tag == PGF_SYMBOL_CAPIT ||+ inf.tag == PGF_SYMBOL_ALL_CAPIT) {+ seq->idx = non_lexical_buf;+ return false;+ }+ }++ seq->idx = gu_new_buf(PgfProductionIdxEntry, pool);+ } if (seq->idx == non_lexical_buf) {+ return false;+ }+ }++ return true;+}++static void+pgf_read_production(PgfReader* rdr, PgfConcr* concr, + PgfCCat* ccat, size_t* top, size_t* bot)+{+ PgfProduction prod = gu_null_variant;+ bool is_lexical = false;++ uint8_t tag = pgf_read_tag(rdr);+ switch (tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply *papp =+ gu_new_variant(PGF_PRODUCTION_APPLY,+ PgfProductionApply,+ &prod, rdr->opool);++ papp->fun = pgf_read_funid(rdr, concr);+ gu_return_on_exn(rdr->err, );++ papp->args = pgf_read_pargs(rdr, concr);+ gu_return_on_exn(rdr->err, );++ is_lexical = pgf_production_is_lexical(papp, rdr->non_lexical_buf, rdr->opool);+ if (!is_lexical)+ gu_seq_set(ccat->prods, PgfProduction, (*top)++, prod);+ else+ gu_seq_set(ccat->prods, PgfProduction, (*bot)--, prod);+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce *pcoerce =+ gu_new_variant(PGF_PRODUCTION_COERCE,+ PgfProductionCoerce,+ &prod, rdr->opool);++ pcoerce->coerce = pgf_read_fid(rdr, concr);+ gu_return_on_exn(rdr->err, );++ gu_seq_set(ccat->prods, PgfProduction, (*top)++, prod);+ break;+ }+ default:+ pgf_read_tag_error(rdr);+ }++ pgf_parser_index(concr, ccat, prod, is_lexical, rdr->opool);+ pgf_lzr_index(concr, ccat, prod, is_lexical, rdr->opool);+}++static void+pgf_read_ccats(PgfReader* rdr, PgfConcr* concr)+{+ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, );++ for (size_t i = 0; i < len; i++) {+ PgfCCat* ccat = pgf_read_fid(rdr, concr);++ size_t n_prods = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err,);++ ccat->prods = gu_new_seq(PgfProduction, n_prods, rdr->opool);++ size_t top = 0;+ size_t bot = n_prods-1;+ for (size_t i = 0; i < n_prods; i++) {+ pgf_read_production(rdr, concr, ccat, &top, &bot);+ gu_return_on_exn(rdr->err, );+ }++ ccat->n_synprods = top;+ }+}++static PgfCncCat*+pgf_read_cnccat(PgfReader* rdr, PgfAbstr* abstr, PgfConcr* concr, PgfCId name)+{+ int first = pgf_read_int(rdr);+ int last = pgf_read_int(rdr);+ int n_lins = pgf_read_len(rdr);+ + PgfCncCat* cnccat =+ gu_malloc(rdr->opool, sizeof(PgfCncCat)+n_lins*sizeof(GuString));++ cnccat->abscat = + gu_seq_binsearch(abstr->cats, pgf_abscat_order, PgfAbsCat, name);+ if (cnccat->abscat == NULL) {+ fprintf(stderr, "Abstract category %s is missing\n", name);+ gu_assert(cnccat->abscat != NULL);+ }++ int len = last + 1 - first;+ cnccat->cats = gu_new_seq(PgfCCat*, len, rdr->opool);++ for (int i = 0; i < len; i++) {+ int fid = first + i;+ PgfCCat* ccat = gu_map_get(concr->ccats, &fid, PgfCCat*);+ if (!ccat) {+ ccat = gu_new(PgfCCat, rdr->opool);+ ccat->cnccat = NULL;+ ccat->lindefs = NULL;+ ccat->linrefs = NULL;+ ccat->n_synprods = 0;+ ccat->prods = NULL;+ ccat->viterbi_prob = 0;+ ccat->fid = fid;+ ccat->conts = NULL;+ ccat->answers = NULL;++ gu_map_put(concr->ccats, &fid, PgfCCat*, ccat);+ }+ gu_seq_set(cnccat->cats, PgfCCat*, i, ccat);++ ccat->cnccat = cnccat;+ }++ cnccat->n_lins = n_lins;+ for (size_t i = 0; i < cnccat->n_lins; i++) {+ cnccat->labels[i] = pgf_read_string(rdr);+ }++ return cnccat;+}++static PgfCIdMap*+pgf_read_cnccats(PgfReader* rdr, PgfAbstr* abstr, PgfConcr* concr)+{+ PgfCIdMap* cnccats = gu_new_string_map(PgfCncCat, &gu_null_struct, rdr->opool);++ size_t len = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ for (size_t i = 0; i < len; i++) {+ PgfCId name = pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, NULL);++ PgfCncCat* cnccat =+ pgf_read_cnccat(rdr, abstr, concr, name);+ gu_return_on_exn(rdr->err, NULL);+ + gu_map_put(cnccats, name, PgfCncCat*, cnccat);+ }++ return cnccats;+}++static void+pgf_ccat_set_cnccat(PgfCCat* ccat, PgfProduction prod)+{+ GuVariantInfo i = gu_variant_open(prod);+ switch (i.tag) {+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce* pcoerce = i.data;+ PgfCncCat* cnccat = pcoerce->coerce->cnccat;+ if (!ccat->cnccat) {+ ccat->cnccat = cnccat;+ } else if (ccat->cnccat != cnccat) {+ // XXX: real error+ gu_impossible();+ }+ break;+ }+ case PGF_PRODUCTION_APPLY:+ // Shouldn't happen with current PGF.+ // XXX: real error+ gu_impossible();+ break;+ default:+ gu_impossible();+ }+}++extern prob_t+pgf_ccat_set_viterbi_prob(PgfCCat* ccat);++static void+pgf_read_ccat_cb(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ (void) (fn && key && err);+ PgfCCat* ccat = *((PgfCCat**) value);++ if (ccat->prods == NULL)+ return;++ size_t n_prods = gu_seq_length(ccat->prods);+ for (size_t i = 0; i < n_prods; i++) {+ PgfProduction prod = + gu_seq_get(ccat->prods, PgfProduction, i);+ + if (!ccat->cnccat) {+ pgf_ccat_set_cnccat(ccat, prod);+ }+ }++// pgf_ccat_set_viterbi_prob(ccat);+}++static void+pgf_read_concrete_content(PgfReader* rdr, PgfConcr* concr)+{+ concr->printnames =+ pgf_read_printnames(rdr);+ gu_return_on_exn(rdr->err,);++ concr->sequences =+ pgf_read_sequences(rdr);+ gu_return_on_exn(rdr->err,);++ concr->cncfuns =+ pgf_read_cncfuns(rdr, concr->abstr, concr);+ gu_return_on_exn(rdr->err,);++ concr->ccats =+ gu_new_int_map(PgfCCat*, &gu_null_struct, rdr->opool);+ concr->fun_indices = gu_new_string_map(PgfCncOverloadMap*, &gu_null_struct, rdr->opool);+ concr->coerce_idx = gu_new_addr_map(PgfCCat*, GuBuf*, &gu_null_struct, rdr->opool);+ pgf_read_lindefs(rdr, concr);+ pgf_read_linrefs(rdr, concr);+ pgf_read_ccats(rdr, concr);+ concr->cnccats = pgf_read_cnccats(rdr, concr->abstr, concr);+ concr->total_cats = pgf_read_int(rdr);++ GuMapItor clo1 = { pgf_read_ccat_cb };+ gu_map_iter(concr->ccats, &clo1, NULL);+}++static void+pgf_read_concrete_init_header(PgfConcr* concr)+{+ concr->printnames = NULL;+ concr->sequences = NULL;+ concr->cncfuns = NULL;+ concr->ccats = NULL;+ concr->fun_indices = NULL;+ concr->coerce_idx = NULL;+ concr->cnccats = NULL;+ concr->total_cats = 0;+}++static void+gu_concr_fini(GuFinalizer* fin)+{+ PgfConcr* concr = gu_container(fin, PgfConcr, fin);+ + if (concr->pool != NULL) {+ pgf_read_concrete_init_header(concr);+ gu_pool_free(concr->pool);+ concr->pool = NULL;+ }+}++static PgfConcr*+pgf_read_concrete(PgfReader* rdr, PgfAbstr* abstr, PgfConcr* concr, bool with_content)+{+ concr->name = + pgf_read_cid(rdr, rdr->opool);+ gu_return_on_exn(rdr->err, NULL);++ concr->abstr = abstr;++ concr->cflags =+ pgf_read_flags(rdr);+ gu_return_on_exn(rdr->err, NULL);++ concr->pool = NULL;++ if (with_content) {+ pgf_read_concrete_content(rdr, concr);+ + concr->fin.fn = NULL;+ } else {+ pgf_read_concrete_init_header(concr);++ concr->fin.fn = gu_concr_fini;+ gu_pool_finally(rdr->opool, &concr->fin);+ }+ gu_return_on_exn(rdr->err, NULL);++ return concr;+}++PGF_API void+pgf_concrete_load(PgfConcr* concr, GuIn* in, GuExn* err)+{+ if (concr->fin.fn == NULL || concr->pool != NULL)+ return; // already loaded++ GuPool* pool = gu_new_pool();+ GuPool* tmp_pool = gu_local_pool();++ PgfReader* rdr = pgf_new_reader(in, pool, tmp_pool, err);++ PgfCId name =+ pgf_read_cid(rdr, rdr->tmp_pool);+ gu_return_on_exn(rdr->err, );++ if (strcmp(name, concr->name) != 0) {+ GuExnData* err_data = gu_raise(rdr->err, PgfExn);+ if (err_data) {+ err_data->data = "This file contains different concrete syntax";+ gu_pool_free(tmp_pool);+ gu_pool_free(pool);+ return;+ }+ }++ concr->pool = pool;++ pgf_read_flags(rdr);+ if (gu_exn_is_raised(rdr->err)) + goto end;++ pgf_read_concrete_content(rdr, concr);+ if (gu_exn_is_raised(rdr->err)) + goto end;++end:+ gu_pool_free(tmp_pool);+}++PGF_API void+pgf_concrete_unload(PgfConcr* concr)+{+ if (concr->fin.fn == NULL)+ return;++ gu_concr_fini(&concr->fin);+}++static PgfConcrs*+pgf_read_concretes(PgfReader* rdr, PgfAbstr* abstr, bool with_content)+{+ size_t n_concrs = pgf_read_len(rdr);+ gu_return_on_exn(rdr->err, NULL);++ PgfConcrs* concretes = gu_new_seq(PgfConcr, n_concrs, rdr->opool);++ for (size_t i = 0; i < n_concrs; i++) {+ PgfConcr* concr = gu_seq_index(concretes, PgfConcr, i);+ pgf_read_concrete(rdr, abstr, concr, with_content);+ gu_return_on_exn(rdr->err, NULL);+ }++ return concretes;+}++PGF_INTERNAL PgfPGF*+pgf_read_pgf(PgfReader* rdr) {+ PgfPGF* pgf = gu_new(PgfPGF, rdr->opool);+ + pgf->major_version = gu_in_u16be(rdr->in, rdr->err);+ gu_return_on_exn(rdr->err, NULL);++ pgf->minor_version = gu_in_u16be(rdr->in, rdr->err);+ gu_return_on_exn(rdr->err, NULL);++ pgf->gflags = pgf_read_flags(rdr);+ gu_return_on_exn(rdr->err, NULL);+ + pgf_read_abstract(rdr, &pgf->abstract);+ gu_return_on_exn(rdr->err, NULL);++ bool with_content =+ (gu_seq_binsearch(pgf->gflags, pgf_flag_order, PgfFlag, "split") == NULL);+ pgf->concretes = pgf_read_concretes(rdr, &pgf->abstract, with_content);+ gu_return_on_exn(rdr->err, NULL);++ pgf->pool = rdr->opool;++ return pgf;+}++PGF_INTERNAL PgfReader*+pgf_new_reader(GuIn* in, GuPool* opool, GuPool* tmp_pool, GuExn* err)+{+ PgfReader* rdr = gu_new(PgfReader, tmp_pool);+ rdr->opool = opool;+ rdr->tmp_pool = tmp_pool;+ rdr->err = err;+ rdr->in = in;+ rdr->non_lexical_buf = gu_new_buf(PgfProductionIdxEntry, opool);+ rdr->jit_state = pgf_new_jit(rdr);+ return rdr;+}++PGF_INTERNAL void+pgf_reader_done(PgfReader* rdr, PgfPGF* pgf)+{+ if (pgf == NULL)+ return;++ pgf_jit_done(rdr, &pgf->abstract);+}
@@ -0,0 +1,73 @@+#ifndef READER_H_+#define READER_H_++#include <gu/exn.h>+#include <gu/mem.h>+#include <gu/in.h>++// general reader interface++typedef struct {+ GuIn* in;+ GuExn* err;+ GuPool* opool;+ GuPool* tmp_pool;+ GuBuf* non_lexical_buf;+ struct PgfJitState* jit_state;+} PgfReader;++PGF_INTERNAL_DECL PgfReader*+pgf_new_reader(GuIn* in, GuPool* opool, GuPool* tmp_pool, GuExn* err);++PGF_INTERNAL_DECL uint8_t+pgf_read_tag(PgfReader* rdr);++PGF_INTERNAL_DECL uint32_t+pgf_read_uint(PgfReader* rdr);++PGF_INTERNAL_DECL int32_t+pgf_read_int(PgfReader* rdr);++PGF_INTERNAL_DECL GuString+pgf_read_string(PgfReader* rdr);++PGF_INTERNAL_DECL double+pgf_read_double(PgfReader* rdr);++PGF_INTERNAL_DECL size_t+pgf_read_len(PgfReader* rdr);++PGF_INTERNAL_DECL PgfCId+pgf_read_cid(PgfReader* rdr, GuPool* pool);++PGF_INTERNAL_DECL PgfPGF*+pgf_read_pgf(PgfReader* rdr);++PGF_INTERNAL_DECL void+pgf_reader_done(PgfReader* rdr, PgfPGF* pgf);+++// JIT specific interface+#ifdef PGF_REASONER_H_++typedef struct PgfJitState PgfJitState;++PGF_INTERNAL_DECL PgfJitState*+pgf_new_jit(PgfReader* rdr);++PGF_INTERNAL_DECL PgfEvalGates*+pgf_jit_gates(PgfReader* rdr);++PGF_INTERNAL_DECL void+pgf_jit_predicate(PgfReader* rdr, PgfAbstr* abstr,+ PgfAbsCat* abscat);++PGF_INTERNAL_DECL void+pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,+ PgfAbsFun* absfun);++PGF_INTERNAL_DECL void+pgf_jit_done(PgfReader* state, PgfAbstr* abstr);++#endif+#endif // READER_H_
@@ -0,0 +1,475 @@+#include <pgf/pgf.h>+#include <pgf/data.h>+#include <pgf/reasoner.h>+#include <gu/file.h>++//#define PGF_REASONER_DEBUG++typedef struct {+ GuBuf* parents;+ GuBuf* exprs;+ prob_t outside_prob;+} PgfAnswers;++#ifdef PGF_REASONER_DEBUG+typedef void (*PgfStatePrinter)(PgfReasoner* rs, PgfReasonerState* st,+ GuOut* out, GuExn* err,+ GuPool* tmp_pool);+#endif++struct PgfReasonerState {+ PgfClosure header;+#ifdef PGF_REASONER_DEBUG+ PgfStatePrinter print;+#endif+ prob_t prob;+};++struct PgfExprState {+ // base must be the first field in order to be able to cast+ // from PgfExprState to PgfReasonerState+ PgfReasonerState base;+ PgfAnswers* answers;+ PgfExpr expr;+#ifdef PGF_REASONER_DEBUG+ size_t n_args;+ size_t arg_idx;+#endif+};++typedef struct {+ // base must be the first field in order to be able to cast+ // from PgfCombine1State to PgfReasonerState+ PgfReasonerState base;+ GuBuf* exprs;+ PgfExprState* parent;+ size_t n_choices;+ size_t choice;+} PgfCombine1State;++typedef struct {+ // base must be the first field in order to be able to cast+ // from PgfCombine2State to PgfReasonerState+ PgfReasonerState base;+ GuBuf* parents;+ PgfExprProb* ep;+ size_t n_choices;+ size_t choice;+} PgfCombine2State;++static int+cmp_expr_state(GuOrder* self, const void* a, const void* b)+{+ PgfReasonerState *st1 = *((PgfReasonerState **) a);+ PgfReasonerState *st2 = *((PgfReasonerState **) b);+ + if (st1->prob < st2->prob)+ return -1;+ else if (st1->prob > st2->prob)+ return 1;+ else+ return 0;+}++static GuOrder+pgf_expr_state_order = { cmp_expr_state };++#ifdef PGF_REASONER_DEBUG+static void+pgf_print_parent_state(PgfReasoner* rs, PgfExprState* st,+ GuOut* out, GuExn* err, GuBuf* stack)+{+ gu_buf_push(stack, int, (st->n_args - st->arg_idx - 1));++ PgfExprState* parent = gu_buf_get(st->answers->parents, PgfExprState*, 0);+ if (&parent->base.header != rs->start)+ pgf_print_parent_state(rs, parent, out, err, stack);++ gu_puts(" (", out, err);+ pgf_print_expr(st->expr, NULL, 0, out, err);+}++static void+pgf_print_expr_state(PgfReasoner* rs, PgfExprState* st,+ GuOut* out, GuExn* err, GuPool* tmp_pool)+{ + gu_printf(out, err, "[%f] ", st->base.prob);++ GuBuf* stack = gu_new_buf(int, tmp_pool);+ if (st->n_args > 0)+ gu_buf_push(stack, int, st->n_args - st->arg_idx);++ PgfExprState* cont =+ gu_buf_get(st->answers->parents, PgfExprState*, 0);+ if (&cont->base.header != rs->start)+ pgf_print_parent_state(rs, cont, out, err, stack);++ if (st->n_args > 0)+ gu_puts(" (", out, err);+ else+ gu_puts(" ", out, err);+ pgf_print_expr(st->expr, NULL, 0, out, err);++ size_t n_counts = gu_buf_length(stack);+ for (size_t i = 0; i < n_counts; i++) {+ int count = gu_buf_get(stack, int, i);+ while (count-- > 0)+ gu_puts(" ?", out, err);+ + gu_puts(")", out, err);+ }+ gu_puts("\n", out, err);+}+#endif++static PgfExprState*+pgf_combine1_to_expr(PgfCombine1State* st, GuPool* pool, GuPool* out_pool) {+ PgfExprProb* ep =+ gu_buf_get(st->exprs, PgfExprProb*, st->choice);++ PgfExprState* nst = gu_new(PgfExprState, pool);+ nst->base.header.code = st->parent->base.header.code;+ nst->base.prob = st->base.prob;+ nst->answers = st->parent->answers;+ nst->expr =+ gu_new_variant_i(out_pool, PGF_EXPR_APP,+ PgfExprApp,+ .fun = st->parent->expr,+ .arg = ep->expr);+#ifdef PGF_REASONER_DEBUG+ nst->base.print = (PgfStatePrinter) pgf_print_expr_state;+ nst->n_args = st->parent->n_args;+ nst->arg_idx = st->parent->arg_idx+1;+#endif++ return nst;+}++static PgfExprState*+pgf_combine2_to_expr(PgfReasoner* rs, PgfCombine2State* st,+ GuPool* pool, GuPool* out_pool)+{+ PgfExprState* parent =+ gu_buf_get(st->parents, PgfExprState*, st->choice);+ if (&parent->base.header == rs->start)+ return NULL;++ PgfExprState* nst =+ gu_new(PgfExprState, pool);+ nst->base.header.code = parent->base.header.code;+ nst->base.prob = st->base.prob;+ nst->answers = parent->answers;+ nst->expr =+ gu_new_variant_i(out_pool, PGF_EXPR_APP,+ PgfExprApp,+ .fun = parent->expr,+ .arg = st->ep->expr);+#ifdef PGF_REASONER_DEBUG+ nst->base.print = (PgfStatePrinter) pgf_print_expr_state;+ nst->n_args = parent->n_args;+ nst->arg_idx = parent->arg_idx+1;+#endif++ return nst;+}++#ifdef PGF_REASONER_DEBUG+static void+pgf_print_combine1_state(PgfReasoner* rs, PgfCombine1State* st,+ GuOut* out, GuExn* err, GuPool* tmp_pool)+{+ PgfExprState* nst = pgf_combine1_to_expr(st, tmp_pool, tmp_pool);+ pgf_print_expr_state(rs, nst, out, err, tmp_pool);+}++static void+pgf_print_combine2_state(PgfReasoner* rs, PgfCombine2State* st,+ GuOut* out, GuExn* err, GuPool* tmp_pool)+{+ PgfExprState* nst = pgf_combine2_to_expr(rs, st, tmp_pool, tmp_pool);+ if (nst != NULL)+ pgf_print_expr_state(rs, nst, out, err, tmp_pool);+}+#endif++PGF_INTERNAL void+pgf_reasoner_combine1(PgfReasoner* rs, PgfClosure* closure)+{+ PgfCombine1State* st = (PgfCombine1State*) closure;+ PgfExprState* nst = pgf_combine1_to_expr(st, rs->pool, rs->out_pool);+ rs->eval_gates->enter(rs, &nst->base.header);++ st->choice++;++ if (st->choice < st->n_choices) {+ PgfExprProb* ep =+ gu_buf_get(st->exprs, PgfExprProb*, st->choice);++ st->base.prob = st->parent->base.prob + ep->prob;+ gu_buf_heap_push(rs->pqueue, &pgf_expr_state_order, &st);+ }+}++PGF_INTERNAL void+pgf_reasoner_try_first(PgfReasoner* rs, PgfExprState* parent, PgfAbsFun* absfun)+{+ PgfCId cat = absfun->type->cid;++ PgfAnswers* answers = gu_map_get(rs->table, cat, PgfAnswers*);+ if (answers == NULL) {+ answers = gu_new(PgfAnswers, rs->pool);+ answers->parents = gu_new_buf(PgfExprState*, rs->pool);+ answers->exprs = gu_new_buf(PgfExprProb*, rs->pool);+ answers->outside_prob = parent->base.prob;++ gu_map_put(rs->table, cat, PgfAnswers*, answers);+ }++ gu_buf_push(answers->parents, PgfExprState*, parent);++ if (gu_buf_length(answers->parents) == 1) {+ PgfExprState* st = gu_new(PgfExprState, rs->pool);+ st->base.header.code = absfun->predicate;+ st->base.prob = answers->outside_prob + absfun->ep.prob;+ st->answers = answers;+ st->expr = absfun->ep.expr;+#ifdef PGF_REASONER_DEBUG+ st->base.print = (PgfStatePrinter) pgf_print_expr_state;+ st->n_args = gu_seq_length(absfun->type->hypos);+ st->arg_idx = 0;+#endif+ gu_buf_heap_push(rs->pqueue, &pgf_expr_state_order, &st);+ } else {+ size_t n_exprs = gu_buf_length(answers->exprs);+ if (n_exprs > 0) {+ PgfExprProb* ep =+ gu_buf_get(answers->exprs, PgfExprProb*, 0);++ PgfCombine1State* nst = gu_new(PgfCombine1State, rs->pool);+ nst->base.header.code = rs->eval_gates->combine1;+ nst->base.prob = parent->base.prob + ep->prob;+ nst->exprs = answers->exprs;+ nst->choice = 0;+ nst->n_choices = gu_buf_length(answers->exprs);+ nst->parent = parent;+#ifdef PGF_REASONER_DEBUG+ nst->base.print = (PgfStatePrinter) pgf_print_combine1_state;+#endif+ gu_buf_heap_push(rs->pqueue, &pgf_expr_state_order, &nst);+ }+ }+}++PGF_INTERNAL void+pgf_reasoner_try_else(PgfReasoner* rs, PgfExprState* prev, PgfAbsFun* absfun)+{+ PgfExprState *st = gu_new(PgfExprState, rs->pool);+ st->base.header.code = absfun->predicate;+ st->base.prob = prev->answers->outside_prob + absfun->ep.prob;+ st->answers = prev->answers;+ st->expr = absfun->ep.expr;+#ifdef PGF_REASONER_DEBUG+ st->base.print = (PgfStatePrinter) pgf_print_expr_state;+ st->n_args = gu_seq_length(absfun->type->hypos);+ st->arg_idx = 0;+#endif+ gu_buf_heap_push(rs->pqueue, &pgf_expr_state_order, &st);+}++PGF_INTERNAL void+pgf_reasoner_combine2(PgfReasoner* rs, PgfClosure* closure)+{+ PgfCombine2State* st = (PgfCombine2State*) closure;+ PgfExprState* nst = pgf_combine2_to_expr(rs, st, rs->pool, rs->out_pool);+ if (nst != NULL) {+ rs->eval_gates->enter(rs, &nst->base.header);+ }++ st->choice++;++ if (st->choice < st->n_choices) {+ PgfExprState* parent =+ gu_buf_get(st->parents, PgfExprState*, st->choice);++ st->base.prob = parent->base.prob + st->ep->prob;+ gu_buf_heap_push(rs->pqueue, &pgf_expr_state_order, &st);+ }+}++PGF_INTERNAL void+pgf_reasoner_complete(PgfReasoner* rs, PgfExprState* st)+{+ PgfExprProb* ep = gu_new(PgfExprProb, rs->out_pool);+ ep->prob = st->base.prob - st->answers->outside_prob;+ ep->expr = st->expr;+ gu_buf_push(st->answers->exprs, PgfExprProb*, ep);++ PgfCombine2State* nst = gu_new(PgfCombine2State, rs->pool);+ nst->base.header.code = rs->eval_gates->combine2;+ nst->base.prob = st->base.prob;+ nst->parents = st->answers->parents;+ nst->choice = 0;+ nst->n_choices = gu_buf_length(st->answers->parents);+ nst->ep = ep;+#ifdef PGF_REASONER_DEBUG+ nst->base.print = (PgfStatePrinter) pgf_print_combine2_state;+#endif+ rs->eval_gates->enter(rs, &nst->base.header);+}++PGF_INTERNAL void+pgf_reasoner_try_constant(PgfReasoner* rs, PgfExprState* prev, PgfAbsFun* absfun)+{+ pgf_reasoner_try_else(rs, prev, absfun);+ pgf_reasoner_complete(rs, prev);+}++static void+pgf_reasoner_mk_literal(PgfReasoner* rs, PgfExprState* parent,+ GuString cat, PgfExpr expr)+{+ PgfAnswers* answers = gu_map_get(rs->table, cat, PgfAnswers*);+ if (answers == NULL) {+ answers = gu_new(PgfAnswers, rs->pool);+ answers->parents = gu_new_buf(PgfExprState*, rs->pool);+ answers->exprs = gu_new_buf(PgfExprProb*, rs->pool);+ answers->outside_prob = parent->base.prob;++ gu_map_put(rs->table, cat, PgfAnswers*, answers);+ }++ gu_buf_push(answers->parents, PgfExprState*, parent);++ if (gu_buf_length(answers->parents) == 1) {+ PgfExprProb* ep = gu_new(PgfExprProb, rs->out_pool);+ ep->prob = 0;+ ep->expr = expr;+ gu_buf_push(answers->exprs, PgfExprProb*, ep);+ }++ if (&parent->base.header == rs->start)+ return;++ PgfExprProb* ep =+ gu_buf_get(answers->exprs, PgfExprProb*, 0);++ parent->expr =+ gu_new_variant_i(rs->out_pool,+ PGF_EXPR_APP,+ PgfExprApp,+ parent->expr, + ep->expr);+#ifdef PGF_REASONER_DEBUG+ parent->arg_idx++;+#endif+ parent->base.prob += ep->prob;+ gu_buf_heap_push(rs->pqueue, &pgf_expr_state_order, &parent);+}++PGF_INTERNAL void+pgf_reasoner_mk_string(PgfReasoner* rs, PgfExprState* parent)+{+ pgf_reasoner_mk_literal(rs, parent, "String",+ pgf_expr_string("__mock_string__", rs->out_pool));+}++PGF_INTERNAL void+pgf_reasoner_mk_int(PgfReasoner* rs, PgfExprState* parent)+{+ pgf_reasoner_mk_literal(rs, parent, "Int",+ pgf_expr_int(999, rs->out_pool));+}++PGF_INTERNAL void+pgf_reasoner_mk_float(PgfReasoner* rs, PgfExprState* parent)+{+ pgf_reasoner_mk_literal(rs, parent, "Float",+ pgf_expr_float(999.99, rs->out_pool));+}++static PgfExprProb*+pgf_reasoner_next(PgfReasoner* rs)+{+ for (;;) {+ if (rs->n_reported_exprs < gu_buf_length(rs->exprs)) {+ return gu_buf_get(rs->exprs, PgfExprProb*, rs->n_reported_exprs++);+ }++ if (gu_buf_length(rs->pqueue) == 0)+ return NULL;++ PgfReasonerState* st;+ gu_buf_heap_pop(rs->pqueue, &pgf_expr_state_order, &st);++#ifdef PGF_REASONER_DEBUG+ {+ GuPool* tmp_pool = gu_new_pool();+ GuOut* out = gu_file_out(stderr, tmp_pool);+ GuExn* err = gu_exn(tmp_pool);+ st->print(rs, st, out, err, tmp_pool);+ gu_pool_free(tmp_pool);+ }+#endif++ rs->eval_gates->enter(rs, &st->header);+ }+}++static void+pgf_reasoner_enum_next(GuEnum* self, void* to, GuPool* pool)+{+ PgfReasoner* pr = gu_container(self, PgfReasoner, en);+ *(PgfExprProb**)to = pgf_reasoner_next(pr);+}++PGF_INTERNAL PgfReasoner*+pgf_new_reasoner(PgfPGF* pgf, GuExn* err, GuPool* pool, GuPool* out_pool)+{+ size_t n_cafs =+ (pgf->abstract.eval_gates->cafs == NULL) + ? 0 : gu_seq_length(pgf->abstract.eval_gates->cafs);++ PgfReasoner* rs = gu_new_flex(pool, PgfReasoner, cafs, n_cafs);+ rs->pool = pool,+ rs->out_pool = out_pool;+ rs->err = err;+ rs->abstract = &pgf->abstract,+ rs->table = gu_new_string_map(PgfAnswers*, &gu_null_struct, rs->pool),++ rs->start = NULL;+ rs->eval_gates = pgf->abstract.eval_gates;++ rs->pqueue = gu_new_buf(PgfReasonerState*, rs->pool);+ rs->exprs = gu_new_buf(PgfExprProb*, rs->pool);+ rs->n_reported_exprs = 0;+ rs->en.next = pgf_reasoner_enum_next;++ PgfFunction* cafs = gu_seq_data(rs->eval_gates->cafs);+ for (size_t i = 0; i < n_cafs; i++) {+ rs->cafs[i].header.code = cafs[i];+ rs->cafs[i].val = NULL;+ }++ return rs;+}++PGF_API PgfExprEnum*+pgf_generate_all(PgfPGF* pgf, PgfType* typ, GuExn* err, GuPool* pool, GuPool* out_pool)+{+ PgfReasoner* rs = pgf_new_reasoner(pgf, err, pool, out_pool);++ PgfAnswers* answers = gu_new(PgfAnswers, rs->pool);+ answers->parents = gu_new_buf(PgfExprState*, rs->pool);+ answers->exprs = rs->exprs;+ answers->outside_prob = 0;+ gu_map_put(rs->table, typ->cid, PgfAnswers*, answers);++ PgfAbsCat* abscat = gu_seq_binsearch(rs->abstract->cats, pgf_abscat_order, PgfAbsCat, typ->cid);+ if (abscat != NULL) {+ rs->start = gu_new(PgfClosure, rs->pool);+ rs->start->code = abscat->predicate;+ rs->eval_gates->enter(rs, rs->start);+ }++ return &rs->en;+}
@@ -0,0 +1,174 @@+#ifndef PGF_REASONER_H_+#define PGF_REASONER_H_++typedef GuStringMap PgfAbswersMap;++typedef struct PgfReasoner PgfReasoner;+typedef struct PgfReasonerState PgfReasonerState;+typedef struct PgfExprState PgfExprState;++typedef struct {+ PgfFunction code;+} PgfClosure;++typedef struct {+ PgfClosure header;+ PgfClosure* val;+} PgfIndirection;++typedef struct {+ PgfLiteral lit;+ GuBuf* consts;+ void* enter_stack_ptr;+} PgfEvalAccum;++struct PgfReasoner {+ GuPool* pool;+ GuPool* out_pool;+ PgfAbstr* abstract;+ PgfAbswersMap* table;+ GuBuf* pqueue;+ GuBuf* exprs;+ size_t n_reported_exprs;+ PgfClosure* start;+ PgfEvalGates* eval_gates; // cached from pgf->abstr->eval_gates+ GuExn* err;+ void* enter_stack_ptr;+ void* tmp; // for temporary register spills+ PgfExprEnum en;+ PgfIndirection cafs[]; // derived from gu_seq_data(pgf->abstr->eval_gates->cafs)+};++typedef struct PgfEnv PgfEnv;++struct PgfEnv {+ PgfEnv* next;+ PgfClosure* closure;+};++typedef struct {+ PgfClosure header;+ PgfEnv* env;+ PgfExpr expr;+} PgfExprThunk;++typedef struct {+ PgfClosure header;+ PgfClosure* con;+ PgfClosure* args[];+} PgfValue;++typedef struct {+ PgfClosure header;+ int level;+} PgfValueGen;++typedef struct {+ PgfClosure header;+ PgfEnv* env;+ PgfMetaId id;+} PgfValueMeta;++typedef struct {+ PgfClosure header;+ PgfLiteral lit;+} PgfValueLit;++typedef struct {+ PgfClosure header;+ PgfLiteral lit;+ GuBuf* consts;+} PgfValueSum;++typedef struct {+ PgfClosure header;+ PgfClosure* fun;+ size_t n_args;+ PgfClosure* args[];+} PgfValuePAP;++struct PgfEvalGates {+ PgfFunction evaluate_expr_thunk;+ PgfFunction evaluate_indirection;+ PgfFunction evaluate_value;+ PgfFunction evaluate_value_lit;+ PgfFunction evaluate_value_pap;+ PgfFunction evaluate_value_lambda;+ PgfFunction evaluate_value_const;+ PgfFunction evaluate_meta;+ PgfFunction evaluate_gen;+ PgfFunction evaluate_sum;+ PgfFunction evaluate_caf;++ PgfFunction update_closure;+ PgfFunction update_pap;++ PgfFunction mk_const;++ PgfFunction combine1;+ PgfFunction combine2;+ PgfFunction complete;++ PgfClosure* (*enter)(PgfReasoner* rs, PgfClosure* closure);++ GuFinalizer fin;+ GuSeq* cafs;+};++PGF_INTERNAL_DECL PgfReasoner*+pgf_new_reasoner(PgfPGF* pgf, GuExn* err, GuPool* pool, GuPool* out_pool);++PGF_INTERNAL_DECL void+pgf_reasoner_try_first(PgfReasoner* rs, PgfExprState* parent, PgfAbsFun* absfun);++PGF_INTERNAL_DECL void+pgf_reasoner_try_else(PgfReasoner* rs, PgfExprState* prev, PgfAbsFun* absfun);++PGF_INTERNAL_DECL void+pgf_reasoner_combine1(PgfReasoner* rs, PgfClosure* closure);++PGF_INTERNAL_DECL void+pgf_reasoner_combine2(PgfReasoner* rs, PgfClosure* closure);++PGF_INTERNAL_DECL void+pgf_reasoner_complete(PgfReasoner* rs, PgfExprState* st);++PGF_INTERNAL_DECL void+pgf_reasoner_try_constant(PgfReasoner* rs, PgfExprState* prev, PgfAbsFun* absfun);++PGF_INTERNAL_DECL void+pgf_reasoner_mk_string(PgfReasoner* rs, PgfExprState* parent);++PGF_INTERNAL_DECL void+pgf_reasoner_mk_int(PgfReasoner* rs, PgfExprState* parent);++PGF_INTERNAL_DECL void+pgf_reasoner_mk_float(PgfReasoner* rs, PgfExprState* parent);++PGF_INTERNAL_DECL PgfClosure*+pgf_evaluate_expr_thunk(PgfReasoner* rs, PgfExprThunk* thunk);++PGF_INTERNAL_DECL PgfClosure*+pgf_evaluate_lambda_application(PgfReasoner* rs, PgfExprThunk* lambda,+ PgfClosure* arg);++PGF_INTERNAL_DECL void+pgf_evaluate_accum_init_int(PgfReasoner* rs, + PgfEvalAccum* accum, int val);++PGF_INTERNAL_DECL void+pgf_evaluate_accum_init_str(PgfReasoner* rs, + PgfEvalAccum* accum, GuString val);+ +PGF_INTERNAL_DECL void+pgf_evaluate_accum_init_flt(PgfReasoner* rs, + PgfEvalAccum* accum, float val);++PGF_INTERNAL_DECL void+pgf_evaluate_accum_add(PgfReasoner* rs, + PgfEvalAccum* accum, PgfClosure* closure);++PGF_INTERNAL_DECL PgfClosure*+pgf_evaluate_accum_done(PgfReasoner* rs, PgfEvalAccum* accum);++#endif
@@ -0,0 +1,588 @@+#include "pgf.h"+#include "data.h"+#include "gu/mem.h"+#include "gu/string.h"++typedef struct PgfCFHypos PgfCFHypos;+struct PgfCFHypos {+ PgfType* ty;+ PgfCFHypos* next;+};++typedef struct PgfContext PgfContext;+struct PgfContext {+ PgfCId var;+ PgfType* ty;+ PgfContext* next;+};++typedef struct {+ PgfCFHypos* hypos;+ PgfCId cat;+} PgfCFType;++typedef struct {+ PgfAbstr* abstr;+ GuExn* exn;+ GuPool* pool;+ GuPool* tmp_pool;+ PgfMetaId meta_id;+} PgfTypeChecker;++static PgfCFType null_cf_type = { .hypos = NULL, .cat = NULL };++static PgfCFType +pgf_ty2cfty(PgfTypeChecker* checker, PgfType* ty)+{+ PgfCFHypos* hypos = NULL;+ size_t n_hypos = gu_seq_length(ty->hypos);+ while (n_hypos-- > 0) {+ PgfHypo* hypo = gu_seq_index(ty->hypos, PgfHypo, n_hypos);++ PgfCFHypos* new_hypos = gu_new(PgfCFHypos, checker->tmp_pool);+ new_hypos->ty = hypo->type;+ new_hypos->next = hypos;+ hypos = new_hypos;+ }+ return ((PgfCFType) { .hypos = hypos, .cat = ty->cid });+}++static PgfType*+pgf_cfty2ty(PgfTypeChecker* checker, PgfCFType cf_ty)+{+ PgfCFHypos* hypos;++ size_t n_hypos = 0;+ hypos = cf_ty.hypos;+ while (hypos != NULL) {+ n_hypos++;+ hypos = hypos->next;+ }++ PgfType* ty = gu_new(PgfType, checker->pool);+ ty->hypos = gu_new_seq(PgfHypo, n_hypos, checker->pool);+ ty->cid = cf_ty.cat;+ ty->n_exprs = 0;++ size_t i = 0;+ hypos = cf_ty.hypos;+ while (hypos != NULL) {+ PgfHypo* hypo = gu_seq_index(ty->hypos, PgfHypo, i++);+ hypo->bind_type = PGF_BIND_TYPE_EXPLICIT;+ hypo->cid = "_";+ hypo->type = pgf_cfty2ty(checker, pgf_ty2cfty(checker, hypos->ty));+ hypos = hypos->next;+ }++ return ty;+}++static PgfPrintContext*+pgf_tc_mk_print_context(PgfTypeChecker* checker, PgfContext* ctxt)+{+ PgfPrintContext* pctxt = NULL;+ PgfPrintContext** pprev = &pctxt;++ while (ctxt != NULL) {+ PgfPrintContext* new_pctxt =+ gu_new(PgfPrintContext, checker->tmp_pool);+ new_pctxt->name = ctxt->var;+ new_pctxt->next = NULL;++ *pprev = new_pctxt;+ pprev = &new_pctxt->next;++ ctxt = ctxt->next;+ }++ return pctxt;+}++static void+pgf_tc_err_cannot_infer(PgfTypeChecker* checker, PgfContext* ctxt, PgfExpr e)+{+ GuStringBuf* sbuf = gu_new_string_buf(checker->tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ GuExn* err = gu_exn(checker->tmp_pool);++ gu_puts("Cannot infer the type of expression ", out, err);+ pgf_print_expr(e, pgf_tc_mk_print_context(checker, ctxt), 0, out, err);++ GuExnData* exn = gu_raise(checker->exn, PgfTypeError);+ exn->data = (void*)+ gu_string_buf_freeze(sbuf, exn->pool);+}++static void+pgf_tc_err_exp_fun_type_1(PgfTypeChecker* checker, PgfContext* ctxt, + PgfExpr e, PgfType* ty)+{+ GuStringBuf* sbuf = gu_new_string_buf(checker->tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ GuExn* err = gu_exn(checker->tmp_pool);++ PgfPrintContext* pctxt = pgf_tc_mk_print_context(checker, ctxt);+ gu_puts("The expression ", out, err);+ pgf_print_expr(e, pctxt, 0, out, err);+ gu_puts(" is of function type but ", out, err);+ pgf_print_type(ty, pctxt, 0, out, err);+ gu_puts(" is expected", out, err);++ GuExnData* exn = gu_raise(checker->exn, PgfTypeError);+ exn->data = (void*)+ gu_string_buf_freeze(sbuf, exn->pool);+}++static void+pgf_tc_err_exp_fun_type_2(PgfTypeChecker* checker, PgfContext* ctxt, + PgfExpr e, PgfType* ty)+{+ GuStringBuf* sbuf = gu_new_string_buf(checker->tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ GuExn* err = gu_exn(checker->tmp_pool);++ PgfPrintContext* pctxt = pgf_tc_mk_print_context(checker, ctxt);+ gu_puts("A function type is expected for the expression ", out, err);+ pgf_print_expr(e, pctxt, 0, out, err);+ gu_puts(" instead of type ", out, err);+ pgf_print_type(ty, pctxt, 0, out, err);++ GuExnData* exn = gu_raise(checker->exn, PgfTypeError);+ exn->data = (void*)+ gu_string_buf_freeze(sbuf, exn->pool);+}++static void+pgf_tc_err_n_args(PgfTypeChecker* checker, + PgfAbsCat* abs_cat, size_t n_args)+{+ GuExnData* exn = gu_raise(checker->exn, PgfTypeError);+ exn->data = (void*)+ gu_format_string(exn->pool, + "The category %s has %d indices but %d are given",+ abs_cat->name,+ gu_seq_length(abs_cat->context),+ n_args);+}++static void+pgf_tc_err_type_mismatch(PgfTypeChecker* checker,+ PgfContext* ctxt,+ PgfExpr e, PgfCFType ty1, PgfCFType ty2)+{+ GuStringBuf* sbuf = gu_new_string_buf(checker->tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ GuExn* err = gu_exn(checker->tmp_pool);++ PgfPrintContext* pctxt = pgf_tc_mk_print_context(checker, ctxt);+ gu_puts("The expected type of the expression ", out, err);+ pgf_print_expr(e, pctxt, 0, out, err);+ gu_puts(" is ", out, err);+ pgf_print_type(pgf_cfty2ty(checker, ty1), pctxt, 0, out, err);+ gu_puts(" but ", out, err);+ pgf_print_type(pgf_cfty2ty(checker, ty2), pctxt, 0, out, err);+ gu_puts(" is infered", out, err);++ GuExnData* exn = gu_raise(checker->exn, PgfTypeError);+ exn->data = (void*)+ gu_string_buf_freeze(sbuf, exn->pool);+}++static bool+pgf_unify_types(PgfTypeChecker* checker, PgfCFType ty1, PgfCFType ty2)+{+ if (strcmp(ty1.cat, ty2.cat) != 0)+ return false;+ + while (ty1.hypos != NULL && ty2.hypos != NULL) {+ if (!pgf_unify_types(checker,+ pgf_ty2cfty(checker, ty1.hypos->ty),+ pgf_ty2cfty(checker, ty2.hypos->ty)))+ return false;++ ty1.hypos = ty1.hypos->next;+ ty2.hypos = ty2.hypos->next;+ }+ + if (ty1.hypos != NULL || ty2.hypos != NULL)+ return false;++ return true;+}++static PgfCFType+pgf_inf_expr(PgfTypeChecker* checker, PgfContext* ctxt, PgfExpr* pe);++static void+pgf_tc_expr(PgfTypeChecker* checker,+ PgfContext* ctxt, PgfExpr* pe, PgfCFType ty)+{+ GuVariantInfo i = gu_variant_open(*pe);+ switch (i.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* eabs = i.data;++ if (ty.hypos == NULL) {+ pgf_tc_err_exp_fun_type_1(checker, ctxt, *pe, pgf_cfty2ty(checker, ty));+ return;+ }++ PgfContext* new_ctxt = gu_new(PgfContext, checker->tmp_pool);+ new_ctxt->var = eabs->id;+ new_ctxt->ty = ty.hypos->ty;+ new_ctxt->next = ctxt;++ PgfExprAbs* new_eabs =+ gu_new_variant(PGF_EXPR_ABS,+ PgfExprAbs,+ pe, checker->pool);+ new_eabs->bind_type = eabs->bind_type;+ new_eabs->id = gu_string_copy(eabs->id, checker->pool);+ new_eabs->body = eabs->body;++ PgfCFType new_ty = { .hypos = ty.hypos->next, .cat = ty.cat };+ pgf_tc_expr(checker, new_ctxt, &new_eabs->body, new_ty);+ break;+ }+ case PGF_EXPR_LIT:+ case PGF_EXPR_APP:+ case PGF_EXPR_FUN:+ case PGF_EXPR_VAR:+ case PGF_EXPR_TYPED: {+ PgfCFType inf_ty =+ pgf_inf_expr(checker, ctxt, pe);+ if (!gu_ok(checker->exn))+ return;+ if (!pgf_unify_types(checker, ty, inf_ty)) {+ pgf_tc_err_type_mismatch(checker, ctxt, *pe, ty, inf_ty);+ return;+ }+ break;+ }+ case PGF_EXPR_META: {+ PgfExprMeta* new_emeta =+ gu_new_variant(PGF_EXPR_META,+ PgfExprMeta,+ pe, checker->pool);+ new_emeta->id = checker->meta_id++;+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = i.data;+ + PgfExprImplArg* new_eimpl =+ gu_new_variant(PGF_EXPR_IMPL_ARG,+ PgfExprImplArg,+ pe, checker->pool);+ new_eimpl->expr = eimpl->expr;+ pgf_tc_expr(checker, ctxt, &new_eimpl->expr, ty);+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_tc_type(PgfTypeChecker* checker, PgfType** pty)+{+ PgfType* ty = *pty;++ PgfAbsCat* abs_cat =+ gu_seq_binsearch(checker->abstr->cats, pgf_abscat_order, PgfAbsCat, ty->cid);+ if (abs_cat == NULL) {+ GuExnData* exn = gu_raise(checker->exn, PgfExn);+ exn->data = (void*)+ gu_format_string(exn->pool,+ "Unknown category \"%s\"", ty->cid);+ return;+ }++ PgfContext* ctxt = NULL;++ size_t n_hypos = gu_seq_length(ty->hypos);+ PgfHypos* new_hypos = gu_new_seq(PgfHypo, n_hypos, checker->pool);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(ty->hypos, PgfHypo, i);+ PgfHypo* new_hypo = gu_seq_index(new_hypos, PgfHypo, i);++ new_hypo->bind_type = hypo->bind_type;+ new_hypo->cid = gu_string_copy(hypo->cid, checker->pool);+ new_hypo->type = hypo->type;++ pgf_tc_type(checker, &new_hypo->type);+ if (!gu_ok(checker->exn))+ return;+ + PgfContext* new_ctxt = gu_new(PgfContext, checker->tmp_pool);+ new_ctxt->var = hypo->cid;+ new_ctxt->ty = hypo->type;+ new_ctxt->next = ctxt;+ ctxt = new_ctxt;+ }++ PgfType *new_ty =+ gu_new_flex(checker->pool, PgfType, exprs, ty->n_exprs);+ new_ty->hypos = new_hypos;+ new_ty->cid = gu_string_copy(ty->cid, checker->pool);+ new_ty->n_exprs = ty->n_exprs;++ if (gu_seq_length(abs_cat->context) != ty->n_exprs) {+ pgf_tc_err_n_args(checker, abs_cat, ty->n_exprs);+ return;+ }++ for (size_t i = 0; i < ty->n_exprs; i++) {+ PgfHypo* hypo = gu_seq_index(abs_cat->context, PgfHypo, i);++ new_ty->exprs[i] = ty->exprs[i];+ pgf_tc_expr(checker, ctxt, &new_ty->exprs[i], pgf_ty2cfty(checker, hypo->type));+ if (!gu_ok(checker->exn))+ return;+ }++ *pty = new_ty;+}++static PgfCFType+pgf_inf_expr(PgfTypeChecker* checker, PgfContext* ctxt, PgfExpr* pe)+{+ GuVariantInfo i = gu_variant_open(*pe);+ switch (i.tag) {+ case PGF_EXPR_ABS: {+ pgf_tc_err_cannot_infer(checker, ctxt, *pe);+ return null_cf_type;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* eapp = i.data;++ PgfExprApp* new_eapp =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ pe, checker->pool);+ new_eapp->fun = eapp->fun;+ new_eapp->arg = eapp->arg;++ PgfCFType fun_ty =+ pgf_inf_expr(checker, ctxt, &new_eapp->fun);+ if (!gu_ok(checker->exn))+ return null_cf_type;+ if (fun_ty.hypos == NULL) {+ pgf_tc_err_exp_fun_type_2(checker,+ ctxt,+ eapp->fun, pgf_cfty2ty(checker, fun_ty));+ return null_cf_type;+ }++ pgf_tc_expr(checker, ctxt, &new_eapp->arg, pgf_ty2cfty(checker, fun_ty.hypos->ty));+ return ((PgfCFType) { .hypos = fun_ty.hypos->next,+ .cat = fun_ty.cat+ });+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = i.data;++ PgfExprLit* new_elit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ pe, checker->pool);++ GuVariantInfo i = gu_variant_open(elit->lit);+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = i.data;++ PgfLiteralStr* new_lstr =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(lstr->val)+1,+ &new_elit->lit, checker->pool);+ strcpy(new_lstr->val, lstr->val);++ return ((PgfCFType) { .hypos = NULL, .cat = "String" });+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = i.data;++ PgfLiteralInt* new_lint =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &new_elit->lit, checker->pool);+ new_lint->val = lint->val;++ return ((PgfCFType) { .hypos = NULL, .cat = "Int" });+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = i.data;++ PgfLiteralFlt* new_lflt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &new_elit->lit, checker->pool);+ new_lflt->val = lflt->val;++ return ((PgfCFType) { .hypos = NULL, .cat = "Float" });+ }+ default:+ gu_impossible();+ }+ break;+ }+ case PGF_EXPR_META: {+ pgf_tc_err_cannot_infer(checker, ctxt, *pe);+ return null_cf_type;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* efun = i.data;++ PgfType* ty = NULL;++ int var = 0;+ PgfContext* var_ctxt = ctxt;+ while (var_ctxt != NULL) {+ if (strcmp(var_ctxt->var, efun->fun) == 0) {+ PgfExprVar* new_evar =+ gu_new_variant(PGF_EXPR_VAR,+ PgfExprVar,+ pe, checker->pool);+ new_evar->var = var;+ ty = var_ctxt->ty;+ break;+ }++ var++;+ var_ctxt = var_ctxt->next;+ }++ if (ty == NULL) {+ PgfAbsFun* abs_fun =+ gu_seq_binsearch(checker->abstr->funs, pgf_absfun_order, PgfAbsFun, efun->fun);+ if (abs_fun == NULL) {+ GuExnData* exn = gu_raise(checker->exn, PgfExn);+ exn->data = (void*)+ gu_format_string(exn->pool, + "Unknown function \"%s\"", efun->fun);+ return null_cf_type;+ } else {+ PgfExprFun *new_efun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(efun->fun)+1,+ pe, checker->pool);+ strcpy(new_efun->fun, efun->fun);+ ty = abs_fun->type;+ }+ }++ return pgf_ty2cfty(checker, ty);+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* evar = i.data;++ int var = evar->var;+ PgfContext* var_ctxt = ctxt;+ assert(var_ctxt != NULL);+ while (var > 0) {+ var--;+ var_ctxt = var_ctxt->next;+ assert(var_ctxt != NULL);+ }++ return pgf_ty2cfty(checker, var_ctxt->ty);+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = i.data;+ + PgfExprTyped* new_etyped =+ gu_new_variant(PGF_EXPR_TYPED,+ PgfExprTyped,+ pe, checker->pool);+ new_etyped->expr = etyped->expr;+ new_etyped->type = etyped->type;++ pgf_tc_type(checker, &new_etyped->type);+ if (!gu_ok(checker->exn))+ return null_cf_type;++ PgfCFType cf_ty = pgf_ty2cfty(checker, new_etyped->type);++ pgf_tc_expr(checker, ctxt, &new_etyped->expr, cf_ty);+ return cf_ty;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = i.data;+ + PgfExprImplArg* new_eimpl =+ gu_new_variant(PGF_EXPR_IMPL_ARG,+ PgfExprImplArg,+ pe, checker->pool);+ new_eimpl->expr = eimpl->expr;+ return pgf_inf_expr(checker, ctxt, &new_eimpl->expr);+ }+ default:+ gu_impossible();+ }++ return null_cf_type;+}++PGF_API void+pgf_check_expr(PgfPGF* gr, PgfExpr* pe, PgfType* ty,+ GuExn* exn, GuPool* pool)+{+ GuPool* tmp_pool = gu_new_pool();+ + PgfTypeChecker* checker = gu_new(PgfTypeChecker, tmp_pool);+ checker->abstr = &gr->abstract;+ checker->exn = exn;+ checker->pool = pool;+ checker->tmp_pool = tmp_pool;+ checker->meta_id = 1;+ + pgf_tc_expr(checker, NULL, pe, pgf_ty2cfty(checker, ty));+ + gu_pool_free(tmp_pool);+}++PGF_API PgfType*+pgf_infer_expr(PgfPGF* gr, PgfExpr* pe,+ GuExn* exn, GuPool* pool)+{+ GuPool* tmp_pool = gu_new_pool();+ + PgfTypeChecker* checker = gu_new(PgfTypeChecker, tmp_pool);+ checker->abstr = &gr->abstract;+ checker->exn = exn;+ checker->pool = pool;+ checker->tmp_pool = tmp_pool;+ checker->meta_id = 1;++ PgfCFType cf_ty = pgf_inf_expr(checker, NULL, pe);+ + PgfType* ty = NULL;+ if (gu_ok(exn)) {+ ty = pgf_cfty2ty(checker, cf_ty);+ }++ gu_pool_free(tmp_pool);++ return ty;+}++PGF_API void+pgf_check_type(PgfPGF* gr, PgfType** pty, + GuExn* exn, GuPool* pool)+{+ GuPool* tmp_pool = gu_new_pool();+ + PgfTypeChecker* checker = gu_new(PgfTypeChecker, tmp_pool);+ checker->abstr = &gr->abstract;+ checker->exn = exn;+ checker->pool = pool;+ checker->tmp_pool = tmp_pool;+ checker->meta_id = 1;++ pgf_tc_type(checker, pty);++ gu_pool_free(tmp_pool);+}
@@ -0,0 +1,922 @@+#include "data.h"+#include "expr.h"+#include "writer.h"++#include <gu/defs.h>+#include <gu/map.h>+#include <gu/seq.h>+#include <gu/assert.h>+#include <gu/in.h>+#include <gu/bits.h>+#include <gu/exn.h>+#include <gu/utf8.h>+#include <math.h>+#include <stdio.h>+#include <stdlib.h>+#if defined(__MINGW32__) || defined(_MSC_VER)+#include <malloc.h>+#endif++//+// PgfWriter+// ++struct PgfWriter {+ GuOut* out;+ GuExn* err;+};++PGF_INTERNAL void+pgf_write_tag(uint8_t tag, PgfWriter* wtr)+{+ gu_out_u8(wtr->out, tag, wtr->err);+}++PGF_INTERNAL void+pgf_write_uint(uint32_t val, PgfWriter* wtr)+{+ for (;;) {+ uint8_t b = val & 0x7F;+ val = val >> 7;+ if (val == 0) {+ gu_out_u8(wtr->out, b, wtr->err);+ break;+ } else {+ gu_out_u8(wtr->out, b | 0x80, wtr->err);+ gu_return_on_exn(wtr->err, );+ }+ }+}++PGF_INTERNAL void+pgf_write_int(int32_t val, PgfWriter* wtr)+{+ pgf_write_uint((uint32_t) val, wtr);+}++PGF_INTERNAL void+pgf_write_len(size_t len, PgfWriter* wtr)+{+ pgf_write_int(len, wtr);+}++PGF_INTERNAL void+pgf_write_cid(PgfCId id, PgfWriter* wtr)+{+ size_t len = strlen(id);+ pgf_write_len(len, wtr);+ gu_return_on_exn(wtr->err, );+ gu_out_bytes(wtr->out, (uint8_t*) id, len, wtr->err);+}++PGF_INTERNAL void+pgf_write_string(GuString val, PgfWriter* wtr)+{ + size_t len = strlen(val);+ pgf_write_len(len, wtr);+ gu_return_on_exn(wtr->err, );+ gu_out_bytes(wtr->out, (uint8_t*) val, len, wtr->err);+}++PGF_INTERNAL void+pgf_write_double(double val, PgfWriter* wtr)+{+ gu_out_f64be(wtr->out, val, wtr->err);+}++static void+pgf_write_literal(PgfLiteral lit, PgfWriter* wtr)+{+ GuVariantInfo i = gu_variant_open(lit);+ pgf_write_tag(i.tag, wtr);+ gu_return_on_exn(wtr->err, );+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr *lstr = i.data;+ pgf_write_string(lstr->val, wtr);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt *lint = i.data;+ pgf_write_int(lint->val, wtr);+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt *lflt = i.data;+ pgf_write_double(lflt->val, wtr);+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_write_flags(PgfFlags* flags, PgfWriter* wtr)+{+ size_t n_flags = gu_seq_length(flags);+ pgf_write_len(n_flags, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < n_flags; i++) {+ PgfFlag* flag = gu_seq_index(flags, PgfFlag, i);++ pgf_write_cid(flag->name, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_literal(flag->value, wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_type_(PgfType* type, PgfWriter* wtr);++static void+pgf_write_expr_(PgfExpr expr, PgfWriter* wtr)+{+ GuVariantInfo i = gu_variant_open(expr);+ pgf_write_tag(i.tag, wtr);+ gu_return_on_exn(wtr->err, );+ switch (i.tag) {+ case PGF_EXPR_ABS:{+ PgfExprAbs *eabs = i.data;++ pgf_write_tag(eabs->bind_type, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_cid(eabs->id, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_expr_(eabs->body, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp *eapp = i.data;++ pgf_write_expr_(eapp->fun, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_expr_(eapp->arg, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit *elit = i.data;+ pgf_write_literal(elit->lit, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_EXPR_META: {+ PgfExprMeta *emeta = i.data;+ pgf_write_int(emeta->id, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun *efun = i.data;+ pgf_write_cid(efun->fun, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar *evar = i.data;+ pgf_write_int(evar->var, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped *etyped = i.data;+ pgf_write_expr_(etyped->expr, wtr);+ gu_return_on_exn(wtr->err, );+ pgf_write_type_(etyped->type, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg *eimpl = i.data;+ pgf_write_expr_(eimpl->expr, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_write_hypo(PgfHypo* hypo, PgfWriter* wtr)+{+ pgf_write_tag(hypo->bind_type, wtr);+ gu_return_on_exn(wtr->err, );+ + pgf_write_cid(hypo->cid, wtr);+ gu_return_on_exn(wtr->err, );+ + pgf_write_type_(hypo->type, wtr);+ gu_return_on_exn(wtr->err, );+}++static void+pgf_write_type_(PgfType* type, PgfWriter* wtr)+{+ size_t n_hypos = gu_seq_length(type->hypos);+ pgf_write_len(n_hypos, wtr);+ gu_return_on_exn(wtr->err, );+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(type->hypos, PgfHypo, i);+ pgf_write_hypo(hypo, wtr);+ gu_return_on_exn(wtr->err, );+ }++ pgf_write_cid(type->cid, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_len(type->n_exprs, wtr);++ for (size_t i = 0; i < type->n_exprs; i++) {+ pgf_write_expr_(type->exprs[i], wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_patt(PgfPatt patt, PgfWriter* wtr)+{+ GuVariantInfo i = gu_variant_open(patt);+ switch (i.tag) {+ case PGF_PATT_APP: {+ PgfPattApp *papp = i.data;+ pgf_write_cid(papp->ctor, wtr);+ gu_return_on_exn(wtr->err, );+ + pgf_write_len(papp->n_args, wtr);+ gu_return_on_exn(wtr->err, );+ + for (size_t i = 0; i < papp->n_args; i++) {+ pgf_write_patt(papp->args[i], wtr);+ gu_return_on_exn(wtr->err, );+ }+ break;+ }+ case PGF_PATT_VAR: {+ PgfPattVar *papp = i.data;+ pgf_write_cid(papp->var, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_PATT_AS: {+ PgfPattAs *pas = i.data;+ pgf_write_cid(pas->var, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_patt(pas->patt, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_PATT_WILD: {+ PgfPattWild* pwild = i.data;+ ((void) pwild);+ break;+ }+ case PGF_PATT_LIT: {+ PgfPattLit *plit = i.data;+ pgf_write_literal(plit->lit, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_PATT_IMPL_ARG: {+ PgfPattImplArg *pimpl = i.data;+ pgf_write_patt(pimpl->patt, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_PATT_TILDE: {+ PgfPattTilde *ptilde = i.data;+ pgf_write_expr_(ptilde->expr, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_write_absfun(PgfAbsFun* absfun, PgfWriter* wtr)+{+ pgf_write_cid(absfun->name,wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_type_(absfun->type, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_int(absfun->arity, wtr);++ pgf_write_tag((absfun->defns == NULL) ? 0 : 1, wtr);+ gu_return_on_exn(wtr->err, );+ + if (absfun->defns != NULL) {+ size_t length = gu_seq_length(absfun->defns);+ pgf_write_len(length, wtr);+ gu_return_on_exn(wtr->err, );++ PgfEquation** data = gu_seq_data(absfun->defns);+ for (size_t i = 0; i < length; i++) {+ PgfEquation *equ = data[i];++ pgf_write_len(equ->n_patts, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t j = 0; j < equ->n_patts; j++) {+ pgf_write_patt(equ->patts[j], wtr);+ gu_return_on_exn(wtr->err, );+ }+ pgf_write_expr_(equ->body, wtr);+ gu_return_on_exn(wtr->err, );+ }+ }++ pgf_write_double(exp(-absfun->ep.prob), wtr);+}++static void+pgf_write_absfuns(PgfAbsFuns* absfuns, PgfWriter* wtr)+{+ size_t n_funs = gu_seq_length(absfuns);+ pgf_write_len(n_funs, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun* absfun = gu_seq_index(absfuns, PgfAbsFun, i);+ pgf_write_absfun(absfun, wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_abscat(PgfAbsCat* abscat, PgfAbstr* abstr, PgfWriter* wtr)+{+ pgf_write_cid(abscat->name, wtr);+ gu_return_on_exn(wtr->err, );++ size_t n_hypos = gu_seq_length(abscat->context);+ pgf_write_len(n_hypos, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(abscat->context, PgfHypo, i);+ pgf_write_hypo(hypo, wtr);+ gu_return_on_exn(wtr->err, );+ }++ size_t n_count = 0;+ size_t n_funs = gu_seq_length(abstr->funs);+ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun* fun = gu_seq_index(abstr->funs, PgfAbsFun, i);++ if (strcmp(fun->type->cid, abscat->name) == 0) {+ n_count++;+ }+ }+ pgf_write_len(n_count, wtr);+ for (size_t i = 0; i < n_funs; i++) {+ PgfAbsFun* fun = gu_seq_index(abstr->funs, PgfAbsFun, i);++ if (strcmp(fun->type->cid, abscat->name) == 0) {+ gu_out_f64be(wtr->out, exp(-fun->ep.prob), wtr->err); // ignore+ gu_return_on_exn(wtr->err, );++ pgf_write_cid(fun->name, wtr);+ gu_return_on_exn(wtr->err, );+ }+ }+ + pgf_write_double(exp(-abscat->prob), wtr);+}++static void+pgf_write_abscats(PgfAbsCats* abscats, PgfAbstr* abstr, PgfWriter* wtr)+{+ size_t n_cats = gu_seq_length(abscats);+ pgf_write_len(n_cats, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < n_cats; i++) {+ PgfAbsCat* abscat = gu_seq_index(abscats, PgfAbsCat, i);+ pgf_write_abscat(abscat, abstr, wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_abstract(PgfAbstr* abstr, PgfWriter* wtr)+{+ pgf_write_cid(abstr->name, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_flags(abstr->aflags, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_absfuns(abstr->funs, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_abscats(abstr->cats, abstr, wtr);+ gu_return_on_exn(wtr->err, );+}++typedef struct {+ GuMapItor itor;+ PgfWriter* wtr;+} PgfWriterIter;++static void+pgf_write_printname(GuMapItor* self, const void* key, void* value, GuExn *err)+{+ PgfWriterIter* itor = gu_container(self, PgfWriterIter, itor);+ PgfCId id = key;+ GuString name = value;+ + pgf_write_cid(id, itor->wtr);+ gu_return_on_exn(err, );++ pgf_write_string(name, itor->wtr);+ gu_return_on_exn(err, );+}++static void+pgf_write_printnames(PgfCIdMap* printnames, PgfWriter* wtr)+{+ pgf_write_len(gu_map_count(printnames), wtr);+ gu_return_on_exn(wtr->err, );++ PgfWriterIter itor;+ itor.itor.fn = pgf_write_printname;+ itor.wtr = wtr;+ gu_map_iter(printnames, &itor.itor, wtr->err);+ gu_return_on_exn(wtr->err, );+}++static void+pgf_write_symbols(PgfSymbols*, PgfWriter* wtr);++static void+pgf_write_alternative(PgfAlternative* alt, PgfWriter* wtr)+{+ pgf_write_symbols(alt->form, wtr);+ gu_return_on_exn(wtr->err,);++ size_t n_prefixes = gu_seq_length(alt->prefixes);+ pgf_write_len(n_prefixes, wtr);+ gu_return_on_exn(wtr->err,);++ for (size_t i = 0; i < n_prefixes; i++) {+ GuString prefix = gu_seq_get(alt->prefixes, GuString, i);++ pgf_write_string(prefix, wtr);+ gu_return_on_exn(wtr->err,);+ }+}++static void+pgf_write_symbol(PgfSymbol sym, PgfWriter* wtr)+{+ GuVariantInfo i = gu_variant_open(sym);++ pgf_write_tag(i.tag, wtr);+ switch (i.tag) {+ case PGF_SYMBOL_CAT: {+ PgfSymbolCat *sym_cat = i.data;++ pgf_write_int(sym_cat->d, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_int(sym_cat->r, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_SYMBOL_LIT: {+ PgfSymbolLit *sym_lit = i.data;++ pgf_write_int(sym_lit->d, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_int(sym_lit->r, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_SYMBOL_VAR: {+ PgfSymbolVar *sym_var = i.data;++ pgf_write_int(sym_var->d, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_int(sym_var->r, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_SYMBOL_KS: {+ PgfSymbolKS *sym_ks = i.data;+ pgf_write_string(sym_ks->token, wtr);+ break;+ }+ case PGF_SYMBOL_KP: {+ PgfSymbolKP *sym_kp = i.data;+ pgf_write_symbols(sym_kp->default_form, wtr);+ gu_return_on_exn(wtr->err, );+ + pgf_write_len(sym_kp->n_forms, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < sym_kp->n_forms; i++) {+ pgf_write_alternative(&sym_kp->forms[i], wtr);+ gu_return_on_exn(wtr->err, );+ }+ break;+ }+ case PGF_SYMBOL_NE:+ case PGF_SYMBOL_BIND:+ case PGF_SYMBOL_SOFT_BIND:+ case PGF_SYMBOL_SOFT_SPACE:+ case PGF_SYMBOL_CAPIT:+ case PGF_SYMBOL_ALL_CAPIT: {+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_write_symbols(PgfSymbols* syms, PgfWriter* wtr)+{+ size_t len = gu_seq_length(syms);+ pgf_write_len(len, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < len; i++) {+ PgfSymbol sym = gu_seq_get(syms, PgfSymbol, i);+ pgf_write_symbol(sym, wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_sequences(PgfSequences* seqs, PgfWriter* wtr)+{+ size_t len = gu_seq_length(seqs);+ pgf_write_len(len, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < len; i++) {+ PgfSymbols* syms = gu_seq_index(seqs, PgfSequence, i)->syms;+ pgf_write_symbols(syms, wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_cncfun(PgfCncFun* cncfun, PgfConcr* concr, PgfWriter* wtr)+{+ pgf_write_cid(cncfun->absfun->name, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_len(cncfun->n_lins, wtr);+ gu_return_on_exn(wtr->err, );++ PgfSequence* data = gu_seq_data(concr->sequences);+ for (size_t i = 0; i < cncfun->n_lins; i++) {+ size_t seq_id = (cncfun->lins[i] - data);++ pgf_write_int(seq_id, wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_cncfuns(PgfCncFuns* cncfuns, PgfConcr* concr, PgfWriter* wtr)+{+ size_t len = gu_seq_length(cncfuns);+ pgf_write_len(len, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t funid = 0; funid < len; funid++) {+ PgfCncFun* cncfun = gu_seq_get(cncfuns, PgfCncFun*, funid);++ pgf_write_cncfun(cncfun, concr, wtr);+ gu_return_on_exn(wtr->err, );+ }+}++static void+pgf_write_fid(PgfCCat* ccat, PgfWriter* wtr)+{+ pgf_write_int(ccat->fid, wtr);+ gu_return_on_exn(wtr->err, );+}++static void+pgf_write_funid(PgfCncFun* cncfun, PgfWriter* wtr)+{+ pgf_write_int(cncfun->funid, wtr);+ gu_return_on_exn(wtr->err, );+}++typedef struct {+ GuMapItor itor;+ PgfWriter* wtr;+ bool do_count;+ bool do_defs;+ size_t count;+} PgfLinDefRefIter;++static void+pgf_write_ccat_lindefrefs(GuMapItor* self, const void* key, void* value, GuExn *err)+{+ PgfLinDefRefIter* itor = gu_container(self, PgfLinDefRefIter, itor);+ PgfCCat* ccat = *((PgfCCat**) value);++ PgfCncFuns* funs = (itor->do_defs) ? ccat->lindefs : ccat->linrefs;+ if (funs != NULL) {+ if (itor->do_count) {+ itor->count++;+ } else {+ pgf_write_fid(ccat, itor->wtr);+ gu_return_on_exn(err, );+ + size_t n_funs = gu_seq_length(funs);+ pgf_write_len(n_funs, itor->wtr);+ gu_return_on_exn(err, );+ + for (size_t j = 0; j < n_funs; j++) {+ PgfCncFun* fun = gu_seq_get(funs, PgfCncFun*, j);+ pgf_write_funid(fun, itor->wtr);+ }+ }+ }+}++static void+pgf_write_lindefs(PgfWriter* wtr, PgfConcr* concr)+{+ PgfLinDefRefIter itor;+ itor.itor.fn = pgf_write_ccat_lindefrefs;+ itor.wtr = wtr;+ itor.do_count= true;+ itor.do_defs = true;+ itor.count = 0;+ gu_map_iter(concr->ccats, &itor.itor, wtr->err);++ pgf_write_len(itor.count, wtr);+ gu_return_on_exn(wtr->err, );++ itor.do_count = false;+ gu_map_iter(concr->ccats, &itor.itor, wtr->err);+ gu_return_on_exn(wtr->err, );+}++static void+pgf_write_linrefs(PgfWriter* wtr, PgfConcr* concr)+{+ PgfLinDefRefIter itor;+ itor.itor.fn = pgf_write_ccat_lindefrefs;+ itor.wtr = wtr;+ itor.do_count= true;+ itor.do_defs = false;+ itor.count = 0;+ gu_map_iter(concr->ccats, &itor.itor, wtr->err);++ pgf_write_len(itor.count, wtr);+ gu_return_on_exn(wtr->err, );++ itor.do_count = false;+ gu_map_iter(concr->ccats, &itor.itor, wtr->err);+ gu_return_on_exn(wtr->err, );+}++static void+pgf_write_parg(PgfPArg* parg, PgfWriter* wtr)+{+ size_t n_hoas = gu_seq_length(parg->hypos);+ pgf_write_len(n_hoas, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < n_hoas; i++) {+ PgfCCat* ccat = gu_seq_get(parg->hypos, PgfCCat*, i);+ pgf_write_fid(ccat, wtr);+ gu_return_on_exn(wtr->err, );+ }++ pgf_write_fid(parg->ccat, wtr);+ gu_return_on_exn(wtr->err, );+}++static void+pgf_write_pargs(PgfPArgs* pargs, PgfWriter* wtr)+{+ size_t len = gu_seq_length(pargs);+ pgf_write_len(len, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < len; i++) {+ PgfPArg* parg = gu_seq_index(pargs, PgfPArg, i);+ pgf_write_parg(parg, wtr);+ }+}++static void+pgf_write_production(PgfProduction prod, PgfWriter* wtr)+{+ GuVariantInfo i = gu_variant_open(prod);+ pgf_write_tag(i.tag, wtr);+ switch (i.tag) {+ case PGF_PRODUCTION_APPLY: {+ PgfProductionApply *papp = i.data;++ pgf_write_funid(papp->fun, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_pargs(papp->args, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ case PGF_PRODUCTION_COERCE: {+ PgfProductionCoerce *pcoerce = i.data;++ pgf_write_fid(pcoerce->coerce, wtr);+ gu_return_on_exn(wtr->err, );+ break;+ }+ default:+ gu_impossible();+ }+}++static void+pgf_write_ccat(GuMapItor* self, const void* key, void* value, GuExn *err)+{+ PgfWriterIter* itor = gu_container(self, PgfWriterIter, itor);+ PgfCCat* ccat = *((PgfCCat**) value);++ pgf_write_fid(ccat, itor->wtr);+ gu_return_on_exn(err, );++ size_t n_prods = ccat->prods ? gu_seq_length(ccat->prods) : 0;+ pgf_write_len(n_prods, itor->wtr);+ gu_return_on_exn(err, );++ for (size_t i = 0; i < n_prods; i++) {+ PgfProduction prod = gu_seq_get(ccat->prods, PgfProduction, i);+ pgf_write_production(prod, itor->wtr);+ gu_return_on_exn(err, );+ }+}++static void+pgf_write_ccats(GuMap* ccats, PgfWriter* wtr)+{+ pgf_write_len(gu_map_count(ccats), wtr);+ gu_return_on_exn(wtr->err, );++ PgfWriterIter itor;+ itor.itor.fn = pgf_write_ccat;+ itor.wtr = wtr;+ gu_map_iter(ccats, &itor.itor, wtr->err);+}++static void+pgf_write_cnccat(PgfCncCat* cnccat, PgfWriter* wtr)+{+ size_t len = gu_seq_length(cnccat->cats);+ PgfCCat* first = gu_seq_get(cnccat->cats, PgfCCat*, 0);+ PgfCCat* last = gu_seq_get(cnccat->cats, PgfCCat*, len-1);+ pgf_write_fid(first,wtr);+ pgf_write_fid(last,wtr);+ pgf_write_len(cnccat->n_lins, wtr);++ for (size_t i = 0; i < cnccat->n_lins; i++) {+ pgf_write_string(cnccat->labels[i], wtr);+ }+}++static void+pgf_write_cnccat_iter(GuMapItor* self, const void* key, void* value, GuExn *err)+{+ PgfWriterIter* itor = gu_container(self, PgfWriterIter, itor);+ PgfCncCat* cnccat = *((PgfCncCat**) value);++ pgf_write_cid(cnccat->abscat->name, itor->wtr);+ gu_return_on_exn(err, );++ pgf_write_cnccat(cnccat, itor->wtr);+}++static void+pgf_write_cnccats(PgfCIdMap* cnccats, PgfWriter* wtr)+{+ pgf_write_len(gu_map_count(cnccats), wtr);+ gu_return_on_exn(wtr->err, );+ + PgfWriterIter itor;+ itor.itor.fn = pgf_write_cnccat_iter;+ itor.wtr = wtr;+ gu_map_iter(cnccats, &itor.itor, wtr->err);+}++static void+pgf_write_concrete_content(PgfConcr* concr, PgfWriter* wtr)+{+ pgf_write_printnames(concr->printnames, wtr);+ gu_return_on_exn(wtr->err,);++ pgf_write_sequences(concr->sequences, wtr);+ gu_return_on_exn(wtr->err,);++ pgf_write_cncfuns(concr->cncfuns, concr, wtr);+ gu_return_on_exn(wtr->err,);++ pgf_write_lindefs(wtr, concr);+ pgf_write_linrefs(wtr, concr);+ pgf_write_ccats(concr->ccats, wtr);+ pgf_write_cnccats(concr->cnccats, wtr);+ pgf_write_int(concr->total_cats, wtr);+}++static void+pgf_write_concrete(PgfConcr* concr, PgfWriter* wtr, bool with_content)+{+ if (with_content &&+ (concr->sequences == NULL || concr->cncfuns == NULL ||+ concr->ccats == NULL || concr->cnccats == NULL)) {+ // the syntax is not loaded so we must skip it.+ return;+ }++ pgf_write_cid(concr->name, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_flags(concr->cflags, wtr);+ gu_return_on_exn(wtr->err, );++ if (with_content) {+ pgf_write_concrete_content(concr, wtr);+ }+ gu_return_on_exn(wtr->err, );+}++PGF_API void+pgf_concrete_save(PgfConcr* concr, GuOut* out, GuExn* err)+{+ GuPool* pool = gu_new_pool();++ PgfWriter* wtr = pgf_new_writer(out, pool, err);++ pgf_write_concrete(concr, wtr, true);++ gu_pool_free(pool);+}++static void+pgf_write_concretes(PgfConcrs* concretes, PgfWriter* wtr, bool with_content)+{+ size_t n_concrs = gu_seq_length(concretes);+ pgf_write_len(n_concrs, wtr);+ gu_return_on_exn(wtr->err, );++ for (size_t i = 0; i < n_concrs; i++) {+ PgfConcr* concr = gu_seq_index(concretes, PgfConcr, i);+ pgf_write_concrete(concr, wtr, with_content);+ gu_return_on_exn(wtr->err, );+ }+}++PGF_INTERNAL void+pgf_write_pgf(PgfPGF* pgf, PgfWriter* wtr) {+ gu_out_u16be(wtr->out, pgf->major_version, wtr->err);+ gu_return_on_exn(wtr->err, );++ gu_out_u16be(wtr->out, pgf->minor_version, wtr->err);+ gu_return_on_exn(wtr->err, );++ pgf_write_flags(pgf->gflags, wtr);+ gu_return_on_exn(wtr->err, );++ pgf_write_abstract(&pgf->abstract, wtr);+ gu_return_on_exn(wtr->err, );++ bool with_content =+ (gu_seq_binsearch(pgf->gflags, pgf_flag_order, PgfFlag, "split") == NULL);+ pgf_write_concretes(pgf->concretes, wtr, with_content);+ gu_return_on_exn(wtr->err, );+}++PGF_INTERNAL PgfWriter*+pgf_new_writer(GuOut* out, GuPool* pool, GuExn* err)+{+ PgfWriter* wtr = gu_new(PgfWriter, pool);+ wtr->out = out;+ wtr->err = err;+ return wtr;+}+
@@ -0,0 +1,39 @@+#ifndef WRITER_H_+#define WRITER_H_++#include <gu/exn.h>+#include <gu/mem.h>+#include <gu/in.h>++// the writer interface++typedef struct PgfWriter PgfWriter;++PGF_INTERNAL_DECL PgfWriter*+pgf_new_writer(GuOut* out, GuPool* pool, GuExn* err);++PGF_INTERNAL_DECL void+pgf_write_tag(uint8_t tag, PgfWriter* wtr);++PGF_INTERNAL_DECL void+pgf_write_uint(uint32_t val, PgfWriter* wtr);++PGF_INTERNAL_DECL void+pgf_write_int(int32_t val, PgfWriter* wtr);++PGF_INTERNAL_DECL void+pgf_write_string(GuString val, PgfWriter* wtr);++PGF_INTERNAL_DECL void+pgf_write_double(double val, PgfWriter* wtr);++PGF_INTERNAL_DECL void+pgf_write_len(size_t len, PgfWriter* wtr);++PGF_INTERNAL_DECL void+pgf_write_cid(PgfCId id, PgfWriter* wtr);++PGF_INTERNAL_DECL void+pgf_write_pgf(PgfPGF* pgf, PgfWriter* wtr);++#endif // WRITER_H_
@@ -0,0 +1,21 @@++# Executable version of INSTALL++command="$1"+shift++case "$command" in+ configure)+ [ `uname` != Darwin ] || glibtoolize+ autoreconf -i+ ./configure "$@"+ ;;+ build)+ make -j "$@"+ ;;+ copy|install)+ make install "$@"+ ;;+ *)+ echo "Usage: setup.sh [configure|build|copy|install] ..."+esac
@@ -0,0 +1,2403 @@+#include <stdlib.h>+#include "sqlite3Btree.h"++#include "sg/sg.h"+#include "gu/mem.h"+#include "pgf/data.h"++#define SG_EXPRS 1+#define SG_PAIRS 2+#define SG_IDENTS 3+#define SG_LITERALS 4+#define SG_TOKENS 5+#define SG_TRIPLES 6+#define SG_TRIPLES_SPO 7+#define SG_TRIPLES_PO 8+#define SG_TRIPLES_O 9++struct SgSG {+ Btree *pBtree;+ int exprsTNum; /* The page number for the table of expressions */+ int identsTNum; /* The page number for the index on identifiers */+ int literalsTNum; /* The page number for the index on literals */+ int pairsTNum; /* The page number for the index on application pairs */+ int tokensTNum; /* The page number for the index on linearization tokens */+ int triplesTNum; /* The page number for the table of triples */+ int triplesIdxTNum[3]; /* The page number for the three indexes on triples */+ int autoCommit;+};++void+sg_raise_sqlite(int rc, GuExn* err)+{+ const char *msg = sqlite3BtreeErrName(rc);++ GuExnData* err_data = gu_raise(err, SgError);+ if (err_data) {+ err_data->data = gu_malloc(err_data->pool, strlen(msg)+1);+ strcpy(err_data->data, msg);+ }+}++void+sg_raise_err(GuString msg, GuExn* err)+{+ GuExnData* err_data = gu_raise(err, SgError);+ if (err_data) {+ err_data->data = (char*) msg;+ }+}++static int+sg_create_table(Btree* pBtree, BtCursor* crsSchema, int tblKey, int* pTNum, int flags)+{+ int rc;+ int file_format = sqlite3BtreeFileFormat(pBtree);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(crsSchema, 0, tblKey, 0, &res);+ if (rc != SQLITE_OK) {+ return rc;+ }++ Mem mem;+ int serial_type;++ if (res == 0) {+ u32 payloadSize;+ rc = sqlite3BtreeDataSize(crsSchema, &payloadSize);+ if (rc != SQLITE_OK)+ return rc;++ u32 avail = 0;+ const unsigned char* row = sqlite3BtreeDataFetch(crsSchema, &avail);+ row++;++ row += getVarint32(row, serial_type);+ row += sqlite3BtreeSerialGet(row, serial_type, &mem);+ assert(mem.flags & MEM_Int);++ *pTNum = mem.u.i;+ } else {+ rc = sqlite3BtreeCreateTable(pBtree, pTNum, flags);+ if (rc != SQLITE_OK) {+ return rc;+ }++ mem.flags = MEM_Int;+ mem.u.i = *pTNum;++ unsigned char buf[32];+ unsigned char *p;++ buf[0] = 2;+ serial_type = sqlite3BtreeSerialType(&mem, file_format);+ buf[1] = serial_type;+ + p = buf+2;+ p += sqlite3BtreeSerialPut(buf+2, &mem, serial_type);++ rc = sqlite3BtreeInsert(crsSchema, 0, tblKey,+ buf, p-buf, 0,+ 0, 0);+ if (rc != SQLITE_OK)+ return rc; + }++ return SQLITE_OK;+}++SgSG*+sg_open(const char *filename,+ GuExn* err)+{+ int rc;++ Btree* pBtree;+ rc = sqlite3BtreeOpen(0, filename, &pBtree,+ 0, SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_MAIN_DB);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return NULL;+ }++ rc = sqlite3BtreeBeginTrans(pBtree, 1);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ sqlite3BtreeClose(pBtree);+ return NULL;+ }++ BtCursor* crsSchema = NULL;+ rc = sqlite3BtreeCursor(pBtree, 1, 1, 0, 0, &crsSchema);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ sqlite3BtreeClose(pBtree);+ return NULL;+ }++ SgSG* sg = malloc(sizeof(SgSG));+ sg->pBtree = pBtree;+ sg->autoCommit = 1;++ rc = sg_create_table(pBtree, crsSchema, SG_EXPRS, &sg->exprsTNum, BTREE_INTKEY);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_IDENTS, &sg->identsTNum, 0);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_LITERALS, &sg->literalsTNum, 0);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_PAIRS, &sg->pairsTNum, 0);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_TOKENS, &sg->tokensTNum, 0);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_TRIPLES, &sg->triplesTNum, BTREE_INTKEY);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_TRIPLES_SPO, &sg->triplesIdxTNum[0], 0);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_TRIPLES_PO, &sg->triplesIdxTNum[1], 0);+ if (rc != SQLITE_OK)+ goto fail;++ rc = sg_create_table(pBtree, crsSchema, SG_TRIPLES_O, &sg->triplesIdxTNum[2], 0);+ if (rc != SQLITE_OK)+ goto fail;++ sqlite3BtreeCloseCursor(crsSchema);++ rc = sqlite3BtreeCommit(pBtree);+ if (rc != SQLITE_OK)+ goto fail;++ return sg;+ +fail:+ sg_raise_sqlite(rc, err);+ if (crsSchema != NULL)+ sqlite3BtreeCloseCursor(crsSchema);+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ sqlite3BtreeClose(pBtree);+ free(sg);+ return NULL;+}++void+sg_close(SgSG* sg, GuExn* err)+{+ sqlite3BtreeClose(sg->pBtree);+}++void+sg_shutdown()+{+ sqlite3BtreeShutdown();+}++void+sg_begin_trans(SgSG* sg, GuExn* err)+{+ int rc = sqlite3BtreeBeginTrans(sg->pBtree, 1);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return;+ }+ sg->autoCommit = 0;+}++void+sg_commit(SgSG* sg, GuExn* err)+{+ int rc = sqlite3BtreeCommit(sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return;+ }+ sg->autoCommit = 1;+}++void+sg_rollback(SgSG* sg, GuExn* err)+{+ int rc = sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return;+ }+ sg->autoCommit = 1;+}++typedef struct {+ int n_cursors;+ BtCursor* crsExprs;+ BtCursor* crsIdents;+ BtCursor* crsLiterals;+ BtCursor* crsPairs;+ SgId key_seed;+} ExprContext;++static int+open_exprs(SgSG *sg, int wrFlag, bool identsOnly,+ ExprContext* ctxt, GuExn* err)+{+ ctxt->n_cursors = 0;++ int rc;++ rc = sqlite3BtreeCursor(sg->pBtree, sg->exprsTNum, wrFlag, 0, 0, &ctxt->crsExprs);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }+ ctxt->n_cursors++;++ rc = sqlite3BtreeCursor(sg->pBtree, sg->identsTNum, wrFlag, 1, 1, &ctxt->crsIdents);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }+ ctxt->n_cursors++;++ if (!identsOnly) {+ rc = sqlite3BtreeCursor(sg->pBtree, sg->literalsTNum, wrFlag, 1, 1, &ctxt->crsLiterals);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }+ ctxt->n_cursors++;++ rc = sqlite3BtreeCursor(sg->pBtree, sg->pairsTNum, wrFlag, 2, 0, &ctxt->crsPairs);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }+ ctxt->n_cursors++;+ }++ if (wrFlag) {+ int res;+ rc = sqlite3BtreeLast(ctxt->crsExprs, &res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }++ rc = sqlite3BtreeKeySize(ctxt->crsExprs, &ctxt->key_seed);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }+ } else {+ ctxt->key_seed = 0;+ }++ return SQLITE_OK;+}++static void+close_exprs(ExprContext* ctxt)+{+ if (ctxt->n_cursors >= 4) {+ sqlite3BtreeCloseCursor(ctxt->crsPairs);+ }++ if (ctxt->n_cursors >= 3) {+ sqlite3BtreeCloseCursor(ctxt->crsLiterals);+ }++ if (ctxt->n_cursors >= 2) {+ sqlite3BtreeCloseCursor(ctxt->crsIdents);+ }++ if (ctxt->n_cursors >= 1) {+ sqlite3BtreeCloseCursor(ctxt->crsExprs);+ }+ + ctxt->n_cursors = 0;+}++static int+find_function_rowid(SgSG* sg, ExprContext* ctxt,+ GuString fun, SgId* pKey, int wrFlag)+{+ int rc = SQLITE_OK;+ int file_format = sqlite3BtreeFileFormat(sg->pBtree);++ Mem mem[2];+ mem[0].flags = MEM_Str;+ mem[0].n = strlen(fun);+ mem[0].z = (void*) fun;++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->crsIdents, 1, 0, mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(ctxt->crsIdents,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK) {+ return rc;+ }++ if (res == 0) {+ rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->crsIdents, pKey);+ } else {+ if (wrFlag == 0) {+ *pKey = 0;+ return SQLITE_OK;+ }++ *pKey = ++ctxt->key_seed;++ int serial_type_fun = sqlite3BtreeSerialType(&mem[0], file_format);+ int serial_type_fun_hdr_len = sqlite3BtreeVarintLen(serial_type_fun);++ mem[1].flags = MEM_Int;+ mem[1].u.i = *pKey;++ int serial_type_key = sqlite3BtreeSerialType(&mem[1], file_format);+ int serial_type_key_hdr_len = sqlite3BtreeVarintLen(serial_type_key);++ unsigned char* buf = malloc(1+serial_type_fun_hdr_len+(serial_type_key_hdr_len > 1 ? serial_type_key_hdr_len : 1)+mem[0].n+8);+ unsigned char* p = buf;+ *p++ = 1+serial_type_fun_hdr_len+1;+ p += putVarint32(p, serial_type_fun);+ *p++ = 0;+ memcpy(p, fun, mem[0].n);+ p += mem[0].n;++ rc = sqlite3BtreeInsert(ctxt->crsExprs, 0, *pKey,+ buf, p-buf, 0,+ 0, 0);+ if (rc != SQLITE_OK) {+ goto free;+ }++ p = buf;+ *p++ = 1+serial_type_fun_hdr_len+serial_type_key_hdr_len;+ p += putVarint32(p, serial_type_fun);+ p += putVarint32(p, serial_type_key);+ memcpy(p, fun, mem[0].n);+ p += mem[0].n;+ p += sqlite3BtreeSerialPut(p, &mem[1], serial_type_key);+ rc = sqlite3BtreeInsert(ctxt->crsIdents, buf, p-buf,+ 0, *pKey, 0,+ 0, 0);++free:+ free(buf);+ }++ return rc;+}++static int+store_expr(SgSG* sg,+ ExprContext* ctxt, PgfExpr expr, SgId* pKey, int wrFlag)+{+ int rc = SQLITE_OK;+ int file_format = sqlite3BtreeFileFormat(sg->pBtree);++ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ gu_impossible();+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;++ Mem mem[3];++ mem[0].flags = MEM_Int;+ rc = store_expr(sg, ctxt, app->fun, &mem[0].u.i, wrFlag);+ if (rc != SQLITE_OK)+ return rc;+ if (wrFlag == 0 && mem[0].u.i == 0) {+ *pKey = 0;+ return SQLITE_OK;+ }++ mem[1].flags = MEM_Int;+ rc = store_expr(sg, ctxt, app->arg, &mem[1].u.i, wrFlag);+ if (rc != SQLITE_OK)+ return rc;+ if (wrFlag == 0 && mem[1].u.i == 0) {+ *pKey = 0;+ return SQLITE_OK;+ }++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->crsPairs, 2, 0, mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(ctxt->crsPairs,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK) {+ return rc;+ }++ if (res == 0) {+ rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->crsPairs, pKey);+ } else {+ if (wrFlag == 0) {+ *pKey = 0;+ return SQLITE_OK;+ }++ *pKey = ++ctxt->key_seed;++ unsigned char buf[32]; // enough for a record with three integers+ buf[1] = 3;++ u32 serial_type;+ unsigned char* p = buf+4;++ serial_type = sqlite3BtreeSerialType(&mem[0], file_format);+ buf[2] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[0], serial_type);++ serial_type = sqlite3BtreeSerialType(&mem[1], file_format);+ buf[3] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[1], serial_type);++ rc = sqlite3BtreeInsert(ctxt->crsExprs, 0, *pKey,+ buf+1, p-(buf+1), 0,+ 0, 0);+ if (rc != SQLITE_OK) {+ return rc;+ }++ buf[0] = 4;+ buf[1] = buf[2];+ buf[2] = buf[3];++ mem[2].flags = MEM_Int;+ mem[2].u.i = *pKey;+ serial_type = sqlite3BtreeSerialType(&mem[2], file_format);+ buf[3] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[2], serial_type);++ rc = sqlite3BtreeInsert(ctxt->crsPairs, buf, p-buf,+ 0, *pKey, 0,+ 0, 0);+ }+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = ei.data;++ Mem mem[2];++ GuVariantInfo li = gu_variant_open(elit->lit);+ switch (li.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = li.data;++ mem[0].flags = MEM_Str;+ mem[0].n = strlen(lstr->val);+ mem[0].z = lstr->val;+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = li.data;++ mem[0].flags = MEM_Int;+ mem[0].u.i = lint->val;+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = li.data;++ mem[0].flags = MEM_Real;+ mem[0].u.r = lflt->val;+ break;+ }+ default:+ gu_impossible();+ }++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->crsIdents, 1, 0, mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(ctxt->crsLiterals,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK) {+ return rc;+ }++ if (res == 0) {+ rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->crsLiterals, pKey);+ } else {+ if (wrFlag == 0) {+ *pKey = 0;+ return SQLITE_OK;+ }++ *pKey = ++ctxt->key_seed;++ mem[1].flags = MEM_Int;+ mem[1].u.i = 0;++ int serial_type_lit = sqlite3BtreeSerialType(&mem[0], file_format);+ int serial_type_lit_hdr_len = sqlite3BtreeVarintLen(serial_type_lit);+ int serial_type_arg = sqlite3BtreeSerialType(&mem[1], file_format);+ int serial_type_arg_hdr_len = sqlite3BtreeVarintLen(serial_type_arg);++ unsigned char* buf = malloc(1+serial_type_lit_hdr_len+(serial_type_arg_hdr_len > 1 ? serial_type_arg_hdr_len : 1)+mem[0].n+8);+ unsigned char* p = buf;+ *p++ = 1+serial_type_lit_hdr_len+serial_type_arg_hdr_len;+ p += putVarint32(p, serial_type_lit);+ p += putVarint32(p, serial_type_arg);+ p += sqlite3BtreeSerialPut(p, &mem[0], serial_type_lit);+ p += sqlite3BtreeSerialPut(p, &mem[1], serial_type_arg);++ rc = sqlite3BtreeInsert(ctxt->crsExprs, 0, *pKey,+ buf, p-buf, 0,+ 0, 0);+ if (rc == SQLITE_OK) {+ mem[1].flags = MEM_Int;+ mem[1].u.i = *pKey;++ int serial_type_key = sqlite3BtreeSerialType(&mem[1], file_format);+ int serial_type_key_hdr_len = sqlite3BtreeVarintLen(serial_type_key);++ p = buf;+ *p++ = 1+serial_type_lit_hdr_len+serial_type_key_hdr_len;+ p += putVarint32(p, serial_type_lit);+ p += putVarint32(p, serial_type_key);+ p += sqlite3BtreeSerialPut(p, &mem[0], serial_type_lit);+ p += sqlite3BtreeSerialPut(p, &mem[1], serial_type_key);+ rc = sqlite3BtreeInsert(ctxt->crsLiterals, buf, p-buf,+ 0, *pKey, 0,+ 0, 0);+ }++ free(buf);+ }+ break;+ }+ case PGF_EXPR_META: {+ gu_impossible();+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;+ rc = find_function_rowid(sg, ctxt, fun->fun, pKey, wrFlag);+ break;+ }+ case PGF_EXPR_VAR: {+ gu_impossible();+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = ei.data;+ rc = store_expr(sg, ctxt, etyped->expr, pKey, wrFlag);+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = ei.data;+ rc = store_expr(sg, ctxt, eimpl->expr, pKey, wrFlag);+ break;+ }+ default:+ gu_impossible();+ }++ return rc;+}++SgId+sg_insert_expr(SgSG *sg, PgfExpr expr, int wrFlag, GuExn* err)+{+ int rc;++ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, wrFlag);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return 0;+ }+ }++ ExprContext ctxt;+ rc = open_exprs(sg, wrFlag, false, &ctxt, err);+ if (rc != SQLITE_OK)+ goto close;++ SgId key;+ rc = store_expr(sg, &ctxt, expr, &key, wrFlag);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ close_exprs(&ctxt);++ if (sg->autoCommit) {+ rc = sqlite3BtreeCommit(sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return 0;+ }+ }++ return key;++close:+ close_exprs(&ctxt);++ if (sg->autoCommit) {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }+ return 0;+}++static int+load_expr(BtCursor* crsExprs, SgId key, PgfExpr *pExpr, GuPool* out_pool)+{+ int res;+ int rc = sqlite3BtreeMovetoUnpacked(crsExprs, 0, key, 0, &res);+ if (rc != SQLITE_OK)+ return rc;++ if (res != 0) {+ *pExpr = gu_null_variant;+ return SQLITE_OK;+ }++ u32 payloadSize;+ rc = sqlite3BtreeDataSize(crsExprs, &payloadSize);+ if (rc != SQLITE_OK)+ return rc;++ u32 avail = 0;+ const unsigned char* row = sqlite3BtreeDataFetch(crsExprs, &avail);+ row++;++ int serial_type_fun, serial_type_arg;+ row += getVarint32(row, serial_type_fun);+ row += getVarint32(row, serial_type_arg);++ Mem mem[2];+ row += sqlite3BtreeSerialGet(row, serial_type_fun, &mem[0]);+ row += sqlite3BtreeSerialGet(row, serial_type_arg, &mem[1]);++ if (mem[1].flags & MEM_Null) {+ u32 len = sqlite3BtreeSerialTypeLen(serial_type_fun);++ PgfExprFun *efun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, len+1,+ pExpr, out_pool);+ memcpy(efun->fun, mem[0].z, len);+ efun->fun[len] = 0;+ } else if (mem[1].u.i == 0) {+ PgfExprLit *elit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ pExpr, out_pool);++ if (mem[0].flags & MEM_Str) {+ u32 len = sqlite3BtreeSerialTypeLen(serial_type_fun);++ PgfLiteralStr *lstr =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, len+1,+ &elit->lit, out_pool);+ memcpy(lstr->val, mem[0].z, len);+ lstr->val[len] = 0;+ } else if (mem[0].flags & MEM_Int) {+ PgfLiteralInt *lint =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &elit->lit, out_pool);+ lint->val = mem[0].u.i;+ } else if (mem[0].flags & MEM_Real) {+ PgfLiteralFlt *lflt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &elit->lit, out_pool);+ lflt->val = mem[0].u.r;+ } else {+ gu_impossible();+ }+ } else {+ PgfExprApp* papp =+ gu_new_variant(PGF_EXPR_APP, PgfExprApp, pExpr, out_pool);++ rc = load_expr(crsExprs, mem[0].u.i, &papp->fun, out_pool);+ if (rc != SQLITE_OK)+ return rc;++ rc = load_expr(crsExprs, mem[1].u.i, &papp->arg, out_pool);+ if (rc != SQLITE_OK)+ return rc;+ }++ return SQLITE_OK;+}++PgfExpr+sg_get_expr(SgSG *sg, SgId key, GuPool* out_pool, GuExn* err)+{+ int rc;+ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return gu_null_variant;+ }+ }++ BtCursor* crsExprs;+ rc = sqlite3BtreeCursor(sg->pBtree, sg->exprsTNum, 0, 0, 0, &crsExprs);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto rollback;+ }++ PgfExpr expr = gu_null_variant;+ rc = load_expr(crsExprs, key, &expr, out_pool);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ rc = sqlite3BtreeCloseCursor(crsExprs);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto rollback;+ }++ if (sg->autoCommit) {+ rc = sqlite3BtreeCommit(sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto rollback;+ }+ }++ return expr;++close:+ sqlite3BtreeCloseCursor(crsExprs);++rollback:+ if (sg->autoCommit) {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }+ return gu_null_variant;+}++// A query is compiled into a sequence of instructions with+// the following codes:+#define QI_PUSH 1+#define QI_VAR 2+#define QI_APPLY 3+#define QI_RETURN 4++typedef struct {+ int code;+ SgId arg;+} QueryInstr;++struct SgQueryExprResult {+ ExprContext ectxt;+ GuBuf* instrs;+ GuBuf* queue;+ size_t iState;+ PgfMetaId min_meta_id;+ PgfMetaId max_meta_id;+};++typedef struct QueryArg QueryArg;+struct QueryArg {+ QueryArg* prev;+ SgId arg;+};++typedef struct {+ QueryArg* args; // a stack of arguments+ int pc; // program counter+} QueryState;++static int+build_expr_query(SgSG* sg,+ SgQueryExprResult* ctxt, PgfExpr expr)+{+ int rc = SQLITE_OK;++ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ gu_impossible();+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;++ rc = build_expr_query(sg, ctxt, app->fun);+ if (rc != SQLITE_OK)+ return rc;+ QueryInstr* first =+ gu_buf_index_last(ctxt->instrs, QueryInstr);++ rc = build_expr_query(sg, ctxt, app->arg);+ if (rc != SQLITE_OK)+ return rc;+ QueryInstr* second =+ gu_buf_index_last(ctxt->instrs, QueryInstr);++ if (first->code == QI_PUSH && second->code == QI_PUSH &&+ second - first == 1) {+ // we could directly combine the two expressions++ Mem mem[2];+ mem[0].flags = MEM_Int;+ mem[0].u.i = first->arg;+ mem[1].flags = MEM_Int;+ mem[1].u.i = second->arg;++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsPairs, 2, 0, mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsPairs,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK)+ return rc;+ if (res != 0)+ return SQLITE_DONE;++ gu_buf_pop(ctxt->instrs, QueryInstr);++ rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsPairs, &first->arg);+ } else if (gu_variant_tag(app->arg) != PGF_EXPR_META) {+ QueryInstr* instr = gu_buf_extend(ctxt->instrs);+ instr->code = QI_APPLY;+ instr->arg = 0;+ }+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = ei.data;++ Mem mem;++ GuVariantInfo li = gu_variant_open(elit->lit);+ switch (li.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = li.data;++ mem.flags = MEM_Str;+ mem.n = strlen(lstr->val);+ mem.z = lstr->val;+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = li.data;++ mem.flags = MEM_Int;+ mem.u.i = lint->val;+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = li.data;++ mem.flags = MEM_Real;+ mem.u.r = lflt->val;+ break;+ }+ default:+ gu_impossible();+ }++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsIdents, 1, 0, &mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsLiterals,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK)+ return rc;+ if (res != 0)+ return SQLITE_DONE;++ QueryInstr* instr = gu_buf_extend(ctxt->instrs);+ instr->code = QI_PUSH;+ rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsLiterals, &instr->arg);+ break;+ }+ case PGF_EXPR_META: {+ PgfExprMeta* emeta = ei.data;+ QueryInstr* instr = gu_buf_extend(ctxt->instrs);+ instr->code = QI_VAR;+ instr->arg = emeta->id;+ + if (ctxt->min_meta_id > emeta->id)+ ctxt->min_meta_id = emeta->id;+ if (ctxt->max_meta_id < emeta->id)+ ctxt->max_meta_id = emeta->id;+ break;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;++ QueryInstr* instr = gu_buf_extend(ctxt->instrs);+ instr->code = QI_PUSH;+ rc = find_function_rowid(sg, &ctxt->ectxt, fun->fun, &instr->arg, 0);+ if (rc == SQLITE_OK && instr->arg == 0)+ return SQLITE_DONE;+ break;+ }+ case PGF_EXPR_VAR: {+ gu_impossible();+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = ei.data;+ rc = build_expr_query(sg, ctxt, etyped->expr);+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = ei.data;+ rc = build_expr_query(sg, ctxt, eimpl->expr);+ break;+ }+ default:+ gu_impossible();+ }++ return rc;+}++static int+run_expr_query(SgSG* sg, SgQueryExprResult* ctxt, GuPool* pool)+{+ int rc;++ while (ctxt->iState < gu_buf_length(ctxt->queue)) {+ QueryState* state =+ gu_buf_index(ctxt->queue, QueryState, ctxt->iState);+ QueryInstr* instr =+ gu_buf_index(ctxt->instrs, QueryInstr, state->pc);++ switch (instr->code) {+ case QI_PUSH: {+ QueryArg* arg = gu_new(QueryArg, pool);+ arg->arg = instr->arg;+ arg->prev = state->args;+ state->args = arg;+ break;+ }+ case QI_VAR: {+ assert(state->args != NULL);++ Mem mem;+ mem.flags = MEM_Int;+ mem.u.i = state->args->arg;++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsPairs, 1, 1, &mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsPairs,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK)+ return rc;+ if (res < 0) {+ rc = sqlite3BtreeNext(ctxt->ectxt.crsPairs, &res);+ }+ res = 0;++ while (res == 0) {+ i64 szData;+ const unsigned char *zData;+ rc = sqlite3BtreeKeySize(ctxt->ectxt.crsPairs, &szData);+ if (rc != SQLITE_OK)+ return rc;++ u32 available = 0;+ zData = sqlite3BtreeKeyFetch(ctxt->ectxt.crsPairs, &available);+ if (szData > available)+ gu_impossible();++ idxKey.default_rc = 0;+ res = sqlite3BtreeRecordCompare(available, zData, &idxKey);+ if (res != 0)+ break;++ QueryArg* arg = gu_new(QueryArg, pool);+ arg->prev = state->args->prev;++ QueryState* state1 = gu_buf_extend(ctxt->queue);+ state1->args = arg;+ state1->pc = state->pc+1;++ rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsPairs, &arg->arg);+ if (rc != SQLITE_OK)+ return rc;++ sqlite3BtreeNext(ctxt->ectxt.crsPairs, &res);+ if (rc != SQLITE_OK)+ return rc;+ }++ ctxt->iState++;+ break;+ }+ case QI_APPLY: {+ assert(state->args != NULL && state->args->prev);++ Mem mem[2];+ mem[0].flags = MEM_Int;+ mem[0].u.i = state->args->prev->arg;+ mem[1].flags = MEM_Int;+ mem[1].u.i = state->args->arg;++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, ctxt->ectxt.crsPairs, 2, 0, mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(ctxt->ectxt.crsPairs,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK)+ return rc;+ if (res != 0) {+ ctxt->iState++;+ continue;+ }++ state->args = state->args->prev;++ rc = sqlite3BtreeIdxRowid(sg->pBtree, ctxt->ectxt.crsPairs, &state->args->arg);+ if (rc != SQLITE_OK)+ return rc;+ break;+ }+ case QI_RETURN:+ return SQLITE_OK;+ }++ state->pc++;+ }++ return SQLITE_DONE;+}++SgQueryExprResult*+sg_query_expr(SgSG *sg, PgfExpr expr, GuPool* pool, GuExn* err)+{+ int rc;++ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return NULL;+ }+ }++ SgQueryExprResult* ctxt = gu_new(SgQueryExprResult, pool);+ rc = open_exprs(sg, 0, false, &ctxt->ectxt, err);+ if (rc != SQLITE_OK)+ goto close;++ ctxt->instrs = gu_new_buf(QueryInstr, pool);+ ctxt->queue = gu_new_buf(QueryState, pool);+ ctxt->iState = 0;+ ctxt->min_meta_id = INT_MAX;+ ctxt->max_meta_id = INT_MIN;++ rc = build_expr_query(sg, ctxt, expr);+ if (rc == SQLITE_OK) {+ QueryInstr* instr = gu_buf_extend(ctxt->instrs);+ instr->code = QI_RETURN;+ instr->arg = 0;++ QueryState* state = gu_buf_extend(ctxt->queue);+ state->args = NULL;+ state->pc = 0;+ } else if (rc != SQLITE_DONE) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ return ctxt;++close:+ close_exprs(&ctxt->ectxt);++ if (sg->autoCommit) {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }+ return NULL;+}++PgfExpr+sg_query_next(SgSG *sg, SgQueryExprResult* ctxt, SgId* pKey, GuPool* pool, GuExn* err)+{+ int rc;++ rc = run_expr_query(sg, ctxt, pool);+ if (rc == SQLITE_DONE)+ return gu_null_variant;+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return gu_null_variant;+ }++ QueryState* state =+ gu_buf_index(ctxt->queue, QueryState, ctxt->iState);+ assert(state->args != NULL);+ ctxt->iState++;++ PgfExpr expr;+ rc = load_expr(ctxt->ectxt.crsExprs, state->args->arg, &expr, pool);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return gu_null_variant;+ }++ *pKey = state->args->arg;++ return expr;+}++void+sg_query_close(SgSG* sg, SgQueryExprResult* ctxt, GuExn* err)+{+ int rc;++ close_exprs(&ctxt->ectxt);++ if (sg->autoCommit) {+ rc = sqlite3BtreeCommit(sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ }+ }+}++static int+insert_token(SgSG *sg, BtCursor* crsTokens, GuString tok, SgId key)+{+ int rc = SQLITE_OK;+ int file_format = sqlite3BtreeFileFormat(sg->pBtree);++ Mem mem[2];+ mem[0].flags = MEM_Str;+ mem[0].n = strlen(tok);+ mem[0].z = (void*) tok;++ int serial_type_tok = sqlite3BtreeSerialType(&mem[0], file_format);+ int serial_type_tok_hdr_len = sqlite3BtreeVarintLen(serial_type_tok);++ mem[1].flags = MEM_Int;+ mem[1].u.i = key;++ int serial_type_key = sqlite3BtreeSerialType(&mem[1], file_format);+ int serial_type_key_hdr_len = sqlite3BtreeVarintLen(serial_type_key);++ unsigned char* buf = malloc(1+serial_type_tok_hdr_len+serial_type_key_hdr_len+mem[0].n+8);+ unsigned char* p = buf;+ *p++ = 1+serial_type_tok_hdr_len+serial_type_key_hdr_len;+ p += putVarint32(p, serial_type_tok);+ p += putVarint32(p, serial_type_key);+ memcpy(p, tok, mem[0].n);+ p += mem[0].n;+ p += sqlite3BtreeSerialPut(p, &mem[1], serial_type_key);+ rc = sqlite3BtreeInsert(crsTokens, buf, p-buf,+ 0, key, 0,+ 0, 0);+ free(buf);++ return rc;+}++static int+insert_syms(SgSG *sg, BtCursor* crsTokens, PgfSymbols* syms, SgId key)+{+ int rc;+ size_t n_syms = gu_seq_length(syms);+ for (size_t sym_idx = 0; sym_idx < n_syms; sym_idx++) {+ PgfSymbol sym = gu_seq_get(syms, PgfSymbol, sym_idx);+ GuVariantInfo sym_i = gu_variant_open(sym);+ switch (sym_i.tag) {+ case PGF_SYMBOL_KS: {+ PgfSymbolKS* ks = sym_i.data;+ rc = insert_token(sg, crsTokens, ks->token, key);+ if (rc != SQLITE_OK)+ return rc;+ break;+ }+ case PGF_SYMBOL_KP: {+ PgfSymbolKP* kp = sym_i.data;+ rc = insert_syms(sg, crsTokens, kp->default_form, key);+ if (rc != SQLITE_OK)+ return rc;+ + for (size_t i = 0; i < kp->n_forms; i++) {+ rc = insert_syms(sg, crsTokens, kp->forms[i].form, key);+ if (rc != SQLITE_OK)+ return rc;+ }+ break;+ }+ }+ }+ + return SQLITE_OK;+}++void+sg_update_fts_index(SgSG* sg, PgfPGF* pgf, GuExn* err)+{+ int rc = SQLITE_OK;++ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, 1);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return;+ }+ }++ ExprContext ctxt;+ rc = open_exprs(sg, 1, true, &ctxt, err);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }+ + rc = sqlite3BtreeClearTable(sg->pBtree, sg->tokensTNum, NULL);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return;+ }++ BtCursor* crsTokens;+ rc = sqlite3BtreeCursor(sg->pBtree, sg->tokensTNum, 1, 1, 1, &crsTokens);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ }+ ctxt.n_cursors++;++ size_t n_concrs = gu_seq_length(pgf->concretes);+ for (size_t i = 0; i < n_concrs; i++) {+ PgfConcr* concr = gu_seq_index(pgf->concretes, PgfConcr, i);+ + size_t n_funs = gu_seq_length(concr->cncfuns);+ for (size_t funid = 0; funid < n_funs; funid++) {+ PgfCncFun* cncfun = gu_seq_get(concr->cncfuns, PgfCncFun*, funid);++ SgId key = 0;+ rc = find_function_rowid(sg, &ctxt, cncfun->absfun->name, &key, 1);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ for (size_t lin_idx = 0; lin_idx < cncfun->n_lins; lin_idx++) {+ PgfSequence* seq = cncfun->lins[lin_idx];+ rc = insert_syms(sg, crsTokens, seq->syms, key);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }+ }+ }+ }++ if (ctxt.n_cursors >= 3) {+ sqlite3BtreeCloseCursor(crsTokens);+ ctxt.n_cursors--;+ }++ close_exprs(&ctxt);+ + if (sg->autoCommit) {+ rc = sqlite3BtreeCommit(sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ }+ }++ return;++close:+ if (ctxt.n_cursors >= 3) {+ sqlite3BtreeCloseCursor(crsTokens);+ ctxt.n_cursors--;+ }++ close_exprs(&ctxt);++ if (sg->autoCommit) {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }+}++GuSeq*+sg_query_linearization(SgSG *sg, GuString tok, GuPool *pool, GuExn* err)+{+ int rc;++ BtCursor* crsTokens;+ rc = sqlite3BtreeCursor(sg->pBtree, sg->tokensTNum, 1, 1, 1, &crsTokens);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return NULL;+ }++ Mem mem[1];+ mem[0].flags = MEM_Str;+ mem[0].n = strlen(tok);+ mem[0].z = (void*) tok;++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, crsTokens, 1, 0, mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(crsTokens,+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return NULL;+ }+ + GuBuf* ids = gu_new_buf(SgId, pool);++ while (res == 0) {+ SgId key;+ rc = sqlite3BtreeIdxRowid(sg->pBtree, crsTokens, &key);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ sqlite3BtreeClearCursor(crsTokens);+ return NULL;+ }++ gu_buf_push(ids, SgId, key);++ sqlite3BtreeNext(crsTokens, &res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ sqlite3BtreeClearCursor(crsTokens);+ return NULL;+ }++ i64 szData;+ const unsigned char *zData;+ rc = sqlite3BtreeKeySize(crsTokens, &szData);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ sqlite3BtreeClearCursor(crsTokens);+ return NULL;+ }++ u32 available = 0;+ zData = sqlite3BtreeKeyFetch(crsTokens, &available);+ if (szData > available)+ gu_impossible();++ res = sqlite3BtreeRecordCompare(available, zData, &idxKey);+ if (res != 0)+ break;+ }++ sqlite3BtreeClearCursor(crsTokens);+ return gu_buf_data_seq(ids);+}++typedef struct {+ int n_cursors;+ BtCursor* cursor[4];+} TripleContext;++static int+open_triples(SgSG *sg, int wrFlag, TripleContext* ctxt, GuExn* err)+{+ int rc;++ ctxt->n_cursors = 0;+ while (ctxt->n_cursors < 3) {+ rc = sqlite3BtreeCursor(sg->pBtree, sg->triplesIdxTNum[ctxt->n_cursors], wrFlag, 3-ctxt->n_cursors, ctxt->n_cursors, &ctxt->cursor[ctxt->n_cursors]);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }+ ctxt->n_cursors++;+ }++ rc = sqlite3BtreeCursor(sg->pBtree, sg->triplesTNum, wrFlag, 0, 0, &ctxt->cursor[ctxt->n_cursors]);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return rc;+ }+ ctxt->n_cursors++;++ return SQLITE_OK;+}++static void+close_triples(TripleContext* ctxt)+{+ while (ctxt->n_cursors > 0) {+ ctxt->n_cursors--;+ sqlite3BtreeCloseCursor(ctxt->cursor[ctxt->n_cursors]);+ }+}++SgId+sg_insert_triple(SgSG *sg, SgTriple triple, GuExn* err)+{+ int rc;++ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, 1);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return 0;+ }+ }++ TripleContext tctxt;+ rc = open_triples(sg, 1, &tctxt, err);+ if (rc != SQLITE_OK)+ goto close;++ Mem mem[4];++ ExprContext ectxt;+ rc = open_exprs(sg, 1, false, &ectxt, err);+ if (rc != SQLITE_OK)+ goto close;++ for (size_t i = 0; i < 3; i++) {+ mem[i].flags = MEM_Int;++ rc = store_expr(sg, &ectxt, triple[i], &mem[i].u.i, 1);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }+ }++ UnpackedRecord idxKey;+ sqlite3BtreeInitUnpackedRecord(&idxKey, tctxt.cursor[0], 3, 0, mem);++ int res = 0;+ rc = sqlite3BtreeMovetoUnpacked(tctxt.cursor[0],+ &idxKey, 0, 0, &res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ SgId key = 0;++ if (res == 0) {+ rc = sqlite3BtreeIdxRowid(sg->pBtree, tctxt.cursor[0], &key);+ } else {+ rc = sqlite3BtreeLast(tctxt.cursor[3], &res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ rc = sqlite3BtreeKeySize(tctxt.cursor[3], &key);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }+ key++;++ u32 serial_type;+ unsigned char buf[41]; // enough for a record with three integers+ int file_format = sqlite3BtreeFileFormat(sg->pBtree);++ unsigned char* p = buf+(buf[0] = 5);++ serial_type = sqlite3BtreeSerialType(&mem[0], file_format);+ buf[1] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[0], serial_type);++ serial_type = sqlite3BtreeSerialType(&mem[1], file_format);+ buf[2] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[1], serial_type);++ serial_type = sqlite3BtreeSerialType(&mem[2], file_format);+ buf[3] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[2], serial_type);++ unsigned char* tmp = p;++ mem[3].flags = MEM_Int;+ mem[3].u.i = 1;+ serial_type = sqlite3BtreeSerialType(&mem[3], file_format);+ buf[4] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[3], serial_type);++ rc = sqlite3BtreeInsert(tctxt.cursor[3], 0, key,+ buf, p-buf, 0,+ 0, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ mem[3].flags = MEM_Int;+ mem[3].u.i = key;++ p = tmp;+ serial_type = sqlite3BtreeSerialType(&mem[3], file_format);+ buf[4] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[3], serial_type);++ rc = sqlite3BtreeInsert(tctxt.cursor[0], buf, p-buf,+ 0, key, 0,+ 0, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ p = buf+(buf[0] = 4);++ serial_type = sqlite3BtreeSerialType(&mem[1], file_format);+ buf[1] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[1], serial_type);++ serial_type = sqlite3BtreeSerialType(&mem[2], file_format);+ buf[2] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[2], serial_type);++ serial_type = sqlite3BtreeSerialType(&mem[3], file_format);+ buf[3] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[3], serial_type);++ rc = sqlite3BtreeInsert(tctxt.cursor[1], buf, p-buf,+ 0, key, 0,+ 0, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ p = buf+(buf[0] = 3);++ serial_type = sqlite3BtreeSerialType(&mem[2], file_format);+ buf[1] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[2], serial_type);++ serial_type = sqlite3BtreeSerialType(&mem[3], file_format);+ buf[2] = serial_type;+ p += sqlite3BtreeSerialPut(p, &mem[3], serial_type);++ rc = sqlite3BtreeInsert(tctxt.cursor[2], buf, p-buf,+ 0, key, 0,+ 0, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }+ }++close:+ close_exprs(&ectxt);+ close_triples(&tctxt);++ if (sg->autoCommit) {+ if (rc == SQLITE_OK || rc == SQLITE_DONE) {+ rc = sqlite3BtreeCommit(sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return 0;+ }+ } else {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }+ }++ return key;+}++static int+load_triple(BtCursor* crsTriples, BtCursor* crsExprs, SgTriple triple,+ GuPool* out_pool)+{+ int rc;++ u32 payloadSize;+ rc = sqlite3BtreeDataSize(crsTriples, &payloadSize);+ if (rc != SQLITE_OK)+ return rc;++ u32 avail = 0;+ const unsigned char* row = sqlite3BtreeDataFetch(crsTriples, &avail);+ row++;++ int serial_type_subj, serial_type_pred, serial_type_obj;+ row += getVarint32(row, serial_type_subj);+ row += getVarint32(row, serial_type_pred);+ row += getVarint32(row, serial_type_obj);+ row++;++ Mem mem[3];+ row += sqlite3BtreeSerialGet(row, serial_type_subj, &mem[0]);+ row += sqlite3BtreeSerialGet(row, serial_type_pred, &mem[1]);+ row += sqlite3BtreeSerialGet(row, serial_type_obj, &mem[2]);++ for (int i = 0; i < 3; i++) {+ if (gu_variant_is_null(triple[i])) {+ rc = load_expr(crsExprs, mem[i].u.i, &triple[i], out_pool);+ if (rc != SQLITE_OK)+ return rc;+ }+ }++ return SQLITE_OK;+}++int+sg_get_triple(SgSG *sg, SgId key, SgTriple triple,+ GuPool* out_pool, GuExn* err)+{+ triple[0] = gu_null_variant;+ triple[1] = gu_null_variant;+ triple[2] = gu_null_variant;++ int rc;+ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return false;+ }+ }++ BtCursor* crsTriples;+ rc = sqlite3BtreeCursor(sg->pBtree, sg->triplesTNum, 0, 0, 0, &crsTriples);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto rollback;+ }++ BtCursor* crsExprs;+ rc = sqlite3BtreeCursor(sg->pBtree, sg->exprsTNum, 0, 0, 0, &crsExprs);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close1;+ }++ int res;+ rc = sqlite3BtreeMovetoUnpacked(crsTriples, 0, key, 0, &res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ if (res == 0) {+ rc = load_triple(crsTriples, crsExprs, triple, out_pool);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }+ }++ rc = sqlite3BtreeCloseCursor(crsExprs);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close1;+ }++ rc = sqlite3BtreeCloseCursor(crsTriples);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto rollback;+ }++ if (sg->autoCommit) {+ rc = sqlite3BtreeCommit(sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return false;+ }+ }++ return (res == 0);++close:+ sqlite3BtreeCloseCursor(crsExprs);++close1:+ sqlite3BtreeCloseCursor(crsTriples);++rollback:+ if (sg->autoCommit) {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }+ return false;+}++typedef struct {+ TripleContext tctxt;++ BtCursor* cursor;++ int res;+ Mem mem[3];+ UnpackedRecord idxKey;+} SgTripleResultInt;++struct SgTripleResult {+ SgSG *sg;+ SgTriple triple;+ ExprContext ectxt;+ + SgTripleResultInt i;+};++static int+triple_result_init(SgSG *sg, SgTripleResultInt* tresi, GuExn* err)+{+ int rc;++ rc = open_triples(sg, 0, &tresi->tctxt, err);+ if (rc != SQLITE_OK)+ return rc;++ int i = 0;+ while (i < 3) {+ if (tresi->mem[i].flags != MEM_Null)+ break;+ i++;+ }++ tresi->cursor = tresi->tctxt.cursor[i];+ sqlite3BtreeInitUnpackedRecord(&tresi->idxKey, tresi->cursor, 0, 0, &tresi->mem[i]);+ tresi->res = 0;++ while (i+tresi->idxKey.nField < 3) {+ tresi->idxKey.nField++;++ if (tresi->mem[i+tresi->idxKey.nField].flags == MEM_Null)+ break;+ }++ if (tresi->idxKey.nField > 0) {+ tresi->idxKey.default_rc = 1;+ rc = sqlite3BtreeMovetoUnpacked(tresi->cursor,+ &tresi->idxKey, 0, 0, &tresi->res);+ if (rc == SQLITE_OK) {+ if (tresi->res < 0) {+ rc = sqlite3BtreeNext(tresi->cursor, &tresi->res);+ }+ tresi->res = 0;+ }+ } else {+ rc = sqlite3BtreeFirst(tresi->cursor, &tresi->res);+ }++ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ }++ return rc;+}++static bool+triple_result_fetch(SgSG* sg,+ SgTripleResultInt* tresi,+ SgId* pKey, GuExn* err)+{+ while (tresi->res == 0) {+ int rc;++ if (tresi->idxKey.nField > 0) {+ i64 szData;+ const unsigned char *zData;+ rc = sqlite3BtreeKeySize(tresi->cursor, &szData);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return false;+ }++ u32 available = 0;+ zData = sqlite3BtreeKeyFetch(tresi->cursor, &available);+ if (szData > available)+ gu_impossible();++ tresi->idxKey.default_rc = 0;+ tresi->res = sqlite3BtreeRecordCompare(available, zData, &tresi->idxKey);+ if (tresi->res != 0)+ return false;++ if (tresi->idxKey.aMem == &tresi->mem[0] &&+ tresi->idxKey.nField == 1 &&+ tresi->mem[2].flags != MEM_Null) {+ int offset = + zData[0] + + sqlite3BtreeSerialTypeLen(zData[1]) + + sqlite3BtreeSerialTypeLen(zData[2]);+ zData+offset;+ Mem mem;+ sqlite3BtreeSerialGet(zData+offset, zData[3], &mem);+ if (mem.u.i != tresi->mem[2].u.i) {+ sqlite3BtreeNext(tresi->cursor, &tresi->res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return false;+ }+ continue;+ }+ }++ rc = sqlite3BtreeIdxRowid(sg->pBtree, tresi->cursor, pKey);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return false;+ }++ rc = sqlite3BtreeMovetoUnpacked(tresi->tctxt.cursor[3], 0, *pKey, 0, &tresi->res);+ } else {+ rc = sqlite3BtreeKeySize(tresi->cursor, pKey);+ }+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return false;+ }++ return true;+ }++ return false;+}++SgTripleResult*+sg_query_triple(SgSG *sg, SgTriple triple, GuExn* err)+{+ int rc;++ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return NULL;+ }+ }++ SgTripleResult* tres = malloc(sizeof(SgTripleResult));+ tres->sg = sg;+ tres->triple[0] = triple[0];+ tres->triple[1] = triple[1];+ tres->triple[2] = triple[2];++ rc = open_exprs(sg, 0, false, &tres->ectxt, err);+ if (rc != SQLITE_OK)+ goto close;++ for (int i = 0; i < 3; i++) {+ if (gu_variant_is_null(triple[i]))+ tres->i.mem[i].flags = MEM_Null;+ else {+ tres->i.mem[i].flags = MEM_Int;+ rc = store_expr(sg, &tres->ectxt, triple[i], &tres->i.mem[i].u.i, 0);+ if (rc != SQLITE_OK)+ goto close;+ if (tres->i.mem[i].u.i == 0) {+ tres->i.res = 1;+ tres->i.tctxt.n_cursors = 0; // this is important since the triples are not initialized yet+ return tres;+ }+ }+ }++ rc = triple_result_init(sg, &tres->i, err);+ if (rc != SQLITE_OK) {+ return NULL;+ }++ return tres;++close:+ close_exprs(&tres->ectxt);++ if (sg->autoCommit) {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }++ free(tres);+ return NULL;+}++int+sg_triple_result_fetch(SgTripleResult* tres, SgId* pKey, SgTriple triple,+ GuPool* out_pool, GuExn* err)+{+ int rc;++ triple[0] = tres->triple[0];+ triple[1] = tres->triple[1];+ triple[2] = tres->triple[2];++ bool found =+ triple_result_fetch(tres->sg, &tres->i, pKey, err);+ if (!found)+ return 0;++ rc = load_triple(tres->i.tctxt.cursor[3], tres->ectxt.crsExprs,+ triple, out_pool);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return 0;+ }+ + sqlite3BtreeNext(tres->i.cursor, &tres->i.res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return 0;+ }++ return 1;+}++void+sg_triple_result_get_query(SgTripleResult* tres, SgTriple triple)+{+ triple[0] = tres->triple[0];+ triple[1] = tres->triple[1];+ triple[2] = tres->triple[2];+}++void+sg_triple_result_close(SgTripleResult* tres, GuExn* err)+{+ close_exprs(&tres->ectxt);+ close_triples(&tres->i.tctxt);++ if (tres->sg->autoCommit) {+ int rc = sqlite3BtreeCommit(tres->sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return;+ }+ }++ free(tres);+}++typedef int SgPattern[3];++struct SgQueryResult {+ SgSG* sg;++ size_t n_vars;+ struct {+ SgId id;+ PgfExpr expr;+ }* vars;++ size_t n_sels;+ int* sels;++ ExprContext ectxt;+ bool is_empty;++ size_t n_results;+ size_t n_patterns;+ struct {+ SgPattern pattern;+ SgTripleResultInt result;+ } triples[];+};++SgQueryResult*+sg_query(SgSG *sg, size_t n_triples, SgTriple* triples, GuExn* err)+{+ int rc;++ if (sg->autoCommit) {+ rc = sqlite3BtreeBeginTrans(sg->pBtree, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return NULL;+ }+ }++ SgQueryResult* qres = malloc(GU_FLEX_SIZE(SgQueryResult, triples, n_triples));+ qres->sg = sg;+ qres->is_empty = false;+ qres->n_results = 0;++ qres->n_vars = 0;+ qres->vars = malloc(sizeof(qres->vars[0])*n_triples*3);++ qres->n_sels = 0;+ qres->sels = malloc(sizeof(int)*n_triples*3);++ rc = open_exprs(sg, 0, false, &qres->ectxt, err);+ if (rc != SQLITE_OK)+ goto close;++ qres->n_patterns = n_triples;+ for (size_t i = 0; i < n_triples; i++) {+ for (int k = 0; k < 3; k++) {+ PgfExpr expr = triples[i][k];++ size_t j = 0;+ while (j < qres->n_vars) {+ if (pgf_expr_eq(expr, qres->vars[j].expr))+ break;+ j++;+ }+ if (j >= qres->n_vars) {+ qres->vars[j].expr = expr;++ if (gu_variant_tag(expr) == PGF_EXPR_META) {+ qres->vars[j].id = 0;+ qres->sels[qres->n_sels++] = j;+ qres->triples[i].result.mem[k].flags = MEM_Null;+ } else {+ rc = store_expr(sg, &qres->ectxt, expr, &qres->vars[j].id, 0);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ if (qres->vars[j].id == 0)+ goto close;++ qres->triples[i].result.mem[k].flags = MEM_Int;+ }++ qres->n_vars++;+ } else {+ qres->triples[i].result.mem[k].flags = MEM_Int;+ }++ qres->triples[i].pattern[k] = j;+ }+ }++ return qres;++close:+ qres->is_empty = true;++ close_exprs(&qres->ectxt);++ if (sg->autoCommit) {+ sqlite3BtreeRollback(sg->pBtree, SQLITE_ABORT_ROLLBACK, 0);+ }++ return qres;+}++size_t+sg_query_result_columns(SgQueryResult* qres) {+ return qres->n_sels;+}++static int+load_vars(SgQueryResult* qres, BtCursor* crsTriples, SgPattern pattern)+{+ int rc;++ u32 payloadSize;+ rc = sqlite3BtreeDataSize(crsTriples, &payloadSize);+ if (rc != SQLITE_OK)+ return rc;++ u32 avail = 0;+ const unsigned char* row = sqlite3BtreeDataFetch(crsTriples, &avail);+ row++;++ int serial_type_subj, serial_type_pred, serial_type_obj;+ row += getVarint32(row, serial_type_subj);+ row += getVarint32(row, serial_type_pred);+ row += getVarint32(row, serial_type_obj);+ row++;++ Mem mem[3];+ row += sqlite3BtreeSerialGet(row, serial_type_subj, &mem[0]);+ row += sqlite3BtreeSerialGet(row, serial_type_pred, &mem[1]);+ row += sqlite3BtreeSerialGet(row, serial_type_obj, &mem[2]);++ for (int i = 0; i < 3; i++) {+ qres->vars[pattern[i]].id = mem[i].u.i;+ }++ return SQLITE_OK;+}++int+query_result_next(SgQueryResult* qres, GuExn* err)+{+ if (qres->is_empty)+ return 0;++ int rc;++ SgId key;+ size_t i = (qres->n_results == 0) ? 0 : qres->n_results-1;+ while (i < qres->n_patterns) {+ if (i >= qres->n_results) {+ for (int k = 0; k < 3; k++) {+ qres->triples[i].result.mem[k].u.i = qres->vars[qres->triples[i].pattern[k]].id;+ }++ rc = triple_result_init(qres->sg, &qres->triples[i].result, err);+ if (rc != SQLITE_OK) {+ goto close;+ }++ qres->n_results++;+ }++ bool found =+ triple_result_fetch(qres->sg,+ &qres->triples[i].result,+ &key, err);+ if (gu_exn_is_raised(err)) {+ goto close;+ }++ if (found) {+ rc = sqlite3BtreeNext(qres->triples[i].result.cursor, &qres->triples[i].result.res);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ rc = load_vars(qres, qres->triples[i].result.tctxt.cursor[3], qres->triples[i].pattern);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ goto close;+ }++ i++;+ } else {+ close_triples(&qres->triples[i].result.tctxt);++ if (i == 0)+ goto close;++ i--;+ qres->n_results--;+ }+ }++close:+ qres->is_empty = true;+ return 0;+}++int+sg_query_result_fetch(SgQueryResult* qres, PgfExpr* res, + GuPool* out_pool, GuExn* err)+{+ if (!query_result_next(qres, err))+ return 0;++ for (size_t i = 0; i < qres->n_sels; i++) {+ int rc = load_expr(qres->ectxt.crsExprs,+ qres->vars[qres->sels[i]].id,+ &res[i], out_pool);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ qres->is_empty = true;+ return 0;+ }+ }++ return 1;+}++static PgfExpr+instantiate_expr(SgQueryResult* qres, PgfExpr expr,+ GuPool* out_pool, GuExn* err)+{+ PgfExpr new_expr = gu_null_variant;++ GuVariantInfo ei = gu_variant_open(expr);+ switch (ei.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* abs = ei.data;++ PgfExprAbs* new_abs =+ gu_new_variant(PGF_EXPR_ABS,+ PgfExprAbs,+ &new_expr, out_pool);+ new_abs->bind_type = abs->bind_type;+ new_abs->id = gu_string_copy(abs->id, out_pool);+ new_abs->body = instantiate_expr(qres, abs->body, out_pool, err);+ break;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* app = ei.data;+ + PgfExprApp* new_app =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &new_expr, out_pool);+ new_app->fun = instantiate_expr(qres, app->fun, out_pool, err);+ new_app->arg = instantiate_expr(qres, app->arg, out_pool, err);+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* lit = ei.data;++ PgfExprLit* new_lit =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &new_expr, out_pool);++ GuVariantInfo i = gu_variant_open(lit->lit);+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = i.data;++ PgfLiteralStr* new_lstr =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(lstr->val)+1,+ &new_lit->lit, out_pool);+ strcpy(new_lstr->val, lstr->val);+ break;+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = i.data;++ PgfLiteralInt* new_lint =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &new_lit->lit, out_pool);+ new_lint->val = lint->val;+ break;+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = i.data;++ PgfLiteralFlt* new_lflt =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &new_lit->lit, out_pool);+ new_lflt->val = lflt->val;+ break;+ }+ default:+ gu_impossible();+ }++ break;+ }+ case PGF_EXPR_META: {+ new_expr = expr;++ size_t j = 0;+ while (j < qres->n_vars) {+ if (pgf_expr_eq(expr, qres->vars[j].expr)) {+ + int rc = load_expr(qres->ectxt.crsExprs,+ qres->vars[j].id,+ &new_expr, out_pool);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ qres->is_empty = true;+ return new_expr;+ }+ break;+ }+ j++;+ }++ break;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* fun = ei.data;+ + PgfExprFun *new_fun =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(fun->fun)+1,+ &new_expr, out_pool);+ strcpy(new_fun->fun, fun->fun);+ break;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* var = ei.data;++ PgfExprVar* new_var =+ gu_new_variant(PGF_EXPR_VAR,+ PgfExprVar,+ &new_expr, out_pool);+ new_var->var = var->var;+ break;+ }+ case PGF_EXPR_TYPED: {+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* impl = ei.data;+ + PgfExprImplArg* new_impl =+ gu_new_variant(PGF_EXPR_IMPL_ARG,+ PgfExprImplArg,+ &new_expr, out_pool);+ new_impl->expr = instantiate_expr(qres, impl->expr, out_pool, err);+ break;+ }+ default:+ gu_impossible();+ }+ + return new_expr;+}++PgfExpr+sg_query_result_fetch_expr(SgQueryResult* qres, PgfExpr expr,+ GuPool* out_pool, GuExn* err)+{+ if (!query_result_next(qres, err))+ return gu_null_variant;++ return instantiate_expr(qres, expr, out_pool, err);+}++void+sg_query_result_close(SgQueryResult* qres, GuExn* err)+{+ while (qres->n_results > 0) {+ close_triples(&qres->triples[qres->n_results-1].result.tctxt);+ qres->n_results--;+ }++ close_exprs(&qres->ectxt);++ if (qres->sg->autoCommit) {+ int rc = sqlite3BtreeCommit(qres->sg->pBtree);+ if (rc != SQLITE_OK) {+ sg_raise_sqlite(rc, err);+ return;+ }+ }++ free(qres->vars);+ free(qres->sels);+ free(qres);+}
@@ -0,0 +1,94 @@+#ifndef SG_SG_H_+#define SG_SG_H_++typedef long long int SgId;++#include <gu/exn.h>+#include <pgf/pgf.h>++typedef struct SgSG SgSG;++SgSG*+sg_open(const char *filename, GuExn* err);++void+sg_close(SgSG *sg, GuExn* err);++void+sg_begin_trans(SgSG* sg, GuExn* err);++void+sg_commit(SgSG* sg, GuExn* err);++void+sg_rollback(SgSG* sg, GuExn* err);+++SgId+sg_insert_expr(SgSG *sg, PgfExpr expr, int wrFlag, GuExn* err);++PgfExpr+sg_get_expr(SgSG *sg, SgId key, GuPool* out_pool, GuExn* err);++typedef struct SgQueryExprResult SgQueryExprResult;++SgQueryExprResult*+sg_query_expr(SgSG *sg, PgfExpr expr, GuPool* pool, GuExn* err);++PgfExpr+sg_query_next(SgSG *sg, SgQueryExprResult* ctxt, SgId* pKey, GuPool* pool, GuExn* err);++void+sg_query_close(SgSG* sg, SgQueryExprResult* ctxt, GuExn* err);++void+sg_update_fts_index(SgSG* sg, PgfPGF* pgf, GuExn* err);++GuSeq*+sg_query_linearization(SgSG *sg, GuString tok, GuPool* pool, GuExn* err);+++typedef PgfExpr SgTriple[3];++SgId+sg_insert_triple(SgSG *sg, SgTriple triple, GuExn* err);++int+sg_get_triple(SgSG *sg, SgId key, SgTriple triple,+ GuPool* out_pool, GuExn* err);++typedef struct SgTripleResult SgTripleResult;++SgTripleResult*+sg_query_triple(SgSG *sg, SgTriple triple, GuExn* err);++int+sg_triple_result_fetch(SgTripleResult* tres, SgId* pKey, SgTriple triple,+ GuPool* out_pool, GuExn* err);++void+sg_triple_result_get_query(SgTripleResult* tres, SgTriple triple);++void+sg_triple_result_close(SgTripleResult* tres, GuExn* err);++typedef struct SgQueryResult SgQueryResult;++SgQueryResult*+sg_query(SgSG *sg, size_t n_triples, SgTriple* triples, GuExn* err);++size_t+sg_query_result_columns(SgQueryResult* qres);++int+sg_query_result_fetch_columns(SgQueryResult* qres, PgfExpr* res,+ GuPool* out_pool, GuExn* err);++PgfExpr+sg_query_result_fetch_expr(SgQueryResult* qres, PgfExpr expr,+ GuPool* out_pool, GuExn* err);++void+sg_query_result_close(SgQueryResult* qres, GuExn* err);++#endif
@@ -0,0 +1,48655 @@+/******************************************************************************+** This file is an amalgamation of many separate C source files from SQLite+** version 3.8.11.1. By combining all the individual C code files into this +** single large file, the entire code can be compiled as a single translation+** unit. This allows many compilers to do optimizations that would not be+** possible if the files were compiled separately. Performance improvements+** of 5% or more are commonly seen when SQLite is compiled as a single+** translation unit.+**+** This file is all you need to compile SQLite. To use SQLite in other+** programs, you need this file and the "sqliteBtree.h" header file that defines+** the programming interface to the SQLite library. (If you do not have +** the "sqliteBtree.h" header file at hand, you will find a copy embedded within+** the text of this file. Search for "Begin file sqliteBtree.h" to find the start+** of the embedded sqliteBtree.h header file.)+*/+#define SQLITE_CORE 1+#define SQLITE_AMALGAMATION 1+#ifndef SQLITE_PRIVATE+# define SQLITE_PRIVATE static+#endif+/************** Begin file sqliteInt.h ***************************************/+/*+** 2001 September 15+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** Internal interface definitions for SQLite.+**+*/+#ifndef _SQLITEINT_H_+#define _SQLITEINT_H_++/*+** Include the header file used to customize the compiler options for MSVC.+** This should be done first so that it can successfully prevent spurious+** compiler warnings due to subsequent content in this file and other files+** that are included by this file.+*/+/************** Include msvc.h in the middle of sqliteInt.h ******************/+/************** Begin file msvc.h ********************************************/+/*+** 2015 January 12+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains code that is specific to MSVC.+*/+#ifndef _MSVC_H_+#define _MSVC_H_++#if defined(_MSC_VER)+#pragma warning(disable : 4054)+#pragma warning(disable : 4055)+#pragma warning(disable : 4100)+#pragma warning(disable : 4127)+#pragma warning(disable : 4130)+#pragma warning(disable : 4152)+#pragma warning(disable : 4189)+#pragma warning(disable : 4206)+#pragma warning(disable : 4210)+#pragma warning(disable : 4232)+#pragma warning(disable : 4244)+#pragma warning(disable : 4305)+#pragma warning(disable : 4306)+#pragma warning(disable : 4702)+#pragma warning(disable : 4706)+#endif /* defined(_MSC_VER) */++#endif /* _MSVC_H_ */++/************** End of msvc.h ************************************************/+/************** Continuing where we left off in sqliteInt.h ******************/++/*+** Special setup for VxWorks+*/+/************** Include vxworks.h in the middle of sqliteInt.h ***************/+/************** Begin file vxworks.h *****************************************/+/*+** 2015-03-02+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains code that is specific to Wind River's VxWorks+*/+#if defined(__RTP__) || defined(_WRS_KERNEL)+/* This is VxWorks. Set up things specially for that OS+*/+#include <vxWorks.h>+#include <pthread.h> /* amalgamator: dontcache */+#define OS_VXWORKS 1+#define SQLITE_OS_OTHER 0+#define SQLITE_HOMEGROWN_RECURSIVE_MUTEX 1+#define SQLITE_ENABLE_LOCKING_STYLE 0+#define HAVE_UTIME 1+#else+/* This is not VxWorks. */+#define OS_VXWORKS 0+#endif /* defined(_WRS_KERNEL) */++/************** End of vxworks.h *********************************************/+/************** Continuing where we left off in sqliteInt.h ******************/++/*+** These #defines should enable >2GB file support on POSIX if the+** underlying operating system supports it. If the OS lacks+** large file support, or if the OS is windows, these should be no-ops.+**+** Ticket #2739: The _LARGEFILE_SOURCE macro must appear before any+** system #includes. Hence, this block of code must be the very first+** code in all source files.+**+** Large file support can be disabled using the -DSQLITE_DISABLE_LFS switch+** on the compiler command line. This is necessary if you are compiling+** on a recent machine (ex: Red Hat 7.2) but you want your code to work+** on an older machine (ex: Red Hat 6.0). If you compile on Red Hat 7.2+** without this option, LFS is enable. But LFS does not exist in the kernel+** in Red Hat 6.0, so the code won't work. Hence, for maximum binary+** portability you should omit LFS.+**+** The previous paragraph was written in 2005. (This paragraph is written+** on 2008-11-28.) These days, all Linux kernels support large files, so+** you should probably leave LFS enabled. But some embedded platforms might+** lack LFS in which case the SQLITE_DISABLE_LFS macro might still be useful.+**+** Similar is true for Mac OS X. LFS is only supported on Mac OS X 9 and later.+*/+#ifndef SQLITE_DISABLE_LFS+# define _LARGE_FILE 1+# ifndef _FILE_OFFSET_BITS+# define _FILE_OFFSET_BITS 64+# endif+# define _LARGEFILE_SOURCE 1+#endif++/* What version of GCC is being used. 0 means GCC is not being used */+#ifdef __GNUC__+# define GCC_VERSION (__GNUC__*1000000+__GNUC_MINOR__*1000+__GNUC_PATCHLEVEL__)+#else+# define GCC_VERSION 0+#endif++/* Needed for various definitions... */+#if defined(__GNUC__) && !defined(_GNU_SOURCE)+# define _GNU_SOURCE+#endif++#if defined(__OpenBSD__) && !defined(_BSD_SOURCE)+# define _BSD_SOURCE+#endif++/*+** For MinGW, check to see if we can include the header file containing its+** version information, among other things. Normally, this internal MinGW+** header file would [only] be included automatically by other MinGW header+** files; however, the contained version information is now required by this+** header file to work around binary compatibility issues (see below) and+** this is the only known way to reliably obtain it. This entire #if block+** would be completely unnecessary if there was any other way of detecting+** MinGW via their preprocessor (e.g. if they customized their GCC to define+** some MinGW-specific macros). When compiling for MinGW, either the+** _HAVE_MINGW_H or _HAVE__MINGW_H (note the extra underscore) macro must be+** defined; otherwise, detection of conditions specific to MinGW will be+** disabled.+*/+#if defined(_HAVE_MINGW_H)+# include "mingw.h"+#elif defined(_HAVE__MINGW_H)+# include "_mingw.h"+#endif++/*+** For MinGW version 4.x (and higher), check to see if the _USE_32BIT_TIME_T+** define is required to maintain binary compatibility with the MSVC runtime+** library in use (e.g. for Windows XP).+*/+#if !defined(_USE_32BIT_TIME_T) && !defined(_USE_64BIT_TIME_T) && \+ defined(_WIN32) && !defined(_WIN64) && \+ defined(__MINGW_MAJOR_VERSION) && __MINGW_MAJOR_VERSION >= 4 && \+ defined(__MSVCRT__)+# define _USE_32BIT_TIME_T+#endif++#include "sqlite3Btree.h"++#include <stdio.h>+#include <stdarg.h> /* Needed for the definition of va_list */++/*+** Provide the ability to override linkage features of the interface.+*/+#ifndef SQLITE_EXTERN+# define SQLITE_EXTERN extern+#endif+#ifndef SQLITE_API+# define SQLITE_API+#endif+#ifndef SQLITE_CDECL+# define SQLITE_CDECL+#endif+#ifndef SQLITE_STDCALL+# define SQLITE_STDCALL+#endif++/*+** CAPI3REF: Compile-Time Library Version Numbers+**+** ^(The [SQLITE_VERSION] C preprocessor macro in the sqlite3.h header+** evaluates to a string literal that is the SQLite version in the+** format "X.Y.Z" where X is the major version number (always 3 for+** SQLite3) and Y is the minor version number and Z is the release number.)^+** ^(The [SQLITE_VERSION_NUMBER] C preprocessor macro resolves to an integer+** with the value (X*1000000 + Y*1000 + Z) where X, Y, and Z are the same+** numbers used in [SQLITE_VERSION].)^+** The SQLITE_VERSION_NUMBER for any given release of SQLite will also+** be larger than the release from which it is derived. Either Y will+** be held constant and Z will be incremented or else Y will be incremented+** and Z will be reset to zero.+**+** Since version 3.6.18, SQLite source code has been stored in the+** <a href="http://www.fossil-scm.org/">Fossil configuration management+** system</a>. ^The SQLITE_SOURCE_ID macro evaluates to+** a string which identifies a particular check-in of SQLite+** within its configuration management system. ^The SQLITE_SOURCE_ID+** string contains the date and time of the check-in (UTC) and an SHA1+** hash of the entire source tree.+**+** See also: [sqlite3_libversion()],+** [sqlite3_libversion_number()], [sqlite3_sourceid()],+** [sqlite_version()] and [sqlite_source_id()].+*/+#define SQLITE_VERSION "3.8.11.1"+#define SQLITE_VERSION_NUMBER 3008011+#define SQLITE_SOURCE_ID "2015-07-29 20:00:57 cf538e2783e468bbc25e7cb2a9ee64d3e0e80b2f"++/*+** CAPI3REF: Device Characteristics+**+** The xDeviceCharacteristics method of the [sqlite3_io_methods]+** object returns an integer which is a vector of these+** bit values expressing I/O characteristics of the mass storage+** device that holds the file that the [sqlite3_io_methods]+** refers to.+**+** The SQLITE_IOCAP_ATOMIC property means that all writes of+** any size are atomic. The SQLITE_IOCAP_ATOMICnnn values+** mean that writes of blocks that are nnn bytes in size and+** are aligned to an address which is an integer multiple of+** nnn are atomic. The SQLITE_IOCAP_SAFE_APPEND value means+** that when data is appended to a file, the data is appended+** first then the size of the file is extended, never the other+** way around. The SQLITE_IOCAP_SEQUENTIAL property means that+** information is written to disk in the same order as calls+** to xWrite(). The SQLITE_IOCAP_POWERSAFE_OVERWRITE property means that+** after reboot following a crash or power loss, the only bytes in a+** file that were written at the application level might have changed+** and that adjacent bytes, even bytes within the same sector are+** guaranteed to be unchanged. The SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN+** flag indicate that a file cannot be deleted when open. The+** SQLITE_IOCAP_IMMUTABLE flag indicates that the file is on+** read-only media and cannot be changed even by processes with+** elevated privileges.+*/+#define SQLITE_IOCAP_ATOMIC 0x00000001+#define SQLITE_IOCAP_ATOMIC512 0x00000002+#define SQLITE_IOCAP_ATOMIC1K 0x00000004+#define SQLITE_IOCAP_ATOMIC2K 0x00000008+#define SQLITE_IOCAP_ATOMIC4K 0x00000010+#define SQLITE_IOCAP_ATOMIC8K 0x00000020+#define SQLITE_IOCAP_ATOMIC16K 0x00000040+#define SQLITE_IOCAP_ATOMIC32K 0x00000080+#define SQLITE_IOCAP_ATOMIC64K 0x00000100+#define SQLITE_IOCAP_SAFE_APPEND 0x00000200+#define SQLITE_IOCAP_SEQUENTIAL 0x00000400+#define SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN 0x00000800+#define SQLITE_IOCAP_POWERSAFE_OVERWRITE 0x00001000+#define SQLITE_IOCAP_IMMUTABLE 0x00002000++/*+** CAPI3REF: File Locking Levels+**+** SQLite uses one of these integer values as the second+** argument to calls it makes to the xLock() and xUnlock() methods+** of an [sqlite3_io_methods] object.+*/+#define SQLITE_LOCK_NONE 0+#define SQLITE_LOCK_SHARED 1+#define SQLITE_LOCK_RESERVED 2+#define SQLITE_LOCK_PENDING 3+#define SQLITE_LOCK_EXCLUSIVE 4++/*+** CAPI3REF: Synchronization Type Flags+**+** When SQLite invokes the xSync() method of an+** [sqlite3_io_methods] object it uses a combination of+** these integer values as the second argument.+**+** When the SQLITE_SYNC_DATAONLY flag is used, it means that the+** sync operation only needs to flush data to mass storage. Inode+** information need not be flushed. If the lower four bits of the flag+** equal SQLITE_SYNC_NORMAL, that means to use normal fsync() semantics.+** If the lower four bits equal SQLITE_SYNC_FULL, that means+** to use Mac OS X style fullsync instead of fsync().+**+** Do not confuse the SQLITE_SYNC_NORMAL and SQLITE_SYNC_FULL flags+** with the [PRAGMA synchronous]=NORMAL and [PRAGMA synchronous]=FULL+** settings. The [synchronous pragma] determines when calls to the+** xSync VFS method occur and applies uniformly across all platforms.+** The SQLITE_SYNC_NORMAL and SQLITE_SYNC_FULL flags determine how+** energetic or rigorous or forceful the sync operations are and+** only make a difference on Mac OSX for the default SQLite code.+** (Third-party VFS implementations might also make the distinction+** between SQLITE_SYNC_NORMAL and SQLITE_SYNC_FULL, but among the+** operating systems natively supported by SQLite, only Mac OSX+** cares about the difference.)+*/+#define SQLITE_SYNC_NORMAL 0x00002+#define SQLITE_SYNC_FULL 0x00003+#define SQLITE_SYNC_DATAONLY 0x00010++/*+** CAPI3REF: OS Interface Open File Handle+**+** An [sqlite3_file] object represents an open file in the +** [sqlite3_vfs | OS interface layer]. Individual OS interface+** implementations will+** want to subclass this object by appending additional fields+** for their own use. The pMethods entry is a pointer to an+** [sqlite3_io_methods] object that defines methods for performing+** I/O operations on the open file.+*/+typedef struct sqlite3_file sqlite3_file;+struct sqlite3_file {+ const struct sqlite3_io_methods *pMethods; /* Methods for an open file */+};++/*+** CAPI3REF: OS Interface File Virtual Methods Object+**+** Every file opened by the [sqlite3_vfs.xOpen] method populates an+** [sqlite3_file] object (or, more commonly, a subclass of the+** [sqlite3_file] object) with a pointer to an instance of this object.+** This object defines the methods used to perform various operations+** against the open file represented by the [sqlite3_file] object.+**+** If the [sqlite3_vfs.xOpen] method sets the sqlite3_file.pMethods element +** to a non-NULL pointer, then the sqlite3_io_methods.xClose method+** may be invoked even if the [sqlite3_vfs.xOpen] reported that it failed. The+** only way to prevent a call to xClose following a failed [sqlite3_vfs.xOpen]+** is for the [sqlite3_vfs.xOpen] to set the sqlite3_file.pMethods element+** to NULL.+**+** The flags argument to xSync may be one of [SQLITE_SYNC_NORMAL] or+** [SQLITE_SYNC_FULL]. The first choice is the normal fsync().+** The second choice is a Mac OS X style fullsync. The [SQLITE_SYNC_DATAONLY]+** flag may be ORed in to indicate that only the data of the file+** and not its inode needs to be synced.+**+** The integer values to xLock() and xUnlock() are one of+** <ul>+** <li> [SQLITE_LOCK_NONE],+** <li> [SQLITE_LOCK_SHARED],+** <li> [SQLITE_LOCK_RESERVED],+** <li> [SQLITE_LOCK_PENDING], or+** <li> [SQLITE_LOCK_EXCLUSIVE].+** </ul>+** xLock() increases the lock. xUnlock() decreases the lock.+** The xCheckReservedLock() method checks whether any database connection,+** either in this process or in some other process, is holding a RESERVED,+** PENDING, or EXCLUSIVE lock on the file. It returns true+** if such a lock exists and false otherwise.+**+** The xFileControl() method is a generic interface that allows custom+** VFS implementations to directly control an open file using the+** [sqlite3_file_control()] interface. The second "op" argument is an+** integer opcode. The third argument is a generic pointer intended to+** point to a structure that may contain arguments or space in which to+** write return values. Potential uses for xFileControl() might be+** functions to enable blocking locks with timeouts, to change the+** locking strategy (for example to use dot-file locks), to inquire+** about the status of a lock, or to break stale locks. The SQLite+** core reserves all opcodes less than 100 for its own use.+** A [file control opcodes | list of opcodes] less than 100 is available.+** Applications that define a custom xFileControl method should use opcodes+** greater than 100 to avoid conflicts. VFS implementations should+** return [SQLITE_NOTFOUND] for file control opcodes that they do not+** recognize.+**+** The xSectorSize() method returns the sector size of the+** device that underlies the file. The sector size is the+** minimum write that can be performed without disturbing+** other bytes in the file. The xDeviceCharacteristics()+** method returns a bit vector describing behaviors of the+** underlying device:+**+** <ul>+** <li> [SQLITE_IOCAP_ATOMIC]+** <li> [SQLITE_IOCAP_ATOMIC512]+** <li> [SQLITE_IOCAP_ATOMIC1K]+** <li> [SQLITE_IOCAP_ATOMIC2K]+** <li> [SQLITE_IOCAP_ATOMIC4K]+** <li> [SQLITE_IOCAP_ATOMIC8K]+** <li> [SQLITE_IOCAP_ATOMIC16K]+** <li> [SQLITE_IOCAP_ATOMIC32K]+** <li> [SQLITE_IOCAP_ATOMIC64K]+** <li> [SQLITE_IOCAP_SAFE_APPEND]+** <li> [SQLITE_IOCAP_SEQUENTIAL]+** </ul>+**+** The SQLITE_IOCAP_ATOMIC property means that all writes of+** any size are atomic. The SQLITE_IOCAP_ATOMICnnn values+** mean that writes of blocks that are nnn bytes in size and+** are aligned to an address which is an integer multiple of+** nnn are atomic. The SQLITE_IOCAP_SAFE_APPEND value means+** that when data is appended to a file, the data is appended+** first then the size of the file is extended, never the other+** way around. The SQLITE_IOCAP_SEQUENTIAL property means that+** information is written to disk in the same order as calls+** to xWrite().+**+** If xRead() returns SQLITE_IOERR_SHORT_READ it must also fill+** in the unread portions of the buffer with zeros. A VFS that+** fails to zero-fill short reads might seem to work. However,+** failure to zero-fill short reads will eventually lead to+** database corruption.+*/+typedef struct sqlite3_io_methods sqlite3_io_methods;+struct sqlite3_io_methods {+ int iVersion;+ int (*xClose)(sqlite3_file*);+ int (*xRead)(sqlite3_file*, void*, int iAmt, sqlite3_int64 iOfst);+ int (*xWrite)(sqlite3_file*, const void*, int iAmt, sqlite3_int64 iOfst);+ int (*xTruncate)(sqlite3_file*, sqlite3_int64 size);+ int (*xSync)(sqlite3_file*, int flags);+ int (*xFileSize)(sqlite3_file*, sqlite3_int64 *pSize);+ int (*xLock)(sqlite3_file*, int);+ int (*xUnlock)(sqlite3_file*, int);+ int (*xCheckReservedLock)(sqlite3_file*, int *pResOut);+ int (*xFileControl)(sqlite3_file*, int op, void *pArg);+ int (*xSectorSize)(sqlite3_file*);+ int (*xDeviceCharacteristics)(sqlite3_file*);+ /* Methods above are valid for version 1 */+ int (*xShmMap)(sqlite3_file*, int iPg, int pgsz, int, void volatile**);+ int (*xShmLock)(sqlite3_file*, int offset, int n, int flags);+ void (*xShmBarrier)(sqlite3_file*);+ int (*xShmUnmap)(sqlite3_file*, int deleteFlag);+ /* Methods above are valid for version 2 */+ int (*xFetch)(sqlite3_file*, sqlite3_int64 iOfst, int iAmt, void **pp);+ int (*xUnfetch)(sqlite3_file*, sqlite3_int64 iOfst, void *p);+ /* Methods above are valid for version 3 */+ /* Additional methods may be added in future releases */+};++/*+** CAPI3REF: Standard File Control Opcodes+** KEYWORDS: {file control opcodes} {file control opcode}+**+** These integer constants are opcodes for the xFileControl method+** of the [sqlite3_io_methods] object and for the [sqlite3_file_control()]+** interface.+**+** <ul>+** <li>[[SQLITE_FCNTL_LOCKSTATE]]+** The [SQLITE_FCNTL_LOCKSTATE] opcode is used for debugging. This+** opcode causes the xFileControl method to write the current state of+** the lock (one of [SQLITE_LOCK_NONE], [SQLITE_LOCK_SHARED],+** [SQLITE_LOCK_RESERVED], [SQLITE_LOCK_PENDING], or [SQLITE_LOCK_EXCLUSIVE])+** into an integer that the pArg argument points to. This capability+** is used during testing and is only available when the SQLITE_TEST+** compile-time option is used.+**+** <li>[[SQLITE_FCNTL_SIZE_HINT]]+** The [SQLITE_FCNTL_SIZE_HINT] opcode is used by SQLite to give the VFS+** layer a hint of how large the database file will grow to be during the+** current transaction. This hint is not guaranteed to be accurate but it+** is often close. The underlying VFS might choose to preallocate database+** file space based on this hint in order to help writes to the database+** file run faster.+**+** <li>[[SQLITE_FCNTL_CHUNK_SIZE]]+** The [SQLITE_FCNTL_CHUNK_SIZE] opcode is used to request that the VFS+** extends and truncates the database file in chunks of a size specified+** by the user. The fourth argument to [sqlite3_file_control()] should +** point to an integer (type int) containing the new chunk-size to use+** for the nominated database. Allocating database file space in large+** chunks (say 1MB at a time), may reduce file-system fragmentation and+** improve performance on some systems.+**+** <li>[[SQLITE_FCNTL_FILE_POINTER]]+** The [SQLITE_FCNTL_FILE_POINTER] opcode is used to obtain a pointer+** to the [sqlite3_file] object associated with a particular database+** connection. See the [sqlite3_file_control()] documentation for+** additional information.+**+** <li>[[SQLITE_FCNTL_SYNC_OMITTED]]+** No longer in use.+**+** <li>[[SQLITE_FCNTL_SYNC]]+** The [SQLITE_FCNTL_SYNC] opcode is generated internally by SQLite and+** sent to the VFS immediately before the xSync method is invoked on a+** database file descriptor. Or, if the xSync method is not invoked +** because the user has configured SQLite with +** [PRAGMA synchronous | PRAGMA synchronous=OFF] it is invoked in place +** of the xSync method. In most cases, the pointer argument passed with+** this file-control is NULL. However, if the database file is being synced+** as part of a multi-database commit, the argument points to a nul-terminated+** string containing the transactions master-journal file name. VFSes that +** do not need this signal should silently ignore this opcode. Applications +** should not call [sqlite3_file_control()] with this opcode as doing so may +** disrupt the operation of the specialized VFSes that do require it. +**+** <li>[[SQLITE_FCNTL_COMMIT_PHASETWO]]+** The [SQLITE_FCNTL_COMMIT_PHASETWO] opcode is generated internally by SQLite+** and sent to the VFS after a transaction has been committed immediately+** but before the database is unlocked. VFSes that do not need this signal+** should silently ignore this opcode. Applications should not call+** [sqlite3_file_control()] with this opcode as doing so may disrupt the +** operation of the specialized VFSes that do require it. +**+** <li>[[SQLITE_FCNTL_WIN32_AV_RETRY]]+** ^The [SQLITE_FCNTL_WIN32_AV_RETRY] opcode is used to configure automatic+** retry counts and intervals for certain disk I/O operations for the+** windows [VFS] in order to provide robustness in the presence of+** anti-virus programs. By default, the windows VFS will retry file read,+** file write, and file delete operations up to 10 times, with a delay+** of 25 milliseconds before the first retry and with the delay increasing+** by an additional 25 milliseconds with each subsequent retry. This+** opcode allows these two values (10 retries and 25 milliseconds of delay)+** to be adjusted. The values are changed for all database connections+** within the same process. The argument is a pointer to an array of two+** integers where the first integer i the new retry count and the second+** integer is the delay. If either integer is negative, then the setting+** is not changed but instead the prior value of that setting is written+** into the array entry, allowing the current retry settings to be+** interrogated. The zDbName parameter is ignored.+**+** <li>[[SQLITE_FCNTL_PERSIST_WAL]]+** ^The [SQLITE_FCNTL_PERSIST_WAL] opcode is used to set or query the+** persistent [WAL | Write Ahead Log] setting. By default, the auxiliary+** write ahead log and shared memory files used for transaction control+** are automatically deleted when the latest connection to the database+** closes. Setting persistent WAL mode causes those files to persist after+** close. Persisting the files is useful when other processes that do not+** have write permission on the directory containing the database file want+** to read the database file, as the WAL and shared memory files must exist+** in order for the database to be readable. The fourth parameter to+** [sqlite3_file_control()] for this opcode should be a pointer to an integer.+** That integer is 0 to disable persistent WAL mode or 1 to enable persistent+** WAL mode. If the integer is -1, then it is overwritten with the current+** WAL persistence setting.+**+** <li>[[SQLITE_FCNTL_POWERSAFE_OVERWRITE]]+** ^The [SQLITE_FCNTL_POWERSAFE_OVERWRITE] opcode is used to set or query the+** persistent "powersafe-overwrite" or "PSOW" setting. The PSOW setting+** determines the [SQLITE_IOCAP_POWERSAFE_OVERWRITE] bit of the+** xDeviceCharacteristics methods. The fourth parameter to+** [sqlite3_file_control()] for this opcode should be a pointer to an integer.+** That integer is 0 to disable zero-damage mode or 1 to enable zero-damage+** mode. If the integer is -1, then it is overwritten with the current+** zero-damage mode setting.+**+** <li>[[SQLITE_FCNTL_OVERWRITE]]+** ^The [SQLITE_FCNTL_OVERWRITE] opcode is invoked by SQLite after opening+** a write transaction to indicate that, unless it is rolled back for some+** reason, the entire database file will be overwritten by the current +** transaction. This is used by VACUUM operations.+**+** <li>[[SQLITE_FCNTL_VFSNAME]]+** ^The [SQLITE_FCNTL_VFSNAME] opcode can be used to obtain the names of+** all [VFSes] in the VFS stack. The names are of all VFS shims and the+** final bottom-level VFS are written into memory obtained from +** [sqlite3_malloc()] and the result is stored in the char* variable+** that the fourth parameter of [sqlite3_file_control()] points to.+** The caller is responsible for freeing the memory when done. As with+** all file-control actions, there is no guarantee that this will actually+** do anything. Callers should initialize the char* variable to a NULL+** pointer in case this file-control is not implemented. This file-control+** is intended for diagnostic use only.+**+** <li>[[SQLITE_FCNTL_PRAGMA]]+** ^Whenever a [PRAGMA] statement is parsed, an [SQLITE_FCNTL_PRAGMA] +** file control is sent to the open [sqlite3_file] object corresponding+** to the database file to which the pragma statement refers. ^The argument+** to the [SQLITE_FCNTL_PRAGMA] file control is an array of+** pointers to strings (char**) in which the second element of the array+** is the name of the pragma and the third element is the argument to the+** pragma or NULL if the pragma has no argument. ^The handler for an+** [SQLITE_FCNTL_PRAGMA] file control can optionally make the first element+** of the char** argument point to a string obtained from [sqlite3_mprintf()]+** or the equivalent and that string will become the result of the pragma or+** the error message if the pragma fails. ^If the+** [SQLITE_FCNTL_PRAGMA] file control returns [SQLITE_NOTFOUND], then normal +** [PRAGMA] processing continues. ^If the [SQLITE_FCNTL_PRAGMA]+** file control returns [SQLITE_OK], then the parser assumes that the+** VFS has handled the PRAGMA itself and the parser generates a no-op+** prepared statement if result string is NULL, or that returns a copy+** of the result string if the string is non-NULL.+** ^If the [SQLITE_FCNTL_PRAGMA] file control returns+** any result code other than [SQLITE_OK] or [SQLITE_NOTFOUND], that means+** that the VFS encountered an error while handling the [PRAGMA] and the+** compilation of the PRAGMA fails with an error. ^The [SQLITE_FCNTL_PRAGMA]+** file control occurs at the beginning of pragma statement analysis and so+** it is able to override built-in [PRAGMA] statements.+**+** <li>[[SQLITE_FCNTL_BUSYHANDLER]]+** ^The [SQLITE_FCNTL_BUSYHANDLER]+** file-control may be invoked by SQLite on the database file handle+** shortly after it is opened in order to provide a custom VFS with access+** to the connections busy-handler callback. The argument is of type (void **)+** - an array of two (void *) values. The first (void *) actually points+** to a function of type (int (*)(void *)). In order to invoke the connections+** busy-handler, this function should be invoked with the second (void *) in+** the array as the only argument. If it returns non-zero, then the operation+** should be retried. If it returns zero, the custom VFS should abandon the+** current operation.+**+** <li>[[SQLITE_FCNTL_TEMPFILENAME]]+** ^Application can invoke the [SQLITE_FCNTL_TEMPFILENAME] file-control+** to have SQLite generate a+** temporary filename using the same algorithm that is followed to generate+** temporary filenames for TEMP tables and other internal uses. The+** argument should be a char** which will be filled with the filename+** written into memory obtained from [sqlite3_malloc()]. The caller should+** invoke [sqlite3_free()] on the result to avoid a memory leak.+**+** <li>[[SQLITE_FCNTL_MMAP_SIZE]]+** The [SQLITE_FCNTL_MMAP_SIZE] file control is used to query or set the+** maximum number of bytes that will be used for memory-mapped I/O.+** The argument is a pointer to a value of type sqlite3_int64 that+** is an advisory maximum number of bytes in the file to memory map. The+** pointer is overwritten with the old value. The limit is not changed if+** the value originally pointed to is negative, and so the current limit +** can be queried by passing in a pointer to a negative number. This+** file-control is used internally to implement [PRAGMA mmap_size].+**+** <li>[[SQLITE_FCNTL_TRACE]]+** The [SQLITE_FCNTL_TRACE] file control provides advisory information+** to the VFS about what the higher layers of the SQLite stack are doing.+** This file control is used by some VFS activity tracing [shims].+** The argument is a zero-terminated string. Higher layers in the+** SQLite stack may generate instances of this file control if+** the [SQLITE_USE_FCNTL_TRACE] compile-time option is enabled.+**+** <li>[[SQLITE_FCNTL_HAS_MOVED]]+** The [SQLITE_FCNTL_HAS_MOVED] file control interprets its argument as a+** pointer to an integer and it writes a boolean into that integer depending+** on whether or not the file has been renamed, moved, or deleted since it+** was first opened.+**+** <li>[[SQLITE_FCNTL_WIN32_SET_HANDLE]]+** The [SQLITE_FCNTL_WIN32_SET_HANDLE] opcode is used for debugging. This+** opcode causes the xFileControl method to swap the file handle with the one+** pointed to by the pArg argument. This capability is used during testing+** and only needs to be supported when SQLITE_TEST is defined.+**+** <li>[[SQLITE_FCNTL_WAL_BLOCK]]+** The [SQLITE_FCNTL_WAL_BLOCK] is a signal to the VFS layer that it might+** be advantageous to block on the next WAL lock if the lock is not immediately+** available. The WAL subsystem issues this signal during rare+** circumstances in order to fix a problem with priority inversion.+** Applications should <em>not</em> use this file-control.+**+** <li>[[SQLITE_FCNTL_ZIPVFS]]+** The [SQLITE_FCNTL_ZIPVFS] opcode is implemented by zipvfs only. All other+** VFS should return SQLITE_NOTFOUND for this opcode.+**+** <li>[[SQLITE_FCNTL_RBU]]+** The [SQLITE_FCNTL_RBU] opcode is implemented by the special VFS used by+** the RBU extension only. All other VFS should return SQLITE_NOTFOUND for+** this opcode. +** </ul>+*/+#define SQLITE_FCNTL_LOCKSTATE 1+#define SQLITE_FCNTL_GET_LOCKPROXYFILE 2+#define SQLITE_FCNTL_SET_LOCKPROXYFILE 3+#define SQLITE_FCNTL_LAST_ERRNO 4+#define SQLITE_FCNTL_SIZE_HINT 5+#define SQLITE_FCNTL_CHUNK_SIZE 6+#define SQLITE_FCNTL_FILE_POINTER 7+#define SQLITE_FCNTL_SYNC_OMITTED 8+#define SQLITE_FCNTL_WIN32_AV_RETRY 9+#define SQLITE_FCNTL_PERSIST_WAL 10+#define SQLITE_FCNTL_OVERWRITE 11+#define SQLITE_FCNTL_VFSNAME 12+#define SQLITE_FCNTL_POWERSAFE_OVERWRITE 13+#define SQLITE_FCNTL_PRAGMA 14+#define SQLITE_FCNTL_BUSYHANDLER 15+#define SQLITE_FCNTL_TEMPFILENAME 16+#define SQLITE_FCNTL_MMAP_SIZE 18+#define SQLITE_FCNTL_TRACE 19+#define SQLITE_FCNTL_HAS_MOVED 20+#define SQLITE_FCNTL_SYNC 21+#define SQLITE_FCNTL_COMMIT_PHASETWO 22+#define SQLITE_FCNTL_WIN32_SET_HANDLE 23+#define SQLITE_FCNTL_WAL_BLOCK 24+#define SQLITE_FCNTL_ZIPVFS 25+#define SQLITE_FCNTL_RBU 26++/*+** CAPI3REF: Mutex Handle+**+** The mutex module within SQLite defines [sqlite3_mutex] to be an+** abstract type for a mutex object. The SQLite core never looks+** at the internal representation of an [sqlite3_mutex]. It only+** deals with pointers to the [sqlite3_mutex] object.+**+** Mutexes are created using [sqlite3_mutex_alloc()].+*/+typedef struct sqlite3_mutex sqlite3_mutex;++/*+** CAPI3REF: OS Interface Object+**+** An instance of the sqlite3_vfs object defines the interface between+** the SQLite core and the underlying operating system. The "vfs"+** in the name of the object stands for "virtual file system". See+** the [VFS | VFS documentation] for further information.+**+** The value of the iVersion field is initially 1 but may be larger in+** future versions of SQLite. Additional fields may be appended to this+** object when the iVersion value is increased. Note that the structure+** of the sqlite3_vfs object changes in the transaction between+** SQLite version 3.5.9 and 3.6.0 and yet the iVersion field was not+** modified.+**+** The szOsFile field is the size of the subclassed [sqlite3_file]+** structure used by this VFS. mxPathname is the maximum length of+** a pathname in this VFS.+**+** Registered sqlite3_vfs objects are kept on a linked list formed by+** the pNext pointer. The [sqlite3_vfs_register()] interface manages+** this list in a thread-safe way. The [sqlite3_vfs_find()] interface+** searches the list. Neither the application code nor the VFS+** implementation should use the pNext pointer.+**+** The pNext field is the only field in the sqlite3_vfs+** structure that SQLite will ever modify. SQLite will only access+** or modify this field while holding a particular static mutex.+** The application should never modify anything within the sqlite3_vfs+** object once the object has been registered.+**+** The zName field holds the name of the VFS module. The name must+** be unique across all VFS modules.+**+** [[sqlite3_vfs.xOpen]]+** ^SQLite guarantees that the zFilename parameter to xOpen+** is either a NULL pointer or string obtained+** from xFullPathname() with an optional suffix added.+** ^If a suffix is added to the zFilename parameter, it will+** consist of a single "-" character followed by no more than+** 11 alphanumeric and/or "-" characters.+** ^SQLite further guarantees that+** the string will be valid and unchanged until xClose() is+** called. Because of the previous sentence,+** the [sqlite3_file] can safely store a pointer to the+** filename if it needs to remember the filename for some reason.+** If the zFilename parameter to xOpen is a NULL pointer then xOpen+** must invent its own temporary name for the file. ^Whenever the +** xFilename parameter is NULL it will also be the case that the+** flags parameter will include [SQLITE_OPEN_DELETEONCLOSE].+**+** The flags argument to xOpen() includes all bits set in+** the flags argument to [sqlite3_open_v2()]. Or if [sqlite3_open()]+** or [sqlite3_open16()] is used, then flags includes at least+** [SQLITE_OPEN_READWRITE] | [SQLITE_OPEN_CREATE]. +** If xOpen() opens a file read-only then it sets *pOutFlags to+** include [SQLITE_OPEN_READONLY]. Other bits in *pOutFlags may be set.+**+** ^(SQLite will also add one of the following flags to the xOpen()+** call, depending on the object being opened:+**+** <ul>+** <li> [SQLITE_OPEN_MAIN_DB]+** <li> [SQLITE_OPEN_MAIN_JOURNAL]+** <li> [SQLITE_OPEN_TEMP_DB]+** <li> [SQLITE_OPEN_TEMP_JOURNAL]+** <li> [SQLITE_OPEN_TRANSIENT_DB]+** <li> [SQLITE_OPEN_SUBJOURNAL]+** <li> [SQLITE_OPEN_MASTER_JOURNAL]+** <li> [SQLITE_OPEN_WAL]+** </ul>)^+**+** The file I/O implementation can use the object type flags to+** change the way it deals with files. For example, an application+** that does not care about crash recovery or rollback might make+** the open of a journal file a no-op. Writes to this journal would+** also be no-ops, and any attempt to read the journal would return+** SQLITE_IOERR. Or the implementation might recognize that a database+** file will be doing page-aligned sector reads and writes in a random+** order and set up its I/O subsystem accordingly.+**+** SQLite might also add one of the following flags to the xOpen method:+**+** <ul>+** <li> [SQLITE_OPEN_DELETEONCLOSE]+** <li> [SQLITE_OPEN_EXCLUSIVE]+** </ul>+**+** The [SQLITE_OPEN_DELETEONCLOSE] flag means the file should be+** deleted when it is closed. ^The [SQLITE_OPEN_DELETEONCLOSE]+** will be set for TEMP databases and their journals, transient+** databases, and subjournals.+**+** ^The [SQLITE_OPEN_EXCLUSIVE] flag is always used in conjunction+** with the [SQLITE_OPEN_CREATE] flag, which are both directly+** analogous to the O_EXCL and O_CREAT flags of the POSIX open()+** API. The SQLITE_OPEN_EXCLUSIVE flag, when paired with the +** SQLITE_OPEN_CREATE, is used to indicate that file should always+** be created, and that it is an error if it already exists.+** It is <i>not</i> used to indicate the file should be opened +** for exclusive access.+**+** ^At least szOsFile bytes of memory are allocated by SQLite+** to hold the [sqlite3_file] structure passed as the third+** argument to xOpen. The xOpen method does not have to+** allocate the structure; it should just fill it in. Note that+** the xOpen method must set the sqlite3_file.pMethods to either+** a valid [sqlite3_io_methods] object or to NULL. xOpen must do+** this even if the open fails. SQLite expects that the sqlite3_file.pMethods+** element will be valid after xOpen returns regardless of the success+** or failure of the xOpen call.+**+** [[sqlite3_vfs.xAccess]]+** ^The flags argument to xAccess() may be [SQLITE_ACCESS_EXISTS]+** to test for the existence of a file, or [SQLITE_ACCESS_READWRITE] to+** test whether a file is readable and writable, or [SQLITE_ACCESS_READ]+** to test whether a file is at least readable. The file can be a+** directory.+**+** ^SQLite will always allocate at least mxPathname+1 bytes for the+** output buffer xFullPathname. The exact size of the output buffer+** is also passed as a parameter to both methods. If the output buffer+** is not large enough, [SQLITE_CANTOPEN] should be returned. Since this is+** handled as a fatal error by SQLite, vfs implementations should endeavor+** to prevent this by setting mxPathname to a sufficiently large value.+**+** The xRandomness(), xSleep(), xCurrentTime(), and xCurrentTimeInt64()+** interfaces are not strictly a part of the filesystem, but they are+** included in the VFS structure for completeness.+** The xRandomness() function attempts to return nBytes bytes+** of good-quality randomness into zOut. The return value is+** the actual number of bytes of randomness obtained.+** The xSleep() method causes the calling thread to sleep for at+** least the number of microseconds given. ^The xCurrentTime()+** method returns a Julian Day Number for the current date and time as+** a floating point value.+** ^The xCurrentTimeInt64() method returns, as an integer, the Julian+** Day Number multiplied by 86400000 (the number of milliseconds in +** a 24-hour day). +** ^SQLite will use the xCurrentTimeInt64() method to get the current+** date and time if that method is available (if iVersion is 2 or +** greater and the function pointer is not NULL) and will fall back+** to xCurrentTime() if xCurrentTimeInt64() is unavailable.+**+** ^The xSetSystemCall(), xGetSystemCall(), and xNestSystemCall() interfaces+** are not used by the SQLite core. These optional interfaces are provided+** by some VFSes to facilitate testing of the VFS code. By overriding +** system calls with functions under its control, a test program can+** simulate faults and error conditions that would otherwise be difficult+** or impossible to induce. The set of system calls that can be overridden+** varies from one VFS to another, and from one version of the same VFS to the+** next. Applications that use these interfaces must be prepared for any+** or all of these interfaces to be NULL or for their behavior to change+** from one release to the next. Applications must not attempt to access+** any of these methods if the iVersion of the VFS is less than 3.+*/+typedef struct sqlite3_vfs sqlite3_vfs;+typedef void (*sqlite3_syscall_ptr)(void);+struct sqlite3_vfs {+ int iVersion; /* Structure version number (currently 3) */+ int szOsFile; /* Size of subclassed sqlite3_file */+ int mxPathname; /* Maximum file pathname length */+ sqlite3_vfs *pNext; /* Next registered VFS */+ const char *zName; /* Name of this virtual file system */+ void *pAppData; /* Pointer to application-specific data */+ int (*xOpen)(sqlite3_vfs*, const char *zName, sqlite3_file*,+ int flags, int *pOutFlags);+ int (*xDelete)(sqlite3_vfs*, const char *zName, int syncDir);+ int (*xAccess)(sqlite3_vfs*, const char *zName, int flags, int *pResOut);+ int (*xFullPathname)(sqlite3_vfs*, const char *zName, int nOut, char *zOut);+ void *(*xDlOpen)(sqlite3_vfs*, const char *zFilename);+ void (*xDlError)(sqlite3_vfs*, int nByte, char *zErrMsg);+ void (*(*xDlSym)(sqlite3_vfs*,void*, const char *zSymbol))(void);+ void (*xDlClose)(sqlite3_vfs*, void*);+ int (*xRandomness)(sqlite3_vfs*, int nByte, char *zOut);+ int (*xSleep)(sqlite3_vfs*, int microseconds);+ int (*xCurrentTime)(sqlite3_vfs*, double*);+ int (*xGetLastError)(sqlite3_vfs*, int, char *);+ /*+ ** The methods above are in version 1 of the sqlite_vfs object+ ** definition. Those that follow are added in version 2 or later+ */+ int (*xCurrentTimeInt64)(sqlite3_vfs*, sqlite3_int64*);+ /*+ ** The methods above are in versions 1 and 2 of the sqlite_vfs object.+ ** Those below are for version 3 and greater.+ */+ int (*xSetSystemCall)(sqlite3_vfs*, const char *zName, sqlite3_syscall_ptr);+ sqlite3_syscall_ptr (*xGetSystemCall)(sqlite3_vfs*, const char *zName);+ const char *(*xNextSystemCall)(sqlite3_vfs*, const char *zName);+ /*+ ** The methods above are in versions 1 through 3 of the sqlite_vfs object.+ ** New fields may be appended in figure versions. The iVersion+ ** value will increment whenever this happens. + */+};++/*+** CAPI3REF: Flags for the xAccess VFS method+**+** These integer constants can be used as the third parameter to+** the xAccess method of an [sqlite3_vfs] object. They determine+** what kind of permissions the xAccess method is looking for.+** With SQLITE_ACCESS_EXISTS, the xAccess method+** simply checks whether the file exists.+** With SQLITE_ACCESS_READWRITE, the xAccess method+** checks whether the named directory is both readable and writable+** (in other words, if files can be added, removed, and renamed within+** the directory).+** The SQLITE_ACCESS_READWRITE constant is currently used only by the+** [temp_store_directory pragma], though this could change in a future+** release of SQLite.+** With SQLITE_ACCESS_READ, the xAccess method+** checks whether the file is readable. The SQLITE_ACCESS_READ constant is+** currently unused, though it might be used in a future release of+** SQLite.+*/+#define SQLITE_ACCESS_EXISTS 0+#define SQLITE_ACCESS_READWRITE 1 /* Used by PRAGMA temp_store_directory */+#define SQLITE_ACCESS_READ 2 /* Unused */++/*+** CAPI3REF: Flags for the xShmLock VFS method+**+** These integer constants define the various locking operations+** allowed by the xShmLock method of [sqlite3_io_methods]. The+** following are the only legal combinations of flags to the+** xShmLock method:+**+** <ul>+** <li> SQLITE_SHM_LOCK | SQLITE_SHM_SHARED+** <li> SQLITE_SHM_LOCK | SQLITE_SHM_EXCLUSIVE+** <li> SQLITE_SHM_UNLOCK | SQLITE_SHM_SHARED+** <li> SQLITE_SHM_UNLOCK | SQLITE_SHM_EXCLUSIVE+** </ul>+**+** When unlocking, the same SHARED or EXCLUSIVE flag must be supplied as+** was given on the corresponding lock. +**+** The xShmLock method can transition between unlocked and SHARED or+** between unlocked and EXCLUSIVE. It cannot transition between SHARED+** and EXCLUSIVE.+*/+#define SQLITE_SHM_UNLOCK 1+#define SQLITE_SHM_LOCK 2+#define SQLITE_SHM_SHARED 4+#define SQLITE_SHM_EXCLUSIVE 8++/*+** CAPI3REF: Maximum xShmLock index+**+** The xShmLock method on [sqlite3_io_methods] may use values+** between 0 and this upper bound as its "offset" argument.+** The SQLite core will never attempt to acquire or release a+** lock outside of this range+*/+#define SQLITE_SHM_NLOCK 8++SQLITE_PRIVATE int sqlite3_os_init(void);+SQLITE_PRIVATE int sqlite3_os_end(void);++/*+** CAPI3REF: Configuring The SQLite Library+**+** The sqlite3_config() interface is used to make global configuration+** changes to SQLite in order to tune SQLite to the specific needs of+** the application. The default configuration is recommended for most+** applications and so this routine is usually not necessary. It is+** provided to support rare applications with unusual needs.+**+** <b>The sqlite3_config() interface is not threadsafe. The application+** must ensure that no other SQLite interfaces are invoked by other+** threads while sqlite3_config() is running.</b>+**+** The sqlite3_config() interface+** may only be invoked prior to library initialization using+** [sqlite3BtreeInitialize()] or after shutdown by [sqlite3BtreeShutdown()].+** ^If sqlite3_config() is called after [sqlite3BtreeInitialize()] and before+** [sqlite3BtreeShutdown()] then it will return SQLITE_MISUSE.+** Note, however, that ^sqlite3_config() can be called as part of the+** implementation of an application-defined [sqlite3_os_init()].+**+** The first argument to sqlite3_config() is an integer+** [configuration option] that determines+** what property of SQLite is to be configured. Subsequent arguments+** vary depending on the [configuration option]+** in the first argument.+**+** ^When a configuration option is set, sqlite3_config() returns [SQLITE_OK].+** ^If the option is unknown or SQLite is unable to set the option+** then this routine returns a non-zero [error code].+*/+SQLITE_PRIVATE int sqlite3_config(int, ...);++/*+** CAPI3REF: Memory Allocation Routines+**+** An instance of this object defines the interface between SQLite+** and low-level memory allocation routines.+**+** This object is used in only one place in the SQLite interface.+** A pointer to an instance of this object is the argument to+** [sqlite3_config()] when the configuration option is+** [SQLITE_CONFIG_MALLOC] or [SQLITE_CONFIG_GETMALLOC]. +** By creating an instance of this object+** and passing it to [sqlite3_config]([SQLITE_CONFIG_MALLOC])+** during configuration, an application can specify an alternative+** memory allocation subsystem for SQLite to use for all of its+** dynamic memory needs.+**+** Note that SQLite comes with several [built-in memory allocators]+** that are perfectly adequate for the overwhelming majority of applications+** and that this object is only useful to a tiny minority of applications+** with specialized memory allocation requirements. This object is+** also used during testing of SQLite in order to specify an alternative+** memory allocator that simulates memory out-of-memory conditions in+** order to verify that SQLite recovers gracefully from such+** conditions.+**+** The xMalloc, xRealloc, and xFree methods must work like the+** malloc(), realloc() and free() functions from the standard C library.+** ^SQLite guarantees that the second argument to+** xRealloc is always a value returned by a prior call to xRoundup.+**+** xSize should return the allocated size of a memory allocation+** previously obtained from xMalloc or xRealloc. The allocated size+** is always at least as big as the requested size but may be larger.+**+** The xRoundup method returns what would be the allocated size of+** a memory allocation given a particular requested size. Most memory+** allocators round up memory allocations at least to the next multiple+** of 8. Some allocators round up to a larger multiple or to a power of 2.+** Every memory allocation request coming in through [sqlite3_malloc()]+** or [sqlite3_realloc()] first calls xRoundup. If xRoundup returns 0, +** that causes the corresponding memory allocation to fail.+**+** The xInit method initializes the memory allocator. For example,+** it might allocate any require mutexes or initialize internal data+** structures. The xShutdown method is invoked (indirectly) by+** [sqlite3BtreeShutdown()] and should deallocate any resources acquired+** by xInit. The pAppData pointer is used as the only parameter to+** xInit and xShutdown.+**+** SQLite holds the [SQLITE_MUTEX_STATIC_MASTER] mutex when it invokes+** the xInit method, so the xInit method need not be threadsafe. The+** xShutdown method is only called from [sqlite3BtreeShutdown()] so it does+** not need to be threadsafe either. For all other methods, SQLite+** holds the [SQLITE_MUTEX_STATIC_MEM] mutex as long as the+** [SQLITE_CONFIG_MEMSTATUS] configuration option is turned on (which+** it is by default) and so the methods are automatically serialized.+** However, if [SQLITE_CONFIG_MEMSTATUS] is disabled, then the other+** methods must be threadsafe or else make their own arrangements for+** serialization.+**+** SQLite will never invoke xInit() more than once without an intervening+** call to xShutdown().+*/+typedef struct sqlite3_mem_methods sqlite3_mem_methods;+struct sqlite3_mem_methods {+ void *(*xMalloc)(int); /* Memory allocation function */+ void (*xFree)(void*); /* Free a prior allocation */+ void *(*xRealloc)(void*,int); /* Resize an allocation */+ int (*xSize)(void*); /* Return the size of an allocation */+ int (*xRoundup)(int); /* Round up request size to allocation size */+ int (*xInit)(void*); /* Initialize the memory allocator */+ void (*xShutdown)(void*); /* Deinitialize the memory allocator */+ void *pAppData; /* Argument to xInit() and xShutdown() */+};++/*+** CAPI3REF: Configuration Options+** KEYWORDS: {configuration option}+**+** These constants are the available integer configuration options that+** can be passed as the first argument to the [sqlite3_config()] interface.+**+** New configuration options may be added in future releases of SQLite.+** Existing configuration options might be discontinued. Applications+** should check the return code from [sqlite3_config()] to make sure that+** the call worked. The [sqlite3_config()] interface will return a+** non-zero [error code] if a discontinued or unsupported configuration option+** is invoked.+**+** <dl>+** [[SQLITE_CONFIG_SINGLETHREAD]] <dt>SQLITE_CONFIG_SINGLETHREAD</dt>+** <dd>There are no arguments to this option. ^This option sets the+** [threading mode] to Single-thread. In other words, it disables+** all mutexing and puts SQLite into a mode where it can only be used+** by a single thread. ^If SQLite is compiled with+** the [SQLITE_THREADSAFE | SQLITE_THREADSAFE=0] compile-time option then+** it is not possible to change the [threading mode] from its default+** value of Single-thread and so [sqlite3_config()] will return +** [SQLITE_ERROR] if called with the SQLITE_CONFIG_SINGLETHREAD+** configuration option.</dd>+**+** [[SQLITE_CONFIG_MULTITHREAD]] <dt>SQLITE_CONFIG_MULTITHREAD</dt>+** <dd>There are no arguments to this option. ^This option sets the+** [threading mode] to Multi-thread. In other words, it disables+** mutexing on [database connection] and [prepared statement] objects.+** The application is responsible for serializing access to+** [database connections] and [prepared statements]. But other mutexes+** are enabled so that SQLite will be safe to use in a multi-threaded+** environment as long as no two threads attempt to use the same+** [database connection] at the same time. ^If SQLite is compiled with+** the [SQLITE_THREADSAFE | SQLITE_THREADSAFE=0] compile-time option then+** it is not possible to set the Multi-thread [threading mode] and+** [sqlite3_config()] will return [SQLITE_ERROR] if called with the+** SQLITE_CONFIG_MULTITHREAD configuration option.</dd>+**+** [[SQLITE_CONFIG_SERIALIZED]] <dt>SQLITE_CONFIG_SERIALIZED</dt>+** <dd>There are no arguments to this option. ^This option sets the+** [threading mode] to Serialized. In other words, this option enables+** all mutexes including the recursive+** mutexes on [database connection] and [prepared statement] objects.+** In this mode (which is the default when SQLite is compiled with+** [SQLITE_THREADSAFE=1]) the SQLite library will itself serialize access+** to [database connections] and [prepared statements] so that the+** application is free to use the same [database connection] or the+** same [prepared statement] in different threads at the same time.+** ^If SQLite is compiled with+** the [SQLITE_THREADSAFE | SQLITE_THREADSAFE=0] compile-time option then+** it is not possible to set the Serialized [threading mode] and+** [sqlite3_config()] will return [SQLITE_ERROR] if called with the+** SQLITE_CONFIG_SERIALIZED configuration option.</dd>+**+** [[SQLITE_CONFIG_MALLOC]] <dt>SQLITE_CONFIG_MALLOC</dt>+** <dd> ^(The SQLITE_CONFIG_MALLOC option takes a single argument which is +** a pointer to an instance of the [sqlite3_mem_methods] structure.+** The argument specifies+** alternative low-level memory allocation routines to be used in place of+** the memory allocation routines built into SQLite.)^ ^SQLite makes+** its own private copy of the content of the [sqlite3_mem_methods] structure+** before the [sqlite3_config()] call returns.</dd>+**+** [[SQLITE_CONFIG_GETMALLOC]] <dt>SQLITE_CONFIG_GETMALLOC</dt>+** <dd> ^(The SQLITE_CONFIG_GETMALLOC option takes a single argument which+** is a pointer to an instance of the [sqlite3_mem_methods] structure.+** The [sqlite3_mem_methods]+** structure is filled with the currently defined memory allocation routines.)^+** This option can be used to overload the default memory allocation+** routines with a wrapper that simulations memory allocation failure or+** tracks memory usage, for example. </dd>+**+** [[SQLITE_CONFIG_MEMSTATUS]] <dt>SQLITE_CONFIG_MEMSTATUS</dt>+** <dd> ^The SQLITE_CONFIG_MEMSTATUS option takes single argument of type int,+** interpreted as a boolean, which enables or disables the collection of+** memory allocation statistics. ^(When memory allocation statistics are+** disabled, the following SQLite interfaces become non-operational:+** <ul>+** <li> [sqlite3_memory_used()]+** <li> [sqlite3_memory_highwater()]+** <li> [sqlite3_soft_heap_limit64()]+** <li> [sqlite3_status64()]+** </ul>)^+** ^Memory allocation statistics are enabled by default unless SQLite is+** compiled with [SQLITE_DEFAULT_MEMSTATUS]=0 in which case memory+** allocation statistics are disabled by default.+** </dd>+**+** [[SQLITE_CONFIG_SCRATCH]] <dt>SQLITE_CONFIG_SCRATCH</dt>+** <dd> ^The SQLITE_CONFIG_SCRATCH option specifies a static memory buffer+** that SQLite can use for scratch memory. ^(There are three arguments+** to SQLITE_CONFIG_SCRATCH: A pointer an 8-byte+** aligned memory buffer from which the scratch allocations will be+** drawn, the size of each scratch allocation (sz),+** and the maximum number of scratch allocations (N).)^+** The first argument must be a pointer to an 8-byte aligned buffer+** of at least sz*N bytes of memory.+** ^SQLite will not use more than one scratch buffers per thread.+** ^SQLite will never request a scratch buffer that is more than 6+** times the database page size.+** ^If SQLite needs needs additional+** scratch memory beyond what is provided by this configuration option, then +** [sqlite3_malloc()] will be used to obtain the memory needed.<p>+** ^When the application provides any amount of scratch memory using+** SQLITE_CONFIG_SCRATCH, SQLite avoids unnecessary large+** [sqlite3_malloc|heap allocations].+** This can help [Robson proof|prevent memory allocation failures] due to heap+** fragmentation in low-memory embedded systems.+** </dd>+**+** [[SQLITE_CONFIG_PAGECACHE]] <dt>SQLITE_CONFIG_PAGECACHE</dt>+** <dd> ^The SQLITE_CONFIG_PAGECACHE option specifies a static memory buffer+** that SQLite can use for the database page cache with the default page+** cache implementation. +** This configuration should not be used if an application-define page+** cache implementation is loaded using the [SQLITE_CONFIG_PCACHE2]+** configuration option.+** ^There are three arguments to SQLITE_CONFIG_PAGECACHE: A pointer to+** 8-byte aligned+** memory, the size of each page buffer (sz), and the number of pages (N).+** The sz argument should be the size of the largest database page+** (a power of two between 512 and 65536) plus some extra bytes for each+** page header. ^The number of extra bytes needed by the page header+** can be determined using the [SQLITE_CONFIG_PCACHE_HDRSZ] option +** to [sqlite3_config()].+** ^It is harmless, apart from the wasted memory,+** for the sz parameter to be larger than necessary. The first+** argument should pointer to an 8-byte aligned block of memory that+** is at least sz*N bytes of memory, otherwise subsequent behavior is+** undefined.+** ^SQLite will use the memory provided by the first argument to satisfy its+** memory needs for the first N pages that it adds to cache. ^If additional+** page cache memory is needed beyond what is provided by this option, then+** SQLite goes to [sqlite3_malloc()] for the additional storage space.</dd>+**+** [[SQLITE_CONFIG_HEAP]] <dt>SQLITE_CONFIG_HEAP</dt>+** <dd> ^The SQLITE_CONFIG_HEAP option specifies a static memory buffer +** that SQLite will use for all of its dynamic memory allocation needs+** beyond those provided for by [SQLITE_CONFIG_SCRATCH] and+** [SQLITE_CONFIG_PAGECACHE].+** ^The SQLITE_CONFIG_HEAP option is only available if SQLite is compiled+** with either [SQLITE_ENABLE_MEMSYS3] or [SQLITE_ENABLE_MEMSYS5] and returns+** [SQLITE_ERROR] if invoked otherwise.+** ^There are three arguments to SQLITE_CONFIG_HEAP:+** An 8-byte aligned pointer to the memory,+** the number of bytes in the memory buffer, and the minimum allocation size.+** ^If the first pointer (the memory pointer) is NULL, then SQLite reverts+** to using its default memory allocator (the system malloc() implementation),+** undoing any prior invocation of [SQLITE_CONFIG_MALLOC]. ^If the+** memory pointer is not NULL then the alternative memory+** allocator is engaged to handle all of SQLites memory allocation needs.+** The first pointer (the memory pointer) must be aligned to an 8-byte+** boundary or subsequent behavior of SQLite will be undefined.+** The minimum allocation size is capped at 2**12. Reasonable values+** for the minimum allocation size are 2**5 through 2**8.</dd>+**+** [[SQLITE_CONFIG_MUTEX]] <dt>SQLITE_CONFIG_MUTEX</dt>+** <dd> ^(The SQLITE_CONFIG_MUTEX option takes a single argument which is a+** pointer to an instance of the [sqlite3_mutex_methods] structure.+** The argument specifies alternative low-level mutex routines to be used+** in place the mutex routines built into SQLite.)^ ^SQLite makes a copy of+** the content of the [sqlite3_mutex_methods] structure before the call to+** [sqlite3_config()] returns. ^If SQLite is compiled with+** the [SQLITE_THREADSAFE | SQLITE_THREADSAFE=0] compile-time option then+** the entire mutexing subsystem is omitted from the build and hence calls to+** [sqlite3_config()] with the SQLITE_CONFIG_MUTEX configuration option will+** return [SQLITE_ERROR].</dd>+**+** [[SQLITE_CONFIG_GETMUTEX]] <dt>SQLITE_CONFIG_GETMUTEX</dt>+** <dd> ^(The SQLITE_CONFIG_GETMUTEX option takes a single argument which+** is a pointer to an instance of the [sqlite3_mutex_methods] structure. The+** [sqlite3_mutex_methods]+** structure is filled with the currently defined mutex routines.)^+** This option can be used to overload the default mutex allocation+** routines with a wrapper used to track mutex usage for performance+** profiling or testing, for example. ^If SQLite is compiled with+** the [SQLITE_THREADSAFE | SQLITE_THREADSAFE=0] compile-time option then+** the entire mutexing subsystem is omitted from the build and hence calls to+** [sqlite3_config()] with the SQLITE_CONFIG_GETMUTEX configuration option will+** return [SQLITE_ERROR].</dd>+**+** [[SQLITE_CONFIG_LOOKASIDE]] <dt>SQLITE_CONFIG_LOOKASIDE</dt>+** <dd> ^(The SQLITE_CONFIG_LOOKASIDE option takes two arguments that determine+** the default size of lookaside memory on each [database connection].+** The first argument is the+** size of each lookaside buffer slot and the second is the number of+** slots allocated to each database connection.)^ ^(SQLITE_CONFIG_LOOKASIDE+** sets the <i>default</i> lookaside size. The [SQLITE_DBCONFIG_LOOKASIDE]+** option to [sqlite3_db_config()] can be used to change the lookaside+** configuration on individual connections.)^ </dd>+**+** [[SQLITE_CONFIG_PCACHE2]] <dt>SQLITE_CONFIG_PCACHE2</dt>+** <dd> ^(The SQLITE_CONFIG_PCACHE2 option takes a single argument which is +** a pointer to an [sqlite3_pcache_methods2] object. This object specifies+** the interface to a custom page cache implementation.)^+** ^SQLite makes a copy of the [sqlite3_pcache_methods2] object.</dd>+**+** [[SQLITE_CONFIG_GETPCACHE2]] <dt>SQLITE_CONFIG_GETPCACHE2</dt>+** <dd> ^(The SQLITE_CONFIG_GETPCACHE2 option takes a single argument which+** is a pointer to an [sqlite3_pcache_methods2] object. SQLite copies of+** the current page cache implementation into that object.)^ </dd>+**+** [[SQLITE_CONFIG_LOG]] <dt>SQLITE_CONFIG_LOG</dt>+** <dd> The SQLITE_CONFIG_LOG option is used to configure the SQLite+** global [error log].+** (^The SQLITE_CONFIG_LOG option takes two arguments: a pointer to a+** function with a call signature of void(*)(void*,int,const char*), +** and a pointer to void. ^If the function pointer is not NULL, it is+** invoked by [sqlite3_log()] to process each logging event. ^If the+** function pointer is NULL, the [sqlite3_log()] interface becomes a no-op.+** ^The void pointer that is the second argument to SQLITE_CONFIG_LOG is+** passed through as the first parameter to the application-defined logger+** function whenever that function is invoked. ^The second parameter to+** the logger function is a copy of the first parameter to the corresponding+** [sqlite3_log()] call and is intended to be a [result code] or an+** [extended result code]. ^The third parameter passed to the logger is+** log message after formatting via [sqlite3_snprintf()].+** The SQLite logging interface is not reentrant; the logger function+** supplied by the application must not invoke any SQLite interface.+** In a multi-threaded application, the application-defined logger+** function must be threadsafe. </dd>+**+** [[SQLITE_CONFIG_URI]] <dt>SQLITE_CONFIG_URI+** <dd>^(The SQLITE_CONFIG_URI option takes a single argument of type int.+** If non-zero, then URI handling is globally enabled. If the parameter is zero,+** then URI handling is globally disabled.)^ ^If URI handling is globally+** enabled, all filenames passed to [sqlite3_open()], [sqlite3_open_v2()],+** [sqlite3_open16()] or+** specified as part of [ATTACH] commands are interpreted as URIs, regardless+** of whether or not the [SQLITE_OPEN_URI] flag is set when the database+** connection is opened. ^If it is globally disabled, filenames are+** only interpreted as URIs if the SQLITE_OPEN_URI flag is set when the+** database connection is opened. ^(By default, URI handling is globally+** disabled. The default value may be changed by compiling with the+** [SQLITE_USE_URI] symbol defined.)^+**+** [[SQLITE_CONFIG_COVERING_INDEX_SCAN]] <dt>SQLITE_CONFIG_COVERING_INDEX_SCAN+** <dd>^The SQLITE_CONFIG_COVERING_INDEX_SCAN option takes a single integer+** argument which is interpreted as a boolean in order to enable or disable+** the use of covering indices for full table scans in the query optimizer.+** ^The default setting is determined+** by the [SQLITE_ALLOW_COVERING_INDEX_SCAN] compile-time option, or is "on"+** if that compile-time option is omitted.+** The ability to disable the use of covering indices for full table scans+** is because some incorrectly coded legacy applications might malfunction+** when the optimization is enabled. Providing the ability to+** disable the optimization allows the older, buggy application code to work+** without change even with newer versions of SQLite.+**+** [[SQLITE_CONFIG_PCACHE]] [[SQLITE_CONFIG_GETPCACHE]]+** <dt>SQLITE_CONFIG_PCACHE and SQLITE_CONFIG_GETPCACHE+** <dd> These options are obsolete and should not be used by new code.+** They are retained for backwards compatibility but are now no-ops.+** </dd>+**+** [[SQLITE_CONFIG_MMAP_SIZE]]+** <dt>SQLITE_CONFIG_MMAP_SIZE+** <dd>^SQLITE_CONFIG_MMAP_SIZE takes two 64-bit integer (sqlite3_int64) values+** that are the default mmap size limit (the default setting for+** [PRAGMA mmap_size]) and the maximum allowed mmap size limit.+** ^The default setting can be overridden by each database connection using+** either the [PRAGMA mmap_size] command, or by using the+** [SQLITE_FCNTL_MMAP_SIZE] file control. ^(The maximum allowed mmap size+** will be silently truncated if necessary so that it does not exceed the+** compile-time maximum mmap size set by the+** [SQLITE_MAX_MMAP_SIZE] compile-time option.)^+** ^If either argument to this option is negative, then that argument is+** changed to its compile-time default.+**+** [[SQLITE_CONFIG_WIN32_HEAPSIZE]]+** <dt>SQLITE_CONFIG_WIN32_HEAPSIZE+** <dd>^The SQLITE_CONFIG_WIN32_HEAPSIZE option is only available if SQLite is+** compiled for Windows with the [SQLITE_WIN32_MALLOC] pre-processor macro+** defined. ^SQLITE_CONFIG_WIN32_HEAPSIZE takes a 32-bit unsigned integer value+** that specifies the maximum size of the created heap.+**+** [[SQLITE_CONFIG_PCACHE_HDRSZ]]+** <dt>SQLITE_CONFIG_PCACHE_HDRSZ+** <dd>^The SQLITE_CONFIG_PCACHE_HDRSZ option takes a single parameter which+** is a pointer to an integer and writes into that integer the number of extra+** bytes per page required for each page in [SQLITE_CONFIG_PAGECACHE].+** The amount of extra space required can change depending on the compiler,+** target platform, and SQLite version.+**+** [[SQLITE_CONFIG_PMASZ]]+** <dt>SQLITE_CONFIG_PMASZ+** <dd>^The SQLITE_CONFIG_PMASZ option takes a single parameter which+** is an unsigned integer and sets the "Minimum PMA Size" for the multithreaded+** sorter to that integer. The default minimum PMA Size is set by the+** [SQLITE_SORTER_PMASZ] compile-time option. New threads are launched+** to help with sort operations when multithreaded sorting+** is enabled (using the [PRAGMA threads] command) and the amount of content+** to be sorted exceeds the page size times the minimum of the+** [PRAGMA cache_size] setting and this value.+** </dl>+*/+#define SQLITE_CONFIG_SINGLETHREAD 1 /* nil */+#define SQLITE_CONFIG_MULTITHREAD 2 /* nil */+#define SQLITE_CONFIG_SERIALIZED 3 /* nil */+#define SQLITE_CONFIG_MALLOC 4 /* sqlite3_mem_methods* */+#define SQLITE_CONFIG_GETMALLOC 5 /* sqlite3_mem_methods* */+#define SQLITE_CONFIG_SCRATCH 6 /* void*, int sz, int N */+#define SQLITE_CONFIG_PAGECACHE 7 /* void*, int sz, int N */+#define SQLITE_CONFIG_HEAP 8 /* void*, int nByte, int min */+#define SQLITE_CONFIG_MEMSTATUS 9 /* boolean */+#define SQLITE_CONFIG_MUTEX 10 /* sqlite3_mutex_methods* */+#define SQLITE_CONFIG_GETMUTEX 11 /* sqlite3_mutex_methods* */+/* previously SQLITE_CONFIG_CHUNKALLOC 12 which is now unused. */ +#define SQLITE_CONFIG_LOOKASIDE 13 /* int int */+#define SQLITE_CONFIG_PCACHE 14 /* no-op */+#define SQLITE_CONFIG_GETPCACHE 15 /* no-op */+#define SQLITE_CONFIG_LOG 16 /* xFunc, void* */+#define SQLITE_CONFIG_URI 17 /* int */+#define SQLITE_CONFIG_PCACHE2 18 /* sqlite3_pcache_methods2* */+#define SQLITE_CONFIG_GETPCACHE2 19 /* sqlite3_pcache_methods2* */+#define SQLITE_CONFIG_COVERING_INDEX_SCAN 20 /* int */+#define SQLITE_CONFIG_SQLLOG 21 /* xSqllog, void* */+#define SQLITE_CONFIG_MMAP_SIZE 22 /* sqlite3_int64, sqlite3_int64 */+#define SQLITE_CONFIG_WIN32_HEAPSIZE 23 /* int nByte */+#define SQLITE_CONFIG_PCACHE_HDRSZ 24 /* int *psz */+#define SQLITE_CONFIG_PMASZ 25 /* unsigned int szPma */++/*+** CAPI3REF: Formatted String Printing Functions+**+** These routines are work-alikes of the "printf()" family of functions+** from the standard C library.+** These routines understand most of the common K&R formatting options,+** plus some additional non-standard formats, detailed below.+** Note that some of the more obscure formatting options from recent+** C-library standards are omitted from this implementation.+**+** ^The sqlite3_mprintf() and sqlite3_vmprintf() routines write their+** results into memory obtained from [sqlite3_malloc()].+** The strings returned by these two routines should be+** released by [sqlite3_free()]. ^Both routines return a+** NULL pointer if [sqlite3_malloc()] is unable to allocate enough+** memory to hold the resulting string.+**+** ^(The sqlite3_snprintf() routine is similar to "snprintf()" from+** the standard C library. The result is written into the+** buffer supplied as the second parameter whose size is given by+** the first parameter. Note that the order of the+** first two parameters is reversed from snprintf().)^ This is an+** historical accident that cannot be fixed without breaking+** backwards compatibility. ^(Note also that sqlite3_snprintf()+** returns a pointer to its buffer instead of the number of+** characters actually written into the buffer.)^ We admit that+** the number of characters written would be a more useful return+** value but we cannot change the implementation of sqlite3_snprintf()+** now without breaking compatibility.+**+** ^As long as the buffer size is greater than zero, sqlite3_snprintf()+** guarantees that the buffer is always zero-terminated. ^The first+** parameter "n" is the total size of the buffer, including space for+** the zero terminator. So the longest string that can be completely+** written will be n-1 characters.+**+** ^The sqlite3_vsnprintf() routine is a varargs version of sqlite3_snprintf().+**+** These routines all implement some additional formatting+** options that are useful for constructing SQL statements.+** All of the usual printf() formatting options apply. In addition, there+** is are "%q", "%Q", "%w" and "%z" options.+**+** ^(The %q option works like %s in that it substitutes a nul-terminated+** string from the argument list. But %q also doubles every '\'' character.+** %q is designed for use inside a string literal.)^ By doubling each '\''+** character it escapes that character and allows it to be inserted into+** the string.+**+** For example, assume the string variable zText contains text as follows:+**+** <blockquote><pre>+** char *zText = "It's a happy day!";+** </pre></blockquote>+**+** One can use this text in an SQL statement as follows:+**+** <blockquote><pre>+** char *zSQL = sqlite3_mprintf("INSERT INTO table VALUES('%q')", zText);+** sqlite3_exec(db, zSQL, 0, 0, 0);+** sqlite3_free(zSQL);+** </pre></blockquote>+**+** Because the %q format string is used, the '\'' character in zText+** is escaped and the SQL generated is as follows:+**+** <blockquote><pre>+** INSERT INTO table1 VALUES('It''s a happy day!')+** </pre></blockquote>+**+** This is correct. Had we used %s instead of %q, the generated SQL+** would have looked like this:+**+** <blockquote><pre>+** INSERT INTO table1 VALUES('It's a happy day!');+** </pre></blockquote>+**+** This second example is an SQL syntax error. As a general rule you should+** always use %q instead of %s when inserting text into a string literal.+**+** ^(The %Q option works like %q except it also adds single quotes around+** the outside of the total string. Additionally, if the parameter in the+** argument list is a NULL pointer, %Q substitutes the text "NULL" (without+** single quotes).)^ So, for example, one could say:+**+** <blockquote><pre>+** char *zSQL = sqlite3_mprintf("INSERT INTO table VALUES(%Q)", zText);+** sqlite3_exec(db, zSQL, 0, 0, 0);+** sqlite3_free(zSQL);+** </pre></blockquote>+**+** The code above will render a correct SQL statement in the zSQL+** variable even if the zText variable is a NULL pointer.+**+** ^(The "%w" formatting option is like "%q" except that it expects to+** be contained within double-quotes instead of single quotes, and it+** escapes the double-quote character instead of the single-quote+** character.)^ The "%w" formatting option is intended for safely inserting+** table and column names into a constructed SQL statement.+**+** ^(The "%z" formatting option works like "%s" but with the+** addition that after the string has been read and copied into+** the result, [sqlite3_free()] is called on the input string.)^+*/+SQLITE_PRIVATE char *sqlite3_mprintf(const char*,...);+SQLITE_PRIVATE char *sqlite3_vmprintf(const char*, va_list);+SQLITE_PRIVATE char *sqlite3_snprintf(int,char*,const char*, ...);+SQLITE_PRIVATE char *sqlite3_vsnprintf(int,char*,const char*, va_list);++/*+** CAPI3REF: Memory Allocation Subsystem+**+** The SQLite core uses these three routines for all of its own+** internal memory allocation needs. "Core" in the previous sentence+** does not include operating-system specific VFS implementation. The+** Windows VFS uses native malloc() and free() for some operations.+**+** ^The sqlite3_malloc() routine returns a pointer to a block+** of memory at least N bytes in length, where N is the parameter.+** ^If sqlite3_malloc() is unable to obtain sufficient free+** memory, it returns a NULL pointer. ^If the parameter N to+** sqlite3_malloc() is zero or negative then sqlite3_malloc() returns+** a NULL pointer.+**+** ^The sqlite3_malloc64(N) routine works just like+** sqlite3_malloc(N) except that N is an unsigned 64-bit integer instead+** of a signed 32-bit integer.+**+** ^Calling sqlite3_free() with a pointer previously returned+** by sqlite3_malloc() or sqlite3_realloc() releases that memory so+** that it might be reused. ^The sqlite3_free() routine is+** a no-op if is called with a NULL pointer. Passing a NULL pointer+** to sqlite3_free() is harmless. After being freed, memory+** should neither be read nor written. Even reading previously freed+** memory might result in a segmentation fault or other severe error.+** Memory corruption, a segmentation fault, or other severe error+** might result if sqlite3_free() is called with a non-NULL pointer that+** was not obtained from sqlite3_malloc() or sqlite3_realloc().+**+** ^The sqlite3_realloc(X,N) interface attempts to resize a+** prior memory allocation X to be at least N bytes.+** ^If the X parameter to sqlite3_realloc(X,N)+** is a NULL pointer then its behavior is identical to calling+** sqlite3_malloc(N).+** ^If the N parameter to sqlite3_realloc(X,N) is zero or+** negative then the behavior is exactly the same as calling+** sqlite3_free(X).+** ^sqlite3_realloc(X,N) returns a pointer to a memory allocation+** of at least N bytes in size or NULL if insufficient memory is available.+** ^If M is the size of the prior allocation, then min(N,M) bytes+** of the prior allocation are copied into the beginning of buffer returned+** by sqlite3_realloc(X,N) and the prior allocation is freed.+** ^If sqlite3_realloc(X,N) returns NULL and N is positive, then the+** prior allocation is not freed.+**+** ^The sqlite3_realloc64(X,N) interfaces works the same as+** sqlite3_realloc(X,N) except that N is a 64-bit unsigned integer instead+** of a 32-bit signed integer.+**+** ^The memory returned by sqlite3_malloc(), sqlite3_realloc(),+** sqlite3_malloc64(), and sqlite3_realloc64()+** is always aligned to at least an 8 byte boundary, or to a+** 4 byte boundary if the [SQLITE_4_BYTE_ALIGNED_MALLOC] compile-time+** option is used.+**+** In SQLite version 3.5.0 and 3.5.1, it was possible to define+** the SQLITE_OMIT_MEMORY_ALLOCATION which would cause the built-in+** implementation of these routines to be omitted. That capability+** is no longer provided. Only built-in memory allocators can be used.+**+** Prior to SQLite version 3.7.10, the Windows OS interface layer called+** the system malloc() and free() directly when converting+** filenames between the UTF-8 encoding used by SQLite+** and whatever filename encoding is used by the particular Windows+** installation. Memory allocation errors were detected, but+** they were reported back as [SQLITE_CANTOPEN] or+** [SQLITE_IOERR] rather than [SQLITE_NOMEM].+**+** The pointer arguments to [sqlite3_free()] and [sqlite3_realloc()]+** must be either NULL or else pointers obtained from a prior+** invocation of [sqlite3_malloc()] or [sqlite3_realloc()] that have+** not yet been released.+**+** The application must not read or write any part of+** a block of memory after it has been released using+** [sqlite3_free()] or [sqlite3_realloc()].+*/+SQLITE_PRIVATE void *sqlite3_malloc(int);+SQLITE_PRIVATE void *sqlite3_malloc64(sqlite3_uint64);+SQLITE_PRIVATE void *sqlite3_realloc(void*, int);+SQLITE_PRIVATE void *sqlite3_realloc64(void*, sqlite3_uint64);+SQLITE_PRIVATE void sqlite3_free(void*);++/*+** CAPI3REF: Run-Time Limit Categories+** KEYWORDS: {limit category} {*limit categories}+**+** These constants define various performance limits+** that can be lowered at run-time using [sqlite3_limit()].+** The synopsis of the meanings of the various limits is shown below.+** Additional information is available at [limits | Limits in SQLite].+**+** <dl>+** [[SQLITE_LIMIT_LENGTH]] ^(<dt>SQLITE_LIMIT_LENGTH</dt>+** <dd>The maximum size of any string or BLOB or table row, in bytes.<dd>)^+**+** [[SQLITE_LIMIT_SQL_LENGTH]] ^(<dt>SQLITE_LIMIT_SQL_LENGTH</dt>+** <dd>The maximum length of an SQL statement, in bytes.</dd>)^+**+** [[SQLITE_LIMIT_COLUMN]] ^(<dt>SQLITE_LIMIT_COLUMN</dt>+** <dd>The maximum number of columns in a table definition or in the+** result set of a [SELECT] or the maximum number of columns in an index+** or in an ORDER BY or GROUP BY clause.</dd>)^+**+** [[SQLITE_LIMIT_EXPR_DEPTH]] ^(<dt>SQLITE_LIMIT_EXPR_DEPTH</dt>+** <dd>The maximum depth of the parse tree on any expression.</dd>)^+**+** [[SQLITE_LIMIT_COMPOUND_SELECT]] ^(<dt>SQLITE_LIMIT_COMPOUND_SELECT</dt>+** <dd>The maximum number of terms in a compound SELECT statement.</dd>)^+**+** [[SQLITE_LIMIT_VDBE_OP]] ^(<dt>SQLITE_LIMIT_VDBE_OP</dt>+** <dd>The maximum number of instructions in a virtual machine program+** used to implement an SQL statement. This limit is not currently+** enforced, though that might be added in some future release of+** SQLite.</dd>)^+**+** [[SQLITE_LIMIT_FUNCTION_ARG]] ^(<dt>SQLITE_LIMIT_FUNCTION_ARG</dt>+** <dd>The maximum number of arguments on a function.</dd>)^+**+** [[SQLITE_LIMIT_ATTACHED]] ^(<dt>SQLITE_LIMIT_ATTACHED</dt>+** <dd>The maximum number of [ATTACH | attached databases].)^</dd>+**+** [[SQLITE_LIMIT_LIKE_PATTERN_LENGTH]]+** ^(<dt>SQLITE_LIMIT_LIKE_PATTERN_LENGTH</dt>+** <dd>The maximum length of the pattern argument to the [LIKE] or+** [GLOB] operators.</dd>)^+**+** [[SQLITE_LIMIT_VARIABLE_NUMBER]]+** ^(<dt>SQLITE_LIMIT_VARIABLE_NUMBER</dt>+** <dd>The maximum index number of any [parameter] in an SQL statement.)^+**+** [[SQLITE_LIMIT_TRIGGER_DEPTH]] ^(<dt>SQLITE_LIMIT_TRIGGER_DEPTH</dt>+** <dd>The maximum depth of recursion for triggers.</dd>)^+**+** [[SQLITE_LIMIT_WORKER_THREADS]] ^(<dt>SQLITE_LIMIT_WORKER_THREADS</dt>+** <dd>The maximum number of auxiliary worker threads that a single+** [prepared statement] may start.</dd>)^+** </dl>+*/+#define SQLITE_LIMIT_LENGTH 0+#define SQLITE_LIMIT_SQL_LENGTH 1+#define SQLITE_LIMIT_COLUMN 2+#define SQLITE_LIMIT_EXPR_DEPTH 3+#define SQLITE_LIMIT_COMPOUND_SELECT 4+#define SQLITE_LIMIT_VDBE_OP 5+#define SQLITE_LIMIT_FUNCTION_ARG 6+#define SQLITE_LIMIT_ATTACHED 7+#define SQLITE_LIMIT_LIKE_PATTERN_LENGTH 8+#define SQLITE_LIMIT_VARIABLE_NUMBER 9+#define SQLITE_LIMIT_TRIGGER_DEPTH 10+#define SQLITE_LIMIT_WORKER_THREADS 11++/*+** CAPI3REF: Name Of The Folder Holding Temporary Files+**+** ^(If this global variable is made to point to a string which is+** the name of a folder (a.k.a. directory), then all temporary files+** created by SQLite when using a built-in [sqlite3_vfs | VFS]+** will be placed in that directory.)^ ^If this variable+** is a NULL pointer, then SQLite performs a search for an appropriate+** temporary file directory.+**+** Applications are strongly discouraged from using this global variable.+** It is required to set a temporary folder on Windows Runtime (WinRT).+** But for all other platforms, it is highly recommended that applications+** neither read nor write this variable. This global variable is a relic+** that exists for backwards compatibility of legacy applications and should+** be avoided in new projects.+**+** It is not safe to read or modify this variable in more than one+** thread at a time. It is not safe to read or modify this variable+** if a [database connection] is being used at the same time in a separate+** thread.+** It is intended that this variable be set once+** as part of process initialization and before any SQLite interface+** routines have been called and that this variable remain unchanged+** thereafter.+**+** ^The [temp_store_directory pragma] may modify this variable and cause+** it to point to memory obtained from [sqlite3_malloc]. ^Furthermore,+** the [temp_store_directory pragma] always assumes that any string+** that this variable points to is held in memory obtained from +** [sqlite3_malloc] and the pragma may attempt to free that memory+** using [sqlite3_free].+** Hence, if this variable is modified directly, either it should be+** made NULL or made to point to memory obtained from [sqlite3_malloc]+** or else the use of the [temp_store_directory pragma] should be avoided.+** Except when requested by the [temp_store_directory pragma], SQLite+** does not free the memory that sqlite3_temp_directory points to. If+** the application wants that memory to be freed, it must do+** so itself, taking care to only do so after all [database connection]+** objects have been destroyed.+**+** <b>Note to Windows Runtime users:</b> The temporary directory must be set+** prior to calling [sqlite3_open] or [sqlite3_open_v2]. Otherwise, various+** features that require the use of temporary files may fail. Here is an+** example of how to do this using C++ with the Windows Runtime:+**+** <blockquote><pre>+** LPCWSTR zPath = Windows::Storage::ApplicationData::Current->+** TemporaryFolder->Path->Data();+** char zPathBuf[MAX_PATH + 1];+** memset(zPathBuf, 0, sizeof(zPathBuf));+** WideCharToMultiByte(CP_UTF8, 0, zPath, -1, zPathBuf, sizeof(zPathBuf),+** NULL, NULL);+** sqlite3_temp_directory = sqlite3_mprintf("%s", zPathBuf);+** </pre></blockquote>+*/+SQLITE_PRIVATE char *sqlite3_temp_directory;++/*+** CAPI3REF: Virtual File System Objects+**+** A virtual filesystem (VFS) is an [sqlite3_vfs] object+** that SQLite uses to interact+** with the underlying operating system. Most SQLite builds come with a+** single default VFS that is appropriate for the host computer.+** New VFSes can be registered and existing VFSes can be unregistered.+** The following interfaces are provided.+**+** ^The sqlite3_vfs_find() interface returns a pointer to a VFS given its name.+** ^Names are case sensitive.+** ^Names are zero-terminated UTF-8 strings.+** ^If there is no match, a NULL pointer is returned.+** ^If zVfsName is NULL then the default VFS is returned.+**+** ^New VFSes are registered with sqlite3_vfs_register().+** ^Each new VFS becomes the default VFS if the makeDflt flag is set.+** ^The same VFS can be registered multiple times without injury.+** ^To make an existing VFS into the default VFS, register it again+** with the makeDflt flag set. If two different VFSes with the+** same name are registered, the behavior is undefined. If a+** VFS is registered with a name that is NULL or an empty string,+** then the behavior is undefined.+**+*/+SQLITE_PRIVATE sqlite3_vfs *sqlite3_vfs_find(const char *zVfsName);+SQLITE_PRIVATE int sqlite3_vfs_register(sqlite3_vfs*, int makeDflt);++/*+** CAPI3REF: Mutexes+**+** The SQLite core uses these routines for thread+** synchronization. Though they are intended for internal+** use by SQLite, code that links against SQLite is+** permitted to use any of these routines.+**+** The SQLite source code contains multiple implementations+** of these mutex routines. An appropriate implementation+** is selected automatically at compile-time. The following+** implementations are available in the SQLite core:+**+** <ul>+** <li> SQLITE_MUTEX_PTHREADS+** <li> SQLITE_MUTEX_W32+** <li> SQLITE_MUTEX_NOOP+** </ul>+**+** The SQLITE_MUTEX_NOOP implementation is a set of routines+** that does no real locking and is appropriate for use in+** a single-threaded application. The SQLITE_MUTEX_PTHREADS and+** SQLITE_MUTEX_W32 implementations are appropriate for use on Unix+** and Windows.+**+** If SQLite is compiled with the SQLITE_MUTEX_APPDEF preprocessor+** macro defined (with "-DSQLITE_MUTEX_APPDEF=1"), then no mutex+** implementation is included with the library. In this case the+** application must supply a custom mutex implementation using the+** [SQLITE_CONFIG_MUTEX] option of the sqlite3_config() function+** before calling sqlite3BtreeInitialize() or any other public sqlite3_+** function that calls sqlite3BtreeInitialize().+**+** ^The sqlite3_mutex_alloc() routine allocates a new+** mutex and returns a pointer to it. ^The sqlite3_mutex_alloc()+** routine returns NULL if it is unable to allocate the requested+** mutex. The argument to sqlite3_mutex_alloc() must one of these+** integer constants:+**+** <ul>+** <li> SQLITE_MUTEX_FAST+** <li> SQLITE_MUTEX_RECURSIVE+** <li> SQLITE_MUTEX_STATIC_MASTER+** <li> SQLITE_MUTEX_STATIC_MEM+** <li> SQLITE_MUTEX_STATIC_OPEN+** <li> SQLITE_MUTEX_STATIC_PRNG+** <li> SQLITE_MUTEX_STATIC_LRU+** <li> SQLITE_MUTEX_STATIC_PMEM+** <li> SQLITE_MUTEX_STATIC_APP1+** <li> SQLITE_MUTEX_STATIC_APP2+** <li> SQLITE_MUTEX_STATIC_APP3+** <li> SQLITE_MUTEX_STATIC_VFS1+** <li> SQLITE_MUTEX_STATIC_VFS2+** <li> SQLITE_MUTEX_STATIC_VFS3+** </ul>+**+** ^The first two constants (SQLITE_MUTEX_FAST and SQLITE_MUTEX_RECURSIVE)+** cause sqlite3_mutex_alloc() to create+** a new mutex. ^The new mutex is recursive when SQLITE_MUTEX_RECURSIVE+** is used but not necessarily so when SQLITE_MUTEX_FAST is used.+** The mutex implementation does not need to make a distinction+** between SQLITE_MUTEX_RECURSIVE and SQLITE_MUTEX_FAST if it does+** not want to. SQLite will only request a recursive mutex in+** cases where it really needs one. If a faster non-recursive mutex+** implementation is available on the host platform, the mutex subsystem+** might return such a mutex in response to SQLITE_MUTEX_FAST.+**+** ^The other allowed parameters to sqlite3_mutex_alloc() (anything other+** than SQLITE_MUTEX_FAST and SQLITE_MUTEX_RECURSIVE) each return+** a pointer to a static preexisting mutex. ^Nine static mutexes are+** used by the current version of SQLite. Future versions of SQLite+** may add additional static mutexes. Static mutexes are for internal+** use by SQLite only. Applications that use SQLite mutexes should+** use only the dynamic mutexes returned by SQLITE_MUTEX_FAST or+** SQLITE_MUTEX_RECURSIVE.+**+** ^Note that if one of the dynamic mutex parameters (SQLITE_MUTEX_FAST+** or SQLITE_MUTEX_RECURSIVE) is used then sqlite3_mutex_alloc()+** returns a different mutex on every call. ^For the static+** mutex types, the same mutex is returned on every call that has+** the same type number.+**+** ^The sqlite3_mutex_free() routine deallocates a previously+** allocated dynamic mutex. Attempting to deallocate a static+** mutex results in undefined behavior.+**+** ^The sqlite3_mutex_enter() and sqlite3_mutex_try() routines attempt+** to enter a mutex. ^If another thread is already within the mutex,+** sqlite3_mutex_enter() will block and sqlite3_mutex_try() will return+** SQLITE_BUSY. ^The sqlite3_mutex_try() interface returns [SQLITE_OK]+** upon successful entry. ^(Mutexes created using+** SQLITE_MUTEX_RECURSIVE can be entered multiple times by the same thread.+** In such cases, the+** mutex must be exited an equal number of times before another thread+** can enter.)^ If the same thread tries to enter any mutex other+** than an SQLITE_MUTEX_RECURSIVE more than once, the behavior is undefined.+**+** ^(Some systems (for example, Windows 95) do not support the operation+** implemented by sqlite3_mutex_try(). On those systems, sqlite3_mutex_try()+** will always return SQLITE_BUSY. The SQLite core only ever uses+** sqlite3_mutex_try() as an optimization so this is acceptable +** behavior.)^+**+** ^The sqlite3_mutex_leave() routine exits a mutex that was+** previously entered by the same thread. The behavior+** is undefined if the mutex is not currently entered by the+** calling thread or is not currently allocated.+**+** ^If the argument to sqlite3_mutex_enter(), sqlite3_mutex_try(), or+** sqlite3_mutex_leave() is a NULL pointer, then all three routines+** behave as no-ops.+**+** See also: [sqlite3_mutex_held()] and [sqlite3_mutex_notheld()].+*/+SQLITE_PRIVATE sqlite3_mutex *sqlite3_mutex_alloc(int);+SQLITE_PRIVATE void sqlite3_mutex_free(sqlite3_mutex*);+SQLITE_PRIVATE void sqlite3_mutex_enter(sqlite3_mutex*);+SQLITE_PRIVATE int sqlite3_mutex_try(sqlite3_mutex*);+SQLITE_PRIVATE void sqlite3_mutex_leave(sqlite3_mutex*);++/*+** CAPI3REF: Mutex Methods Object+**+** An instance of this structure defines the low-level routines+** used to allocate and use mutexes.+**+** Usually, the default mutex implementations provided by SQLite are+** sufficient, however the application has the option of substituting a custom+** implementation for specialized deployments or systems for which SQLite+** does not provide a suitable implementation. In this case, the application+** creates and populates an instance of this structure to pass+** to sqlite3_config() along with the [SQLITE_CONFIG_MUTEX] option.+** Additionally, an instance of this structure can be used as an+** output variable when querying the system for the current mutex+** implementation, using the [SQLITE_CONFIG_GETMUTEX] option.+**+** ^The xMutexInit method defined by this structure is invoked as+** part of system initialization by the sqlite3BtreeInitialize() function.+** ^The xMutexInit routine is called by SQLite exactly once for each+** effective call to [sqlite3BtreeInitialize()].+**+** ^The xMutexEnd method defined by this structure is invoked as+** part of system shutdown by the sqlite3BtreeShutdown() function. The+** implementation of this method is expected to release all outstanding+** resources obtained by the mutex methods implementation, especially+** those obtained by the xMutexInit method. ^The xMutexEnd()+** interface is invoked exactly once for each call to [sqlite3BtreeShutdown()].+**+** ^(The remaining seven methods defined by this structure (xMutexAlloc,+** xMutexFree, xMutexEnter, xMutexTry, xMutexLeave, xMutexHeld and+** xMutexNotheld) implement the following interfaces (respectively):+**+** <ul>+** <li> [sqlite3_mutex_alloc()] </li>+** <li> [sqlite3_mutex_free()] </li>+** <li> [sqlite3_mutex_enter()] </li>+** <li> [sqlite3_mutex_try()] </li>+** <li> [sqlite3_mutex_leave()] </li>+** <li> [sqlite3_mutex_held()] </li>+** <li> [sqlite3_mutex_notheld()] </li>+** </ul>)^+**+** The only difference is that the public sqlite3_XXX functions enumerated+** above silently ignore any invocations that pass a NULL pointer instead+** of a valid mutex handle. The implementations of the methods defined+** by this structure are not required to handle this case, the results+** of passing a NULL pointer instead of a valid mutex handle are undefined+** (i.e. it is acceptable to provide an implementation that segfaults if+** it is passed a NULL pointer).+**+** The xMutexInit() method must be threadsafe. It must be harmless to+** invoke xMutexInit() multiple times within the same process and without+** intervening calls to xMutexEnd(). Second and subsequent calls to+** xMutexInit() must be no-ops.+**+** xMutexInit() must not use SQLite memory allocation ([sqlite3_malloc()]+** and its associates). Similarly, xMutexAlloc() must not use SQLite memory+** allocation for a static mutex. ^However xMutexAlloc() may use SQLite+** memory allocation for a fast or recursive mutex.+**+** ^SQLite will invoke the xMutexEnd() method when [sqlite3BtreeShutdown()] is+** called, but only if the prior call to xMutexInit returned SQLITE_OK.+** If xMutexInit fails in any way, it is expected to clean up after itself+** prior to returning.+*/+typedef struct sqlite3_mutex_methods sqlite3_mutex_methods;+struct sqlite3_mutex_methods {+ int (*xMutexInit)(void);+ int (*xMutexEnd)(void);+ sqlite3_mutex *(*xMutexAlloc)(int);+ void (*xMutexFree)(sqlite3_mutex *);+ void (*xMutexEnter)(sqlite3_mutex *);+ int (*xMutexTry)(sqlite3_mutex *);+ void (*xMutexLeave)(sqlite3_mutex *);+ int (*xMutexHeld)(sqlite3_mutex *);+ int (*xMutexNotheld)(sqlite3_mutex *);+};++/*+** CAPI3REF: Mutex Types+**+** The [sqlite3_mutex_alloc()] interface takes a single argument+** which is one of these integer constants.+**+** The set of static mutexes may change from one SQLite release to the+** next. Applications that override the built-in mutex logic must be+** prepared to accommodate additional static mutexes.+*/+#define SQLITE_MUTEX_FAST 0+#define SQLITE_MUTEX_RECURSIVE 1+#define SQLITE_MUTEX_STATIC_MASTER 2+#define SQLITE_MUTEX_STATIC_MEM 3 /* sqlite3_malloc() */+#define SQLITE_MUTEX_STATIC_MEM2 4 /* NOT USED */+#define SQLITE_MUTEX_STATIC_OPEN 4 /* sqlite3BtreeOpen() */+#define SQLITE_MUTEX_STATIC_PRNG 5 /* sqlite3_random() */+#define SQLITE_MUTEX_STATIC_LRU 6 /* lru page list */+#define SQLITE_MUTEX_STATIC_LRU2 7 /* NOT USED */+#define SQLITE_MUTEX_STATIC_PMEM 7 /* sqlite3PageMalloc() */+#define SQLITE_MUTEX_STATIC_APP1 8 /* For use by application */+#define SQLITE_MUTEX_STATIC_APP2 9 /* For use by application */+#define SQLITE_MUTEX_STATIC_APP3 10 /* For use by application */+#define SQLITE_MUTEX_STATIC_VFS1 11 /* For use by built-in VFS */+#define SQLITE_MUTEX_STATIC_VFS2 12 /* For use by extension VFS */+#define SQLITE_MUTEX_STATIC_VFS3 13 /* For use by application VFS */++/*+** CAPI3REF: Status Parameters+** KEYWORDS: {status parameters}+**+** These integer constants designate various run-time status parameters+** that can be returned by [sqlite3_status()].+**+** <dl>+** [[SQLITE_STATUS_MEMORY_USED]] ^(<dt>SQLITE_STATUS_MEMORY_USED</dt>+** <dd>This parameter is the current amount of memory checked out+** using [sqlite3_malloc()], either directly or indirectly. The+** figure includes calls made to [sqlite3_malloc()] by the application+** and internal memory usage by the SQLite library. Scratch memory+** controlled by [SQLITE_CONFIG_SCRATCH] and auxiliary page-cache+** memory controlled by [SQLITE_CONFIG_PAGECACHE] is not included in+** this parameter. The amount returned is the sum of the allocation+** sizes as reported by the xSize method in [sqlite3_mem_methods].</dd>)^+**+** [[SQLITE_STATUS_MALLOC_SIZE]] ^(<dt>SQLITE_STATUS_MALLOC_SIZE</dt>+** <dd>This parameter records the largest memory allocation request+** handed to [sqlite3_malloc()] or [sqlite3_realloc()] (or their+** internal equivalents). Only the value returned in the+** *pHighwater parameter to [sqlite3_status()] is of interest. +** The value written into the *pCurrent parameter is undefined.</dd>)^+**+** [[SQLITE_STATUS_MALLOC_COUNT]] ^(<dt>SQLITE_STATUS_MALLOC_COUNT</dt>+** <dd>This parameter records the number of separate memory allocations+** currently checked out.</dd>)^+**+** [[SQLITE_STATUS_PAGECACHE_USED]] ^(<dt>SQLITE_STATUS_PAGECACHE_USED</dt>+** <dd>This parameter returns the number of pages used out of the+** [pagecache memory allocator] that was configured using +** [SQLITE_CONFIG_PAGECACHE]. The+** value returned is in pages, not in bytes.</dd>)^+**+** [[SQLITE_STATUS_PAGECACHE_OVERFLOW]] +** ^(<dt>SQLITE_STATUS_PAGECACHE_OVERFLOW</dt>+** <dd>This parameter returns the number of bytes of page cache+** allocation which could not be satisfied by the [SQLITE_CONFIG_PAGECACHE]+** buffer and where forced to overflow to [sqlite3_malloc()]. The+** returned value includes allocations that overflowed because they+** where too large (they were larger than the "sz" parameter to+** [SQLITE_CONFIG_PAGECACHE]) and allocations that overflowed because+** no space was left in the page cache.</dd>)^+**+** [[SQLITE_STATUS_PAGECACHE_SIZE]] ^(<dt>SQLITE_STATUS_PAGECACHE_SIZE</dt>+** <dd>This parameter records the largest memory allocation request+** handed to [pagecache memory allocator]. Only the value returned in the+** *pHighwater parameter to [sqlite3_status()] is of interest. +** The value written into the *pCurrent parameter is undefined.</dd>)^+**+** [[SQLITE_STATUS_SCRATCH_USED]] ^(<dt>SQLITE_STATUS_SCRATCH_USED</dt>+** <dd>This parameter returns the number of allocations used out of the+** [scratch memory allocator] configured using+** [SQLITE_CONFIG_SCRATCH]. The value returned is in allocations, not+** in bytes. Since a single thread may only have one scratch allocation+** outstanding at time, this parameter also reports the number of threads+** using scratch memory at the same time.</dd>)^+**+** [[SQLITE_STATUS_SCRATCH_OVERFLOW]] ^(<dt>SQLITE_STATUS_SCRATCH_OVERFLOW</dt>+** <dd>This parameter returns the number of bytes of scratch memory+** allocation which could not be satisfied by the [SQLITE_CONFIG_SCRATCH]+** buffer and where forced to overflow to [sqlite3_malloc()]. The values+** returned include overflows because the requested allocation was too+** larger (that is, because the requested allocation was larger than the+** "sz" parameter to [SQLITE_CONFIG_SCRATCH]) and because no scratch buffer+** slots were available.+** </dd>)^+**+** [[SQLITE_STATUS_SCRATCH_SIZE]] ^(<dt>SQLITE_STATUS_SCRATCH_SIZE</dt>+** <dd>This parameter records the largest memory allocation request+** handed to [scratch memory allocator]. Only the value returned in the+** *pHighwater parameter to [sqlite3_status()] is of interest. +** The value written into the *pCurrent parameter is undefined.</dd>)^+**+** [[SQLITE_STATUS_PARSER_STACK]] ^(<dt>SQLITE_STATUS_PARSER_STACK</dt>+** <dd>This parameter records the deepest parser stack. It is only+** meaningful if SQLite is compiled with [YYTRACKMAXSTACKDEPTH].</dd>)^+** </dl>+**+** New status parameters may be added from time to time.+*/+#define SQLITE_STATUS_MEMORY_USED 0+#define SQLITE_STATUS_PAGECACHE_USED 1+#define SQLITE_STATUS_PAGECACHE_OVERFLOW 2+#define SQLITE_STATUS_SCRATCH_USED 3+#define SQLITE_STATUS_SCRATCH_OVERFLOW 4+#define SQLITE_STATUS_MALLOC_SIZE 5+#define SQLITE_STATUS_PARSER_STACK 6+#define SQLITE_STATUS_PAGECACHE_SIZE 7+#define SQLITE_STATUS_SCRATCH_SIZE 8+#define SQLITE_STATUS_MALLOC_COUNT 9++/*+** CAPI3REF: Status Parameters for database connections+** KEYWORDS: {SQLITE_DBSTATUS options}+**+** These constants are the available integer "verbs" that can be passed as+** the second argument to the [sqlite3_db_status()] interface.+**+** New verbs may be added in future releases of SQLite. Existing verbs+** might be discontinued. Applications should check the return code from+** [sqlite3_db_status()] to make sure that the call worked.+** The [sqlite3_db_status()] interface will return a non-zero error code+** if a discontinued or unsupported verb is invoked.+**+** <dl>+** [[SQLITE_DBSTATUS_LOOKASIDE_USED]] ^(<dt>SQLITE_DBSTATUS_LOOKASIDE_USED</dt>+** <dd>This parameter returns the number of lookaside memory slots currently+** checked out.</dd>)^+**+** [[SQLITE_DBSTATUS_LOOKASIDE_HIT]] ^(<dt>SQLITE_DBSTATUS_LOOKASIDE_HIT</dt>+** <dd>This parameter returns the number malloc attempts that were +** satisfied using lookaside memory. Only the high-water value is meaningful;+** the current value is always zero.)^+**+** [[SQLITE_DBSTATUS_LOOKASIDE_MISS_SIZE]]+** ^(<dt>SQLITE_DBSTATUS_LOOKASIDE_MISS_SIZE</dt>+** <dd>This parameter returns the number malloc attempts that might have+** been satisfied using lookaside memory but failed due to the amount of+** memory requested being larger than the lookaside slot size.+** Only the high-water value is meaningful;+** the current value is always zero.)^+**+** [[SQLITE_DBSTATUS_LOOKASIDE_MISS_FULL]]+** ^(<dt>SQLITE_DBSTATUS_LOOKASIDE_MISS_FULL</dt>+** <dd>This parameter returns the number malloc attempts that might have+** been satisfied using lookaside memory but failed due to all lookaside+** memory already being in use.+** Only the high-water value is meaningful;+** the current value is always zero.)^+**+** [[SQLITE_DBSTATUS_CACHE_USED]] ^(<dt>SQLITE_DBSTATUS_CACHE_USED</dt>+** <dd>This parameter returns the approximate number of bytes of heap+** memory used by all pager caches associated with the database connection.)^+** ^The highwater mark associated with SQLITE_DBSTATUS_CACHE_USED is always 0.+**+** [[SQLITE_DBSTATUS_SCHEMA_USED]] ^(<dt>SQLITE_DBSTATUS_SCHEMA_USED</dt>+** <dd>This parameter returns the approximate number of bytes of heap+** memory used to store the schema for all databases associated+** with the connection - main, temp, and any [ATTACH]-ed databases.)^ +** ^The full amount of memory used by the schemas is reported, even if the+** schema memory is shared with other database connections due to+** [shared cache mode] being enabled.+** ^The highwater mark associated with SQLITE_DBSTATUS_SCHEMA_USED is always 0.+**+** [[SQLITE_DBSTATUS_STMT_USED]] ^(<dt>SQLITE_DBSTATUS_STMT_USED</dt>+** <dd>This parameter returns the approximate number of bytes of heap+** and lookaside memory used by all prepared statements associated with+** the database connection.)^+** ^The highwater mark associated with SQLITE_DBSTATUS_STMT_USED is always 0.+** </dd>+**+** [[SQLITE_DBSTATUS_CACHE_HIT]] ^(<dt>SQLITE_DBSTATUS_CACHE_HIT</dt>+** <dd>This parameter returns the number of pager cache hits that have+** occurred.)^ ^The highwater mark associated with SQLITE_DBSTATUS_CACHE_HIT +** is always 0.+** </dd>+**+** [[SQLITE_DBSTATUS_CACHE_MISS]] ^(<dt>SQLITE_DBSTATUS_CACHE_MISS</dt>+** <dd>This parameter returns the number of pager cache misses that have+** occurred.)^ ^The highwater mark associated with SQLITE_DBSTATUS_CACHE_MISS +** is always 0.+** </dd>+**+** [[SQLITE_DBSTATUS_CACHE_WRITE]] ^(<dt>SQLITE_DBSTATUS_CACHE_WRITE</dt>+** <dd>This parameter returns the number of dirty cache entries that have+** been written to disk. Specifically, the number of pages written to the+** wal file in wal mode databases, or the number of pages written to the+** database file in rollback mode databases. Any pages written as part of+** transaction rollback or database recovery operations are not included.+** If an IO or other error occurs while writing a page to disk, the effect+** on subsequent SQLITE_DBSTATUS_CACHE_WRITE requests is undefined.)^ ^The+** highwater mark associated with SQLITE_DBSTATUS_CACHE_WRITE is always 0.+** </dd>+**+** [[SQLITE_DBSTATUS_DEFERRED_FKS]] ^(<dt>SQLITE_DBSTATUS_DEFERRED_FKS</dt>+** <dd>This parameter returns zero for the current value if and only if+** all foreign key constraints (deferred or immediate) have been+** resolved.)^ ^The highwater mark is always 0.+** </dd>+** </dl>+*/+#define SQLITE_DBSTATUS_LOOKASIDE_USED 0+#define SQLITE_DBSTATUS_CACHE_USED 1+#define SQLITE_DBSTATUS_SCHEMA_USED 2+#define SQLITE_DBSTATUS_STMT_USED 3+#define SQLITE_DBSTATUS_LOOKASIDE_HIT 4+#define SQLITE_DBSTATUS_LOOKASIDE_MISS_SIZE 5+#define SQLITE_DBSTATUS_LOOKASIDE_MISS_FULL 6+#define SQLITE_DBSTATUS_CACHE_HIT 7+#define SQLITE_DBSTATUS_CACHE_MISS 8+#define SQLITE_DBSTATUS_CACHE_WRITE 9+#define SQLITE_DBSTATUS_DEFERRED_FKS 10+#define SQLITE_DBSTATUS_MAX 10 /* Largest defined DBSTATUS */++/*+** CAPI3REF: Checkpoint Mode Values+** KEYWORDS: {checkpoint mode}+**+** These constants define all valid values for the "checkpoint mode" passed+** as the third parameter to the [sqlite3_wal_checkpoint_v2()] interface.+** See the [sqlite3_wal_checkpoint_v2()] documentation for details on the+** meaning of each of these checkpoint modes.+*/+#define SQLITE_CHECKPOINT_PASSIVE 0 /* Do as much as possible w/o blocking */+#define SQLITE_CHECKPOINT_FULL 1 /* Wait for writers, then checkpoint */+#define SQLITE_CHECKPOINT_RESTART 2 /* Like FULL but wait for for readers */+#define SQLITE_CHECKPOINT_TRUNCATE 3 /* Like RESTART but also truncate WAL */++/*+** CAPI3REF: Custom Page Cache Object+**+** The sqlite3_pcache type is opaque. It is implemented by+** the pluggable module. The SQLite core has no knowledge of+** its size or internal structure and never deals with the+** sqlite3_pcache object except by holding and passing pointers+** to the object.+**+** See [sqlite3_pcache_methods2] for additional information.+*/+typedef struct sqlite3_pcache sqlite3_pcache;++/*+** CAPI3REF: Custom Page Cache Object+**+** The sqlite3_pcache_page object represents a single page in the+** page cache. The page cache will allocate instances of this+** object. Various methods of the page cache use pointers to instances+** of this object as parameters or as their return value.+**+** See [sqlite3_pcache_methods2] for additional information.+*/+typedef struct sqlite3_pcache_page sqlite3_pcache_page;+struct sqlite3_pcache_page {+ void *pBuf; /* The content of the page */+ void *pExtra; /* Extra information associated with the page */+};++/*+** CAPI3REF: Application Defined Page Cache.+** KEYWORDS: {page cache}+**+** ^(The [sqlite3_config]([SQLITE_CONFIG_PCACHE2], ...) interface can+** register an alternative page cache implementation by passing in an +** instance of the sqlite3_pcache_methods2 structure.)^+** In many applications, most of the heap memory allocated by +** SQLite is used for the page cache.+** By implementing a +** custom page cache using this API, an application can better control+** the amount of memory consumed by SQLite, the way in which +** that memory is allocated and released, and the policies used to +** determine exactly which parts of a database file are cached and for +** how long.+**+** The alternative page cache mechanism is an+** extreme measure that is only needed by the most demanding applications.+** The built-in page cache is recommended for most uses.+**+** ^(The contents of the sqlite3_pcache_methods2 structure are copied to an+** internal buffer by SQLite within the call to [sqlite3_config]. Hence+** the application may discard the parameter after the call to+** [sqlite3_config()] returns.)^+**+** [[the xInit() page cache method]]+** ^(The xInit() method is called once for each effective +** call to [sqlite3BtreeInitialize()])^+** (usually only once during the lifetime of the process). ^(The xInit()+** method is passed a copy of the sqlite3_pcache_methods2.pArg value.)^+** The intent of the xInit() method is to set up global data structures +** required by the custom page cache implementation. +** ^(If the xInit() method is NULL, then the +** built-in default page cache is used instead of the application defined+** page cache.)^+**+** [[the xShutdown() page cache method]]+** ^The xShutdown() method is called by [sqlite3BtreeShutdown()].+** It can be used to clean up +** any outstanding resources before process shutdown, if required.+** ^The xShutdown() method may be NULL.+**+** ^SQLite automatically serializes calls to the xInit method,+** so the xInit method need not be threadsafe. ^The+** xShutdown method is only called from [sqlite3BtreeShutdown()] so it does+** not need to be threadsafe either. All other methods must be threadsafe+** in multithreaded applications.+**+** ^SQLite will never invoke xInit() more than once without an intervening+** call to xShutdown().+**+** [[the xCreate() page cache methods]]+** ^SQLite invokes the xCreate() method to construct a new cache instance.+** SQLite will typically create one cache instance for each open database file,+** though this is not guaranteed. ^The+** first parameter, szPage, is the size in bytes of the pages that must+** be allocated by the cache. ^szPage will always a power of two. ^The+** second parameter szExtra is a number of bytes of extra storage +** associated with each page cache entry. ^The szExtra parameter will+** a number less than 250. SQLite will use the+** extra szExtra bytes on each page to store metadata about the underlying+** database page on disk. The value passed into szExtra depends+** on the SQLite version, the target platform, and how SQLite was compiled.+** ^The third argument to xCreate(), bPurgeable, is true if the cache being+** created will be used to cache database pages of a file stored on disk, or+** false if it is used for an in-memory database. The cache implementation+** does not have to do anything special based with the value of bPurgeable;+** it is purely advisory. ^On a cache where bPurgeable is false, SQLite will+** never invoke xUnpin() except to deliberately delete a page.+** ^In other words, calls to xUnpin() on a cache with bPurgeable set to+** false will always have the "discard" flag set to true. +** ^Hence, a cache created with bPurgeable false will+** never contain any unpinned pages.+**+** [[the xCachesize() page cache method]]+** ^(The xCachesize() method may be called at any time by SQLite to set the+** suggested maximum cache-size (number of pages stored by) the cache+** instance passed as the first argument. This is the value configured using+** the SQLite "[PRAGMA cache_size]" command.)^ As with the bPurgeable+** parameter, the implementation is not required to do anything with this+** value; it is advisory only.+**+** [[the xPagecount() page cache methods]]+** The xPagecount() method must return the number of pages currently+** stored in the cache, both pinned and unpinned.+** +** [[the xFetch() page cache methods]]+** The xFetch() method locates a page in the cache and returns a pointer to +** an sqlite3_pcache_page object associated with that page, or a NULL pointer.+** The pBuf element of the returned sqlite3_pcache_page object will be a+** pointer to a buffer of szPage bytes used to store the content of a +** single database page. The pExtra element of sqlite3_pcache_page will be+** a pointer to the szExtra bytes of extra storage that SQLite has requested+** for each entry in the page cache.+**+** The page to be fetched is determined by the key. ^The minimum key value+** is 1. After it has been retrieved using xFetch, the page is considered+** to be "pinned".+**+** If the requested page is already in the page cache, then the page cache+** implementation must return a pointer to the page buffer with its content+** intact. If the requested page is not already in the cache, then the+** cache implementation should use the value of the createFlag+** parameter to help it determined what action to take:+**+** <table border=1 width=85% align=center>+** <tr><th> createFlag <th> Behavior when page is not already in cache+** <tr><td> 0 <td> Do not allocate a new page. Return NULL.+** <tr><td> 1 <td> Allocate a new page if it easy and convenient to do so.+** Otherwise return NULL.+** <tr><td> 2 <td> Make every effort to allocate a new page. Only return+** NULL if allocating a new page is effectively impossible.+** </table>+**+** ^(SQLite will normally invoke xFetch() with a createFlag of 0 or 1. SQLite+** will only use a createFlag of 2 after a prior call with a createFlag of 1+** failed.)^ In between the to xFetch() calls, SQLite may+** attempt to unpin one or more cache pages by spilling the content of+** pinned pages to disk and synching the operating system disk cache.+**+** [[the xUnpin() page cache method]]+** ^xUnpin() is called by SQLite with a pointer to a currently pinned page+** as its second argument. If the third parameter, discard, is non-zero,+** then the page must be evicted from the cache.+** ^If the discard parameter is+** zero, then the page may be discarded or retained at the discretion of+** page cache implementation. ^The page cache implementation+** may choose to evict unpinned pages at any time.+**+** The cache must not perform any reference counting. A single +** call to xUnpin() unpins the page regardless of the number of prior calls +** to xFetch().+**+** [[the xRekey() page cache methods]]+** The xRekey() method is used to change the key value associated with the+** page passed as the second argument. If the cache+** previously contains an entry associated with newKey, it must be+** discarded. ^Any prior cache entry associated with newKey is guaranteed not+** to be pinned.+**+** When SQLite calls the xTruncate() method, the cache must discard all+** existing cache entries with page numbers (keys) greater than or equal+** to the value of the iLimit parameter passed to xTruncate(). If any+** of these pages are pinned, they are implicitly unpinned, meaning that+** they can be safely discarded.+**+** [[the xDestroy() page cache method]]+** ^The xDestroy() method is used to delete a cache allocated by xCreate().+** All resources associated with the specified cache should be freed. ^After+** calling the xDestroy() method, SQLite considers the [sqlite3_pcache*]+** handle invalid, and will not use it with any other sqlite3_pcache_methods2+** functions.+**+** [[the xShrink() page cache method]]+** ^SQLite invokes the xShrink() method when it wants the page cache to+** free up as much of heap memory as possible. The page cache implementation+** is not obligated to free any memory, but well-behaved implementations should+** do their best.+*/+typedef struct sqlite3_pcache_methods2 sqlite3_pcache_methods2;+struct sqlite3_pcache_methods2 {+ int iVersion;+ void *pArg;+ int (*xInit)(void*);+ void (*xShutdown)(void*);+ sqlite3_pcache *(*xCreate)(int szPage, int szExtra, int bPurgeable);+ void (*xCachesize)(sqlite3_pcache*, int nCachesize);+ int (*xPagecount)(sqlite3_pcache*);+ sqlite3_pcache_page *(*xFetch)(sqlite3_pcache*, unsigned key, int createFlag);+ void (*xUnpin)(sqlite3_pcache*, sqlite3_pcache_page*, int discard);+ void (*xRekey)(sqlite3_pcache*, sqlite3_pcache_page*, + unsigned oldKey, unsigned newKey);+ void (*xTruncate)(sqlite3_pcache*, unsigned iLimit);+ void (*xDestroy)(sqlite3_pcache*);+ void (*xShrink)(sqlite3_pcache*);+};++/*+** CAPI3REF: Online Backup Object+**+** The sqlite3_backup object records state information about an ongoing+** online backup operation. ^The sqlite3_backup object is created by+** a call to [sqlite3_backup_init()] and is destroyed by a call to+** [sqlite3_backup_finish()].+**+** See Also: [Using the SQLite Online Backup API]+*/+typedef struct sqlite3_backup sqlite3_backup;++/*+** CAPI3REF: Error Logging Interface+**+** ^The [sqlite3_log()] interface writes a message into the [error log]+** established by the [SQLITE_CONFIG_LOG] option to [sqlite3_config()].+** ^If logging is enabled, the zFormat string and subsequent arguments are+** used with [sqlite3_snprintf()] to generate the final output string.+**+** The sqlite3_log() interface is intended for use by extensions such as+** virtual tables, collating functions, and SQL functions. While there is+** nothing to prevent an application from calling sqlite3_log(), doing so+** is considered bad form.+**+** The zFormat string must not be NULL.+**+** To avoid deadlocks and other threading problems, the sqlite3_log() routine+** will not use dynamically allocated memory. The log message is stored in+** a fixed-length buffer on the stack. If the log message is longer than+** a few hundred characters, it will be truncated to the length of the+** buffer.+*/+SQLITE_PRIVATE void sqlite3_log(int iErrCode, const char *zFormat, ...);++/*+** CAPI3REF: Text Encodings+**+** These constant define integer codes that represent the various+** text encodings supported by SQLite.+*/+#define SQLITE_UTF8 1 /* IMP: R-37514-35566 */+#define SQLITE_UTF16LE 2 /* IMP: R-03371-37637 */+#define SQLITE_UTF16BE 3 /* IMP: R-51971-34154 */+#define SQLITE_UTF16 4 /* Use native byte order */+#define SQLITE_ANY 5 /* Deprecated */+#define SQLITE_UTF16_ALIGNED 8 /* sqlite3_create_collation only */++/*+** Include the configuration header output by 'configure' if we're using the+** autoconf-based build+*/+#ifdef _HAVE_SQLITE_CONFIG_H+#include "config.h"+#endif++/************** Include sqliteLimit.h in the middle of sqliteInt.h ***********/+/************** Begin file sqliteLimit.h *************************************/+/*+** 2007 May 7+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** +** This file defines various limits of what SQLite can process.+*/++/*+** The maximum length of a TEXT or BLOB in bytes. This also+** limits the size of a row in a table or index.+**+** The hard limit is the ability of a 32-bit signed integer+** to count the size: 2^31-1 or 2147483647.+*/+#ifndef SQLITE_MAX_LENGTH+# define SQLITE_MAX_LENGTH 1000000000+#endif++/*+** This is the maximum number of+**+** * Columns in a table+** * Columns in an index+** * Columns in a view+** * Terms in the SET clause of an UPDATE statement+** * Terms in the result set of a SELECT statement+** * Terms in the GROUP BY or ORDER BY clauses of a SELECT statement.+** * Terms in the VALUES clause of an INSERT statement+**+** The hard upper limit here is 32676. Most database people will+** tell you that in a well-normalized database, you usually should+** not have more than a dozen or so columns in any table. And if+** that is the case, there is no point in having more than a few+** dozen values in any of the other situations described above.+*/+#ifndef SQLITE_MAX_COLUMN+# define SQLITE_MAX_COLUMN 2000+#endif++/*+** The maximum length of a single SQL statement in bytes.+**+** It used to be the case that setting this value to zero would+** turn the limit off. That is no longer true. It is not possible+** to turn this limit off.+*/+#ifndef SQLITE_MAX_SQL_LENGTH+# define SQLITE_MAX_SQL_LENGTH 1000000000+#endif++/*+** The maximum depth of an expression tree. This is limited to +** some extent by SQLITE_MAX_SQL_LENGTH. But sometime you might +** want to place more severe limits on the complexity of an +** expression.+**+** A value of 0 used to mean that the limit was not enforced.+** But that is no longer true. The limit is now strictly enforced+** at all times.+*/+#ifndef SQLITE_MAX_EXPR_DEPTH+# define SQLITE_MAX_EXPR_DEPTH 1000+#endif++/*+** The maximum number of terms in a compound SELECT statement.+** The code generator for compound SELECT statements does one+** level of recursion for each term. A stack overflow can result+** if the number of terms is too large. In practice, most SQL+** never has more than 3 or 4 terms. Use a value of 0 to disable+** any limit on the number of terms in a compount SELECT.+*/+#ifndef SQLITE_MAX_COMPOUND_SELECT+# define SQLITE_MAX_COMPOUND_SELECT 500+#endif++/*+** The maximum number of opcodes in a VDBE program.+** Not currently enforced.+*/+#ifndef SQLITE_MAX_VDBE_OP+# define SQLITE_MAX_VDBE_OP 25000+#endif++/*+** The maximum number of arguments to an SQL function.+*/+#ifndef SQLITE_MAX_FUNCTION_ARG+# define SQLITE_MAX_FUNCTION_ARG 127+#endif++/*+** The suggested maximum number of in-memory pages to use for+** the main database table and for temporary tables.+**+** IMPLEMENTATION-OF: R-31093-59126 The default suggested cache size+** is 2000 pages.+** IMPLEMENTATION-OF: R-48205-43578 The default suggested cache size can be+** altered using the SQLITE_DEFAULT_CACHE_SIZE compile-time options.+*/+#ifndef SQLITE_DEFAULT_CACHE_SIZE+# define SQLITE_DEFAULT_CACHE_SIZE 2000+#endif++/*+** The default number of frames to accumulate in the log file before+** checkpointing the database in WAL mode.+*/+#ifndef SQLITE_DEFAULT_WAL_AUTOCHECKPOINT+# define SQLITE_DEFAULT_WAL_AUTOCHECKPOINT 1000+#endif++/*+** The maximum number of attached databases. This must be between 0+** and 62. The upper bound on 62 is because a 64-bit integer bitmap+** is used internally to track attached databases.+*/+#ifndef SQLITE_MAX_ATTACHED+# define SQLITE_MAX_ATTACHED 10+#endif+++/*+** The maximum value of a ?nnn wildcard that the parser will accept.+*/+#ifndef SQLITE_MAX_VARIABLE_NUMBER+# define SQLITE_MAX_VARIABLE_NUMBER 999+#endif++/* Maximum page size. The upper bound on this value is 65536. This a limit+** imposed by the use of 16-bit offsets within each page.+**+** Earlier versions of SQLite allowed the user to change this value at+** compile time. This is no longer permitted, on the grounds that it creates+** a library that is technically incompatible with an SQLite library +** compiled with a different limit. If a process operating on a database +** with a page-size of 65536 bytes crashes, then an instance of SQLite +** compiled with the default page-size limit will not be able to rollback +** the aborted transaction. This could lead to database corruption.+*/+#ifdef SQLITE_MAX_PAGE_SIZE+# undef SQLITE_MAX_PAGE_SIZE+#endif+#define SQLITE_MAX_PAGE_SIZE 65536+++/*+** The default size of a database page.+*/+#ifndef SQLITE_DEFAULT_PAGE_SIZE+# define SQLITE_DEFAULT_PAGE_SIZE 1024+#endif+#if SQLITE_DEFAULT_PAGE_SIZE>SQLITE_MAX_PAGE_SIZE+# undef SQLITE_DEFAULT_PAGE_SIZE+# define SQLITE_DEFAULT_PAGE_SIZE SQLITE_MAX_PAGE_SIZE+#endif++/*+** Ordinarily, if no value is explicitly provided, SQLite creates databases+** with page size SQLITE_DEFAULT_PAGE_SIZE. However, based on certain+** device characteristics (sector-size and atomic write() support),+** SQLite may choose a larger value. This constant is the maximum value+** SQLite will choose on its own.+*/+#ifndef SQLITE_MAX_DEFAULT_PAGE_SIZE+# define SQLITE_MAX_DEFAULT_PAGE_SIZE 8192+#endif+#if SQLITE_MAX_DEFAULT_PAGE_SIZE>SQLITE_MAX_PAGE_SIZE+# undef SQLITE_MAX_DEFAULT_PAGE_SIZE+# define SQLITE_MAX_DEFAULT_PAGE_SIZE SQLITE_MAX_PAGE_SIZE+#endif+++/*+** Maximum number of pages in one database file.+**+** This is really just the default value for the max_page_count pragma.+** This value can be lowered (or raised) at run-time using that the+** max_page_count macro.+*/+#ifndef SQLITE_MAX_PAGE_COUNT+# define SQLITE_MAX_PAGE_COUNT 1073741823+#endif++/*+** Maximum length (in bytes) of the pattern in a LIKE or GLOB+** operator.+*/+#ifndef SQLITE_MAX_LIKE_PATTERN_LENGTH+# define SQLITE_MAX_LIKE_PATTERN_LENGTH 50000+#endif++/*+** Maximum depth of recursion for triggers.+**+** A value of 1 means that a trigger program will not be able to itself+** fire any triggers. A value of 0 means that no trigger programs at all +** may be executed.+*/+#ifndef SQLITE_MAX_TRIGGER_DEPTH+# define SQLITE_MAX_TRIGGER_DEPTH 1000+#endif++/************** End of sqliteLimit.h *****************************************/+/************** Continuing where we left off in sqliteInt.h ******************/++/* Disable nuisance warnings on Borland compilers */+#if defined(__BORLANDC__)+#pragma warn -rch /* unreachable code */+#pragma warn -ccc /* Condition is always true or false */+#pragma warn -aus /* Assigned value is never used */+#pragma warn -csu /* Comparing signed and unsigned */+#pragma warn -spa /* Suspicious pointer arithmetic */+#endif++/*+** Include standard header files as necessary+*/+#ifdef HAVE_STDINT_H+#include <stdint.h>+#endif+#ifdef HAVE_INTTYPES_H+#include <inttypes.h>+#endif++/*+** The following macros are used to cast pointers to integers and+** integers to pointers. The way you do this varies from one compiler+** to the next, so we have developed the following set of #if statements+** to generate appropriate macros for a wide range of compilers.+**+** The correct "ANSI" way to do this is to use the intptr_t type. +** Unfortunately, that typedef is not available on all compilers, or+** if it is available, it requires an #include of specific headers+** that vary from one machine to the next.+**+** Ticket #3860: The llvm-gcc-4.2 compiler from Apple chokes on+** the ((void*)&((char*)0)[X]) construct. But MSVC chokes on ((void*)(X)).+** So we have to define the macros in different ways depending on the+** compiler.+*/+#if defined(__PTRDIFF_TYPE__) /* This case should work for GCC */+# define SQLITE_INT_TO_PTR(X) ((void*)(__PTRDIFF_TYPE__)(X))+# define SQLITE_PTR_TO_INT(X) ((int)(__PTRDIFF_TYPE__)(X))+#elif !defined(__GNUC__) /* Works for compilers other than LLVM */+# define SQLITE_INT_TO_PTR(X) ((void*)&((char*)0)[X])+# define SQLITE_PTR_TO_INT(X) ((int)(((char*)X)-(char*)0))+#elif defined(HAVE_STDINT_H) /* Use this case if we have ANSI headers */+# define SQLITE_INT_TO_PTR(X) ((void*)(intptr_t)(X))+# define SQLITE_PTR_TO_INT(X) ((int)(intptr_t)(X))+#else /* Generates a warning - but it always works */+# define SQLITE_INT_TO_PTR(X) ((void*)(X))+# define SQLITE_PTR_TO_INT(X) ((int)(X))+#endif++/*+** A macro to hint to the compiler that a function should not be+** inlined.+*/+#if defined(__GNUC__)+# define SQLITE_NOINLINE __attribute__((noinline))+#elif defined(_MSC_VER) && _MSC_VER>=1310+# define SQLITE_NOINLINE __declspec(noinline)+#else+# define SQLITE_NOINLINE+#endif++/*+** Make sure that the compiler intrinsics we desire are enabled when+** compiling with an appropriate version of MSVC unless prevented by+** the SQLITE_DISABLE_INTRINSIC define.+*/+#if !defined(SQLITE_DISABLE_INTRINSIC)+# if defined(_MSC_VER) && _MSC_VER>=1300+# if !defined(_WIN32_WCE)+# include <intrin.h>+# pragma intrinsic(_byteswap_ushort)+# pragma intrinsic(_byteswap_ulong)+# pragma intrinsic(_ReadWriteBarrier)+# else+# include <cmnintrin.h>+# endif+# endif+#endif++/*+** Powersafe overwrite is on by default. But can be turned off using+** the -DSQLITE_POWERSAFE_OVERWRITE=0 command-line option.+*/+#ifndef SQLITE_POWERSAFE_OVERWRITE+# define SQLITE_POWERSAFE_OVERWRITE 1+#endif++/*+** EVIDENCE-OF: R-25715-37072 Memory allocation statistics are enabled by+** default unless SQLite is compiled with SQLITE_DEFAULT_MEMSTATUS=0 in+** which case memory allocation statistics are disabled by default.+*/+#if !defined(SQLITE_DEFAULT_MEMSTATUS)+# define SQLITE_DEFAULT_MEMSTATUS 1+#endif++/*+** Exactly one of the following macros must be defined in order to+** specify which memory allocation subsystem to use.+**+** SQLITE_SYSTEM_MALLOC // Use normal system malloc()+** SQLITE_WIN32_MALLOC // Use Win32 native heap API+** SQLITE_ZERO_MALLOC // Use a stub allocator that always fails+** SQLITE_MEMDEBUG // Debugging version of system malloc()+**+** On Windows, if the SQLITE_WIN32_MALLOC_VALIDATE macro is defined and the+** assert() macro is enabled, each call into the Win32 native heap subsystem+** will cause HeapValidate to be called. If heap validation should fail, an+** assertion will be triggered.+**+** If none of the above are defined, then set SQLITE_SYSTEM_MALLOC as+** the default.+*/+#if defined(SQLITE_SYSTEM_MALLOC) \+ + defined(SQLITE_WIN32_MALLOC) \+ + defined(SQLITE_ZERO_MALLOC) \+ + defined(SQLITE_MEMDEBUG)>1+# error "Two or more of the following compile-time configuration options\+ are defined but at most one is allowed:\+ SQLITE_SYSTEM_MALLOC, SQLITE_WIN32_MALLOC, SQLITE_MEMDEBUG,\+ SQLITE_ZERO_MALLOC"+#endif+#if defined(SQLITE_SYSTEM_MALLOC) \+ + defined(SQLITE_WIN32_MALLOC) \+ + defined(SQLITE_ZERO_MALLOC) \+ + defined(SQLITE_MEMDEBUG)==0+# define SQLITE_SYSTEM_MALLOC 1+#endif++/*+** We need to define _XOPEN_SOURCE as follows in order to enable+** recursive mutexes on most Unix systems and fchmod() on OpenBSD.+** But _XOPEN_SOURCE define causes problems for Mac OS X, so omit+** it.+*/+#if !defined(_XOPEN_SOURCE) && !defined(__DARWIN__) && !defined(__APPLE__)+# define _XOPEN_SOURCE 600+#endif++/*+** NDEBUG and SQLITE_DEBUG are opposites. It should always be true that+** defined(NDEBUG)==!defined(SQLITE_DEBUG). If this is not currently true,+** make it true by defining or undefining NDEBUG.+**+** Setting NDEBUG makes the code smaller and faster by disabling the+** assert() statements in the code. So we want the default action+** to be for NDEBUG to be set and NDEBUG to be undefined only if SQLITE_DEBUG+** is set. Thus NDEBUG becomes an opt-in rather than an opt-out+** feature.+*/+#if !defined(NDEBUG) && !defined(SQLITE_DEBUG) +# define NDEBUG 1+#endif+#if defined(NDEBUG) && defined(SQLITE_DEBUG)+# undef NDEBUG+#endif++/*+** The testcase() macro is used to aid in coverage testing. When +** doing coverage testing, the condition inside the argument to+** testcase() must be evaluated both true and false in order to+** get full branch coverage. The testcase() macro is inserted+** to help ensure adequate test coverage in places where simple+** condition/decision coverage is inadequate. For example, testcase()+** can be used to make sure boundary values are tested. For+** bitmask tests, testcase() can be used to make sure each bit+** is significant and used at least once. On switch statements+** where multiple cases go to the same block of code, testcase()+** can insure that all cases are evaluated.+**+*/+#ifdef SQLITE_COVERAGE_TEST+SQLITE_PRIVATE void sqlite3Coverage(int);+# define testcase(X) if( X ){ sqlite3Coverage(__LINE__); }+#else+# define testcase(X)+#endif++/*+** The TESTONLY macro is used to enclose variable declarations or+** other bits of code that are needed to support the arguments+** within testcase() and assert() macros.+*/+#if !defined(NDEBUG) || defined(SQLITE_COVERAGE_TEST)+# define TESTONLY(X) X+#else+# define TESTONLY(X)+#endif++/*+** Sometimes we need a small amount of code such as a variable initialization+** to setup for a later assert() statement. We do not want this code to+** appear when assert() is disabled. The following macro is therefore+** used to contain that setup code. The "VVA" acronym stands for+** "Verification, Validation, and Accreditation". In other words, the+** code within VVA_ONLY() will only run during verification processes.+*/+#ifndef NDEBUG+# define VVA_ONLY(X) X+#else+# define VVA_ONLY(X)+#endif++/*+** The ALWAYS and NEVER macros surround boolean expressions which +** are intended to always be true or false, respectively. Such+** expressions could be omitted from the code completely. But they+** are included in a few cases in order to enhance the resilience+** of SQLite to unexpected behavior - to make the code "self-healing"+** or "ductile" rather than being "brittle" and crashing at the first+** hint of unplanned behavior.+**+** In other words, ALWAYS and NEVER are added for defensive code.+**+** When doing coverage testing ALWAYS and NEVER are hard-coded to+** be true and false so that the unreachable code they specify will+** not be counted as untested code.+*/+#if defined(SQLITE_COVERAGE_TEST)+# define ALWAYS(X) (1)+# define NEVER(X) (0)+#elif !defined(NDEBUG)+# define ALWAYS(X) ((X)?1:(assert(0),0))+# define NEVER(X) ((X)?(assert(0),1):0)+#else+# define ALWAYS(X) (X)+# define NEVER(X) (X)+#endif++/*+** Declarations used for tracing the operating system interfaces.+*/+#if defined(SQLITE_FORCE_OS_TRACE) || defined(SQLITE_TEST) || \+ (defined(SQLITE_DEBUG) && SQLITE_OS_WIN)+ extern int sqlite3OSTrace;+# define OSTRACE(X) if( sqlite3OSTrace ) sqlite3DebugPrintf X+# define SQLITE_HAVE_OS_TRACE+#else+# define OSTRACE(X)+# undef SQLITE_HAVE_OS_TRACE+#endif++/*+** Is the sqlite3ErrName() function needed in the build? Currently,+** it is needed by "mutex_w32.c" (when debugging), "os_win.c" (when+** OSTRACE is enabled), and by several "test*.c" files (which are+** compiled using SQLITE_TEST).+*/+#if defined(SQLITE_HAVE_OS_TRACE) || defined(SQLITE_TEST) || \+ (defined(SQLITE_DEBUG) && SQLITE_OS_WIN)+# define SQLITE_NEED_ERR_NAME+#else+# undef SQLITE_NEED_ERR_NAME+#endif++/*+** The macro unlikely() is a hint that surrounds a boolean+** expression that is usually false. Macro likely() surrounds+** a boolean expression that is usually true. These hints could,+** in theory, be used by the compiler to generate better code, but+** currently they are just comments for human readers.+*/+#define likely(X) (X)+#define unlikely(X) (X)++#include <stdlib.h>+#include <string.h>+#include <assert.h>+#include <stddef.h>++/*+** The "file format" number is an integer that is incremented whenever+** the VDBE-level file format changes. The following macros define the+** the default file format for new databases and the maximum file format+** that the library can read.+*/+#define SQLITE_MAX_FILE_FORMAT 4+#ifndef SQLITE_DEFAULT_FILE_FORMAT+# define SQLITE_DEFAULT_FILE_FORMAT 4+#endif++/*+** The default initial allocation for the pagecache when using separate+** pagecaches for each database connection. A positive number is the+** number of pages. A negative number N translations means that a buffer+** of -1024*N bytes is allocated and used for as many pages as it will hold.+*/+#ifndef SQLITE_DEFAULT_PCACHE_INITSZ+# define SQLITE_DEFAULT_PCACHE_INITSZ 100+#endif++/*+** GCC does not define the offsetof() macro so we'll have to do it+** ourselves.+*/+#ifndef offsetof+#define offsetof(STRUCTURE,FIELD) ((int)((char*)&((STRUCTURE*)0)->FIELD))+#endif++/*+** Macros to compute minimum and maximum of two numbers.+*/+#define MIN(A,B) ((A)<(B)?(A):(B))+#define MAX(A,B) ((A)>(B)?(A):(B))++/*+** Swap two objects of type TYPE.+*/+#define SWAP(TYPE,A,B) {TYPE t=A; A=B; B=t;}++/*+** SQLITE_MAX_U32 is a u64 constant that is the maximum u64 value+** that can be stored in a u32 without loss of data. The value+** is 0x00000000ffffffff. But because of quirks of some compilers, we+** have to specify the value in the less intuitive manner shown:+*/+#define SQLITE_MAX_U32 ((((u64)1)<<32)-1)++/*+** Set the SQLITE_PTRSIZE macro to the number of bytes in a pointer+*/+#ifndef SQLITE_PTRSIZE+# if defined(__SIZEOF_POINTER__)+# define SQLITE_PTRSIZE __SIZEOF_POINTER__+# elif defined(i386) || defined(__i386__) || defined(_M_IX86) || \+ defined(_M_ARM) || defined(__arm__) || defined(__x86)+# define SQLITE_PTRSIZE 4+# else+# define SQLITE_PTRSIZE 8+# endif+#endif++/*+** Constants for the largest and smallest possible 64-bit signed integers.+** These macros are designed to work correctly on both 32-bit and 64-bit+** compilers.+*/+#define LARGEST_INT64 (0xffffffff|(((i64)0x7fffffff)<<32))+#define SMALLEST_INT64 (((i64)-1) - LARGEST_INT64)++/* +** Round up a number to the next larger multiple of 8. This is used+** to force 8-byte alignment on 64-bit architectures.+*/+#define ROUND8(x) (((x)+7)&~7)++/*+** Round down to the nearest multiple of 8+*/+#define ROUNDDOWN8(x) ((x)&~7)++/*+** Disable MMAP on platforms where it is known to not work+*/+#if defined(__OpenBSD__) || defined(__QNXNTO__)+# undef SQLITE_MAX_MMAP_SIZE+# define SQLITE_MAX_MMAP_SIZE 0+#endif++/*+** Default maximum size of memory used by memory-mapped I/O in the VFS+*/+#ifdef __APPLE__+# include <TargetConditionals.h>+# if TARGET_OS_IPHONE+# undef SQLITE_MAX_MMAP_SIZE+# define SQLITE_MAX_MMAP_SIZE 0+# endif+#endif+#ifndef SQLITE_MAX_MMAP_SIZE+# if defined(__linux__) \+ || defined(_WIN32) \+ || (defined(__APPLE__) && defined(__MACH__)) \+ || defined(__sun) \+ || defined(__FreeBSD__) \+ || defined(__DragonFly__)+# define SQLITE_MAX_MMAP_SIZE 0x7fff0000 /* 2147418112 */+# else+# define SQLITE_MAX_MMAP_SIZE 0+# endif+# define SQLITE_MAX_MMAP_SIZE_xc 1 /* exclude from ctime.c */+#endif++/*+** The default MMAP_SIZE is zero on all platforms. Or, even if a larger+** default MMAP_SIZE is specified at compile-time, make sure that it does+** not exceed the maximum mmap size.+*/+#ifndef SQLITE_DEFAULT_MMAP_SIZE+# define SQLITE_DEFAULT_MMAP_SIZE 0+# define SQLITE_DEFAULT_MMAP_SIZE_xc 1 /* Exclude from ctime.c */+#endif+#if SQLITE_DEFAULT_MMAP_SIZE>SQLITE_MAX_MMAP_SIZE+# undef SQLITE_DEFAULT_MMAP_SIZE+# define SQLITE_DEFAULT_MMAP_SIZE SQLITE_MAX_MMAP_SIZE+#endif++/*+** An instance of the following structure is used to store the busy-handler+** callback for a given sqlite handle. +**+** The sqlite.busyHandler member of the sqlite struct contains the busy+** callback for the database handle. Each pager opened via the sqlite+** handle is passed a pointer to sqlite.busyHandler. The busy-handler+** callback is currently invoked only from within pager.c.+*/+typedef struct BusyHandler BusyHandler;+struct BusyHandler {+ int (*xFunc)(void *,int); /* The busy callback */+ void *pArg; /* First arg to busy callback */+ int nBusy; /* Incremented with each busy call */+};++/*+** The root-page of the master database table.+*/+#define MASTER_ROOT 1++/*+** A convenience macro that returns the number of elements in+** an array.+*/+#define ArraySize(X) ((int)(sizeof(X)/sizeof(X[0])))++/*+** When SQLITE_OMIT_WSD is defined, it means that the target platform does+** not support Writable Static Data (WSD) such as global and static variables.+** All variables must either be on the stack or dynamically allocated from+** the heap. When WSD is unsupported, the variable declarations scattered+** throughout the SQLite code must become constants instead. The SQLITE_WSD+** macro is used for this purpose. And instead of referencing the variable+** directly, we use its constant as a key to lookup the run-time allocated+** buffer that holds real variable. The constant is also the initializer+** for the run-time allocated buffer.+**+** In the usual case where WSD is supported, the SQLITE_WSD and GLOBAL+** macros become no-ops and have zero performance impact.+*/+#ifdef SQLITE_OMIT_WSD+ #define SQLITE_WSD const+ #define GLOBAL(t,v) (*(t*)sqlite3_wsd_find((void*)&(v), sizeof(v)))+ #define sqlite3GlobalConfig GLOBAL(struct Sqlite3Config, sqlite3Config)+SQLITE_PRIVATE int sqlite3_wsd_init(int N, int J);+SQLITE_PRIVATE void *sqlite3_wsd_find(void *K, int L);+#else+ #define SQLITE_WSD + #define GLOBAL(t,v) v+ #define sqlite3GlobalConfig sqlite3Config+#endif++/*+** The following macros are used to suppress compiler warnings and to+** make it clear to human readers when a function parameter is deliberately +** left unused within the body of a function. This usually happens when+** a function is called via a function pointer. For example the +** implementation of an SQL aggregate step callback may not use the+** parameter indicating the number of arguments passed to the aggregate,+** if it knows that this is enforced elsewhere.+**+** When a function parameter is not used at all within the body of a function,+** it is generally named "NotUsed" or "NotUsed2" to make things even clearer.+** However, these macros may also be used to suppress warnings related to+** parameters that may or may not be used depending on compilation options.+** For example those parameters only used in assert() statements. In these+** cases the parameters are named as per the usual conventions.+*/+#define UNUSED_PARAMETER(x) (void)(x)+#define UNUSED_PARAMETER2(x,y) UNUSED_PARAMETER(x),UNUSED_PARAMETER(y)++typedef struct Bitvec Bitvec;+typedef struct CollSeq CollSeq;+typedef struct PrintfArguments PrintfArguments;+typedef struct Savepoint Savepoint;+typedef struct StrAccum StrAccum;++/************** Include pager.h in the middle of sqliteInt.h *****************/+/************** Begin file pager.h *******************************************/+/*+** 2001 September 15+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This header file defines the interface that the sqlite page cache+** subsystem. The page cache subsystem reads and writes a file a page+** at a time and provides a journal for rollback.+*/++#ifndef _PAGER_H_+#define _PAGER_H_++/*+** Default maximum size for persistent journal files. A negative +** value means no limit. This value may be overridden using the +** sqlite3PagerJournalSizeLimit() API. See also "PRAGMA journal_size_limit".+*/+#ifndef SQLITE_DEFAULT_JOURNAL_SIZE_LIMIT+ #define SQLITE_DEFAULT_JOURNAL_SIZE_LIMIT -1+#endif++/*+** The type used to represent a page number. The first page in a file+** is called page 1. 0 is used to represent "not a page".+*/+typedef u32 Pgno;++/*+** Each open file is managed by a separate instance of the "Pager" structure.+*/+typedef struct Pager Pager;++/*+** Handle type for pages.+*/+typedef struct PgHdr DbPage;++/*+** Page number PAGER_MJ_PGNO is never used in an SQLite database (it is+** reserved for working around a windows/posix incompatibility). It is+** used in the journal to signify that the remainder of the journal file +** is devoted to storing a master journal name - there are no more pages to+** roll back. See comments for function writeMasterJournal() in pager.c +** for details.+*/+#define PAGER_MJ_PGNO(x) ((Pgno)((PENDING_BYTE/((x)->pageSize))+1))++/*+** Allowed values for the flags parameter to sqlite3PagerOpen().+**+** NOTE: These values must match the corresponding BTREE_ values in btree.h.+*/+#define PAGER_OMIT_JOURNAL 0x0001 /* Do not use a rollback journal */+#define PAGER_MEMORY 0x0002 /* In-memory database */++/*+** Valid values for the second argument to sqlite3PagerLockingMode().+*/+#define PAGER_LOCKINGMODE_QUERY -1+#define PAGER_LOCKINGMODE_NORMAL 0+#define PAGER_LOCKINGMODE_EXCLUSIVE 1++/*+** Numeric constants that encode the journalmode. +*/+#define PAGER_JOURNALMODE_QUERY (-1) /* Query the value of journalmode */+#define PAGER_JOURNALMODE_DELETE 0 /* Commit by deleting journal file */+#define PAGER_JOURNALMODE_PERSIST 1 /* Commit by zeroing journal header */+#define PAGER_JOURNALMODE_OFF 2 /* Journal omitted. */+#define PAGER_JOURNALMODE_TRUNCATE 3 /* Commit by truncating journal */+#define PAGER_JOURNALMODE_MEMORY 4 /* In-memory journal file */+#define PAGER_JOURNALMODE_WAL 5 /* Use write-ahead logging */++/*+** Flags that make up the mask passed to sqlite3PagerAcquire().+*/+#define PAGER_GET_NOCONTENT 0x01 /* Do not load data from disk */+#define PAGER_GET_READONLY 0x02 /* Read-only page is acceptable */++/*+** Flags for sqlite3PagerSetFlags()+*/+#define PAGER_SYNCHRONOUS_OFF 0x01 /* PRAGMA synchronous=OFF */+#define PAGER_SYNCHRONOUS_NORMAL 0x02 /* PRAGMA synchronous=NORMAL */+#define PAGER_SYNCHRONOUS_FULL 0x03 /* PRAGMA synchronous=FULL */+#define PAGER_SYNCHRONOUS_MASK 0x03 /* Mask for three values above */+#define PAGER_FULLFSYNC 0x04 /* PRAGMA fullfsync=ON */+#define PAGER_CKPT_FULLFSYNC 0x08 /* PRAGMA checkpoint_fullfsync=ON */+#define PAGER_CACHESPILL 0x10 /* PRAGMA cache_spill=ON */+#define PAGER_FLAGS_MASK 0x1c /* All above except SYNCHRONOUS */++/*+** The remainder of this file contains the declarations of the functions+** that make up the Pager sub-system API. See source code comments for +** a detailed description of each routine.+*/++/* Open and close a Pager connection. */ +SQLITE_PRIVATE int sqlite3PagerOpen(+ sqlite3_vfs*,+ Pager **ppPager,+ const char*,+ int,+ int,+ int,+ void(*)(DbPage*)+);+SQLITE_PRIVATE int sqlite3PagerClose(Pager *pPager);+SQLITE_PRIVATE int sqlite3PagerReadFileheader(Pager*, int, unsigned char*);++/* Functions used to configure a Pager object. */+SQLITE_PRIVATE void sqlite3PagerSetBusyhandler(Pager*, int(*)(void *), void *);+SQLITE_PRIVATE int sqlite3PagerSetPagesize(Pager*, u32*, int);+#ifdef SQLITE_HAS_CODEC+SQLITE_PRIVATE void sqlite3PagerAlignReserve(Pager*,Pager*);+#endif+SQLITE_PRIVATE int sqlite3PagerMaxPageCount(Pager*, int);+SQLITE_PRIVATE void sqlite3PagerSetCachesize(Pager*, int);+SQLITE_PRIVATE void sqlite3PagerSetMmapLimit(Pager *, sqlite3_int64);+SQLITE_PRIVATE void sqlite3PagerSetFlags(Pager*,unsigned);+#if 0+SQLITE_PRIVATE int sqlite3PagerLockingMode(Pager *, int);+SQLITE_PRIVATE int sqlite3PagerSetJournalMode(Pager *, int);+SQLITE_PRIVATE int sqlite3PagerGetJournalMode(Pager*);+SQLITE_PRIVATE int sqlite3PagerOkToChangeJournalMode(Pager*);+SQLITE_PRIVATE i64 sqlite3PagerJournalSizeLimit(Pager *, i64);+#endif++/* Functions used to obtain and release page references. */ +SQLITE_PRIVATE int sqlite3PagerAcquire(Pager *pPager, Pgno pgno, DbPage **ppPage, int clrFlag);+#define sqlite3PagerGet(A,B,C) sqlite3PagerAcquire(A,B,C,0)+SQLITE_PRIVATE DbPage *sqlite3PagerLookup(Pager *pPager, Pgno pgno);+SQLITE_PRIVATE void sqlite3PagerRef(DbPage*);+SQLITE_PRIVATE void sqlite3PagerUnref(DbPage*);+SQLITE_PRIVATE void sqlite3PagerUnrefNotNull(DbPage*);++/* Operations on page references. */+SQLITE_PRIVATE int sqlite3PagerWrite(DbPage*);+SQLITE_PRIVATE void sqlite3PagerDontWrite(DbPage*);+SQLITE_PRIVATE int sqlite3PagerMovepage(Pager*,DbPage*,Pgno,int);+SQLITE_PRIVATE int sqlite3PagerPageRefcount(DbPage*);+SQLITE_PRIVATE void *sqlite3PagerGetData(DbPage *); +SQLITE_PRIVATE void *sqlite3PagerGetExtra(DbPage *); ++/* Functions used to manage pager transactions and savepoints. */+SQLITE_PRIVATE void sqlite3PagerPagecount(Pager*, int*);+SQLITE_PRIVATE int sqlite3PagerBegin(Pager*, int exFlag, int);+SQLITE_PRIVATE int sqlite3PagerCommitPhaseOne(Pager*,const char *zMaster, int);+SQLITE_PRIVATE int sqlite3PagerExclusiveLock(Pager*);+SQLITE_PRIVATE int sqlite3PagerSync(Pager *pPager, const char *zMaster);+SQLITE_PRIVATE int sqlite3PagerCommitPhaseTwo(Pager*);+SQLITE_PRIVATE int sqlite3PagerRollback(Pager*);+SQLITE_PRIVATE int sqlite3PagerOpenSavepoint(Pager *pPager, int n);+SQLITE_PRIVATE int sqlite3PagerSavepoint(Pager *pPager, int op, int iSavepoint);+SQLITE_PRIVATE int sqlite3PagerSharedLock(Pager *pPager);++#ifndef SQLITE_OMIT_WAL+SQLITE_PRIVATE int sqlite3PagerCheckpoint(Pager *pPager, int, int*, int*);+SQLITE_PRIVATE int sqlite3PagerWalSupported(Pager *pPager);+#if 0+SQLITE_PRIVATE int sqlite3PagerWalCallback(Pager *pPager);+#endif+SQLITE_PRIVATE int sqlite3PagerOpenWal(Pager *pPager, int *pisOpen);+#if 0+SQLITE_PRIVATE int sqlite3PagerCloseWal(Pager *pPager);+#endif+#endif++#ifdef SQLITE_ENABLE_ZIPVFS+SQLITE_PRIVATE int sqlite3PagerWalFramesize(Pager *pPager);+#endif++/* Functions used to query pager state and configuration. */+SQLITE_PRIVATE u8 sqlite3PagerIsreadonly(Pager*);+SQLITE_PRIVATE u32 sqlite3PagerDataVersion(Pager*);+#ifdef SQLITE_DEBUG+SQLITE_PRIVATE int sqlite3PagerRefcount(Pager*);+#endif+#if 0+SQLITE_PRIVATE int sqlite3PagerMemUsed(Pager*);+#endif+SQLITE_PRIVATE const char *sqlite3PagerFilename(Pager*, int);+SQLITE_PRIVATE const sqlite3_vfs *sqlite3PagerVfs(Pager*);+#ifdef SQLITE_DIRECT_OVERFLOW_READ+SQLITE_PRIVATE sqlite3_file *sqlite3PagerFile(Pager*);+#endif+SQLITE_PRIVATE const char *sqlite3PagerJournalname(Pager*);+SQLITE_PRIVATE int sqlite3PagerNosync(Pager*);+SQLITE_PRIVATE void *sqlite3PagerTempSpace(Pager*);+#if 0+SQLITE_PRIVATE void sqlite3PagerCacheStat(Pager *, int, int, int *);+SQLITE_PRIVATE void sqlite3PagerClearCache(Pager *);+#endif+SQLITE_PRIVATE int sqlite3SectorSize(sqlite3_file *);++/* Functions used to truncate the database file. */+SQLITE_PRIVATE void sqlite3PagerTruncateImage(Pager*,Pgno);++SQLITE_PRIVATE void sqlite3PagerRekey(DbPage*, Pgno, u16);++#if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_WAL)+SQLITE_PRIVATE void *sqlite3PagerCodec(DbPage *);+#endif++/* Functions to support testing and debugging. */+#if !defined(NDEBUG) || defined(SQLITE_TEST)+SQLITE_PRIVATE Pgno sqlite3PagerPagenumber(DbPage*);+SQLITE_PRIVATE int sqlite3PagerIswriteable(DbPage*);+#endif+#ifdef SQLITE_TEST+SQLITE_PRIVATE int *sqlite3PagerStats(Pager*);+SQLITE_PRIVATE void sqlite3PagerRefdump(Pager*);+ void disable_simulated_io_errors(void);+ void enable_simulated_io_errors(void);+#else+# define disable_simulated_io_errors()+# define enable_simulated_io_errors()+#endif++#endif /* _PAGER_H_ */++/************** End of pager.h ***********************************************/+/************** Continuing where we left off in sqliteInt.h ******************/+/************** Include pcache.h in the middle of sqliteInt.h ****************/+/************** Begin file pcache.h ******************************************/+/*+** 2008 August 05+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This header file defines the interface that the sqlite page cache+** subsystem. +*/++#ifndef _PCACHE_H_++typedef struct PgHdr PgHdr;+typedef struct PCache PCache;++/*+** Every page in the cache is controlled by an instance of the following+** structure.+*/+struct PgHdr {+ sqlite3_pcache_page *pPage; /* Pcache object page handle */+ void *pData; /* Page data */+ void *pExtra; /* Extra content */+ PgHdr *pDirty; /* Transient list of dirty pages */+ Pager *pPager; /* The pager this page is part of */+ Pgno pgno; /* Page number for this page */+#ifdef SQLITE_CHECK_PAGES+ u32 pageHash; /* Hash of page content */+#endif+ u16 flags; /* PGHDR flags defined below */++ /**********************************************************************+ ** Elements above are public. All that follows is private to pcache.c+ ** and should not be accessed by other modules.+ */+ i16 nRef; /* Number of users of this page */+ PCache *pCache; /* Cache that owns this page */++ PgHdr *pDirtyNext; /* Next element in list of dirty pages */+ PgHdr *pDirtyPrev; /* Previous element in list of dirty pages */+};++/* Bit values for PgHdr.flags */+#define PGHDR_CLEAN 0x001 /* Page not on the PCache.pDirty list */+#define PGHDR_DIRTY 0x002 /* Page is on the PCache.pDirty list */+#define PGHDR_WRITEABLE 0x004 /* Journaled and ready to modify */+#define PGHDR_NEED_SYNC 0x008 /* Fsync the rollback journal before+ ** writing this page to the database */+#define PGHDR_NEED_READ 0x010 /* Content is unread */+#define PGHDR_DONT_WRITE 0x020 /* Do not write content to disk */+#define PGHDR_MMAP 0x040 /* This is an mmap page object */++/* Initialize and shutdown the page cache subsystem */+SQLITE_PRIVATE int sqlite3PcacheInitialize(void);+SQLITE_PRIVATE void sqlite3PcacheShutdown(void);++/* Page cache buffer management:+** These routines implement SQLITE_CONFIG_PAGECACHE.+*/+SQLITE_PRIVATE void sqlite3PCacheBufferSetup(void *, int sz, int n);++/* Create a new pager cache.+** Under memory stress, invoke xStress to try to make pages clean.+** Only clean and unpinned pages can be reclaimed.+*/+SQLITE_PRIVATE int sqlite3PcacheOpen(+ int szPage, /* Size of every page */+ int szExtra, /* Extra space associated with each page */+ int bPurgeable, /* True if pages are on backing store */+ int (*xStress)(void*, PgHdr*), /* Call to try to make pages clean */+ void *pStress, /* Argument to xStress */+ PCache *pToInit /* Preallocated space for the PCache */+);++/* Modify the page-size after the cache has been created. */+SQLITE_PRIVATE int sqlite3PcacheSetPageSize(PCache *, int);++/* Return the size in bytes of a PCache object. Used to preallocate+** storage space.+*/+SQLITE_PRIVATE int sqlite3PcacheSize(void);++/* One release per successful fetch. Page is pinned until released.+** Reference counted. +*/+SQLITE_PRIVATE sqlite3_pcache_page *sqlite3PcacheFetch(PCache*, Pgno, int createFlag);+SQLITE_PRIVATE int sqlite3PcacheFetchStress(PCache*, Pgno, sqlite3_pcache_page**);+SQLITE_PRIVATE PgHdr *sqlite3PcacheFetchFinish(PCache*, Pgno, sqlite3_pcache_page *pPage);+SQLITE_PRIVATE void sqlite3PcacheRelease(PgHdr*);++SQLITE_PRIVATE void sqlite3PcacheDrop(PgHdr*); /* Remove page from cache */+SQLITE_PRIVATE void sqlite3PcacheMakeDirty(PgHdr*); /* Make sure page is marked dirty */+SQLITE_PRIVATE void sqlite3PcacheMakeClean(PgHdr*); /* Mark a single page as clean */+SQLITE_PRIVATE void sqlite3PcacheCleanAll(PCache*); /* Mark all dirty list pages as clean */++/* Change a page number. Used by incr-vacuum. */+SQLITE_PRIVATE void sqlite3PcacheMove(PgHdr*, Pgno);++/* Remove all pages with pgno>x. Reset the cache if x==0 */+SQLITE_PRIVATE void sqlite3PcacheTruncate(PCache*, Pgno x);++/* Get a list of all dirty pages in the cache, sorted by page number */+SQLITE_PRIVATE PgHdr *sqlite3PcacheDirtyList(PCache*);++/* Reset and close the cache object */+SQLITE_PRIVATE void sqlite3PcacheClose(PCache*);++/* Clear flags from pages of the page cache */+SQLITE_PRIVATE void sqlite3PcacheClearSyncFlags(PCache *);++/* Discard the contents of the cache */+SQLITE_PRIVATE void sqlite3PcacheClear(PCache*);++/* Return the total number of outstanding page references */+SQLITE_PRIVATE int sqlite3PcacheRefCount(PCache*);++/* Increment the reference count of an existing page */+SQLITE_PRIVATE void sqlite3PcacheRef(PgHdr*);++SQLITE_PRIVATE int sqlite3PcachePageRefcount(PgHdr*);++#ifdef SQLITE_TEST+/* Return the total number of pages stored in the cache */+SQLITE_PRIVATE int sqlite3PcachePagecount(PCache*);+#endif++#if defined(SQLITE_CHECK_PAGES) || defined(SQLITE_DEBUG)+/* Iterate through all dirty pages currently stored in the cache. This+** interface is only available if SQLITE_CHECK_PAGES is defined when the +** library is built.+*/+SQLITE_PRIVATE void sqlite3PcacheIterateDirty(PCache *pCache, void (*xIter)(PgHdr *));+#endif++/* Set and get the suggested cache-size for the specified pager-cache.+**+** If no global maximum is configured, then the system attempts to limit+** the total number of pages cached by purgeable pager-caches to the sum+** of the suggested cache-sizes.+*/+SQLITE_PRIVATE void sqlite3PcacheSetCachesize(PCache *, int);+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3PcacheGetCachesize(PCache *);+#endif++#if 0+/* Free up as much memory as possible from the page cache */+SQLITE_PRIVATE void sqlite3PcacheShrink(PCache*);+#endif++#ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT+/* Try to return memory used by the pcache module to the main memory heap */+SQLITE_PRIVATE int sqlite3PcacheReleaseMemory(int);+#endif++#ifdef SQLITE_TEST+SQLITE_PRIVATE void sqlite3PcacheStats(int*,int*,int*,int*);+#endif++SQLITE_PRIVATE void sqlite3PCacheSetDefault(void);++/* Return the header size */+SQLITE_PRIVATE int sqlite3HeaderSizePcache(void);+SQLITE_PRIVATE int sqlite3HeaderSizePcache1(void);++#endif /* _PCACHE_H_ */++/************** End of pcache.h **********************************************/+/************** Continuing where we left off in sqliteInt.h ******************/++/************** Include os.h in the middle of sqliteInt.h ********************/+/************** Begin file os.h **********************************************/+/*+** 2001 September 16+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This header file (together with is companion C source-code file+** "os.c") attempt to abstract the underlying operating system so that+** the SQLite library will work on both POSIX and windows systems.+**+** This header file is #include-ed by sqliteInt.h and thus ends up+** being included by every source file.+*/+#ifndef _SQLITE_OS_H_+#define _SQLITE_OS_H_++/*+** Attempt to automatically detect the operating system and setup the+** necessary pre-processor macros for it.+*/+/************** Include os_setup.h in the middle of os.h *********************/+/************** Begin file os_setup.h ****************************************/+/*+** 2013 November 25+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains pre-processor directives related to operating system+** detection and/or setup.+*/+#ifndef _OS_SETUP_H_+#define _OS_SETUP_H_++/*+** Figure out if we are dealing with Unix, Windows, or some other operating+** system.+**+** After the following block of preprocess macros, all of SQLITE_OS_UNIX,+** SQLITE_OS_WIN, and SQLITE_OS_OTHER will defined to either 1 or 0. One of+** the three will be 1. The other two will be 0.+*/+#if defined(SQLITE_OS_OTHER)+# if SQLITE_OS_OTHER==1+# undef SQLITE_OS_UNIX+# define SQLITE_OS_UNIX 0+# undef SQLITE_OS_WIN+# define SQLITE_OS_WIN 0+# else+# undef SQLITE_OS_OTHER+# endif+#endif+#if !defined(SQLITE_OS_UNIX) && !defined(SQLITE_OS_OTHER)+# define SQLITE_OS_OTHER 0+# ifndef SQLITE_OS_WIN+# if defined(_WIN32) || defined(WIN32) || defined(__CYGWIN__) || \+ defined(__MINGW32__) || defined(__BORLANDC__)+# define SQLITE_OS_WIN 1+# define SQLITE_OS_UNIX 0+# else+# define SQLITE_OS_WIN 0+# define SQLITE_OS_UNIX 1+# endif+# else+# define SQLITE_OS_UNIX 0+# endif+#else+# ifndef SQLITE_OS_WIN+# define SQLITE_OS_WIN 0+# endif+#endif++#endif /* _OS_SETUP_H_ */++/************** End of os_setup.h ********************************************/+/************** Continuing where we left off in os.h *************************/++/* If the SET_FULLSYNC macro is not defined above, then make it+** a no-op+*/+#ifndef SET_FULLSYNC+# define SET_FULLSYNC(x,y)+#endif++/*+** The default size of a disk sector+*/+#ifndef SQLITE_DEFAULT_SECTOR_SIZE+# define SQLITE_DEFAULT_SECTOR_SIZE 4096+#endif++/*+** Temporary files are named starting with this prefix followed by 16 random+** alphanumeric characters, and no file extension. They are stored in the+** OS's standard temporary file directory, and are deleted prior to exit.+** If sqlite is being embedded in another program, you may wish to change the+** prefix to reflect your program's name, so that if your program exits+** prematurely, old temporary files can be easily identified. This can be done+** using -DSQLITE_TEMP_FILE_PREFIX=myprefix_ on the compiler command line.+**+** 2006-10-31: The default prefix used to be "sqlite_". But then+** Mcafee started using SQLite in their anti-virus product and it+** started putting files with the "sqlite" name in the c:/temp folder.+** This annoyed many windows users. Those users would then do a +** Google search for "sqlite", find the telephone numbers of the+** developers and call to wake them up at night and complain.+** For this reason, the default name prefix is changed to be "sqlite" +** spelled backwards. So the temp files are still identified, but+** anybody smart enough to figure out the code is also likely smart+** enough to know that calling the developer will not help get rid+** of the file.+*/+#ifndef SQLITE_TEMP_FILE_PREFIX+# define SQLITE_TEMP_FILE_PREFIX "etilqs_"+#endif++/*+** The following values may be passed as the second argument to+** sqlite3OsLock(). The various locks exhibit the following semantics:+**+** SHARED: Any number of processes may hold a SHARED lock simultaneously.+** RESERVED: A single process may hold a RESERVED lock on a file at+** any time. Other processes may hold and obtain new SHARED locks.+** PENDING: A single process may hold a PENDING lock on a file at+** any one time. Existing SHARED locks may persist, but no new+** SHARED locks may be obtained by other processes.+** EXCLUSIVE: An EXCLUSIVE lock precludes all other locks.+**+** PENDING_LOCK may not be passed directly to sqlite3OsLock(). Instead, a+** process that requests an EXCLUSIVE lock may actually obtain a PENDING+** lock. This can be upgraded to an EXCLUSIVE lock by a subsequent call to+** sqlite3OsLock().+*/+#define NO_LOCK 0+#define SHARED_LOCK 1+#define RESERVED_LOCK 2+#define PENDING_LOCK 3+#define EXCLUSIVE_LOCK 4++/*+** File Locking Notes: (Mostly about windows but also some info for Unix)+**+** We cannot use LockFileEx() or UnlockFileEx() on Win95/98/ME because+** those functions are not available. So we use only LockFile() and+** UnlockFile().+**+** LockFile() prevents not just writing but also reading by other processes.+** A SHARED_LOCK is obtained by locking a single randomly-chosen +** byte out of a specific range of bytes. The lock byte is obtained at +** random so two separate readers can probably access the file at the +** same time, unless they are unlucky and choose the same lock byte.+** An EXCLUSIVE_LOCK is obtained by locking all bytes in the range.+** There can only be one writer. A RESERVED_LOCK is obtained by locking+** a single byte of the file that is designated as the reserved lock byte.+** A PENDING_LOCK is obtained by locking a designated byte different from+** the RESERVED_LOCK byte.+**+** On WinNT/2K/XP systems, LockFileEx() and UnlockFileEx() are available,+** which means we can use reader/writer locks. When reader/writer locks+** are used, the lock is placed on the same range of bytes that is used+** for probabilistic locking in Win95/98/ME. Hence, the locking scheme+** will support two or more Win95 readers or two or more WinNT readers.+** But a single Win95 reader will lock out all WinNT readers and a single+** WinNT reader will lock out all other Win95 readers.+**+** The following #defines specify the range of bytes used for locking.+** SHARED_SIZE is the number of bytes available in the pool from which+** a random byte is selected for a shared lock. The pool of bytes for+** shared locks begins at SHARED_FIRST. +**+** The same locking strategy and+** byte ranges are used for Unix. This leaves open the possibility of having+** clients on win95, winNT, and unix all talking to the same shared file+** and all locking correctly. To do so would require that samba (or whatever+** tool is being used for file sharing) implements locks correctly between+** windows and unix. I'm guessing that isn't likely to happen, but by+** using the same locking range we are at least open to the possibility.+**+** Locking in windows is manditory. For this reason, we cannot store+** actual data in the bytes used for locking. The pager never allocates+** the pages involved in locking therefore. SHARED_SIZE is selected so+** that all locks will fit on a single page even at the minimum page size.+** PENDING_BYTE defines the beginning of the locks. By default PENDING_BYTE+** is set high so that we don't have to allocate an unused page except+** for very large databases. But one should test the page skipping logic +** by setting PENDING_BYTE low and running the entire regression suite.+**+** Changing the value of PENDING_BYTE results in a subtly incompatible+** file format. Depending on how it is changed, you might not notice+** the incompatibility right away, even running a full regression test.+** The default location of PENDING_BYTE is the first byte past the+** 1GB boundary.+**+*/+#ifdef SQLITE_OMIT_WSD+# define PENDING_BYTE (0x40000000)+#else+# define PENDING_BYTE sqlite3PendingByte+#endif+#define RESERVED_BYTE (PENDING_BYTE+1)+#define SHARED_FIRST (PENDING_BYTE+2)+#define SHARED_SIZE 510++/*+** Wrapper around OS specific sqlite3_os_init() function.+*/+SQLITE_PRIVATE int sqlite3OsInit(void);++/* +** Functions for accessing sqlite3_file methods +*/+SQLITE_PRIVATE int sqlite3OsClose(sqlite3_file*);+SQLITE_PRIVATE int sqlite3OsRead(sqlite3_file*, void*, int amt, i64 offset);+SQLITE_PRIVATE int sqlite3OsWrite(sqlite3_file*, const void*, int amt, i64 offset);+SQLITE_PRIVATE int sqlite3OsTruncate(sqlite3_file*, i64 size);+SQLITE_PRIVATE int sqlite3OsSync(sqlite3_file*, int);+SQLITE_PRIVATE int sqlite3OsFileSize(sqlite3_file*, i64 *pSize);+SQLITE_PRIVATE int sqlite3OsLock(sqlite3_file*, int);+SQLITE_PRIVATE int sqlite3OsUnlock(sqlite3_file*, int);+SQLITE_PRIVATE int sqlite3OsCheckReservedLock(sqlite3_file *id, int *pResOut);+SQLITE_PRIVATE int sqlite3OsFileControl(sqlite3_file*,int,void*);+SQLITE_PRIVATE void sqlite3OsFileControlHint(sqlite3_file*,int,void*);+#define SQLITE_FCNTL_DB_UNCHANGED 0xca093fa0+SQLITE_PRIVATE int sqlite3OsSectorSize(sqlite3_file *id);+SQLITE_PRIVATE int sqlite3OsDeviceCharacteristics(sqlite3_file *id);+SQLITE_PRIVATE int sqlite3OsShmMap(sqlite3_file *,int,int,int,void volatile **);+SQLITE_PRIVATE int sqlite3OsShmLock(sqlite3_file *id, int, int, int);+SQLITE_PRIVATE void sqlite3OsShmBarrier(sqlite3_file *id);+SQLITE_PRIVATE int sqlite3OsShmUnmap(sqlite3_file *id, int);+SQLITE_PRIVATE int sqlite3OsFetch(sqlite3_file *id, i64, int, void **);+SQLITE_PRIVATE int sqlite3OsUnfetch(sqlite3_file *, i64, void *);+++/* +** Functions for accessing sqlite3_vfs methods +*/+SQLITE_PRIVATE int sqlite3OsOpen(sqlite3_vfs *, const char *, sqlite3_file*, int, int *);+SQLITE_PRIVATE int sqlite3OsDelete(sqlite3_vfs *, const char *, int);+SQLITE_PRIVATE int sqlite3OsAccess(sqlite3_vfs *, const char *, int, int *pResOut);+SQLITE_PRIVATE int sqlite3OsFullPathname(sqlite3_vfs *, const char *, int, char *);+SQLITE_PRIVATE int sqlite3OsRandomness(sqlite3_vfs *, int, char *);+SQLITE_PRIVATE int sqlite3OsSleep(sqlite3_vfs *, int);++#endif /* _SQLITE_OS_H_ */++/************** End of os.h **************************************************/+/************** Continuing where we left off in sqliteInt.h ******************/+/************** Include mutex.h in the middle of sqliteInt.h *****************/+/************** Begin file mutex.h *******************************************/+/*+** 2007 August 28+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file contains the common header for all mutex implementations.+** The sqliteInt.h header #includes this file so that it is available+** to all source files. We break it out in an effort to keep the code+** better organized.+**+** NOTE: source files should *not* #include this header file directly.+** Source files should #include the sqliteInt.h file and let that file+** include this one indirectly.+*/+++/*+** Figure out what version of the code to use. The choices are+**+** SQLITE_MUTEX_OMIT No mutex logic. Not even stubs. The+** mutexes implementation cannot be overridden+** at start-time.+**+** SQLITE_MUTEX_NOOP For single-threaded applications. No+** mutual exclusion is provided. But this+** implementation can be overridden at+** start-time.+**+** SQLITE_MUTEX_PTHREADS For multi-threaded applications on Unix.+**+** SQLITE_MUTEX_W32 For multi-threaded applications on Win32.+*/+#if !SQLITE_THREADSAFE+# define SQLITE_MUTEX_OMIT+#endif+#if SQLITE_THREADSAFE && !defined(SQLITE_MUTEX_NOOP)+# if SQLITE_OS_UNIX+# define SQLITE_MUTEX_PTHREADS+# elif SQLITE_OS_WIN+# define SQLITE_MUTEX_W32+# else+# define SQLITE_MUTEX_NOOP+# endif+#endif++#ifdef SQLITE_MUTEX_OMIT+/*+** If this is a no-op implementation, implement everything as macros.+*/+#define sqlite3_mutex_alloc(X) ((sqlite3_mutex*)8)+#define sqlite3_mutex_free(X)+#define sqlite3_mutex_enter(X) +#define sqlite3_mutex_try(X) SQLITE_OK+#define sqlite3_mutex_leave(X) +#define sqlite3_mutex_held(X) ((void)(X),1)+#define sqlite3_mutex_notheld(X) ((void)(X),1)+#define sqlite3MutexAlloc(X) ((sqlite3_mutex*)8)+#define sqlite3MutexInit() SQLITE_OK+#define sqlite3MutexEnd()+#define MUTEX_LOGIC(X)+#else+#define MUTEX_LOGIC(X) X+#endif /* defined(SQLITE_MUTEX_OMIT) */++/************** End of mutex.h ***********************************************/+/************** Continuing where we left off in sqliteInt.h ******************/++/*+** The number of different kinds of things that can be limited+** using the sqlite3_limit() interface.+*/+#define SQLITE_N_LIMIT (SQLITE_LIMIT_WORKER_THREADS+1)++/*+** Possible values for the sqlite.magic field.+** The numbers are obtained at random and have no special meaning, other+** than being distinct from one another.+*/+#define SQLITE_MAGIC_OPEN 0xa029a697 /* Database is open */+#define SQLITE_MAGIC_CLOSED 0x9f3c2d33 /* Database is closed */+#define SQLITE_MAGIC_SICK 0x4b771290 /* Error and awaiting close */+#define SQLITE_MAGIC_BUSY 0xf03b7906 /* Database currently in use */+#define SQLITE_MAGIC_ERROR 0xb5357930 /* An SQLITE_MISUSE error occurred */+#define SQLITE_MAGIC_ZOMBIE 0x64cffc7f /* Close with last statement close */++/*+** The SQLITE_*_BKPT macros are substitutes for the error codes with+** the same name but without the _BKPT suffix. These macros invoke+** routines that report the line-number on which the error originated+** using sqlite3_log(). The routines also provide a convenient place+** to set a debugger breakpoint.+*/+SQLITE_PRIVATE int sqlite3CorruptError(int);+SQLITE_PRIVATE int sqlite3MisuseError(int);+SQLITE_PRIVATE int sqlite3CantopenError(int);+#define SQLITE_CORRUPT_BKPT sqlite3CorruptError(__LINE__)+#define SQLITE_MISUSE_BKPT sqlite3MisuseError(__LINE__)+#define SQLITE_CANTOPEN_BKPT sqlite3CantopenError(__LINE__)++#include <ctype.h>++# define sqlite3Toupper(x) toupper((unsigned char)(x))+# define sqlite3Isspace(x) isspace((unsigned char)(x))+# define sqlite3Isalnum(x) isalnum((unsigned char)(x))+# define sqlite3Isalpha(x) isalpha((unsigned char)(x))+# define sqlite3Isdigit(x) isdigit((unsigned char)(x))+# define sqlite3Isxdigit(x) isxdigit((unsigned char)(x))+# define sqlite3Tolower(x) tolower((unsigned char)(x))++/*+** Internal function prototypes+*/+SQLITE_PRIVATE int sqlite3Strlen30(const char*);++SQLITE_PRIVATE int sqlite3MallocInit(void);+SQLITE_PRIVATE void sqlite3MallocEnd(void);+SQLITE_PRIVATE void *sqlite3Malloc(u64);+SQLITE_PRIVATE void *sqlite3MallocZero(u64);+SQLITE_PRIVATE void *sqlite3DbMallocZero(Btree*, u64);+SQLITE_PRIVATE void *sqlite3DbMallocRaw(Btree*, u64);+SQLITE_PRIVATE void *sqlite3Realloc(void*, u64);+SQLITE_PRIVATE void *sqlite3DbReallocOrFree(Btree*, void *, u64);+SQLITE_PRIVATE void *sqlite3DbRealloc(Btree*, void *, u64);+SQLITE_PRIVATE void sqlite3DbFree(Btree*, void*);+SQLITE_PRIVATE int sqlite3MallocSize(void*);+SQLITE_PRIVATE int sqlite3DbMallocSize(Btree*, void*);+SQLITE_PRIVATE void *sqlite3ScratchMalloc(int);+SQLITE_PRIVATE void sqlite3ScratchFree(void*);+SQLITE_PRIVATE void *sqlite3PageMalloc(int);+SQLITE_PRIVATE void sqlite3PageFree(void*);+SQLITE_PRIVATE void sqlite3MemSetDefault(void);+SQLITE_PRIVATE int sqlite3HeapNearlyFull(void);++/*+** On systems with ample stack space and that support alloca(), make+** use of alloca() to obtain space for large automatic objects. By default,+** obtain space from malloc().+**+** The alloca() routine never returns NULL. This will cause code paths+** that deal with sqlite3StackAlloc() failures to be unreachable.+*/+#ifdef SQLITE_USE_ALLOCA+# define sqlite3StackAllocRaw(D,N) alloca(N)+# define sqlite3StackAllocZero(D,N) memset(alloca(N), 0, N)+# define sqlite3StackFree(D,P) +#else+# define sqlite3StackAllocRaw(D,N) sqlite3DbMallocRaw(D,N)+# define sqlite3StackAllocZero(D,N) sqlite3DbMallocZero(D,N)+# define sqlite3StackFree(D,P) sqlite3DbFree(D,P)+#endif++#ifndef SQLITE_MUTEX_OMIT+SQLITE_PRIVATE sqlite3_mutex_methods const *sqlite3DefaultMutex(void);+SQLITE_PRIVATE sqlite3_mutex_methods const *sqlite3NoopMutex(void);+SQLITE_PRIVATE sqlite3_mutex *sqlite3MutexAlloc(int);+SQLITE_PRIVATE int sqlite3MutexInit(void);+SQLITE_PRIVATE int sqlite3MutexEnd(void);+#endif+#if !defined(SQLITE_MUTEX_OMIT) && !defined(SQLITE_MUTEX_NOOP)+SQLITE_PRIVATE void sqlite3MemoryBarrier(void);+#else+# define sqlite3MemoryBarrier()+#endif++#ifndef SQLITE_OMIT_FLOATING_POINT+SQLITE_PRIVATE int sqlite3IsNaN(double);+#else+# define sqlite3IsNaN(X) 0+#endif++/*+** An instance of the following structure holds information about SQL+** functions arguments that are the parameters to the printf() function.+*/+struct PrintfArguments {+ int nArg; /* Total number of arguments */+ int nUsed; /* Number of arguments used so far */+ Mem **apArg; /* The argument values */+};++#define SQLITE_PRINTF_INTERNAL 0x01+#define SQLITE_PRINTF_SQLFUNC 0x02++SQLITE_PRIVATE void sqlite3StrAccumInit(StrAccum*, Btree* pBtree, char*, int, int);+SQLITE_PRIVATE void sqlite3StrAccumAppend(StrAccum*,const char*,int);+SQLITE_PRIVATE void sqlite3AppendChar(StrAccum*,int,char);+SQLITE_PRIVATE char *sqlite3StrAccumFinish(StrAccum*);+SQLITE_PRIVATE void sqlite3StrAccumReset(StrAccum*);++SQLITE_PRIVATE int sqlite3SafetyCheckSickOrOk(Btree*);++SQLITE_PRIVATE int sqlite3InvokeBusyHandler(BusyHandler*);++SQLITE_PRIVATE void sqlite3BackupRestart(sqlite3_backup *);+SQLITE_PRIVATE void sqlite3BackupUpdate(sqlite3_backup *, Pgno, const u8 *);++typedef int (*RecordCompare)(int,const void*,UnpackedRecord*);++#define SQLITE_RecoveryMode 0x00010000 /* Ignore schema errors */+#define SQLITE_CellSizeCk 0x10000000 /* Check btree cell sizes on load */++/*+** The following are used as the second parameter to sqlite3Savepoint(),+** and as the P1 argument to the OP_Savepoint instruction.+*/+#define SAVEPOINT_BEGIN 0+#define SAVEPOINT_RELEASE 1+#define SAVEPOINT_ROLLBACK 2++/*+** A "Collating Sequence" is defined by an instance of the following+** structure. Conceptually, a collating sequence consists of a name and+** a comparison routine that defines the order of that sequence.+**+** If CollSeq.xCmp is NULL, it means that the+** collating sequence is undefined. Indices built on an undefined+** collating sequence may not be read or written.+*/+struct CollSeq {+ char *zName; /* Name of the collating sequence, UTF-8 encoded */+ u8 enc; /* Text encoding handled by xCmp() */+ void *pUser; /* First argument to xCmp() */+ int (*xCmp)(void*,int, const void*, int, const void*);+ void (*xDel)(void*); /* Destructor for pUser */+};++/*+** An instance of the following structure is passed as the first+** argument to sqlite3VdbeKeyCompare and is used to control the +** comparison of the two index keys.+**+** Note that aSortOrder[] and aColl[] have nField+1 slots. There+** are nField slots for the columns of an index then one extra slot+** for the rowid at the end.+*/+struct KeyInfo {+ u32 nRef; /* Number of references to this KeyInfo object */+ u8 enc; /* Text encoding - one of the SQLITE_UTF* values */+ u16 nField; /* Number of key columns in the index */+ u16 nXField; /* Number of columns beyond the key columns */+ Btree *pBtree; /* The database connection */+ u8 *aSortOrder; /* Sort order for each column. */+ CollSeq *aColl[1]; /* Collating sequence for each term of the key */+};++/*+** An objected used to accumulate the text of a string where we+** do not necessarily know how big the string will be in the end.+*/+struct StrAccum {+ Btree *pBtree; /* Optional database for lookaside. Can be NULL */+ char *zBase; /* A base allocation. Not from malloc. */+ char *zText; /* The string collected so far */+ int nChar; /* Length of the string so far */+ int nAlloc; /* Amount of space allocated in zText */+ int mxAlloc; /* Maximum allowed allocation. 0 for no malloc usage */+ u8 accError; /* STRACCUM_NOMEM or STRACCUM_TOOBIG */+};+#define STRACCUM_NOMEM 1+#define STRACCUM_TOOBIG 2++/************** Include btreeInt.h in the middle of sqliteInt.h **************/+/************** Begin file btreeInt.h ****************************************/+/*+** 2004 April 6+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file implements an external (disk-based) database using BTrees.+** For a detailed discussion of BTrees, refer to+**+** Donald E. Knuth, THE ART OF COMPUTER PROGRAMMING, Volume 3:+** "Sorting And Searching", pages 473-480. Addison-Wesley+** Publishing Company, Reading, Massachusetts.+**+** The basic idea is that each page of the file contains N database+** entries and N+1 pointers to subpages.+**+** ----------------------------------------------------------------+** | Ptr(0) | Key(0) | Ptr(1) | Key(1) | ... | Key(N-1) | Ptr(N) |+** ----------------------------------------------------------------+**+** All of the keys on the page that Ptr(0) points to have values less+** than Key(0). All of the keys on page Ptr(1) and its subpages have+** values greater than Key(0) and less than Key(1). All of the keys+** on Ptr(N) and its subpages have values greater than Key(N-1). And+** so forth.+**+** Finding a particular key requires reading O(log(M)) pages from the +** disk where M is the number of entries in the tree.+**+** In this implementation, a single file can hold one or more separate +** BTrees. Each BTree is identified by the index of its root page. The+** key and data for any entry are combined to form the "payload". A+** fixed amount of payload can be carried directly on the database+** page. If the payload is larger than the preset amount then surplus+** bytes are stored on overflow pages. The payload for an entry+** and the preceding pointer are combined to form a "Cell". Each +** page has a small header which contains the Ptr(N) pointer and other+** information such as the size of key and data.+**+** FORMAT DETAILS+**+** The file is divided into pages. The first page is called page 1,+** the second is page 2, and so forth. A page number of zero indicates+** "no such page". The page size can be any power of 2 between 512 and 65536.+** Each page can be either a btree page, a freelist page, an overflow+** page, or a pointer-map page.+**+** The first page is always a btree page. The first 100 bytes of the first+** page contain a special header (the "file header") that describes the file.+** The format of the file header is as follows:+**+** OFFSET SIZE DESCRIPTION+** 0 16 Header string: "SQLite format 3\000"+** 16 2 Page size in bytes. (1 means 65536)+** 18 1 File format write version+** 19 1 File format read version+** 20 1 Bytes of unused space at the end of each page+** 21 1 Max embedded payload fraction (must be 64)+** 22 1 Min embedded payload fraction (must be 32)+** 23 1 Min leaf payload fraction (must be 32)+** 24 4 File change counter+** 28 4 Reserved for future use+** 32 4 First freelist page+** 36 4 Number of freelist pages in the file+** 40 60 15 4-byte meta values passed to higher layers+**+** 40 4 Schema cookie+** 44 4 File format of schema layer+** 48 4 Size of page cache+** 52 4 Largest root-page (auto/incr_vacuum)+** 56 4 1=UTF-8 2=UTF16le 3=UTF16be+** 60 4 User version+** 64 4 Incremental vacuum mode+** 68 4 Application-ID+** 72 20 unused+** 92 4 The version-valid-for number+** 96 4 SQLITE_VERSION_NUMBER+**+** All of the integer values are big-endian (most significant byte first).+**+** The file change counter is incremented when the database is changed+** This counter allows other processes to know when the file has changed+** and thus when they need to flush their cache.+**+** The max embedded payload fraction is the amount of the total usable+** space in a page that can be consumed by a single cell for standard+** B-tree (non-LEAFDATA) tables. A value of 255 means 100%. The default+** is to limit the maximum cell size so that at least 4 cells will fit+** on one page. Thus the default max embedded payload fraction is 64.+**+** If the payload for a cell is larger than the max payload, then extra+** payload is spilled to overflow pages. Once an overflow page is allocated,+** as many bytes as possible are moved into the overflow pages without letting+** the cell size drop below the min embedded payload fraction.+**+** The min leaf payload fraction is like the min embedded payload fraction+** except that it applies to leaf nodes in a LEAFDATA tree. The maximum+** payload fraction for a LEAFDATA tree is always 100% (or 255) and it+** not specified in the header.+**+** Each btree pages is divided into three sections: The header, the+** cell pointer array, and the cell content area. Page 1 also has a 100-byte+** file header that occurs before the page header.+**+** |----------------|+** | file header | 100 bytes. Page 1 only.+** |----------------|+** | page header | 8 bytes for leaves. 12 bytes for interior nodes+** |----------------|+** | cell pointer | | 2 bytes per cell. Sorted order.+** | array | | Grows downward+** | | v+** |----------------|+** | unallocated |+** | space |+** |----------------| ^ Grows upwards+** | cell content | | Arbitrary order interspersed with freeblocks.+** | area | | and free space fragments.+** |----------------|+**+** The page headers looks like this:+**+** OFFSET SIZE DESCRIPTION+** 0 1 Flags. 1: intkey, 2: zerodata, 4: leafdata, 8: leaf+** 1 2 byte offset to the first freeblock+** 3 2 number of cells on this page+** 5 2 first byte of the cell content area+** 7 1 number of fragmented free bytes+** 8 4 Right child (the Ptr(N) value). Omitted on leaves.+**+** The flags define the format of this btree page. The leaf flag means that+** this page has no children. The zerodata flag means that this page carries+** only keys and no data. The intkey flag means that the key is an integer+** which is stored in the key size entry of the cell header rather than in+** the payload area.+**+** The cell pointer array begins on the first byte after the page header.+** The cell pointer array contains zero or more 2-byte numbers which are+** offsets from the beginning of the page to the cell content in the cell+** content area. The cell pointers occur in sorted order. The system strives+** to keep free space after the last cell pointer so that new cells can+** be easily added without having to defragment the page.+**+** Cell content is stored at the very end of the page and grows toward the+** beginning of the page.+**+** Unused space within the cell content area is collected into a linked list of+** freeblocks. Each freeblock is at least 4 bytes in size. The byte offset+** to the first freeblock is given in the header. Freeblocks occur in+** increasing order. Because a freeblock must be at least 4 bytes in size,+** any group of 3 or fewer unused bytes in the cell content area cannot+** exist on the freeblock chain. A group of 3 or fewer free bytes is called+** a fragment. The total number of bytes in all fragments is recorded.+** in the page header at offset 7.+**+** SIZE DESCRIPTION+** 2 Byte offset of the next freeblock+** 2 Bytes in this freeblock+**+** Cells are of variable length. Cells are stored in the cell content area at+** the end of the page. Pointers to the cells are in the cell pointer array+** that immediately follows the page header. Cells is not necessarily+** contiguous or in order, but cell pointers are contiguous and in order.+**+** Cell content makes use of variable length integers. A variable+** length integer is 1 to 9 bytes where the lower 7 bits of each +** byte are used. The integer consists of all bytes that have bit 8 set and+** the first byte with bit 8 clear. The most significant byte of the integer+** appears first. A variable-length integer may not be more than 9 bytes long.+** As a special case, all 8 bytes of the 9th byte are used as data. This+** allows a 64-bit integer to be encoded in 9 bytes.+**+** 0x00 becomes 0x00000000+** 0x7f becomes 0x0000007f+** 0x81 0x00 becomes 0x00000080+** 0x82 0x00 becomes 0x00000100+** 0x80 0x7f becomes 0x0000007f+** 0x8a 0x91 0xd1 0xac 0x78 becomes 0x12345678+** 0x81 0x81 0x81 0x81 0x01 becomes 0x10204081+**+** Variable length integers are used for rowids and to hold the number of+** bytes of key and data in a btree cell.+**+** The content of a cell looks like this:+**+** SIZE DESCRIPTION+** 4 Page number of the left child. Omitted if leaf flag is set.+** var Number of bytes of data. Omitted if the zerodata flag is set.+** var Number of bytes of key. Or the key itself if intkey flag is set.+** * Payload+** 4 First page of the overflow chain. Omitted if no overflow+**+** Overflow pages form a linked list. Each page except the last is completely+** filled with data (pagesize - 4 bytes). The last page can have as little+** as 1 byte of data.+**+** SIZE DESCRIPTION+** 4 Page number of next overflow page+** * Data+**+** Freelist pages come in two subtypes: trunk pages and leaf pages. The+** file header points to the first in a linked list of trunk page. Each trunk+** page points to multiple leaf pages. The content of a leaf page is+** unspecified. A trunk page looks like this:+**+** SIZE DESCRIPTION+** 4 Page number of next trunk page+** 4 Number of leaf pointers on this page+** * zero or more pages numbers of leaves+*/+/* #include "sqliteInt.h" */+++/* The following value is the maximum cell size assuming a maximum page+** size give above.+*/+#define MX_CELL_SIZE(pBt) ((int)(pBt->pageSize-8))++/* The maximum number of cells on a single page of the database. This+** assumes a minimum cell size of 6 bytes (4 bytes for the cell itself+** plus 2 bytes for the index to the cell in the page header). Such+** small cells will be rare, but they are possible.+*/+#define MX_CELL(pBt) ((pBt->pageSize-8)/6)++/* Forward declarations */+typedef struct MemPage MemPage;+typedef struct BtLock BtLock;+typedef struct CellInfo CellInfo;++/*+** This is a magic string that appears at the beginning of every+** SQLite database in order to identify the file as a real database.+**+** You can change this value at compile-time by specifying a+** -DSQLITE_FILE_HEADER="..." on the compiler command-line. The+** header must be exactly 16 bytes including the zero-terminator so+** the string itself should be 15 characters long. If you change+** the header, then your custom library will not be able to read +** databases generated by the standard tools and the standard tools+** will not be able to read databases created by your custom library.+*/+#ifndef SQLITE_FILE_HEADER /* 123456789 123456 */+# define SQLITE_FILE_HEADER "SQLite Btree v3"+ +#endif++/*+** Page type flags. An ORed combination of these flags appear as the+** first byte of on-disk image of every BTree page.+*/+#define PTF_INTKEY 0x01+#define PTF_ZERODATA 0x02+#define PTF_LEAFDATA 0x04+#define PTF_LEAF 0x08++/*+** As each page of the file is loaded into memory, an instance of the following+** structure is appended and initialized to zero. This structure stores+** information about the page that is decoded from the raw file page.+**+** The pParent field points back to the parent page. This allows us to+** walk up the BTree from any leaf to the root. Care must be taken to+** unref() the parent page pointer when this page is no longer referenced.+** The pageDestructor() routine handles that chore.+**+** Access to all fields of this structure is controlled by the mutex+** stored in MemPage.pBt->mutex.+*/+struct MemPage {+ u8 isInit; /* True if previously initialized. MUST BE FIRST! */+ u8 nOverflow; /* Number of overflow cell bodies in aCell[] */+ u8 intKey; /* True if table b-trees. False for index b-trees */+ u8 intKeyLeaf; /* True if the leaf of an intKey table */+ u8 noPayload; /* True if internal intKey page (thus w/o data) */+ u8 leaf; /* True if a leaf page */+ u8 hdrOffset; /* 100 for page 1. 0 otherwise */+ u8 childPtrSize; /* 0 if leaf==1. 4 if leaf==0 */+ u8 max1bytePayload; /* min(maxLocal,127) */+ u8 bBusy; /* Prevent endless loops on corrupt database files */+ u16 maxLocal; /* Copy of BtShared.maxLocal or BtShared.maxLeaf */+ u16 minLocal; /* Copy of BtShared.minLocal or BtShared.minLeaf */+ u16 cellOffset; /* Index in aData of first cell pointer */+ u16 nFree; /* Number of free bytes on the page */+ u16 nCell; /* Number of cells on this page, local and ovfl */+ u16 maskPage; /* Mask for page offset */+ u16 aiOvfl[5]; /* Insert the i-th overflow cell before the aiOvfl-th+ ** non-overflow cell */+ u8 *apOvfl[5]; /* Pointers to the body of overflow cells */+ BtShared *pBt; /* Pointer to BtShared that this page is part of */+ u8 *aData; /* Pointer to disk image of the page data */+ u8 *aDataEnd; /* One byte past the end of usable data */+ u8 *aCellIdx; /* The cell index area */+ u8 *aDataOfst; /* Same as aData for leaves. aData+4 for interior */+ DbPage *pDbPage; /* Pager page handle */+ u16 (*xCellSize)(MemPage*,u8*); /* cellSizePtr method */+ void (*xParseCell)(MemPage*,u8*,CellInfo*); /* btreeParseCell method */+ Pgno pgno; /* Page number for this page */+};++/*+** The in-memory image of a disk page has the auxiliary information appended+** to the end. EXTRA_SIZE is the number of bytes of space needed to hold+** that extra information.+*/+#define EXTRA_SIZE sizeof(MemPage)++/*+** A linked list of the following structures is stored at BtShared.pLock.+** Locks are added (or upgraded from READ_LOCK to WRITE_LOCK) when a cursor +** is opened on the table with root page BtShared.iTable. Locks are removed+** from this list when a transaction is committed or rolled back, or when+** a btree handle is closed.+*/+struct BtLock {+ Btree *pBtree; /* Btree handle holding this lock */+ Pgno iTable; /* Root page of table */+ u8 eLock; /* READ_LOCK or WRITE_LOCK */+ BtLock *pNext; /* Next in BtShared.pLock list */+};++/* Candidate values for BtLock.eLock */+#define READ_LOCK 1+#define WRITE_LOCK 2++/* A Btree handle+**+** A database connection contains a pointer to an instance of+** this object for every database file that it has open. This structure+** is opaque to the database connection. The database connection cannot+** see the internals of this structure and only deals with pointers to+** this structure.+**+** For some database files, the same underlying database cache might be +** shared between multiple connections. In that case, each connection+** has it own instance of this object. But each instance of this object+** points to the same BtShared object. The database cache and the+** schema associated with the database file are all contained within+** the BtShared object.+**+** All fields in this structure are accessed under sqlite3.mutex.+** The pBt pointer itself may not be changed while there exists cursors +** in the referenced BtShared that point back to this Btree since those+** cursors have to go through this Btree to find their BtShared and+** they often do so without holding sqlite3.mutex.+*/+struct Btree {+ sqlite3_mutex *mutex; /* Connection mutex */+ int flags; /* Miscellaneous flags */+ i64 szMmap; /* Default mmap_size setting */+ u8 enc; /* Text encoding */+ u8 mallocFailed; /* True if we have seen a malloc failure */+ u32 magic; /* Magic number for detect library misuse */+ int nVdbeRead; /* Number of active VDBEs that read or write */+ BusyHandler busyHandler; /* Busy callback */+ int nSavepoint; /* Number of non-transaction savepoints */+ int *pnBytesFreed; /* If not NULL, increment this in DbFree() */+ BtShared *pBt; /* Sharable content of this btree */+ u8 inTrans; /* TRANS_NONE, TRANS_READ or TRANS_WRITE */+ u8 sharable; /* True if we can share pBt with another db */+ u8 locked; /* True if db currently has pBt locked */+ u8 hasIncrblobCur; /* True if there are one or more Incrblob cursors */+ int wantToLock; /* Number of nested calls to sqlite3BtreeEnter() */+ int nBackup; /* Number of backup operations reading this btree */+ u32 iDataVersion; /* Combines with pBt->pPager->iDataVersion */+ Btree *pNext; /* List of other sharable Btrees from the same db */+ Btree *pPrev; /* Back pointer of the same list */+#ifndef SQLITE_OMIT_SHARED_CACHE+ BtLock lock; /* Object used to lock page 1 */+#endif+};++/*+** Btree.inTrans may take one of the following values.+**+** If the shared-data extension is enabled, there may be multiple users+** of the Btree structure. At most one of these may open a write transaction,+** but any number may have active read transactions.+*/+#define TRANS_NONE 0+#define TRANS_READ 1+#define TRANS_WRITE 2++/*+** An instance of this object represents a single database file.+** +** A single database file can be in use at the same time by two+** or more database connections. When two or more connections are+** sharing the same database file, each connection has it own+** private Btree object for the file and each of those Btrees points+** to this one BtShared object. BtShared.nRef is the number of+** connections currently sharing this database file.+**+** Fields in this structure are accessed under the BtShared.mutex+** mutex, except for nRef and pNext which are accessed under the+** global SQLITE_MUTEX_STATIC_MASTER mutex. The pPager field+** may not be modified once it is initially set as long as nRef>0.+** The pSchema field may be set once under BtShared.mutex and+** thereafter is unchanged as long as nRef>0.+**+** isPending:+**+** If a BtShared client fails to obtain a write-lock on a database+** table (because there exists one or more read-locks on the table),+** the shared-cache enters 'pending-lock' state and isPending is+** set to true.+**+** The shared-cache leaves the 'pending lock' state when either of+** the following occur:+**+** 1) The current writer (BtShared.pWriter) concludes its transaction, OR+** 2) The number of locks held by other connections drops to zero.+**+** while in the 'pending-lock' state, no connection may start a new+** transaction.+**+** This feature is included to help prevent writer-starvation.+*/+struct BtShared {+ Pager *pPager; /* The page cache */+ Btree *pBt; /* Database connection currently using this Btree */+ BtCursor *pCursor; /* A list of all open cursors */+ MemPage *pPage1; /* First page of the database */+ u8 openFlags; /* Flags to sqlite3BtreeOpen() */+#ifndef SQLITE_OMIT_AUTOVACUUM+ u8 autoVacuum; /* True if auto-vacuum is enabled */+ u8 incrVacuum; /* True if incr-vacuum is enabled */+ u8 bDoTruncate; /* True to truncate db on commit */+#endif+ u8 inTransaction; /* Transaction state */+ u8 max1bytePayload; /* Maximum first byte of cell for a 1-byte payload */+#ifdef SQLITE_HAS_CODEC+ u8 optimalReserve; /* Desired amount of reserved space per page */+#endif+ u16 btsFlags; /* Boolean parameters. See BTS_* macros below */+ u16 maxLocal; /* Maximum local payload in non-LEAFDATA tables */+ u16 minLocal; /* Minimum local payload in non-LEAFDATA tables */+ u16 maxLeaf; /* Maximum local payload in a LEAFDATA table */+ u16 minLeaf; /* Minimum local payload in a LEAFDATA table */+ u32 pageSize; /* Total number of bytes on a page */+ u32 file_format; /* File Format */+ u32 usableSize; /* Number of usable bytes on each page */+ int nTransaction; /* Number of open transactions (read + write) */+ u32 nPage; /* Number of pages in the database */+ void *pSchema; /* Pointer to space allocated by sqlite3BtreeSchema() */+ void (*xFreeSchema)(void*); /* Destructor for BtShared.pSchema */+ sqlite3_mutex *mutex; /* Non-recursive mutex required to access this object */+ Bitvec *pHasContent; /* Set of pages moved to free-list this transaction */+#ifndef SQLITE_OMIT_SHARED_CACHE+ int nRef; /* Number of references to this structure */+ BtShared *pNext; /* Next on a list of sharable BtShared structs */+ BtLock *pLock; /* List of locks held on this shared-btree struct */+ Btree *pWriter; /* Btree with currently open write transaction */+#endif+ u8 *pTmpSpace; /* Temp space sufficient to hold a single cell */+};++/*+** Allowed values for BtShared.btsFlags+*/+#define BTS_READ_ONLY 0x0001 /* Underlying file is readonly */+#define BTS_PAGESIZE_FIXED 0x0002 /* Page size can no longer be changed */+#define BTS_SECURE_DELETE 0x0004 /* PRAGMA secure_delete is enabled */+#define BTS_INITIALLY_EMPTY 0x0008 /* Database was empty at trans start */+#define BTS_NO_WAL 0x0010 /* Do not open write-ahead-log files */+#define BTS_EXCLUSIVE 0x0020 /* pWriter has an exclusive lock */+#define BTS_PENDING 0x0040 /* Waiting for read-locks to clear */++/*+** An instance of the following structure is used to hold information+** about a cell. The parseCellPtr() function fills in this structure+** based on information extract from the raw disk page.+*/+struct CellInfo {+ i64 nKey; /* The key for INTKEY tables, or nPayload otherwise */+ u8 *pPayload; /* Pointer to the start of payload */+ u32 nPayload; /* Bytes of payload */+ u16 nLocal; /* Amount of payload held locally, not on overflow */+ u16 iOverflow; /* Offset to overflow page number. Zero if no overflow */+ u16 nSize; /* Size of the cell content on the main b-tree page */+};++/*+** Maximum depth of an SQLite B-Tree structure. Any B-Tree deeper than+** this will be declared corrupt. This value is calculated based on a+** maximum database size of 2^31 pages a minimum fanout of 2 for a+** root-node and 3 for all other internal nodes.+**+** If a tree that appears to be taller than this is encountered, it is+** assumed that the database is corrupt.+*/+#define BTCURSOR_MAX_DEPTH 20++/*+** A cursor is a pointer to a particular entry within a particular+** b-tree within a database file.+**+** The entry is identified by its MemPage and the index in+** MemPage.aCell[] of the entry.+**+** A single database file can be shared by two more database connections,+** but cursors cannot be shared. Each cursor is associated with a+** particular database connection identified BtCursor.pBtree.db.+**+** Fields in this structure are accessed under the BtShared.mutex+** found at self->pBt->mutex. +**+** skipNext meaning:+** eState==SKIPNEXT && skipNext>0: Next sqlite3BtreeNext() is no-op.+** eState==SKIPNEXT && skipNext<0: Next sqlite3BtreePrevious() is no-op.+** eState==FAULT: Cursor fault with skipNext as error code.+*/+struct BtCursor {+ Btree *pBtree; /* The Btree to which this cursor belongs */+ BtShared *pBt; /* The BtShared this cursor points to */+ BtCursor *pNext; /* Forms a linked list of all cursors */+ Pgno *aOverflow; /* Cache of overflow page locations */+ CellInfo info; /* A parse of the cell we are pointing at */+ i64 nKey; /* Size of pKey, or last integer key */+ void *pKey; /* Saved key that was cursor last known position */+ Pgno pgnoRoot; /* The root page of this tree */+ int nOvflAlloc; /* Allocated size of aOverflow[] array */+ int skipNext; /* Prev() is noop if negative. Next() is noop if positive.+ ** Error code if eState==CURSOR_FAULT */+ u8 curFlags; /* zero or more BTCF_* flags defined below */+ u8 curPagerFlags; /* Flags to send to sqlite3PagerAcquire() */+ u8 eState; /* One of the CURSOR_XXX constants (see below) */+ u8 hints; /* As configured by CursorSetHints() */+ i8 iPage; /* Index of current page in apPage */+ u8 curIntKey; /* Value of apPage[0]->intKey */+ struct KeyInfo *pKeyInfo; /* Argument passed to comparison function */+ void *padding1; /* Make object size a multiple of 16 */+ u16 aiIdx[BTCURSOR_MAX_DEPTH]; /* Current index in apPage[i] */+ MemPage *apPage[BTCURSOR_MAX_DEPTH]; /* Pages from root to current page */+};++/*+** Legal values for BtCursor.curFlags+*/+#define BTCF_WriteFlag 0x01 /* True if a write cursor */+#define BTCF_ValidNKey 0x02 /* True if info.nKey is valid */+#define BTCF_ValidOvfl 0x04 /* True if aOverflow is valid */+#define BTCF_AtLast 0x08 /* Cursor is pointing ot the last entry */+#define BTCF_Incrblob 0x10 /* True if an incremental I/O handle */+#define BTCF_Multiple 0x20 /* Maybe another cursor on the same btree */++/*+** Potential values for BtCursor.eState.+**+** CURSOR_INVALID:+** Cursor does not point to a valid entry. This can happen (for example) +** because the table is empty or because BtreeCursorFirst() has not been+** called.+**+** CURSOR_VALID:+** Cursor points to a valid entry. getPayload() etc. may be called.+**+** CURSOR_SKIPNEXT:+** Cursor is valid except that the Cursor.skipNext field is non-zero+** indicating that the next sqlite3BtreeNext() or sqlite3BtreePrevious()+** operation should be a no-op.+**+** CURSOR_REQUIRESEEK:+** The table that this cursor was opened on still exists, but has been +** modified since the cursor was last used. The cursor position is saved+** in variables BtCursor.pKey and BtCursor.nKey. When a cursor is in +** this state, restoreCursorPosition() can be called to attempt to+** seek the cursor to the saved position.+**+** CURSOR_FAULT:+** An unrecoverable error (an I/O error or a malloc failure) has occurred+** on a different connection that shares the BtShared cache with this+** cursor. The error has left the cache in an inconsistent state.+** Do nothing else with this cursor. Any attempt to use the cursor+** should return the error code stored in BtCursor.skipNext+*/+#define CURSOR_INVALID 0+#define CURSOR_VALID 1+#define CURSOR_SKIPNEXT 2+#define CURSOR_REQUIRESEEK 3+#define CURSOR_FAULT 4++/* +** The database page the PENDING_BYTE occupies. This page is never used.+*/+# define PENDING_BYTE_PAGE(pBt) PAGER_MJ_PGNO(pBt)++/*+** These macros define the location of the pointer-map entry for a +** database page. The first argument to each is the number of usable+** bytes on each page of the database (often 1024). The second is the+** page number to look up in the pointer map.+**+** PTRMAP_PAGENO returns the database page number of the pointer-map+** page that stores the required pointer. PTRMAP_PTROFFSET returns+** the offset of the requested map entry.+**+** If the pgno argument passed to PTRMAP_PAGENO is a pointer-map page,+** then pgno is returned. So (pgno==PTRMAP_PAGENO(pgsz, pgno)) can be+** used to test if pgno is a pointer-map page. PTRMAP_ISPAGE implements+** this test.+*/+#define PTRMAP_PAGENO(pBt, pgno) ptrmapPageno(pBt, pgno)+#define PTRMAP_PTROFFSET(pgptrmap, pgno) (5*(pgno-pgptrmap-1))+#define PTRMAP_ISPAGE(pBt, pgno) (PTRMAP_PAGENO((pBt),(pgno))==(pgno))++/*+** The pointer map is a lookup table that identifies the parent page for+** each child page in the database file. The parent page is the page that+** contains a pointer to the child. Every page in the database contains+** 0 or 1 parent pages. (In this context 'database page' refers+** to any page that is not part of the pointer map itself.) Each pointer map+** entry consists of a single byte 'type' and a 4 byte parent page number.+** The PTRMAP_XXX identifiers below are the valid types.+**+** The purpose of the pointer map is to facility moving pages from one+** position in the file to another as part of autovacuum. When a page+** is moved, the pointer in its parent must be updated to point to the+** new location. The pointer map is used to locate the parent page quickly.+**+** PTRMAP_ROOTPAGE: The database page is a root-page. The page-number is not+** used in this case.+**+** PTRMAP_FREEPAGE: The database page is an unused (free) page. The page-number +** is not used in this case.+**+** PTRMAP_OVERFLOW1: The database page is the first page in a list of +** overflow pages. The page number identifies the page that+** contains the cell with a pointer to this overflow page.+**+** PTRMAP_OVERFLOW2: The database page is the second or later page in a list of+** overflow pages. The page-number identifies the previous+** page in the overflow page list.+**+** PTRMAP_BTREE: The database page is a non-root btree page. The page number+** identifies the parent page in the btree.+*/+#define PTRMAP_ROOTPAGE 1+#define PTRMAP_FREEPAGE 2+#define PTRMAP_OVERFLOW1 3+#define PTRMAP_OVERFLOW2 4+#define PTRMAP_BTREE 5++/* A bunch of assert() statements to check the transaction state variables+** of handle p (type Btree*) are internally consistent.+*/+#define btreeIntegrity(p) \+ assert( p->pBt->inTransaction!=TRANS_NONE || p->pBt->nTransaction==0 ); \+ assert( p->pBt->inTransaction>=p->inTrans ); +++/*+** The ISAUTOVACUUM macro is used within balance_nonroot() to determine+** if the database supports auto-vacuum or not. Because it is used+** within an expression that is an argument to another macro +** (sqliteMallocRaw), it is not possible to use conditional compilation.+** So, this macro is defined instead.+*/+#ifndef SQLITE_OMIT_AUTOVACUUM+#define ISAUTOVACUUM (pBt->autoVacuum)+#else+#define ISAUTOVACUUM 0+#endif+++/*+** This structure is passed around through all the sanity checking routines+** in order to keep track of some global state information.+**+** The aRef[] array is allocated so that there is 1 bit for each page in+** the database. As the integrity-check proceeds, for each page used in+** the database the corresponding bit is set. This allows integrity-check to +** detect pages that are used twice and orphaned pages (both of which +** indicate corruption).+*/+typedef struct IntegrityCk IntegrityCk;+struct IntegrityCk {+ BtShared *pBt; /* The tree being checked out */+ Pager *pPager; /* The associated pager. Also accessible by pBt->pPager */+ u8 *aPgRef; /* 1 bit per page in the db (see above) */+ Pgno nPage; /* Number of pages in the database */+ int mxErr; /* Stop accumulating errors when this reaches zero */+ int nErr; /* Number of messages written to zErrMsg so far */+ int mallocFailed; /* A memory allocation error has occurred */+ const char *zPfx; /* Error message prefix */+ int v1, v2; /* Values for up to two %d fields in zPfx */+ StrAccum errMsg; /* Accumulate the error message text here */+ u32 *heap; /* Min-heap used for analyzing cell coverage */+};++/*+** Routines to read or write a two- and four-byte big-endian integer values.+*/+#define get2byte(x) ((x)[0]<<8 | (x)[1])+#define put2byte(p,v) ((p)[0] = (u8)((v)>>8), (p)[1] = (u8)(v))+#define get4byte sqlite3Get4byte+#define put4byte sqlite3Put4byte++/*+** get2byteAligned(), unlike get2byte(), requires that its argument point to a+** two-byte aligned address. get2bytea() is only used for accessing the+** cell addresses in a btree header.+*/+#if SQLITE_BYTEORDER==4321+# define get2byteAligned(x) (*(u16*)(x))+#elif SQLITE_BYTEORDER==1234 && !defined(SQLITE_DISABLE_INTRINSIC) \+ && GCC_VERSION>=4008000+# define get2byteAligned(x) __builtin_bswap16(*(u16*)(x))+#elif SQLITE_BYTEORDER==1234 && !defined(SQLITE_DISABLE_INTRINSIC) \+ && defined(_MSC_VER) && _MSC_VER>=1300+# define get2byteAligned(x) _byteswap_ushort(*(u16*)(x))+#else+# define get2byteAligned(x) ((x)[0]<<8 | (x)[1])+#endif++#ifndef SQLITE_OMIT_INCRBLOB+SQLITE_PRIVATE int sqlite3VdbeMemExpandBlob(Mem *);+ #define ExpandBlob(P) (((P)->flags&MEM_Zero)?sqlite3VdbeMemExpandBlob(P):0)+#else+ #define sqlite3VdbeMemExpandBlob(x) SQLITE_OK+ #define ExpandBlob(P) SQLITE_OK+#endif++SQLITE_PRIVATE int sqlite3HeaderSizeBtree(void);++SQLITE_PRIVATE void sqlite3VdbeRecordUnpack(KeyInfo*,int,const void*,UnpackedRecord*);+SQLITE_PRIVATE UnpackedRecord *sqlite3VdbeAllocUnpackedRecord(KeyInfo *, char *, int, char **);++typedef int (*RecordCompare)(int,const void*,UnpackedRecord*);+SQLITE_PRIVATE RecordCompare sqlite3VdbeFindCompare(UnpackedRecord*);++/************** End of btreeInt.h ********************************************/+/************** Continuing where we left off in sqliteInt.h ******************/++/*+** Structure containing global configuration data for the SQLite library.+**+** This structure also contains some state information.+*/+struct Sqlite3Config {+ int bMemstat; /* True to enable memory status */+ int bCoreMutex; /* True to enable core mutexing */+ int bFullMutex; /* True to enable full mutexing */+ int bOpenUri; /* True to interpret filenames as URIs */+ int bUseCis; /* Use covering indices for full-scans */+ int mxStrlen; /* Maximum string length */+ int neverCorrupt; /* Database is always well-formed */+ int szLookaside; /* Default lookaside buffer size */+ int nLookaside; /* Default lookaside buffer count */+ sqlite3_mem_methods m; /* Low-level memory allocation interface */+ sqlite3_mutex_methods mutex; /* Low-level mutex interface */+ sqlite3_pcache_methods2 pcache2; /* Low-level page-cache interface */+ void *pHeap; /* Heap storage space */+ int nHeap; /* Size of pHeap[] */+ int mnReq, mxReq; /* Min and max heap requests sizes */+ sqlite3_int64 szMmap; /* mmap() space per open file */+ sqlite3_int64 mxMmap; /* Maximum value for szMmap */+ void *pScratch; /* Scratch memory */+ int szScratch; /* Size of each scratch buffer */+ int nScratch; /* Number of scratch buffers */+ void *pPage; /* Page cache memory */+ int szPage; /* Size of each page in pPage[] */+ int nPage; /* Number of pages in pPage[] */+ int mxParserStack; /* maximum depth of the parser stack */+ int sharedCacheEnabled; /* true if shared-cache mode enabled */+ u32 szPma; /* Maximum Sorter PMA size */+ /* The above might be initialized to non-zero. The following need to always+ ** initially be zero, however. */+ int isInit; /* True after initialization has finished */+ int inProgress; /* True while initialization in progress */+ int isMutexInit; /* True after mutexes are initialized */+ int isMallocInit; /* True after malloc is initialized */+ int isPCacheInit; /* True after malloc is initialized */+ int nRefInitMutex; /* Number of users of pInitMutex */+ sqlite3_mutex *pInitMutex; /* Mutex used by sqlite3BtreeInitialize() */+ void (*xLog)(void*,int,const char*); /* Function for logging */+ void *pLogArg; /* First argument to xLog() */+#ifdef SQLITE_VDBE_COVERAGE+ /* The following callback (if not NULL) is invoked on every VDBE branch+ ** operation. Set the callback using SQLITE_TESTCTRL_VDBE_COVERAGE.+ */+ void (*xVdbeBranch)(void*,int iSrcLine,u8 eThis,u8 eMx); /* Callback */+ void *pVdbeBranchArg; /* 1st argument */+#endif+ int bLocaltimeFault; /* True to fail localtime() calls */+};++#ifndef SQLITE_AMALGAMATION+SQLITE_PRIVATE SQLITE_WSD struct Sqlite3Config sqlite3Config;+#ifndef SQLITE_OMIT_WSD+SQLITE_PRIVATE int sqlite3PendingByte;+#endif+#endif++#if (defined(i386) || defined(__i386__) || defined(_M_IX86) || \+ defined(__x86_64) || defined(__x86_64__) || defined(_M_X64) || \+ defined(_M_AMD64) || defined(_M_ARM) || defined(__x86) || \+ defined(__arm__)) && !defined(SQLITE_RUNTIME_BYTEORDER)+# define SQLITE_BYTEORDER 1234+# define SQLITE_BIGENDIAN 0+# define SQLITE_LITTLEENDIAN 1+# define SQLITE_UTF16NATIVE SQLITE_UTF16LE+#endif+#if (defined(sparc) || defined(__ppc__)) \+ && !defined(SQLITE_RUNTIME_BYTEORDER)+# define SQLITE_BYTEORDER 4321+# define SQLITE_BIGENDIAN 1+# define SQLITE_LITTLEENDIAN 0+# define SQLITE_UTF16NATIVE SQLITE_UTF16BE+#endif+#if !defined(SQLITE_BYTEORDER)+const int sqlite3one = 1;+# define SQLITE_BYTEORDER 0 /* 0 means "unknown at compile-time" */+# define SQLITE_BIGENDIAN (*(char *)(&sqlite3one)==0)+# define SQLITE_LITTLEENDIAN (*(char *)(&sqlite3one)==1)+# define SQLITE_UTF16NATIVE (SQLITE_BIGENDIAN?SQLITE_UTF16BE:SQLITE_UTF16LE)+#endif++#ifdef SQLITE_ENABLE_ATOMIC_WRITE+SQLITE_PRIVATE int sqlite3JournalOpen(sqlite3_vfs *, const char *, sqlite3_file *, int, int);+SQLITE_PRIVATE int sqlite3JournalSize(sqlite3_vfs *);+SQLITE_PRIVATE int sqlite3JournalCreate(sqlite3_file *);+SQLITE_PRIVATE int sqlite3JournalExists(sqlite3_file *p);+#else+ #define sqlite3JournalSize(pVfs) ((pVfs)->szOsFile)+ #define sqlite3JournalExists(p) 1+#endif++SQLITE_PRIVATE void sqlite3MemJournalOpen(sqlite3_file *);+SQLITE_PRIVATE int sqlite3MemJournalSize(void);+SQLITE_PRIVATE int sqlite3IsMemJournal(sqlite3_file *);++#ifdef SQLITE_ENABLE_UNLOCK_NOTIFY+SQLITE_PRIVATE void sqlite3ConnectionBlocked(Btree*, Btree*);+SQLITE_PRIVATE void sqlite3ConnectionUnlocked(Btree *db);+SQLITE_PRIVATE void sqlite3ConnectionClosed(Btree *db);+#else+ #define sqlite3ConnectionBlocked(x,y)+ #define sqlite3ConnectionUnlocked(x)+ #define sqlite3ConnectionClosed(x)+#endif++/*+** If the SQLITE_ENABLE IOTRACE exists then the global variable+** sqlite3IoTrace is a pointer to a printf-like routine used to+** print I/O tracing messages. +*/+#ifdef SQLITE_ENABLE_IOTRACE+# define IOTRACE(A) if( sqlite3IoTrace ){ sqlite3IoTrace A; }+SQLITE_PRIVATE void sqlite3VdbeIOTraceSql(Vdbe*);+SQLITE_API SQLITE_EXTERN void (SQLITE_CDECL *sqlite3IoTrace)(const char*,...);+#else+# define IOTRACE(A)+# define sqlite3VdbeIOTraceSql(X)+#endif++SQLITE_PRIVATE Bitvec *sqlite3BitvecCreate(u32);+SQLITE_PRIVATE int sqlite3BitvecTest(Bitvec*, u32);+SQLITE_PRIVATE int sqlite3BitvecTestNotNull(Bitvec*, u32);+SQLITE_PRIVATE int sqlite3BitvecSet(Bitvec*, u32);+SQLITE_PRIVATE void sqlite3BitvecClear(Bitvec*, u32, void*);+SQLITE_PRIVATE void sqlite3BitvecDestroy(Bitvec*);+SQLITE_PRIVATE u32 sqlite3BitvecSize(Bitvec*);++SQLITE_PRIVATE const void *sqlite3ValueText(Mem*, u8);++/*+** These routines are available for the mem2.c debugging memory allocator+** only. They are used to verify that different "types" of memory+** allocations are properly tracked by the system.+**+** sqlite3MemdebugSetType() sets the "type" of an allocation to one of+** the MEMTYPE_* macros defined below. The type must be a bitmask with+** a single bit set.+**+** sqlite3MemdebugHasType() returns true if any of the bits in its second+** argument match the type set by the previous sqlite3MemdebugSetType().+** sqlite3MemdebugHasType() is intended for use inside assert() statements.+**+** sqlite3MemdebugNoType() returns true if none of the bits in its second+** argument match the type set by the previous sqlite3MemdebugSetType().+**+** Perhaps the most important point is the difference between MEMTYPE_HEAP+** and MEMTYPE_LOOKASIDE. If an allocation is MEMTYPE_LOOKASIDE, that means+** it might have been allocated by lookaside, except the allocation was+** too large or lookaside was already full. It is important to verify+** that allocations that might have been satisfied by lookaside are not+** passed back to non-lookaside free() routines. Asserts such as the+** example above are placed on the non-lookaside free() routines to verify+** this constraint. +**+** All of this is no-op for a production build. It only comes into+** play when the SQLITE_MEMDEBUG compile-time option is used.+*/+#ifdef SQLITE_MEMDEBUG+SQLITE_PRIVATE void sqlite3MemdebugSetType(void*,u8);+SQLITE_PRIVATE int sqlite3MemdebugHasType(void*,u8);+SQLITE_PRIVATE int sqlite3MemdebugNoType(void*,u8);+#else+# define sqlite3MemdebugSetType(X,Y) /* no-op */+# define sqlite3MemdebugHasType(X,Y) 1+# define sqlite3MemdebugNoType(X,Y) 1+#endif+#define MEMTYPE_HEAP 0x01 /* General heap allocations */+#define MEMTYPE_LOOKASIDE 0x02 /* Heap that might have been lookaside */+#define MEMTYPE_SCRATCH 0x04 /* Scratch allocations */+#define MEMTYPE_PCACHE 0x08 /* Page cache allocations */+++SQLITE_PRIVATE i64 sqlite3VdbeIntValue(Mem*);+SQLITE_PRIVATE double sqlite3VdbeRealValue(Mem*);++SQLITE_PRIVATE int sqlite3VdbeRecordCompareWithSkip(int, const void *, UnpackedRecord *, int);++#endif /* _SQLITEINT_H_ */++/************** End of sqliteInt.h *******************************************/+/************** Begin file global.c ******************************************/+/*+** 2008 June 13+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file contains definitions of global variables and constants.+*/+/* #include "sqliteInt.h" */++/* An array to map all upper-case characters into their corresponding+** lower-case character. +**+** SQLite only considers US-ASCII (or EBCDIC) characters. We do not+** handle case conversions for the UTF character set since the tables+** involved are nearly as big or bigger than SQLite itself.+*/+const unsigned char sqlite3UpperToLower[] = {+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,+ 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,+ 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53,+ 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 97, 98, 99,100,101,102,103,+ 104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,+ 122, 91, 92, 93, 94, 95, 96, 97, 98, 99,100,101,102,103,104,105,106,107,+ 108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,+ 126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,+ 144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,+ 162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,+ 180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,+ 198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,+ 216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,+ 234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,+ 252,253,254,255+};+/* EVIDENCE-OF: R-02982-34736 In order to maintain full backwards+** compatibility for legacy applications, the URI filename capability is+** disabled by default.+**+** EVIDENCE-OF: R-38799-08373 URI filenames can be enabled or disabled+** using the SQLITE_USE_URI=1 or SQLITE_USE_URI=0 compile-time options.+**+** EVIDENCE-OF: R-43642-56306 By default, URI handling is globally+** disabled. The default value may be changed by compiling with the+** SQLITE_USE_URI symbol defined.+*/+#ifndef SQLITE_USE_URI+# define SQLITE_USE_URI 0+#endif++/* EVIDENCE-OF: R-38720-18127 The default setting is determined by the+** SQLITE_ALLOW_COVERING_INDEX_SCAN compile-time option, or is "on" if+** that compile-time option is omitted.+*/+#ifndef SQLITE_ALLOW_COVERING_INDEX_SCAN+# define SQLITE_ALLOW_COVERING_INDEX_SCAN 1+#endif++/* The minimum PMA size is set to this value multiplied by the database+** page size in bytes.+*/+#ifndef SQLITE_SORTER_PMASZ+# define SQLITE_SORTER_PMASZ 250+#endif++/*+** The following singleton contains the global configuration for+** the SQLite library.+*/+SQLITE_PRIVATE SQLITE_WSD struct Sqlite3Config sqlite3Config = {+ SQLITE_DEFAULT_MEMSTATUS, /* bMemstat */+ 1, /* bCoreMutex */+ SQLITE_THREADSAFE==1, /* bFullMutex */+ SQLITE_USE_URI, /* bOpenUri */+ SQLITE_ALLOW_COVERING_INDEX_SCAN, /* bUseCis */+ 0x7ffffffe, /* mxStrlen */+ 0, /* neverCorrupt */+ 128, /* szLookaside */+ 500, /* nLookaside */+ {0,0,0,0,0,0,0,0}, /* m */+ {0,0,0,0,0,0,0,0,0}, /* mutex */+ {0,0,0,0,0,0,0,0,0,0,0,0,0},/* pcache2 */+ (void*)0, /* pHeap */+ 0, /* nHeap */+ 0, 0, /* mnHeap, mxHeap */+ SQLITE_DEFAULT_MMAP_SIZE, /* szMmap */+ SQLITE_MAX_MMAP_SIZE, /* mxMmap */+ (void*)0, /* pScratch */+ 0, /* szScratch */+ 0, /* nScratch */+ (void*)0, /* pPage */+ 0, /* szPage */+ SQLITE_DEFAULT_PCACHE_INITSZ, /* nPage */+ 0, /* mxParserStack */+ 0, /* sharedCacheEnabled */+ SQLITE_SORTER_PMASZ, /* szPma */+ /* All the rest should always be initialized to zero */+ 0, /* isInit */+ 0, /* inProgress */+ 0, /* isMutexInit */+ 0, /* isMallocInit */+ 0, /* isPCacheInit */+ 0, /* nRefInitMutex */+ 0, /* pInitMutex */+ 0, /* xLog */+ 0, /* pLogArg */+#ifdef SQLITE_VDBE_COVERAGE+ 0, /* xVdbeBranch */+ 0, /* pVbeBranchArg */+#endif+ 0 /* bLocaltimeFault */+};++/*+** The value of the "pending" byte must be 0x40000000 (1 byte past the+** 1-gibabyte boundary) in a compatible database. SQLite never uses+** the database page that contains the pending byte. It never attempts+** to read or write that page. The pending byte page is set assign+** for use by the VFS layers as space for managing file locks.+**+** During testing, it is often desirable to move the pending byte to+** a different position in the file. This allows code that has to+** deal with the pending byte to run on files that are much smaller+** than 1 GiB. The sqlite3_test_control() interface can be used to+** move the pending byte.+**+** IMPORTANT: Changing the pending byte to any value other than+** 0x40000000 results in an incompatible database file format!+** Changing the pending byte during operation will result in undefined+** and incorrect behavior.+*/+#ifndef SQLITE_OMIT_WSD+SQLITE_PRIVATE int sqlite3PendingByte = 0x40000000;+#endif++/************** End of global.c **********************************************/+/************** Begin file status.c ******************************************/+/*+** 2008 June 18+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This module implements the sqlite3_status() interface and related+** functionality.+*/+/* #include "sqliteInt.h" */++/*+** Variables in which to record status information.+*/+typedef struct sqlite3StatType sqlite3StatType;+static SQLITE_WSD struct sqlite3StatType {+#if SQLITE_PTRSIZE>4+ sqlite3_int64 nowValue[10]; /* Current value */+ sqlite3_int64 mxValue[10]; /* Maximum value */+#else+ u32 nowValue[10]; /* Current value */+ u32 mxValue[10]; /* Maximum value */+#endif+} sqlite3Stat = { {0,}, {0,} };++#ifndef NDEBUG+/*+** Elements of sqlite3Stat[] are protected by either the memory allocator+** mutex, or by the pcache1 mutex. The following array determines which.+*/+static const char statMutex[] = {+ 0, /* SQLITE_STATUS_MEMORY_USED */+ 1, /* SQLITE_STATUS_PAGECACHE_USED */+ 1, /* SQLITE_STATUS_PAGECACHE_OVERFLOW */+ 0, /* SQLITE_STATUS_SCRATCH_USED */+ 0, /* SQLITE_STATUS_SCRATCH_OVERFLOW */+ 0, /* SQLITE_STATUS_MALLOC_SIZE */+ 0, /* SQLITE_STATUS_PARSER_STACK */+ 1, /* SQLITE_STATUS_PAGECACHE_SIZE */+ 0, /* SQLITE_STATUS_SCRATCH_SIZE */+ 0, /* SQLITE_STATUS_MALLOC_COUNT */+};+#endif++/* The "wsdStat" macro will resolve to the status information+** state vector. If writable static data is unsupported on the target,+** we have to locate the state vector at run-time. In the more common+** case where writable static data is supported, wsdStat can refer directly+** to the "sqlite3Stat" state vector declared above.+*/+#ifdef SQLITE_OMIT_WSD+# define wsdStatInit sqlite3StatType *x = &GLOBAL(sqlite3StatType,sqlite3Stat)+# define wsdStat x[0]+#else+# define wsdStatInit+# define wsdStat sqlite3Stat+#endif++/*+** Return the current value of a status parameter. The caller must+** be holding the appropriate mutex.+*/+SQLITE_PRIVATE sqlite3_int64 sqlite3StatusValue(int op){+ wsdStatInit;+ assert( op>=0 && op<ArraySize(wsdStat.nowValue) );+ assert( op>=0 && op<ArraySize(statMutex) );+ assert( sqlite3_mutex_held(statMutex[op] ? sqlite3Pcache1Mutex()+ : sqlite3MallocMutex()) );+ return wsdStat.nowValue[op];+}+++/*+** Add N to the value of a status record. The caller must hold the+** appropriate mutex. (Locking is checked by assert()).+**+** The StatusUp() routine can accept positive or negative values for N.+** The value of N is added to the current status value and the high-water+** mark is adjusted if necessary.+**+** The StatusDown() routine lowers the current value by N. The highwater+** mark is unchanged. N must be non-negative for StatusDown().+*/+SQLITE_PRIVATE void sqlite3StatusUp(int op, int N){+ wsdStatInit;+ assert( op>=0 && op<ArraySize(wsdStat.nowValue) );+ assert( op>=0 && op<ArraySize(statMutex) );+ assert( sqlite3_mutex_held(statMutex[op] ? sqlite3Pcache1Mutex()+ : sqlite3MallocMutex()) );+ wsdStat.nowValue[op] += N;+ if( wsdStat.nowValue[op]>wsdStat.mxValue[op] ){+ wsdStat.mxValue[op] = wsdStat.nowValue[op];+ }+}+SQLITE_PRIVATE void sqlite3StatusDown(int op, int N){+ wsdStatInit;+ assert( N>=0 );+ assert( op>=0 && op<ArraySize(statMutex) );+ assert( sqlite3_mutex_held(statMutex[op] ? sqlite3Pcache1Mutex()+ : sqlite3MallocMutex()) );+ assert( op>=0 && op<ArraySize(wsdStat.nowValue) );+ wsdStat.nowValue[op] -= N;+}++/*+** Set the value of a status to X. The highwater mark is adjusted if+** necessary. The caller must hold the appropriate mutex.+*/+SQLITE_PRIVATE void sqlite3StatusSet(int op, int X){+ wsdStatInit;+ assert( op>=0 && op<ArraySize(wsdStat.nowValue) );+ assert( op>=0 && op<ArraySize(statMutex) );+ assert( sqlite3_mutex_held(statMutex[op] ? sqlite3Pcache1Mutex()+ : sqlite3MallocMutex()) );+ wsdStat.nowValue[op] = X;+ if( wsdStat.nowValue[op]>wsdStat.mxValue[op] ){+ wsdStat.mxValue[op] = wsdStat.nowValue[op];+ }+}++/************** End of status.c **********************************************/+/************** Begin file os.c **********************************************/+/*+** 2005 November 29+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains OS interface code that is common to all+** architectures.+*/+#define _SQLITE_OS_C_ 1+/* #include "sqliteInt.h" */+#undef _SQLITE_OS_C_++/*+** The default SQLite sqlite3_vfs implementations do not allocate+** memory (actually, os_unix.c allocates a small amount of memory+** from within OsOpen()), but some third-party implementations may.+** So we test the effects of a malloc() failing and the sqlite3OsXXX()+** function returning SQLITE_IOERR_NOMEM using the DO_OS_MALLOC_TEST macro.+**+** The following functions are instrumented for malloc() failure +** testing:+**+** sqlite3OsRead()+** sqlite3OsWrite()+** sqlite3OsSync()+** sqlite3OsFileSize()+** sqlite3OsLock()+** sqlite3OsCheckReservedLock()+** sqlite3OsFileControl()+** sqlite3OsShmMap()+** sqlite3OsOpen()+** sqlite3OsDelete()+** sqlite3OsAccess()+** sqlite3OsFullPathname()+**+*/+#if defined(SQLITE_TEST)+SQLITE_PRIVATE int sqlite3_memdebug_vfs_oom_test = 1;+ #define DO_OS_MALLOC_TEST(x) \+ if (sqlite3_memdebug_vfs_oom_test && (!x || !sqlite3IsMemJournal(x))) { \+ void *pTstAlloc = sqlite3Malloc(10); \+ if (!pTstAlloc) return SQLITE_IOERR_NOMEM; \+ sqlite3_free(pTstAlloc); \+ }+#else+ #define DO_OS_MALLOC_TEST(x)+#endif++/*+** The following routines are convenience wrappers around methods+** of the sqlite3_file object. This is mostly just syntactic sugar. All+** of this would be completely automatic if SQLite were coded using+** C++ instead of plain old C.+*/+SQLITE_PRIVATE int sqlite3OsClose(sqlite3_file *pId){+ int rc = SQLITE_OK;+ if( pId->pMethods ){+ rc = pId->pMethods->xClose(pId);+ pId->pMethods = 0;+ }+ return rc;+}+SQLITE_PRIVATE int sqlite3OsRead(sqlite3_file *id, void *pBuf, int amt, i64 offset){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xRead(id, pBuf, amt, offset);+}+SQLITE_PRIVATE int sqlite3OsWrite(sqlite3_file *id, const void *pBuf, int amt, i64 offset){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xWrite(id, pBuf, amt, offset);+}+SQLITE_PRIVATE int sqlite3OsTruncate(sqlite3_file *id, i64 size){+ return id->pMethods->xTruncate(id, size);+}+SQLITE_PRIVATE int sqlite3OsSync(sqlite3_file *id, int flags){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xSync(id, flags);+}+SQLITE_PRIVATE int sqlite3OsFileSize(sqlite3_file *id, i64 *pSize){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xFileSize(id, pSize);+}+SQLITE_PRIVATE int sqlite3OsLock(sqlite3_file *id, int lockType){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xLock(id, lockType);+}+SQLITE_PRIVATE int sqlite3OsUnlock(sqlite3_file *id, int lockType){+ return id->pMethods->xUnlock(id, lockType);+}+SQLITE_PRIVATE int sqlite3OsCheckReservedLock(sqlite3_file *id, int *pResOut){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xCheckReservedLock(id, pResOut);+}++/*+** Use sqlite3OsFileControl() when we are doing something that might fail+** and we need to know about the failures. Use sqlite3OsFileControlHint()+** when simply tossing information over the wall to the VFS and we do not+** really care if the VFS receives and understands the information since it+** is only a hint and can be safely ignored. The sqlite3OsFileControlHint()+** routine has no return value since the return value would be meaningless.+*/+SQLITE_PRIVATE int sqlite3OsFileControl(sqlite3_file *id, int op, void *pArg){+#ifdef SQLITE_TEST+ if( op!=SQLITE_FCNTL_COMMIT_PHASETWO ){+ /* Faults are not injected into COMMIT_PHASETWO because, assuming SQLite+ ** is using a regular VFS, it is called after the corresponding + ** transaction has been committed. Injecting a fault at this point + ** confuses the test scripts - the COMMIT comand returns SQLITE_NOMEM+ ** but the transaction is committed anyway.+ **+ ** The core must call OsFileControl() though, not OsFileControlHint(),+ ** as if a custom VFS (e.g. zipvfs) returns an error here, it probably+ ** means the commit really has failed and an error should be returned+ ** to the user. */+ DO_OS_MALLOC_TEST(id);+ }+#endif+ return id->pMethods->xFileControl(id, op, pArg);+}+SQLITE_PRIVATE void sqlite3OsFileControlHint(sqlite3_file *id, int op, void *pArg){+ (void)id->pMethods->xFileControl(id, op, pArg);+}++SQLITE_PRIVATE int sqlite3OsSectorSize(sqlite3_file *id){+ int (*xSectorSize)(sqlite3_file*) = id->pMethods->xSectorSize;+ return (xSectorSize ? xSectorSize(id) : SQLITE_DEFAULT_SECTOR_SIZE);+}+SQLITE_PRIVATE int sqlite3OsDeviceCharacteristics(sqlite3_file *id){+ return id->pMethods->xDeviceCharacteristics(id);+}+SQLITE_PRIVATE int sqlite3OsShmLock(sqlite3_file *id, int offset, int n, int flags){+ return id->pMethods->xShmLock(id, offset, n, flags);+}+SQLITE_PRIVATE void sqlite3OsShmBarrier(sqlite3_file *id){+ id->pMethods->xShmBarrier(id);+}+SQLITE_PRIVATE int sqlite3OsShmUnmap(sqlite3_file *id, int deleteFlag){+ return id->pMethods->xShmUnmap(id, deleteFlag);+}+SQLITE_PRIVATE int sqlite3OsShmMap(+ sqlite3_file *id, /* Database file handle */+ int iPage,+ int pgsz,+ int bExtend, /* True to extend file if necessary */+ void volatile **pp /* OUT: Pointer to mapping */+){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xShmMap(id, iPage, pgsz, bExtend, pp);+}++#if SQLITE_MAX_MMAP_SIZE>0+/* The real implementation of xFetch and xUnfetch */+SQLITE_PRIVATE int sqlite3OsFetch(sqlite3_file *id, i64 iOff, int iAmt, void **pp){+ DO_OS_MALLOC_TEST(id);+ return id->pMethods->xFetch(id, iOff, iAmt, pp);+}+SQLITE_PRIVATE int sqlite3OsUnfetch(sqlite3_file *id, i64 iOff, void *p){+ return id->pMethods->xUnfetch(id, iOff, p);+}+#else+/* No-op stubs to use when memory-mapped I/O is disabled */+SQLITE_PRIVATE int sqlite3OsFetch(sqlite3_file *id, i64 iOff, int iAmt, void **pp){+ *pp = 0;+ return SQLITE_OK;+}+SQLITE_PRIVATE int sqlite3OsUnfetch(sqlite3_file *id, i64 iOff, void *p){+ return SQLITE_OK;+}+#endif++/*+** The next group of routines are convenience wrappers around the+** VFS methods.+*/+SQLITE_PRIVATE int sqlite3OsOpen(+ sqlite3_vfs *pVfs, + const char *zPath, + sqlite3_file *pFile, + int flags, + int *pFlagsOut+){+ int rc;+ DO_OS_MALLOC_TEST(0);+ /* 0x87f7f is a mask of SQLITE_OPEN_ flags that are valid to be passed+ ** down into the VFS layer. Some SQLITE_OPEN_ flags (for example,+ ** SQLITE_OPEN_FULLMUTEX or SQLITE_OPEN_SHAREDCACHE) are blocked before+ ** reaching the VFS. */+ rc = pVfs->xOpen(pVfs, zPath, pFile, flags & 0x87f7f, pFlagsOut);+ assert( rc==SQLITE_OK || pFile->pMethods==0 );+ return rc;+}+SQLITE_PRIVATE int sqlite3OsDelete(sqlite3_vfs *pVfs, const char *zPath, int dirSync){+ DO_OS_MALLOC_TEST(0);+ assert( dirSync==0 || dirSync==1 );+ return pVfs->xDelete(pVfs, zPath, dirSync);+}+SQLITE_PRIVATE int sqlite3OsAccess(+ sqlite3_vfs *pVfs, + const char *zPath, + int flags, + int *pResOut+){+ DO_OS_MALLOC_TEST(0);+ return pVfs->xAccess(pVfs, zPath, flags, pResOut);+}+SQLITE_PRIVATE int sqlite3OsFullPathname(+ sqlite3_vfs *pVfs, + const char *zPath, + int nPathOut, + char *zPathOut+){+ DO_OS_MALLOC_TEST(0);+ zPathOut[0] = 0;+ return pVfs->xFullPathname(pVfs, zPath, nPathOut, zPathOut);+}+SQLITE_PRIVATE int sqlite3OsRandomness(sqlite3_vfs *pVfs, int nByte, char *zBufOut){+ return pVfs->xRandomness(pVfs, nByte, zBufOut);+}+SQLITE_PRIVATE int sqlite3OsSleep(sqlite3_vfs *pVfs, int nMicro){+ return pVfs->xSleep(pVfs, nMicro);+}++/*+** This function is a wrapper around the OS specific implementation of+** sqlite3_os_init(). The purpose of the wrapper is to provide the+** ability to simulate a malloc failure, so that the handling of an+** error in sqlite3_os_init() by the upper layers can be tested.+*/+SQLITE_PRIVATE int sqlite3OsInit(void){+ void *p = sqlite3_malloc(10);+ if( p==0 ) return SQLITE_NOMEM;+ sqlite3_free(p);+ return sqlite3_os_init();+}++/*+** The list of all registered VFS implementations.+*/+static sqlite3_vfs * SQLITE_WSD vfsList = 0;+#define vfsList GLOBAL(sqlite3_vfs *, vfsList)++/*+** Locate a VFS by name. If no name is given, simply return the+** first VFS on the list.+*/+SQLITE_PRIVATE sqlite3_vfs *sqlite3_vfs_find(const char *zVfs){+ sqlite3_vfs *pVfs = 0;+#if SQLITE_THREADSAFE+ sqlite3_mutex *mutex;+#endif+#ifndef SQLITE_OMIT_AUTOINIT+ int rc = sqlite3BtreeInitialize();+ if( rc ) return 0;+#endif+#if SQLITE_THREADSAFE+ mutex = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MASTER);+#endif+ sqlite3_mutex_enter(mutex);+ for(pVfs = vfsList; pVfs; pVfs=pVfs->pNext){+ if( zVfs==0 ) break;+ if( strcmp(zVfs, pVfs->zName)==0 ) break;+ }+ sqlite3_mutex_leave(mutex);+ return pVfs;+}++/*+** Unlink a VFS from the linked list+*/+static void vfsUnlink(sqlite3_vfs *pVfs){+ assert( sqlite3_mutex_held(sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MASTER)) );+ if( pVfs==0 ){+ /* No-op */+ }else if( vfsList==pVfs ){+ vfsList = pVfs->pNext;+ }else if( vfsList ){+ sqlite3_vfs *p = vfsList;+ while( p->pNext && p->pNext!=pVfs ){+ p = p->pNext;+ }+ if( p->pNext==pVfs ){+ p->pNext = pVfs->pNext;+ }+ }+}++/*+** Register a VFS with the system. It is harmless to register the same+** VFS multiple times. The new VFS becomes the default if makeDflt is+** true.+*/+SQLITE_PRIVATE int sqlite3_vfs_register(sqlite3_vfs *pVfs, int makeDflt){+ MUTEX_LOGIC(sqlite3_mutex *mutex;)+#ifndef SQLITE_OMIT_AUTOINIT+ int rc = sqlite3BtreeInitialize();+ if( rc ) return rc;+#endif+#ifdef SQLITE_ENABLE_API_ARMOR+ if( pVfs==0 ) return SQLITE_MISUSE_BKPT;+#endif++ MUTEX_LOGIC( mutex = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MASTER); )+ sqlite3_mutex_enter(mutex);+ vfsUnlink(pVfs);+ if( makeDflt || vfsList==0 ){+ pVfs->pNext = vfsList;+ vfsList = pVfs;+ }else{+ pVfs->pNext = vfsList->pNext;+ vfsList->pNext = pVfs;+ }+ assert(vfsList);+ sqlite3_mutex_leave(mutex);+ return SQLITE_OK;+}++/************** End of os.c **************************************************/+/************** Begin file mem1.c ********************************************/+/*+** 2007 August 14+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file contains low-level memory allocation drivers for when+** SQLite will use the standard C-library malloc/realloc/free interface+** to obtain the memory it needs.+**+** This file contains implementations of the low-level memory allocation+** routines specified in the sqlite3_mem_methods object. The content of+** this file is only used if SQLITE_SYSTEM_MALLOC is defined. The+** SQLITE_SYSTEM_MALLOC macro is defined automatically if neither the+** SQLITE_MEMDEBUG nor the SQLITE_WIN32_MALLOC macros are defined. The+** default configuration is to use memory allocation routines in this+** file.+**+** C-preprocessor macro summary:+**+** HAVE_MALLOC_USABLE_SIZE The configure script sets this symbol if+** the malloc_usable_size() interface exists+** on the target platform. Or, this symbol+** can be set manually, if desired.+** If an equivalent interface exists by+** a different name, using a separate -D+** option to rename it.+**+** SQLITE_WITHOUT_ZONEMALLOC Some older macs lack support for the zone+** memory allocator. Set this symbol to enable+** building on older macs.+**+** SQLITE_WITHOUT_MSIZE Set this symbol to disable the use of+** _msize() on windows systems. This might+** be necessary when compiling for Delphi,+** for example.+*/+/* #include "sqliteInt.h" */++/*+** This version of the memory allocator is the default. It is+** used when no other memory allocator is specified using compile-time+** macros.+*/+#ifdef SQLITE_SYSTEM_MALLOC+#if defined(__APPLE__) && !defined(SQLITE_WITHOUT_ZONEMALLOC)++/*+** Use the zone allocator available on apple products unless the+** SQLITE_WITHOUT_ZONEMALLOC symbol is defined.+*/+#include <sys/sysctl.h>+#include <malloc/malloc.h>+#include <libkern/OSAtomic.h>+static malloc_zone_t* _sqliteZone_;+#define SQLITE_MALLOC(x) malloc_zone_malloc(_sqliteZone_, (x))+#define SQLITE_FREE(x) malloc_zone_free(_sqliteZone_, (x));+#define SQLITE_REALLOC(x,y) malloc_zone_realloc(_sqliteZone_, (x), (y))+#define SQLITE_MALLOCSIZE(x) \+ (_sqliteZone_ ? _sqliteZone_->size(_sqliteZone_,x) : malloc_size(x))++#else /* if not __APPLE__ */++/*+** Use standard C library malloc and free on non-Apple systems. +** Also used by Apple systems if SQLITE_WITHOUT_ZONEMALLOC is defined.+*/+#define SQLITE_MALLOC(x) malloc(x)+#define SQLITE_FREE(x) free(x)+#define SQLITE_REALLOC(x,y) realloc((x),(y))++/*+** The malloc.h header file is needed for malloc_usable_size() function+** on some systems (e.g. Linux).+*/+#if HAVE_MALLOC_H && HAVE_MALLOC_USABLE_SIZE+# define SQLITE_USE_MALLOC_H 1+# define SQLITE_USE_MALLOC_USABLE_SIZE 1+/*+** The MSVCRT has malloc_usable_size(), but it is called _msize(). The+** use of _msize() is automatic, but can be disabled by compiling with+** -DSQLITE_WITHOUT_MSIZE. Using the _msize() function also requires+** the malloc.h header file.+*/+#elif defined(_MSC_VER) && !defined(SQLITE_WITHOUT_MSIZE)+# define SQLITE_USE_MALLOC_H+# define SQLITE_USE_MSIZE+#endif++/*+** Include the malloc.h header file, if necessary. Also set define macro+** SQLITE_MALLOCSIZE to the appropriate function name, which is _msize()+** for MSVC and malloc_usable_size() for most other systems (e.g. Linux).+** The memory size function can always be overridden manually by defining+** the macro SQLITE_MALLOCSIZE to the desired function name.+*/+#if defined(SQLITE_USE_MALLOC_H)+# include <malloc.h>+# if defined(SQLITE_USE_MALLOC_USABLE_SIZE)+# if !defined(SQLITE_MALLOCSIZE)+# define SQLITE_MALLOCSIZE(x) malloc_usable_size(x)+# endif+# elif defined(SQLITE_USE_MSIZE)+# if !defined(SQLITE_MALLOCSIZE)+# define SQLITE_MALLOCSIZE _msize+# endif+# endif+#endif /* defined(SQLITE_USE_MALLOC_H) */++#endif /* __APPLE__ or not __APPLE__ */++/*+** Like malloc(), but remember the size of the allocation+** so that we can find it later using sqlite3MemSize().+**+** For this low-level routine, we are guaranteed that nByte>0 because+** cases of nByte<=0 will be intercepted and dealt with by higher level+** routines.+*/+static void *sqlite3MemMalloc(int nByte){+#ifdef SQLITE_MALLOCSIZE+ void *p = SQLITE_MALLOC( nByte );+ if( p==0 ){+ testcase( sqlite3GlobalConfig.xLog!=0 );+ sqlite3_log(SQLITE_NOMEM, "failed to allocate %u bytes of memory", nByte);+ }+ return p;+#else+ sqlite3_int64 *p;+ assert( nByte>0 );+ nByte = ROUND8(nByte);+ p = SQLITE_MALLOC( nByte+8 );+ if( p ){+ p[0] = nByte;+ p++;+ }else{+ testcase( sqlite3GlobalConfig.xLog!=0 );+ sqlite3_log(SQLITE_NOMEM, "failed to allocate %u bytes of memory", nByte);+ }+ return (void *)p;+#endif+}++/*+** Like free() but works for allocations obtained from sqlite3MemMalloc()+** or sqlite3MemRealloc().+**+** For this low-level routine, we already know that pPrior!=0 since+** cases where pPrior==0 will have been intecepted and dealt with+** by higher-level routines.+*/+static void sqlite3MemFree(void *pPrior){+#ifdef SQLITE_MALLOCSIZE+ SQLITE_FREE(pPrior);+#else+ sqlite3_int64 *p = (sqlite3_int64*)pPrior;+ assert( pPrior!=0 );+ p--;+ SQLITE_FREE(p);+#endif+}++/*+** Report the allocated size of a prior return from xMalloc()+** or xRealloc().+*/+static int sqlite3MemSize(void *pPrior){+#ifdef SQLITE_MALLOCSIZE+ return pPrior ? (int)SQLITE_MALLOCSIZE(pPrior) : 0;+#else+ sqlite3_int64 *p;+ if( pPrior==0 ) return 0;+ p = (sqlite3_int64*)pPrior;+ p--;+ return (int)p[0];+#endif+}++/*+** Like realloc(). Resize an allocation previously obtained from+** sqlite3MemMalloc().+**+** For this low-level interface, we know that pPrior!=0. Cases where+** pPrior==0 while have been intercepted by higher-level routine and+** redirected to xMalloc. Similarly, we know that nByte>0 because+** cases where nByte<=0 will have been intercepted by higher-level+** routines and redirected to xFree.+*/+static void *sqlite3MemRealloc(void *pPrior, int nByte){+#ifdef SQLITE_MALLOCSIZE+ void *p = SQLITE_REALLOC(pPrior, nByte);+ if( p==0 ){+ testcase( sqlite3GlobalConfig.xLog!=0 );+ sqlite3_log(SQLITE_NOMEM,+ "failed memory resize %u to %u bytes",+ SQLITE_MALLOCSIZE(pPrior), nByte);+ }+ return p;+#else+ sqlite3_int64 *p = (sqlite3_int64*)pPrior;+ assert( pPrior!=0 && nByte>0 );+ assert( nByte==ROUND8(nByte) ); /* EV: R-46199-30249 */+ p--;+ p = SQLITE_REALLOC(p, nByte+8 );+ if( p ){+ p[0] = nByte;+ p++;+ }else{+ testcase( sqlite3GlobalConfig.xLog!=0 );+ sqlite3_log(SQLITE_NOMEM,+ "failed memory resize %u to %u bytes",+ sqlite3MemSize(pPrior), nByte);+ }+ return (void*)p;+#endif+}++/*+** Round up a request size to the next valid allocation size.+*/+static int sqlite3MemRoundup(int n){+ return ROUND8(n);+}++/*+** Initialize this module.+*/+static int sqlite3MemInit(void *NotUsed){+#if defined(__APPLE__) && !defined(SQLITE_WITHOUT_ZONEMALLOC)+ int cpuCount;+ size_t len;+ if( _sqliteZone_ ){+ return SQLITE_OK;+ }+ len = sizeof(cpuCount);+ /* One usually wants to use hw.acctivecpu for MT decisions, but not here */+ sysctlbyname("hw.ncpu", &cpuCount, &len, NULL, 0);+ if( cpuCount>1 ){+ /* defer MT decisions to system malloc */+ _sqliteZone_ = malloc_default_zone();+ }else{+ /* only 1 core, use our own zone to contention over global locks, + ** e.g. we have our own dedicated locks */+ bool success;+ malloc_zone_t* newzone = malloc_create_zone(4096, 0);+ malloc_set_zone_name(newzone, "Sqlite_Heap");+ do{+ success = OSAtomicCompareAndSwapPtrBarrier(NULL, newzone, + (void * volatile *)&_sqliteZone_);+ }while(!_sqliteZone_);+ if( !success ){+ /* somebody registered a zone first */+ malloc_destroy_zone(newzone);+ }+ }+#endif+ UNUSED_PARAMETER(NotUsed);+ return SQLITE_OK;+}++/*+** Deinitialize this module.+*/+static void sqlite3MemShutdown(void *NotUsed){+ UNUSED_PARAMETER(NotUsed);+ return;+}++/*+** This routine is the only routine in this file with external linkage.+**+** Populate the low-level memory allocation function pointers in+** sqlite3GlobalConfig.m with pointers to the routines in this file.+*/+SQLITE_PRIVATE void sqlite3MemSetDefault(void){+ static const sqlite3_mem_methods defaultMethods = {+ sqlite3MemMalloc,+ sqlite3MemFree,+ sqlite3MemRealloc,+ sqlite3MemSize,+ sqlite3MemRoundup,+ sqlite3MemInit,+ sqlite3MemShutdown,+ 0+ };+ sqlite3_config(SQLITE_CONFIG_MALLOC, &defaultMethods);+}++#endif /* SQLITE_SYSTEM_MALLOC */++/************** End of mem1.c ************************************************/+/************** Begin file mutex.c *******************************************/+/*+** 2007 August 14+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file contains the C functions that implement mutexes.+**+** This file contains code that is common across all mutex implementations.+*/+/* #include "sqliteInt.h" */++#if defined(SQLITE_DEBUG) && !defined(SQLITE_MUTEX_OMIT)+/*+** For debugging purposes, record when the mutex subsystem is initialized+** and uninitialized so that we can assert() if there is an attempt to+** allocate a mutex while the system is uninitialized.+*/+static SQLITE_WSD int mutexIsInit = 0;+#endif /* SQLITE_DEBUG && !defined(SQLITE_MUTEX_OMIT) */+++#ifndef SQLITE_MUTEX_OMIT+/*+** Initialize the mutex system.+*/+SQLITE_PRIVATE int sqlite3MutexInit(void){ + int rc = SQLITE_OK;+ if( !sqlite3GlobalConfig.mutex.xMutexAlloc ){+ /* If the xMutexAlloc method has not been set, then the user did not+ ** install a mutex implementation via sqlite3_config() prior to + ** sqlite3BtreeInitialize() being called. This block copies pointers to+ ** the default implementation into the sqlite3GlobalConfig structure.+ */+ sqlite3_mutex_methods const *pFrom;+ sqlite3_mutex_methods *pTo = &sqlite3GlobalConfig.mutex;++ if( sqlite3GlobalConfig.bCoreMutex ){+ pFrom = sqlite3DefaultMutex();+ }else{+ pFrom = sqlite3NoopMutex();+ }+ pTo->xMutexInit = pFrom->xMutexInit;+ pTo->xMutexEnd = pFrom->xMutexEnd;+ pTo->xMutexFree = pFrom->xMutexFree;+ pTo->xMutexEnter = pFrom->xMutexEnter;+ pTo->xMutexTry = pFrom->xMutexTry;+ pTo->xMutexLeave = pFrom->xMutexLeave;+ pTo->xMutexHeld = pFrom->xMutexHeld;+ pTo->xMutexNotheld = pFrom->xMutexNotheld;+ sqlite3MemoryBarrier();+ pTo->xMutexAlloc = pFrom->xMutexAlloc;+ }+ assert( sqlite3GlobalConfig.mutex.xMutexInit );+ rc = sqlite3GlobalConfig.mutex.xMutexInit();++#ifdef SQLITE_DEBUG+ GLOBAL(int, mutexIsInit) = 1;+#endif++ return rc;+}++/*+** Shutdown the mutex system. This call frees resources allocated by+** sqlite3MutexInit().+*/+SQLITE_PRIVATE int sqlite3MutexEnd(void){+ int rc = SQLITE_OK;+ if( sqlite3GlobalConfig.mutex.xMutexEnd ){+ rc = sqlite3GlobalConfig.mutex.xMutexEnd();+ }++#ifdef SQLITE_DEBUG+ GLOBAL(int, mutexIsInit) = 0;+#endif++ return rc;+}++/*+** Retrieve a pointer to a static mutex or allocate a new dynamic one.+*/+SQLITE_PRIVATE sqlite3_mutex *sqlite3_mutex_alloc(int id){+#ifndef SQLITE_OMIT_AUTOINIT+ if( id<=SQLITE_MUTEX_RECURSIVE && sqlite3BtreeInitialize() ) return 0;+ if( id>SQLITE_MUTEX_RECURSIVE && sqlite3MutexInit() ) return 0;+#endif+ assert( sqlite3GlobalConfig.mutex.xMutexAlloc );+ return sqlite3GlobalConfig.mutex.xMutexAlloc(id);+}++SQLITE_PRIVATE sqlite3_mutex *sqlite3MutexAlloc(int id){+ if( !sqlite3GlobalConfig.bCoreMutex ){+ return 0;+ }+ assert( GLOBAL(int, mutexIsInit) );+ assert( sqlite3GlobalConfig.mutex.xMutexAlloc );+ return sqlite3GlobalConfig.mutex.xMutexAlloc(id);+}++/*+** Free a dynamic mutex.+*/+SQLITE_PRIVATE void sqlite3_mutex_free(sqlite3_mutex *p){+ if( p ){+ assert( sqlite3GlobalConfig.mutex.xMutexFree );+ sqlite3GlobalConfig.mutex.xMutexFree(p);+ }+}++/*+** Obtain the mutex p. If some other thread already has the mutex, block+** until it can be obtained.+*/+SQLITE_PRIVATE void sqlite3_mutex_enter(sqlite3_mutex *p){+ if( p ){+ assert( sqlite3GlobalConfig.mutex.xMutexEnter );+ sqlite3GlobalConfig.mutex.xMutexEnter(p);+ }+}++/*+** Obtain the mutex p. If successful, return SQLITE_OK. Otherwise, if another+** thread holds the mutex and it cannot be obtained, return SQLITE_BUSY.+*/+SQLITE_PRIVATE int sqlite3_mutex_try(sqlite3_mutex *p){+ int rc = SQLITE_OK;+ if( p ){+ assert( sqlite3GlobalConfig.mutex.xMutexTry );+ return sqlite3GlobalConfig.mutex.xMutexTry(p);+ }+ return rc;+}++/*+** The sqlite3_mutex_leave() routine exits a mutex that was previously+** entered by the same thread. The behavior is undefined if the mutex +** is not currently entered. If a NULL pointer is passed as an argument+** this function is a no-op.+*/+SQLITE_PRIVATE void sqlite3_mutex_leave(sqlite3_mutex *p){+ if( p ){+ assert( sqlite3GlobalConfig.mutex.xMutexLeave );+ sqlite3GlobalConfig.mutex.xMutexLeave(p);+ }+}++#ifndef NDEBUG+/*+** The sqlite3_mutex_held() and sqlite3_mutex_notheld() routine are+** intended for use inside assert() statements.+*/+SQLITE_PRIVATE int sqlite3_mutex_held(sqlite3_mutex *p){+ assert( p==0 || sqlite3GlobalConfig.mutex.xMutexHeld );+ return p==0 || sqlite3GlobalConfig.mutex.xMutexHeld(p);+}+SQLITE_PRIVATE int sqlite3_mutex_notheld(sqlite3_mutex *p){+ assert( p==0 || sqlite3GlobalConfig.mutex.xMutexNotheld );+ return p==0 || sqlite3GlobalConfig.mutex.xMutexNotheld(p);+}+#endif++#endif /* !defined(SQLITE_MUTEX_OMIT) */++/************** End of mutex.c ***********************************************/+/************** Begin file mutex_noop.c **************************************/+/*+** 2008 October 07+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file contains the C functions that implement mutexes.+**+** This implementation in this file does not provide any mutual+** exclusion and is thus suitable for use only in applications+** that use SQLite in a single thread. The routines defined+** here are place-holders. Applications can substitute working+** mutex routines at start-time using the+**+** sqlite3_config(SQLITE_CONFIG_MUTEX,...)+**+** interface.+**+** If compiled with SQLITE_DEBUG, then additional logic is inserted+** that does error checking on mutexes to make sure they are being+** called correctly.+*/+/* #include "sqliteInt.h" */++#ifndef SQLITE_MUTEX_OMIT++#ifndef SQLITE_DEBUG+/*+** Stub routines for all mutex methods.+**+** This routines provide no mutual exclusion or error checking.+*/+static int noopMutexInit(void){ return SQLITE_OK; }+static int noopMutexEnd(void){ return SQLITE_OK; }+static sqlite3_mutex *noopMutexAlloc(int id){ + UNUSED_PARAMETER(id);+ return (sqlite3_mutex*)8; +}+static void noopMutexFree(sqlite3_mutex *p){ UNUSED_PARAMETER(p); return; }+static void noopMutexEnter(sqlite3_mutex *p){ UNUSED_PARAMETER(p); return; }+static int noopMutexTry(sqlite3_mutex *p){+ UNUSED_PARAMETER(p);+ return SQLITE_OK;+}+static void noopMutexLeave(sqlite3_mutex *p){ UNUSED_PARAMETER(p); return; }++SQLITE_PRIVATE sqlite3_mutex_methods const *sqlite3NoopMutex(void){+ static const sqlite3_mutex_methods sMutex = {+ noopMutexInit,+ noopMutexEnd,+ noopMutexAlloc,+ noopMutexFree,+ noopMutexEnter,+ noopMutexTry,+ noopMutexLeave,++ 0,+ 0,+ };++ return &sMutex;+}+#endif /* !SQLITE_DEBUG */++#ifdef SQLITE_DEBUG+/*+** In this implementation, error checking is provided for testing+** and debugging purposes. The mutexes still do not provide any+** mutual exclusion.+*/++/*+** The mutex object+*/+typedef struct sqlite3_debug_mutex {+ int id; /* The mutex type */+ int cnt; /* Number of entries without a matching leave */+} sqlite3_debug_mutex;++/*+** The sqlite3_mutex_held() and sqlite3_mutex_notheld() routine are+** intended for use inside assert() statements.+*/+static int debugMutexHeld(sqlite3_mutex *pX){+ sqlite3_debug_mutex *p = (sqlite3_debug_mutex*)pX;+ return p==0 || p->cnt>0;+}+static int debugMutexNotheld(sqlite3_mutex *pX){+ sqlite3_debug_mutex *p = (sqlite3_debug_mutex*)pX;+ return p==0 || p->cnt==0;+}++/*+** Initialize and deinitialize the mutex subsystem.+*/+static int debugMutexInit(void){ return SQLITE_OK; }+static int debugMutexEnd(void){ return SQLITE_OK; }++/*+** The sqlite3_mutex_alloc() routine allocates a new+** mutex and returns a pointer to it. If it returns NULL+** that means that a mutex could not be allocated. +*/+static sqlite3_mutex *debugMutexAlloc(int id){+ static sqlite3_debug_mutex aStatic[SQLITE_MUTEX_STATIC_VFS3 - 1];+ sqlite3_debug_mutex *pNew = 0;+ switch( id ){+ case SQLITE_MUTEX_FAST:+ case SQLITE_MUTEX_RECURSIVE: {+ pNew = sqlite3Malloc(sizeof(*pNew));+ if( pNew ){+ pNew->id = id;+ pNew->cnt = 0;+ }+ break;+ }+ default: {+#ifdef SQLITE_ENABLE_API_ARMOR+ if( id-2<0 || id-2>=ArraySize(aStatic) ){+ (void)SQLITE_MISUSE_BKPT;+ return 0;+ }+#endif+ pNew = &aStatic[id-2];+ pNew->id = id;+ break;+ }+ }+ return (sqlite3_mutex*)pNew;+}++/*+** This routine deallocates a previously allocated mutex.+*/+static void debugMutexFree(sqlite3_mutex *pX){+ sqlite3_debug_mutex *p = (sqlite3_debug_mutex*)pX;+ assert( p->cnt==0 );+ if( p->id==SQLITE_MUTEX_RECURSIVE || p->id==SQLITE_MUTEX_FAST ){+ sqlite3_free(p);+ }else{+#ifdef SQLITE_ENABLE_API_ARMOR+ (void)SQLITE_MISUSE_BKPT;+#endif+ }+}++/*+** The sqlite3_mutex_enter() and sqlite3_mutex_try() routines attempt+** to enter a mutex. If another thread is already within the mutex,+** sqlite3_mutex_enter() will block and sqlite3_mutex_try() will return+** SQLITE_BUSY. The sqlite3_mutex_try() interface returns SQLITE_OK+** upon successful entry. Mutexes created using SQLITE_MUTEX_RECURSIVE can+** be entered multiple times by the same thread. In such cases the,+** mutex must be exited an equal number of times before another thread+** can enter. If the same thread tries to enter any other kind of mutex+** more than once, the behavior is undefined.+*/+static void debugMutexEnter(sqlite3_mutex *pX){+ sqlite3_debug_mutex *p = (sqlite3_debug_mutex*)pX;+ assert( p->id==SQLITE_MUTEX_RECURSIVE || debugMutexNotheld(pX) );+ p->cnt++;+}+static int debugMutexTry(sqlite3_mutex *pX){+ sqlite3_debug_mutex *p = (sqlite3_debug_mutex*)pX;+ assert( p->id==SQLITE_MUTEX_RECURSIVE || debugMutexNotheld(pX) );+ p->cnt++;+ return SQLITE_OK;+}++/*+** The sqlite3_mutex_leave() routine exits a mutex that was+** previously entered by the same thread. The behavior+** is undefined if the mutex is not currently entered or+** is not currently allocated. SQLite will never do either.+*/+static void debugMutexLeave(sqlite3_mutex *pX){+ sqlite3_debug_mutex *p = (sqlite3_debug_mutex*)pX;+ assert( debugMutexHeld(pX) );+ p->cnt--;+ assert( p->id==SQLITE_MUTEX_RECURSIVE || debugMutexNotheld(pX) );+}++SQLITE_PRIVATE sqlite3_mutex_methods const *sqlite3NoopMutex(void){+ static const sqlite3_mutex_methods sMutex = {+ debugMutexInit,+ debugMutexEnd,+ debugMutexAlloc,+ debugMutexFree,+ debugMutexEnter,+ debugMutexTry,+ debugMutexLeave,++ debugMutexHeld,+ debugMutexNotheld+ };++ return &sMutex;+}+#endif /* SQLITE_DEBUG */++/*+** If compiled with SQLITE_MUTEX_NOOP, then the no-op mutex implementation+** is used regardless of the run-time threadsafety setting.+*/+#ifdef SQLITE_MUTEX_NOOP+SQLITE_PRIVATE sqlite3_mutex_methods const *sqlite3DefaultMutex(void){+ return sqlite3NoopMutex();+}+#endif /* defined(SQLITE_MUTEX_NOOP) */+#endif /* !defined(SQLITE_MUTEX_OMIT) */++/************** End of mutex_noop.c ******************************************/+/************** Begin file mutex_unix.c **************************************/+/*+** 2007 August 28+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file contains the C functions that implement mutexes for pthreads+*/+/* #include "sqliteInt.h" */++/*+** The code in this file is only used if we are compiling threadsafe+** under unix with pthreads.+**+** Note that this implementation requires a version of pthreads that+** supports recursive mutexes.+*/+#ifdef SQLITE_MUTEX_PTHREADS++#include <pthread.h>++/*+** The sqlite3_mutex.id, sqlite3_mutex.nRef, and sqlite3_mutex.owner fields+** are necessary under two condidtions: (1) Debug builds and (2) using+** home-grown mutexes. Encapsulate these conditions into a single #define.+*/+#if defined(SQLITE_DEBUG) || defined(SQLITE_HOMEGROWN_RECURSIVE_MUTEX)+# define SQLITE_MUTEX_NREF 1+#else+# define SQLITE_MUTEX_NREF 0+#endif++/*+** Each recursive mutex is an instance of the following structure.+*/+struct sqlite3_mutex {+ pthread_mutex_t mutex; /* Mutex controlling the lock */+#if SQLITE_MUTEX_NREF || defined(SQLITE_ENABLE_API_ARMOR)+ int id; /* Mutex type */+#endif+#if SQLITE_MUTEX_NREF+ volatile int nRef; /* Number of entrances */+ volatile pthread_t owner; /* Thread that is within this mutex */+ int trace; /* True to trace changes */+#endif+};+#if SQLITE_MUTEX_NREF+#define SQLITE3_MUTEX_INITIALIZER { PTHREAD_MUTEX_INITIALIZER, 0, 0, (pthread_t)0, 0 }+#else+#define SQLITE3_MUTEX_INITIALIZER { PTHREAD_MUTEX_INITIALIZER }+#endif++/*+** The sqlite3_mutex_held() and sqlite3_mutex_notheld() routine are+** intended for use only inside assert() statements. On some platforms,+** there might be race conditions that can cause these routines to+** deliver incorrect results. In particular, if pthread_equal() is+** not an atomic operation, then these routines might delivery+** incorrect results. On most platforms, pthread_equal() is a +** comparison of two integers and is therefore atomic. But we are+** told that HPUX is not such a platform. If so, then these routines+** will not always work correctly on HPUX.+**+** On those platforms where pthread_equal() is not atomic, SQLite+** should be compiled without -DSQLITE_DEBUG and with -DNDEBUG to+** make sure no assert() statements are evaluated and hence these+** routines are never called.+*/+#if !defined(NDEBUG) || defined(SQLITE_DEBUG)+static int pthreadMutexHeld(sqlite3_mutex *p){+ return (p->nRef!=0 && pthread_equal(p->owner, pthread_self()));+}+static int pthreadMutexNotheld(sqlite3_mutex *p){+ return p->nRef==0 || pthread_equal(p->owner, pthread_self())==0;+}+#endif++/*+** Try to provide a memory barrier operation, needed for initialization+** and also for the implementation of xShmBarrier in the VFS in cases+** where SQLite is compiled without mutexes.+*/+SQLITE_PRIVATE void sqlite3MemoryBarrier(void){+#if defined(SQLITE_MEMORY_BARRIER)+ SQLITE_MEMORY_BARRIER;+#elif defined(__GNUC__) && GCC_VERSION>=4001000+ __sync_synchronize();+#endif+}++/*+** Initialize and deinitialize the mutex subsystem.+*/+static int pthreadMutexInit(void){ return SQLITE_OK; }+static int pthreadMutexEnd(void){ return SQLITE_OK; }++/*+** The sqlite3_mutex_alloc() routine allocates a new+** mutex and returns a pointer to it. If it returns NULL+** that means that a mutex could not be allocated. SQLite+** will unwind its stack and return an error. The argument+** to sqlite3_mutex_alloc() is one of these integer constants:+**+** <ul>+** <li> SQLITE_MUTEX_FAST+** <li> SQLITE_MUTEX_RECURSIVE+** <li> SQLITE_MUTEX_STATIC_MASTER+** <li> SQLITE_MUTEX_STATIC_MEM+** <li> SQLITE_MUTEX_STATIC_OPEN+** <li> SQLITE_MUTEX_STATIC_PRNG+** <li> SQLITE_MUTEX_STATIC_LRU+** <li> SQLITE_MUTEX_STATIC_PMEM+** <li> SQLITE_MUTEX_STATIC_APP1+** <li> SQLITE_MUTEX_STATIC_APP2+** <li> SQLITE_MUTEX_STATIC_APP3+** <li> SQLITE_MUTEX_STATIC_VFS1+** <li> SQLITE_MUTEX_STATIC_VFS2+** <li> SQLITE_MUTEX_STATIC_VFS3+** </ul>+**+** The first two constants cause sqlite3_mutex_alloc() to create+** a new mutex. The new mutex is recursive when SQLITE_MUTEX_RECURSIVE+** is used but not necessarily so when SQLITE_MUTEX_FAST is used.+** The mutex implementation does not need to make a distinction+** between SQLITE_MUTEX_RECURSIVE and SQLITE_MUTEX_FAST if it does+** not want to. But SQLite will only request a recursive mutex in+** cases where it really needs one. If a faster non-recursive mutex+** implementation is available on the host platform, the mutex subsystem+** might return such a mutex in response to SQLITE_MUTEX_FAST.+**+** The other allowed parameters to sqlite3_mutex_alloc() each return+** a pointer to a static preexisting mutex. Six static mutexes are+** used by the current version of SQLite. Future versions of SQLite+** may add additional static mutexes. Static mutexes are for internal+** use by SQLite only. Applications that use SQLite mutexes should+** use only the dynamic mutexes returned by SQLITE_MUTEX_FAST or+** SQLITE_MUTEX_RECURSIVE.+**+** Note that if one of the dynamic mutex parameters (SQLITE_MUTEX_FAST+** or SQLITE_MUTEX_RECURSIVE) is used then sqlite3_mutex_alloc()+** returns a different mutex on every call. But for the static +** mutex types, the same mutex is returned on every call that has+** the same type number.+*/+static sqlite3_mutex *pthreadMutexAlloc(int iType){+ static sqlite3_mutex staticMutexes[] = {+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER+ };+ sqlite3_mutex *p;+ switch( iType ){+ case SQLITE_MUTEX_RECURSIVE: {+ p = sqlite3MallocZero( sizeof(*p) );+ if( p ){+#ifdef SQLITE_HOMEGROWN_RECURSIVE_MUTEX+ /* If recursive mutexes are not available, we will have to+ ** build our own. See below. */+ pthread_mutex_init(&p->mutex, 0);+#else+ /* Use a recursive mutex if it is available */+ pthread_mutexattr_t recursiveAttr;+ pthread_mutexattr_init(&recursiveAttr);+ pthread_mutexattr_settype(&recursiveAttr, PTHREAD_MUTEX_RECURSIVE);+ pthread_mutex_init(&p->mutex, &recursiveAttr);+ pthread_mutexattr_destroy(&recursiveAttr);+#endif+ }+ break;+ }+ case SQLITE_MUTEX_FAST: {+ p = sqlite3MallocZero( sizeof(*p) );+ if( p ){+ pthread_mutex_init(&p->mutex, 0);+ }+ break;+ }+ default: {+#ifdef SQLITE_ENABLE_API_ARMOR+ if( iType-2<0 || iType-2>=ArraySize(staticMutexes) ){+ (void)SQLITE_MISUSE_BKPT;+ return 0;+ }+#endif+ p = &staticMutexes[iType-2];+ break;+ }+ }+#if SQLITE_MUTEX_NREF || defined(SQLITE_ENABLE_API_ARMOR)+ if( p ) p->id = iType;+#endif+ return p;+}+++/*+** This routine deallocates a previously+** allocated mutex. SQLite is careful to deallocate every+** mutex that it allocates.+*/+static void pthreadMutexFree(sqlite3_mutex *p){+ assert( p->nRef==0 );+#if SQLITE_ENABLE_API_ARMOR+ if( p->id==SQLITE_MUTEX_FAST || p->id==SQLITE_MUTEX_RECURSIVE )+#endif+ {+ pthread_mutex_destroy(&p->mutex);+ sqlite3_free(p);+ }+#ifdef SQLITE_ENABLE_API_ARMOR+ else{+ (void)SQLITE_MISUSE_BKPT;+ }+#endif+}++/*+** The sqlite3_mutex_enter() and sqlite3_mutex_try() routines attempt+** to enter a mutex. If another thread is already within the mutex,+** sqlite3_mutex_enter() will block and sqlite3_mutex_try() will return+** SQLITE_BUSY. The sqlite3_mutex_try() interface returns SQLITE_OK+** upon successful entry. Mutexes created using SQLITE_MUTEX_RECURSIVE can+** be entered multiple times by the same thread. In such cases the,+** mutex must be exited an equal number of times before another thread+** can enter. If the same thread tries to enter any other kind of mutex+** more than once, the behavior is undefined.+*/+static void pthreadMutexEnter(sqlite3_mutex *p){+ assert( p->id==SQLITE_MUTEX_RECURSIVE || pthreadMutexNotheld(p) );++#ifdef SQLITE_HOMEGROWN_RECURSIVE_MUTEX+ /* If recursive mutexes are not available, then we have to grow+ ** our own. This implementation assumes that pthread_equal()+ ** is atomic - that it cannot be deceived into thinking self+ ** and p->owner are equal if p->owner changes between two values+ ** that are not equal to self while the comparison is taking place.+ ** This implementation also assumes a coherent cache - that + ** separate processes cannot read different values from the same+ ** address at the same time. If either of these two conditions+ ** are not met, then the mutexes will fail and problems will result.+ */+ {+ pthread_t self = pthread_self();+ if( p->nRef>0 && pthread_equal(p->owner, self) ){+ p->nRef++;+ }else{+ pthread_mutex_lock(&p->mutex);+ assert( p->nRef==0 );+ p->owner = self;+ p->nRef = 1;+ }+ }+#else+ /* Use the built-in recursive mutexes if they are available.+ */+ pthread_mutex_lock(&p->mutex);+#if SQLITE_MUTEX_NREF+ assert( p->nRef>0 || p->owner==0 );+ p->owner = pthread_self();+ p->nRef++;+#endif+#endif++#ifdef SQLITE_DEBUG+ if( p->trace ){+ printf("enter mutex %p (%d) with nRef=%d\n", p, p->trace, p->nRef);+ }+#endif+}+static int pthreadMutexTry(sqlite3_mutex *p){+ int rc;+ assert( p->id==SQLITE_MUTEX_RECURSIVE || pthreadMutexNotheld(p) );++#ifdef SQLITE_HOMEGROWN_RECURSIVE_MUTEX+ /* If recursive mutexes are not available, then we have to grow+ ** our own. This implementation assumes that pthread_equal()+ ** is atomic - that it cannot be deceived into thinking self+ ** and p->owner are equal if p->owner changes between two values+ ** that are not equal to self while the comparison is taking place.+ ** This implementation also assumes a coherent cache - that + ** separate processes cannot read different values from the same+ ** address at the same time. If either of these two conditions+ ** are not met, then the mutexes will fail and problems will result.+ */+ {+ pthread_t self = pthread_self();+ if( p->nRef>0 && pthread_equal(p->owner, self) ){+ p->nRef++;+ rc = SQLITE_OK;+ }else if( pthread_mutex_trylock(&p->mutex)==0 ){+ assert( p->nRef==0 );+ p->owner = self;+ p->nRef = 1;+ rc = SQLITE_OK;+ }else{+ rc = SQLITE_BUSY;+ }+ }+#else+ /* Use the built-in recursive mutexes if they are available.+ */+ if( pthread_mutex_trylock(&p->mutex)==0 ){+#if SQLITE_MUTEX_NREF+ p->owner = pthread_self();+ p->nRef++;+#endif+ rc = SQLITE_OK;+ }else{+ rc = SQLITE_BUSY;+ }+#endif++#ifdef SQLITE_DEBUG+ if( rc==SQLITE_OK && p->trace ){+ printf("enter mutex %p (%d) with nRef=%d\n", p, p->trace, p->nRef);+ }+#endif+ return rc;+}++/*+** The sqlite3_mutex_leave() routine exits a mutex that was+** previously entered by the same thread. The behavior+** is undefined if the mutex is not currently entered or+** is not currently allocated. SQLite will never do either.+*/+static void pthreadMutexLeave(sqlite3_mutex *p){+ assert( pthreadMutexHeld(p) );+#if SQLITE_MUTEX_NREF+ p->nRef--;+ if( p->nRef==0 ) p->owner = 0;+#endif+ assert( p->nRef==0 || p->id==SQLITE_MUTEX_RECURSIVE );++#ifdef SQLITE_HOMEGROWN_RECURSIVE_MUTEX+ if( p->nRef==0 ){+ pthread_mutex_unlock(&p->mutex);+ }+#else+ pthread_mutex_unlock(&p->mutex);+#endif++#ifdef SQLITE_DEBUG+ if( p->trace ){+ printf("leave mutex %p (%d) with nRef=%d\n", p, p->trace, p->nRef);+ }+#endif+}++SQLITE_PRIVATE sqlite3_mutex_methods const *sqlite3DefaultMutex(void){+ static const sqlite3_mutex_methods sMutex = {+ pthreadMutexInit,+ pthreadMutexEnd,+ pthreadMutexAlloc,+ pthreadMutexFree,+ pthreadMutexEnter,+ pthreadMutexTry,+ pthreadMutexLeave,+#ifdef SQLITE_DEBUG+ pthreadMutexHeld,+ pthreadMutexNotheld+#else+ 0,+ 0+#endif+ };++ return &sMutex;+}++#endif /* SQLITE_MUTEX_PTHREADS */++/************** End of mutex_unix.c ******************************************/+/************** Begin file mutex_w32.c ***************************************/+/*+** 2007 August 14+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file contains the C functions that implement mutexes for Win32.+*/+/* #include "sqliteInt.h" */++#if SQLITE_OS_WIN+/*+** Include code that is common to all os_*.c files+*/+/************** Include os_common.h in the middle of mutex_w32.c *************/+/************** Begin file os_common.h ***************************************/+/*+** 2004 May 22+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains macros and a little bit of code that is common to+** all of the platform-specific files (os_*.c) and is #included into those+** files.+**+** This file should be #included by the os_*.c files only. It is not a+** general purpose header file.+*/+#ifndef _OS_COMMON_H_+#define _OS_COMMON_H_++/*+** At least two bugs have slipped in because we changed the MEMORY_DEBUG+** macro to SQLITE_DEBUG and some older makefiles have not yet made the+** switch. The following code should catch this problem at compile-time.+*/+#ifdef MEMORY_DEBUG+# error "The MEMORY_DEBUG macro is obsolete. Use SQLITE_DEBUG instead."+#endif++/*+** Macros for performance tracing. Normally turned off. Only works+** on i486 hardware.+*/+#ifdef SQLITE_PERFORMANCE_TRACE++/* +** hwtime.h contains inline assembler code for implementing +** high-performance timing routines.+*/+#include "hwtime.h"++static sqlite_uint64 g_start;+static sqlite_uint64 g_elapsed;+#define TIMER_START g_start=sqlite3Hwtime()+#define TIMER_END g_elapsed=sqlite3Hwtime()-g_start+#define TIMER_ELAPSED g_elapsed+#else+#define TIMER_START+#define TIMER_END+#define TIMER_ELAPSED ((sqlite_uint64)0)+#endif++/*+** If we compile with the SQLITE_TEST macro set, then the following block+** of code will give us the ability to simulate a disk I/O error. This+** is used for testing the I/O recovery logic.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_io_error_hit = 0; /* Total number of I/O Errors */+SQLITE_PRIVATE int sqlite3_io_error_hardhit = 0; /* Number of non-benign errors */+SQLITE_PRIVATE int sqlite3_io_error_pending = 0; /* Count down to first I/O error */+SQLITE_PRIVATE int sqlite3_io_error_persist = 0; /* True if I/O errors persist */+SQLITE_PRIVATE int sqlite3_io_error_benign = 0; /* True if errors are benign */+SQLITE_PRIVATE int sqlite3_diskfull_pending = 0;+SQLITE_PRIVATE int sqlite3_diskfull = 0;+#define SimulateIOErrorBenign(X) sqlite3_io_error_benign=(X)+#define SimulateIOError(CODE) \+ if( (sqlite3_io_error_persist && sqlite3_io_error_hit) \+ || sqlite3_io_error_pending-- == 1 ) \+ { local_ioerr(); CODE; }+static void local_ioerr(){+ IOTRACE(("IOERR\n"));+ sqlite3_io_error_hit++;+ if( !sqlite3_io_error_benign ) sqlite3_io_error_hardhit++;+}+#define SimulateDiskfullError(CODE) \+ if( sqlite3_diskfull_pending ){ \+ if( sqlite3_diskfull_pending == 1 ){ \+ local_ioerr(); \+ sqlite3_diskfull = 1; \+ sqlite3_io_error_hit = 1; \+ CODE; \+ }else{ \+ sqlite3_diskfull_pending--; \+ } \+ }+#else+#define SimulateIOErrorBenign(X)+#define SimulateIOError(A)+#define SimulateDiskfullError(A)+#endif++/*+** When testing, keep a count of the number of open files.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_open_file_count = 0;+#define OpenCounter(X) sqlite3_open_file_count+=(X)+#else+#define OpenCounter(X)+#endif++#endif /* !defined(_OS_COMMON_H_) */++/************** End of os_common.h *******************************************/+/************** Continuing where we left off in mutex_w32.c ******************/++/*+** Include the header file for the Windows VFS.+*/+/************** Include os_win.h in the middle of mutex_w32.c ****************/+/************** Begin file os_win.h ******************************************/+/*+** 2013 November 25+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains code that is specific to Windows.+*/+#ifndef _OS_WIN_H_+#define _OS_WIN_H_++/*+** Include the primary Windows SDK header file.+*/+#include "windows.h"++#ifdef __CYGWIN__+# include <sys/cygwin.h>+# include <errno.h> /* amalgamator: dontcache */+#endif++/*+** Determine if we are dealing with Windows NT.+**+** We ought to be able to determine if we are compiling for Windows 9x or+** Windows NT using the _WIN32_WINNT macro as follows:+**+** #if defined(_WIN32_WINNT)+** # define SQLITE_OS_WINNT 1+** #else+** # define SQLITE_OS_WINNT 0+** #endif+**+** However, Visual Studio 2005 does not set _WIN32_WINNT by default, as+** it ought to, so the above test does not work. We'll just assume that+** everything is Windows NT unless the programmer explicitly says otherwise+** by setting SQLITE_OS_WINNT to 0.+*/+#if SQLITE_OS_WIN && !defined(SQLITE_OS_WINNT)+# define SQLITE_OS_WINNT 1+#endif++/*+** Determine if we are dealing with Windows CE - which has a much reduced+** API.+*/+#if defined(_WIN32_WCE)+# define SQLITE_OS_WINCE 1+#else+# define SQLITE_OS_WINCE 0+#endif++/*+** Determine if we are dealing with WinRT, which provides only a subset of+** the full Win32 API.+*/+#if !defined(SQLITE_OS_WINRT)+# define SQLITE_OS_WINRT 0+#endif++/*+** For WinCE, some API function parameters do not appear to be declared as+** volatile.+*/+#if SQLITE_OS_WINCE+# define SQLITE_WIN32_VOLATILE+#else+# define SQLITE_WIN32_VOLATILE volatile+#endif++/*+** For some Windows sub-platforms, the _beginthreadex() / _endthreadex()+** functions are not available (e.g. those not using MSVC, Cygwin, etc).+*/+#if SQLITE_OS_WIN && !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && \+ SQLITE_THREADSAFE>0 && !defined(__CYGWIN__)+# define SQLITE_OS_WIN_THREADS 1+#else+# define SQLITE_OS_WIN_THREADS 0+#endif++#endif /* _OS_WIN_H_ */++/************** End of os_win.h **********************************************/+/************** Continuing where we left off in mutex_w32.c ******************/+#endif++/*+** The code in this file is only used if we are compiling multithreaded+** on a Win32 system.+*/+#ifdef SQLITE_MUTEX_W32++/*+** Each recursive mutex is an instance of the following structure.+*/+struct sqlite3_mutex {+ CRITICAL_SECTION mutex; /* Mutex controlling the lock */+ int id; /* Mutex type */+#ifdef SQLITE_DEBUG+ volatile int nRef; /* Number of enterances */+ volatile DWORD owner; /* Thread holding this mutex */+ volatile int trace; /* True to trace changes */+#endif+};++/*+** These are the initializer values used when declaring a "static" mutex+** on Win32. It should be noted that all mutexes require initialization+** on the Win32 platform.+*/+#define SQLITE_W32_MUTEX_INITIALIZER { 0 }++#ifdef SQLITE_DEBUG+#define SQLITE3_MUTEX_INITIALIZER { SQLITE_W32_MUTEX_INITIALIZER, 0, \+ 0L, (DWORD)0, 0 }+#else+#define SQLITE3_MUTEX_INITIALIZER { SQLITE_W32_MUTEX_INITIALIZER, 0 }+#endif++#ifdef SQLITE_DEBUG+/*+** The sqlite3_mutex_held() and sqlite3_mutex_notheld() routine are+** intended for use only inside assert() statements.+*/+static int winMutexHeld(sqlite3_mutex *p){+ return p->nRef!=0 && p->owner==GetCurrentThreadId();+}++static int winMutexNotheld2(sqlite3_mutex *p, DWORD tid){+ return p->nRef==0 || p->owner!=tid;+}++static int winMutexNotheld(sqlite3_mutex *p){+ DWORD tid = GetCurrentThreadId();+ return winMutexNotheld2(p, tid);+}+#endif++/*+** Try to provide a memory barrier operation, needed for initialization+** and also for the xShmBarrier method of the VFS in cases when SQLite is+** compiled without mutexes (SQLITE_THREADSAFE=0).+*/+SQLITE_PRIVATE void sqlite3MemoryBarrier(void){+#if defined(SQLITE_MEMORY_BARRIER)+ SQLITE_MEMORY_BARRIER;+#elif defined(__GNUC__)+ __sync_synchronize();+#elif !defined(SQLITE_DISABLE_INTRINSIC) && \+ defined(_MSC_VER) && _MSC_VER>=1300+ _ReadWriteBarrier();+#elif defined(MemoryBarrier)+ MemoryBarrier();+#endif+}++/*+** Initialize and deinitialize the mutex subsystem.+*/+static sqlite3_mutex winMutex_staticMutexes[] = {+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER,+ SQLITE3_MUTEX_INITIALIZER+};++static int winMutex_isInit = 0;+static int winMutex_isNt = -1; /* <0 means "need to query" */++/* As the winMutexInit() and winMutexEnd() functions are called as part+** of the sqlite3BtreeInitialize() and sqlite3BtreeShutdown() processing, the+** "interlocked" magic used here is probably not strictly necessary.+*/+static LONG SQLITE_WIN32_VOLATILE winMutex_lock = 0;++SQLITE_PRIVATE int sqlite3_win32_is_nt(void); /* os_win.c */+SQLITE_PRIVATE void sqlite3_win32_sleep(DWORD milliseconds); /* os_win.c */++static int winMutexInit(void){+ /* The first to increment to 1 does actual initialization */+ if( InterlockedCompareExchange(&winMutex_lock, 1, 0)==0 ){+ int i;+ for(i=0; i<ArraySize(winMutex_staticMutexes); i++){+#if SQLITE_OS_WINRT+ InitializeCriticalSectionEx(&winMutex_staticMutexes[i].mutex, 0, 0);+#else+ InitializeCriticalSection(&winMutex_staticMutexes[i].mutex);+#endif+ }+ winMutex_isInit = 1;+ }else{+ /* Another thread is (in the process of) initializing the static+ ** mutexes */+ while( !winMutex_isInit ){+ sqlite3_win32_sleep(1);+ }+ }+ return SQLITE_OK;+}++static int winMutexEnd(void){+ /* The first to decrement to 0 does actual shutdown+ ** (which should be the last to shutdown.) */+ if( InterlockedCompareExchange(&winMutex_lock, 0, 1)==1 ){+ if( winMutex_isInit==1 ){+ int i;+ for(i=0; i<ArraySize(winMutex_staticMutexes); i++){+ DeleteCriticalSection(&winMutex_staticMutexes[i].mutex);+ }+ winMutex_isInit = 0;+ }+ }+ return SQLITE_OK;+}++/*+** The sqlite3_mutex_alloc() routine allocates a new+** mutex and returns a pointer to it. If it returns NULL+** that means that a mutex could not be allocated. SQLite+** will unwind its stack and return an error. The argument+** to sqlite3_mutex_alloc() is one of these integer constants:+**+** <ul>+** <li> SQLITE_MUTEX_FAST+** <li> SQLITE_MUTEX_RECURSIVE+** <li> SQLITE_MUTEX_STATIC_MASTER+** <li> SQLITE_MUTEX_STATIC_MEM+** <li> SQLITE_MUTEX_STATIC_OPEN+** <li> SQLITE_MUTEX_STATIC_PRNG+** <li> SQLITE_MUTEX_STATIC_LRU+** <li> SQLITE_MUTEX_STATIC_PMEM+** <li> SQLITE_MUTEX_STATIC_APP1+** <li> SQLITE_MUTEX_STATIC_APP2+** <li> SQLITE_MUTEX_STATIC_APP3+** <li> SQLITE_MUTEX_STATIC_VFS1+** <li> SQLITE_MUTEX_STATIC_VFS2+** <li> SQLITE_MUTEX_STATIC_VFS3+** </ul>+**+** The first two constants cause sqlite3_mutex_alloc() to create+** a new mutex. The new mutex is recursive when SQLITE_MUTEX_RECURSIVE+** is used but not necessarily so when SQLITE_MUTEX_FAST is used.+** The mutex implementation does not need to make a distinction+** between SQLITE_MUTEX_RECURSIVE and SQLITE_MUTEX_FAST if it does+** not want to. But SQLite will only request a recursive mutex in+** cases where it really needs one. If a faster non-recursive mutex+** implementation is available on the host platform, the mutex subsystem+** might return such a mutex in response to SQLITE_MUTEX_FAST.+**+** The other allowed parameters to sqlite3_mutex_alloc() each return+** a pointer to a static preexisting mutex. Six static mutexes are+** used by the current version of SQLite. Future versions of SQLite+** may add additional static mutexes. Static mutexes are for internal+** use by SQLite only. Applications that use SQLite mutexes should+** use only the dynamic mutexes returned by SQLITE_MUTEX_FAST or+** SQLITE_MUTEX_RECURSIVE.+**+** Note that if one of the dynamic mutex parameters (SQLITE_MUTEX_FAST+** or SQLITE_MUTEX_RECURSIVE) is used then sqlite3_mutex_alloc()+** returns a different mutex on every call. But for the static+** mutex types, the same mutex is returned on every call that has+** the same type number.+*/+static sqlite3_mutex *winMutexAlloc(int iType){+ sqlite3_mutex *p;++ switch( iType ){+ case SQLITE_MUTEX_FAST:+ case SQLITE_MUTEX_RECURSIVE: {+ p = sqlite3MallocZero( sizeof(*p) );+ if( p ){+ p->id = iType;+#ifdef SQLITE_DEBUG+#ifdef SQLITE_WIN32_MUTEX_TRACE_DYNAMIC+ p->trace = 1;+#endif+#endif+#if SQLITE_OS_WINRT+ InitializeCriticalSectionEx(&p->mutex, 0, 0);+#else+ InitializeCriticalSection(&p->mutex);+#endif+ }+ break;+ }+ default: {+#ifdef SQLITE_ENABLE_API_ARMOR+ if( iType-2<0 || iType-2>=ArraySize(winMutex_staticMutexes) ){+ (void)SQLITE_MISUSE_BKPT;+ return 0;+ }+#endif+ p = &winMutex_staticMutexes[iType-2];+ p->id = iType;+#ifdef SQLITE_DEBUG+#ifdef SQLITE_WIN32_MUTEX_TRACE_STATIC+ p->trace = 1;+#endif+#endif+ break;+ }+ }+ return p;+}+++/*+** This routine deallocates a previously+** allocated mutex. SQLite is careful to deallocate every+** mutex that it allocates.+*/+static void winMutexFree(sqlite3_mutex *p){+ assert( p );+ assert( p->nRef==0 && p->owner==0 );+ if( p->id==SQLITE_MUTEX_FAST || p->id==SQLITE_MUTEX_RECURSIVE ){+ DeleteCriticalSection(&p->mutex);+ sqlite3_free(p);+ }else{+#ifdef SQLITE_ENABLE_API_ARMOR+ (void)SQLITE_MISUSE_BKPT;+#endif+ }+}++/*+** The sqlite3_mutex_enter() and sqlite3_mutex_try() routines attempt+** to enter a mutex. If another thread is already within the mutex,+** sqlite3_mutex_enter() will block and sqlite3_mutex_try() will return+** SQLITE_BUSY. The sqlite3_mutex_try() interface returns SQLITE_OK+** upon successful entry. Mutexes created using SQLITE_MUTEX_RECURSIVE can+** be entered multiple times by the same thread. In such cases the,+** mutex must be exited an equal number of times before another thread+** can enter. If the same thread tries to enter any other kind of mutex+** more than once, the behavior is undefined.+*/+static void winMutexEnter(sqlite3_mutex *p){+#if defined(SQLITE_DEBUG) || defined(SQLITE_TEST)+ DWORD tid = GetCurrentThreadId();+#endif+#ifdef SQLITE_DEBUG+ assert( p );+ assert( p->id==SQLITE_MUTEX_RECURSIVE || winMutexNotheld2(p, tid) );+#else+ assert( p );+#endif+ assert( winMutex_isInit==1 );+ EnterCriticalSection(&p->mutex);+#ifdef SQLITE_DEBUG+ assert( p->nRef>0 || p->owner==0 );+ p->owner = tid;+ p->nRef++;+ if( p->trace ){+ OSTRACE(("ENTER-MUTEX tid=%lu, mutex=%p (%d), nRef=%d\n",+ tid, p, p->trace, p->nRef));+ }+#endif+}++static int winMutexTry(sqlite3_mutex *p){+#if defined(SQLITE_DEBUG) || defined(SQLITE_TEST)+ DWORD tid = GetCurrentThreadId();+#endif+ int rc = SQLITE_BUSY;+ assert( p );+ assert( p->id==SQLITE_MUTEX_RECURSIVE || winMutexNotheld2(p, tid) );+ /*+ ** The sqlite3_mutex_try() routine is very rarely used, and when it+ ** is used it is merely an optimization. So it is OK for it to always+ ** fail.+ **+ ** The TryEnterCriticalSection() interface is only available on WinNT.+ ** And some windows compilers complain if you try to use it without+ ** first doing some #defines that prevent SQLite from building on Win98.+ ** For that reason, we will omit this optimization for now. See+ ** ticket #2685.+ */+#if defined(_WIN32_WINNT) && _WIN32_WINNT >= 0x0400+ assert( winMutex_isInit==1 );+ assert( winMutex_isNt>=-1 && winMutex_isNt<=1 );+ if( winMutex_isNt<0 ){+ winMutex_isNt = sqlite3_win32_is_nt();+ }+ assert( winMutex_isNt==0 || winMutex_isNt==1 );+ if( winMutex_isNt && TryEnterCriticalSection(&p->mutex) ){+#ifdef SQLITE_DEBUG+ p->owner = tid;+ p->nRef++;+#endif+ rc = SQLITE_OK;+ }+#else+ UNUSED_PARAMETER(p);+#endif+#ifdef SQLITE_DEBUG+ if( p->trace ){+ OSTRACE(("TRY-MUTEX tid=%lu, mutex=%p (%d), owner=%lu, nRef=%d, rc=%s\n",+ tid, p, p->trace, p->owner, p->nRef, sqlite3ErrName(rc)));+ }+#endif+ return rc;+}++/*+** The sqlite3_mutex_leave() routine exits a mutex that was+** previously entered by the same thread. The behavior+** is undefined if the mutex is not currently entered or+** is not currently allocated. SQLite will never do either.+*/+static void winMutexLeave(sqlite3_mutex *p){+#if defined(SQLITE_DEBUG) || defined(SQLITE_TEST)+ DWORD tid = GetCurrentThreadId();+#endif+ assert( p );+#ifdef SQLITE_DEBUG+ assert( p->nRef>0 );+ assert( p->owner==tid );+ p->nRef--;+ if( p->nRef==0 ) p->owner = 0;+ assert( p->nRef==0 || p->id==SQLITE_MUTEX_RECURSIVE );+#endif+ assert( winMutex_isInit==1 );+ LeaveCriticalSection(&p->mutex);+#ifdef SQLITE_DEBUG+ if( p->trace ){+ OSTRACE(("LEAVE-MUTEX tid=%lu, mutex=%p (%d), nRef=%d\n",+ tid, p, p->trace, p->nRef));+ }+#endif+}++SQLITE_PRIVATE sqlite3_mutex_methods const *sqlite3DefaultMutex(void){+ static const sqlite3_mutex_methods sMutex = {+ winMutexInit,+ winMutexEnd,+ winMutexAlloc,+ winMutexFree,+ winMutexEnter,+ winMutexTry,+ winMutexLeave,+#ifdef SQLITE_DEBUG+ winMutexHeld,+ winMutexNotheld+#else+ 0,+ 0+#endif+ };+ return &sMutex;+}++#endif /* SQLITE_MUTEX_W32 */++/************** End of mutex_w32.c *******************************************/+/************** Begin file malloc.c ******************************************/+/*+** 2001 September 15+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** Memory allocation functions used throughout sqlite.+*/+/* #include "sqliteInt.h" */+/* #include <stdarg.h> */++/*+** Attempt to release up to n bytes of non-essential memory currently+** held by SQLite. An example of non-essential memory is memory used to+** cache database pages that are not currently in use.+*/+SQLITE_PRIVATE int sqlite3_release_memory(int n){+#ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT+ return sqlite3PcacheReleaseMemory(n);+#else+ /* IMPLEMENTATION-OF: R-34391-24921 The sqlite3_release_memory() routine+ ** is a no-op returning zero if SQLite is not compiled with+ ** SQLITE_ENABLE_MEMORY_MANAGEMENT. */+ UNUSED_PARAMETER(n);+ return 0;+#endif+}++/*+** An instance of the following object records the location of+** each unused scratch buffer.+*/+typedef struct ScratchFreeslot {+ struct ScratchFreeslot *pNext; /* Next unused scratch buffer */+} ScratchFreeslot;++/*+** State information local to the memory allocation subsystem.+*/+static SQLITE_WSD struct Mem0Global {+ sqlite3_mutex *mutex; /* Mutex to serialize access */+ sqlite3_int64 alarmThreshold; /* The soft heap limit */++ /*+ ** Pointers to the end of sqlite3GlobalConfig.pScratch memory+ ** (so that a range test can be used to determine if an allocation+ ** being freed came from pScratch) and a pointer to the list of+ ** unused scratch allocations.+ */+ void *pScratchEnd;+ ScratchFreeslot *pScratchFree;+ u32 nScratchFree;++ /*+ ** True if heap is nearly "full" where "full" is defined by the+ ** sqlite3_soft_heap_limit() setting.+ */+ int nearlyFull;+} mem0 = { 0, 0, 0, 0, 0, 0 };++#define mem0 GLOBAL(struct Mem0Global, mem0)++#ifndef NDEBUG+/*+** Return the memory allocator mutex. sqlite3_status() needs it.+*/+SQLITE_PRIVATE sqlite3_mutex *sqlite3MallocMutex(void){+ return mem0.mutex;+}+#endif++/*+** Initialize the memory allocation subsystem.+*/+SQLITE_PRIVATE int sqlite3MallocInit(void){+ int rc;+ if( sqlite3GlobalConfig.m.xMalloc==0 ){+ sqlite3MemSetDefault();+ }+ memset(&mem0, 0, sizeof(mem0));+ if( sqlite3GlobalConfig.bCoreMutex ){+ mem0.mutex = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MEM);+ }+ if( sqlite3GlobalConfig.pScratch && sqlite3GlobalConfig.szScratch>=100+ && sqlite3GlobalConfig.nScratch>0 ){+ int i, n, sz;+ ScratchFreeslot *pSlot;+ sz = ROUNDDOWN8(sqlite3GlobalConfig.szScratch);+ sqlite3GlobalConfig.szScratch = sz;+ pSlot = (ScratchFreeslot*)sqlite3GlobalConfig.pScratch;+ n = sqlite3GlobalConfig.nScratch;+ mem0.pScratchFree = pSlot;+ mem0.nScratchFree = n;+ for(i=0; i<n-1; i++){+ pSlot->pNext = (ScratchFreeslot*)(sz+(char*)pSlot);+ pSlot = pSlot->pNext;+ }+ pSlot->pNext = 0;+ mem0.pScratchEnd = (void*)&pSlot[1];+ }else{+ mem0.pScratchEnd = 0;+ sqlite3GlobalConfig.pScratch = 0;+ sqlite3GlobalConfig.szScratch = 0;+ sqlite3GlobalConfig.nScratch = 0;+ }+ if( sqlite3GlobalConfig.pPage==0 || sqlite3GlobalConfig.szPage<512+ || sqlite3GlobalConfig.nPage<=0 ){+ sqlite3GlobalConfig.pPage = 0;+ sqlite3GlobalConfig.szPage = 0;+ }+ rc = sqlite3GlobalConfig.m.xInit(sqlite3GlobalConfig.m.pAppData);+ if( rc!=SQLITE_OK ) memset(&mem0, 0, sizeof(mem0));+ return rc;+}++/*+** Return true if the heap is currently under memory pressure - in other+** words if the amount of heap used is close to the limit set by+** sqlite3_soft_heap_limit().+*/+SQLITE_PRIVATE int sqlite3HeapNearlyFull(void){+ return mem0.nearlyFull;+}++/*+** Deinitialize the memory allocation subsystem.+*/+SQLITE_PRIVATE void sqlite3MallocEnd(void){+ if( sqlite3GlobalConfig.m.xShutdown ){+ sqlite3GlobalConfig.m.xShutdown(sqlite3GlobalConfig.m.pAppData);+ }+ memset(&mem0, 0, sizeof(mem0));+}++/*+** Trigger the alarm +*/+static void sqlite3MallocAlarm(int nByte){+ if( mem0.alarmThreshold<=0 ) return;+ sqlite3_mutex_leave(mem0.mutex);+ sqlite3_release_memory(nByte);+ sqlite3_mutex_enter(mem0.mutex);+}++/*+** Do a memory allocation with statistics and alarms. Assume the+** lock is already held.+*/+static int mallocWithAlarm(int n, void **pp){+ int nFull;+ void *p;+ assert( sqlite3_mutex_held(mem0.mutex) );+ nFull = sqlite3GlobalConfig.m.xRoundup(n);+ sqlite3StatusSet(SQLITE_STATUS_MALLOC_SIZE, n);+ if( mem0.alarmThreshold>0 ){+ sqlite3_int64 nUsed = sqlite3StatusValue(SQLITE_STATUS_MEMORY_USED);+ if( nUsed >= mem0.alarmThreshold - nFull ){+ mem0.nearlyFull = 1;+ sqlite3MallocAlarm(nFull);+ }else{+ mem0.nearlyFull = 0;+ }+ }+ p = sqlite3GlobalConfig.m.xMalloc(nFull);+#ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT+ if( p==0 && mem0.alarmThreshold>0 ){+ sqlite3MallocAlarm(nFull);+ p = sqlite3GlobalConfig.m.xMalloc(nFull);+ }+#endif+ if( p ){+ nFull = sqlite3MallocSize(p);+ sqlite3StatusUp(SQLITE_STATUS_MEMORY_USED, nFull);+ sqlite3StatusUp(SQLITE_STATUS_MALLOC_COUNT, 1);+ }+ *pp = p;+ return nFull;+}++/*+** Allocate memory. This routine is like sqlite3_malloc() except that it+** assumes the memory subsystem has already been initialized.+*/+SQLITE_PRIVATE void *sqlite3Malloc(u64 n){+ void *p;+ if( n==0 || n>=0x7fffff00 ){+ /* A memory allocation of a number of bytes which is near the maximum+ ** signed integer value might cause an integer overflow inside of the+ ** xMalloc(). Hence we limit the maximum size to 0x7fffff00, giving+ ** 255 bytes of overhead. SQLite itself will never use anything near+ ** this amount. The only way to reach the limit is with sqlite3_malloc() */+ p = 0;+ }else if( sqlite3GlobalConfig.bMemstat ){+ sqlite3_mutex_enter(mem0.mutex);+ mallocWithAlarm((int)n, &p);+ sqlite3_mutex_leave(mem0.mutex);+ }else{+ p = sqlite3GlobalConfig.m.xMalloc((int)n);+ }+ assert( EIGHT_BYTE_ALIGNMENT(p) ); /* IMP: R-11148-40995 */+ return p;+}++/*+** This version of the memory allocation is for use by the application.+** First make sure the memory subsystem is initialized, then do the+** allocation.+*/+SQLITE_PRIVATE void *sqlite3_malloc(int n){+#ifndef SQLITE_OMIT_AUTOINIT+ if( sqlite3BtreeInitialize() ) return 0;+#endif+ return n<=0 ? 0 : sqlite3Malloc(n);+}+SQLITE_PRIVATE void *sqlite3_malloc64(sqlite3_uint64 n){+#ifndef SQLITE_OMIT_AUTOINIT+ if( sqlite3BtreeInitialize() ) return 0;+#endif+ return sqlite3Malloc(n);+}++/*+** Each thread may only have a single outstanding allocation from+** xScratchMalloc(). We verify this constraint in the single-threaded+** case by setting scratchAllocOut to 1 when an allocation+** is outstanding clearing it when the allocation is freed.+*/+#if SQLITE_THREADSAFE==0 && !defined(NDEBUG)+static int scratchAllocOut = 0;+#endif+++/*+** Allocate memory that is to be used and released right away.+** This routine is similar to alloca() in that it is not intended+** for situations where the memory might be held long-term. This+** routine is intended to get memory to old large transient data+** structures that would not normally fit on the stack of an+** embedded processor.+*/+SQLITE_PRIVATE void *sqlite3ScratchMalloc(int n){+ void *p;+ assert( n>0 );++ sqlite3_mutex_enter(mem0.mutex);+ sqlite3StatusSet(SQLITE_STATUS_SCRATCH_SIZE, n);+ if( mem0.nScratchFree && sqlite3GlobalConfig.szScratch>=n ){+ p = mem0.pScratchFree;+ mem0.pScratchFree = mem0.pScratchFree->pNext;+ mem0.nScratchFree--;+ sqlite3StatusUp(SQLITE_STATUS_SCRATCH_USED, 1);+ sqlite3_mutex_leave(mem0.mutex);+ }else{+ sqlite3_mutex_leave(mem0.mutex);+ p = sqlite3Malloc(n);+ if( sqlite3GlobalConfig.bMemstat && p ){+ sqlite3_mutex_enter(mem0.mutex);+ sqlite3StatusUp(SQLITE_STATUS_SCRATCH_OVERFLOW, sqlite3MallocSize(p));+ sqlite3_mutex_leave(mem0.mutex);+ }+ sqlite3MemdebugSetType(p, MEMTYPE_SCRATCH);+ }+ assert( sqlite3_mutex_notheld(mem0.mutex) );+++#if SQLITE_THREADSAFE==0 && !defined(NDEBUG)+ /* EVIDENCE-OF: R-12970-05880 SQLite will not use more than one scratch+ ** buffers per thread.+ **+ ** This can only be checked in single-threaded mode.+ */+ assert( scratchAllocOut==0 );+ if( p ) scratchAllocOut++;+#endif++ return p;+}+SQLITE_PRIVATE void sqlite3ScratchFree(void *p){+ if( p ){++#if SQLITE_THREADSAFE==0 && !defined(NDEBUG)+ /* Verify that no more than two scratch allocation per thread+ ** is outstanding at one time. (This is only checked in the+ ** single-threaded case since checking in the multi-threaded case+ ** would be much more complicated.) */+ assert( scratchAllocOut>=1 && scratchAllocOut<=2 );+ scratchAllocOut--;+#endif++ if( p>=sqlite3GlobalConfig.pScratch && p<mem0.pScratchEnd ){+ /* Release memory from the SQLITE_CONFIG_SCRATCH allocation */+ ScratchFreeslot *pSlot;+ pSlot = (ScratchFreeslot*)p;+ sqlite3_mutex_enter(mem0.mutex);+ pSlot->pNext = mem0.pScratchFree;+ mem0.pScratchFree = pSlot;+ mem0.nScratchFree++;+ assert( mem0.nScratchFree <= (u32)sqlite3GlobalConfig.nScratch );+ sqlite3StatusDown(SQLITE_STATUS_SCRATCH_USED, 1);+ sqlite3_mutex_leave(mem0.mutex);+ }else{+ /* Release memory back to the heap */+ assert( sqlite3MemdebugHasType(p, MEMTYPE_SCRATCH) );+ assert( sqlite3MemdebugNoType(p, (u8)~MEMTYPE_SCRATCH) );+ sqlite3MemdebugSetType(p, MEMTYPE_HEAP);+ if( sqlite3GlobalConfig.bMemstat ){+ int iSize = sqlite3MallocSize(p);+ sqlite3_mutex_enter(mem0.mutex);+ sqlite3StatusDown(SQLITE_STATUS_SCRATCH_OVERFLOW, iSize);+ sqlite3StatusDown(SQLITE_STATUS_MEMORY_USED, iSize);+ sqlite3StatusDown(SQLITE_STATUS_MALLOC_COUNT, 1);+ sqlite3GlobalConfig.m.xFree(p);+ sqlite3_mutex_leave(mem0.mutex);+ }else{+ sqlite3GlobalConfig.m.xFree(p);+ }+ }+ }+}++/*+** Return the size of a memory allocation previously obtained from+** sqlite3Malloc() or sqlite3_malloc().+*/+SQLITE_PRIVATE int sqlite3MallocSize(void *p){+ assert( sqlite3MemdebugHasType(p, MEMTYPE_HEAP) );+ return sqlite3GlobalConfig.m.xSize(p);+}+SQLITE_PRIVATE int sqlite3DbMallocSize(Btree *pBtree, void *p){+ if( pBtree==0 ){+#if SQLITE_DEBUG+ assert( sqlite3MemdebugNoType(p, (u8)~MEMTYPE_HEAP) );+ assert( sqlite3MemdebugHasType(p, MEMTYPE_HEAP) );+#endif+ return sqlite3GlobalConfig.m.xSize(p);+ }else{+ assert( sqlite3_mutex_held(pBtree->mutex) );+ return 0;+ }+}++/*+** Free memory previously obtained from sqlite3Malloc().+*/+SQLITE_PRIVATE void sqlite3_free(void *p){+ if( p==0 ) return; /* IMP: R-49053-54554 */+ assert( sqlite3MemdebugHasType(p, MEMTYPE_HEAP) );+ assert( sqlite3MemdebugNoType(p, (u8)~MEMTYPE_HEAP) );+ if( sqlite3GlobalConfig.bMemstat ){+ sqlite3_mutex_enter(mem0.mutex);+ sqlite3StatusDown(SQLITE_STATUS_MEMORY_USED, sqlite3MallocSize(p));+ sqlite3StatusDown(SQLITE_STATUS_MALLOC_COUNT, 1);+ sqlite3GlobalConfig.m.xFree(p);+ sqlite3_mutex_leave(mem0.mutex);+ }else{+ sqlite3GlobalConfig.m.xFree(p);+ }+}++/*+** Add the size of memory allocation "p" to the count in+** *db->pnBytesFreed.+*/+static SQLITE_NOINLINE void measureAllocationSize(Btree *pBtree, void *p){+ *pBtree->pnBytesFreed += sqlite3DbMallocSize(pBtree,p);+}++/*+** Free memory that might be associated with a particular database+** connection.+*/+SQLITE_PRIVATE void sqlite3DbFree(Btree *pBtree, void *p){+ assert( pBTree==0 || sqlite3_mutex_held(pTree->mutex) );+ if( p==0 ) return;+ if( pBtree ){+ if( pBtree->pnBytesFreed ){+ measureAllocationSize(pBtree, p);+ return;+ }+ }+ assert( sqlite3MemdebugHasType(p, (MEMTYPE_LOOKASIDE|MEMTYPE_HEAP)) );+ assert( sqlite3MemdebugNoType(p, (u8)~(MEMTYPE_LOOKASIDE|MEMTYPE_HEAP)) );+ assert( pBtree!=0 || sqlite3MemdebugNoType(p, MEMTYPE_LOOKASIDE) );+ sqlite3MemdebugSetType(p, MEMTYPE_HEAP);+ sqlite3_free(p);+}++/*+** Change the size of an existing memory allocation+*/+SQLITE_PRIVATE void *sqlite3Realloc(void *pOld, u64 nBytes){+ int nOld, nNew, nDiff;+ void *pNew;+ assert( sqlite3MemdebugHasType(pOld, MEMTYPE_HEAP) );+ assert( sqlite3MemdebugNoType(pOld, (u8)~MEMTYPE_HEAP) );+ if( pOld==0 ){+ return sqlite3Malloc(nBytes); /* IMP: R-04300-56712 */+ }+ if( nBytes==0 ){+ sqlite3_free(pOld); /* IMP: R-26507-47431 */+ return 0;+ }+ if( nBytes>=0x7fffff00 ){+ /* The 0x7ffff00 limit term is explained in comments on sqlite3Malloc() */+ return 0;+ }+ nOld = sqlite3MallocSize(pOld);+ /* IMPLEMENTATION-OF: R-46199-30249 SQLite guarantees that the second+ ** argument to xRealloc is always a value returned by a prior call to+ ** xRoundup. */+ nNew = sqlite3GlobalConfig.m.xRoundup((int)nBytes);+ if( nOld==nNew ){+ pNew = pOld;+ }else if( sqlite3GlobalConfig.bMemstat ){+ sqlite3_mutex_enter(mem0.mutex);+ sqlite3StatusSet(SQLITE_STATUS_MALLOC_SIZE, (int)nBytes);+ nDiff = nNew - nOld;+ if( sqlite3StatusValue(SQLITE_STATUS_MEMORY_USED) >= + mem0.alarmThreshold-nDiff ){+ sqlite3MallocAlarm(nDiff);+ }+ pNew = sqlite3GlobalConfig.m.xRealloc(pOld, nNew);+ if( pNew==0 && mem0.alarmThreshold>0 ){+ sqlite3MallocAlarm((int)nBytes);+ pNew = sqlite3GlobalConfig.m.xRealloc(pOld, nNew);+ }+ if( pNew ){+ nNew = sqlite3MallocSize(pNew);+ sqlite3StatusUp(SQLITE_STATUS_MEMORY_USED, nNew-nOld);+ }+ sqlite3_mutex_leave(mem0.mutex);+ }else{+ pNew = sqlite3GlobalConfig.m.xRealloc(pOld, nNew);+ }+ assert( EIGHT_BYTE_ALIGNMENT(pNew) ); /* IMP: R-11148-40995 */+ return pNew;+}++/*+** The public interface to sqlite3Realloc. Make sure that the memory+** subsystem is initialized prior to invoking sqliteRealloc.+*/+SQLITE_PRIVATE void *sqlite3_realloc(void *pOld, int n){+#ifndef SQLITE_OMIT_AUTOINIT+ if( sqlite3BtreeInitialize() ) return 0;+#endif+ if( n<0 ) n = 0; /* IMP: R-26507-47431 */+ return sqlite3Realloc(pOld, n);+}+SQLITE_PRIVATE void *sqlite3_realloc64(void *pOld, sqlite3_uint64 n){+#ifndef SQLITE_OMIT_AUTOINIT+ if( sqlite3BtreeInitialize() ) return 0;+#endif+ return sqlite3Realloc(pOld, n);+}+++/*+** Allocate and zero memory.+*/ +SQLITE_PRIVATE void *sqlite3MallocZero(u64 n){+ void *p = sqlite3Malloc(n);+ if( p ){+ memset(p, 0, (size_t)n);+ }+ return p;+}++/*+** Allocate and zero memory. If the allocation fails, make+** the mallocFailed flag in the connection pointer.+*/+SQLITE_PRIVATE void *sqlite3DbMallocZero(Btree *pBtree, u64 n){+ void *p = sqlite3DbMallocRaw(pBtree, n);+ if( p ){+ memset(p, 0, (size_t)n);+ }+ return p;+}++/*+** Allocate and zero memory. If the allocation fails, make+** the mallocFailed flag in the connection pointer.+**+** If pBtree!=0 and pBtree->mallocFailed is true (indicating a prior malloc+** failure on the same database connection) then always return 0.+** Hence for a particular database connection, once malloc starts+** failing, it fails consistently until mallocFailed is reset.+** This is an important assumption. There are many places in the+** code that do things like this:+**+** int *a = (int*)sqlite3DbMallocRaw(pBtree, 100);+** int *b = (int*)sqlite3DbMallocRaw(pBtree, 200);+** if( b ) a[10] = 9;+**+** In other words, if a subsequent malloc (ex: "b") worked, it is assumed+** that all prior mallocs (ex: "a") worked too.+*/+SQLITE_PRIVATE void *sqlite3DbMallocRaw(Btree *pBtree, u64 n){+ void *p;+ assert( pBtree==0 || sqlite3_mutex_held(pBtree->mutex) );+ assert( pBtree==0 || pBtree->pnBytesFreed==0 );+ if( pBtree && pBtree->mallocFailed ){+ return 0;+ }+ p = sqlite3Malloc(n);+ if( !p && pBtree ){+ pBtree->mallocFailed = 1;+ }+ sqlite3MemdebugSetType(p, MEMTYPE_HEAP);+ return p;+}++/*+** Resize the block of memory pointed to by p to n bytes. If the+** resize fails, set the mallocFailed flag in the connection object.+*/+SQLITE_PRIVATE void *sqlite3DbRealloc(Btree *pBtree, void *p, u64 n){+ void *pNew = 0;+ assert( pBtree!=0 );+ assert( sqlite3_mutex_held(pBtree->mutex) );+ if( pBtree->mallocFailed==0 ){+ if( p==0 ){+ return sqlite3DbMallocRaw(pBtree, n);+ }+ assert( sqlite3MemdebugHasType(p, (MEMTYPE_LOOKASIDE|MEMTYPE_HEAP)) );+ assert( sqlite3MemdebugNoType(p, (u8)~(MEMTYPE_LOOKASIDE|MEMTYPE_HEAP)) );+ sqlite3MemdebugSetType(p, MEMTYPE_HEAP);+ pNew = sqlite3_realloc64(p, n);+ if( !pNew ){+ pBtree->mallocFailed = 1;+ }+ sqlite3MemdebugSetType(pNew, MEMTYPE_HEAP);+ }+ return pNew;+}++/*+** Attempt to reallocate p. If the reallocation fails, then free p+** and set the mallocFailed flag in the database connection.+*/+SQLITE_PRIVATE void *sqlite3DbReallocOrFree(Btree *pBtree, void *p, u64 n){+ void *pNew;+ pNew = sqlite3DbRealloc(pBtree, p, n);+ if( !pNew ){+ sqlite3DbFree(pBtree, p);+ }+ return pNew;+}++/*+** Make a copy of a string in memory obtained from sqliteMalloc(). These +** functions call sqlite3MallocRaw() directly instead of sqliteMalloc(). This+** is because when memory debugging is turned on, these two functions are +** called via macros that record the current file and line number in the+** ThreadData structure.+*/+char *sqlite3DbStrDup(Btree *pBtree, const char *z){+ char *zNew;+ size_t n;+ if( z==0 ){+ return 0;+ }+ n = sqlite3Strlen30(z) + 1;+ assert( (n&0x7fffffff)==n );+ zNew = sqlite3DbMallocRaw(pBtree, (int)n);+ if( zNew ){+ memcpy(zNew, z, n);+ }+ return zNew;+}++/************** End of malloc.c **********************************************/+/************** Begin file printf.c ******************************************/+/*+** The "printf" code that follows dates from the 1980's. It is in+** the public domain. +**+**************************************************************************+**+** This file contains code for a set of "printf"-like routines. These+** routines format strings much like the printf() from the standard C+** library, though the implementation here has enhancements to support+** SQLite.+*/+/* #include "sqliteInt.h" */++/*+** Conversion types fall into various categories as defined by the+** following enumeration.+*/+#define etRADIX 1 /* Integer types. %d, %x, %o, and so forth */+#define etFLOAT 2 /* Floating point. %f */+#define etEXP 3 /* Exponentional notation. %e and %E */+#define etGENERIC 4 /* Floating or exponential, depending on exponent. %g */+#define etSIZE 5 /* Return number of characters processed so far. %n */+#define etSTRING 6 /* Strings. %s */+#define etDYNSTRING 7 /* Dynamically allocated strings. %z */+#define etPERCENT 8 /* Percent symbol. %% */+#define etCHARX 9 /* Characters. %c */+/* The rest are extensions, not normally found in printf() */+#define etSQLESCAPE 10 /* Strings with '\'' doubled. %q */+#define etSQLESCAPE2 11 /* Strings with '\'' doubled and enclosed in '',+ NULL pointers replaced by SQL NULL. %Q */+#define etPOINTER 14 /* The %p conversion */+#define etSQLESCAPE3 15 /* %w -> Strings with '\"' doubled */+#define etORDINAL 16 /* %r -> 1st, 2nd, 3rd, 4th, etc. English only */++#define etINVALID 0 /* Any unrecognized conversion type */+++/*+** An "etByte" is an 8-bit unsigned value.+*/+typedef unsigned char etByte;++/*+** Each builtin conversion character (ex: the 'd' in "%d") is described+** by an instance of the following structure+*/+typedef struct et_info { /* Information about each format field */+ char fmttype; /* The format field code letter */+ etByte base; /* The base for radix conversion */+ etByte flags; /* One or more of FLAG_ constants below */+ etByte type; /* Conversion paradigm */+ etByte charset; /* Offset into aDigits[] of the digits string */+ etByte prefix; /* Offset into aPrefix[] of the prefix string */+} et_info;++/*+** Allowed values for et_info.flags+*/+#define FLAG_SIGNED 1 /* True if the value to convert is signed */+#define FLAG_INTERN 2 /* True if for internal use only */+#define FLAG_STRING 4 /* Allow infinity precision */+++/*+** The following table is searched linearly, so it is good to put the+** most frequently used conversion types first.+*/+static const char aDigits[] = "0123456789ABCDEF0123456789abcdef";+static const char aPrefix[] = "-x0\000X0";+static const et_info fmtinfo[] = {+ { 'd', 10, 1, etRADIX, 0, 0 },+ { 's', 0, 4, etSTRING, 0, 0 },+ { 'g', 0, 1, etGENERIC, 30, 0 },+ { 'z', 0, 4, etDYNSTRING, 0, 0 },+ { 'q', 0, 4, etSQLESCAPE, 0, 0 },+ { 'Q', 0, 4, etSQLESCAPE2, 0, 0 },+ { 'w', 0, 4, etSQLESCAPE3, 0, 0 },+ { 'c', 0, 0, etCHARX, 0, 0 },+ { 'o', 8, 0, etRADIX, 0, 2 },+ { 'u', 10, 0, etRADIX, 0, 0 },+ { 'x', 16, 0, etRADIX, 16, 1 },+ { 'X', 16, 0, etRADIX, 0, 4 },+#ifndef SQLITE_OMIT_FLOATING_POINT+ { 'f', 0, 1, etFLOAT, 0, 0 },+ { 'e', 0, 1, etEXP, 30, 0 },+ { 'E', 0, 1, etEXP, 14, 0 },+ { 'G', 0, 1, etGENERIC, 14, 0 },+#endif+ { 'i', 10, 1, etRADIX, 0, 0 },+ { 'n', 0, 0, etSIZE, 0, 0 },+ { '%', 0, 0, etPERCENT, 0, 0 },+ { 'p', 16, 0, etPOINTER, 0, 1 },++/* All the rest have the FLAG_INTERN bit set and are thus for internal+** use only */+ { 'r', 10, 3, etORDINAL, 0, 0 },+};++/*+** If SQLITE_OMIT_FLOATING_POINT is defined, then none of the floating point+** conversions will work.+*/+#ifndef SQLITE_OMIT_FLOATING_POINT+/*+** "*val" is a double such that 0.1 <= *val < 10.0+** Return the ascii code for the leading digit of *val, then+** multiply "*val" by 10.0 to renormalize.+**+** Example:+** input: *val = 3.14159+** output: *val = 1.4159 function return = '3'+**+** The counter *cnt is incremented each time. After counter exceeds+** 16 (the number of significant digits in a 64-bit float) '0' is+** always returned.+*/+static char et_getdigit(LONGDOUBLE_TYPE *val, int *cnt){+ int digit;+ LONGDOUBLE_TYPE d;+ if( (*cnt)<=0 ) return '0';+ (*cnt)--;+ digit = (int)*val;+ d = digit;+ digit += '0';+ *val = (*val - d)*10.0;+ return (char)digit;+}+#endif /* SQLITE_OMIT_FLOATING_POINT */++/*+** Set the StrAccum object to an error mode.+*/+static void setStrAccumError(StrAccum *p, u8 eError){+ assert( eError==STRACCUM_NOMEM || eError==STRACCUM_TOOBIG );+ p->accError = eError;+ p->nAlloc = 0;+}++/*+** Extra argument values from a PrintfArguments object+*/+static sqlite3_int64 getIntArg(PrintfArguments *p){+ if( p->nArg<=p->nUsed ) return 0;+ return sqlite3VdbeIntValue((Mem*)p->apArg[p->nUsed++]);+}+static double getDoubleArg(PrintfArguments *p){+ if( p->nArg<=p->nUsed ) return 0.0;+ return sqlite3VdbeRealValue((Mem*)p->apArg[p->nUsed++]);+}+static char *getTextArg(PrintfArguments *p){+ if( p->nArg<=p->nUsed ) return 0;+ return (char*)sqlite3ValueText(p->apArg[p->nUsed++], SQLITE_UTF8);+}+++/*+** On machines with a small stack size, you can redefine the+** SQLITE_PRINT_BUF_SIZE to be something smaller, if desired.+*/+#ifndef SQLITE_PRINT_BUF_SIZE+# define SQLITE_PRINT_BUF_SIZE 70+#endif+#define etBUFSIZE SQLITE_PRINT_BUF_SIZE /* Size of the output buffer */++/*+** Render a string given by "fmt" into the StrAccum object.+*/+SQLITE_PRIVATE void sqlite3VXPrintf(+ StrAccum *pAccum, /* Accumulate results here */+ u32 bFlags, /* SQLITE_PRINTF_* flags */+ const char *fmt, /* Format string */+ va_list ap /* arguments */+){+ int c; /* Next character in the format string */+ char *bufpt; /* Pointer to the conversion buffer */+ int precision; /* Precision of the current field */+ int length; /* Length of the field */+ int idx; /* A general purpose loop counter */+ int width; /* Width of the current field */+ etByte flag_leftjustify; /* True if "-" flag is present */+ etByte flag_plussign; /* True if "+" flag is present */+ etByte flag_blanksign; /* True if " " flag is present */+ etByte flag_alternateform; /* True if "#" flag is present */+ etByte flag_altform2; /* True if "!" flag is present */+ etByte flag_zeropad; /* True if field width constant starts with zero */+ etByte flag_long; /* True if "l" flag is present */+ etByte flag_longlong; /* True if the "ll" flag is present */+ etByte done; /* Loop termination flag */+ etByte xtype = 0; /* Conversion paradigm */+ u8 bArgList; /* True for SQLITE_PRINTF_SQLFUNC */+ u8 useIntern; /* Ok to use internal conversions (ex: %T) */+ char prefix; /* Prefix character. "+" or "-" or " " or '\0'. */+ sqlite_uint64 longvalue; /* Value for integer types */+ LONGDOUBLE_TYPE realvalue; /* Value for real types */+ const et_info *infop; /* Pointer to the appropriate info structure */+ char *zOut; /* Rendering buffer */+ int nOut; /* Size of the rendering buffer */+ char *zExtra = 0; /* Malloced memory used by some conversion */+#ifndef SQLITE_OMIT_FLOATING_POINT+ int exp, e2; /* exponent of real numbers */+ int nsd; /* Number of significant digits returned */+ double rounder; /* Used for rounding floating point values */+ etByte flag_dp; /* True if decimal point should be shown */+ etByte flag_rtz; /* True if trailing zeros should be removed */+#endif+ PrintfArguments *pArgList = 0; /* Arguments for SQLITE_PRINTF_SQLFUNC */+ char buf[etBUFSIZE]; /* Conversion buffer */++ bufpt = 0;+ if( bFlags ){+ if( (bArgList = (bFlags & SQLITE_PRINTF_SQLFUNC))!=0 ){+ pArgList = va_arg(ap, PrintfArguments*);+ }+ useIntern = bFlags & SQLITE_PRINTF_INTERNAL;+ }else{+ bArgList = useIntern = 0;+ }+ for(; (c=(*fmt))!=0; ++fmt){+ if( c!='%' ){+ bufpt = (char *)fmt;+#if HAVE_STRCHRNUL+ fmt = strchrnul(fmt, '%');+#else+ do{ fmt++; }while( *fmt && *fmt != '%' );+#endif+ sqlite3StrAccumAppend(pAccum, bufpt, (int)(fmt - bufpt));+ if( *fmt==0 ) break;+ }+ if( (c=(*++fmt))==0 ){+ sqlite3StrAccumAppend(pAccum, "%", 1);+ break;+ }+ /* Find out what flags are present */+ flag_leftjustify = flag_plussign = flag_blanksign = + flag_alternateform = flag_altform2 = flag_zeropad = 0;+ done = 0;+ do{+ switch( c ){+ case '-': flag_leftjustify = 1; break;+ case '+': flag_plussign = 1; break;+ case ' ': flag_blanksign = 1; break;+ case '#': flag_alternateform = 1; break;+ case '!': flag_altform2 = 1; break;+ case '0': flag_zeropad = 1; break;+ default: done = 1; break;+ }+ }while( !done && (c=(*++fmt))!=0 );+ /* Get the field width */+ if( c=='*' ){+ if( bArgList ){+ width = (int)getIntArg(pArgList);+ }else{+ width = va_arg(ap,int);+ }+ if( width<0 ){+ flag_leftjustify = 1;+ width = width >= -2147483647 ? -width : 0;+ }+ c = *++fmt;+ }else{+ unsigned wx = 0;+ while( c>='0' && c<='9' ){+ wx = wx*10 + c - '0';+ c = *++fmt;+ }+ testcase( wx>0x7fffffff );+ width = wx & 0x7fffffff;+ }++ /* Get the precision */+ if( c=='.' ){+ c = *++fmt;+ if( c=='*' ){+ if( bArgList ){+ precision = (int)getIntArg(pArgList);+ }else{+ precision = va_arg(ap,int);+ }+ c = *++fmt;+ if( precision<0 ){+ precision = precision >= -2147483647 ? -precision : -1;+ }+ }else{+ unsigned px = 0;+ while( c>='0' && c<='9' ){+ px = px*10 + c - '0';+ c = *++fmt;+ }+ testcase( px>0x7fffffff );+ precision = px & 0x7fffffff;+ }+ }else{+ precision = -1;+ }+ /* Get the conversion type modifier */+ if( c=='l' ){+ flag_long = 1;+ c = *++fmt;+ if( c=='l' ){+ flag_longlong = 1;+ c = *++fmt;+ }else{+ flag_longlong = 0;+ }+ }else{+ flag_long = flag_longlong = 0;+ }+ /* Fetch the info entry for the field */+ infop = &fmtinfo[0];+ xtype = etINVALID;+ for(idx=0; idx<ArraySize(fmtinfo); idx++){+ if( c==fmtinfo[idx].fmttype ){+ infop = &fmtinfo[idx];+ if( useIntern || (infop->flags & FLAG_INTERN)==0 ){+ xtype = infop->type;+ }else{+ return;+ }+ break;+ }+ }++ /*+ ** At this point, variables are initialized as follows:+ **+ ** flag_alternateform TRUE if a '#' is present.+ ** flag_altform2 TRUE if a '!' is present.+ ** flag_plussign TRUE if a '+' is present.+ ** flag_leftjustify TRUE if a '-' is present or if the+ ** field width was negative.+ ** flag_zeropad TRUE if the width began with 0.+ ** flag_long TRUE if the letter 'l' (ell) prefixed+ ** the conversion character.+ ** flag_longlong TRUE if the letter 'll' (ell ell) prefixed+ ** the conversion character.+ ** flag_blanksign TRUE if a ' ' is present.+ ** width The specified field width. This is+ ** always non-negative. Zero is the default.+ ** precision The specified precision. The default+ ** is -1.+ ** xtype The class of the conversion.+ ** infop Pointer to the appropriate info struct.+ */+ switch( xtype ){+ case etPOINTER:+ flag_longlong = sizeof(char*)==sizeof(i64);+ flag_long = sizeof(char*)==sizeof(long int);+ /* Fall through into the next case */+ case etORDINAL:+ case etRADIX:+ if( infop->flags & FLAG_SIGNED ){+ i64 v;+ if( bArgList ){+ v = getIntArg(pArgList);+ }else if( flag_longlong ){+ v = va_arg(ap,i64);+ }else if( flag_long ){+ v = va_arg(ap,long int);+ }else{+ v = va_arg(ap,int);+ }+ if( v<0 ){+ if( v==SMALLEST_INT64 ){+ longvalue = ((u64)1)<<63;+ }else{+ longvalue = -v;+ }+ prefix = '-';+ }else{+ longvalue = v;+ if( flag_plussign ) prefix = '+';+ else if( flag_blanksign ) prefix = ' ';+ else prefix = 0;+ }+ }else{+ if( bArgList ){+ longvalue = (u64)getIntArg(pArgList);+ }else if( flag_longlong ){+ longvalue = va_arg(ap,u64);+ }else if( flag_long ){+ longvalue = va_arg(ap,unsigned long int);+ }else{+ longvalue = va_arg(ap,unsigned int);+ }+ prefix = 0;+ }+ if( longvalue==0 ) flag_alternateform = 0;+ if( flag_zeropad && precision<width-(prefix!=0) ){+ precision = width-(prefix!=0);+ }+ if( precision<etBUFSIZE-10 ){+ nOut = etBUFSIZE;+ zOut = buf;+ }else{+ nOut = precision + 10;+ zOut = zExtra = sqlite3Malloc( nOut );+ if( zOut==0 ){+ setStrAccumError(pAccum, STRACCUM_NOMEM);+ return;+ }+ }+ bufpt = &zOut[nOut-1];+ if( xtype==etORDINAL ){+ static const char zOrd[] = "thstndrd";+ int x = (int)(longvalue % 10);+ if( x>=4 || (longvalue/10)%10==1 ){+ x = 0;+ }+ *(--bufpt) = zOrd[x*2+1];+ *(--bufpt) = zOrd[x*2];+ }+ {+ const char *cset = &aDigits[infop->charset];+ u8 base = infop->base;+ do{ /* Convert to ascii */+ *(--bufpt) = cset[longvalue%base];+ longvalue = longvalue/base;+ }while( longvalue>0 );+ }+ length = (int)(&zOut[nOut-1]-bufpt);+ for(idx=precision-length; idx>0; idx--){+ *(--bufpt) = '0'; /* Zero pad */+ }+ if( prefix ) *(--bufpt) = prefix; /* Add sign */+ if( flag_alternateform && infop->prefix ){ /* Add "0" or "0x" */+ const char *pre;+ char x;+ pre = &aPrefix[infop->prefix];+ for(; (x=(*pre))!=0; pre++) *(--bufpt) = x;+ }+ length = (int)(&zOut[nOut-1]-bufpt);+ break;+ case etFLOAT:+ case etEXP:+ case etGENERIC:+ if( bArgList ){+ realvalue = getDoubleArg(pArgList);+ }else{+ realvalue = va_arg(ap,double);+ }+#ifdef SQLITE_OMIT_FLOATING_POINT+ length = 0;+#else+ if( precision<0 ) precision = 6; /* Set default precision */+ if( realvalue<0.0 ){+ realvalue = -realvalue;+ prefix = '-';+ }else{+ if( flag_plussign ) prefix = '+';+ else if( flag_blanksign ) prefix = ' ';+ else prefix = 0;+ }+ if( xtype==etGENERIC && precision>0 ) precision--;+ testcase( precision>0xfff );+ for(idx=precision&0xfff, rounder=0.5; idx>0; idx--, rounder*=0.1){}+ if( xtype==etFLOAT ) realvalue += rounder;+ /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */+ exp = 0;+ if( sqlite3IsNaN((double)realvalue) ){+ bufpt = "NaN";+ length = 3;+ break;+ }+ if( realvalue>0.0 ){+ LONGDOUBLE_TYPE scale = 1.0;+ while( realvalue>=1e100*scale && exp<=350 ){ scale *= 1e100;exp+=100;}+ while( realvalue>=1e10*scale && exp<=350 ){ scale *= 1e10; exp+=10; }+ while( realvalue>=10.0*scale && exp<=350 ){ scale *= 10.0; exp++; }+ realvalue /= scale;+ while( realvalue<1e-8 ){ realvalue *= 1e8; exp-=8; }+ while( realvalue<1.0 ){ realvalue *= 10.0; exp--; }+ if( exp>350 ){+ bufpt = buf;+ buf[0] = prefix;+ memcpy(buf+(prefix!=0),"Inf",4);+ length = 3+(prefix!=0);+ break;+ }+ }+ bufpt = buf;+ /*+ ** If the field type is etGENERIC, then convert to either etEXP+ ** or etFLOAT, as appropriate.+ */+ if( xtype!=etFLOAT ){+ realvalue += rounder;+ if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; }+ }+ if( xtype==etGENERIC ){+ flag_rtz = !flag_alternateform;+ if( exp<-4 || exp>precision ){+ xtype = etEXP;+ }else{+ precision = precision - exp;+ xtype = etFLOAT;+ }+ }else{+ flag_rtz = flag_altform2;+ }+ if( xtype==etEXP ){+ e2 = 0;+ }else{+ e2 = exp;+ }+ if( MAX(e2,0)+(i64)precision+(i64)width > etBUFSIZE - 15 ){+ bufpt = zExtra + = sqlite3Malloc( MAX(e2,0)+(i64)precision+(i64)width+15 );+ if( bufpt==0 ){+ setStrAccumError(pAccum, STRACCUM_NOMEM);+ return;+ }+ }+ zOut = bufpt;+ nsd = 16 + flag_altform2*10;+ flag_dp = (precision>0 ?1:0) | flag_alternateform | flag_altform2;+ /* The sign in front of the number */+ if( prefix ){+ *(bufpt++) = prefix;+ }+ /* Digits prior to the decimal point */+ if( e2<0 ){+ *(bufpt++) = '0';+ }else{+ for(; e2>=0; e2--){+ *(bufpt++) = et_getdigit(&realvalue,&nsd);+ }+ }+ /* The decimal point */+ if( flag_dp ){+ *(bufpt++) = '.';+ }+ /* "0" digits after the decimal point but before the first+ ** significant digit of the number */+ for(e2++; e2<0; precision--, e2++){+ assert( precision>0 );+ *(bufpt++) = '0';+ }+ /* Significant digits after the decimal point */+ while( (precision--)>0 ){+ *(bufpt++) = et_getdigit(&realvalue,&nsd);+ }+ /* Remove trailing zeros and the "." if no digits follow the "." */+ if( flag_rtz && flag_dp ){+ while( bufpt[-1]=='0' ) *(--bufpt) = 0;+ assert( bufpt>zOut );+ if( bufpt[-1]=='.' ){+ if( flag_altform2 ){+ *(bufpt++) = '0';+ }else{+ *(--bufpt) = 0;+ }+ }+ }+ /* Add the "eNNN" suffix */+ if( xtype==etEXP ){+ *(bufpt++) = aDigits[infop->charset];+ if( exp<0 ){+ *(bufpt++) = '-'; exp = -exp;+ }else{+ *(bufpt++) = '+';+ }+ if( exp>=100 ){+ *(bufpt++) = (char)((exp/100)+'0'); /* 100's digit */+ exp %= 100;+ }+ *(bufpt++) = (char)(exp/10+'0'); /* 10's digit */+ *(bufpt++) = (char)(exp%10+'0'); /* 1's digit */+ }+ *bufpt = 0;++ /* The converted number is in buf[] and zero terminated. Output it.+ ** Note that the number is in the usual order, not reversed as with+ ** integer conversions. */+ length = (int)(bufpt-zOut);+ bufpt = zOut;++ /* Special case: Add leading zeros if the flag_zeropad flag is+ ** set and we are not left justified */+ if( flag_zeropad && !flag_leftjustify && length < width){+ int i;+ int nPad = width - length;+ for(i=width; i>=nPad; i--){+ bufpt[i] = bufpt[i-nPad];+ }+ i = prefix!=0;+ while( nPad-- ) bufpt[i++] = '0';+ length = width;+ }+#endif /* !defined(SQLITE_OMIT_FLOATING_POINT) */+ break;+ case etSIZE:+ if( !bArgList ){+ *(va_arg(ap,int*)) = pAccum->nChar;+ }+ length = width = 0;+ break;+ case etPERCENT:+ buf[0] = '%';+ bufpt = buf;+ length = 1;+ break;+ case etCHARX:+ if( bArgList ){+ bufpt = getTextArg(pArgList);+ c = bufpt ? bufpt[0] : 0;+ }else{+ c = va_arg(ap,int);+ }+ if( precision>1 ){+ width -= precision-1;+ if( width>1 && !flag_leftjustify ){+ sqlite3AppendChar(pAccum, width-1, ' ');+ width = 0;+ }+ sqlite3AppendChar(pAccum, precision-1, c);+ }+ length = 1;+ buf[0] = c;+ bufpt = buf;+ break;+ case etSTRING:+ case etDYNSTRING:+ if( bArgList ){+ bufpt = getTextArg(pArgList);+ xtype = etSTRING;+ }else{+ bufpt = va_arg(ap,char*);+ }+ if( bufpt==0 ){+ bufpt = "";+ }else if( xtype==etDYNSTRING ){+ zExtra = bufpt;+ }+ if( precision>=0 ){+ for(length=0; length<precision && bufpt[length]; length++){}+ }else{+ length = sqlite3Strlen30(bufpt);+ }+ break;+ case etSQLESCAPE: /* Escape ' characters */+ case etSQLESCAPE2: /* Escape ' and enclose in '...' */+ case etSQLESCAPE3: { /* Escape " characters */+ int i, j, k, n, isnull;+ int needQuote;+ char ch;+ char q = ((xtype==etSQLESCAPE3)?'"':'\''); /* Quote character */+ char *escarg;++ if( bArgList ){+ escarg = getTextArg(pArgList);+ }else{+ escarg = va_arg(ap,char*);+ }+ isnull = escarg==0;+ if( isnull ) escarg = (xtype==etSQLESCAPE2 ? "NULL" : "(NULL)");+ k = precision;+ for(i=n=0; k!=0 && (ch=escarg[i])!=0; i++, k--){+ if( ch==q ) n++;+ }+ needQuote = !isnull && xtype==etSQLESCAPE2;+ n += i + 3;+ if( n>etBUFSIZE ){+ bufpt = zExtra = sqlite3Malloc( n );+ if( bufpt==0 ){+ setStrAccumError(pAccum, STRACCUM_NOMEM);+ return;+ }+ }else{+ bufpt = buf;+ }+ j = 0;+ if( needQuote ) bufpt[j++] = q;+ k = i;+ for(i=0; i<k; i++){+ bufpt[j++] = ch = escarg[i];+ if( ch==q ) bufpt[j++] = ch;+ }+ if( needQuote ) bufpt[j++] = q;+ bufpt[j] = 0;+ length = j;+ /* The precision in %q and %Q means how many input characters to+ ** consume, not the length of the output...+ ** if( precision>=0 && precision<length ) length = precision; */+ break;+ }+ default: {+ assert( xtype==etINVALID );+ return;+ }+ }/* End switch over the format type */+ /*+ ** The text of the conversion is pointed to by "bufpt" and is+ ** "length" characters long. The field width is "width". Do+ ** the output.+ */+ width -= length;+ if( width>0 && !flag_leftjustify ) sqlite3AppendChar(pAccum, width, ' ');+ sqlite3StrAccumAppend(pAccum, bufpt, length);+ if( width>0 && flag_leftjustify ) sqlite3AppendChar(pAccum, width, ' ');++ if( zExtra ){+ sqlite3_free(zExtra);+ zExtra = 0;+ }+ }/* End for loop over the format string */+} /* End of function */++/*+** Enlarge the memory allocation on a StrAccum object so that it is+** able to accept at least N more bytes of text.+**+** Return the number of bytes of text that StrAccum is able to accept+** after the attempted enlargement. The value returned might be zero.+*/+static int sqlite3StrAccumEnlarge(StrAccum *p, int N){+ char *zNew;+ assert( p->nChar+(i64)N >= p->nAlloc ); /* Only called if really needed */+ if( p->accError ){+ testcase(p->accError==STRACCUM_TOOBIG);+ testcase(p->accError==STRACCUM_NOMEM);+ return 0;+ }+ if( p->mxAlloc==0 ){+ N = p->nAlloc - p->nChar - 1;+ setStrAccumError(p, STRACCUM_TOOBIG);+ return N;+ }else{+ char *zOld = (p->zText==p->zBase ? 0 : p->zText);+ i64 szNew = p->nChar;+ szNew += N + 1;+ if( szNew+p->nChar<=p->mxAlloc ){+ /* Force exponential buffer size growth as long as it does not overflow,+ ** to avoid having to call this routine too often */+ szNew += p->nChar;+ }+ if( szNew > p->mxAlloc ){+ sqlite3StrAccumReset(p);+ setStrAccumError(p, STRACCUM_TOOBIG);+ return 0;+ }else{+ p->nAlloc = (int)szNew;+ }+ if( p->pBtree ){+ zNew = sqlite3DbRealloc(p->pBtree, zOld, p->nAlloc);+ }else{+ zNew = sqlite3_realloc64(zOld, p->nAlloc);+ }+ if( zNew ){+ assert( p->zText!=0 || p->nChar==0 );+ if( zOld==0 && p->nChar>0 ) memcpy(zNew, p->zText, p->nChar);+ p->zText = zNew;+ p->nAlloc = sqlite3DbMallocSize(p->pBtree, zNew);+ }else{+ sqlite3StrAccumReset(p);+ setStrAccumError(p, STRACCUM_NOMEM);+ return 0;+ }+ }+ return N;+}++/*+** Append N copies of character c to the given string buffer.+*/+SQLITE_PRIVATE void sqlite3AppendChar(StrAccum *p, int N, char c){+ testcase( p->nChar + (i64)N > 0x7fffffff );+ if( p->nChar+(i64)N >= p->nAlloc && (N = sqlite3StrAccumEnlarge(p, N))<=0 ){+ return;+ }+ while( (N--)>0 ) p->zText[p->nChar++] = c;+}++/*+** The StrAccum "p" is not large enough to accept N new bytes of z[].+** So enlarge if first, then do the append.+**+** This is a helper routine to sqlite3StrAccumAppend() that does special-case+** work (enlarging the buffer) using tail recursion, so that the+** sqlite3StrAccumAppend() routine can use fast calling semantics.+*/+static void SQLITE_NOINLINE enlargeAndAppend(StrAccum *p, const char *z, int N){+ N = sqlite3StrAccumEnlarge(p, N);+ if( N>0 ){+ memcpy(&p->zText[p->nChar], z, N);+ p->nChar += N;+ }+}++/*+** Append N bytes of text from z to the StrAccum object. Increase the+** size of the memory allocation for StrAccum if necessary.+*/+SQLITE_PRIVATE void sqlite3StrAccumAppend(StrAccum *p, const char *z, int N){+ assert( z!=0 || N==0 );+ assert( p->zText!=0 || p->nChar==0 || p->accError );+ assert( N>=0 );+ assert( p->accError==0 || p->nAlloc==0 );+ if( p->nChar+N >= p->nAlloc ){+ enlargeAndAppend(p,z,N);+ }else{+ assert( p->zText );+ p->nChar += N;+ memcpy(&p->zText[p->nChar-N], z, N);+ }+}++/*+** Finish off a string by making sure it is zero-terminated.+** Return a pointer to the resulting string. Return a NULL+** pointer if any kind of error was encountered.+*/+SQLITE_PRIVATE char *sqlite3StrAccumFinish(StrAccum *p){+ if( p->zText ){+ p->zText[p->nChar] = 0;+ if( p->mxAlloc>0 && p->zText==p->zBase ){+ p->zText = sqlite3DbMallocRaw(p->pBtree, p->nChar+1 );+ if( p->zText ){+ memcpy(p->zText, p->zBase, p->nChar+1);+ }else{+ setStrAccumError(p, STRACCUM_NOMEM);+ }+ }+ }+ return p->zText;+}++/*+** Reset an StrAccum string. Reclaim all malloced memory.+*/+SQLITE_PRIVATE void sqlite3StrAccumReset(StrAccum *p){+ if( p->zText!=p->zBase ){+ sqlite3DbFree(p->pBtree, p->zText);+ }+ p->zText = 0;+}++/*+** Initialize a string accumulator.+**+** p: The accumulator to be initialized.+** db: Pointer to a database connection. May be NULL. Lookaside+** memory is used if not NULL. db->mallocFailed is set appropriately+** when not NULL.+** zBase: An initial buffer. May be NULL in which case the initial buffer+** is malloced.+** n: Size of zBase in bytes. If total space requirements never exceed+** n then no memory allocations ever occur.+** mx: Maximum number of bytes to accumulate. If mx==0 then no memory+** allocations will ever occur.+*/+SQLITE_PRIVATE void sqlite3StrAccumInit(StrAccum *p, Btree* pBtree, char *zBase, int n, int mx){+ p->zText = p->zBase = zBase;+ p->pBtree = pBtree;+ p->nChar = 0;+ p->nAlloc = n;+ p->mxAlloc = mx;+ p->accError = 0;+}++/*+** Print into memory obtained from sqlite3_malloc(). Omit the internal+** %-conversion extensions.+*/+SQLITE_PRIVATE char *sqlite3_vmprintf(const char *zFormat, va_list ap){+ char *z;+ char zBase[SQLITE_PRINT_BUF_SIZE];+ StrAccum acc;++#ifdef SQLITE_ENABLE_API_ARMOR + if( zFormat==0 ){+ (void)SQLITE_MISUSE_BKPT;+ return 0;+ }+#endif+#ifndef SQLITE_OMIT_AUTOINIT+ if( sqlite3BtreeInitialize() ) return 0;+#endif+ sqlite3StrAccumInit(&acc, 0, zBase, sizeof(zBase), SQLITE_MAX_LENGTH);+ sqlite3VXPrintf(&acc, 0, zFormat, ap);+ z = sqlite3StrAccumFinish(&acc);+ return z;+}++/*+** Print into memory obtained from sqlite3_malloc()(). Omit the internal+** %-conversion extensions.+*/+SQLITE_PRIVATE char *sqlite3_mprintf(const char *zFormat, ...){+ va_list ap;+ char *z;+#ifndef SQLITE_OMIT_AUTOINIT+ if( sqlite3BtreeInitialize() ) return 0;+#endif+ va_start(ap, zFormat);+ z = sqlite3_vmprintf(zFormat, ap);+ va_end(ap);+ return z;+}++/*+** sqlite3_snprintf() works like snprintf() except that it ignores the+** current locale settings. This is important for SQLite because we+** are not able to use a "," as the decimal point in place of "." as+** specified by some locales.+**+** Oops: The first two arguments of sqlite3_snprintf() are backwards+** from the snprintf() standard. Unfortunately, it is too late to change+** this without breaking compatibility, so we just have to live with the+** mistake.+**+** sqlite3_vsnprintf() is the varargs version.+*/+SQLITE_PRIVATE char *sqlite3_vsnprintf(int n, char *zBuf, const char *zFormat, va_list ap){+ StrAccum acc;+ if( n<=0 ) return zBuf;+#ifdef SQLITE_ENABLE_API_ARMOR+ if( zBuf==0 || zFormat==0 ) {+ (void)SQLITE_MISUSE_BKPT;+ if( zBuf ) zBuf[0] = 0;+ return zBuf;+ }+#endif+ sqlite3StrAccumInit(&acc, 0, zBuf, n, 0);+ sqlite3VXPrintf(&acc, 0, zFormat, ap);+ return sqlite3StrAccumFinish(&acc);+}+SQLITE_PRIVATE char *sqlite3_snprintf(int n, char *zBuf, const char *zFormat, ...){+ char *z;+ va_list ap;+ va_start(ap,zFormat);+ z = sqlite3_vsnprintf(n, zBuf, zFormat, ap);+ va_end(ap);+ return z;+}++/*+** This is the routine that actually formats the sqlite3_log() message.+** We house it in a separate routine from sqlite3_log() to avoid using+** stack space on small-stack systems when logging is disabled.+**+** sqlite3_log() must render into a static buffer. It cannot dynamically+** allocate memory because it might be called while the memory allocator+** mutex is held.+**+** sqlite3VXPrintf() might ask for *temporary* memory allocations for+** certain format characters (%q) or for very large precisions or widths.+** Care must be taken that any sqlite3_log() calls that occur while the+** memory mutex is held do not use these mechanisms.+*/+static void renderLogMsg(int iErrCode, const char *zFormat, va_list ap){+ StrAccum acc; /* String accumulator */+ char zMsg[SQLITE_PRINT_BUF_SIZE*3]; /* Complete log message */++ sqlite3StrAccumInit(&acc, 0, zMsg, sizeof(zMsg), 0);+ sqlite3VXPrintf(&acc, 0, zFormat, ap);+ sqlite3GlobalConfig.xLog(sqlite3GlobalConfig.pLogArg, iErrCode,+ sqlite3StrAccumFinish(&acc));+}++/*+** Format and write a message to the log if logging is enabled.+*/+SQLITE_PRIVATE void sqlite3_log(int iErrCode, const char *zFormat, ...){+ va_list ap; /* Vararg list */+ if( sqlite3GlobalConfig.xLog ){+ va_start(ap, zFormat);+ renderLogMsg(iErrCode, zFormat, ap);+ va_end(ap);+ }+}++#if defined(SQLITE_DEBUG) || defined(SQLITE_HAVE_OS_TRACE)+/*+** A version of printf() that understands %lld. Used for debugging.+** The printf() built into some versions of windows does not understand %lld+** and segfaults if you give it a long long int.+*/+SQLITE_PRIVATE void sqlite3DebugPrintf(const char *zFormat, ...){+ va_list ap;+ StrAccum acc;+ char zBuf[500];+ sqlite3StrAccumInit(&acc, 0, zBuf, sizeof(zBuf), 0);+ va_start(ap,zFormat);+ sqlite3VXPrintf(&acc, 0, zFormat, ap);+ va_end(ap);+ sqlite3StrAccumFinish(&acc);+ fprintf(stdout,"%s", zBuf);+ fflush(stdout);+}+#endif+++/*+** variable-argument wrapper around sqlite3VXPrintf(). The bFlags argument+** can contain the bit SQLITE_PRINTF_INTERNAL enable internal formats.+*/+SQLITE_PRIVATE void sqlite3XPrintf(StrAccum *p, u32 bFlags, const char *zFormat, ...){+ va_list ap;+ va_start(ap,zFormat);+ sqlite3VXPrintf(p, bFlags, zFormat, ap);+ va_end(ap);+}++/************** End of printf.c **********************************************/+/************** Begin file random.c ******************************************/+/*+** 2001 September 15+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file contains code to implement a pseudo-random number+** generator (PRNG) for SQLite.+**+** Random numbers are used by some of the database backends in order+** to generate random integer keys for tables or random filenames.+*/+/* #include "sqliteInt.h" */+++/* All threads share a single random number generator.+** This structure is the current state of the generator.+*/+static SQLITE_WSD struct sqlite3PrngType {+ unsigned char isInit; /* True if initialized */+ unsigned char i, j; /* State variables */+ unsigned char s[256]; /* State variables */+} sqlite3Prng;++/*+** Return N random bytes.+*/+SQLITE_PRIVATE void sqlite3_randomness(int N, void *pBuf){+ unsigned char t;+ unsigned char *zBuf = pBuf;++ /* The "wsdPrng" macro will resolve to the pseudo-random number generator+ ** state vector. If writable static data is unsupported on the target,+ ** we have to locate the state vector at run-time. In the more common+ ** case where writable static data is supported, wsdPrng can refer directly+ ** to the "sqlite3Prng" state vector declared above.+ */+#ifdef SQLITE_OMIT_WSD+ struct sqlite3PrngType *p = &GLOBAL(struct sqlite3PrngType, sqlite3Prng);+# define wsdPrng p[0]+#else+# define wsdPrng sqlite3Prng+#endif++#if SQLITE_THREADSAFE+ sqlite3_mutex *mutex;+#endif++#ifndef SQLITE_OMIT_AUTOINIT+ if( sqlite3BtreeInitialize() ) return;+#endif++#if SQLITE_THREADSAFE+ mutex = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_PRNG);+#endif++ sqlite3_mutex_enter(mutex);+ if( N<=0 || pBuf==0 ){+ wsdPrng.isInit = 0;+ sqlite3_mutex_leave(mutex);+ return;+ }++ /* Initialize the state of the random number generator once,+ ** the first time this routine is called. The seed value does+ ** not need to contain a lot of randomness since we are not+ ** trying to do secure encryption or anything like that...+ **+ ** Nothing in this file or anywhere else in SQLite does any kind of+ ** encryption. The RC4 algorithm is being used as a PRNG (pseudo-random+ ** number generator) not as an encryption device.+ */+ if( !wsdPrng.isInit ){+ int i;+ char k[256];+ wsdPrng.j = 0;+ wsdPrng.i = 0;+ sqlite3OsRandomness(sqlite3_vfs_find(0), 256, k);+ for(i=0; i<256; i++){+ wsdPrng.s[i] = (u8)i;+ }+ for(i=0; i<256; i++){+ wsdPrng.j += wsdPrng.s[i] + k[i];+ t = wsdPrng.s[wsdPrng.j];+ wsdPrng.s[wsdPrng.j] = wsdPrng.s[i];+ wsdPrng.s[i] = t;+ }+ wsdPrng.isInit = 1;+ }++ assert( N>0 );+ do{+ wsdPrng.i++;+ t = wsdPrng.s[wsdPrng.i];+ wsdPrng.j += t;+ wsdPrng.s[wsdPrng.i] = wsdPrng.s[wsdPrng.j];+ wsdPrng.s[wsdPrng.j] = t;+ t += wsdPrng.s[wsdPrng.i];+ *(zBuf++) = wsdPrng.s[t];+ }while( --N );+ sqlite3_mutex_leave(mutex);+}++/************** End of random.c **********************************************/+/************** Begin file util.c ********************************************/+/*+** 2001 September 15+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** Utility functions used throughout sqlite.+**+** This file contains functions for allocating memory, comparing+** strings, and stuff like that.+**+*/+/* #include "sqliteInt.h" */+/* #include <stdarg.h> */+#if HAVE_ISNAN || SQLITE_HAVE_ISNAN+# include <math.h>+#endif++/*+** Routine needed to support the testcase() macro.+*/+#ifdef SQLITE_COVERAGE_TEST+SQLITE_PRIVATE void sqlite3Coverage(int x){+ static unsigned dummy = 0;+ dummy += (unsigned)x;+}+#endif++#ifndef SQLITE_OMIT_FLOATING_POINT+/*+** Return true if the floating point value is Not a Number (NaN).+**+** Use the math library isnan() function if compiled with SQLITE_HAVE_ISNAN.+** Otherwise, we have our own implementation that works on most systems.+*/+SQLITE_PRIVATE int sqlite3IsNaN(double x){+ int rc; /* The value return */+#if !SQLITE_HAVE_ISNAN && !HAVE_ISNAN+ /*+ ** Systems that support the isnan() library function should probably+ ** make use of it by compiling with -DSQLITE_HAVE_ISNAN. But we have+ ** found that many systems do not have a working isnan() function so+ ** this implementation is provided as an alternative.+ **+ ** This NaN test sometimes fails if compiled on GCC with -ffast-math.+ ** On the other hand, the use of -ffast-math comes with the following+ ** warning:+ **+ ** This option [-ffast-math] should never be turned on by any+ ** -O option since it can result in incorrect output for programs+ ** which depend on an exact implementation of IEEE or ISO + ** rules/specifications for math functions.+ **+ ** Under MSVC, this NaN test may fail if compiled with a floating-+ ** point precision mode other than /fp:precise. From the MSDN + ** documentation:+ **+ ** The compiler [with /fp:precise] will properly handle comparisons + ** involving NaN. For example, x != x evaluates to true if x is NaN + ** ...+ */+#ifdef __FAST_MATH__+# error SQLite will not work correctly with the -ffast-math option of GCC.+#endif+ volatile double y = x;+ volatile double z = y;+ rc = (y!=z);+#else /* if HAVE_ISNAN */+ rc = isnan(x);+#endif /* HAVE_ISNAN */+ testcase( rc );+ return rc;+}+#endif /* SQLITE_OMIT_FLOATING_POINT */++/*+** Compute a string length that is limited to what can be stored in+** lower 30 bits of a 32-bit signed integer.+**+** The value returned will never be negative. Nor will it ever be greater+** than the actual length of the string. For very long strings (greater+** than 1GiB) the value returned might be less than the true string length.+*/+SQLITE_PRIVATE int sqlite3Strlen30(const char *z){+ if( z==0 ) return 0;+ return 0x3fffffff & (int)strlen(z);+}++/* Convenient short-hand */+#define UpperToLower sqlite3UpperToLower++int sqlite3StrICmp(const char *zLeft, const char *zRight){+ unsigned char *a, *b;+ int c;+ a = (unsigned char *)zLeft;+ b = (unsigned char *)zRight;+ for(;;){+ c = (int)UpperToLower[*a] - (int)UpperToLower[*b];+ if( c || *a==0 ) break;+ a++;+ b++;+ }+ return c;+}+/*+** The string z[] is an text representation of a real number.+** Convert this string to a double and write it into *pResult.+**+** The string z[] is length bytes in length (bytes, not characters) and+** uses the encoding enc. The string is not necessarily zero-terminated.+**+** Return TRUE if the result is a valid real number (or integer) and FALSE+** if the string is empty or contains extraneous text. Valid numbers+** are in one of these formats:+**+** [+-]digits[E[+-]digits]+** [+-]digits.[digits][E[+-]digits]+** [+-].digits[E[+-]digits]+**+** Leading and trailing whitespace is ignored for the purpose of determining+** validity.+**+** If some prefix of the input string is a valid number, this routine+** returns FALSE but it still converts the prefix and writes the result+** into *pResult.+*/+SQLITE_PRIVATE int sqlite3AtoF(const char *z, double *pResult, int length, u8 enc){+#ifndef SQLITE_OMIT_FLOATING_POINT+ int incr;+ const char *zEnd = z + length;+ /* sign * significand * (10 ^ (esign * exponent)) */+ int sign = 1; /* sign of significand */+ i64 s = 0; /* significand */+ int d = 0; /* adjust exponent for shifting decimal point */+ int esign = 1; /* sign of exponent */+ int e = 0; /* exponent */+ int eValid = 1; /* True exponent is either not used or is well-formed */+ double result;+ int nDigits = 0;+ int nonNum = 0;++ assert( enc==SQLITE_UTF8 || enc==SQLITE_UTF16LE || enc==SQLITE_UTF16BE );+ *pResult = 0.0; /* Default return value, in case of an error */++ if( enc==SQLITE_UTF8 ){+ incr = 1;+ }else{+ int i;+ incr = 2;+ assert( SQLITE_UTF16LE==2 && SQLITE_UTF16BE==3 );+ for(i=3-enc; i<length && z[i]==0; i+=2){}+ nonNum = i<length;+ zEnd = z+i+enc-3;+ z += (enc&1);+ }++ /* skip leading spaces */+ while( z<zEnd && sqlite3Isspace(*z) ) z+=incr;+ if( z>=zEnd ) return 0;++ /* get sign of significand */+ if( *z=='-' ){+ sign = -1;+ z+=incr;+ }else if( *z=='+' ){+ z+=incr;+ }++ /* skip leading zeroes */+ while( z<zEnd && z[0]=='0' ) z+=incr, nDigits++;++ /* copy max significant digits to significand */+ while( z<zEnd && sqlite3Isdigit(*z) && s<((LARGEST_INT64-9)/10) ){+ s = s*10 + (*z - '0');+ z+=incr, nDigits++;+ }++ /* skip non-significant significand digits+ ** (increase exponent by d to shift decimal left) */+ while( z<zEnd && sqlite3Isdigit(*z) ) z+=incr, nDigits++, d++;+ if( z>=zEnd ) goto do_atof_calc;++ /* if decimal point is present */+ if( *z=='.' ){+ z+=incr;+ /* copy digits from after decimal to significand+ ** (decrease exponent by d to shift decimal right) */+ while( z<zEnd && sqlite3Isdigit(*z) && s<((LARGEST_INT64-9)/10) ){+ s = s*10 + (*z - '0');+ z+=incr, nDigits++, d--;+ }+ /* skip non-significant digits */+ while( z<zEnd && sqlite3Isdigit(*z) ) z+=incr, nDigits++;+ }+ if( z>=zEnd ) goto do_atof_calc;++ /* if exponent is present */+ if( *z=='e' || *z=='E' ){+ z+=incr;+ eValid = 0;+ if( z>=zEnd ) goto do_atof_calc;+ /* get sign of exponent */+ if( *z=='-' ){+ esign = -1;+ z+=incr;+ }else if( *z=='+' ){+ z+=incr;+ }+ /* copy digits to exponent */+ while( z<zEnd && sqlite3Isdigit(*z) ){+ e = e<10000 ? (e*10 + (*z - '0')) : 10000;+ z+=incr;+ eValid = 1;+ }+ }++ /* skip trailing spaces */+ if( nDigits && eValid ){+ while( z<zEnd && sqlite3Isspace(*z) ) z+=incr;+ }++do_atof_calc:+ /* adjust exponent by d, and update sign */+ e = (e*esign) + d;+ if( e<0 ) {+ esign = -1;+ e *= -1;+ } else {+ esign = 1;+ }++ /* if 0 significand */+ if( !s ) {+ /* In the IEEE 754 standard, zero is signed.+ ** Add the sign if we've seen at least one digit */+ result = (sign<0 && nDigits) ? -(double)0 : (double)0;+ } else {+ /* attempt to reduce exponent */+ if( esign>0 ){+ while( s<(LARGEST_INT64/10) && e>0 ) e--,s*=10;+ }else{+ while( !(s%10) && e>0 ) e--,s/=10;+ }++ /* adjust the sign of significand */+ s = sign<0 ? -s : s;++ /* if exponent, scale significand as appropriate+ ** and store in result. */+ if( e ){+ LONGDOUBLE_TYPE scale = 1.0;+ /* attempt to handle extremely small/large numbers better */+ if( e>307 && e<342 ){+ while( e%308 ) { scale *= 1.0e+1; e -= 1; }+ if( esign<0 ){+ result = s / scale;+ result /= 1.0e+308;+ }else{+ result = s * scale;+ result *= 1.0e+308;+ }+ }else if( e>=342 ){+ if( esign<0 ){+ result = 0.0*s;+ }else{+ result = 1e308*1e308*s; /* Infinity */+ }+ }else{+ /* 1.0e+22 is the largest power of 10 than can be + ** represented exactly. */+ while( e%22 ) { scale *= 1.0e+1; e -= 1; }+ while( e>0 ) { scale *= 1.0e+22; e -= 22; }+ if( esign<0 ){+ result = s / scale;+ }else{+ result = s * scale;+ }+ }+ } else {+ result = (double)s;+ }+ }++ /* store the result */+ *pResult = result;++ /* return true if number and no extra non-whitespace chracters after */+ return z>=zEnd && nDigits>0 && eValid && nonNum==0;+#else+ return !sqlite3Atoi64(z, pResult, length, enc);+#endif /* SQLITE_OMIT_FLOATING_POINT */+}++/*+** Compare the 19-character string zNum against the text representation+** value 2^63: 9223372036854775808. Return negative, zero, or positive+** if zNum is less than, equal to, or greater than the string.+** Note that zNum must contain exactly 19 characters.+**+** Unlike memcmp() this routine is guaranteed to return the difference+** in the values of the last digit if the only difference is in the+** last digit. So, for example,+**+** compare2pow63("9223372036854775800", 1)+**+** will return -8.+*/+static int compare2pow63(const char *zNum, int incr){+ int c = 0;+ int i;+ /* 012345678901234567 */+ const char *pow63 = "922337203685477580";+ for(i=0; c==0 && i<18; i++){+ c = (zNum[i*incr]-pow63[i])*10;+ }+ if( c==0 ){+ c = zNum[18*incr] - '8';+ testcase( c==(-1) );+ testcase( c==0 );+ testcase( c==(+1) );+ }+ return c;+}++/*+** Convert zNum to a 64-bit signed integer. zNum must be decimal. This+** routine does *not* accept hexadecimal notation.+**+** If the zNum value is representable as a 64-bit twos-complement +** integer, then write that value into *pNum and return 0.+**+** If zNum is exactly 9223372036854775808, return 2. This special+** case is broken out because while 9223372036854775808 cannot be a +** signed 64-bit integer, its negative -9223372036854775808 can be.+**+** If zNum is too big for a 64-bit integer and is not+** 9223372036854775808 or if zNum contains any non-numeric text,+** then return 1.+**+** length is the number of bytes in the string (bytes, not characters).+** The string is not necessarily zero-terminated. The encoding is+** given by enc.+*/+SQLITE_PRIVATE int sqlite3Atoi64(const char *zNum, i64 *pNum, int length, u8 enc){+ int incr;+ u64 u = 0;+ int neg = 0; /* assume positive */+ int i;+ int c = 0;+ int nonNum = 0;+ const char *zStart;+ const char *zEnd = zNum + length;+ assert( enc==SQLITE_UTF8 || enc==SQLITE_UTF16LE || enc==SQLITE_UTF16BE );+ if( enc==SQLITE_UTF8 ){+ incr = 1;+ }else{+ incr = 2;+ assert( SQLITE_UTF16LE==2 && SQLITE_UTF16BE==3 );+ for(i=3-enc; i<length && zNum[i]==0; i+=2){}+ nonNum = i<length;+ zEnd = zNum+i+enc-3;+ zNum += (enc&1);+ }+ while( zNum<zEnd && sqlite3Isspace(*zNum) ) zNum+=incr;+ if( zNum<zEnd ){+ if( *zNum=='-' ){+ neg = 1;+ zNum+=incr;+ }else if( *zNum=='+' ){+ zNum+=incr;+ }+ }+ zStart = zNum;+ while( zNum<zEnd && zNum[0]=='0' ){ zNum+=incr; } /* Skip leading zeros. */+ for(i=0; &zNum[i]<zEnd && (c=zNum[i])>='0' && c<='9'; i+=incr){+ u = u*10 + c - '0';+ }+ if( u>LARGEST_INT64 ){+ *pNum = neg ? SMALLEST_INT64 : LARGEST_INT64;+ }else if( neg ){+ *pNum = -(i64)u;+ }else{+ *pNum = (i64)u;+ }+ testcase( i==18 );+ testcase( i==19 );+ testcase( i==20 );+ if( (c!=0 && &zNum[i]<zEnd) || (i==0 && zStart==zNum) || i>19*incr || nonNum ){+ /* zNum is empty or contains non-numeric text or is longer+ ** than 19 digits (thus guaranteeing that it is too large) */+ return 1;+ }else if( i<19*incr ){+ /* Less than 19 digits, so we know that it fits in 64 bits */+ assert( u<=LARGEST_INT64 );+ return 0;+ }else{+ /* zNum is a 19-digit numbers. Compare it against 9223372036854775808. */+ c = compare2pow63(zNum, incr);+ if( c<0 ){+ /* zNum is less than 9223372036854775808 so it fits */+ assert( u<=LARGEST_INT64 );+ return 0;+ }else if( c>0 ){+ /* zNum is greater than 9223372036854775808 so it overflows */+ return 1;+ }else{+ /* zNum is exactly 9223372036854775808. Fits if negative. The+ ** special case 2 overflow if positive */+ assert( u-1==LARGEST_INT64 );+ return neg ? 0 : 2;+ }+ }+}++/*+** The variable-length integer encoding is as follows:+**+** KEY:+** A = 0xxxxxxx 7 bits of data and one flag bit+** B = 1xxxxxxx 7 bits of data and one flag bit+** C = xxxxxxxx 8 bits of data+**+** 7 bits - A+** 14 bits - BA+** 21 bits - BBA+** 28 bits - BBBA+** 35 bits - BBBBA+** 42 bits - BBBBBA+** 49 bits - BBBBBBA+** 56 bits - BBBBBBBA+** 64 bits - BBBBBBBBC+*/++/*+** Write a 64-bit variable-length integer to memory starting at p[0].+** The length of data write will be between 1 and 9 bytes. The number+** of bytes written is returned.+**+** A variable-length integer consists of the lower 7 bits of each byte+** for all bytes that have the 8th bit set and one byte with the 8th+** bit clear. Except, if we get to the 9th byte, it stores the full+** 8 bits and is the last byte.+*/+static int SQLITE_NOINLINE putVarint64(unsigned char *p, u64 v){+ int i, j, n;+ u8 buf[10];+ if( v & (((u64)0xff000000)<<32) ){+ p[8] = (u8)v;+ v >>= 8;+ for(i=7; i>=0; i--){+ p[i] = (u8)((v & 0x7f) | 0x80);+ v >>= 7;+ }+ return 9;+ } + n = 0;+ do{+ buf[n++] = (u8)((v & 0x7f) | 0x80);+ v >>= 7;+ }while( v!=0 );+ buf[0] &= 0x7f;+ assert( n<=9 );+ for(i=0, j=n-1; j>=0; j--, i++){+ p[i] = buf[j];+ }+ return n;+}+SQLITE_API int SQLITE_STDCALL sqlite3BtreePutVarint(unsigned char *p, u64 v){+ if( v<=0x7f ){+ p[0] = v&0x7f;+ return 1;+ }+ if( v<=0x3fff ){+ p[0] = ((v>>7)&0x7f)|0x80;+ p[1] = v&0x7f;+ return 2;+ }+ return putVarint64(p,v);+}++/*+** Bitmasks used by sqlite3GetVarint(). These precomputed constants+** are defined here rather than simply putting the constant expressions+** inline in order to work around bugs in the RVT compiler.+**+** SLOT_2_0 A mask for (0x7f<<14) | 0x7f+**+** SLOT_4_2_0 A mask for (0x7f<<28) | SLOT_2_0+*/+#define SLOT_2_0 0x001fc07f+#define SLOT_4_2_0 0xf01fc07f+++/*+** Read a 64-bit variable-length integer from memory starting at p[0].+** Return the number of bytes read. The value is stored in *v.+*/+SQLITE_API u8 SQLITE_STDCALL sqlite3BtreeGetVarint(const unsigned char *p, u64 *v){+ u32 a,b,s;++ a = *p;+ /* a: p0 (unmasked) */+ if (!(a&0x80))+ {+ *v = a;+ return 1;+ }++ p++;+ b = *p;+ /* b: p1 (unmasked) */+ if (!(b&0x80))+ {+ a &= 0x7f;+ a = a<<7;+ a |= b;+ *v = a;+ return 2;+ }++ /* Verify that constants are precomputed correctly */+ assert( SLOT_2_0 == ((0x7f<<14) | (0x7f)) );+ assert( SLOT_4_2_0 == ((0xfU<<28) | (0x7f<<14) | (0x7f)) );++ p++;+ a = a<<14;+ a |= *p;+ /* a: p0<<14 | p2 (unmasked) */+ if (!(a&0x80))+ {+ a &= SLOT_2_0;+ b &= 0x7f;+ b = b<<7;+ a |= b;+ *v = a;+ return 3;+ }++ /* CSE1 from below */+ a &= SLOT_2_0;+ p++;+ b = b<<14;+ b |= *p;+ /* b: p1<<14 | p3 (unmasked) */+ if (!(b&0x80))+ {+ b &= SLOT_2_0;+ /* moved CSE1 up */+ /* a &= (0x7f<<14)|(0x7f); */+ a = a<<7;+ a |= b;+ *v = a;+ return 4;+ }++ /* a: p0<<14 | p2 (masked) */+ /* b: p1<<14 | p3 (unmasked) */+ /* 1:save off p0<<21 | p1<<14 | p2<<7 | p3 (masked) */+ /* moved CSE1 up */+ /* a &= (0x7f<<14)|(0x7f); */+ b &= SLOT_2_0;+ s = a;+ /* s: p0<<14 | p2 (masked) */++ p++;+ a = a<<14;+ a |= *p;+ /* a: p0<<28 | p2<<14 | p4 (unmasked) */+ if (!(a&0x80))+ {+ /* we can skip these cause they were (effectively) done above in calc'ing s */+ /* a &= (0x7f<<28)|(0x7f<<14)|(0x7f); */+ /* b &= (0x7f<<14)|(0x7f); */+ b = b<<7;+ a |= b;+ s = s>>18;+ *v = ((u64)s)<<32 | a;+ return 5;+ }++ /* 2:save off p0<<21 | p1<<14 | p2<<7 | p3 (masked) */+ s = s<<7;+ s |= b;+ /* s: p0<<21 | p1<<14 | p2<<7 | p3 (masked) */++ p++;+ b = b<<14;+ b |= *p;+ /* b: p1<<28 | p3<<14 | p5 (unmasked) */+ if (!(b&0x80))+ {+ /* we can skip this cause it was (effectively) done above in calc'ing s */+ /* b &= (0x7f<<28)|(0x7f<<14)|(0x7f); */+ a &= SLOT_2_0;+ a = a<<7;+ a |= b;+ s = s>>18;+ *v = ((u64)s)<<32 | a;+ return 6;+ }++ p++;+ a = a<<14;+ a |= *p;+ /* a: p2<<28 | p4<<14 | p6 (unmasked) */+ if (!(a&0x80))+ {+ a &= SLOT_4_2_0;+ b &= SLOT_2_0;+ b = b<<7;+ a |= b;+ s = s>>11;+ *v = ((u64)s)<<32 | a;+ return 7;+ }++ /* CSE2 from below */+ a &= SLOT_2_0;+ p++;+ b = b<<14;+ b |= *p;+ /* b: p3<<28 | p5<<14 | p7 (unmasked) */+ if (!(b&0x80))+ {+ b &= SLOT_4_2_0;+ /* moved CSE2 up */+ /* a &= (0x7f<<14)|(0x7f); */+ a = a<<7;+ a |= b;+ s = s>>4;+ *v = ((u64)s)<<32 | a;+ return 8;+ }++ p++;+ a = a<<15;+ a |= *p;+ /* a: p4<<29 | p6<<15 | p8 (unmasked) */++ /* moved CSE2 up */+ /* a &= (0x7f<<29)|(0x7f<<15)|(0xff); */+ b &= SLOT_2_0;+ b = b<<8;+ a |= b;++ s = s<<4;+ b = p[-4];+ b &= 0x7f;+ b = b>>3;+ s |= b;++ *v = ((u64)s)<<32 | a;++ return 9;+}++/*+** Read a 32-bit variable-length integer from memory starting at p[0].+** Return the number of bytes read. The value is stored in *v.+**+** If the varint stored in p[0] is larger than can fit in a 32-bit unsigned+** integer, then set *v to 0xffffffff.+**+** A MACRO version, getVarint32, is provided which inlines the +** single-byte case. All code should use the MACRO version as +** this function assumes the single-byte case has already been handled.+*/+SQLITE_API u8 SQLITE_STDCALL sqlite3BtreeGetVarint32(const unsigned char *p, u32 *v){+ u32 a,b;++ /* The 1-byte case. Overwhelmingly the most common. Handled inline+ ** by the getVarin32() macro */+ a = *p;+ /* a: p0 (unmasked) */+#ifndef getVarint32+ if (!(a&0x80))+ {+ /* Values between 0 and 127 */+ *v = a;+ return 1;+ }+#endif++ /* The 2-byte case */+ p++;+ b = *p;+ /* b: p1 (unmasked) */+ if (!(b&0x80))+ {+ /* Values between 128 and 16383 */+ a &= 0x7f;+ a = a<<7;+ *v = a | b;+ return 2;+ }++ /* The 3-byte case */+ p++;+ a = a<<14;+ a |= *p;+ /* a: p0<<14 | p2 (unmasked) */+ if (!(a&0x80))+ {+ /* Values between 16384 and 2097151 */+ a &= (0x7f<<14)|(0x7f);+ b &= 0x7f;+ b = b<<7;+ *v = a | b;+ return 3;+ }++ /* A 32-bit varint is used to store size information in btrees.+ ** Objects are rarely larger than 2MiB limit of a 3-byte varint.+ ** A 3-byte varint is sufficient, for example, to record the size+ ** of a 1048569-byte BLOB or string.+ **+ ** We only unroll the first 1-, 2-, and 3- byte cases. The very+ ** rare larger cases can be handled by the slower 64-bit varint+ ** routine.+ */+#if 1+ {+ u64 v64;+ u8 n;++ p -= 2;+ n = sqlite3BtreeGetVarint(p, &v64);+ assert( n>3 && n<=9 );+ if( (v64 & SQLITE_MAX_U32)!=v64 ){+ *v = 0xffffffff;+ }else{+ *v = (u32)v64;+ }+ return n;+ }++#else+ /* For following code (kept for historical record only) shows an+ ** unrolling for the 3- and 4-byte varint cases. This code is+ ** slightly faster, but it is also larger and much harder to test.+ */+ p++;+ b = b<<14;+ b |= *p;+ /* b: p1<<14 | p3 (unmasked) */+ if (!(b&0x80))+ {+ /* Values between 2097152 and 268435455 */+ b &= (0x7f<<14)|(0x7f);+ a &= (0x7f<<14)|(0x7f);+ a = a<<7;+ *v = a | b;+ return 4;+ }++ p++;+ a = a<<14;+ a |= *p;+ /* a: p0<<28 | p2<<14 | p4 (unmasked) */+ if (!(a&0x80))+ {+ /* Values between 268435456 and 34359738367 */+ a &= SLOT_4_2_0;+ b &= SLOT_4_2_0;+ b = b<<7;+ *v = a | b;+ return 5;+ }++ /* We can only reach this point when reading a corrupt database+ ** file. In that case we are not in any hurry. Use the (relatively+ ** slow) general-purpose sqlite3BtreeGetVarint() routine to extract the+ ** value. */+ {+ u64 v64;+ u8 n;++ p -= 4;+ n = sqlite3BtreeGetVarint(p, &v64);+ assert( n>5 && n<=9 );+ *v = (u32)v64;+ return n;+ }+#endif+}++/*+** Return the number of bytes that will be needed to store the given+** 64-bit integer.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeVarintLen(u64 v){+ int i;+ for(i=1; (v >>= 7)!=0; i++){ assert( i<9 ); }+ return i;+}+++/*+** Read or write a four-byte big-endian integer value.+*/+SQLITE_PRIVATE u32 sqlite3Get4byte(const u8 *p){+#if SQLITE_BYTEORDER==4321+ u32 x;+ memcpy(&x,p,4);+ return x;+#elif SQLITE_BYTEORDER==1234 && !defined(SQLITE_DISABLE_INTRINSIC) \+ && defined(__GNUC__) && GCC_VERSION>=4003000+ u32 x;+ memcpy(&x,p,4);+ return __builtin_bswap32(x);+#elif SQLITE_BYTEORDER==1234 && !defined(SQLITE_DISABLE_INTRINSIC) \+ && defined(_MSC_VER) && _MSC_VER>=1300+ u32 x;+ memcpy(&x,p,4);+ return _byteswap_ulong(x);+#else+ testcase( p[0]&0x80 );+ return ((unsigned)p[0]<<24) | (p[1]<<16) | (p[2]<<8) | p[3];+#endif+}+SQLITE_PRIVATE void sqlite3Put4byte(unsigned char *p, u32 v){+#if SQLITE_BYTEORDER==4321+ memcpy(p,&v,4);+#elif SQLITE_BYTEORDER==1234 && defined(__GNUC__) && GCC_VERSION>=4003000+ u32 x = __builtin_bswap32(v);+ memcpy(p,&x,4);+#elif SQLITE_BYTEORDER==1234 && defined(_MSC_VER) && _MSC_VER>=1300+ u32 x = _byteswap_ulong(v);+ memcpy(p,&x,4);+#else+ p[0] = (u8)(v>>24);+ p[1] = (u8)(v>>16);+ p[2] = (u8)(v>>8);+ p[3] = (u8)v;+#endif+}++/*+** Log an error that is an API call on a connection pointer that should+** not have been used. The "type" of connection pointer is given as the+** argument. The zType is a word like "NULL" or "closed" or "invalid".+*/+static void logBadConnection(const char *zType){+ sqlite3_log(SQLITE_MISUSE, + "API call with %s database connection pointer",+ zType+ );+}++SQLITE_PRIVATE int sqlite3SafetyCheckSickOrOk(Btree *pBtree){+ u32 magic;+ magic = pBtree->magic;+ if( magic!=SQLITE_MAGIC_SICK &&+ magic!=SQLITE_MAGIC_OPEN &&+ magic!=SQLITE_MAGIC_BUSY ){+ testcase( sqlite3GlobalConfig.xLog!=0 );+ logBadConnection("invalid");+ return 0;+ }else{+ return 1;+ }+}++/*+** Compute the absolute value of a 32-bit signed integer, of possible. Or +** if the integer has a value of -2147483648, return +2147483647+*/+SQLITE_PRIVATE int sqlite3AbsInt32(int x){+ if( x>=0 ) return x;+ if( x==(int)0x80000000 ) return 0x7fffffff;+ return -x;+}++/************** End of util.c ************************************************/+/************** Begin file os_unix.c *****************************************/+/*+** 2004 May 22+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains the VFS implementation for unix-like operating systems+** include Linux, MacOSX, *BSD, QNX, VxWorks, AIX, HPUX, and others.+**+** There are actually several different VFS implementations in this file.+** The differences are in the way that file locking is done. The default+** implementation uses Posix Advisory Locks. Alternative implementations+** use flock(), dot-files, various proprietary locking schemas, or simply+** skip locking all together.+**+** This source file is organized into divisions where the logic for various+** subfunctions is contained within the appropriate division. PLEASE+** KEEP THE STRUCTURE OF THIS FILE INTACT. New code should be placed+** in the correct division and should be clearly labeled.+**+** The layout of divisions is as follows:+**+** * General-purpose declarations and utility functions.+** * Unique file ID logic used by VxWorks.+** * Various locking primitive implementations (all except proxy locking):+** + for Posix Advisory Locks+** + for no-op locks+** + for dot-file locks+** + for flock() locking+** + for named semaphore locks (VxWorks only)+** + for AFP filesystem locks (MacOSX only)+** * sqlite3_file methods not associated with locking.+** * Definitions of sqlite3_io_methods objects for all locking+** methods plus "finder" functions for each locking method.+** * sqlite3_vfs method implementations.+** * Locking primitives for the proxy uber-locking-method. (MacOSX only)+** * Definitions of sqlite3_vfs objects for all locking methods+** plus implementations of sqlite3_os_init() and sqlite3_os_end().+*/+/* #include "sqliteInt.h" */+#if SQLITE_OS_UNIX /* This file is used on unix only */++/*+** There are various methods for file locking used for concurrency+** control:+**+** 1. POSIX locking (the default),+** 2. No locking,+** 3. Dot-file locking,+** 4. flock() locking,+** 5. AFP locking (OSX only),+** 6. Named POSIX semaphores (VXWorks only),+** 7. proxy locking. (OSX only)+**+** Styles 4, 5, and 7 are only available of SQLITE_ENABLE_LOCKING_STYLE+** is defined to 1. The SQLITE_ENABLE_LOCKING_STYLE also enables automatic+** selection of the appropriate locking style based on the filesystem+** where the database is located. +*/+#if !defined(SQLITE_ENABLE_LOCKING_STYLE)+# if defined(__APPLE__)+# define SQLITE_ENABLE_LOCKING_STYLE 1+# else+# define SQLITE_ENABLE_LOCKING_STYLE 0+# endif+#endif++/*+** standard include files.+*/+#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>+#include <unistd.h>+#include <time.h>+#include <sys/time.h>+#include <errno.h>+#if !defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0+# include <sys/mman.h>+#endif++#if SQLITE_ENABLE_LOCKING_STYLE+# include <sys/ioctl.h>+# include <sys/file.h>+# include <sys/param.h>+#endif /* SQLITE_ENABLE_LOCKING_STYLE */++#if defined(__APPLE__) && ((__MAC_OS_X_VERSION_MIN_REQUIRED > 1050) || \+ (__IPHONE_OS_VERSION_MIN_REQUIRED > 2000))+# if (!defined(TARGET_OS_EMBEDDED) || (TARGET_OS_EMBEDDED==0)) \+ && (!defined(TARGET_IPHONE_SIMULATOR) || (TARGET_IPHONE_SIMULATOR==0))+# define HAVE_GETHOSTUUID 1+# else+# warning "gethostuuid() is disabled."+# endif+#endif+++#if OS_VXWORKS+/* # include <sys/ioctl.h> */+# include <semaphore.h>+# include <limits.h>+#endif /* OS_VXWORKS */++#if defined(__APPLE__) || SQLITE_ENABLE_LOCKING_STYLE+# include <sys/mount.h>+#endif++#ifdef HAVE_UTIME+# include <utime.h>+#endif++/*+** Allowed values of unixFile.fsFlags+*/+#define SQLITE_FSFLAGS_IS_MSDOS 0x1++/*+** If we are to be thread-safe, include the pthreads header and define+** the SQLITE_UNIX_THREADS macro.+*/+#if SQLITE_THREADSAFE+/* # include <pthread.h> */+# define SQLITE_UNIX_THREADS 1+#endif++/*+** Default permissions when creating a new file+*/+#ifndef SQLITE_DEFAULT_FILE_PERMISSIONS+# define SQLITE_DEFAULT_FILE_PERMISSIONS 0644+#endif++/*+** Default permissions when creating auto proxy dir+*/+#ifndef SQLITE_DEFAULT_PROXYDIR_PERMISSIONS+# define SQLITE_DEFAULT_PROXYDIR_PERMISSIONS 0755+#endif++/*+** Maximum supported path-length.+*/+#define MAX_PATHNAME 512++/* Always cast the getpid() return type for compatibility with+** kernel modules in VxWorks. */+#define osGetpid(X) (pid_t)getpid()++/*+** Only set the lastErrno if the error code is a real error and not +** a normal expected return code of SQLITE_BUSY or SQLITE_OK+*/+#define IS_LOCK_ERROR(x) ((x != SQLITE_OK) && (x != SQLITE_BUSY))++/* Forward references */+typedef struct unixShm unixShm; /* Connection shared memory */+typedef struct unixShmNode unixShmNode; /* Shared memory instance */+typedef struct unixInodeInfo unixInodeInfo; /* An i-node */+typedef struct UnixUnusedFd UnixUnusedFd; /* An unused file descriptor */++/*+** Sometimes, after a file handle is closed by SQLite, the file descriptor+** cannot be closed immediately. In these cases, instances of the following+** structure are used to store the file descriptor while waiting for an+** opportunity to either close or reuse it.+*/+struct UnixUnusedFd {+ int fd; /* File descriptor to close */+ int flags; /* Flags this file descriptor was opened with */+ UnixUnusedFd *pNext; /* Next unused file descriptor on same file */+};++/*+** The unixFile structure is subclass of sqlite3_file specific to the unix+** VFS implementations.+*/+typedef struct unixFile unixFile;+struct unixFile {+ sqlite3_io_methods const *pMethod; /* Always the first entry */+ sqlite3_vfs *pVfs; /* The VFS that created this unixFile */+ unixInodeInfo *pInode; /* Info about locks on this inode */+ int h; /* The file descriptor */+ unsigned char eFileLock; /* The type of lock held on this fd */+ unsigned short int ctrlFlags; /* Behavioral bits. UNIXFILE_* flags */+ int lastErrno; /* The unix errno from last I/O error */+ void *lockingContext; /* Locking style specific state */+ UnixUnusedFd *pUnused; /* Pre-allocated UnixUnusedFd */+ const char *zPath; /* Name of the file */+ unixShm *pShm; /* Shared memory segment information */+ int szChunk; /* Configured by FCNTL_CHUNK_SIZE */+#if SQLITE_MAX_MMAP_SIZE>0+ int nFetchOut; /* Number of outstanding xFetch refs */+ sqlite3_int64 mmapSize; /* Usable size of mapping at pMapRegion */+ sqlite3_int64 mmapSizeActual; /* Actual size of mapping at pMapRegion */+ sqlite3_int64 mmapSizeMax; /* Configured FCNTL_MMAP_SIZE value */+ void *pMapRegion; /* Memory mapped region */+#endif+#ifdef __QNXNTO__+ int sectorSize; /* Device sector size */+ int deviceCharacteristics; /* Precomputed device characteristics */+#endif+#if SQLITE_ENABLE_LOCKING_STYLE+ int openFlags; /* The flags specified at open() */+#endif+#if SQLITE_ENABLE_LOCKING_STYLE || defined(__APPLE__)+ unsigned fsFlags; /* cached details from statfs() */+#endif+#if OS_VXWORKS+ struct vxworksFileId *pId; /* Unique file ID */+#endif+#ifdef SQLITE_DEBUG+ /* The next group of variables are used to track whether or not the+ ** transaction counter in bytes 24-27 of database files are updated+ ** whenever any part of the database changes. An assertion fault will+ ** occur if a file is updated without also updating the transaction+ ** counter. This test is made to avoid new problems similar to the+ ** one described by ticket #3584. + */+ unsigned char transCntrChng; /* True if the transaction counter changed */+ unsigned char dbUpdate; /* True if any part of database file changed */+ unsigned char inNormalWrite; /* True if in a normal write operation */++#endif++#ifdef SQLITE_TEST+ /* In test mode, increase the size of this structure a bit so that + ** it is larger than the struct CrashFile defined in test6.c.+ */+ char aPadding[32];+#endif+};++/* This variable holds the process id (pid) from when the xRandomness()+** method was called. If xOpen() is called from a different process id,+** indicating that a fork() has occurred, the PRNG will be reset.+*/+static pid_t randomnessPid = 0;++/*+** Allowed values for the unixFile.ctrlFlags bitmask:+*/+#define UNIXFILE_EXCL 0x01 /* Connections from one process only */+#define UNIXFILE_RDONLY 0x02 /* Connection is read only */+#define UNIXFILE_PERSIST_WAL 0x04 /* Persistent WAL mode */+#ifndef SQLITE_DISABLE_DIRSYNC+# define UNIXFILE_DIRSYNC 0x08 /* Directory sync needed */+#else+# define UNIXFILE_DIRSYNC 0x00+#endif+#define UNIXFILE_PSOW 0x10 /* SQLITE_IOCAP_POWERSAFE_OVERWRITE */+#define UNIXFILE_DELETE 0x20 /* Delete on close */+#define UNIXFILE_URI 0x40 /* Filename might have query parameters */+#define UNIXFILE_NOLOCK 0x80 /* Do no file locking */+#define UNIXFILE_WARNED 0x0100 /* verifyDbFile() warnings issued */+#define UNIXFILE_BLOCK 0x0200 /* Next SHM lock might block */++/*+** Include code that is common to all os_*.c files+*/+/************** Include os_common.h in the middle of os_unix.c ***************/+/************** Begin file os_common.h ***************************************/+/*+** 2004 May 22+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains macros and a little bit of code that is common to+** all of the platform-specific files (os_*.c) and is #included into those+** files.+**+** This file should be #included by the os_*.c files only. It is not a+** general purpose header file.+*/+#ifndef _OS_COMMON_H_+#define _OS_COMMON_H_++/*+** At least two bugs have slipped in because we changed the MEMORY_DEBUG+** macro to SQLITE_DEBUG and some older makefiles have not yet made the+** switch. The following code should catch this problem at compile-time.+*/+#ifdef MEMORY_DEBUG+# error "The MEMORY_DEBUG macro is obsolete. Use SQLITE_DEBUG instead."+#endif++/*+** Macros for performance tracing. Normally turned off. Only works+** on i486 hardware.+*/+#ifdef SQLITE_PERFORMANCE_TRACE++/* +** hwtime.h contains inline assembler code for implementing +** high-performance timing routines.+*/+/* #include "hwtime.h" */++static sqlite_uint64 g_start;+static sqlite_uint64 g_elapsed;+#define TIMER_START g_start=sqlite3Hwtime()+#define TIMER_END g_elapsed=sqlite3Hwtime()-g_start+#define TIMER_ELAPSED g_elapsed+#else+#define TIMER_START+#define TIMER_END+#define TIMER_ELAPSED ((sqlite_uint64)0)+#endif++/*+** If we compile with the SQLITE_TEST macro set, then the following block+** of code will give us the ability to simulate a disk I/O error. This+** is used for testing the I/O recovery logic.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_io_error_hit = 0; /* Total number of I/O Errors */+SQLITE_PRIVATE int sqlite3_io_error_hardhit = 0; /* Number of non-benign errors */+SQLITE_PRIVATE int sqlite3_io_error_pending = 0; /* Count down to first I/O error */+SQLITE_PRIVATE int sqlite3_io_error_persist = 0; /* True if I/O errors persist */+SQLITE_PRIVATE int sqlite3_io_error_benign = 0; /* True if errors are benign */+SQLITE_PRIVATE int sqlite3_diskfull_pending = 0;+SQLITE_PRIVATE int sqlite3_diskfull = 0;+#define SimulateIOErrorBenign(X) sqlite3_io_error_benign=(X)+#define SimulateIOError(CODE) \+ if( (sqlite3_io_error_persist && sqlite3_io_error_hit) \+ || sqlite3_io_error_pending-- == 1 ) \+ { local_ioerr(); CODE; }+static void local_ioerr(){+ IOTRACE(("IOERR\n"));+ sqlite3_io_error_hit++;+ if( !sqlite3_io_error_benign ) sqlite3_io_error_hardhit++;+}+#define SimulateDiskfullError(CODE) \+ if( sqlite3_diskfull_pending ){ \+ if( sqlite3_diskfull_pending == 1 ){ \+ local_ioerr(); \+ sqlite3_diskfull = 1; \+ sqlite3_io_error_hit = 1; \+ CODE; \+ }else{ \+ sqlite3_diskfull_pending--; \+ } \+ }+#else+#define SimulateIOErrorBenign(X)+#define SimulateIOError(A)+#define SimulateDiskfullError(A)+#endif++/*+** When testing, keep a count of the number of open files.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_open_file_count = 0;+#define OpenCounter(X) sqlite3_open_file_count+=(X)+#else+#define OpenCounter(X)+#endif++#endif /* !defined(_OS_COMMON_H_) */++/************** End of os_common.h *******************************************/+/************** Continuing where we left off in os_unix.c ********************/++/*+** Define various macros that are missing from some systems.+*/+#ifndef O_LARGEFILE+# define O_LARGEFILE 0+#endif+#ifdef SQLITE_DISABLE_LFS+# undef O_LARGEFILE+# define O_LARGEFILE 0+#endif+#ifndef O_NOFOLLOW+# define O_NOFOLLOW 0+#endif+#ifndef O_BINARY+# define O_BINARY 0+#endif++/*+** The threadid macro resolves to the thread-id or to 0. Used for+** testing and debugging only.+*/+#if SQLITE_THREADSAFE+#define threadid pthread_self()+#else+#define threadid 0+#endif++/*+** HAVE_MREMAP defaults to true on Linux and false everywhere else.+*/+#if !defined(HAVE_MREMAP)+# if defined(__linux__) && defined(_GNU_SOURCE)+# define HAVE_MREMAP 1+# else+# define HAVE_MREMAP 0+# endif+#endif++/*+** Explicitly call the 64-bit version of lseek() on Android. Otherwise, lseek()+** is the 32-bit version, even if _FILE_OFFSET_BITS=64 is defined.+*/+#ifdef __ANDROID__+# define lseek lseek64+#endif++/*+** Different Unix systems declare open() in different ways. Same use+** open(const char*,int,mode_t). Others use open(const char*,int,...).+** The difference is important when using a pointer to the function.+**+** The safest way to deal with the problem is to always use this wrapper+** which always has the same well-defined interface.+*/+static int posixOpen(const char *zFile, int flags, int mode){+ return open(zFile, flags, mode);+}++/*+** On some systems, calls to fchown() will trigger a message in a security+** log if they come from non-root processes. So avoid calling fchown() if+** we are not running as root.+*/+static int posixFchown(int fd, uid_t uid, gid_t gid){+#if OS_VXWORKS+ return 0;+#else+ return geteuid() ? 0 : fchown(fd,uid,gid);+#endif+}++/* Forward reference */+static int openDirectory(const char*, int*);+static int unixGetpagesize(void);++/*+** Many system calls are accessed through pointer-to-functions so that+** they may be overridden at runtime to facilitate fault injection during+** testing and sandboxing. The following array holds the names and pointers+** to all overrideable system calls.+*/+static struct unix_syscall {+ const char *zName; /* Name of the system call */+ sqlite3_syscall_ptr pCurrent; /* Current value of the system call */+ sqlite3_syscall_ptr pDefault; /* Default value */+} aSyscall[] = {+ { "open", (sqlite3_syscall_ptr)posixOpen, 0 },+#define osOpen ((int(*)(const char*,int,int))aSyscall[0].pCurrent)++ { "close", (sqlite3_syscall_ptr)close, 0 },+#define osClose ((int(*)(int))aSyscall[1].pCurrent)++ { "access", (sqlite3_syscall_ptr)access, 0 },+#define osAccess ((int(*)(const char*,int))aSyscall[2].pCurrent)++ { "getcwd", (sqlite3_syscall_ptr)getcwd, 0 },+#define osGetcwd ((char*(*)(char*,size_t))aSyscall[3].pCurrent)++ { "stat", (sqlite3_syscall_ptr)stat, 0 },+#define osStat ((int(*)(const char*,struct stat*))aSyscall[4].pCurrent)++/*+** The DJGPP compiler environment looks mostly like Unix, but it+** lacks the fcntl() system call. So redefine fcntl() to be something+** that always succeeds. This means that locking does not occur under+** DJGPP. But it is DOS - what did you expect?+*/+#ifdef __DJGPP__+ { "fstat", 0, 0 },+#define osFstat(a,b,c) 0+#else + { "fstat", (sqlite3_syscall_ptr)fstat, 0 },+#define osFstat ((int(*)(int,struct stat*))aSyscall[5].pCurrent)+#endif++ { "ftruncate", (sqlite3_syscall_ptr)ftruncate, 0 },+#define osFtruncate ((int(*)(int,off_t))aSyscall[6].pCurrent)++ { "fcntl", (sqlite3_syscall_ptr)fcntl, 0 },+#define osFcntl ((int(*)(int,int,...))aSyscall[7].pCurrent)++ { "read", (sqlite3_syscall_ptr)read, 0 },+#define osRead ((ssize_t(*)(int,void*,size_t))aSyscall[8].pCurrent)++#if defined(USE_PREAD) || SQLITE_ENABLE_LOCKING_STYLE+ { "pread", (sqlite3_syscall_ptr)pread, 0 },+#else+ { "pread", (sqlite3_syscall_ptr)0, 0 },+#endif+#define osPread ((ssize_t(*)(int,void*,size_t,off_t))aSyscall[9].pCurrent)++#if defined(USE_PREAD64)+ { "pread64", (sqlite3_syscall_ptr)pread64, 0 },+#else+ { "pread64", (sqlite3_syscall_ptr)0, 0 },+#endif+#define osPread64 ((ssize_t(*)(int,void*,size_t,off_t))aSyscall[10].pCurrent)++ { "write", (sqlite3_syscall_ptr)write, 0 },+#define osWrite ((ssize_t(*)(int,const void*,size_t))aSyscall[11].pCurrent)++#if defined(USE_PREAD) || SQLITE_ENABLE_LOCKING_STYLE+ { "pwrite", (sqlite3_syscall_ptr)pwrite, 0 },+#else+ { "pwrite", (sqlite3_syscall_ptr)0, 0 },+#endif+#define osPwrite ((ssize_t(*)(int,const void*,size_t,off_t))\+ aSyscall[12].pCurrent)++#if defined(USE_PREAD64)+ { "pwrite64", (sqlite3_syscall_ptr)pwrite64, 0 },+#else+ { "pwrite64", (sqlite3_syscall_ptr)0, 0 },+#endif+#define osPwrite64 ((ssize_t(*)(int,const void*,size_t,off_t))\+ aSyscall[13].pCurrent)++ { "fchmod", (sqlite3_syscall_ptr)fchmod, 0 },+#define osFchmod ((int(*)(int,mode_t))aSyscall[14].pCurrent)++#if defined(HAVE_POSIX_FALLOCATE) && HAVE_POSIX_FALLOCATE+ { "fallocate", (sqlite3_syscall_ptr)posix_fallocate, 0 },+#else+ { "fallocate", (sqlite3_syscall_ptr)0, 0 },+#endif+#define osFallocate ((int(*)(int,off_t,off_t))aSyscall[15].pCurrent)++ { "unlink", (sqlite3_syscall_ptr)unlink, 0 },+#define osUnlink ((int(*)(const char*))aSyscall[16].pCurrent)++ { "openDirectory", (sqlite3_syscall_ptr)openDirectory, 0 },+#define osOpenDirectory ((int(*)(const char*,int*))aSyscall[17].pCurrent)++ { "mkdir", (sqlite3_syscall_ptr)mkdir, 0 },+#define osMkdir ((int(*)(const char*,mode_t))aSyscall[18].pCurrent)++ { "rmdir", (sqlite3_syscall_ptr)rmdir, 0 },+#define osRmdir ((int(*)(const char*))aSyscall[19].pCurrent)++ { "fchown", (sqlite3_syscall_ptr)posixFchown, 0 },+#define osFchown ((int(*)(int,uid_t,gid_t))aSyscall[20].pCurrent)++#if !defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0+ { "mmap", (sqlite3_syscall_ptr)mmap, 0 },+#define osMmap ((void*(*)(void*,size_t,int,int,int,off_t))aSyscall[21].pCurrent)++ { "munmap", (sqlite3_syscall_ptr)munmap, 0 },+#define osMunmap ((void*(*)(void*,size_t))aSyscall[22].pCurrent)++#if HAVE_MREMAP+ { "mremap", (sqlite3_syscall_ptr)mremap, 0 },+#else+ { "mremap", (sqlite3_syscall_ptr)0, 0 },+#endif+#define osMremap ((void*(*)(void*,size_t,size_t,int,...))aSyscall[23].pCurrent)+ { "getpagesize", (sqlite3_syscall_ptr)unixGetpagesize, 0 },+#define osGetpagesize ((int(*)(void))aSyscall[24].pCurrent)++#endif++}; /* End of the overrideable system calls */++/*+** This is the xSetSystemCall() method of sqlite3_vfs for all of the+** "unix" VFSes. Return SQLITE_OK opon successfully updating the+** system call pointer, or SQLITE_NOTFOUND if there is no configurable+** system call named zName.+*/+static int unixSetSystemCall(+ sqlite3_vfs *pNotUsed, /* The VFS pointer. Not used */+ const char *zName, /* Name of system call to override */+ sqlite3_syscall_ptr pNewFunc /* Pointer to new system call value */+){+ unsigned int i;+ int rc = SQLITE_NOTFOUND;++ UNUSED_PARAMETER(pNotUsed);+ if( zName==0 ){+ /* If no zName is given, restore all system calls to their default+ ** settings and return NULL+ */+ rc = SQLITE_OK;+ for(i=0; i<sizeof(aSyscall)/sizeof(aSyscall[0]); i++){+ if( aSyscall[i].pDefault ){+ aSyscall[i].pCurrent = aSyscall[i].pDefault;+ }+ }+ }else{+ /* If zName is specified, operate on only the one system call+ ** specified.+ */+ for(i=0; i<sizeof(aSyscall)/sizeof(aSyscall[0]); i++){+ if( strcmp(zName, aSyscall[i].zName)==0 ){+ if( aSyscall[i].pDefault==0 ){+ aSyscall[i].pDefault = aSyscall[i].pCurrent;+ }+ rc = SQLITE_OK;+ if( pNewFunc==0 ) pNewFunc = aSyscall[i].pDefault;+ aSyscall[i].pCurrent = pNewFunc;+ break;+ }+ }+ }+ return rc;+}++/*+** Return the value of a system call. Return NULL if zName is not a+** recognized system call name. NULL is also returned if the system call+** is currently undefined.+*/+static sqlite3_syscall_ptr unixGetSystemCall(+ sqlite3_vfs *pNotUsed,+ const char *zName+){+ unsigned int i;++ UNUSED_PARAMETER(pNotUsed);+ for(i=0; i<sizeof(aSyscall)/sizeof(aSyscall[0]); i++){+ if( strcmp(zName, aSyscall[i].zName)==0 ) return aSyscall[i].pCurrent;+ }+ return 0;+}++/*+** Return the name of the first system call after zName. If zName==NULL+** then return the name of the first system call. Return NULL if zName+** is the last system call or if zName is not the name of a valid+** system call.+*/+static const char *unixNextSystemCall(sqlite3_vfs *p, const char *zName){+ int i = -1;++ UNUSED_PARAMETER(p);+ if( zName ){+ for(i=0; i<ArraySize(aSyscall)-1; i++){+ if( strcmp(zName, aSyscall[i].zName)==0 ) break;+ }+ }+ for(i++; i<ArraySize(aSyscall); i++){+ if( aSyscall[i].pCurrent!=0 ) return aSyscall[i].zName;+ }+ return 0;+}++/*+** Do not accept any file descriptor less than this value, in order to avoid+** opening database file using file descriptors that are commonly used for +** standard input, output, and error.+*/+#ifndef SQLITE_MINIMUM_FILE_DESCRIPTOR+# define SQLITE_MINIMUM_FILE_DESCRIPTOR 3+#endif++/*+** Invoke open(). Do so multiple times, until it either succeeds or+** fails for some reason other than EINTR.+**+** If the file creation mode "m" is 0 then set it to the default for+** SQLite. The default is SQLITE_DEFAULT_FILE_PERMISSIONS (normally+** 0644) as modified by the system umask. If m is not 0, then+** make the file creation mode be exactly m ignoring the umask.+**+** The m parameter will be non-zero only when creating -wal, -journal,+** and -shm files. We want those files to have *exactly* the same+** permissions as their original database, unadulterated by the umask.+** In that way, if a database file is -rw-rw-rw or -rw-rw-r-, and a+** transaction crashes and leaves behind hot journals, then any+** process that is able to write to the database will also be able to+** recover the hot journals.+*/+static int robust_open(const char *z, int f, mode_t m){+ int fd;+ mode_t m2 = m ? m : SQLITE_DEFAULT_FILE_PERMISSIONS;+ while(1){+#if defined(O_CLOEXEC)+ fd = osOpen(z,f|O_CLOEXEC,m2);+#else+ fd = osOpen(z,f,m2);+#endif+ if( fd<0 ){+ if( errno==EINTR ) continue;+ break;+ }+ if( fd>=SQLITE_MINIMUM_FILE_DESCRIPTOR ) break;+ osClose(fd);+// sqlite3_log(SQLITE_WARNING, +// "attempt to open \"%s\" as file descriptor %d", z, fd);+ fd = -1;+ if( osOpen("/dev/null", f, m)<0 ) break;+ }+ if( fd>=0 ){+ if( m!=0 ){+ struct stat statbuf;+ if( osFstat(fd, &statbuf)==0 + && statbuf.st_size==0+ && (statbuf.st_mode&0777)!=m + ){+ osFchmod(fd, m);+ }+ }+#if defined(FD_CLOEXEC) && (!defined(O_CLOEXEC) || O_CLOEXEC==0)+ osFcntl(fd, F_SETFD, osFcntl(fd, F_GETFD, 0) | FD_CLOEXEC);+#endif+ }+ return fd;+}++/*+** Helper functions to obtain and relinquish the global mutex. The+** global mutex is used to protect the unixInodeInfo and+** vxworksFileId objects used by this file, all of which may be +** shared by multiple threads.+**+** Function unixMutexHeld() is used to assert() that the global mutex +** is held when required. This function is only used as part of assert() +** statements. e.g.+**+** unixEnterMutex()+** assert( unixMutexHeld() );+** unixEnterLeave()+*/+static void unixEnterMutex(void){+ sqlite3_mutex_enter(sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_VFS1));+}+static void unixLeaveMutex(void){+ sqlite3_mutex_leave(sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_VFS1));+}++#ifndef NDEBUG+static int unixMutexHeld(void) {+ return sqlite3_mutex_held(sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_VFS1));+}+#endif++++#ifdef SQLITE_HAVE_OS_TRACE+/*+** Helper function for printing out trace information from debugging+** binaries. This returns the string representation of the supplied+** integer lock-type.+*/+static const char *azFileLock(int eFileLock){+ switch( eFileLock ){+ case NO_LOCK: return "NONE";+ case SHARED_LOCK: return "SHARED";+ case RESERVED_LOCK: return "RESERVED";+ case PENDING_LOCK: return "PENDING";+ case EXCLUSIVE_LOCK: return "EXCLUSIVE";+ }+ return "ERROR";+}+#endif++#ifdef SQLITE_LOCK_TRACE+/*+** Print out information about all locking operations.+**+** This routine is used for troubleshooting locks on multithreaded+** platforms. Enable by compiling with the -DSQLITE_LOCK_TRACE+** command-line option on the compiler. This code is normally+** turned off.+*/+static int lockTrace(int fd, int op, struct flock *p){+ char *zOpName, *zType;+ int s;+ int savedErrno;+ if( op==F_GETLK ){+ zOpName = "GETLK";+ }else if( op==F_SETLK ){+ zOpName = "SETLK";+ }else{+ s = osFcntl(fd, op, p);+ sqlite3DebugPrintf("fcntl unknown %d %d %d\n", fd, op, s);+ return s;+ }+ if( p->l_type==F_RDLCK ){+ zType = "RDLCK";+ }else if( p->l_type==F_WRLCK ){+ zType = "WRLCK";+ }else if( p->l_type==F_UNLCK ){+ zType = "UNLCK";+ }else{+ assert( 0 );+ }+ assert( p->l_whence==SEEK_SET );+ s = osFcntl(fd, op, p);+ savedErrno = errno;+ sqlite3DebugPrintf("fcntl %d %d %s %s %d %d %d %d\n",+ threadid, fd, zOpName, zType, (int)p->l_start, (int)p->l_len,+ (int)p->l_pid, s);+ if( s==(-1) && op==F_SETLK && (p->l_type==F_RDLCK || p->l_type==F_WRLCK) ){+ struct flock l2;+ l2 = *p;+ osFcntl(fd, F_GETLK, &l2);+ if( l2.l_type==F_RDLCK ){+ zType = "RDLCK";+ }else if( l2.l_type==F_WRLCK ){+ zType = "WRLCK";+ }else if( l2.l_type==F_UNLCK ){+ zType = "UNLCK";+ }else{+ assert( 0 );+ }+ sqlite3DebugPrintf("fcntl-failure-reason: %s %d %d %d\n",+ zType, (int)l2.l_start, (int)l2.l_len, (int)l2.l_pid);+ }+ errno = savedErrno;+ return s;+}+#undef osFcntl+#define osFcntl lockTrace+#endif /* SQLITE_LOCK_TRACE */++/*+** Retry ftruncate() calls that fail due to EINTR+**+** All calls to ftruncate() within this file should be made through+** this wrapper. On the Android platform, bypassing the logic below+** could lead to a corrupt database.+*/+static int robust_ftruncate(int h, sqlite3_int64 sz){+ int rc;+#ifdef __ANDROID__+ /* On Android, ftruncate() always uses 32-bit offsets, even if + ** _FILE_OFFSET_BITS=64 is defined. This means it is unsafe to attempt to+ ** truncate a file to any size larger than 2GiB. Silently ignore any+ ** such attempts. */+ if( sz>(sqlite3_int64)0x7FFFFFFF ){+ rc = SQLITE_OK;+ }else+#endif+ do{ rc = osFtruncate(h,sz); }while( rc<0 && errno==EINTR );+ return rc;+}++/*+** This routine translates a standard POSIX errno code into something+** useful to the clients of the sqlite3 functions. Specifically, it is+** intended to translate a variety of "try again" errors into SQLITE_BUSY+** and a variety of "please close the file descriptor NOW" errors into +** SQLITE_IOERR+** +** Errors during initialization of locks, or file system support for locks,+** should handle ENOLCK, ENOTSUP, EOPNOTSUPP separately.+*/+static int sqliteErrorFromPosixError(int posixError, int sqliteIOErr) {+ switch (posixError) {+#if 0+ /* At one point this code was not commented out. In theory, this branch+ ** should never be hit, as this function should only be called after+ ** a locking-related function (i.e. fcntl()) has returned non-zero with+ ** the value of errno as the first argument. Since a system call has failed,+ ** errno should be non-zero.+ **+ ** Despite this, if errno really is zero, we still don't want to return+ ** SQLITE_OK. The system call failed, and *some* SQLite error should be+ ** propagated back to the caller. Commenting this branch out means errno==0+ ** will be handled by the "default:" case below.+ */+ case 0: + return SQLITE_OK;+#endif++ case EAGAIN:+ case ETIMEDOUT:+ case EBUSY:+ case EINTR:+ case ENOLCK: + /* random NFS retry error, unless during file system support + * introspection, in which it actually means what it says */+ return SQLITE_BUSY;+ + case EACCES: + /* EACCES is like EAGAIN during locking operations, but not any other time*/+ if( (sqliteIOErr == SQLITE_IOERR_LOCK) || + (sqliteIOErr == SQLITE_IOERR_UNLOCK) || + (sqliteIOErr == SQLITE_IOERR_RDLOCK) ||+ (sqliteIOErr == SQLITE_IOERR_CHECKRESERVEDLOCK) ){+ return SQLITE_BUSY;+ }+ /* else fall through */+ case EPERM: + return SQLITE_PERM;+ +#if EOPNOTSUPP!=ENOTSUP+ case EOPNOTSUPP: + /* something went terribly awry, unless during file system support + * introspection, in which it actually means what it says */+#endif+#ifdef ENOTSUP+ case ENOTSUP: + /* invalid fd, unless during file system support introspection, in which + * it actually means what it says */+#endif+ case EIO:+ case EBADF:+ case EINVAL:+ case ENOTCONN:+ case ENODEV:+ case ENXIO:+ case ENOENT:+#ifdef ESTALE /* ESTALE is not defined on Interix systems */+ case ESTALE:+#endif+ case ENOSYS:+ /* these should force the client to close the file and reconnect */+ + default: + return sqliteIOErr;+ }+}+++/******************************************************************************+****************** Begin Unique File ID Utility Used By VxWorks ***************+**+** On most versions of unix, we can get a unique ID for a file by concatenating+** the device number and the inode number. But this does not work on VxWorks.+** On VxWorks, a unique file id must be based on the canonical filename.+**+** A pointer to an instance of the following structure can be used as a+** unique file ID in VxWorks. Each instance of this structure contains+** a copy of the canonical filename. There is also a reference count. +** The structure is reclaimed when the number of pointers to it drops to+** zero.+**+** There are never very many files open at one time and lookups are not+** a performance-critical path, so it is sufficient to put these+** structures on a linked list.+*/+struct vxworksFileId {+ struct vxworksFileId *pNext; /* Next in a list of them all */+ int nRef; /* Number of references to this one */+ int nName; /* Length of the zCanonicalName[] string */+ char *zCanonicalName; /* Canonical filename */+};++#if OS_VXWORKS+/* +** All unique filenames are held on a linked list headed by this+** variable:+*/+static struct vxworksFileId *vxworksFileList = 0;++/*+** Simplify a filename into its canonical form+** by making the following changes:+**+** * removing any trailing and duplicate /+** * convert /./ into just /+** * convert /A/../ where A is any simple name into just /+**+** Changes are made in-place. Return the new name length.+**+** The original filename is in z[0..n-1]. Return the number of+** characters in the simplified name.+*/+static int vxworksSimplifyName(char *z, int n){+ int i, j;+ while( n>1 && z[n-1]=='/' ){ n--; }+ for(i=j=0; i<n; i++){+ if( z[i]=='/' ){+ if( z[i+1]=='/' ) continue;+ if( z[i+1]=='.' && i+2<n && z[i+2]=='/' ){+ i += 1;+ continue;+ }+ if( z[i+1]=='.' && i+3<n && z[i+2]=='.' && z[i+3]=='/' ){+ while( j>0 && z[j-1]!='/' ){ j--; }+ if( j>0 ){ j--; }+ i += 2;+ continue;+ }+ }+ z[j++] = z[i];+ }+ z[j] = 0;+ return j;+}++/*+** Find a unique file ID for the given absolute pathname. Return+** a pointer to the vxworksFileId object. This pointer is the unique+** file ID.+**+** The nRef field of the vxworksFileId object is incremented before+** the object is returned. A new vxworksFileId object is created+** and added to the global list if necessary.+**+** If a memory allocation error occurs, return NULL.+*/+static struct vxworksFileId *vxworksFindFileId(const char *zAbsoluteName){+ struct vxworksFileId *pNew; /* search key and new file ID */+ struct vxworksFileId *pCandidate; /* For looping over existing file IDs */+ int n; /* Length of zAbsoluteName string */++ assert( zAbsoluteName[0]=='/' );+ n = (int)strlen(zAbsoluteName);+ pNew = sqlite3_malloc64( sizeof(*pNew) + (n+1) );+ if( pNew==0 ) return 0;+ pNew->zCanonicalName = (char*)&pNew[1];+ memcpy(pNew->zCanonicalName, zAbsoluteName, n+1);+ n = vxworksSimplifyName(pNew->zCanonicalName, n);++ /* Search for an existing entry that matching the canonical name.+ ** If found, increment the reference count and return a pointer to+ ** the existing file ID.+ */+ unixEnterMutex();+ for(pCandidate=vxworksFileList; pCandidate; pCandidate=pCandidate->pNext){+ if( pCandidate->nName==n + && memcmp(pCandidate->zCanonicalName, pNew->zCanonicalName, n)==0+ ){+ sqlite3_free(pNew);+ pCandidate->nRef++;+ unixLeaveMutex();+ return pCandidate;+ }+ }++ /* No match was found. We will make a new file ID */+ pNew->nRef = 1;+ pNew->nName = n;+ pNew->pNext = vxworksFileList;+ vxworksFileList = pNew;+ unixLeaveMutex();+ return pNew;+}++/*+** Decrement the reference count on a vxworksFileId object. Free+** the object when the reference count reaches zero.+*/+static void vxworksReleaseFileId(struct vxworksFileId *pId){+ unixEnterMutex();+ assert( pId->nRef>0 );+ pId->nRef--;+ if( pId->nRef==0 ){+ struct vxworksFileId **pp;+ for(pp=&vxworksFileList; *pp && *pp!=pId; pp = &((*pp)->pNext)){}+ assert( *pp==pId );+ *pp = pId->pNext;+ sqlite3_free(pId);+ }+ unixLeaveMutex();+}+#endif /* OS_VXWORKS */+/*************** End of Unique File ID Utility Used By VxWorks ****************+******************************************************************************/+++/******************************************************************************+*************************** Posix Advisory Locking ****************************+**+** POSIX advisory locks are broken by design. ANSI STD 1003.1 (1996)+** section 6.5.2.2 lines 483 through 490 specify that when a process+** sets or clears a lock, that operation overrides any prior locks set+** by the same process. It does not explicitly say so, but this implies+** that it overrides locks set by the same process using a different+** file descriptor. Consider this test case:+**+** int fd1 = open("./file1", O_RDWR|O_CREAT, 0644);+** int fd2 = open("./file2", O_RDWR|O_CREAT, 0644);+**+** Suppose ./file1 and ./file2 are really the same file (because+** one is a hard or symbolic link to the other) then if you set+** an exclusive lock on fd1, then try to get an exclusive lock+** on fd2, it works. I would have expected the second lock to+** fail since there was already a lock on the file due to fd1.+** But not so. Since both locks came from the same process, the+** second overrides the first, even though they were on different+** file descriptors opened on different file names.+**+** This means that we cannot use POSIX locks to synchronize file access+** among competing threads of the same process. POSIX locks will work fine+** to synchronize access for threads in separate processes, but not+** threads within the same process.+**+** To work around the problem, SQLite has to manage file locks internally+** on its own. Whenever a new database is opened, we have to find the+** specific inode of the database file (the inode is determined by the+** st_dev and st_ino fields of the stat structure that fstat() fills in)+** and check for locks already existing on that inode. When locks are+** created or removed, we have to look at our own internal record of the+** locks to see if another thread has previously set a lock on that same+** inode.+**+** (Aside: The use of inode numbers as unique IDs does not work on VxWorks.+** For VxWorks, we have to use the alternative unique ID system based on+** canonical filename and implemented in the previous division.)+**+** The sqlite3_file structure for POSIX is no longer just an integer file+** descriptor. It is now a structure that holds the integer file+** descriptor and a pointer to a structure that describes the internal+** locks on the corresponding inode. There is one locking structure+** per inode, so if the same inode is opened twice, both unixFile structures+** point to the same locking structure. The locking structure keeps+** a reference count (so we will know when to delete it) and a "cnt"+** field that tells us its internal lock status. cnt==0 means the+** file is unlocked. cnt==-1 means the file has an exclusive lock.+** cnt>0 means there are cnt shared locks on the file.+**+** Any attempt to lock or unlock a file first checks the locking+** structure. The fcntl() system call is only invoked to set a +** POSIX lock if the internal lock structure transitions between+** a locked and an unlocked state.+**+** But wait: there are yet more problems with POSIX advisory locks.+**+** If you close a file descriptor that points to a file that has locks,+** all locks on that file that are owned by the current process are+** released. To work around this problem, each unixInodeInfo object+** maintains a count of the number of pending locks on tha inode.+** When an attempt is made to close an unixFile, if there are+** other unixFile open on the same inode that are holding locks, the call+** to close() the file descriptor is deferred until all of the locks clear.+** The unixInodeInfo structure keeps a list of file descriptors that need to+** be closed and that list is walked (and cleared) when the last lock+** clears.+**+** Yet another problem: LinuxThreads do not play well with posix locks.+**+** Many older versions of linux use the LinuxThreads library which is+** not posix compliant. Under LinuxThreads, a lock created by thread+** A cannot be modified or overridden by a different thread B.+** Only thread A can modify the lock. Locking behavior is correct+** if the appliation uses the newer Native Posix Thread Library (NPTL)+** on linux - with NPTL a lock created by thread A can override locks+** in thread B. But there is no way to know at compile-time which+** threading library is being used. So there is no way to know at+** compile-time whether or not thread A can override locks on thread B.+** One has to do a run-time check to discover the behavior of the+** current process.+**+** SQLite used to support LinuxThreads. But support for LinuxThreads+** was dropped beginning with version 3.7.0. SQLite will still work with+** LinuxThreads provided that (1) there is no more than one connection +** per database file in the same process and (2) database connections+** do not move across threads.+*/++/*+** An instance of the following structure serves as the key used+** to locate a particular unixInodeInfo object.+*/+struct unixFileId {+ dev_t dev; /* Device number */+#if OS_VXWORKS+ struct vxworksFileId *pId; /* Unique file ID for vxworks. */+#else+ ino_t ino; /* Inode number */+#endif+};++/*+** An instance of the following structure is allocated for each open+** inode. Or, on LinuxThreads, there is one of these structures for+** each inode opened by each thread.+**+** A single inode can have multiple file descriptors, so each unixFile+** structure contains a pointer to an instance of this object and this+** object keeps a count of the number of unixFile pointing to it.+*/+struct unixInodeInfo {+ struct unixFileId fileId; /* The lookup key */+ int nShared; /* Number of SHARED locks held */+ unsigned char eFileLock; /* One of SHARED_LOCK, RESERVED_LOCK etc. */+ unsigned char bProcessLock; /* An exclusive process lock is held */+ int nRef; /* Number of pointers to this structure */+ unixShmNode *pShmNode; /* Shared memory associated with this inode */+ int nLock; /* Number of outstanding file locks */+ UnixUnusedFd *pUnused; /* Unused file descriptors to close */+ unixInodeInfo *pNext; /* List of all unixInodeInfo objects */+ unixInodeInfo *pPrev; /* .... doubly linked */+#if SQLITE_ENABLE_LOCKING_STYLE+ unsigned long long sharedByte; /* for AFP simulated shared lock */+#endif+#if OS_VXWORKS+ sem_t *pSem; /* Named POSIX semaphore */+ char aSemName[MAX_PATHNAME+2]; /* Name of that semaphore */+#endif+};++/*+** A lists of all unixInodeInfo objects.+*/+static unixInodeInfo *inodeList = 0;++/*+**+** This function - unixLogError_x(), is only ever called via the macro+** unixLogError().+**+** It is invoked after an error occurs in an OS function and errno has been+** set. It logs a message using sqlite3_log() containing the current value of+** errno and, if possible, the human-readable equivalent from strerror() or+** strerror_r().+**+** The first argument passed to the macro should be the error code that+** will be returned to SQLite (e.g. SQLITE_IOERR_DELETE, SQLITE_CANTOPEN). +** The two subsequent arguments should be the name of the OS function that+** failed (e.g. "unlink", "open") and the associated file-system path,+** if any.+*/+#define unixLogError(a,b,c) unixLogErrorAtLine(a,b,c,__LINE__)+static int unixLogErrorAtLine(+ int errcode, /* SQLite error code */+ const char *zFunc, /* Name of OS function that failed */+ const char *zPath, /* File path associated with error */+ int iLine /* Source line number where error occurred */+){+ char *zErr; /* Message from strerror() or equivalent */+ int iErrno = errno; /* Saved syscall error number */++ /* If this is not a threadsafe build (SQLITE_THREADSAFE==0), then use+ ** the strerror() function to obtain the human-readable error message+ ** equivalent to errno. Otherwise, use strerror_r().+ */ +#if SQLITE_THREADSAFE && defined(HAVE_STRERROR_R)+ char aErr[80];+ memset(aErr, 0, sizeof(aErr));+ zErr = aErr;++ /* If STRERROR_R_CHAR_P (set by autoconf scripts) or __USE_GNU is defined,+ ** assume that the system provides the GNU version of strerror_r() that+ ** returns a pointer to a buffer containing the error message. That pointer + ** may point to aErr[], or it may point to some static storage somewhere. + ** Otherwise, assume that the system provides the POSIX version of + ** strerror_r(), which always writes an error message into aErr[].+ **+ ** If the code incorrectly assumes that it is the POSIX version that is+ ** available, the error message will often be an empty string. Not a+ ** huge problem. Incorrectly concluding that the GNU version is available + ** could lead to a segfault though.+ */+#if defined(STRERROR_R_CHAR_P) || defined(__USE_GNU)+ zErr = +# endif+ strerror_r(iErrno, aErr, sizeof(aErr)-1);++#elif SQLITE_THREADSAFE+ /* This is a threadsafe build, but strerror_r() is not available. */+ zErr = "";+#else+ /* Non-threadsafe build, use strerror(). */+ zErr = strerror(iErrno);+#endif++ if( zPath==0 ) zPath = "";+ sqlite3_log(errcode,+ "os_unix.c:%d: (%d) %s(%s) - %s",+ iLine, iErrno, zFunc, zPath, zErr+ );++ return errcode;+}++/*+** Close a file descriptor.+**+** We assume that close() almost always works, since it is only in a+** very sick application or on a very sick platform that it might fail.+** If it does fail, simply leak the file descriptor, but do log the+** error.+**+** Note that it is not safe to retry close() after EINTR since the+** file descriptor might have already been reused by another thread.+** So we don't even try to recover from an EINTR. Just log the error+** and move on.+*/+static void robust_close(unixFile *pFile, int h, int lineno){+ if( osClose(h) ){+ unixLogErrorAtLine(SQLITE_IOERR_CLOSE, "close",+ pFile ? pFile->zPath : 0, lineno);+ }+}++/*+** Set the pFile->lastErrno. Do this in a subroutine as that provides+** a convenient place to set a breakpoint.+*/+static void storeLastErrno(unixFile *pFile, int error){+ pFile->lastErrno = error;+}++/*+** Close all file descriptors accumuated in the unixInodeInfo->pUnused list.+*/ +static void closePendingFds(unixFile *pFile){+ unixInodeInfo *pInode = pFile->pInode;+ UnixUnusedFd *p;+ UnixUnusedFd *pNext;+ for(p=pInode->pUnused; p; p=pNext){+ pNext = p->pNext;+ robust_close(pFile, p->fd, __LINE__);+ sqlite3_free(p);+ }+ pInode->pUnused = 0;+}++/*+** Release a unixInodeInfo structure previously allocated by findInodeInfo().+**+** The mutex entered using the unixEnterMutex() function must be held+** when this function is called.+*/+static void releaseInodeInfo(unixFile *pFile){+ unixInodeInfo *pInode = pFile->pInode;+ assert( unixMutexHeld() );+ if( ALWAYS(pInode) ){+ pInode->nRef--;+ if( pInode->nRef==0 ){+ assert( pInode->pShmNode==0 );+ closePendingFds(pFile);+ if( pInode->pPrev ){+ assert( pInode->pPrev->pNext==pInode );+ pInode->pPrev->pNext = pInode->pNext;+ }else{+ assert( inodeList==pInode );+ inodeList = pInode->pNext;+ }+ if( pInode->pNext ){+ assert( pInode->pNext->pPrev==pInode );+ pInode->pNext->pPrev = pInode->pPrev;+ }+ sqlite3_free(pInode);+ }+ }+}++/*+** Given a file descriptor, locate the unixInodeInfo object that+** describes that file descriptor. Create a new one if necessary. The+** return value might be uninitialized if an error occurs.+**+** The mutex entered using the unixEnterMutex() function must be held+** when this function is called.+**+** Return an appropriate error code.+*/+static int findInodeInfo(+ unixFile *pFile, /* Unix file with file desc used in the key */+ unixInodeInfo **ppInode /* Return the unixInodeInfo object here */+){+ int rc; /* System call return code */+ int fd; /* The file descriptor for pFile */+ struct unixFileId fileId; /* Lookup key for the unixInodeInfo */+ struct stat statbuf; /* Low-level file information */+ unixInodeInfo *pInode = 0; /* Candidate unixInodeInfo object */++ assert( unixMutexHeld() );++ /* Get low-level information about the file that we can used to+ ** create a unique name for the file.+ */+ fd = pFile->h;+ rc = osFstat(fd, &statbuf);+ if( rc!=0 ){+ storeLastErrno(pFile, errno);+#ifdef EOVERFLOW+ if( pFile->lastErrno==EOVERFLOW ) return SQLITE_NOLFS;+#endif+ return SQLITE_IOERR;+ }++#ifdef __APPLE__+ /* On OS X on an msdos filesystem, the inode number is reported+ ** incorrectly for zero-size files. See ticket #3260. To work+ ** around this problem (we consider it a bug in OS X, not SQLite)+ ** we always increase the file size to 1 by writing a single byte+ ** prior to accessing the inode number. The one byte written is+ ** an ASCII 'S' character which also happens to be the first byte+ ** in the header of every SQLite database. In this way, if there+ ** is a race condition such that another thread has already populated+ ** the first page of the database, no damage is done.+ */+ if( statbuf.st_size==0 && (pFile->fsFlags & SQLITE_FSFLAGS_IS_MSDOS)!=0 ){+ do{ rc = osWrite(fd, "S", 1); }while( rc<0 && errno==EINTR );+ if( rc!=1 ){+ storeLastErrno(pFile, errno);+ return SQLITE_IOERR;+ }+ rc = osFstat(fd, &statbuf);+ if( rc!=0 ){+ storeLastErrno(pFile, errno);+ return SQLITE_IOERR;+ }+ }+#endif++ memset(&fileId, 0, sizeof(fileId));+ fileId.dev = statbuf.st_dev;+#if OS_VXWORKS+ fileId.pId = pFile->pId;+#else+ fileId.ino = statbuf.st_ino;+#endif+ pInode = inodeList;+ while( pInode && memcmp(&fileId, &pInode->fileId, sizeof(fileId)) ){+ pInode = pInode->pNext;+ }+ if( pInode==0 ){+ pInode = sqlite3_malloc64( sizeof(*pInode) );+ if( pInode==0 ){+ return SQLITE_NOMEM;+ }+ memset(pInode, 0, sizeof(*pInode));+ memcpy(&pInode->fileId, &fileId, sizeof(fileId));+ pInode->nRef = 1;+ pInode->pNext = inodeList;+ pInode->pPrev = 0;+ if( inodeList ) inodeList->pPrev = pInode;+ inodeList = pInode;+ }else{+ pInode->nRef++;+ }+ *ppInode = pInode;+ return SQLITE_OK;+}++/*+** Return TRUE if pFile has been renamed or unlinked since it was first opened.+*/+static int fileHasMoved(unixFile *pFile){+#if OS_VXWORKS+ return pFile->pInode!=0 && pFile->pId!=pFile->pInode->fileId.pId;+#else+ struct stat buf;+ return pFile->pInode!=0 &&+ (osStat(pFile->zPath, &buf)!=0 || buf.st_ino!=pFile->pInode->fileId.ino);+#endif+}+++/*+** Check a unixFile that is a database. Verify the following:+**+** (1) There is exactly one hard link on the file+** (2) The file is not a symbolic link+** (3) The file has not been renamed or unlinked+**+** Issue sqlite3_log(SQLITE_WARNING,...) messages if anything is not right.+*/+static void verifyDbFile(unixFile *pFile){+ struct stat buf;+ int rc;+ if( pFile->ctrlFlags & UNIXFILE_WARNED ){+ /* One or more of the following warnings have already been issued. Do not+ ** repeat them so as not to clutter the error log */+ return;+ }+ rc = osFstat(pFile->h, &buf);+ if( rc!=0 ){+// sqlite3_log(SQLITE_WARNING, "cannot fstat db file %s", pFile->zPath);+ pFile->ctrlFlags |= UNIXFILE_WARNED;+ return;+ }+ if( buf.st_nlink==0 && (pFile->ctrlFlags & UNIXFILE_DELETE)==0 ){+// sqlite3_log(SQLITE_WARNING, "file unlinked while open: %s", pFile->zPath);+ pFile->ctrlFlags |= UNIXFILE_WARNED;+ return;+ }+ if( buf.st_nlink>1 ){+// sqlite3_log(SQLITE_WARNING, "multiple links to file: %s", pFile->zPath);+ pFile->ctrlFlags |= UNIXFILE_WARNED;+ return;+ }+ if( fileHasMoved(pFile) ){+// sqlite3_log(SQLITE_WARNING, "file renamed while open: %s", pFile->zPath);+ pFile->ctrlFlags |= UNIXFILE_WARNED;+ return;+ }+}+++/*+** This routine checks if there is a RESERVED lock held on the specified+** file by this or any other process. If such a lock is held, set *pResOut+** to a non-zero value otherwise *pResOut is set to zero. The return value+** is set to SQLITE_OK unless an I/O error occurs during lock checking.+*/+static int unixCheckReservedLock(sqlite3_file *id, int *pResOut){+ int rc = SQLITE_OK;+ int reserved = 0;+ unixFile *pFile = (unixFile*)id;++ SimulateIOError( return SQLITE_IOERR_CHECKRESERVEDLOCK; );++ assert( pFile );+ unixEnterMutex(); /* Because pFile->pInode is shared across threads */++ /* Check if a thread in this process holds such a lock */+ if( pFile->pInode->eFileLock>SHARED_LOCK ){+ reserved = 1;+ }++ /* Otherwise see if some other process holds it.+ */+#ifndef __DJGPP__+ if( !reserved && !pFile->pInode->bProcessLock ){+ struct flock lock;+ lock.l_whence = SEEK_SET;+ lock.l_start = RESERVED_BYTE;+ lock.l_len = 1;+ lock.l_type = F_WRLCK;+ if( osFcntl(pFile->h, F_GETLK, &lock) ){+ rc = SQLITE_IOERR_CHECKRESERVEDLOCK;+ storeLastErrno(pFile, errno);+ } else if( lock.l_type!=F_UNLCK ){+ reserved = 1;+ }+ }+#endif+ + unixLeaveMutex();+ OSTRACE(("TEST WR-LOCK %d %d %d (unix)\n", pFile->h, rc, reserved));++ *pResOut = reserved;+ return rc;+}++/*+** Attempt to set a system-lock on the file pFile. The lock is +** described by pLock.+**+** If the pFile was opened read/write from unix-excl, then the only lock+** ever obtained is an exclusive lock, and it is obtained exactly once+** the first time any lock is attempted. All subsequent system locking+** operations become no-ops. Locking operations still happen internally,+** in order to coordinate access between separate database connections+** within this process, but all of that is handled in memory and the+** operating system does not participate.+**+** This function is a pass-through to fcntl(F_SETLK) if pFile is using+** any VFS other than "unix-excl" or if pFile is opened on "unix-excl"+** and is read-only.+**+** Zero is returned if the call completes successfully, or -1 if a call+** to fcntl() fails. In this case, errno is set appropriately (by fcntl()).+*/+static int unixFileLock(unixFile *pFile, struct flock *pLock){+ int rc;+ unixInodeInfo *pInode = pFile->pInode;+ assert( unixMutexHeld() );+ assert( pInode!=0 );+ if( ((pFile->ctrlFlags & UNIXFILE_EXCL)!=0 || pInode->bProcessLock)+ && ((pFile->ctrlFlags & UNIXFILE_RDONLY)==0)+ ){+ if( pInode->bProcessLock==0 ){+ struct flock lock;+ assert( pInode->nLock==0 );+ lock.l_whence = SEEK_SET;+ lock.l_start = SHARED_FIRST;+ lock.l_len = SHARED_SIZE;+ lock.l_type = F_WRLCK;+ rc = osFcntl(pFile->h, F_SETLK, &lock);+ if( rc<0 ) return rc;+ pInode->bProcessLock = 1;+ pInode->nLock++;+ }else{+ rc = 0;+ }+ }else{+ rc = osFcntl(pFile->h, F_SETLK, pLock);+ }+ return rc;+}++/*+** Lock the file with the lock specified by parameter eFileLock - one+** of the following:+**+** (1) SHARED_LOCK+** (2) RESERVED_LOCK+** (3) PENDING_LOCK+** (4) EXCLUSIVE_LOCK+**+** Sometimes when requesting one lock state, additional lock states+** are inserted in between. The locking might fail on one of the later+** transitions leaving the lock state different from what it started but+** still short of its goal. The following chart shows the allowed+** transitions and the inserted intermediate states:+**+** UNLOCKED -> SHARED+** SHARED -> RESERVED+** SHARED -> (PENDING) -> EXCLUSIVE+** RESERVED -> (PENDING) -> EXCLUSIVE+** PENDING -> EXCLUSIVE+**+** This routine will only increase a lock. Use the sqlite3OsUnlock()+** routine to lower a locking level.+*/+static int unixLock(sqlite3_file *id, int eFileLock){+ /* The following describes the implementation of the various locks and+ ** lock transitions in terms of the POSIX advisory shared and exclusive+ ** lock primitives (called read-locks and write-locks below, to avoid+ ** confusion with SQLite lock names). The algorithms are complicated+ ** slightly in order to be compatible with windows systems simultaneously+ ** accessing the same database file, in case that is ever required.+ **+ ** Symbols defined in os.h indentify the 'pending byte' and the 'reserved+ ** byte', each single bytes at well known offsets, and the 'shared byte+ ** range', a range of 510 bytes at a well known offset.+ **+ ** To obtain a SHARED lock, a read-lock is obtained on the 'pending+ ** byte'. If this is successful, a random byte from the 'shared byte+ ** range' is read-locked and the lock on the 'pending byte' released.+ **+ ** A process may only obtain a RESERVED lock after it has a SHARED lock.+ ** A RESERVED lock is implemented by grabbing a write-lock on the+ ** 'reserved byte'. + **+ ** A process may only obtain a PENDING lock after it has obtained a+ ** SHARED lock. A PENDING lock is implemented by obtaining a write-lock+ ** on the 'pending byte'. This ensures that no new SHARED locks can be+ ** obtained, but existing SHARED locks are allowed to persist. A process+ ** does not have to obtain a RESERVED lock on the way to a PENDING lock.+ ** This property is used by the algorithm for rolling back a journal file+ ** after a crash.+ **+ ** An EXCLUSIVE lock, obtained after a PENDING lock is held, is+ ** implemented by obtaining a write-lock on the entire 'shared byte+ ** range'. Since all other locks require a read-lock on one of the bytes+ ** within this range, this ensures that no other locks are held on the+ ** database. + **+ ** The reason a single byte cannot be used instead of the 'shared byte+ ** range' is that some versions of windows do not support read-locks. By+ ** locking a random byte from a range, concurrent SHARED locks may exist+ ** even if the locking primitive used is always a write-lock.+ */+ int rc = SQLITE_OK;+ unixFile *pFile = (unixFile*)id;+ unixInodeInfo *pInode;+ struct flock lock;+ int tErrno = 0;++ assert( pFile );+ OSTRACE(("LOCK %d %s was %s(%s,%d) pid=%d (unix)\n", pFile->h,+ azFileLock(eFileLock), azFileLock(pFile->eFileLock),+ azFileLock(pFile->pInode->eFileLock), pFile->pInode->nShared,+ osGetpid(0)));++ /* If there is already a lock of this type or more restrictive on the+ ** unixFile, do nothing. Don't use the end_lock: exit path, as+ ** unixEnterMutex() hasn't been called yet.+ */+ if( pFile->eFileLock>=eFileLock ){+ OSTRACE(("LOCK %d %s ok (already held) (unix)\n", pFile->h,+ azFileLock(eFileLock)));+ return SQLITE_OK;+ }++ /* Make sure the locking sequence is correct.+ ** (1) We never move from unlocked to anything higher than shared lock.+ ** (2) SQLite never explicitly requests a pendig lock.+ ** (3) A shared lock is always held when a reserve lock is requested.+ */+ assert( pFile->eFileLock!=NO_LOCK || eFileLock==SHARED_LOCK );+ assert( eFileLock!=PENDING_LOCK );+ assert( eFileLock!=RESERVED_LOCK || pFile->eFileLock==SHARED_LOCK );++ /* This mutex is needed because pFile->pInode is shared across threads+ */+ unixEnterMutex();+ pInode = pFile->pInode;++ /* If some thread using this PID has a lock via a different unixFile*+ ** handle that precludes the requested lock, return BUSY.+ */+ if( (pFile->eFileLock!=pInode->eFileLock && + (pInode->eFileLock>=PENDING_LOCK || eFileLock>SHARED_LOCK))+ ){+ rc = SQLITE_BUSY;+ goto end_lock;+ }++ /* If a SHARED lock is requested, and some thread using this PID already+ ** has a SHARED or RESERVED lock, then increment reference counts and+ ** return SQLITE_OK.+ */+ if( eFileLock==SHARED_LOCK && + (pInode->eFileLock==SHARED_LOCK || pInode->eFileLock==RESERVED_LOCK) ){+ assert( eFileLock==SHARED_LOCK );+ assert( pFile->eFileLock==0 );+ assert( pInode->nShared>0 );+ pFile->eFileLock = SHARED_LOCK;+ pInode->nShared++;+ pInode->nLock++;+ goto end_lock;+ }+++ /* A PENDING lock is needed before acquiring a SHARED lock and before+ ** acquiring an EXCLUSIVE lock. For the SHARED lock, the PENDING will+ ** be released.+ */+ lock.l_len = 1L;+ lock.l_whence = SEEK_SET;+ if( eFileLock==SHARED_LOCK + || (eFileLock==EXCLUSIVE_LOCK && pFile->eFileLock<PENDING_LOCK)+ ){+ lock.l_type = (eFileLock==SHARED_LOCK?F_RDLCK:F_WRLCK);+ lock.l_start = PENDING_BYTE;+ if( unixFileLock(pFile, &lock) ){+ tErrno = errno;+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_LOCK);+ if( rc!=SQLITE_BUSY ){+ storeLastErrno(pFile, tErrno);+ }+ goto end_lock;+ }+ }+++ /* If control gets to this point, then actually go ahead and make+ ** operating system calls for the specified lock.+ */+ if( eFileLock==SHARED_LOCK ){+ assert( pInode->nShared==0 );+ assert( pInode->eFileLock==0 );+ assert( rc==SQLITE_OK );++ /* Now get the read-lock */+ lock.l_start = SHARED_FIRST;+ lock.l_len = SHARED_SIZE;+ if( unixFileLock(pFile, &lock) ){+ tErrno = errno;+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_LOCK);+ }++ /* Drop the temporary PENDING lock */+ lock.l_start = PENDING_BYTE;+ lock.l_len = 1L;+ lock.l_type = F_UNLCK;+ if( unixFileLock(pFile, &lock) && rc==SQLITE_OK ){+ /* This could happen with a network mount */+ tErrno = errno;+ rc = SQLITE_IOERR_UNLOCK; + }++ if( rc ){+ if( rc!=SQLITE_BUSY ){+ storeLastErrno(pFile, tErrno);+ }+ goto end_lock;+ }else{+ pFile->eFileLock = SHARED_LOCK;+ pInode->nLock++;+ pInode->nShared = 1;+ }+ }else if( eFileLock==EXCLUSIVE_LOCK && pInode->nShared>1 ){+ /* We are trying for an exclusive lock but another thread in this+ ** same process is still holding a shared lock. */+ rc = SQLITE_BUSY;+ }else{+ /* The request was for a RESERVED or EXCLUSIVE lock. It is+ ** assumed that there is a SHARED or greater lock on the file+ ** already.+ */+ assert( 0!=pFile->eFileLock );+ lock.l_type = F_WRLCK;++ assert( eFileLock==RESERVED_LOCK || eFileLock==EXCLUSIVE_LOCK );+ if( eFileLock==RESERVED_LOCK ){+ lock.l_start = RESERVED_BYTE;+ lock.l_len = 1L;+ }else{+ lock.l_start = SHARED_FIRST;+ lock.l_len = SHARED_SIZE;+ }++ if( unixFileLock(pFile, &lock) ){+ tErrno = errno;+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_LOCK);+ if( rc!=SQLITE_BUSY ){+ storeLastErrno(pFile, tErrno);+ }+ }+ }+ ++#ifdef SQLITE_DEBUG+ /* Set up the transaction-counter change checking flags when+ ** transitioning from a SHARED to a RESERVED lock. The change+ ** from SHARED to RESERVED marks the beginning of a normal+ ** write operation (not a hot journal rollback).+ */+ if( rc==SQLITE_OK+ && pFile->eFileLock<=SHARED_LOCK+ && eFileLock==RESERVED_LOCK+ ){+ pFile->transCntrChng = 0;+ pFile->dbUpdate = 0;+ pFile->inNormalWrite = 1;+ }+#endif+++ if( rc==SQLITE_OK ){+ pFile->eFileLock = eFileLock;+ pInode->eFileLock = eFileLock;+ }else if( eFileLock==EXCLUSIVE_LOCK ){+ pFile->eFileLock = PENDING_LOCK;+ pInode->eFileLock = PENDING_LOCK;+ }++end_lock:+ unixLeaveMutex();+ OSTRACE(("LOCK %d %s %s (unix)\n", pFile->h, azFileLock(eFileLock), + rc==SQLITE_OK ? "ok" : "failed"));+ return rc;+}++/*+** Add the file descriptor used by file handle pFile to the corresponding+** pUnused list.+*/+static void setPendingFd(unixFile *pFile){+ unixInodeInfo *pInode = pFile->pInode;+ UnixUnusedFd *p = pFile->pUnused;+ p->pNext = pInode->pUnused;+ pInode->pUnused = p;+ pFile->h = -1;+ pFile->pUnused = 0;+}++/*+** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+** +** If handleNFSUnlock is true, then on downgrading an EXCLUSIVE_LOCK to SHARED+** the byte range is divided into 2 parts and the first part is unlocked then+** set to a read lock, then the other part is simply unlocked. This works +** around a bug in BSD NFS lockd (also seen on MacOSX 10.3+) that fails to +** remove the write lock on a region when a read lock is set.+*/+static int posixUnlock(sqlite3_file *id, int eFileLock, int handleNFSUnlock){+ unixFile *pFile = (unixFile*)id;+ unixInodeInfo *pInode;+ struct flock lock;+ int rc = SQLITE_OK;++ assert( pFile );+ OSTRACE(("UNLOCK %d %d was %d(%d,%d) pid=%d (unix)\n", pFile->h, eFileLock,+ pFile->eFileLock, pFile->pInode->eFileLock, pFile->pInode->nShared,+ osGetpid(0)));++ assert( eFileLock<=SHARED_LOCK );+ if( pFile->eFileLock<=eFileLock ){+ return SQLITE_OK;+ }+ unixEnterMutex();+ pInode = pFile->pInode;+ assert( pInode->nShared!=0 );+ if( pFile->eFileLock>SHARED_LOCK ){+ assert( pInode->eFileLock==pFile->eFileLock );++#ifdef SQLITE_DEBUG+ /* When reducing a lock such that other processes can start+ ** reading the database file again, make sure that the+ ** transaction counter was updated if any part of the database+ ** file changed. If the transaction counter is not updated,+ ** other connections to the same file might not realize that+ ** the file has changed and hence might not know to flush their+ ** cache. The use of a stale cache can lead to database corruption.+ */+ pFile->inNormalWrite = 0;+#endif++ /* downgrading to a shared lock on NFS involves clearing the write lock+ ** before establishing the readlock - to avoid a race condition we downgrade+ ** the lock in 2 blocks, so that part of the range will be covered by a + ** write lock until the rest is covered by a read lock:+ ** 1: [WWWWW]+ ** 2: [....W]+ ** 3: [RRRRW]+ ** 4: [RRRR.]+ */+ if( eFileLock==SHARED_LOCK ){+#if !defined(__APPLE__) || !SQLITE_ENABLE_LOCKING_STYLE+ (void)handleNFSUnlock;+ assert( handleNFSUnlock==0 );+#endif+#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+ if( handleNFSUnlock ){+ int tErrno; /* Error code from system call errors */+ off_t divSize = SHARED_SIZE - 1;+ + lock.l_type = F_UNLCK;+ lock.l_whence = SEEK_SET;+ lock.l_start = SHARED_FIRST;+ lock.l_len = divSize;+ if( unixFileLock(pFile, &lock)==(-1) ){+ tErrno = errno;+ rc = SQLITE_IOERR_UNLOCK;+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ goto end_unlock;+ }+ lock.l_type = F_RDLCK;+ lock.l_whence = SEEK_SET;+ lock.l_start = SHARED_FIRST;+ lock.l_len = divSize;+ if( unixFileLock(pFile, &lock)==(-1) ){+ tErrno = errno;+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_RDLOCK);+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ goto end_unlock;+ }+ lock.l_type = F_UNLCK;+ lock.l_whence = SEEK_SET;+ lock.l_start = SHARED_FIRST+divSize;+ lock.l_len = SHARED_SIZE-divSize;+ if( unixFileLock(pFile, &lock)==(-1) ){+ tErrno = errno;+ rc = SQLITE_IOERR_UNLOCK;+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ goto end_unlock;+ }+ }else+#endif /* defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE */+ {+ lock.l_type = F_RDLCK;+ lock.l_whence = SEEK_SET;+ lock.l_start = SHARED_FIRST;+ lock.l_len = SHARED_SIZE;+ if( unixFileLock(pFile, &lock) ){+ /* In theory, the call to unixFileLock() cannot fail because another+ ** process is holding an incompatible lock. If it does, this + ** indicates that the other process is not following the locking+ ** protocol. If this happens, return SQLITE_IOERR_RDLOCK. Returning+ ** SQLITE_BUSY would confuse the upper layer (in practice it causes + ** an assert to fail). */ + rc = SQLITE_IOERR_RDLOCK;+ storeLastErrno(pFile, errno);+ goto end_unlock;+ }+ }+ }+ lock.l_type = F_UNLCK;+ lock.l_whence = SEEK_SET;+ lock.l_start = PENDING_BYTE;+ lock.l_len = 2L; assert( PENDING_BYTE+1==RESERVED_BYTE );+ if( unixFileLock(pFile, &lock)==0 ){+ pInode->eFileLock = SHARED_LOCK;+ }else{+ rc = SQLITE_IOERR_UNLOCK;+ storeLastErrno(pFile, errno);+ goto end_unlock;+ }+ }+ if( eFileLock==NO_LOCK ){+ /* Decrement the shared lock counter. Release the lock using an+ ** OS call only when all threads in this same process have released+ ** the lock.+ */+ pInode->nShared--;+ if( pInode->nShared==0 ){+ lock.l_type = F_UNLCK;+ lock.l_whence = SEEK_SET;+ lock.l_start = lock.l_len = 0L;+ if( unixFileLock(pFile, &lock)==0 ){+ pInode->eFileLock = NO_LOCK;+ }else{+ rc = SQLITE_IOERR_UNLOCK;+ storeLastErrno(pFile, errno);+ pInode->eFileLock = NO_LOCK;+ pFile->eFileLock = NO_LOCK;+ }+ }++ /* Decrement the count of locks against this same file. When the+ ** count reaches zero, close any other file descriptors whose close+ ** was deferred because of outstanding locks.+ */+ pInode->nLock--;+ assert( pInode->nLock>=0 );+ if( pInode->nLock==0 ){+ closePendingFds(pFile);+ }+ }++end_unlock:+ unixLeaveMutex();+ if( rc==SQLITE_OK ) pFile->eFileLock = eFileLock;+ return rc;+}++/*+** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+*/+static int unixUnlock(sqlite3_file *id, int eFileLock){+#if SQLITE_MAX_MMAP_SIZE>0+ assert( eFileLock==SHARED_LOCK || ((unixFile *)id)->nFetchOut==0 );+#endif+ return posixUnlock(id, eFileLock, 0);+}++#if SQLITE_MAX_MMAP_SIZE>0+static int unixMapfile(unixFile *pFd, i64 nByte);+static void unixUnmapfile(unixFile *pFd);+#endif++/*+** This function performs the parts of the "close file" operation +** common to all locking schemes. It closes the directory and file+** handles, if they are valid, and sets all fields of the unixFile+** structure to 0.+**+** It is *not* necessary to hold the mutex when this routine is called,+** even on VxWorks. A mutex will be acquired on VxWorks by the+** vxworksReleaseFileId() routine.+*/+static int closeUnixFile(sqlite3_file *id){+ unixFile *pFile = (unixFile*)id;+#if SQLITE_MAX_MMAP_SIZE>0+ unixUnmapfile(pFile);+#endif+ if( pFile->h>=0 ){+ robust_close(pFile, pFile->h, __LINE__);+ pFile->h = -1;+ }+#if OS_VXWORKS+ if( pFile->pId ){+ if( pFile->ctrlFlags & UNIXFILE_DELETE ){+ osUnlink(pFile->pId->zCanonicalName);+ }+ vxworksReleaseFileId(pFile->pId);+ pFile->pId = 0;+ }+#endif+#ifdef SQLITE_UNLINK_AFTER_CLOSE+ if( pFile->ctrlFlags & UNIXFILE_DELETE ){+ osUnlink(pFile->zPath);+ sqlite3_free(*(char**)&pFile->zPath);+ pFile->zPath = 0;+ }+#endif+ OSTRACE(("CLOSE %-3d\n", pFile->h));+ OpenCounter(-1);+ sqlite3_free(pFile->pUnused);+ memset(pFile, 0, sizeof(unixFile));+ return SQLITE_OK;+}++/*+** Close a file.+*/+static int unixClose(sqlite3_file *id){+ int rc = SQLITE_OK;+ unixFile *pFile = (unixFile *)id;+ verifyDbFile(pFile);+ unixUnlock(id, NO_LOCK);+ unixEnterMutex();++ /* unixFile.pInode is always valid here. Otherwise, a different close+ ** routine (e.g. nolockClose()) would be called instead.+ */+ assert( pFile->pInode->nLock>0 || pFile->pInode->bProcessLock==0 );+ if( ALWAYS(pFile->pInode) && pFile->pInode->nLock ){+ /* If there are outstanding locks, do not actually close the file just+ ** yet because that would clear those locks. Instead, add the file+ ** descriptor to pInode->pUnused list. It will be automatically closed + ** when the last lock is cleared.+ */+ setPendingFd(pFile);+ }+ releaseInodeInfo(pFile);+ rc = closeUnixFile(id);+ unixLeaveMutex();+ return rc;+}++/************** End of the posix advisory lock implementation *****************+******************************************************************************/++/******************************************************************************+****************************** No-op Locking **********************************+**+** Of the various locking implementations available, this is by far the+** simplest: locking is ignored. No attempt is made to lock the database+** file for reading or writing.+**+** This locking mode is appropriate for use on read-only databases+** (ex: databases that are burned into CD-ROM, for example.) It can+** also be used if the application employs some external mechanism to+** prevent simultaneous access of the same database by two or more+** database connections. But there is a serious risk of database+** corruption if this locking mode is used in situations where multiple+** database connections are accessing the same database file at the same+** time and one or more of those connections are writing.+*/++static int nolockCheckReservedLock(sqlite3_file *NotUsed, int *pResOut){+ UNUSED_PARAMETER(NotUsed);+ *pResOut = 0;+ return SQLITE_OK;+}+static int nolockLock(sqlite3_file *NotUsed, int NotUsed2){+ UNUSED_PARAMETER2(NotUsed, NotUsed2);+ return SQLITE_OK;+}+static int nolockUnlock(sqlite3_file *NotUsed, int NotUsed2){+ UNUSED_PARAMETER2(NotUsed, NotUsed2);+ return SQLITE_OK;+}++/*+** Close the file.+*/+static int nolockClose(sqlite3_file *id) {+ return closeUnixFile(id);+}++/******************* End of the no-op lock implementation *********************+******************************************************************************/++/******************************************************************************+************************* Begin dot-file Locking ******************************+**+** The dotfile locking implementation uses the existence of separate lock+** files (really a directory) to control access to the database. This works+** on just about every filesystem imaginable. But there are serious downsides:+**+** (1) There is zero concurrency. A single reader blocks all other+** connections from reading or writing the database.+**+** (2) An application crash or power loss can leave stale lock files+** sitting around that need to be cleared manually.+**+** Nevertheless, a dotlock is an appropriate locking mode for use if no+** other locking strategy is available.+**+** Dotfile locking works by creating a subdirectory in the same directory as+** the database and with the same name but with a ".lock" extension added.+** The existence of a lock directory implies an EXCLUSIVE lock. All other+** lock types (SHARED, RESERVED, PENDING) are mapped into EXCLUSIVE.+*/++/*+** The file suffix added to the data base filename in order to create the+** lock directory.+*/+#define DOTLOCK_SUFFIX ".lock"++/*+** This routine checks if there is a RESERVED lock held on the specified+** file by this or any other process. If such a lock is held, set *pResOut+** to a non-zero value otherwise *pResOut is set to zero. The return value+** is set to SQLITE_OK unless an I/O error occurs during lock checking.+**+** In dotfile locking, either a lock exists or it does not. So in this+** variation of CheckReservedLock(), *pResOut is set to true if any lock+** is held on the file and false if the file is unlocked.+*/+static int dotlockCheckReservedLock(sqlite3_file *id, int *pResOut) {+ int rc = SQLITE_OK;+ int reserved = 0;+ unixFile *pFile = (unixFile*)id;++ SimulateIOError( return SQLITE_IOERR_CHECKRESERVEDLOCK; );+ + assert( pFile );++ /* Check if a thread in this process holds such a lock */+ if( pFile->eFileLock>SHARED_LOCK ){+ /* Either this connection or some other connection in the same process+ ** holds a lock on the file. No need to check further. */+ reserved = 1;+ }else{+ /* The lock is held if and only if the lockfile exists */+ const char *zLockFile = (const char*)pFile->lockingContext;+ reserved = osAccess(zLockFile, 0)==0;+ }+ OSTRACE(("TEST WR-LOCK %d %d %d (dotlock)\n", pFile->h, rc, reserved));+ *pResOut = reserved;+ return rc;+}++/*+** Lock the file with the lock specified by parameter eFileLock - one+** of the following:+**+** (1) SHARED_LOCK+** (2) RESERVED_LOCK+** (3) PENDING_LOCK+** (4) EXCLUSIVE_LOCK+**+** Sometimes when requesting one lock state, additional lock states+** are inserted in between. The locking might fail on one of the later+** transitions leaving the lock state different from what it started but+** still short of its goal. The following chart shows the allowed+** transitions and the inserted intermediate states:+**+** UNLOCKED -> SHARED+** SHARED -> RESERVED+** SHARED -> (PENDING) -> EXCLUSIVE+** RESERVED -> (PENDING) -> EXCLUSIVE+** PENDING -> EXCLUSIVE+**+** This routine will only increase a lock. Use the sqlite3OsUnlock()+** routine to lower a locking level.+**+** With dotfile locking, we really only support state (4): EXCLUSIVE.+** But we track the other locking levels internally.+*/+static int dotlockLock(sqlite3_file *id, int eFileLock) {+ unixFile *pFile = (unixFile*)id;+ char *zLockFile = (char *)pFile->lockingContext;+ int rc = SQLITE_OK;+++ /* If we have any lock, then the lock file already exists. All we have+ ** to do is adjust our internal record of the lock level.+ */+ if( pFile->eFileLock > NO_LOCK ){+ pFile->eFileLock = eFileLock;+ /* Always update the timestamp on the old file */+#ifdef HAVE_UTIME+ utime(zLockFile, NULL);+#else+ utimes(zLockFile, NULL);+#endif+ return SQLITE_OK;+ }+ + /* grab an exclusive lock */+ rc = osMkdir(zLockFile, 0777);+ if( rc<0 ){+ /* failed to open/create the lock directory */+ int tErrno = errno;+ if( EEXIST == tErrno ){+ rc = SQLITE_BUSY;+ } else {+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_LOCK);+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ }+ return rc;+ } + + /* got it, set the type and return ok */+ pFile->eFileLock = eFileLock;+ return rc;+}++/*+** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+**+** When the locking level reaches NO_LOCK, delete the lock file.+*/+static int dotlockUnlock(sqlite3_file *id, int eFileLock) {+ unixFile *pFile = (unixFile*)id;+ char *zLockFile = (char *)pFile->lockingContext;+ int rc;++ assert( pFile );+ OSTRACE(("UNLOCK %d %d was %d pid=%d (dotlock)\n", pFile->h, eFileLock,+ pFile->eFileLock, osGetpid(0)));+ assert( eFileLock<=SHARED_LOCK );+ + /* no-op if possible */+ if( pFile->eFileLock==eFileLock ){+ return SQLITE_OK;+ }++ /* To downgrade to shared, simply update our internal notion of the+ ** lock state. No need to mess with the file on disk.+ */+ if( eFileLock==SHARED_LOCK ){+ pFile->eFileLock = SHARED_LOCK;+ return SQLITE_OK;+ }+ + /* To fully unlock the database, delete the lock file */+ assert( eFileLock==NO_LOCK );+ rc = osRmdir(zLockFile);+ if( rc<0 && errno==ENOTDIR ) rc = osUnlink(zLockFile);+ if( rc<0 ){+ int tErrno = errno;+ rc = 0;+ if( ENOENT != tErrno ){+ rc = SQLITE_IOERR_UNLOCK;+ }+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ return rc; + }+ pFile->eFileLock = NO_LOCK;+ return SQLITE_OK;+}++/*+** Close a file. Make sure the lock has been released before closing.+*/+static int dotlockClose(sqlite3_file *id) {+ int rc = SQLITE_OK;+ if( id ){+ unixFile *pFile = (unixFile*)id;+ dotlockUnlock(id, NO_LOCK);+ sqlite3_free(pFile->lockingContext);+ rc = closeUnixFile(id);+ }+ return rc;+}+/****************** End of the dot-file lock implementation *******************+******************************************************************************/++/******************************************************************************+************************** Begin flock Locking ********************************+**+** Use the flock() system call to do file locking.+**+** flock() locking is like dot-file locking in that the various+** fine-grain locking levels supported by SQLite are collapsed into+** a single exclusive lock. In other words, SHARED, RESERVED, and+** PENDING locks are the same thing as an EXCLUSIVE lock. SQLite+** still works when you do this, but concurrency is reduced since+** only a single process can be reading the database at a time.+**+** Omit this section if SQLITE_ENABLE_LOCKING_STYLE is turned off+*/+#if SQLITE_ENABLE_LOCKING_STYLE++/*+** Retry flock() calls that fail with EINTR+*/+#ifdef EINTR+static int robust_flock(int fd, int op){+ int rc;+ do{ rc = flock(fd,op); }while( rc<0 && errno==EINTR );+ return rc;+}+#else+# define robust_flock(a,b) flock(a,b)+#endif+ ++/*+** This routine checks if there is a RESERVED lock held on the specified+** file by this or any other process. If such a lock is held, set *pResOut+** to a non-zero value otherwise *pResOut is set to zero. The return value+** is set to SQLITE_OK unless an I/O error occurs during lock checking.+*/+static int flockCheckReservedLock(sqlite3_file *id, int *pResOut){+ int rc = SQLITE_OK;+ int reserved = 0;+ unixFile *pFile = (unixFile*)id;+ + SimulateIOError( return SQLITE_IOERR_CHECKRESERVEDLOCK; );+ + assert( pFile );+ + /* Check if a thread in this process holds such a lock */+ if( pFile->eFileLock>SHARED_LOCK ){+ reserved = 1;+ }+ + /* Otherwise see if some other process holds it. */+ if( !reserved ){+ /* attempt to get the lock */+ int lrc = robust_flock(pFile->h, LOCK_EX | LOCK_NB);+ if( !lrc ){+ /* got the lock, unlock it */+ lrc = robust_flock(pFile->h, LOCK_UN);+ if ( lrc ) {+ int tErrno = errno;+ /* unlock failed with an error */+ lrc = SQLITE_IOERR_UNLOCK; + if( IS_LOCK_ERROR(lrc) ){+ storeLastErrno(pFile, tErrno);+ rc = lrc;+ }+ }+ } else {+ int tErrno = errno;+ reserved = 1;+ /* someone else might have it reserved */+ lrc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_LOCK); + if( IS_LOCK_ERROR(lrc) ){+ storeLastErrno(pFile, tErrno);+ rc = lrc;+ }+ }+ }+ OSTRACE(("TEST WR-LOCK %d %d %d (flock)\n", pFile->h, rc, reserved));++#ifdef SQLITE_IGNORE_FLOCK_LOCK_ERRORS+ if( (rc & SQLITE_IOERR) == SQLITE_IOERR ){+ rc = SQLITE_OK;+ reserved=1;+ }+#endif /* SQLITE_IGNORE_FLOCK_LOCK_ERRORS */+ *pResOut = reserved;+ return rc;+}++/*+** Lock the file with the lock specified by parameter eFileLock - one+** of the following:+**+** (1) SHARED_LOCK+** (2) RESERVED_LOCK+** (3) PENDING_LOCK+** (4) EXCLUSIVE_LOCK+**+** Sometimes when requesting one lock state, additional lock states+** are inserted in between. The locking might fail on one of the later+** transitions leaving the lock state different from what it started but+** still short of its goal. The following chart shows the allowed+** transitions and the inserted intermediate states:+**+** UNLOCKED -> SHARED+** SHARED -> RESERVED+** SHARED -> (PENDING) -> EXCLUSIVE+** RESERVED -> (PENDING) -> EXCLUSIVE+** PENDING -> EXCLUSIVE+**+** flock() only really support EXCLUSIVE locks. We track intermediate+** lock states in the sqlite3_file structure, but all locks SHARED or+** above are really EXCLUSIVE locks and exclude all other processes from+** access the file.+**+** This routine will only increase a lock. Use the sqlite3OsUnlock()+** routine to lower a locking level.+*/+static int flockLock(sqlite3_file *id, int eFileLock) {+ int rc = SQLITE_OK;+ unixFile *pFile = (unixFile*)id;++ assert( pFile );++ /* if we already have a lock, it is exclusive. + ** Just adjust level and punt on outta here. */+ if (pFile->eFileLock > NO_LOCK) {+ pFile->eFileLock = eFileLock;+ return SQLITE_OK;+ }+ + /* grab an exclusive lock */+ + if (robust_flock(pFile->h, LOCK_EX | LOCK_NB)) {+ int tErrno = errno;+ /* didn't get, must be busy */+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_LOCK);+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ } else {+ /* got it, set the type and return ok */+ pFile->eFileLock = eFileLock;+ }+ OSTRACE(("LOCK %d %s %s (flock)\n", pFile->h, azFileLock(eFileLock), + rc==SQLITE_OK ? "ok" : "failed"));+#ifdef SQLITE_IGNORE_FLOCK_LOCK_ERRORS+ if( (rc & SQLITE_IOERR) == SQLITE_IOERR ){+ rc = SQLITE_BUSY;+ }+#endif /* SQLITE_IGNORE_FLOCK_LOCK_ERRORS */+ return rc;+}+++/*+** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+*/+static int flockUnlock(sqlite3_file *id, int eFileLock) {+ unixFile *pFile = (unixFile*)id;+ + assert( pFile );+ OSTRACE(("UNLOCK %d %d was %d pid=%d (flock)\n", pFile->h, eFileLock,+ pFile->eFileLock, osGetpid(0)));+ assert( eFileLock<=SHARED_LOCK );+ + /* no-op if possible */+ if( pFile->eFileLock==eFileLock ){+ return SQLITE_OK;+ }+ + /* shared can just be set because we always have an exclusive */+ if (eFileLock==SHARED_LOCK) {+ pFile->eFileLock = eFileLock;+ return SQLITE_OK;+ }+ + /* no, really, unlock. */+ if( robust_flock(pFile->h, LOCK_UN) ){+#ifdef SQLITE_IGNORE_FLOCK_LOCK_ERRORS+ return SQLITE_OK;+#endif /* SQLITE_IGNORE_FLOCK_LOCK_ERRORS */+ return SQLITE_IOERR_UNLOCK;+ }else{+ pFile->eFileLock = NO_LOCK;+ return SQLITE_OK;+ }+}++/*+** Close a file.+*/+static int flockClose(sqlite3_file *id) {+ int rc = SQLITE_OK;+ if( id ){+ flockUnlock(id, NO_LOCK);+ rc = closeUnixFile(id);+ }+ return rc;+}++#endif /* SQLITE_ENABLE_LOCKING_STYLE && !OS_VXWORK */++/******************* End of the flock lock implementation *********************+******************************************************************************/++/******************************************************************************+************************ Begin Named Semaphore Locking ************************+**+** Named semaphore locking is only supported on VxWorks.+**+** Semaphore locking is like dot-lock and flock in that it really only+** supports EXCLUSIVE locking. Only a single process can read or write+** the database file at a time. This reduces potential concurrency, but+** makes the lock implementation much easier.+*/+#if OS_VXWORKS++/*+** This routine checks if there is a RESERVED lock held on the specified+** file by this or any other process. If such a lock is held, set *pResOut+** to a non-zero value otherwise *pResOut is set to zero. The return value+** is set to SQLITE_OK unless an I/O error occurs during lock checking.+*/+static int semXCheckReservedLock(sqlite3_file *id, int *pResOut) {+ int rc = SQLITE_OK;+ int reserved = 0;+ unixFile *pFile = (unixFile*)id;++ SimulateIOError( return SQLITE_IOERR_CHECKRESERVEDLOCK; );+ + assert( pFile );++ /* Check if a thread in this process holds such a lock */+ if( pFile->eFileLock>SHARED_LOCK ){+ reserved = 1;+ }+ + /* Otherwise see if some other process holds it. */+ if( !reserved ){+ sem_t *pSem = pFile->pInode->pSem;++ if( sem_trywait(pSem)==-1 ){+ int tErrno = errno;+ if( EAGAIN != tErrno ){+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_CHECKRESERVEDLOCK);+ storeLastErrno(pFile, tErrno);+ } else {+ /* someone else has the lock when we are in NO_LOCK */+ reserved = (pFile->eFileLock < SHARED_LOCK);+ }+ }else{+ /* we could have it if we want it */+ sem_post(pSem);+ }+ }+ OSTRACE(("TEST WR-LOCK %d %d %d (sem)\n", pFile->h, rc, reserved));++ *pResOut = reserved;+ return rc;+}++/*+** Lock the file with the lock specified by parameter eFileLock - one+** of the following:+**+** (1) SHARED_LOCK+** (2) RESERVED_LOCK+** (3) PENDING_LOCK+** (4) EXCLUSIVE_LOCK+**+** Sometimes when requesting one lock state, additional lock states+** are inserted in between. The locking might fail on one of the later+** transitions leaving the lock state different from what it started but+** still short of its goal. The following chart shows the allowed+** transitions and the inserted intermediate states:+**+** UNLOCKED -> SHARED+** SHARED -> RESERVED+** SHARED -> (PENDING) -> EXCLUSIVE+** RESERVED -> (PENDING) -> EXCLUSIVE+** PENDING -> EXCLUSIVE+**+** Semaphore locks only really support EXCLUSIVE locks. We track intermediate+** lock states in the sqlite3_file structure, but all locks SHARED or+** above are really EXCLUSIVE locks and exclude all other processes from+** access the file.+**+** This routine will only increase a lock. Use the sqlite3OsUnlock()+** routine to lower a locking level.+*/+static int semXLock(sqlite3_file *id, int eFileLock) {+ unixFile *pFile = (unixFile*)id;+ sem_t *pSem = pFile->pInode->pSem;+ int rc = SQLITE_OK;++ /* if we already have a lock, it is exclusive. + ** Just adjust level and punt on outta here. */+ if (pFile->eFileLock > NO_LOCK) {+ pFile->eFileLock = eFileLock;+ rc = SQLITE_OK;+ goto sem_end_lock;+ }+ + /* lock semaphore now but bail out when already locked. */+ if( sem_trywait(pSem)==-1 ){+ rc = SQLITE_BUSY;+ goto sem_end_lock;+ }++ /* got it, set the type and return ok */+ pFile->eFileLock = eFileLock;++ sem_end_lock:+ return rc;+}++/*+** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+*/+static int semXUnlock(sqlite3_file *id, int eFileLock) {+ unixFile *pFile = (unixFile*)id;+ sem_t *pSem = pFile->pInode->pSem;++ assert( pFile );+ assert( pSem );+ OSTRACE(("UNLOCK %d %d was %d pid=%d (sem)\n", pFile->h, eFileLock,+ pFile->eFileLock, osGetpid(0)));+ assert( eFileLock<=SHARED_LOCK );+ + /* no-op if possible */+ if( pFile->eFileLock==eFileLock ){+ return SQLITE_OK;+ }+ + /* shared can just be set because we always have an exclusive */+ if (eFileLock==SHARED_LOCK) {+ pFile->eFileLock = eFileLock;+ return SQLITE_OK;+ }+ + /* no, really unlock. */+ if ( sem_post(pSem)==-1 ) {+ int rc, tErrno = errno;+ rc = sqliteErrorFromPosixError(tErrno, SQLITE_IOERR_UNLOCK);+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ return rc; + }+ pFile->eFileLock = NO_LOCK;+ return SQLITE_OK;+}++/*+ ** Close a file.+ */+static int semXClose(sqlite3_file *id) {+ if( id ){+ unixFile *pFile = (unixFile*)id;+ semXUnlock(id, NO_LOCK);+ assert( pFile );+ unixEnterMutex();+ releaseInodeInfo(pFile);+ unixLeaveMutex();+ closeUnixFile(id);+ }+ return SQLITE_OK;+}++#endif /* OS_VXWORKS */+/*+** Named semaphore locking is only available on VxWorks.+**+*************** End of the named semaphore lock implementation ****************+******************************************************************************/+++/******************************************************************************+*************************** Begin AFP Locking *********************************+**+** AFP is the Apple Filing Protocol. AFP is a network filesystem found+** on Apple Macintosh computers - both OS9 and OSX.+**+** Third-party implementations of AFP are available. But this code here+** only works on OSX.+*/++#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+/*+** The afpLockingContext structure contains all afp lock specific state+*/+typedef struct afpLockingContext afpLockingContext;+struct afpLockingContext {+ int reserved;+ const char *dbPath; /* Name of the open file */+};++struct ByteRangeLockPB2+{+ unsigned long long offset; /* offset to first byte to lock */+ unsigned long long length; /* nbr of bytes to lock */+ unsigned long long retRangeStart; /* nbr of 1st byte locked if successful */+ unsigned char unLockFlag; /* 1 = unlock, 0 = lock */+ unsigned char startEndFlag; /* 1=rel to end of fork, 0=rel to start */+ int fd; /* file desc to assoc this lock with */+};++#define afpfsByteRangeLock2FSCTL _IOWR('z', 23, struct ByteRangeLockPB2)++/*+** This is a utility for setting or clearing a bit-range lock on an+** AFP filesystem.+** +** Return SQLITE_OK on success, SQLITE_BUSY on failure.+*/+static int afpSetLock(+ const char *path, /* Name of the file to be locked or unlocked */+ unixFile *pFile, /* Open file descriptor on path */+ unsigned long long offset, /* First byte to be locked */+ unsigned long long length, /* Number of bytes to lock */+ int setLockFlag /* True to set lock. False to clear lock */+){+ struct ByteRangeLockPB2 pb;+ int err;+ + pb.unLockFlag = setLockFlag ? 0 : 1;+ pb.startEndFlag = 0;+ pb.offset = offset;+ pb.length = length; + pb.fd = pFile->h;+ + OSTRACE(("AFPSETLOCK [%s] for %d%s in range %llx:%llx\n", + (setLockFlag?"ON":"OFF"), pFile->h, (pb.fd==-1?"[testval-1]":""),+ offset, length));+ err = fsctl(path, afpfsByteRangeLock2FSCTL, &pb, 0);+ if ( err==-1 ) {+ int rc;+ int tErrno = errno;+ OSTRACE(("AFPSETLOCK failed to fsctl() '%s' %d %s\n",+ path, tErrno, strerror(tErrno)));+#ifdef SQLITE_IGNORE_AFP_LOCK_ERRORS+ rc = SQLITE_BUSY;+#else+ rc = sqliteErrorFromPosixError(tErrno,+ setLockFlag ? SQLITE_IOERR_LOCK : SQLITE_IOERR_UNLOCK);+#endif /* SQLITE_IGNORE_AFP_LOCK_ERRORS */+ if( IS_LOCK_ERROR(rc) ){+ storeLastErrno(pFile, tErrno);+ }+ return rc;+ } else {+ return SQLITE_OK;+ }+}++/*+** This routine checks if there is a RESERVED lock held on the specified+** file by this or any other process. If such a lock is held, set *pResOut+** to a non-zero value otherwise *pResOut is set to zero. The return value+** is set to SQLITE_OK unless an I/O error occurs during lock checking.+*/+static int afpCheckReservedLock(sqlite3_file *id, int *pResOut){+ int rc = SQLITE_OK;+ int reserved = 0;+ unixFile *pFile = (unixFile*)id;+ afpLockingContext *context;+ + SimulateIOError( return SQLITE_IOERR_CHECKRESERVEDLOCK; );+ + assert( pFile );+ context = (afpLockingContext *) pFile->lockingContext;+ if( context->reserved ){+ *pResOut = 1;+ return SQLITE_OK;+ }+ unixEnterMutex(); /* Because pFile->pInode is shared across threads */+ + /* Check if a thread in this process holds such a lock */+ if( pFile->pInode->eFileLock>SHARED_LOCK ){+ reserved = 1;+ }+ + /* Otherwise see if some other process holds it.+ */+ if( !reserved ){+ /* lock the RESERVED byte */+ int lrc = afpSetLock(context->dbPath, pFile, RESERVED_BYTE, 1,1); + if( SQLITE_OK==lrc ){+ /* if we succeeded in taking the reserved lock, unlock it to restore+ ** the original state */+ lrc = afpSetLock(context->dbPath, pFile, RESERVED_BYTE, 1, 0);+ } else {+ /* if we failed to get the lock then someone else must have it */+ reserved = 1;+ }+ if( IS_LOCK_ERROR(lrc) ){+ rc=lrc;+ }+ }+ + unixLeaveMutex();+ OSTRACE(("TEST WR-LOCK %d %d %d (afp)\n", pFile->h, rc, reserved));+ + *pResOut = reserved;+ return rc;+}++/*+** Lock the file with the lock specified by parameter eFileLock - one+** of the following:+**+** (1) SHARED_LOCK+** (2) RESERVED_LOCK+** (3) PENDING_LOCK+** (4) EXCLUSIVE_LOCK+**+** Sometimes when requesting one lock state, additional lock states+** are inserted in between. The locking might fail on one of the later+** transitions leaving the lock state different from what it started but+** still short of its goal. The following chart shows the allowed+** transitions and the inserted intermediate states:+**+** UNLOCKED -> SHARED+** SHARED -> RESERVED+** SHARED -> (PENDING) -> EXCLUSIVE+** RESERVED -> (PENDING) -> EXCLUSIVE+** PENDING -> EXCLUSIVE+**+** This routine will only increase a lock. Use the sqlite3OsUnlock()+** routine to lower a locking level.+*/+static int afpLock(sqlite3_file *id, int eFileLock){+ int rc = SQLITE_OK;+ unixFile *pFile = (unixFile*)id;+ unixInodeInfo *pInode = pFile->pInode;+ afpLockingContext *context = (afpLockingContext *) pFile->lockingContext;+ + assert( pFile );+ OSTRACE(("LOCK %d %s was %s(%s,%d) pid=%d (afp)\n", pFile->h,+ azFileLock(eFileLock), azFileLock(pFile->eFileLock),+ azFileLock(pInode->eFileLock), pInode->nShared , osGetpid(0)));++ /* If there is already a lock of this type or more restrictive on the+ ** unixFile, do nothing. Don't use the afp_end_lock: exit path, as+ ** unixEnterMutex() hasn't been called yet.+ */+ if( pFile->eFileLock>=eFileLock ){+ OSTRACE(("LOCK %d %s ok (already held) (afp)\n", pFile->h,+ azFileLock(eFileLock)));+ return SQLITE_OK;+ }++ /* Make sure the locking sequence is correct+ ** (1) We never move from unlocked to anything higher than shared lock.+ ** (2) SQLite never explicitly requests a pendig lock.+ ** (3) A shared lock is always held when a reserve lock is requested.+ */+ assert( pFile->eFileLock!=NO_LOCK || eFileLock==SHARED_LOCK );+ assert( eFileLock!=PENDING_LOCK );+ assert( eFileLock!=RESERVED_LOCK || pFile->eFileLock==SHARED_LOCK );+ + /* This mutex is needed because pFile->pInode is shared across threads+ */+ unixEnterMutex();+ pInode = pFile->pInode;++ /* If some thread using this PID has a lock via a different unixFile*+ ** handle that precludes the requested lock, return BUSY.+ */+ if( (pFile->eFileLock!=pInode->eFileLock && + (pInode->eFileLock>=PENDING_LOCK || eFileLock>SHARED_LOCK))+ ){+ rc = SQLITE_BUSY;+ goto afp_end_lock;+ }+ + /* If a SHARED lock is requested, and some thread using this PID already+ ** has a SHARED or RESERVED lock, then increment reference counts and+ ** return SQLITE_OK.+ */+ if( eFileLock==SHARED_LOCK && + (pInode->eFileLock==SHARED_LOCK || pInode->eFileLock==RESERVED_LOCK) ){+ assert( eFileLock==SHARED_LOCK );+ assert( pFile->eFileLock==0 );+ assert( pInode->nShared>0 );+ pFile->eFileLock = SHARED_LOCK;+ pInode->nShared++;+ pInode->nLock++;+ goto afp_end_lock;+ }+ + /* A PENDING lock is needed before acquiring a SHARED lock and before+ ** acquiring an EXCLUSIVE lock. For the SHARED lock, the PENDING will+ ** be released.+ */+ if( eFileLock==SHARED_LOCK + || (eFileLock==EXCLUSIVE_LOCK && pFile->eFileLock<PENDING_LOCK)+ ){+ int failed;+ failed = afpSetLock(context->dbPath, pFile, PENDING_BYTE, 1, 1);+ if (failed) {+ rc = failed;+ goto afp_end_lock;+ }+ }+ + /* If control gets to this point, then actually go ahead and make+ ** operating system calls for the specified lock.+ */+ if( eFileLock==SHARED_LOCK ){+ int lrc1, lrc2, lrc1Errno = 0;+ long lk, mask;+ + assert( pInode->nShared==0 );+ assert( pInode->eFileLock==0 );+ + mask = (sizeof(long)==8) ? LARGEST_INT64 : 0x7fffffff;+ /* Now get the read-lock SHARED_LOCK */+ /* note that the quality of the randomness doesn't matter that much */+ lk = random(); + pInode->sharedByte = (lk & mask)%(SHARED_SIZE - 1);+ lrc1 = afpSetLock(context->dbPath, pFile, + SHARED_FIRST+pInode->sharedByte, 1, 1);+ if( IS_LOCK_ERROR(lrc1) ){+ lrc1Errno = pFile->lastErrno;+ }+ /* Drop the temporary PENDING lock */+ lrc2 = afpSetLock(context->dbPath, pFile, PENDING_BYTE, 1, 0);+ + if( IS_LOCK_ERROR(lrc1) ) {+ storeLastErrno(pFile, lrc1Errno);+ rc = lrc1;+ goto afp_end_lock;+ } else if( IS_LOCK_ERROR(lrc2) ){+ rc = lrc2;+ goto afp_end_lock;+ } else if( lrc1 != SQLITE_OK ) {+ rc = lrc1;+ } else {+ pFile->eFileLock = SHARED_LOCK;+ pInode->nLock++;+ pInode->nShared = 1;+ }+ }else if( eFileLock==EXCLUSIVE_LOCK && pInode->nShared>1 ){+ /* We are trying for an exclusive lock but another thread in this+ ** same process is still holding a shared lock. */+ rc = SQLITE_BUSY;+ }else{+ /* The request was for a RESERVED or EXCLUSIVE lock. It is+ ** assumed that there is a SHARED or greater lock on the file+ ** already.+ */+ int failed = 0;+ assert( 0!=pFile->eFileLock );+ if (eFileLock >= RESERVED_LOCK && pFile->eFileLock < RESERVED_LOCK) {+ /* Acquire a RESERVED lock */+ failed = afpSetLock(context->dbPath, pFile, RESERVED_BYTE, 1,1);+ if( !failed ){+ context->reserved = 1;+ }+ }+ if (!failed && eFileLock == EXCLUSIVE_LOCK) {+ /* Acquire an EXCLUSIVE lock */+ + /* Remove the shared lock before trying the range. we'll need to + ** reestablish the shared lock if we can't get the afpUnlock+ */+ if( !(failed = afpSetLock(context->dbPath, pFile, SHARED_FIRST ++ pInode->sharedByte, 1, 0)) ){+ int failed2 = SQLITE_OK;+ /* now attemmpt to get the exclusive lock range */+ failed = afpSetLock(context->dbPath, pFile, SHARED_FIRST, + SHARED_SIZE, 1);+ if( failed && (failed2 = afpSetLock(context->dbPath, pFile, + SHARED_FIRST + pInode->sharedByte, 1, 1)) ){+ /* Can't reestablish the shared lock. Sqlite can't deal, this is+ ** a critical I/O error+ */+ rc = ((failed & SQLITE_IOERR) == SQLITE_IOERR) ? failed2 : + SQLITE_IOERR_LOCK;+ goto afp_end_lock;+ } + }else{+ rc = failed; + }+ }+ if( failed ){+ rc = failed;+ }+ }+ + if( rc==SQLITE_OK ){+ pFile->eFileLock = eFileLock;+ pInode->eFileLock = eFileLock;+ }else if( eFileLock==EXCLUSIVE_LOCK ){+ pFile->eFileLock = PENDING_LOCK;+ pInode->eFileLock = PENDING_LOCK;+ }+ +afp_end_lock:+ unixLeaveMutex();+ OSTRACE(("LOCK %d %s %s (afp)\n", pFile->h, azFileLock(eFileLock), + rc==SQLITE_OK ? "ok" : "failed"));+ return rc;+}++/*+** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+*/+static int afpUnlock(sqlite3_file *id, int eFileLock) {+ int rc = SQLITE_OK;+ unixFile *pFile = (unixFile*)id;+ unixInodeInfo *pInode;+ afpLockingContext *context = (afpLockingContext *) pFile->lockingContext;+ int skipShared = 0;+#ifdef SQLITE_TEST+ int h = pFile->h;+#endif++ assert( pFile );+ OSTRACE(("UNLOCK %d %d was %d(%d,%d) pid=%d (afp)\n", pFile->h, eFileLock,+ pFile->eFileLock, pFile->pInode->eFileLock, pFile->pInode->nShared,+ osGetpid(0)));++ assert( eFileLock<=SHARED_LOCK );+ if( pFile->eFileLock<=eFileLock ){+ return SQLITE_OK;+ }+ unixEnterMutex();+ pInode = pFile->pInode;+ assert( pInode->nShared!=0 );+ if( pFile->eFileLock>SHARED_LOCK ){+ assert( pInode->eFileLock==pFile->eFileLock );+ SimulateIOErrorBenign(1);+ SimulateIOError( h=(-1) )+ SimulateIOErrorBenign(0);+ +#ifdef SQLITE_DEBUG+ /* When reducing a lock such that other processes can start+ ** reading the database file again, make sure that the+ ** transaction counter was updated if any part of the database+ ** file changed. If the transaction counter is not updated,+ ** other connections to the same file might not realize that+ ** the file has changed and hence might not know to flush their+ ** cache. The use of a stale cache can lead to database corruption.+ */+ assert( pFile->inNormalWrite==0+ || pFile->dbUpdate==0+ || pFile->transCntrChng==1 );+ pFile->inNormalWrite = 0;+#endif+ + if( pFile->eFileLock==EXCLUSIVE_LOCK ){+ rc = afpSetLock(context->dbPath, pFile, SHARED_FIRST, SHARED_SIZE, 0);+ if( rc==SQLITE_OK && (eFileLock==SHARED_LOCK || pInode->nShared>1) ){+ /* only re-establish the shared lock if necessary */+ int sharedLockByte = SHARED_FIRST+pInode->sharedByte;+ rc = afpSetLock(context->dbPath, pFile, sharedLockByte, 1, 1);+ } else {+ skipShared = 1;+ }+ }+ if( rc==SQLITE_OK && pFile->eFileLock>=PENDING_LOCK ){+ rc = afpSetLock(context->dbPath, pFile, PENDING_BYTE, 1, 0);+ } + if( rc==SQLITE_OK && pFile->eFileLock>=RESERVED_LOCK && context->reserved ){+ rc = afpSetLock(context->dbPath, pFile, RESERVED_BYTE, 1, 0);+ if( !rc ){ + context->reserved = 0; + }+ }+ if( rc==SQLITE_OK && (eFileLock==SHARED_LOCK || pInode->nShared>1)){+ pInode->eFileLock = SHARED_LOCK;+ }+ }+ if( rc==SQLITE_OK && eFileLock==NO_LOCK ){++ /* Decrement the shared lock counter. Release the lock using an+ ** OS call only when all threads in this same process have released+ ** the lock.+ */+ unsigned long long sharedLockByte = SHARED_FIRST+pInode->sharedByte;+ pInode->nShared--;+ if( pInode->nShared==0 ){+ SimulateIOErrorBenign(1);+ SimulateIOError( h=(-1) )+ SimulateIOErrorBenign(0);+ if( !skipShared ){+ rc = afpSetLock(context->dbPath, pFile, sharedLockByte, 1, 0);+ }+ if( !rc ){+ pInode->eFileLock = NO_LOCK;+ pFile->eFileLock = NO_LOCK;+ }+ }+ if( rc==SQLITE_OK ){+ pInode->nLock--;+ assert( pInode->nLock>=0 );+ if( pInode->nLock==0 ){+ closePendingFds(pFile);+ }+ }+ }+ + unixLeaveMutex();+ if( rc==SQLITE_OK ) pFile->eFileLock = eFileLock;+ return rc;+}++/*+** Close a file & cleanup AFP specific locking context +*/+static int afpClose(sqlite3_file *id) {+ int rc = SQLITE_OK;+ if( id ){+ unixFile *pFile = (unixFile*)id;+ afpUnlock(id, NO_LOCK);+ unixEnterMutex();+ if( pFile->pInode && pFile->pInode->nLock ){+ /* If there are outstanding locks, do not actually close the file just+ ** yet because that would clear those locks. Instead, add the file+ ** descriptor to pInode->aPending. It will be automatically closed when+ ** the last lock is cleared.+ */+ setPendingFd(pFile);+ }+ releaseInodeInfo(pFile);+ sqlite3_free(pFile->lockingContext);+ rc = closeUnixFile(id);+ unixLeaveMutex();+ }+ return rc;+}++#endif /* defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE */+/*+** The code above is the AFP lock implementation. The code is specific+** to MacOSX and does not work on other unix platforms. No alternative+** is available. If you don't compile for a mac, then the "unix-afp"+** VFS is not available.+**+********************* End of the AFP lock implementation **********************+******************************************************************************/++/******************************************************************************+*************************** Begin NFS Locking ********************************/++#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+/*+ ** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+ ** must be either NO_LOCK or SHARED_LOCK.+ **+ ** If the locking level of the file descriptor is already at or below+ ** the requested locking level, this routine is a no-op.+ */+static int nfsUnlock(sqlite3_file *id, int eFileLock){+ return posixUnlock(id, eFileLock, 1);+}++#endif /* defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE */+/*+** The code above is the NFS lock implementation. The code is specific+** to MacOSX and does not work on other unix platforms. No alternative+** is available. +**+********************* End of the NFS lock implementation **********************+******************************************************************************/++/******************************************************************************+**************** Non-locking sqlite3_file methods *****************************+**+** The next division contains implementations for all methods of the +** sqlite3_file object other than the locking methods. The locking+** methods were defined in divisions above (one locking method per+** division). Those methods that are common to all locking modes+** are gather together into this division.+*/++/*+** Seek to the offset passed as the second argument, then read cnt +** bytes into pBuf. Return the number of bytes actually read.+**+** NB: If you define USE_PREAD or USE_PREAD64, then it might also+** be necessary to define _XOPEN_SOURCE to be 500. This varies from+** one system to another. Since SQLite does not define USE_PREAD+** in any form by default, we will not attempt to define _XOPEN_SOURCE.+** See tickets #2741 and #2681.+**+** To avoid stomping the errno value on a failed read the lastErrno value+** is set before returning.+*/+static int seekAndRead(unixFile *id, sqlite3_int64 offset, void *pBuf, int cnt){+ int got;+ int prior = 0;+#if (!defined(USE_PREAD) && !defined(USE_PREAD64))+ i64 newOffset;+#endif+ TIMER_START;+ assert( cnt==(cnt&0x1ffff) );+ assert( id->h>2 );+ do{+#if defined(USE_PREAD)+ got = osPread(id->h, pBuf, cnt, offset);+ SimulateIOError( got = -1 );+#elif defined(USE_PREAD64)+ got = osPread64(id->h, pBuf, cnt, offset);+ SimulateIOError( got = -1 );+#else+ newOffset = lseek(id->h, offset, SEEK_SET);+ SimulateIOError( newOffset-- );+ if( newOffset!=offset ){+ if( newOffset == -1 ){+ storeLastErrno((unixFile*)id, errno);+ }else{+ storeLastErrno((unixFile*)id, 0);+ }+ return -1;+ }+ got = osRead(id->h, pBuf, cnt);+#endif+ if( got==cnt ) break;+ if( got<0 ){+ if( errno==EINTR ){ got = 1; continue; }+ prior = 0;+ storeLastErrno((unixFile*)id, errno);+ break;+ }else if( got>0 ){+ cnt -= got;+ offset += got;+ prior += got;+ pBuf = (void*)(got + (char*)pBuf);+ }+ }while( got>0 );+ TIMER_END;+ OSTRACE(("READ %-3d %5d %7lld %llu\n",+ id->h, got+prior, offset-prior, TIMER_ELAPSED));+ return got+prior;+}++/*+** Read data from a file into a buffer. Return SQLITE_OK if all+** bytes were read successfully and SQLITE_IOERR if anything goes+** wrong.+*/+static int unixRead(+ sqlite3_file *id, + void *pBuf, + int amt,+ sqlite3_int64 offset+){+ unixFile *pFile = (unixFile *)id;+ int got;+ assert( id );+ assert( offset>=0 );+ assert( amt>0 );++ /* If this is a database file (not a journal, master-journal or temp+ ** file), the bytes in the locking range should never be read or written. */+#if 0+ assert( pFile->pUnused==0+ || offset>=PENDING_BYTE+512+ || offset+amt<=PENDING_BYTE + );+#endif++#if SQLITE_MAX_MMAP_SIZE>0+ /* Deal with as much of this read request as possible by transfering+ ** data from the memory mapping using memcpy(). */+ if( offset<pFile->mmapSize ){+ if( offset+amt <= pFile->mmapSize ){+ memcpy(pBuf, &((u8 *)(pFile->pMapRegion))[offset], amt);+ return SQLITE_OK;+ }else{+ int nCopy = pFile->mmapSize - offset;+ memcpy(pBuf, &((u8 *)(pFile->pMapRegion))[offset], nCopy);+ pBuf = &((u8 *)pBuf)[nCopy];+ amt -= nCopy;+ offset += nCopy;+ }+ }+#endif++ got = seekAndRead(pFile, offset, pBuf, amt);+ if( got==amt ){+ return SQLITE_OK;+ }else if( got<0 ){+ /* lastErrno set by seekAndRead */+ return SQLITE_IOERR_READ;+ }else{+ storeLastErrno(pFile, 0); /* not a system error */+ /* Unread parts of the buffer must be zero-filled */+ memset(&((char*)pBuf)[got], 0, amt-got);+ return SQLITE_IOERR_SHORT_READ;+ }+}++/*+** Attempt to seek the file-descriptor passed as the first argument to+** absolute offset iOff, then attempt to write nBuf bytes of data from+** pBuf to it. If an error occurs, return -1 and set *piErrno. Otherwise, +** return the actual number of bytes written (which may be less than+** nBuf).+*/+static int seekAndWriteFd(+ int fd, /* File descriptor to write to */+ i64 iOff, /* File offset to begin writing at */+ const void *pBuf, /* Copy data from this buffer to the file */+ int nBuf, /* Size of buffer pBuf in bytes */+ int *piErrno /* OUT: Error number if error occurs */+){+ int rc = 0; /* Value returned by system call */++ assert( nBuf==(nBuf&0x1ffff) );+ assert( fd>2 );+ nBuf &= 0x1ffff;+ TIMER_START;++#if defined(USE_PREAD)+ do{ rc = (int)osPwrite(fd, pBuf, nBuf, iOff); }while( rc<0 && errno==EINTR );+#elif defined(USE_PREAD64)+ do{ rc = (int)osPwrite64(fd, pBuf, nBuf, iOff);}while( rc<0 && errno==EINTR);+#else+ do{+ i64 iSeek = lseek(fd, iOff, SEEK_SET);+ SimulateIOError( iSeek-- );++ if( iSeek!=iOff ){+ if( piErrno ) *piErrno = (iSeek==-1 ? errno : 0);+ return -1;+ }+ rc = osWrite(fd, pBuf, nBuf);+ }while( rc<0 && errno==EINTR );+#endif++ TIMER_END;+ OSTRACE(("WRITE %-3d %5d %7lld %llu\n", fd, rc, iOff, TIMER_ELAPSED));++ if( rc<0 && piErrno ) *piErrno = errno;+ return rc;+}+++/*+** Seek to the offset in id->offset then read cnt bytes into pBuf.+** Return the number of bytes actually read. Update the offset.+**+** To avoid stomping the errno value on a failed write the lastErrno value+** is set before returning.+*/+static int seekAndWrite(unixFile *id, i64 offset, const void *pBuf, int cnt){+ return seekAndWriteFd(id->h, offset, pBuf, cnt, &id->lastErrno);+}+++/*+** Write data from a buffer into a file. Return SQLITE_OK on success+** or some other error code on failure.+*/+static int unixWrite(+ sqlite3_file *id, + const void *pBuf, + int amt,+ sqlite3_int64 offset +){+ unixFile *pFile = (unixFile*)id;+ int wrote = 0;+ assert( id );+ assert( amt>0 );++ /* If this is a database file (not a journal, master-journal or temp+ ** file), the bytes in the locking range should never be read or written. */+#if 0+ assert( pFile->pUnused==0+ || offset>=PENDING_BYTE+512+ || offset+amt<=PENDING_BYTE + );+#endif++#ifdef SQLITE_DEBUG+ /* If we are doing a normal write to a database file (as opposed to+ ** doing a hot-journal rollback or a write to some file other than a+ ** normal database file) then record the fact that the database+ ** has changed. If the transaction counter is modified, record that+ ** fact too.+ */+ if( pFile->inNormalWrite ){+ pFile->dbUpdate = 1; /* The database has been modified */+ if( offset<=24 && offset+amt>=27 ){+ int rc;+ char oldCntr[4];+ SimulateIOErrorBenign(1);+ rc = seekAndRead(pFile, 24, oldCntr, 4);+ SimulateIOErrorBenign(0);+ if( rc!=4 || memcmp(oldCntr, &((char*)pBuf)[24-offset], 4)!=0 ){+ pFile->transCntrChng = 1; /* The transaction counter has changed */+ }+ }+ }+#endif++#if SQLITE_MAX_MMAP_SIZE>0+ /* Deal with as much of this write request as possible by transfering+ ** data from the memory mapping using memcpy(). */+ if( offset<pFile->mmapSize ){+ if( offset+amt <= pFile->mmapSize ){+ memcpy(&((u8 *)(pFile->pMapRegion))[offset], pBuf, amt);+ return SQLITE_OK;+ }else{+ int nCopy = pFile->mmapSize - offset;+ memcpy(&((u8 *)(pFile->pMapRegion))[offset], pBuf, nCopy);+ pBuf = &((u8 *)pBuf)[nCopy];+ amt -= nCopy;+ offset += nCopy;+ }+ }+#endif+ + while( (wrote = seekAndWrite(pFile, offset, pBuf, amt))<amt && wrote>0 ){+ amt -= wrote;+ offset += wrote;+ pBuf = &((char*)pBuf)[wrote];+ }+ SimulateIOError(( wrote=(-1), amt=1 ));+ SimulateDiskfullError(( wrote=0, amt=1 ));++ if( amt>wrote ){+ if( wrote<0 && pFile->lastErrno!=ENOSPC ){+ /* lastErrno set by seekAndWrite */+ return SQLITE_IOERR_WRITE;+ }else{+ storeLastErrno(pFile, 0); /* not a system error */+ return SQLITE_FULL;+ }+ }++ return SQLITE_OK;+}++#ifdef SQLITE_TEST+/*+** Count the number of fullsyncs and normal syncs. This is used to test+** that syncs and fullsyncs are occurring at the right times.+*/+SQLITE_PRIVATE int sqlite3_sync_count = 0;+SQLITE_PRIVATE int sqlite3_fullsync_count = 0;+#endif++/*+** We do not trust systems to provide a working fdatasync(). Some do.+** Others do no. To be safe, we will stick with the (slightly slower)+** fsync(). If you know that your system does support fdatasync() correctly,+** then simply compile with -Dfdatasync=fdatasync or -DHAVE_FDATASYNC+*/+#if !defined(fdatasync) && !HAVE_FDATASYNC+# define fdatasync fsync+#endif++/*+** Define HAVE_FULLFSYNC to 0 or 1 depending on whether or not+** the F_FULLFSYNC macro is defined. F_FULLFSYNC is currently+** only available on Mac OS X. But that could change.+*/+#ifdef F_FULLFSYNC+# define HAVE_FULLFSYNC 1+#else+# define HAVE_FULLFSYNC 0+#endif+++/*+** The fsync() system call does not work as advertised on many+** unix systems. The following procedure is an attempt to make+** it work better.+**+** The SQLITE_NO_SYNC macro disables all fsync()s. This is useful+** for testing when we want to run through the test suite quickly.+** You are strongly advised *not* to deploy with SQLITE_NO_SYNC+** enabled, however, since with SQLITE_NO_SYNC enabled, an OS crash+** or power failure will likely corrupt the database file.+**+** SQLite sets the dataOnly flag if the size of the file is unchanged.+** The idea behind dataOnly is that it should only write the file content+** to disk, not the inode. We only set dataOnly if the file size is +** unchanged since the file size is part of the inode. However, +** Ted Ts'o tells us that fdatasync() will also write the inode if the+** file size has changed. The only real difference between fdatasync()+** and fsync(), Ted tells us, is that fdatasync() will not flush the+** inode if the mtime or owner or other inode attributes have changed.+** We only care about the file size, not the other file attributes, so+** as far as SQLite is concerned, an fdatasync() is always adequate.+** So, we always use fdatasync() if it is available, regardless of+** the value of the dataOnly flag.+*/+static int full_fsync(int fd, int fullSync, int dataOnly){+ int rc;++ /* The following "ifdef/elif/else/" block has the same structure as+ ** the one below. It is replicated here solely to avoid cluttering + ** up the real code with the UNUSED_PARAMETER() macros.+ */+#ifdef SQLITE_NO_SYNC+ UNUSED_PARAMETER(fd);+ UNUSED_PARAMETER(fullSync);+ UNUSED_PARAMETER(dataOnly);+#elif HAVE_FULLFSYNC+ UNUSED_PARAMETER(dataOnly);+#else+ UNUSED_PARAMETER(fullSync);+ UNUSED_PARAMETER(dataOnly);+#endif++ /* Record the number of times that we do a normal fsync() and + ** FULLSYNC. This is used during testing to verify that this procedure+ ** gets called with the correct arguments.+ */+#ifdef SQLITE_TEST+ if( fullSync ) sqlite3_fullsync_count++;+ sqlite3_sync_count++;+#endif++ /* If we compiled with the SQLITE_NO_SYNC flag, then syncing is a+ ** no-op+ */+#ifdef SQLITE_NO_SYNC+ rc = SQLITE_OK;+#elif HAVE_FULLFSYNC+ if( fullSync ){+ rc = osFcntl(fd, F_FULLFSYNC, 0);+ }else{+ rc = 1;+ }+ /* If the FULLFSYNC failed, fall back to attempting an fsync().+ ** It shouldn't be possible for fullfsync to fail on the local + ** file system (on OSX), so failure indicates that FULLFSYNC+ ** isn't supported for this file system. So, attempt an fsync + ** and (for now) ignore the overhead of a superfluous fcntl call. + ** It'd be better to detect fullfsync support once and avoid + ** the fcntl call every time sync is called.+ */+ if( rc ) rc = fsync(fd);++#elif defined(__APPLE__)+ /* fdatasync() on HFS+ doesn't yet flush the file size if it changed correctly+ ** so currently we default to the macro that redefines fdatasync to fsync+ */+ rc = fsync(fd);+#else + rc = fdatasync(fd);+#if OS_VXWORKS+ if( rc==-1 && errno==ENOTSUP ){+ rc = fsync(fd);+ }+#endif /* OS_VXWORKS */+#endif /* ifdef SQLITE_NO_SYNC elif HAVE_FULLFSYNC */++ if( OS_VXWORKS && rc!= -1 ){+ rc = 0;+ }+ return rc;+}++/*+** Open a file descriptor to the directory containing file zFilename.+** If successful, *pFd is set to the opened file descriptor and+** SQLITE_OK is returned. If an error occurs, either SQLITE_NOMEM+** or SQLITE_CANTOPEN is returned and *pFd is set to an undefined+** value.+**+** The directory file descriptor is used for only one thing - to+** fsync() a directory to make sure file creation and deletion events+** are flushed to disk. Such fsyncs are not needed on newer+** journaling filesystems, but are required on older filesystems.+**+** This routine can be overridden using the xSetSysCall interface.+** The ability to override this routine was added in support of the+** chromium sandbox. Opening a directory is a security risk (we are+** told) so making it overrideable allows the chromium sandbox to+** replace this routine with a harmless no-op. To make this routine+** a no-op, replace it with a stub that returns SQLITE_OK but leaves+** *pFd set to a negative number.+**+** If SQLITE_OK is returned, the caller is responsible for closing+** the file descriptor *pFd using close().+*/+static int openDirectory(const char *zFilename, int *pFd){+ int ii;+ int fd = -1;+ char zDirname[MAX_PATHNAME+1];++ sqlite3_snprintf(MAX_PATHNAME, zDirname, "%s", zFilename);+ for(ii=(int)strlen(zDirname); ii>1 && zDirname[ii]!='/'; ii--);+ if( ii>0 ){+ zDirname[ii] = '\0';+ fd = robust_open(zDirname, O_RDONLY|O_BINARY, 0);+ if( fd>=0 ){+ OSTRACE(("OPENDIR %-3d %s\n", fd, zDirname));+ }+ }+ *pFd = fd;+ return (fd>=0?SQLITE_OK:unixLogError(SQLITE_CANTOPEN_BKPT, "open", zDirname));+}++/*+** Make sure all writes to a particular file are committed to disk.+**+** If dataOnly==0 then both the file itself and its metadata (file+** size, access time, etc) are synced. If dataOnly!=0 then only the+** file data is synced.+**+** Under Unix, also make sure that the directory entry for the file+** has been created by fsync-ing the directory that contains the file.+** If we do not do this and we encounter a power failure, the directory+** entry for the journal might not exist after we reboot. The next+** SQLite to access the file will not know that the journal exists (because+** the directory entry for the journal was never created) and the transaction+** will not roll back - possibly leading to database corruption.+*/+static int unixSync(sqlite3_file *id, int flags){+ int rc;+ unixFile *pFile = (unixFile*)id;++ int isDataOnly = (flags&SQLITE_SYNC_DATAONLY);+ int isFullsync = (flags&0x0F)==SQLITE_SYNC_FULL;++ /* Check that one of SQLITE_SYNC_NORMAL or FULL was passed */+ assert((flags&0x0F)==SQLITE_SYNC_NORMAL+ || (flags&0x0F)==SQLITE_SYNC_FULL+ );++ /* Unix cannot, but some systems may return SQLITE_FULL from here. This+ ** line is to test that doing so does not cause any problems.+ */+ SimulateDiskfullError( return SQLITE_FULL );++ assert( pFile );+ OSTRACE(("SYNC %-3d\n", pFile->h));+ rc = full_fsync(pFile->h, isFullsync, isDataOnly);+ SimulateIOError( rc=1 );+ if( rc ){+ storeLastErrno(pFile, errno);+ return unixLogError(SQLITE_IOERR_FSYNC, "full_fsync", pFile->zPath);+ }++ /* Also fsync the directory containing the file if the DIRSYNC flag+ ** is set. This is a one-time occurrence. Many systems (examples: AIX)+ ** are unable to fsync a directory, so ignore errors on the fsync.+ */+ if( pFile->ctrlFlags & UNIXFILE_DIRSYNC ){+ int dirfd;+ OSTRACE(("DIRSYNC %s (have_fullfsync=%d fullsync=%d)\n", pFile->zPath,+ HAVE_FULLFSYNC, isFullsync));+ rc = osOpenDirectory(pFile->zPath, &dirfd);+ if( rc==SQLITE_OK && dirfd>=0 ){+ full_fsync(dirfd, 0, 0);+ robust_close(pFile, dirfd, __LINE__);+ }else if( rc==SQLITE_CANTOPEN ){+ rc = SQLITE_OK;+ }+ pFile->ctrlFlags &= ~UNIXFILE_DIRSYNC;+ }+ return rc;+}++/*+** Truncate an open file to a specified size+*/+static int unixTruncate(sqlite3_file *id, i64 nByte){+ unixFile *pFile = (unixFile *)id;+ int rc;+ assert( pFile );+ SimulateIOError( return SQLITE_IOERR_TRUNCATE );++ /* If the user has configured a chunk-size for this file, truncate the+ ** file so that it consists of an integer number of chunks (i.e. the+ ** actual file size after the operation may be larger than the requested+ ** size).+ */+ if( pFile->szChunk>0 ){+ nByte = ((nByte + pFile->szChunk - 1)/pFile->szChunk) * pFile->szChunk;+ }++ rc = robust_ftruncate(pFile->h, nByte);+ if( rc ){+ storeLastErrno(pFile, errno);+ return unixLogError(SQLITE_IOERR_TRUNCATE, "ftruncate", pFile->zPath);+ }else{+#ifdef SQLITE_DEBUG+ /* If we are doing a normal write to a database file (as opposed to+ ** doing a hot-journal rollback or a write to some file other than a+ ** normal database file) and we truncate the file to zero length,+ ** that effectively updates the change counter. This might happen+ ** when restoring a database using the backup API from a zero-length+ ** source.+ */+ if( pFile->inNormalWrite && nByte==0 ){+ pFile->transCntrChng = 1;+ }+#endif++#if SQLITE_MAX_MMAP_SIZE>0+ /* If the file was just truncated to a size smaller than the currently+ ** mapped region, reduce the effective mapping size as well. SQLite will+ ** use read() and write() to access data beyond this point from now on. + */+ if( nByte<pFile->mmapSize ){+ pFile->mmapSize = nByte;+ }+#endif++ return SQLITE_OK;+ }+}++/*+** Determine the current size of a file in bytes+*/+static int unixFileSize(sqlite3_file *id, i64 *pSize){+ int rc;+ struct stat buf;+ assert( id );+ rc = osFstat(((unixFile*)id)->h, &buf);+ SimulateIOError( rc=1 );+ if( rc!=0 ){+ storeLastErrno((unixFile*)id, errno);+ return SQLITE_IOERR_FSTAT;+ }+ *pSize = buf.st_size;++ /* When opening a zero-size database, the findInodeInfo() procedure+ ** writes a single byte into that file in order to work around a bug+ ** in the OS-X msdos filesystem. In order to avoid problems with upper+ ** layers, we need to report this file size as zero even though it is+ ** really 1. Ticket #3260.+ */+ if( *pSize==1 ) *pSize = 0;+++ return SQLITE_OK;+}++#if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__)+/*+** Handler for proxy-locking file-control verbs. Defined below in the+** proxying locking division.+*/+static int proxyFileControl(sqlite3_file*,int,void*);+#endif++/* +** This function is called to handle the SQLITE_FCNTL_SIZE_HINT +** file-control operation. Enlarge the database to nBytes in size+** (rounded up to the next chunk-size). If the database is already+** nBytes or larger, this routine is a no-op.+*/+static int fcntlSizeHint(unixFile *pFile, i64 nByte){+ if( pFile->szChunk>0 ){+ i64 nSize; /* Required file size */+ struct stat buf; /* Used to hold return values of fstat() */+ + if( osFstat(pFile->h, &buf) ){+ return SQLITE_IOERR_FSTAT;+ }++ nSize = ((nByte+pFile->szChunk-1) / pFile->szChunk) * pFile->szChunk;+ if( nSize>(i64)buf.st_size ){++#if defined(HAVE_POSIX_FALLOCATE) && HAVE_POSIX_FALLOCATE+ /* The code below is handling the return value of osFallocate() + ** correctly. posix_fallocate() is defined to "returns zero on success, + ** or an error number on failure". See the manpage for details. */+ int err;+ do{+ err = osFallocate(pFile->h, buf.st_size, nSize-buf.st_size);+ }while( err==EINTR );+ if( err ) return SQLITE_IOERR_WRITE;+#else+ /* If the OS does not have posix_fallocate(), fake it. Write a + ** single byte to the last byte in each block that falls entirely+ ** within the extended region. Then, if required, a single byte+ ** at offset (nSize-1), to set the size of the file correctly.+ ** This is a similar technique to that used by glibc on systems+ ** that do not have a real fallocate() call.+ */+ int nBlk = buf.st_blksize; /* File-system block size */+ int nWrite = 0; /* Number of bytes written by seekAndWrite */+ i64 iWrite; /* Next offset to write to */++ iWrite = ((buf.st_size + 2*nBlk - 1)/nBlk)*nBlk-1;+ assert( iWrite>=buf.st_size );+ assert( (iWrite/nBlk)==((buf.st_size+nBlk-1)/nBlk) );+ assert( ((iWrite+1)%nBlk)==0 );+ for(/*no-op*/; iWrite<nSize; iWrite+=nBlk ){+ nWrite = seekAndWrite(pFile, iWrite, "", 1);+ if( nWrite!=1 ) return SQLITE_IOERR_WRITE;+ }+ if( nWrite==0 || (nSize%nBlk) ){+ nWrite = seekAndWrite(pFile, nSize-1, "", 1);+ if( nWrite!=1 ) return SQLITE_IOERR_WRITE;+ }+#endif+ }+ }++#if SQLITE_MAX_MMAP_SIZE>0+ if( pFile->mmapSizeMax>0 && nByte>pFile->mmapSize ){+ int rc;+ if( pFile->szChunk<=0 ){+ if( robust_ftruncate(pFile->h, nByte) ){+ storeLastErrno(pFile, errno);+ return unixLogError(SQLITE_IOERR_TRUNCATE, "ftruncate", pFile->zPath);+ }+ }++ rc = unixMapfile(pFile, nByte);+ return rc;+ }+#endif++ return SQLITE_OK;+}++/*+** If *pArg is initially negative then this is a query. Set *pArg to+** 1 or 0 depending on whether or not bit mask of pFile->ctrlFlags is set.+**+** If *pArg is 0 or 1, then clear or set the mask bit of pFile->ctrlFlags.+*/+static void unixModeBit(unixFile *pFile, unsigned char mask, int *pArg){+ if( *pArg<0 ){+ *pArg = (pFile->ctrlFlags & mask)!=0;+ }else if( (*pArg)==0 ){+ pFile->ctrlFlags &= ~mask;+ }else{+ pFile->ctrlFlags |= mask;+ }+}++/* Forward declaration */+static int unixGetTempname(int nBuf, char *zBuf);++/*+** Information and control of an open file handle.+*/+static int unixFileControl(sqlite3_file *id, int op, void *pArg){+ unixFile *pFile = (unixFile*)id;+ switch( op ){+ case SQLITE_FCNTL_WAL_BLOCK: {+ /* pFile->ctrlFlags |= UNIXFILE_BLOCK; // Deferred feature */+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_LOCKSTATE: {+ *(int*)pArg = pFile->eFileLock;+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_LAST_ERRNO: {+ *(int*)pArg = pFile->lastErrno;+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_CHUNK_SIZE: {+ pFile->szChunk = *(int *)pArg;+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_SIZE_HINT: {+ int rc;+ SimulateIOErrorBenign(1);+ rc = fcntlSizeHint(pFile, *(i64 *)pArg);+ SimulateIOErrorBenign(0);+ return rc;+ }+ case SQLITE_FCNTL_PERSIST_WAL: {+ unixModeBit(pFile, UNIXFILE_PERSIST_WAL, (int*)pArg);+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_POWERSAFE_OVERWRITE: {+ unixModeBit(pFile, UNIXFILE_PSOW, (int*)pArg);+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_VFSNAME: {+ *(char**)pArg = sqlite3_mprintf("%s", pFile->pVfs->zName);+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_TEMPFILENAME: {+ char *zTFile = sqlite3_malloc64( pFile->pVfs->mxPathname );+ if( zTFile ){+ unixGetTempname(pFile->pVfs->mxPathname, zTFile);+ *(char**)pArg = zTFile;+ }+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_HAS_MOVED: {+ *(int*)pArg = fileHasMoved(pFile);+ return SQLITE_OK;+ }+#if SQLITE_MAX_MMAP_SIZE>0+ case SQLITE_FCNTL_MMAP_SIZE: {+ i64 newLimit = *(i64*)pArg;+ int rc = SQLITE_OK;+ if( newLimit>sqlite3GlobalConfig.mxMmap ){+ newLimit = sqlite3GlobalConfig.mxMmap;+ }+ *(i64*)pArg = pFile->mmapSizeMax;+ if( newLimit>=0 && newLimit!=pFile->mmapSizeMax && pFile->nFetchOut==0 ){+ pFile->mmapSizeMax = newLimit;+ if( pFile->mmapSize>0 ){+ unixUnmapfile(pFile);+ rc = unixMapfile(pFile, -1);+ }+ }+ return rc;+ }+#endif+#ifdef SQLITE_DEBUG+ /* The pager calls this method to signal that it has done+ ** a rollback and that the database is therefore unchanged and+ ** it hence it is OK for the transaction change counter to be+ ** unchanged.+ */+ case SQLITE_FCNTL_DB_UNCHANGED: {+ ((unixFile*)id)->dbUpdate = 0;+ return SQLITE_OK;+ }+#endif+#if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__)+ case SQLITE_FCNTL_SET_LOCKPROXYFILE:+ case SQLITE_FCNTL_GET_LOCKPROXYFILE: {+ return proxyFileControl(id,op,pArg);+ }+#endif /* SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__) */+ }+ return SQLITE_NOTFOUND;+}++/*+** Return the sector size in bytes of the underlying block device for+** the specified file. This is almost always 512 bytes, but may be+** larger for some devices.+**+** SQLite code assumes this function cannot fail. It also assumes that+** if two files are created in the same file-system directory (i.e.+** a database and its journal file) that the sector size will be the+** same for both.+*/+#ifndef __QNXNTO__ +static int unixSectorSize(sqlite3_file *NotUsed){+ UNUSED_PARAMETER(NotUsed);+ return SQLITE_DEFAULT_SECTOR_SIZE;+}+#endif++/*+** The following version of unixSectorSize() is optimized for QNX.+*/+#ifdef __QNXNTO__+#include <sys/dcmd_blk.h>+#include <sys/statvfs.h>+static int unixSectorSize(sqlite3_file *id){+ unixFile *pFile = (unixFile*)id;+ if( pFile->sectorSize == 0 ){+ struct statvfs fsInfo;+ + /* Set defaults for non-supported filesystems */+ pFile->sectorSize = SQLITE_DEFAULT_SECTOR_SIZE;+ pFile->deviceCharacteristics = 0;+ if( fstatvfs(pFile->h, &fsInfo) == -1 ) {+ return pFile->sectorSize;+ }++ if( !strcmp(fsInfo.f_basetype, "tmp") ) {+ pFile->sectorSize = fsInfo.f_bsize;+ pFile->deviceCharacteristics =+ SQLITE_IOCAP_ATOMIC4K | /* All ram filesystem writes are atomic */+ SQLITE_IOCAP_SAFE_APPEND | /* growing the file does not occur until+ ** the write succeeds */+ SQLITE_IOCAP_SEQUENTIAL | /* The ram filesystem has no write behind+ ** so it is ordered */+ 0;+ }else if( strstr(fsInfo.f_basetype, "etfs") ){+ pFile->sectorSize = fsInfo.f_bsize;+ pFile->deviceCharacteristics =+ /* etfs cluster size writes are atomic */+ (pFile->sectorSize / 512 * SQLITE_IOCAP_ATOMIC512) |+ SQLITE_IOCAP_SAFE_APPEND | /* growing the file does not occur until+ ** the write succeeds */+ SQLITE_IOCAP_SEQUENTIAL | /* The ram filesystem has no write behind+ ** so it is ordered */+ 0;+ }else if( !strcmp(fsInfo.f_basetype, "qnx6") ){+ pFile->sectorSize = fsInfo.f_bsize;+ pFile->deviceCharacteristics =+ SQLITE_IOCAP_ATOMIC | /* All filesystem writes are atomic */+ SQLITE_IOCAP_SAFE_APPEND | /* growing the file does not occur until+ ** the write succeeds */+ SQLITE_IOCAP_SEQUENTIAL | /* The ram filesystem has no write behind+ ** so it is ordered */+ 0;+ }else if( !strcmp(fsInfo.f_basetype, "qnx4") ){+ pFile->sectorSize = fsInfo.f_bsize;+ pFile->deviceCharacteristics =+ /* full bitset of atomics from max sector size and smaller */+ ((pFile->sectorSize / 512 * SQLITE_IOCAP_ATOMIC512) << 1) - 2 |+ SQLITE_IOCAP_SEQUENTIAL | /* The ram filesystem has no write behind+ ** so it is ordered */+ 0;+ }else if( strstr(fsInfo.f_basetype, "dos") ){+ pFile->sectorSize = fsInfo.f_bsize;+ pFile->deviceCharacteristics =+ /* full bitset of atomics from max sector size and smaller */+ ((pFile->sectorSize / 512 * SQLITE_IOCAP_ATOMIC512) << 1) - 2 |+ SQLITE_IOCAP_SEQUENTIAL | /* The ram filesystem has no write behind+ ** so it is ordered */+ 0;+ }else{+ pFile->deviceCharacteristics =+ SQLITE_IOCAP_ATOMIC512 | /* blocks are atomic */+ SQLITE_IOCAP_SAFE_APPEND | /* growing the file does not occur until+ ** the write succeeds */+ 0;+ }+ }+ /* Last chance verification. If the sector size isn't a multiple of 512+ ** then it isn't valid.*/+ if( pFile->sectorSize % 512 != 0 ){+ pFile->deviceCharacteristics = 0;+ pFile->sectorSize = SQLITE_DEFAULT_SECTOR_SIZE;+ }+ return pFile->sectorSize;+}+#endif /* __QNXNTO__ */++/*+** Return the device characteristics for the file.+**+** This VFS is set up to return SQLITE_IOCAP_POWERSAFE_OVERWRITE by default.+** However, that choice is controversial since technically the underlying+** file system does not always provide powersafe overwrites. (In other+** words, after a power-loss event, parts of the file that were never+** written might end up being altered.) However, non-PSOW behavior is very,+** very rare. And asserting PSOW makes a large reduction in the amount+** of required I/O for journaling, since a lot of padding is eliminated.+** Hence, while POWERSAFE_OVERWRITE is on by default, there is a file-control+** available to turn it off and URI query parameter available to turn it off.+*/+static int unixDeviceCharacteristics(sqlite3_file *id){+ unixFile *p = (unixFile*)id;+ int rc = 0;+#ifdef __QNXNTO__+ if( p->sectorSize==0 ) unixSectorSize(id);+ rc = p->deviceCharacteristics;+#endif+ if( p->ctrlFlags & UNIXFILE_PSOW ){+ rc |= SQLITE_IOCAP_POWERSAFE_OVERWRITE;+ }+ return rc;+}++#if !defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0++/*+** Return the system page size.+**+** This function should not be called directly by other code in this file. +** Instead, it should be called via macro osGetpagesize().+*/+static int unixGetpagesize(void){+#if OS_VXWORKS+ return 1024;+#elif defined(_BSD_SOURCE)+ return getpagesize();+#else+ return (int)sysconf(_SC_PAGESIZE);+#endif+}++#endif /* !defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0 */++#ifndef SQLITE_OMIT_WAL++/*+** Object used to represent an shared memory buffer. +**+** When multiple threads all reference the same wal-index, each thread+** has its own unixShm object, but they all point to a single instance+** of this unixShmNode object. In other words, each wal-index is opened+** only once per process.+**+** Each unixShmNode object is connected to a single unixInodeInfo object.+** We could coalesce this object into unixInodeInfo, but that would mean+** every open file that does not use shared memory (in other words, most+** open files) would have to carry around this extra information. So+** the unixInodeInfo object contains a pointer to this unixShmNode object+** and the unixShmNode object is created only when needed.+**+** unixMutexHeld() must be true when creating or destroying+** this object or while reading or writing the following fields:+**+** nRef+**+** The following fields are read-only after the object is created:+** +** fid+** zFilename+**+** Either unixShmNode.mutex must be held or unixShmNode.nRef==0 and+** unixMutexHeld() is true when reading or writing any other field+** in this structure.+*/+struct unixShmNode {+ unixInodeInfo *pInode; /* unixInodeInfo that owns this SHM node */+ sqlite3_mutex *mutex; /* Mutex to access this object */+ char *zFilename; /* Name of the mmapped file */+ int h; /* Open file descriptor */+ int szRegion; /* Size of shared-memory regions */+ u16 nRegion; /* Size of array apRegion */+ u8 isReadonly; /* True if read-only */+ char **apRegion; /* Array of mapped shared-memory regions */+ int nRef; /* Number of unixShm objects pointing to this */+ unixShm *pFirst; /* All unixShm objects pointing to this */+#ifdef SQLITE_DEBUG+ u8 exclMask; /* Mask of exclusive locks held */+ u8 sharedMask; /* Mask of shared locks held */+ u8 nextShmId; /* Next available unixShm.id value */+#endif+};++/*+** Structure used internally by this VFS to record the state of an+** open shared memory connection.+**+** The following fields are initialized when this object is created and+** are read-only thereafter:+**+** unixShm.pFile+** unixShm.id+**+** All other fields are read/write. The unixShm.pFile->mutex must be held+** while accessing any read/write fields.+*/+struct unixShm {+ unixShmNode *pShmNode; /* The underlying unixShmNode object */+ unixShm *pNext; /* Next unixShm with the same unixShmNode */+ u8 hasMutex; /* True if holding the unixShmNode mutex */+ u8 id; /* Id of this connection within its unixShmNode */+ u16 sharedMask; /* Mask of shared locks held */+ u16 exclMask; /* Mask of exclusive locks held */+};++/*+** Constants used for locking+*/+#define UNIX_SHM_BASE ((22+SQLITE_SHM_NLOCK)*4) /* first lock byte */+#define UNIX_SHM_DMS (UNIX_SHM_BASE+SQLITE_SHM_NLOCK) /* deadman switch */++/*+** Apply posix advisory locks for all bytes from ofst through ofst+n-1.+**+** Locks block if the mask is exactly UNIX_SHM_C and are non-blocking+** otherwise.+*/+static int unixShmSystemLock(+ unixFile *pFile, /* Open connection to the WAL file */+ int lockType, /* F_UNLCK, F_RDLCK, or F_WRLCK */+ int ofst, /* First byte of the locking range */+ int n /* Number of bytes to lock */+){+ unixShmNode *pShmNode; /* Apply locks to this open shared-memory segment */+ struct flock f; /* The posix advisory locking structure */+ int rc = SQLITE_OK; /* Result code form fcntl() */++ /* Access to the unixShmNode object is serialized by the caller */+ pShmNode = pFile->pInode->pShmNode;+ assert( sqlite3_mutex_held(pShmNode->mutex) || pShmNode->nRef==0 );++ /* Shared locks never span more than one byte */+ assert( n==1 || lockType!=F_RDLCK );++ /* Locks are within range */+ assert( n>=1 && n<SQLITE_SHM_NLOCK );++ if( pShmNode->h>=0 ){+ int lkType;+ /* Initialize the locking parameters */+ memset(&f, 0, sizeof(f));+ f.l_type = lockType;+ f.l_whence = SEEK_SET;+ f.l_start = ofst;+ f.l_len = n;++ lkType = (pFile->ctrlFlags & UNIXFILE_BLOCK)!=0 ? F_SETLKW : F_SETLK;+ rc = osFcntl(pShmNode->h, lkType, &f);+ rc = (rc!=(-1)) ? SQLITE_OK : SQLITE_BUSY;+ pFile->ctrlFlags &= ~UNIXFILE_BLOCK;+ }++ /* Update the global lock state and do debug tracing */+#ifdef SQLITE_DEBUG+ { u16 mask;+ OSTRACE(("SHM-LOCK "));+ mask = ofst>31 ? 0xffff : (1<<(ofst+n)) - (1<<ofst);+ if( rc==SQLITE_OK ){+ if( lockType==F_UNLCK ){+ OSTRACE(("unlock %d ok", ofst));+ pShmNode->exclMask &= ~mask;+ pShmNode->sharedMask &= ~mask;+ }else if( lockType==F_RDLCK ){+ OSTRACE(("read-lock %d ok", ofst));+ pShmNode->exclMask &= ~mask;+ pShmNode->sharedMask |= mask;+ }else{+ assert( lockType==F_WRLCK );+ OSTRACE(("write-lock %d ok", ofst));+ pShmNode->exclMask |= mask;+ pShmNode->sharedMask &= ~mask;+ }+ }else{+ if( lockType==F_UNLCK ){+ OSTRACE(("unlock %d failed", ofst));+ }else if( lockType==F_RDLCK ){+ OSTRACE(("read-lock failed"));+ }else{+ assert( lockType==F_WRLCK );+ OSTRACE(("write-lock %d failed", ofst));+ }+ }+ OSTRACE((" - afterwards %03x,%03x\n",+ pShmNode->sharedMask, pShmNode->exclMask));+ }+#endif++ return rc; +}++/*+** Return the minimum number of 32KB shm regions that should be mapped at+** a time, assuming that each mapping must be an integer multiple of the+** current system page-size.+**+** Usually, this is 1. The exception seems to be systems that are configured+** to use 64KB pages - in this case each mapping must cover at least two+** shm regions.+*/+static int unixShmRegionPerMap(void){+ int shmsz = 32*1024; /* SHM region size */+ int pgsz = osGetpagesize(); /* System page size */+ assert( ((pgsz-1)&pgsz)==0 ); /* Page size must be a power of 2 */+ if( pgsz<shmsz ) return 1;+ return pgsz/shmsz;+}++/*+** Purge the unixShmNodeList list of all entries with unixShmNode.nRef==0.+**+** This is not a VFS shared-memory method; it is a utility function called+** by VFS shared-memory methods.+*/+static void unixShmPurge(unixFile *pFd){+ unixShmNode *p = pFd->pInode->pShmNode;+ assert( unixMutexHeld() );+ if( p && p->nRef==0 ){+ int nShmPerMap = unixShmRegionPerMap();+ int i;+ assert( p->pInode==pFd->pInode );+ sqlite3_mutex_free(p->mutex);+ for(i=0; i<p->nRegion; i+=nShmPerMap){+ if( p->h>=0 ){+ osMunmap(p->apRegion[i], p->szRegion);+ }else{+ sqlite3_free(p->apRegion[i]);+ }+ }+ sqlite3_free(p->apRegion);+ if( p->h>=0 ){+ robust_close(pFd, p->h, __LINE__);+ p->h = -1;+ }+ p->pInode->pShmNode = 0;+ sqlite3_free(p);+ }+}++/*+** Open a shared-memory area associated with open database file pDbFd. +** This particular implementation uses mmapped files.+**+** The file used to implement shared-memory is in the same directory+** as the open database file and has the same name as the open database+** file with the "-shm" suffix added. For example, if the database file+** is "/home/user1/config.db" then the file that is created and mmapped+** for shared memory will be called "/home/user1/config.db-shm". +**+** Another approach to is to use files in /dev/shm or /dev/tmp or an+** some other tmpfs mount. But if a file in a different directory+** from the database file is used, then differing access permissions+** or a chroot() might cause two different processes on the same+** database to end up using different files for shared memory - +** meaning that their memory would not really be shared - resulting+** in database corruption. Nevertheless, this tmpfs file usage+** can be enabled at compile-time using -DSQLITE_SHM_DIRECTORY="/dev/shm"+** or the equivalent. The use of the SQLITE_SHM_DIRECTORY compile-time+** option results in an incompatible build of SQLite; builds of SQLite+** that with differing SQLITE_SHM_DIRECTORY settings attempt to use the+** same database file at the same time, database corruption will likely+** result. The SQLITE_SHM_DIRECTORY compile-time option is considered+** "unsupported" and may go away in a future SQLite release.+**+** When opening a new shared-memory file, if no other instances of that+** file are currently open, in this process or in other processes, then+** the file must be truncated to zero length or have its header cleared.+**+** If the original database file (pDbFd) is using the "unix-excl" VFS+** that means that an exclusive lock is held on the database file and+** that no other processes are able to read or write the database. In+** that case, we do not really need shared memory. No shared memory+** file is created. The shared memory will be simulated with heap memory.+*/+static int unixOpenSharedMemory(unixFile *pDbFd){+ struct unixShm *p = 0; /* The connection to be opened */+ struct unixShmNode *pShmNode; /* The underlying mmapped file */+ int rc; /* Result code */+ unixInodeInfo *pInode; /* The inode of fd */+ char *zShmFilename; /* Name of the file used for SHM */+ int nShmFilename; /* Size of the SHM filename in bytes */++ /* Allocate space for the new unixShm object. */+ p = sqlite3_malloc64( sizeof(*p) );+ if( p==0 ) return SQLITE_NOMEM;+ memset(p, 0, sizeof(*p));+ assert( pDbFd->pShm==0 );++ /* Check to see if a unixShmNode object already exists. Reuse an existing+ ** one if present. Create a new one if necessary.+ */+ unixEnterMutex();+ pInode = pDbFd->pInode;+ pShmNode = pInode->pShmNode;+ if( pShmNode==0 ){+ struct stat sStat; /* fstat() info for database file */+#ifndef SQLITE_SHM_DIRECTORY+ const char *zBasePath = pDbFd->zPath;+#endif++ /* Call fstat() to figure out the permissions on the database file. If+ ** a new *-shm file is created, an attempt will be made to create it+ ** with the same permissions.+ */+ if( osFstat(pDbFd->h, &sStat) && pInode->bProcessLock==0 ){+ rc = SQLITE_IOERR_FSTAT;+ goto shm_open_err;+ }++#ifdef SQLITE_SHM_DIRECTORY+ nShmFilename = sizeof(SQLITE_SHM_DIRECTORY) + 31;+#else+ nShmFilename = 6 + (int)strlen(zBasePath);+#endif+ pShmNode = sqlite3_malloc64( sizeof(*pShmNode) + nShmFilename );+ if( pShmNode==0 ){+ rc = SQLITE_NOMEM;+ goto shm_open_err;+ }+ memset(pShmNode, 0, sizeof(*pShmNode)+nShmFilename);+ zShmFilename = pShmNode->zFilename = (char*)&pShmNode[1];+#ifdef SQLITE_SHM_DIRECTORY+ sqlite3_snprintf(nShmFilename, zShmFilename, + SQLITE_SHM_DIRECTORY "/sqlite-shm-%x-%x",+ (u32)sStat.st_ino, (u32)sStat.st_dev);+#else+ sqlite3_snprintf(nShmFilename, zShmFilename, "%s-shm", zBasePath);+#endif+ pShmNode->h = -1;+ pDbFd->pInode->pShmNode = pShmNode;+ pShmNode->pInode = pDbFd->pInode;+ pShmNode->mutex = sqlite3_mutex_alloc(SQLITE_MUTEX_FAST);+ if( pShmNode->mutex==0 ){+ rc = SQLITE_NOMEM;+ goto shm_open_err;+ }++ if( pInode->bProcessLock==0 ){+ int openFlags = O_RDWR | O_CREAT;+ pShmNode->h = robust_open(zShmFilename, openFlags, (sStat.st_mode&0777));+ if( pShmNode->h<0 ){+ rc = unixLogError(SQLITE_CANTOPEN_BKPT, "open", zShmFilename);+ goto shm_open_err;+ }++ /* If this process is running as root, make sure that the SHM file+ ** is owned by the same user that owns the original database. Otherwise,+ ** the original owner will not be able to connect.+ */+ osFchown(pShmNode->h, sStat.st_uid, sStat.st_gid);+ + /* Check to see if another process is holding the dead-man switch.+ ** If not, truncate the file to zero length. + */+ rc = SQLITE_OK;+ if( unixShmSystemLock(pDbFd, F_WRLCK, UNIX_SHM_DMS, 1)==SQLITE_OK ){+ if( robust_ftruncate(pShmNode->h, 0) ){+ rc = unixLogError(SQLITE_IOERR_SHMOPEN, "ftruncate", zShmFilename);+ }+ }+ if( rc==SQLITE_OK ){+ rc = unixShmSystemLock(pDbFd, F_RDLCK, UNIX_SHM_DMS, 1);+ }+ if( rc ) goto shm_open_err;+ }+ }++ /* Make the new connection a child of the unixShmNode */+ p->pShmNode = pShmNode;+#ifdef SQLITE_DEBUG+ p->id = pShmNode->nextShmId++;+#endif+ pShmNode->nRef++;+ pDbFd->pShm = p;+ unixLeaveMutex();++ /* The reference count on pShmNode has already been incremented under+ ** the cover of the unixEnterMutex() mutex and the pointer from the+ ** new (struct unixShm) object to the pShmNode has been set. All that is+ ** left to do is to link the new object into the linked list starting+ ** at pShmNode->pFirst. This must be done while holding the pShmNode->mutex + ** mutex.+ */+ sqlite3_mutex_enter(pShmNode->mutex);+ p->pNext = pShmNode->pFirst;+ pShmNode->pFirst = p;+ sqlite3_mutex_leave(pShmNode->mutex);+ return SQLITE_OK;++ /* Jump here on any error */+shm_open_err:+ unixShmPurge(pDbFd); /* This call frees pShmNode if required */+ sqlite3_free(p);+ unixLeaveMutex();+ return rc;+}++/*+** This function is called to obtain a pointer to region iRegion of the +** shared-memory associated with the database file fd. Shared-memory regions +** are numbered starting from zero. Each shared-memory region is szRegion +** bytes in size.+**+** If an error occurs, an error code is returned and *pp is set to NULL.+**+** Otherwise, if the bExtend parameter is 0 and the requested shared-memory+** region has not been allocated (by any client, including one running in a+** separate process), then *pp is set to NULL and SQLITE_OK returned. If +** bExtend is non-zero and the requested shared-memory region has not yet +** been allocated, it is allocated by this function.+**+** If the shared-memory region has already been allocated or is allocated by+** this call as described above, then it is mapped into this processes +** address space (if it is not already), *pp is set to point to the mapped +** memory and SQLITE_OK returned.+*/+static int unixShmMap(+ sqlite3_file *fd, /* Handle open on database file */+ int iRegion, /* Region to retrieve */+ int szRegion, /* Size of regions */+ int bExtend, /* True to extend file if necessary */+ void volatile **pp /* OUT: Mapped memory */+){+ unixFile *pDbFd = (unixFile*)fd;+ unixShm *p;+ unixShmNode *pShmNode;+ int rc = SQLITE_OK;+ int nShmPerMap = unixShmRegionPerMap();+ int nReqRegion;++ /* If the shared-memory file has not yet been opened, open it now. */+ if( pDbFd->pShm==0 ){+ rc = unixOpenSharedMemory(pDbFd);+ if( rc!=SQLITE_OK ) return rc;+ }++ p = pDbFd->pShm;+ pShmNode = p->pShmNode;+ sqlite3_mutex_enter(pShmNode->mutex);+ assert( szRegion==pShmNode->szRegion || pShmNode->nRegion==0 );+ assert( pShmNode->pInode==pDbFd->pInode );+ assert( pShmNode->h>=0 || pDbFd->pInode->bProcessLock==1 );+ assert( pShmNode->h<0 || pDbFd->pInode->bProcessLock==0 );++ /* Minimum number of regions required to be mapped. */+ nReqRegion = ((iRegion+nShmPerMap) / nShmPerMap) * nShmPerMap;++ if( pShmNode->nRegion<nReqRegion ){+ char **apNew; /* New apRegion[] array */+ int nByte = nReqRegion*szRegion; /* Minimum required file size */+ struct stat sStat; /* Used by fstat() */++ pShmNode->szRegion = szRegion;++ if( pShmNode->h>=0 ){+ /* The requested region is not mapped into this processes address space.+ ** Check to see if it has been allocated (i.e. if the wal-index file is+ ** large enough to contain the requested region).+ */+ if( osFstat(pShmNode->h, &sStat) ){+ rc = SQLITE_IOERR_SHMSIZE;+ goto shmpage_out;+ }+ + if( sStat.st_size<nByte ){+ /* The requested memory region does not exist. If bExtend is set to+ ** false, exit early. *pp will be set to NULL and SQLITE_OK returned.+ */+ if( !bExtend ){+ goto shmpage_out;+ }++ /* Alternatively, if bExtend is true, extend the file. Do this by+ ** writing a single byte to the end of each (OS) page being+ ** allocated or extended. Technically, we need only write to the+ ** last page in order to extend the file. But writing to all new+ ** pages forces the OS to allocate them immediately, which reduces+ ** the chances of SIGBUS while accessing the mapped region later on.+ */+ else{+ static const int pgsz = 4096;+ int iPg;++ /* Write to the last byte of each newly allocated or extended page */+ assert( (nByte % pgsz)==0 );+ for(iPg=(sStat.st_size/pgsz); iPg<(nByte/pgsz); iPg++){+ if( seekAndWriteFd(pShmNode->h, iPg*pgsz + pgsz-1, "", 1, 0)!=1 ){+ const char *zFile = pShmNode->zFilename;+ rc = unixLogError(SQLITE_IOERR_SHMSIZE, "write", zFile);+ goto shmpage_out;+ }+ }+ }+ }+ }++ /* Map the requested memory region into this processes address space. */+ apNew = (char **)sqlite3_realloc(+ pShmNode->apRegion, nReqRegion*sizeof(char *)+ );+ if( !apNew ){+ rc = SQLITE_IOERR_NOMEM;+ goto shmpage_out;+ }+ pShmNode->apRegion = apNew;+ while( pShmNode->nRegion<nReqRegion ){+ int nMap = szRegion*nShmPerMap;+ int i;+ void *pMem;+ if( pShmNode->h>=0 ){+ pMem = osMmap(0, nMap,+ pShmNode->isReadonly ? PROT_READ : PROT_READ|PROT_WRITE, + MAP_SHARED, pShmNode->h, szRegion*(i64)pShmNode->nRegion+ );+ if( pMem==MAP_FAILED ){+ rc = unixLogError(SQLITE_IOERR_SHMMAP, "mmap", pShmNode->zFilename);+ goto shmpage_out;+ }+ }else{+ pMem = sqlite3_malloc64(szRegion);+ if( pMem==0 ){+ rc = SQLITE_NOMEM;+ goto shmpage_out;+ }+ memset(pMem, 0, szRegion);+ }++ for(i=0; i<nShmPerMap; i++){+ pShmNode->apRegion[pShmNode->nRegion+i] = &((char*)pMem)[szRegion*i];+ }+ pShmNode->nRegion += nShmPerMap;+ }+ }++shmpage_out:+ if( pShmNode->nRegion>iRegion ){+ *pp = pShmNode->apRegion[iRegion];+ }else{+ *pp = 0;+ }+ if( pShmNode->isReadonly && rc==SQLITE_OK ) rc = SQLITE_READONLY;+ sqlite3_mutex_leave(pShmNode->mutex);+ return rc;+}++/*+** Change the lock state for a shared-memory segment.+**+** Note that the relationship between SHAREd and EXCLUSIVE locks is a little+** different here than in posix. In xShmLock(), one can go from unlocked+** to shared and back or from unlocked to exclusive and back. But one may+** not go from shared to exclusive or from exclusive to shared.+*/+static int unixShmLock(+ sqlite3_file *fd, /* Database file holding the shared memory */+ int ofst, /* First lock to acquire or release */+ int n, /* Number of locks to acquire or release */+ int flags /* What to do with the lock */+){+ unixFile *pDbFd = (unixFile*)fd; /* Connection holding shared memory */+ unixShm *p = pDbFd->pShm; /* The shared memory being locked */+ unixShm *pX; /* For looping over all siblings */+ unixShmNode *pShmNode = p->pShmNode; /* The underlying file iNode */+ int rc = SQLITE_OK; /* Result code */+ u16 mask; /* Mask of locks to take or release */++ assert( pShmNode==pDbFd->pInode->pShmNode );+ assert( pShmNode->pInode==pDbFd->pInode );+ assert( ofst>=0 && ofst+n<=SQLITE_SHM_NLOCK );+ assert( n>=1 );+ assert( flags==(SQLITE_SHM_LOCK | SQLITE_SHM_SHARED)+ || flags==(SQLITE_SHM_LOCK | SQLITE_SHM_EXCLUSIVE)+ || flags==(SQLITE_SHM_UNLOCK | SQLITE_SHM_SHARED)+ || flags==(SQLITE_SHM_UNLOCK | SQLITE_SHM_EXCLUSIVE) );+ assert( n==1 || (flags & SQLITE_SHM_EXCLUSIVE)!=0 );+ assert( pShmNode->h>=0 || pDbFd->pInode->bProcessLock==1 );+ assert( pShmNode->h<0 || pDbFd->pInode->bProcessLock==0 );++ mask = (1<<(ofst+n)) - (1<<ofst);+ assert( n>1 || mask==(1<<ofst) );+ sqlite3_mutex_enter(pShmNode->mutex);+ if( flags & SQLITE_SHM_UNLOCK ){+ u16 allMask = 0; /* Mask of locks held by siblings */++ /* See if any siblings hold this same lock */+ for(pX=pShmNode->pFirst; pX; pX=pX->pNext){+ if( pX==p ) continue;+ assert( (pX->exclMask & (p->exclMask|p->sharedMask))==0 );+ allMask |= pX->sharedMask;+ }++ /* Unlock the system-level locks */+ if( (mask & allMask)==0 ){+ rc = unixShmSystemLock(pDbFd, F_UNLCK, ofst+UNIX_SHM_BASE, n);+ }else{+ rc = SQLITE_OK;+ }++ /* Undo the local locks */+ if( rc==SQLITE_OK ){+ p->exclMask &= ~mask;+ p->sharedMask &= ~mask;+ } + }else if( flags & SQLITE_SHM_SHARED ){+ u16 allShared = 0; /* Union of locks held by connections other than "p" */++ /* Find out which shared locks are already held by sibling connections.+ ** If any sibling already holds an exclusive lock, go ahead and return+ ** SQLITE_BUSY.+ */+ for(pX=pShmNode->pFirst; pX; pX=pX->pNext){+ if( (pX->exclMask & mask)!=0 ){+ rc = SQLITE_BUSY;+ break;+ }+ allShared |= pX->sharedMask;+ }++ /* Get shared locks at the system level, if necessary */+ if( rc==SQLITE_OK ){+ if( (allShared & mask)==0 ){+ rc = unixShmSystemLock(pDbFd, F_RDLCK, ofst+UNIX_SHM_BASE, n);+ }else{+ rc = SQLITE_OK;+ }+ }++ /* Get the local shared locks */+ if( rc==SQLITE_OK ){+ p->sharedMask |= mask;+ }+ }else{+ /* Make sure no sibling connections hold locks that will block this+ ** lock. If any do, return SQLITE_BUSY right away.+ */+ for(pX=pShmNode->pFirst; pX; pX=pX->pNext){+ if( (pX->exclMask & mask)!=0 || (pX->sharedMask & mask)!=0 ){+ rc = SQLITE_BUSY;+ break;+ }+ }+ + /* Get the exclusive locks at the system level. Then if successful+ ** also mark the local connection as being locked.+ */+ if( rc==SQLITE_OK ){+ rc = unixShmSystemLock(pDbFd, F_WRLCK, ofst+UNIX_SHM_BASE, n);+ if( rc==SQLITE_OK ){+ assert( (p->sharedMask & mask)==0 );+ p->exclMask |= mask;+ }+ }+ }+ sqlite3_mutex_leave(pShmNode->mutex);+ OSTRACE(("SHM-LOCK shmid-%d, pid-%d got %03x,%03x\n",+ p->id, osGetpid(0), p->sharedMask, p->exclMask));+ return rc;+}++/*+** Implement a memory barrier or memory fence on shared memory. +**+** All loads and stores begun before the barrier must complete before+** any load or store begun after the barrier.+*/+static void unixShmBarrier(+ sqlite3_file *fd /* Database file holding the shared memory */+){+ UNUSED_PARAMETER(fd);+ sqlite3MemoryBarrier(); /* compiler-defined memory barrier */+ unixEnterMutex(); /* Also mutex, for redundancy */+ unixLeaveMutex();+}++/*+** Close a connection to shared-memory. Delete the underlying +** storage if deleteFlag is true.+**+** If there is no shared memory associated with the connection then this+** routine is a harmless no-op.+*/+static int unixShmUnmap(+ sqlite3_file *fd, /* The underlying database file */+ int deleteFlag /* Delete shared-memory if true */+){+ unixShm *p; /* The connection to be closed */+ unixShmNode *pShmNode; /* The underlying shared-memory file */+ unixShm **pp; /* For looping over sibling connections */+ unixFile *pDbFd; /* The underlying database file */++ pDbFd = (unixFile*)fd;+ p = pDbFd->pShm;+ if( p==0 ) return SQLITE_OK;+ pShmNode = p->pShmNode;++ assert( pShmNode==pDbFd->pInode->pShmNode );+ assert( pShmNode->pInode==pDbFd->pInode );++ /* Remove connection p from the set of connections associated+ ** with pShmNode */+ sqlite3_mutex_enter(pShmNode->mutex);+ for(pp=&pShmNode->pFirst; (*pp)!=p; pp = &(*pp)->pNext){}+ *pp = p->pNext;++ /* Free the connection p */+ sqlite3_free(p);+ pDbFd->pShm = 0;+ sqlite3_mutex_leave(pShmNode->mutex);++ /* If pShmNode->nRef has reached 0, then close the underlying+ ** shared-memory file, too */+ unixEnterMutex();+ assert( pShmNode->nRef>0 );+ pShmNode->nRef--;+ if( pShmNode->nRef==0 ){+ if( deleteFlag && pShmNode->h>=0 ){+ osUnlink(pShmNode->zFilename);+ }+ unixShmPurge(pDbFd);+ }+ unixLeaveMutex();++ return SQLITE_OK;+}+++#else+# define unixShmMap 0+# define unixShmLock 0+# define unixShmBarrier 0+# define unixShmUnmap 0+#endif /* #ifndef SQLITE_OMIT_WAL */++#if SQLITE_MAX_MMAP_SIZE>0+/*+** If it is currently memory mapped, unmap file pFd.+*/+static void unixUnmapfile(unixFile *pFd){+ assert( pFd->nFetchOut==0 );+ if( pFd->pMapRegion ){+ osMunmap(pFd->pMapRegion, pFd->mmapSizeActual);+ pFd->pMapRegion = 0;+ pFd->mmapSize = 0;+ pFd->mmapSizeActual = 0;+ }+}++/*+** Attempt to set the size of the memory mapping maintained by file +** descriptor pFd to nNew bytes. Any existing mapping is discarded.+**+** If successful, this function sets the following variables:+**+** unixFile.pMapRegion+** unixFile.mmapSize+** unixFile.mmapSizeActual+**+** If unsuccessful, an error message is logged via sqlite3_log() and+** the three variables above are zeroed. In this case SQLite should+** continue accessing the database using the xRead() and xWrite()+** methods.+*/+static void unixRemapfile(+ unixFile *pFd, /* File descriptor object */+ i64 nNew /* Required mapping size */+){+ const char *zErr = "mmap";+ int h = pFd->h; /* File descriptor open on db file */+ u8 *pOrig = (u8 *)pFd->pMapRegion; /* Pointer to current file mapping */+ i64 nOrig = pFd->mmapSizeActual; /* Size of pOrig region in bytes */+ u8 *pNew = 0; /* Location of new mapping */+ int flags = PROT_READ; /* Flags to pass to mmap() */++ assert( pFd->nFetchOut==0 );+ assert( nNew>pFd->mmapSize );+ assert( nNew<=pFd->mmapSizeMax );+ assert( nNew>0 );+ assert( pFd->mmapSizeActual>=pFd->mmapSize );+ assert( MAP_FAILED!=0 );++ if( (pFd->ctrlFlags & UNIXFILE_RDONLY)==0 ) flags |= PROT_WRITE;++ if( pOrig ){+#if HAVE_MREMAP+ i64 nReuse = pFd->mmapSize;+#else+ const int szSyspage = osGetpagesize();+ i64 nReuse = (pFd->mmapSize & ~(szSyspage-1));+#endif+ u8 *pReq = &pOrig[nReuse];++ /* Unmap any pages of the existing mapping that cannot be reused. */+ if( nReuse!=nOrig ){+ osMunmap(pReq, nOrig-nReuse);+ }++#if HAVE_MREMAP+ pNew = osMremap(pOrig, nReuse, nNew, MREMAP_MAYMOVE);+ zErr = "mremap";+#else+ pNew = osMmap(pReq, nNew-nReuse, flags, MAP_SHARED, h, nReuse);+ if( pNew!=MAP_FAILED ){+ if( pNew!=pReq ){+ osMunmap(pNew, nNew - nReuse);+ pNew = 0;+ }else{+ pNew = pOrig;+ }+ }+#endif++ /* The attempt to extend the existing mapping failed. Free it. */+ if( pNew==MAP_FAILED || pNew==0 ){+ osMunmap(pOrig, nReuse);+ }+ }++ /* If pNew is still NULL, try to create an entirely new mapping. */+ if( pNew==0 ){+ pNew = osMmap(0, nNew, flags, MAP_SHARED, h, 0);+ }++ if( pNew==MAP_FAILED ){+ pNew = 0;+ nNew = 0;+ unixLogError(SQLITE_OK, zErr, pFd->zPath);++ /* If the mmap() above failed, assume that all subsequent mmap() calls+ ** will probably fail too. Fall back to using xRead/xWrite exclusively+ ** in this case. */+ pFd->mmapSizeMax = 0;+ }+ pFd->pMapRegion = (void *)pNew;+ pFd->mmapSize = pFd->mmapSizeActual = nNew;+}++/*+** Memory map or remap the file opened by file-descriptor pFd (if the file+** is already mapped, the existing mapping is replaced by the new). Or, if +** there already exists a mapping for this file, and there are still +** outstanding xFetch() references to it, this function is a no-op.+**+** If parameter nByte is non-negative, then it is the requested size of +** the mapping to create. Otherwise, if nByte is less than zero, then the +** requested size is the size of the file on disk. The actual size of the+** created mapping is either the requested size or the value configured +** using SQLITE_FCNTL_MMAP_LIMIT, whichever is smaller.+**+** SQLITE_OK is returned if no error occurs (even if the mapping is not+** recreated as a result of outstanding references) or an SQLite error+** code otherwise.+*/+static int unixMapfile(unixFile *pFd, i64 nByte){+ i64 nMap = nByte;+ int rc;++ assert( nMap>=0 || pFd->nFetchOut==0 );+ if( pFd->nFetchOut>0 ) return SQLITE_OK;++ if( nMap<0 ){+ struct stat statbuf; /* Low-level file information */+ rc = osFstat(pFd->h, &statbuf);+ if( rc!=SQLITE_OK ){+ return SQLITE_IOERR_FSTAT;+ }+ nMap = statbuf.st_size;+ }+ if( nMap>pFd->mmapSizeMax ){+ nMap = pFd->mmapSizeMax;+ }++ if( nMap!=pFd->mmapSize ){+ if( nMap>0 ){+ unixRemapfile(pFd, nMap);+ }else{+ unixUnmapfile(pFd);+ }+ }++ return SQLITE_OK;+}+#endif /* SQLITE_MAX_MMAP_SIZE>0 */++/*+** If possible, return a pointer to a mapping of file fd starting at offset+** iOff. The mapping must be valid for at least nAmt bytes.+**+** If such a pointer can be obtained, store it in *pp and return SQLITE_OK.+** Or, if one cannot but no error occurs, set *pp to 0 and return SQLITE_OK.+** Finally, if an error does occur, return an SQLite error code. The final+** value of *pp is undefined in this case.+**+** If this function does return a pointer, the caller must eventually +** release the reference by calling unixUnfetch().+*/+static int unixFetch(sqlite3_file *fd, i64 iOff, int nAmt, void **pp){+#if SQLITE_MAX_MMAP_SIZE>0+ unixFile *pFd = (unixFile *)fd; /* The underlying database file */+#endif+ *pp = 0;++#if SQLITE_MAX_MMAP_SIZE>0+ if( pFd->mmapSizeMax>0 ){+ if( pFd->pMapRegion==0 ){+ int rc = unixMapfile(pFd, -1);+ if( rc!=SQLITE_OK ) return rc;+ }+ if( pFd->mmapSize >= iOff+nAmt ){+ *pp = &((u8 *)pFd->pMapRegion)[iOff];+ pFd->nFetchOut++;+ }+ }+#endif+ return SQLITE_OK;+}++/*+** If the third argument is non-NULL, then this function releases a +** reference obtained by an earlier call to unixFetch(). The second+** argument passed to this function must be the same as the corresponding+** argument that was passed to the unixFetch() invocation. +**+** Or, if the third argument is NULL, then this function is being called +** to inform the VFS layer that, according to POSIX, any existing mapping +** may now be invalid and should be unmapped.+*/+static int unixUnfetch(sqlite3_file *fd, i64 iOff, void *p){+#if SQLITE_MAX_MMAP_SIZE>0+ unixFile *pFd = (unixFile *)fd; /* The underlying database file */+ UNUSED_PARAMETER(iOff);++ /* If p==0 (unmap the entire file) then there must be no outstanding + ** xFetch references. Or, if p!=0 (meaning it is an xFetch reference),+ ** then there must be at least one outstanding. */+ assert( (p==0)==(pFd->nFetchOut==0) );++ /* If p!=0, it must match the iOff value. */+ assert( p==0 || p==&((u8 *)pFd->pMapRegion)[iOff] );++ if( p ){+ pFd->nFetchOut--;+ }else{+ unixUnmapfile(pFd);+ }++ assert( pFd->nFetchOut>=0 );+#else+ UNUSED_PARAMETER(fd);+ UNUSED_PARAMETER(p);+ UNUSED_PARAMETER(iOff);+#endif+ return SQLITE_OK;+}++/*+** Here ends the implementation of all sqlite3_file methods.+**+********************** End sqlite3_file Methods *******************************+******************************************************************************/++/*+** This division contains definitions of sqlite3_io_methods objects that+** implement various file locking strategies. It also contains definitions+** of "finder" functions. A finder-function is used to locate the appropriate+** sqlite3_io_methods object for a particular database file. The pAppData+** field of the sqlite3_vfs VFS objects are initialized to be pointers to+** the correct finder-function for that VFS.+**+** Most finder functions return a pointer to a fixed sqlite3_io_methods+** object. The only interesting finder-function is autolockIoFinder, which+** looks at the filesystem type and tries to guess the best locking+** strategy from that.+**+** For finder-function F, two objects are created:+**+** (1) The real finder-function named "FImpt()".+**+** (2) A constant pointer to this function named just "F".+**+**+** A pointer to the F pointer is used as the pAppData value for VFS+** objects. We have to do this instead of letting pAppData point+** directly at the finder-function since C90 rules prevent a void*+** from be cast into a function pointer.+**+**+** Each instance of this macro generates two objects:+**+** * A constant sqlite3_io_methods object call METHOD that has locking+** methods CLOSE, LOCK, UNLOCK, CKRESLOCK.+**+** * An I/O method finder function called FINDER that returns a pointer+** to the METHOD object in the previous bullet.+*/+#define IOMETHODS(FINDER,METHOD,VERSION,CLOSE,LOCK,UNLOCK,CKLOCK,SHMMAP) \+static const sqlite3_io_methods METHOD = { \+ VERSION, /* iVersion */ \+ CLOSE, /* xClose */ \+ unixRead, /* xRead */ \+ unixWrite, /* xWrite */ \+ unixTruncate, /* xTruncate */ \+ unixSync, /* xSync */ \+ unixFileSize, /* xFileSize */ \+ LOCK, /* xLock */ \+ UNLOCK, /* xUnlock */ \+ CKLOCK, /* xCheckReservedLock */ \+ unixFileControl, /* xFileControl */ \+ unixSectorSize, /* xSectorSize */ \+ unixDeviceCharacteristics, /* xDeviceCapabilities */ \+ SHMMAP, /* xShmMap */ \+ unixShmLock, /* xShmLock */ \+ unixShmBarrier, /* xShmBarrier */ \+ unixShmUnmap, /* xShmUnmap */ \+ unixFetch, /* xFetch */ \+ unixUnfetch, /* xUnfetch */ \+}; \+static const sqlite3_io_methods *FINDER##Impl(const char *z, unixFile *p){ \+ UNUSED_PARAMETER(z); UNUSED_PARAMETER(p); \+ return &METHOD; \+} \+static const sqlite3_io_methods *(*const FINDER)(const char*,unixFile *p) \+ = FINDER##Impl;++/*+** Here are all of the sqlite3_io_methods objects for each of the+** locking strategies. Functions that return pointers to these methods+** are also created.+*/+IOMETHODS(+ posixIoFinder, /* Finder function name */+ posixIoMethods, /* sqlite3_io_methods object name */+ 3, /* shared memory and mmap are enabled */+ unixClose, /* xClose method */+ unixLock, /* xLock method */+ unixUnlock, /* xUnlock method */+ unixCheckReservedLock, /* xCheckReservedLock method */+ unixShmMap /* xShmMap method */+)+IOMETHODS(+ nolockIoFinder, /* Finder function name */+ nolockIoMethods, /* sqlite3_io_methods object name */+ 3, /* shared memory is disabled */+ nolockClose, /* xClose method */+ nolockLock, /* xLock method */+ nolockUnlock, /* xUnlock method */+ nolockCheckReservedLock, /* xCheckReservedLock method */+ 0 /* xShmMap method */+)+IOMETHODS(+ dotlockIoFinder, /* Finder function name */+ dotlockIoMethods, /* sqlite3_io_methods object name */+ 1, /* shared memory is disabled */+ dotlockClose, /* xClose method */+ dotlockLock, /* xLock method */+ dotlockUnlock, /* xUnlock method */+ dotlockCheckReservedLock, /* xCheckReservedLock method */+ 0 /* xShmMap method */+)++#if SQLITE_ENABLE_LOCKING_STYLE+IOMETHODS(+ flockIoFinder, /* Finder function name */+ flockIoMethods, /* sqlite3_io_methods object name */+ 1, /* shared memory is disabled */+ flockClose, /* xClose method */+ flockLock, /* xLock method */+ flockUnlock, /* xUnlock method */+ flockCheckReservedLock, /* xCheckReservedLock method */+ 0 /* xShmMap method */+)+#endif++#if OS_VXWORKS+IOMETHODS(+ semIoFinder, /* Finder function name */+ semIoMethods, /* sqlite3_io_methods object name */+ 1, /* shared memory is disabled */+ semXClose, /* xClose method */+ semXLock, /* xLock method */+ semXUnlock, /* xUnlock method */+ semXCheckReservedLock, /* xCheckReservedLock method */+ 0 /* xShmMap method */+)+#endif++#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+IOMETHODS(+ afpIoFinder, /* Finder function name */+ afpIoMethods, /* sqlite3_io_methods object name */+ 1, /* shared memory is disabled */+ afpClose, /* xClose method */+ afpLock, /* xLock method */+ afpUnlock, /* xUnlock method */+ afpCheckReservedLock, /* xCheckReservedLock method */+ 0 /* xShmMap method */+)+#endif++/*+** The proxy locking method is a "super-method" in the sense that it+** opens secondary file descriptors for the conch and lock files and+** it uses proxy, dot-file, AFP, and flock() locking methods on those+** secondary files. For this reason, the division that implements+** proxy locking is located much further down in the file. But we need+** to go ahead and define the sqlite3_io_methods and finder function+** for proxy locking here. So we forward declare the I/O methods.+*/+#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+static int proxyClose(sqlite3_file*);+static int proxyLock(sqlite3_file*, int);+static int proxyUnlock(sqlite3_file*, int);+static int proxyCheckReservedLock(sqlite3_file*, int*);+IOMETHODS(+ proxyIoFinder, /* Finder function name */+ proxyIoMethods, /* sqlite3_io_methods object name */+ 1, /* shared memory is disabled */+ proxyClose, /* xClose method */+ proxyLock, /* xLock method */+ proxyUnlock, /* xUnlock method */+ proxyCheckReservedLock, /* xCheckReservedLock method */+ 0 /* xShmMap method */+)+#endif++/* nfs lockd on OSX 10.3+ doesn't clear write locks when a read lock is set */+#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+IOMETHODS(+ nfsIoFinder, /* Finder function name */+ nfsIoMethods, /* sqlite3_io_methods object name */+ 1, /* shared memory is disabled */+ unixClose, /* xClose method */+ unixLock, /* xLock method */+ nfsUnlock, /* xUnlock method */+ unixCheckReservedLock, /* xCheckReservedLock method */+ 0 /* xShmMap method */+)+#endif++#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+/* +** This "finder" function attempts to determine the best locking strategy +** for the database file "filePath". It then returns the sqlite3_io_methods+** object that implements that strategy.+**+** This is for MacOSX only.+*/+static const sqlite3_io_methods *autolockIoFinderImpl(+ const char *filePath, /* name of the database file */+ unixFile *pNew /* open file object for the database file */+){+ static const struct Mapping {+ const char *zFilesystem; /* Filesystem type name */+ const sqlite3_io_methods *pMethods; /* Appropriate locking method */+ } aMap[] = {+ { "hfs", &posixIoMethods },+ { "ufs", &posixIoMethods },+ { "afpfs", &afpIoMethods },+ { "smbfs", &afpIoMethods },+ { "webdav", &nolockIoMethods },+ { 0, 0 }+ };+ int i;+ struct statfs fsInfo;+ struct flock lockInfo;++ if( !filePath ){+ /* If filePath==NULL that means we are dealing with a transient file+ ** that does not need to be locked. */+ return &nolockIoMethods;+ }+ if( statfs(filePath, &fsInfo) != -1 ){+ if( fsInfo.f_flags & MNT_RDONLY ){+ return &nolockIoMethods;+ }+ for(i=0; aMap[i].zFilesystem; i++){+ if( strcmp(fsInfo.f_fstypename, aMap[i].zFilesystem)==0 ){+ return aMap[i].pMethods;+ }+ }+ }++ /* Default case. Handles, amongst others, "nfs".+ ** Test byte-range lock using fcntl(). If the call succeeds, + ** assume that the file-system supports POSIX style locks. + */+ lockInfo.l_len = 1;+ lockInfo.l_start = 0;+ lockInfo.l_whence = SEEK_SET;+ lockInfo.l_type = F_RDLCK;+ if( osFcntl(pNew->h, F_GETLK, &lockInfo)!=-1 ) {+ if( strcmp(fsInfo.f_fstypename, "nfs")==0 ){+ return &nfsIoMethods;+ } else {+ return &posixIoMethods;+ }+ }else{+ return &dotlockIoMethods;+ }+}+static const sqlite3_io_methods + *(*const autolockIoFinder)(const char*,unixFile*) = autolockIoFinderImpl;++#endif /* defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE */++#if OS_VXWORKS+/*+** This "finder" function for VxWorks checks to see if posix advisory+** locking works. If it does, then that is what is used. If it does not+** work, then fallback to named semaphore locking.+*/+static const sqlite3_io_methods *vxworksIoFinderImpl(+ const char *filePath, /* name of the database file */+ unixFile *pNew /* the open file object */+){+ struct flock lockInfo;++ if( !filePath ){+ /* If filePath==NULL that means we are dealing with a transient file+ ** that does not need to be locked. */+ return &nolockIoMethods;+ }++ /* Test if fcntl() is supported and use POSIX style locks.+ ** Otherwise fall back to the named semaphore method.+ */+ lockInfo.l_len = 1;+ lockInfo.l_start = 0;+ lockInfo.l_whence = SEEK_SET;+ lockInfo.l_type = F_RDLCK;+ if( osFcntl(pNew->h, F_GETLK, &lockInfo)!=-1 ) {+ return &posixIoMethods;+ }else{+ return &semIoMethods;+ }+}+static const sqlite3_io_methods + *(*const vxworksIoFinder)(const char*,unixFile*) = vxworksIoFinderImpl;++#endif /* OS_VXWORKS */++/*+** An abstract type for a pointer to an IO method finder function:+*/+typedef const sqlite3_io_methods *(*finder_type)(const char*,unixFile*);+++/****************************************************************************+**************************** sqlite3_vfs methods ****************************+**+** This division contains the implementation of methods on the+** sqlite3_vfs object.+*/++/*+** Initialize the contents of the unixFile structure pointed to by pId.+*/+static int fillInUnixFile(+ sqlite3_vfs *pVfs, /* Pointer to vfs object */+ int h, /* Open file descriptor of file being opened */+ sqlite3_file *pId, /* Write to the unixFile structure here */+ const char *zFilename, /* Name of the file being opened */+ int ctrlFlags /* Zero or more UNIXFILE_* values */+){+ const sqlite3_io_methods *pLockingStyle;+ unixFile *pNew = (unixFile *)pId;+ int rc = SQLITE_OK;++ assert( pNew->pInode==NULL );++ /* Usually the path zFilename should not be a relative pathname. The+ ** exception is when opening the proxy "conch" file in builds that+ ** include the special Apple locking styles.+ */+#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+ assert( zFilename==0 || zFilename[0]=='/' + || pVfs->pAppData==(void*)&autolockIoFinder );+#else+ assert( zFilename==0 || zFilename[0]=='/' );+#endif++ /* No locking occurs in temporary files */+ assert( zFilename!=0 || (ctrlFlags & UNIXFILE_NOLOCK)!=0 );++ OSTRACE(("OPEN %-3d %s\n", h, zFilename));+ pNew->h = h;+ pNew->pVfs = pVfs;+ pNew->zPath = zFilename;+ pNew->ctrlFlags = (u8)ctrlFlags;+#if SQLITE_MAX_MMAP_SIZE>0+ pNew->mmapSizeMax = sqlite3GlobalConfig.szMmap;+#endif+ if( SQLITE_POWERSAFE_OVERWRITE ){+ pNew->ctrlFlags |= UNIXFILE_PSOW;+ }+ if( strcmp(pVfs->zName,"unix-excl")==0 ){+ pNew->ctrlFlags |= UNIXFILE_EXCL;+ }++#if OS_VXWORKS+ pNew->pId = vxworksFindFileId(zFilename);+ if( pNew->pId==0 ){+ ctrlFlags |= UNIXFILE_NOLOCK;+ rc = SQLITE_NOMEM;+ }+#endif++ if( ctrlFlags & UNIXFILE_NOLOCK ){+ pLockingStyle = &nolockIoMethods;+ }else{+ pLockingStyle = (**(finder_type*)pVfs->pAppData)(zFilename, pNew);+#if SQLITE_ENABLE_LOCKING_STYLE+ /* Cache zFilename in the locking context (AFP and dotlock override) for+ ** proxyLock activation is possible (remote proxy is based on db name)+ ** zFilename remains valid until file is closed, to support */+ pNew->lockingContext = (void*)zFilename;+#endif+ }++ if( pLockingStyle == &posixIoMethods+#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE+ || pLockingStyle == &nfsIoMethods+#endif+ ){+ unixEnterMutex();+ rc = findInodeInfo(pNew, &pNew->pInode);+ if( rc!=SQLITE_OK ){+ /* If an error occurred in findInodeInfo(), close the file descriptor+ ** immediately, before releasing the mutex. findInodeInfo() may fail+ ** in two scenarios:+ **+ ** (a) A call to fstat() failed.+ ** (b) A malloc failed.+ **+ ** Scenario (b) may only occur if the process is holding no other+ ** file descriptors open on the same file. If there were other file+ ** descriptors on this file, then no malloc would be required by+ ** findInodeInfo(). If this is the case, it is quite safe to close+ ** handle h - as it is guaranteed that no posix locks will be released+ ** by doing so.+ **+ ** If scenario (a) caused the error then things are not so safe. The+ ** implicit assumption here is that if fstat() fails, things are in+ ** such bad shape that dropping a lock or two doesn't matter much.+ */+ robust_close(pNew, h, __LINE__);+ h = -1;+ }+ unixLeaveMutex();+ }++#if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__)+ else if( pLockingStyle == &afpIoMethods ){+ /* AFP locking uses the file path so it needs to be included in+ ** the afpLockingContext.+ */+ afpLockingContext *pCtx;+ pNew->lockingContext = pCtx = sqlite3_malloc64( sizeof(*pCtx) );+ if( pCtx==0 ){+ rc = SQLITE_NOMEM;+ }else{+ /* NB: zFilename exists and remains valid until the file is closed+ ** according to requirement F11141. So we do not need to make a+ ** copy of the filename. */+ pCtx->dbPath = zFilename;+ pCtx->reserved = 0;+ srandomdev();+ unixEnterMutex();+ rc = findInodeInfo(pNew, &pNew->pInode);+ if( rc!=SQLITE_OK ){+ sqlite3_free(pNew->lockingContext);+ robust_close(pNew, h, __LINE__);+ h = -1;+ }+ unixLeaveMutex(); + }+ }+#endif++ else if( pLockingStyle == &dotlockIoMethods ){+ /* Dotfile locking uses the file path so it needs to be included in+ ** the dotlockLockingContext + */+ char *zLockFile;+ int nFilename;+ assert( zFilename!=0 );+ nFilename = (int)strlen(zFilename) + 6;+ zLockFile = (char *)sqlite3_malloc64(nFilename);+ if( zLockFile==0 ){+ rc = SQLITE_NOMEM;+ }else{+ sqlite3_snprintf(nFilename, zLockFile, "%s" DOTLOCK_SUFFIX, zFilename);+ }+ pNew->lockingContext = zLockFile;+ }++#if OS_VXWORKS+ else if( pLockingStyle == &semIoMethods ){+ /* Named semaphore locking uses the file path so it needs to be+ ** included in the semLockingContext+ */+ unixEnterMutex();+ rc = findInodeInfo(pNew, &pNew->pInode);+ if( (rc==SQLITE_OK) && (pNew->pInode->pSem==NULL) ){+ char *zSemName = pNew->pInode->aSemName;+ int n;+ sqlite3_snprintf(MAX_PATHNAME, zSemName, "/%s.sem",+ pNew->pId->zCanonicalName);+ for( n=1; zSemName[n]; n++ )+ if( zSemName[n]=='/' ) zSemName[n] = '_';+ pNew->pInode->pSem = sem_open(zSemName, O_CREAT, 0666, 1);+ if( pNew->pInode->pSem == SEM_FAILED ){+ rc = SQLITE_NOMEM;+ pNew->pInode->aSemName[0] = '\0';+ }+ }+ unixLeaveMutex();+ }+#endif+ + storeLastErrno(pNew, 0);+#if OS_VXWORKS+ if( rc!=SQLITE_OK ){+ if( h>=0 ) robust_close(pNew, h, __LINE__);+ h = -1;+ osUnlink(zFilename);+ pNew->ctrlFlags |= UNIXFILE_DELETE;+ }+#endif+ if( rc!=SQLITE_OK ){+ if( h>=0 ) robust_close(pNew, h, __LINE__);+ }else{+ pNew->pMethod = pLockingStyle;+ OpenCounter(+1);+ verifyDbFile(pNew);+ }+ return rc;+}++/*+** Return the name of a directory in which to put temporary files.+** If no suitable temporary file directory can be found, return NULL.+*/+static const char *unixTempFileDir(void){+ static const char *azDirs[] = {+ 0,+ 0,+ 0,+ "/var/tmp",+ "/usr/tmp",+ "/tmp",+ 0 /* List terminator */+ };+ unsigned int i;+ struct stat buf;+ const char *zDir = 0;++ azDirs[0] = sqlite3_temp_directory;+ if( !azDirs[1] ) azDirs[1] = getenv("SQLITE_TMPDIR");+ if( !azDirs[2] ) azDirs[2] = getenv("TMPDIR");+ for(i=0; i<sizeof(azDirs)/sizeof(azDirs[0]); zDir=azDirs[i++]){+ if( zDir==0 ) continue;+ if( osStat(zDir, &buf) ) continue;+ if( !S_ISDIR(buf.st_mode) ) continue;+ if( osAccess(zDir, 07) ) continue;+ break;+ }+ return zDir;+}++/*+** Create a temporary file name in zBuf. zBuf must be allocated+** by the calling process and must be big enough to hold at least+** pVfs->mxPathname bytes.+*/+static int unixGetTempname(int nBuf, char *zBuf){+ static const unsigned char zChars[] =+ "abcdefghijklmnopqrstuvwxyz"+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"+ "0123456789";+ unsigned int i, j;+ const char *zDir;++ /* It's odd to simulate an io-error here, but really this is just+ ** using the io-error infrastructure to test that SQLite handles this+ ** function failing. + */+ SimulateIOError( return SQLITE_IOERR );++ zDir = unixTempFileDir();+ if( zDir==0 ) zDir = ".";++ /* Check that the output buffer is large enough for the temporary file + ** name. If it is not, return SQLITE_ERROR.+ */+ if( (strlen(zDir) + strlen(SQLITE_TEMP_FILE_PREFIX) + 18) >= (size_t)nBuf ){+ return SQLITE_ERROR;+ }++ do{+ sqlite3_snprintf(nBuf-18, zBuf, "%s/"SQLITE_TEMP_FILE_PREFIX, zDir);+ j = (int)strlen(zBuf);+ sqlite3_randomness(15, &zBuf[j]);+ for(i=0; i<15; i++, j++){+ zBuf[j] = (char)zChars[ ((unsigned char)zBuf[j])%(sizeof(zChars)-1) ];+ }+ zBuf[j] = 0;+ zBuf[j+1] = 0;+ }while( osAccess(zBuf,0)==0 );+ return SQLITE_OK;+}++#if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__)+/*+** Routine to transform a unixFile into a proxy-locking unixFile.+** Implementation in the proxy-lock division, but used by unixOpen()+** if SQLITE_PREFER_PROXY_LOCKING is defined.+*/+static int proxyTransformUnixFile(unixFile*, const char*);+#endif++/*+** Search for an unused file descriptor that was opened on the database +** file (not a journal or master-journal file) identified by pathname+** zPath with SQLITE_OPEN_XXX flags matching those passed as the second+** argument to this function.+**+** Such a file descriptor may exist if a database connection was closed+** but the associated file descriptor could not be closed because some+** other file descriptor open on the same file is holding a file-lock.+** Refer to comments in the unixClose() function and the lengthy comment+** describing "Posix Advisory Locking" at the start of this file for +** further details. Also, ticket #4018.+**+** If a suitable file descriptor is found, then it is returned. If no+** such file descriptor is located, -1 is returned.+*/+static UnixUnusedFd *findReusableFd(const char *zPath, int flags){+ UnixUnusedFd *pUnused = 0;++ /* Do not search for an unused file descriptor on vxworks. Not because+ ** vxworks would not benefit from the change (it might, we're not sure),+ ** but because no way to test it is currently available. It is better + ** not to risk breaking vxworks support for the sake of such an obscure + ** feature. */+#if !OS_VXWORKS+ struct stat sStat; /* Results of stat() call */++ /* A stat() call may fail for various reasons. If this happens, it is+ ** almost certain that an open() call on the same path will also fail.+ ** For this reason, if an error occurs in the stat() call here, it is+ ** ignored and -1 is returned. The caller will try to open a new file+ ** descriptor on the same path, fail, and return an error to SQLite.+ **+ ** Even if a subsequent open() call does succeed, the consequences of+ ** not searching for a reusable file descriptor are not dire. */+ if( 0==osStat(zPath, &sStat) ){+ unixInodeInfo *pInode;++ unixEnterMutex();+ pInode = inodeList;+ while( pInode && (pInode->fileId.dev!=sStat.st_dev+ || pInode->fileId.ino!=sStat.st_ino) ){+ pInode = pInode->pNext;+ }+ if( pInode ){+ UnixUnusedFd **pp;+ for(pp=&pInode->pUnused; *pp && (*pp)->flags!=flags; pp=&((*pp)->pNext));+ pUnused = *pp;+ if( pUnused ){+ *pp = pUnused->pNext;+ }+ }+ unixLeaveMutex();+ }+#endif /* if !OS_VXWORKS */+ return pUnused;+}++/*+** This function is called by unixOpen() to determine the unix permissions+** to create new files with. If no error occurs, then SQLITE_OK is returned+** and a value suitable for passing as the third argument to open(2) is+** written to *pMode. If an IO error occurs, an SQLite error code is +** returned and the value of *pMode is not modified.+**+** In most cases, this routine sets *pMode to 0, which will become+** an indication to robust_open() to create the file using+** SQLITE_DEFAULT_FILE_PERMISSIONS adjusted by the umask.+** But if the file being opened is a WAL or regular journal file, then +** this function queries the file-system for the permissions on the +** corresponding database file and sets *pMode to this value. Whenever +** possible, WAL and journal files are created using the same permissions +** as the associated database file.+*/+static int findCreateFileMode(+ const char *zPath, /* Path of file (possibly) being created */+ int flags, /* Flags passed as 4th argument to xOpen() */+ mode_t *pMode, /* OUT: Permissions to open file with */+ uid_t *pUid, /* OUT: uid to set on the file */+ gid_t *pGid /* OUT: gid to set on the file */+){+ int rc = SQLITE_OK; /* Return Code */+ *pMode = 0;+ *pUid = 0;+ *pGid = 0;+ if( flags & (SQLITE_OPEN_WAL|SQLITE_OPEN_MAIN_JOURNAL) ){+ char zDb[MAX_PATHNAME+1]; /* Database file path */+ int nDb; /* Number of valid bytes in zDb */+ struct stat sStat; /* Output of stat() on database file */++ /* zPath is a path to a WAL or journal file. The following block derives+ ** the path to the associated database file from zPath. This block handles+ ** the following naming conventions:+ **+ ** "<path to db>-journal"+ ** "<path to db>-wal"+ ** "<path to db>-journalNN"+ ** "<path to db>-walNN"+ **+ ** where NN is a decimal number. The NN naming schemes are + ** used by the test_multiplex.c module.+ */+ nDb = sqlite3Strlen30(zPath) - 1; + while( zPath[nDb]!='-' ){+ assert( nDb>0 );+ assert( zPath[nDb]!='\n' );+ nDb--;+ }+ memcpy(zDb, zPath, nDb);+ zDb[nDb] = '\0';++ if( 0==osStat(zDb, &sStat) ){+ *pMode = sStat.st_mode & 0777;+ *pUid = sStat.st_uid;+ *pGid = sStat.st_gid;+ }else{+ rc = SQLITE_IOERR_FSTAT;+ }+ }else if( flags & SQLITE_OPEN_DELETEONCLOSE ){+ *pMode = 0600;+ }+ return rc;+}++/*+** Open the file zPath.+** +** Previously, the SQLite OS layer used three functions in place of this+** one:+**+** sqlite3OsOpenReadWrite();+** sqlite3OsOpenReadOnly();+** sqlite3OsOpenExclusive();+**+** These calls correspond to the following combinations of flags:+**+** ReadWrite() -> (READWRITE | CREATE)+** ReadOnly() -> (READONLY) +** OpenExclusive() -> (READWRITE | CREATE | EXCLUSIVE)+**+** The old OpenExclusive() accepted a boolean argument - "delFlag". If+** true, the file was configured to be automatically deleted when the+** file handle closed. To achieve the same effect using this new +** interface, add the DELETEONCLOSE flag to those specified above for +** OpenExclusive().+*/+static int unixOpen(+ sqlite3_vfs *pVfs, /* The VFS for which this is the xOpen method */+ const char *zPath, /* Pathname of file to be opened */+ sqlite3_file *pFile, /* The file descriptor to be filled in */+ int flags, /* Input flags to control the opening */+ int *pOutFlags /* Output flags returned to SQLite core */+){+ unixFile *p = (unixFile *)pFile;+ int fd = -1; /* File descriptor returned by open() */+ int openFlags = 0; /* Flags to pass to open() */+ int eType = flags&0xFFFFFF00; /* Type of file to open */+ int noLock; /* True to omit locking primitives */+ int rc = SQLITE_OK; /* Function Return Code */+ int ctrlFlags = 0; /* UNIXFILE_* flags */++ int isExclusive = (flags & SQLITE_OPEN_EXCLUSIVE);+ int isDelete = (flags & SQLITE_OPEN_DELETEONCLOSE);+ int isCreate = (flags & SQLITE_OPEN_CREATE);+ int isReadonly = (flags & SQLITE_OPEN_READONLY);+ int isReadWrite = (flags & SQLITE_OPEN_READWRITE);+#if SQLITE_ENABLE_LOCKING_STYLE+ int isAutoProxy = (flags & SQLITE_OPEN_AUTOPROXY);+#endif+#if defined(__APPLE__) || SQLITE_ENABLE_LOCKING_STYLE+ struct statfs fsInfo;+#endif++ /* If creating a master or main-file journal, this function will open+ ** a file-descriptor on the directory too. The first time unixSync()+ ** is called the directory file descriptor will be fsync()ed and close()d.+ */+ int syncDir = (isCreate && (+ eType==SQLITE_OPEN_MASTER_JOURNAL + || eType==SQLITE_OPEN_MAIN_JOURNAL + || eType==SQLITE_OPEN_WAL+ ));++ /* If argument zPath is a NULL pointer, this function is required to open+ ** a temporary file. Use this buffer to store the file name in.+ */+ char zTmpname[MAX_PATHNAME+2];+ const char *zName = zPath;++ /* Check the following statements are true: + **+ ** (a) Exactly one of the READWRITE and READONLY flags must be set, and + ** (b) if CREATE is set, then READWRITE must also be set, and+ ** (c) if EXCLUSIVE is set, then CREATE must also be set.+ ** (d) if DELETEONCLOSE is set, then CREATE must also be set.+ */+ assert((isReadonly==0 || isReadWrite==0) && (isReadWrite || isReadonly));+ assert(isCreate==0 || isReadWrite);+ assert(isExclusive==0 || isCreate);+ assert(isDelete==0 || isCreate);++ /* The main DB, main journal, WAL file and master journal are never + ** automatically deleted. Nor are they ever temporary files. */+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_MAIN_DB );+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_MAIN_JOURNAL );+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_MASTER_JOURNAL );+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_WAL );++ /* Assert that the upper layer has set one of the "file-type" flags. */+ assert( eType==SQLITE_OPEN_MAIN_DB || eType==SQLITE_OPEN_TEMP_DB + || eType==SQLITE_OPEN_MAIN_JOURNAL || eType==SQLITE_OPEN_TEMP_JOURNAL + || eType==SQLITE_OPEN_SUBJOURNAL || eType==SQLITE_OPEN_MASTER_JOURNAL + || eType==SQLITE_OPEN_TRANSIENT_DB || eType==SQLITE_OPEN_WAL+ );++ /* Detect a pid change and reset the PRNG. There is a race condition+ ** here such that two or more threads all trying to open databases at+ ** the same instant might all reset the PRNG. But multiple resets+ ** are harmless.+ */+ if( randomnessPid!=osGetpid(0) ){+ randomnessPid = osGetpid(0);+ sqlite3_randomness(0,0);+ }++ memset(p, 0, sizeof(unixFile));++ if( eType==SQLITE_OPEN_MAIN_DB ){+ UnixUnusedFd *pUnused;+ pUnused = findReusableFd(zName, flags);+ if( pUnused ){+ fd = pUnused->fd;+ }else{+ pUnused = sqlite3_malloc64(sizeof(*pUnused));+ if( !pUnused ){+ return SQLITE_NOMEM;+ }+ }+ p->pUnused = pUnused;++ /* Database filenames are double-zero terminated if they are not+ ** URIs with parameters. Hence, they can always be passed into+ ** sqlite3_uri_parameter(). */+ assert( (flags & SQLITE_OPEN_URI) || zName[strlen(zName)+1]==0 );++ }else if( !zName ){+ /* If zName is NULL, the upper layer is requesting a temp file. */+ assert(isDelete && !syncDir);+ rc = unixGetTempname(MAX_PATHNAME+2, zTmpname);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ zName = zTmpname;++ /* Generated temporary filenames are always double-zero terminated+ ** for use by sqlite3_uri_parameter(). */+ assert( zName[strlen(zName)+1]==0 );+ }++ /* Determine the value of the flags parameter passed to POSIX function+ ** open(). These must be calculated even if open() is not called, as+ ** they may be stored as part of the file handle and used by the + ** 'conch file' locking functions later on. */+ if( isReadonly ) openFlags |= O_RDONLY;+ if( isReadWrite ) openFlags |= O_RDWR;+ if( isCreate ) openFlags |= O_CREAT;+ if( isExclusive ) openFlags |= (O_EXCL|O_NOFOLLOW);+ openFlags |= (O_LARGEFILE|O_BINARY);++ if( fd<0 ){+ mode_t openMode; /* Permissions to create file with */+ uid_t uid; /* Userid for the file */+ gid_t gid; /* Groupid for the file */+ rc = findCreateFileMode(zName, flags, &openMode, &uid, &gid);+ if( rc!=SQLITE_OK ){+ assert( !p->pUnused );+ assert( eType==SQLITE_OPEN_WAL || eType==SQLITE_OPEN_MAIN_JOURNAL );+ return rc;+ }+ fd = robust_open(zName, openFlags, openMode);+ OSTRACE(("OPENX %-3d %s 0%o\n", fd, zName, openFlags));+ if( fd<0 && errno!=EISDIR && isReadWrite && !isExclusive ){+ /* Failed to open the file for read/write access. Try read-only. */+ flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);+ openFlags &= ~(O_RDWR|O_CREAT);+ flags |= SQLITE_OPEN_READONLY;+ openFlags |= O_RDONLY;+ isReadonly = 1;+ fd = robust_open(zName, openFlags, openMode);+ }+ if( fd<0 ){+ rc = unixLogError(SQLITE_CANTOPEN_BKPT, "open", zName);+ goto open_finished;+ }++ /* If this process is running as root and if creating a new rollback+ ** journal or WAL file, set the ownership of the journal or WAL to be+ ** the same as the original database.+ */+ if( flags & (SQLITE_OPEN_WAL|SQLITE_OPEN_MAIN_JOURNAL) ){+ osFchown(fd, uid, gid);+ }+ }+ assert( fd>=0 );+ if( pOutFlags ){+ *pOutFlags = flags;+ }++ if( p->pUnused ){+ p->pUnused->fd = fd;+ p->pUnused->flags = flags;+ }++ if( isDelete ){+#if OS_VXWORKS+ zPath = zName;+#elif defined(SQLITE_UNLINK_AFTER_CLOSE)+ zPath = sqlite3_mprintf("%s", zName);+ if( zPath==0 ){+ robust_close(p, fd, __LINE__);+ return SQLITE_NOMEM;+ }+#else+ osUnlink(zName);+#endif+ }+#if SQLITE_ENABLE_LOCKING_STYLE+ else{+ p->openFlags = openFlags;+ }+#endif++ noLock = eType!=SQLITE_OPEN_MAIN_DB;++ +#if defined(__APPLE__) || SQLITE_ENABLE_LOCKING_STYLE+ if( fstatfs(fd, &fsInfo) == -1 ){+ storeLastErrno(p, errno);+ robust_close(p, fd, __LINE__);+ return SQLITE_IOERR_ACCESS;+ }+ if (0 == strncmp("msdos", fsInfo.f_fstypename, 5)) {+ ((unixFile*)pFile)->fsFlags |= SQLITE_FSFLAGS_IS_MSDOS;+ }+ if (0 == strncmp("exfat", fsInfo.f_fstypename, 5)) {+ ((unixFile*)pFile)->fsFlags |= SQLITE_FSFLAGS_IS_MSDOS;+ }+#endif++ /* Set up appropriate ctrlFlags */+ if( isDelete ) ctrlFlags |= UNIXFILE_DELETE;+ if( isReadonly ) ctrlFlags |= UNIXFILE_RDONLY;+ if( noLock ) ctrlFlags |= UNIXFILE_NOLOCK;+ if( syncDir ) ctrlFlags |= UNIXFILE_DIRSYNC;+ if( flags & SQLITE_OPEN_URI ) ctrlFlags |= UNIXFILE_URI;++#if SQLITE_ENABLE_LOCKING_STYLE+#if SQLITE_PREFER_PROXY_LOCKING+ isAutoProxy = 1;+#endif+ if( isAutoProxy && (zPath!=NULL) && (!noLock) && pVfs->xOpen ){+ char *envforce = getenv("SQLITE_FORCE_PROXY_LOCKING");+ int useProxy = 0;++ /* SQLITE_FORCE_PROXY_LOCKING==1 means force always use proxy, 0 means + ** never use proxy, NULL means use proxy for non-local files only. */+ if( envforce!=NULL ){+ useProxy = atoi(envforce)>0;+ }else{+ useProxy = !(fsInfo.f_flags&MNT_LOCAL);+ }+ if( useProxy ){+ rc = fillInUnixFile(pVfs, fd, pFile, zPath, ctrlFlags);+ if( rc==SQLITE_OK ){+ rc = proxyTransformUnixFile((unixFile*)pFile, ":auto:");+ if( rc!=SQLITE_OK ){+ /* Use unixClose to clean up the resources added in fillInUnixFile + ** and clear all the structure's references. Specifically, + ** pFile->pMethods will be NULL so sqlite3OsClose will be a no-op + */+ unixClose(pFile);+ return rc;+ }+ }+ goto open_finished;+ }+ }+#endif+ + rc = fillInUnixFile(pVfs, fd, pFile, zPath, ctrlFlags);++open_finished:+ if( rc!=SQLITE_OK ){+ sqlite3_free(p->pUnused);+ }+ return rc;+}+++/*+** Delete the file at zPath. If the dirSync argument is true, fsync()+** the directory after deleting the file.+*/+static int unixDelete(+ sqlite3_vfs *NotUsed, /* VFS containing this as the xDelete method */+ const char *zPath, /* Name of file to be deleted */+ int dirSync /* If true, fsync() directory after deleting file */+){+ int rc = SQLITE_OK;+ UNUSED_PARAMETER(NotUsed);+ SimulateIOError(return SQLITE_IOERR_DELETE);+ if( osUnlink(zPath)==(-1) ){+ if( errno==ENOENT+#if OS_VXWORKS+ || osAccess(zPath,0)!=0+#endif+ ){+ rc = SQLITE_IOERR_DELETE_NOENT;+ }else{+ rc = unixLogError(SQLITE_IOERR_DELETE, "unlink", zPath);+ }+ return rc;+ }+#ifndef SQLITE_DISABLE_DIRSYNC+ if( (dirSync & 1)!=0 ){+ int fd;+ rc = osOpenDirectory(zPath, &fd);+ if( rc==SQLITE_OK ){+#if OS_VXWORKS+ if( fsync(fd)==-1 )+#else+ if( fsync(fd) )+#endif+ {+ rc = unixLogError(SQLITE_IOERR_DIR_FSYNC, "fsync", zPath);+ }+ robust_close(0, fd, __LINE__);+ }else if( rc==SQLITE_CANTOPEN ){+ rc = SQLITE_OK;+ }+ }+#endif+ return rc;+}++/*+** Test the existence of or access permissions of file zPath. The+** test performed depends on the value of flags:+**+** SQLITE_ACCESS_EXISTS: Return 1 if the file exists+** SQLITE_ACCESS_READWRITE: Return 1 if the file is read and writable.+** SQLITE_ACCESS_READONLY: Return 1 if the file is readable.+**+** Otherwise return 0.+*/+static int unixAccess(+ sqlite3_vfs *NotUsed, /* The VFS containing this xAccess method */+ const char *zPath, /* Path of the file to examine */+ int flags, /* What do we want to learn about the zPath file? */+ int *pResOut /* Write result boolean here */+){+ int amode = 0;+ UNUSED_PARAMETER(NotUsed);+ SimulateIOError( return SQLITE_IOERR_ACCESS; );+ switch( flags ){+ case SQLITE_ACCESS_EXISTS:+ amode = F_OK;+ break;+ case SQLITE_ACCESS_READWRITE:+ amode = W_OK|R_OK;+ break;+ case SQLITE_ACCESS_READ:+ amode = R_OK;+ break;++ default:+ assert(!"Invalid flags argument");+ }+ *pResOut = (osAccess(zPath, amode)==0);+ if( flags==SQLITE_ACCESS_EXISTS && *pResOut ){+ struct stat buf;+ if( 0==osStat(zPath, &buf) && buf.st_size==0 ){+ *pResOut = 0;+ }+ }+ return SQLITE_OK;+}+++/*+** Turn a relative pathname into a full pathname. The relative path+** is stored as a nul-terminated string in the buffer pointed to by+** zPath. +**+** zOut points to a buffer of at least sqlite3_vfs.mxPathname bytes +** (in this case, MAX_PATHNAME bytes). The full-path is written to+** this buffer before returning.+*/+static int unixFullPathname(+ sqlite3_vfs *pVfs, /* Pointer to vfs object */+ const char *zPath, /* Possibly relative input path */+ int nOut, /* Size of output buffer in bytes */+ char *zOut /* Output buffer */+){++ /* It's odd to simulate an io-error here, but really this is just+ ** using the io-error infrastructure to test that SQLite handles this+ ** function failing. This function could fail if, for example, the+ ** current working directory has been unlinked.+ */+ SimulateIOError( return SQLITE_ERROR );++ assert( pVfs->mxPathname==MAX_PATHNAME );+ UNUSED_PARAMETER(pVfs);++ zOut[nOut-1] = '\0';+ if( zPath[0]=='/' ){+ sqlite3_snprintf(nOut, zOut, "%s", zPath);+ }else{+ int nCwd;+ if( osGetcwd(zOut, nOut-1)==0 ){+ return unixLogError(SQLITE_CANTOPEN_BKPT, "getcwd", zPath);+ }+ nCwd = (int)strlen(zOut);+ sqlite3_snprintf(nOut-nCwd, &zOut[nCwd], "/%s", zPath);+ }+ return SQLITE_OK;+}++ #define unixDlOpen 0+ #define unixDlError 0+ #define unixDlSym 0+ #define unixDlClose 0++/*+** Write nBuf bytes of random data to the supplied buffer zBuf.+*/+static int unixRandomness(sqlite3_vfs *NotUsed, int nBuf, char *zBuf){+ UNUSED_PARAMETER(NotUsed);+ assert((size_t)nBuf>=(sizeof(time_t)+sizeof(int)));++ /* We have to initialize zBuf to prevent valgrind from reporting+ ** errors. The reports issued by valgrind are incorrect - we would+ ** prefer that the randomness be increased by making use of the+ ** uninitialized space in zBuf - but valgrind errors tend to worry+ ** some users. Rather than argue, it seems easier just to initialize+ ** the whole array and silence valgrind, even if that means less randomness+ ** in the random seed.+ **+ ** When testing, initializing zBuf[] to zero is all we do. That means+ ** that we always use the same random number sequence. This makes the+ ** tests repeatable.+ */+ memset(zBuf, 0, nBuf);+ randomnessPid = osGetpid(0); +#if !defined(SQLITE_TEST) && !defined(SQLITE_OMIT_RANDOMNESS)+ {+ int fd, got;+ fd = robust_open("/dev/urandom", O_RDONLY, 0);+ if( fd<0 ){+ time_t t;+ time(&t);+ memcpy(zBuf, &t, sizeof(t));+ memcpy(&zBuf[sizeof(t)], &randomnessPid, sizeof(randomnessPid));+ assert( sizeof(t)+sizeof(randomnessPid)<=(size_t)nBuf );+ nBuf = sizeof(t) + sizeof(randomnessPid);+ }else{+ do{ got = osRead(fd, zBuf, nBuf); }while( got<0 && errno==EINTR );+ robust_close(0, fd, __LINE__);+ }+ }+#endif+ return nBuf;+}+++/*+** Sleep for a little while. Return the amount of time slept.+** The argument is the number of microseconds we want to sleep.+** The return value is the number of microseconds of sleep actually+** requested from the underlying operating system, a number which+** might be greater than or equal to the argument, but not less+** than the argument.+*/+static int unixSleep(sqlite3_vfs *NotUsed, int microseconds){+#if OS_VXWORKS+ struct timespec sp;++ sp.tv_sec = microseconds / 1000000;+ sp.tv_nsec = (microseconds % 1000000) * 1000;+ nanosleep(&sp, NULL);+ UNUSED_PARAMETER(NotUsed);+ return microseconds;+#elif defined(HAVE_USLEEP) && HAVE_USLEEP+ usleep(microseconds);+ UNUSED_PARAMETER(NotUsed);+ return microseconds;+#else+ int seconds = (microseconds+999999)/1000000;+ sleep(seconds);+ UNUSED_PARAMETER(NotUsed);+ return seconds*1000000;+#endif+}++/*+** The following variable, if set to a non-zero value, is interpreted as+** the number of seconds since 1970 and is used to set the result of+** sqlite3OsCurrentTime() during testing.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_current_time = 0; /* Fake system time in seconds since 1970. */+#endif++/*+** Find the current time (in Universal Coordinated Time). Write into *piNow+** the current time and date as a Julian Day number times 86_400_000. In+** other words, write into *piNow the number of milliseconds since the Julian+** epoch of noon in Greenwich on November 24, 4714 B.C according to the+** proleptic Gregorian calendar.+**+** On success, return SQLITE_OK. Return SQLITE_ERROR if the time and date +** cannot be found.+*/+static int unixCurrentTimeInt64(sqlite3_vfs *NotUsed, sqlite3_int64 *piNow){+ static const sqlite3_int64 unixEpoch = 24405875*(sqlite3_int64)8640000;+ int rc = SQLITE_OK;+#if defined(NO_GETTOD)+ time_t t;+ time(&t);+ *piNow = ((sqlite3_int64)t)*1000 + unixEpoch;+#elif OS_VXWORKS+ struct timespec sNow;+ clock_gettime(CLOCK_REALTIME, &sNow);+ *piNow = unixEpoch + 1000*(sqlite3_int64)sNow.tv_sec + sNow.tv_nsec/1000000;+#else+ struct timeval sNow;+ if( gettimeofday(&sNow, 0)==0 ){+ *piNow = unixEpoch + 1000*(sqlite3_int64)sNow.tv_sec + sNow.tv_usec/1000;+ }else{+ rc = SQLITE_ERROR;+ }+#endif++#ifdef SQLITE_TEST+ if( sqlite3_current_time ){+ *piNow = 1000*(sqlite3_int64)sqlite3_current_time + unixEpoch;+ }+#endif+ UNUSED_PARAMETER(NotUsed);+ return rc;+}++/*+** Find the current time (in Universal Coordinated Time). Write the+** current time and date as a Julian Day number into *prNow and+** return 0. Return 1 if the time and date cannot be found.+*/+static int unixCurrentTime(sqlite3_vfs *NotUsed, double *prNow){+ sqlite3_int64 i = 0;+ int rc;+ UNUSED_PARAMETER(NotUsed);+ rc = unixCurrentTimeInt64(0, &i);+ *prNow = i/86400000.0;+ return rc;+}++/*+** We added the xGetLastError() method with the intention of providing+** better low-level error messages when operating-system problems come up+** during SQLite operation. But so far, none of that has been implemented+** in the core. So this routine is never called. For now, it is merely+** a place-holder.+*/+static int unixGetLastError(sqlite3_vfs *NotUsed, int NotUsed2, char *NotUsed3){+ UNUSED_PARAMETER(NotUsed);+ UNUSED_PARAMETER(NotUsed2);+ UNUSED_PARAMETER(NotUsed3);+ return 0;+}+++/*+************************ End of sqlite3_vfs methods ***************************+******************************************************************************/++/******************************************************************************+************************** Begin Proxy Locking ********************************+**+** Proxy locking is a "uber-locking-method" in this sense: It uses the+** other locking methods on secondary lock files. Proxy locking is a+** meta-layer over top of the primitive locking implemented above. For+** this reason, the division that implements of proxy locking is deferred+** until late in the file (here) after all of the other I/O methods have+** been defined - so that the primitive locking methods are available+** as services to help with the implementation of proxy locking.+**+****+**+** The default locking schemes in SQLite use byte-range locks on the+** database file to coordinate safe, concurrent access by multiple readers+** and writers [http://sqlite.org/lockingv3.html]. The five file locking+** states (UNLOCKED, PENDING, SHARED, RESERVED, EXCLUSIVE) are implemented+** as POSIX read & write locks over fixed set of locations (via fsctl),+** on AFP and SMB only exclusive byte-range locks are available via fsctl+** with _IOWR('z', 23, struct ByteRangeLockPB2) to track the same 5 states.+** To simulate a F_RDLCK on the shared range, on AFP a randomly selected+** address in the shared range is taken for a SHARED lock, the entire+** shared range is taken for an EXCLUSIVE lock):+**+** PENDING_BYTE 0x40000000+** RESERVED_BYTE 0x40000001+** SHARED_RANGE 0x40000002 -> 0x40000200+**+** This works well on the local file system, but shows a nearly 100x+** slowdown in read performance on AFP because the AFP client disables+** the read cache when byte-range locks are present. Enabling the read+** cache exposes a cache coherency problem that is present on all OS X+** supported network file systems. NFS and AFP both observe the+** close-to-open semantics for ensuring cache coherency+** [http://nfs.sourceforge.net/#faq_a8], which does not effectively+** address the requirements for concurrent database access by multiple+** readers and writers+** [http://www.nabble.com/SQLite-on-NFS-cache-coherency-td15655701.html].+**+** To address the performance and cache coherency issues, proxy file locking+** changes the way database access is controlled by limiting access to a+** single host at a time and moving file locks off of the database file+** and onto a proxy file on the local file system. +**+**+** Using proxy locks+** -----------------+**+** C APIs+**+** sqlite3_file_control(db, dbname, SQLITE_FCNTL_SET_LOCKPROXYFILE,+** <proxy_path> | ":auto:");+** sqlite3_file_control(db, dbname, SQLITE_FCNTL_GET_LOCKPROXYFILE,+** &<proxy_path>);+**+**+** SQL pragmas+**+** PRAGMA [database.]lock_proxy_file=<proxy_path> | :auto:+** PRAGMA [database.]lock_proxy_file+**+** Specifying ":auto:" means that if there is a conch file with a matching+** host ID in it, the proxy path in the conch file will be used, otherwise+** a proxy path based on the user's temp dir+** (via confstr(_CS_DARWIN_USER_TEMP_DIR,...)) will be used and the+** actual proxy file name is generated from the name and path of the+** database file. For example:+**+** For database path "/Users/me/foo.db" +** The lock path will be "<tmpdir>/sqliteplocks/_Users_me_foo.db:auto:")+**+** Once a lock proxy is configured for a database connection, it can not+** be removed, however it may be switched to a different proxy path via+** the above APIs (assuming the conch file is not being held by another+** connection or process). +**+**+** How proxy locking works+** -----------------------+**+** Proxy file locking relies primarily on two new supporting files: +**+** * conch file to limit access to the database file to a single host+** at a time+**+** * proxy file to act as a proxy for the advisory locks normally+** taken on the database+**+** The conch file - to use a proxy file, sqlite must first "hold the conch"+** by taking an sqlite-style shared lock on the conch file, reading the+** contents and comparing the host's unique host ID (see below) and lock+** proxy path against the values stored in the conch. The conch file is+** stored in the same directory as the database file and the file name+** is patterned after the database file name as ".<databasename>-conch".+** If the conch file does not exist, or its contents do not match the+** host ID and/or proxy path, then the lock is escalated to an exclusive+** lock and the conch file contents is updated with the host ID and proxy+** path and the lock is downgraded to a shared lock again. If the conch+** is held by another process (with a shared lock), the exclusive lock+** will fail and SQLITE_BUSY is returned.+**+** The proxy file - a single-byte file used for all advisory file locks+** normally taken on the database file. This allows for safe sharing+** of the database file for multiple readers and writers on the same+** host (the conch ensures that they all use the same local lock file).+**+** Requesting the lock proxy does not immediately take the conch, it is+** only taken when the first request to lock database file is made. +** This matches the semantics of the traditional locking behavior, where+** opening a connection to a database file does not take a lock on it.+** The shared lock and an open file descriptor are maintained until +** the connection to the database is closed. +**+** The proxy file and the lock file are never deleted so they only need+** to be created the first time they are used.+**+** Configuration options+** ---------------------+**+** SQLITE_PREFER_PROXY_LOCKING+**+** Database files accessed on non-local file systems are+** automatically configured for proxy locking, lock files are+** named automatically using the same logic as+** PRAGMA lock_proxy_file=":auto:"+** +** SQLITE_PROXY_DEBUG+**+** Enables the logging of error messages during host id file+** retrieval and creation+**+** LOCKPROXYDIR+**+** Overrides the default directory used for lock proxy files that+** are named automatically via the ":auto:" setting+**+** SQLITE_DEFAULT_PROXYDIR_PERMISSIONS+**+** Permissions to use when creating a directory for storing the+** lock proxy files, only used when LOCKPROXYDIR is not set.+** +** +** As mentioned above, when compiled with SQLITE_PREFER_PROXY_LOCKING,+** setting the environment variable SQLITE_FORCE_PROXY_LOCKING to 1 will+** force proxy locking to be used for every database file opened, and 0+** will force automatic proxy locking to be disabled for all database+** files (explicitly calling the SQLITE_FCNTL_SET_LOCKPROXYFILE pragma or+** sqlite_file_control API is not affected by SQLITE_FORCE_PROXY_LOCKING).+*/++/*+** Proxy locking is only available on MacOSX +*/+#if defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE++/*+** The proxyLockingContext has the path and file structures for the remote +** and local proxy files in it+*/+typedef struct proxyLockingContext proxyLockingContext;+struct proxyLockingContext {+ unixFile *conchFile; /* Open conch file */+ char *conchFilePath; /* Name of the conch file */+ unixFile *lockProxy; /* Open proxy lock file */+ char *lockProxyPath; /* Name of the proxy lock file */+ char *dbPath; /* Name of the open file */+ int conchHeld; /* 1 if the conch is held, -1 if lockless */+ int nFails; /* Number of conch taking failures */+ void *oldLockingContext; /* Original lockingcontext to restore on close */+ sqlite3_io_methods const *pOldMethod; /* Original I/O methods for close */+};++/* +** The proxy lock file path for the database at dbPath is written into lPath, +** which must point to valid, writable memory large enough for a maxLen length+** file path. +*/+static int proxyGetLockPath(const char *dbPath, char *lPath, size_t maxLen){+ int len;+ int dbLen;+ int i;++#ifdef LOCKPROXYDIR+ len = strlcpy(lPath, LOCKPROXYDIR, maxLen);+#else+# ifdef _CS_DARWIN_USER_TEMP_DIR+ {+ if( !confstr(_CS_DARWIN_USER_TEMP_DIR, lPath, maxLen) ){+ OSTRACE(("GETLOCKPATH failed %s errno=%d pid=%d\n",+ lPath, errno, osGetpid(0)));+ return SQLITE_IOERR_LOCK;+ }+ len = strlcat(lPath, "sqliteplocks", maxLen); + }+# else+ len = strlcpy(lPath, "/tmp/", maxLen);+# endif+#endif++ if( lPath[len-1]!='/' ){+ len = strlcat(lPath, "/", maxLen);+ }+ + /* transform the db path to a unique cache name */+ dbLen = (int)strlen(dbPath);+ for( i=0; i<dbLen && (i+len+7)<(int)maxLen; i++){+ char c = dbPath[i];+ lPath[i+len] = (c=='/')?'_':c;+ }+ lPath[i+len]='\0';+ strlcat(lPath, ":auto:", maxLen);+ OSTRACE(("GETLOCKPATH proxy lock path=%s pid=%d\n", lPath, osGetpid(0)));+ return SQLITE_OK;+}++/* + ** Creates the lock file and any missing directories in lockPath+ */+static int proxyCreateLockPath(const char *lockPath){+ int i, len;+ char buf[MAXPATHLEN];+ int start = 0;+ + assert(lockPath!=NULL);+ /* try to create all the intermediate directories */+ len = (int)strlen(lockPath);+ buf[0] = lockPath[0];+ for( i=1; i<len; i++ ){+ if( lockPath[i] == '/' && (i - start > 0) ){+ /* only mkdir if leaf dir != "." or "/" or ".." */+ if( i-start>2 || (i-start==1 && buf[start] != '.' && buf[start] != '/') + || (i-start==2 && buf[start] != '.' && buf[start+1] != '.') ){+ buf[i]='\0';+ if( osMkdir(buf, SQLITE_DEFAULT_PROXYDIR_PERMISSIONS) ){+ int err=errno;+ if( err!=EEXIST ) {+ OSTRACE(("CREATELOCKPATH FAILED creating %s, "+ "'%s' proxy lock path=%s pid=%d\n",+ buf, strerror(err), lockPath, osGetpid(0)));+ return err;+ }+ }+ }+ start=i+1;+ }+ buf[i] = lockPath[i];+ }+ OSTRACE(("CREATELOCKPATH proxy lock path=%s pid=%d\n", lockPath, osGetpid(0)));+ return 0;+}++/*+** Create a new VFS file descriptor (stored in memory obtained from+** sqlite3_malloc) and open the file named "path" in the file descriptor.+**+** The caller is responsible not only for closing the file descriptor+** but also for freeing the memory associated with the file descriptor.+*/+static int proxyCreateUnixFile(+ const char *path, /* path for the new unixFile */+ unixFile **ppFile, /* unixFile created and returned by ref */+ int islockfile /* if non zero missing dirs will be created */+) {+ int fd = -1;+ unixFile *pNew;+ int rc = SQLITE_OK;+ int openFlags = O_RDWR | O_CREAT;+ sqlite3_vfs dummyVfs;+ int terrno = 0;+ UnixUnusedFd *pUnused = NULL;++ /* 1. first try to open/create the file+ ** 2. if that fails, and this is a lock file (not-conch), try creating+ ** the parent directories and then try again.+ ** 3. if that fails, try to open the file read-only+ ** otherwise return BUSY (if lock file) or CANTOPEN for the conch file+ */+ pUnused = findReusableFd(path, openFlags);+ if( pUnused ){+ fd = pUnused->fd;+ }else{+ pUnused = sqlite3_malloc64(sizeof(*pUnused));+ if( !pUnused ){+ return SQLITE_NOMEM;+ }+ }+ if( fd<0 ){+ fd = robust_open(path, openFlags, 0);+ terrno = errno;+ if( fd<0 && errno==ENOENT && islockfile ){+ if( proxyCreateLockPath(path) == SQLITE_OK ){+ fd = robust_open(path, openFlags, 0);+ }+ }+ }+ if( fd<0 ){+ openFlags = O_RDONLY;+ fd = robust_open(path, openFlags, 0);+ terrno = errno;+ }+ if( fd<0 ){+ if( islockfile ){+ return SQLITE_BUSY;+ }+ switch (terrno) {+ case EACCES:+ return SQLITE_PERM;+ case EIO: + return SQLITE_IOERR_LOCK; /* even though it is the conch */+ default:+ return SQLITE_CANTOPEN_BKPT;+ }+ }+ + pNew = (unixFile *)sqlite3_malloc64(sizeof(*pNew));+ if( pNew==NULL ){+ rc = SQLITE_NOMEM;+ goto end_create_proxy;+ }+ memset(pNew, 0, sizeof(unixFile));+ pNew->openFlags = openFlags;+ memset(&dummyVfs, 0, sizeof(dummyVfs));+ dummyVfs.pAppData = (void*)&autolockIoFinder;+ dummyVfs.zName = "dummy";+ pUnused->fd = fd;+ pUnused->flags = openFlags;+ pNew->pUnused = pUnused;+ + rc = fillInUnixFile(&dummyVfs, fd, (sqlite3_file*)pNew, path, 0);+ if( rc==SQLITE_OK ){+ *ppFile = pNew;+ return SQLITE_OK;+ }+end_create_proxy: + robust_close(pNew, fd, __LINE__);+ sqlite3_free(pNew);+ sqlite3_free(pUnused);+ return rc;+}++#ifdef SQLITE_TEST+/* simulate multiple hosts by creating unique hostid file paths */+SQLITE_PRIVATE int sqlite3_hostid_num = 0;+#endif++#define PROXY_HOSTIDLEN 16 /* conch file host id length */++#ifdef HAVE_GETHOSTUUID+/* Not always defined in the headers as it ought to be */+extern int gethostuuid(uuid_t id, const struct timespec *wait);+#endif++/* get the host ID via gethostuuid(), pHostID must point to PROXY_HOSTIDLEN +** bytes of writable memory.+*/+static int proxyGetHostID(unsigned char *pHostID, int *pError){+ assert(PROXY_HOSTIDLEN == sizeof(uuid_t));+ memset(pHostID, 0, PROXY_HOSTIDLEN);+#ifdef HAVE_GETHOSTUUID+ {+ struct timespec timeout = {1, 0}; /* 1 sec timeout */+ if( gethostuuid(pHostID, &timeout) ){+ int err = errno;+ if( pError ){+ *pError = err;+ }+ return SQLITE_IOERR;+ }+ }+#else+ UNUSED_PARAMETER(pError);+#endif+#ifdef SQLITE_TEST+ /* simulate multiple hosts by creating unique hostid file paths */+ if( sqlite3_hostid_num != 0){+ pHostID[0] = (char)(pHostID[0] + (char)(sqlite3_hostid_num & 0xFF));+ }+#endif+ + return SQLITE_OK;+}++/* The conch file contains the header, host id and lock file path+ */+#define PROXY_CONCHVERSION 2 /* 1-byte header, 16-byte host id, path */+#define PROXY_HEADERLEN 1 /* conch file header length */+#define PROXY_PATHINDEX (PROXY_HEADERLEN+PROXY_HOSTIDLEN)+#define PROXY_MAXCONCHLEN (PROXY_HEADERLEN+PROXY_HOSTIDLEN+MAXPATHLEN)++/* +** Takes an open conch file, copies the contents to a new path and then moves +** it back. The newly created file's file descriptor is assigned to the+** conch file structure and finally the original conch file descriptor is +** closed. Returns zero if successful.+*/+static int proxyBreakConchLock(unixFile *pFile, uuid_t myHostID){+ proxyLockingContext *pCtx = (proxyLockingContext *)pFile->lockingContext; + unixFile *conchFile = pCtx->conchFile;+ char tPath[MAXPATHLEN];+ char buf[PROXY_MAXCONCHLEN];+ char *cPath = pCtx->conchFilePath;+ size_t readLen = 0;+ size_t pathLen = 0;+ char errmsg[64] = "";+ int fd = -1;+ int rc = -1;+ UNUSED_PARAMETER(myHostID);++ /* create a new path by replace the trailing '-conch' with '-break' */+ pathLen = strlcpy(tPath, cPath, MAXPATHLEN);+ if( pathLen>MAXPATHLEN || pathLen<6 || + (strlcpy(&tPath[pathLen-5], "break", 6) != 5) ){+ sqlite3_snprintf(sizeof(errmsg),errmsg,"path error (len %d)",(int)pathLen);+ goto end_breaklock;+ }+ /* read the conch content */+ readLen = osPread(conchFile->h, buf, PROXY_MAXCONCHLEN, 0);+ if( readLen<PROXY_PATHINDEX ){+ sqlite3_snprintf(sizeof(errmsg),errmsg,"read error (len %d)",(int)readLen);+ goto end_breaklock;+ }+ /* write it out to the temporary break file */+ fd = robust_open(tPath, (O_RDWR|O_CREAT|O_EXCL), 0);+ if( fd<0 ){+ sqlite3_snprintf(sizeof(errmsg), errmsg, "create failed (%d)", errno);+ goto end_breaklock;+ }+ if( osPwrite(fd, buf, readLen, 0) != (ssize_t)readLen ){+ sqlite3_snprintf(sizeof(errmsg), errmsg, "write failed (%d)", errno);+ goto end_breaklock;+ }+ if( rename(tPath, cPath) ){+ sqlite3_snprintf(sizeof(errmsg), errmsg, "rename failed (%d)", errno);+ goto end_breaklock;+ }+ rc = 0;+ fprintf(stderr, "broke stale lock on %s\n", cPath);+ robust_close(pFile, conchFile->h, __LINE__);+ conchFile->h = fd;+ conchFile->openFlags = O_RDWR | O_CREAT;++end_breaklock:+ if( rc ){+ if( fd>=0 ){+ osUnlink(tPath);+ robust_close(pFile, fd, __LINE__);+ }+ fprintf(stderr, "failed to break stale lock on %s, %s\n", cPath, errmsg);+ }+ return rc;+}++/* Take the requested lock on the conch file and break a stale lock if the +** host id matches.+*/+static int proxyConchLock(unixFile *pFile, uuid_t myHostID, int lockType){+ proxyLockingContext *pCtx = (proxyLockingContext *)pFile->lockingContext; + unixFile *conchFile = pCtx->conchFile;+ int rc = SQLITE_OK;+ int nTries = 0;+ struct timespec conchModTime;+ + memset(&conchModTime, 0, sizeof(conchModTime));+ do {+ rc = conchFile->pMethod->xLock((sqlite3_file*)conchFile, lockType);+ nTries ++;+ if( rc==SQLITE_BUSY ){+ /* If the lock failed (busy):+ * 1st try: get the mod time of the conch, wait 0.5s and try again. + * 2nd try: fail if the mod time changed or host id is different, wait + * 10 sec and try again+ * 3rd try: break the lock unless the mod time has changed.+ */+ struct stat buf;+ if( osFstat(conchFile->h, &buf) ){+ storeLastErrno(pFile, errno);+ return SQLITE_IOERR_LOCK;+ }+ + if( nTries==1 ){+ conchModTime = buf.st_mtimespec;+ usleep(500000); /* wait 0.5 sec and try the lock again*/+ continue; + }++ assert( nTries>1 );+ if( conchModTime.tv_sec != buf.st_mtimespec.tv_sec || + conchModTime.tv_nsec != buf.st_mtimespec.tv_nsec ){+ return SQLITE_BUSY;+ }+ + if( nTries==2 ){ + char tBuf[PROXY_MAXCONCHLEN];+ int len = osPread(conchFile->h, tBuf, PROXY_MAXCONCHLEN, 0);+ if( len<0 ){+ storeLastErrno(pFile, errno);+ return SQLITE_IOERR_LOCK;+ }+ if( len>PROXY_PATHINDEX && tBuf[0]==(char)PROXY_CONCHVERSION){+ /* don't break the lock if the host id doesn't match */+ if( 0!=memcmp(&tBuf[PROXY_HEADERLEN], myHostID, PROXY_HOSTIDLEN) ){+ return SQLITE_BUSY;+ }+ }else{+ /* don't break the lock on short read or a version mismatch */+ return SQLITE_BUSY;+ }+ usleep(10000000); /* wait 10 sec and try the lock again */+ continue; + }+ + assert( nTries==3 );+ if( 0==proxyBreakConchLock(pFile, myHostID) ){+ rc = SQLITE_OK;+ if( lockType==EXCLUSIVE_LOCK ){+ rc = conchFile->pMethod->xLock((sqlite3_file*)conchFile, SHARED_LOCK);+ }+ if( !rc ){+ rc = conchFile->pMethod->xLock((sqlite3_file*)conchFile, lockType);+ }+ }+ }+ } while( rc==SQLITE_BUSY && nTries<3 );+ + return rc;+}++/* Takes the conch by taking a shared lock and read the contents conch, if +** lockPath is non-NULL, the host ID and lock file path must match. A NULL +** lockPath means that the lockPath in the conch file will be used if the +** host IDs match, or a new lock path will be generated automatically +** and written to the conch file.+*/+static int proxyTakeConch(unixFile *pFile){+ proxyLockingContext *pCtx = (proxyLockingContext *)pFile->lockingContext; + + if( pCtx->conchHeld!=0 ){+ return SQLITE_OK;+ }else{+ unixFile *conchFile = pCtx->conchFile;+ uuid_t myHostID;+ int pError = 0;+ char readBuf[PROXY_MAXCONCHLEN];+ char lockPath[MAXPATHLEN];+ char *tempLockPath = NULL;+ int rc = SQLITE_OK;+ int createConch = 0;+ int hostIdMatch = 0;+ int readLen = 0;+ int tryOldLockPath = 0;+ int forceNewLockPath = 0;+ + OSTRACE(("TAKECONCH %d for %s pid=%d\n", conchFile->h,+ (pCtx->lockProxyPath ? pCtx->lockProxyPath : ":auto:"),+ osGetpid(0)));++ rc = proxyGetHostID(myHostID, &pError);+ if( (rc&0xff)==SQLITE_IOERR ){+ storeLastErrno(pFile, pError);+ goto end_takeconch;+ }+ rc = proxyConchLock(pFile, myHostID, SHARED_LOCK);+ if( rc!=SQLITE_OK ){+ goto end_takeconch;+ }+ /* read the existing conch file */+ readLen = seekAndRead((unixFile*)conchFile, 0, readBuf, PROXY_MAXCONCHLEN);+ if( readLen<0 ){+ /* I/O error: lastErrno set by seekAndRead */+ storeLastErrno(pFile, conchFile->lastErrno);+ rc = SQLITE_IOERR_READ;+ goto end_takeconch;+ }else if( readLen<=(PROXY_HEADERLEN+PROXY_HOSTIDLEN) || + readBuf[0]!=(char)PROXY_CONCHVERSION ){+ /* a short read or version format mismatch means we need to create a new + ** conch file. + */+ createConch = 1;+ }+ /* if the host id matches and the lock path already exists in the conch+ ** we'll try to use the path there, if we can't open that path, we'll + ** retry with a new auto-generated path + */+ do { /* in case we need to try again for an :auto: named lock file */++ if( !createConch && !forceNewLockPath ){+ hostIdMatch = !memcmp(&readBuf[PROXY_HEADERLEN], myHostID, + PROXY_HOSTIDLEN);+ /* if the conch has data compare the contents */+ if( !pCtx->lockProxyPath ){+ /* for auto-named local lock file, just check the host ID and we'll+ ** use the local lock file path that's already in there+ */+ if( hostIdMatch ){+ size_t pathLen = (readLen - PROXY_PATHINDEX);+ + if( pathLen>=MAXPATHLEN ){+ pathLen=MAXPATHLEN-1;+ }+ memcpy(lockPath, &readBuf[PROXY_PATHINDEX], pathLen);+ lockPath[pathLen] = 0;+ tempLockPath = lockPath;+ tryOldLockPath = 1;+ /* create a copy of the lock path if the conch is taken */+ goto end_takeconch;+ }+ }else if( hostIdMatch+ && !strncmp(pCtx->lockProxyPath, &readBuf[PROXY_PATHINDEX],+ readLen-PROXY_PATHINDEX)+ ){+ /* conch host and lock path match */+ goto end_takeconch; + }+ }+ + /* if the conch isn't writable and doesn't match, we can't take it */+ if( (conchFile->openFlags&O_RDWR) == 0 ){+ rc = SQLITE_BUSY;+ goto end_takeconch;+ }+ + /* either the conch didn't match or we need to create a new one */+ if( !pCtx->lockProxyPath ){+ proxyGetLockPath(pCtx->dbPath, lockPath, MAXPATHLEN);+ tempLockPath = lockPath;+ /* create a copy of the lock path _only_ if the conch is taken */+ }+ + /* update conch with host and path (this will fail if other process+ ** has a shared lock already), if the host id matches, use the big+ ** stick.+ */+ futimes(conchFile->h, NULL);+ if( hostIdMatch && !createConch ){+ if( conchFile->pInode && conchFile->pInode->nShared>1 ){+ /* We are trying for an exclusive lock but another thread in this+ ** same process is still holding a shared lock. */+ rc = SQLITE_BUSY;+ } else { + rc = proxyConchLock(pFile, myHostID, EXCLUSIVE_LOCK);+ }+ }else{+ rc = proxyConchLock(pFile, myHostID, EXCLUSIVE_LOCK);+ }+ if( rc==SQLITE_OK ){+ char writeBuffer[PROXY_MAXCONCHLEN];+ int writeSize = 0;+ + writeBuffer[0] = (char)PROXY_CONCHVERSION;+ memcpy(&writeBuffer[PROXY_HEADERLEN], myHostID, PROXY_HOSTIDLEN);+ if( pCtx->lockProxyPath!=NULL ){+ strlcpy(&writeBuffer[PROXY_PATHINDEX], pCtx->lockProxyPath,+ MAXPATHLEN);+ }else{+ strlcpy(&writeBuffer[PROXY_PATHINDEX], tempLockPath, MAXPATHLEN);+ }+ writeSize = PROXY_PATHINDEX + strlen(&writeBuffer[PROXY_PATHINDEX]);+ robust_ftruncate(conchFile->h, writeSize);+ rc = unixWrite((sqlite3_file *)conchFile, writeBuffer, writeSize, 0);+ fsync(conchFile->h);+ /* If we created a new conch file (not just updated the contents of a + ** valid conch file), try to match the permissions of the database + */+ if( rc==SQLITE_OK && createConch ){+ struct stat buf;+ int err = osFstat(pFile->h, &buf);+ if( err==0 ){+ mode_t cmode = buf.st_mode&(S_IRUSR|S_IWUSR | S_IRGRP|S_IWGRP |+ S_IROTH|S_IWOTH);+ /* try to match the database file R/W permissions, ignore failure */+#ifndef SQLITE_PROXY_DEBUG+ osFchmod(conchFile->h, cmode);+#else+ do{+ rc = osFchmod(conchFile->h, cmode);+ }while( rc==(-1) && errno==EINTR );+ if( rc!=0 ){+ int code = errno;+ fprintf(stderr, "fchmod %o FAILED with %d %s\n",+ cmode, code, strerror(code));+ } else {+ fprintf(stderr, "fchmod %o SUCCEDED\n",cmode);+ }+ }else{+ int code = errno;+ fprintf(stderr, "STAT FAILED[%d] with %d %s\n", + err, code, strerror(code));+#endif+ }+ }+ }+ conchFile->pMethod->xUnlock((sqlite3_file*)conchFile, SHARED_LOCK);+ + end_takeconch:+ OSTRACE(("TRANSPROXY: CLOSE %d\n", pFile->h));+ if( rc==SQLITE_OK && pFile->openFlags ){+ int fd;+ if( pFile->h>=0 ){+ robust_close(pFile, pFile->h, __LINE__);+ }+ pFile->h = -1;+ fd = robust_open(pCtx->dbPath, pFile->openFlags, 0);+ OSTRACE(("TRANSPROXY: OPEN %d\n", fd));+ if( fd>=0 ){+ pFile->h = fd;+ }else{+ rc=SQLITE_CANTOPEN_BKPT; /* SQLITE_BUSY? proxyTakeConch called+ during locking */+ }+ }+ if( rc==SQLITE_OK && !pCtx->lockProxy ){+ char *path = tempLockPath ? tempLockPath : pCtx->lockProxyPath;+ rc = proxyCreateUnixFile(path, &pCtx->lockProxy, 1);+ if( rc!=SQLITE_OK && rc!=SQLITE_NOMEM && tryOldLockPath ){+ /* we couldn't create the proxy lock file with the old lock file path+ ** so try again via auto-naming + */+ forceNewLockPath = 1;+ tryOldLockPath = 0;+ continue; /* go back to the do {} while start point, try again */+ }+ }+ if( rc==SQLITE_OK ){+ /* Need to make a copy of path if we extracted the value+ ** from the conch file or the path was allocated on the stack+ */+ if( tempLockPath ){+ pCtx->lockProxyPath = sqlite3DbStrDup(0, tempLockPath);+ if( !pCtx->lockProxyPath ){+ rc = SQLITE_NOMEM;+ }+ }+ }+ if( rc==SQLITE_OK ){+ pCtx->conchHeld = 1;+ + if( pCtx->lockProxy->pMethod == &afpIoMethods ){+ afpLockingContext *afpCtx;+ afpCtx = (afpLockingContext *)pCtx->lockProxy->lockingContext;+ afpCtx->dbPath = pCtx->lockProxyPath;+ }+ } else {+ conchFile->pMethod->xUnlock((sqlite3_file*)conchFile, NO_LOCK);+ }+ OSTRACE(("TAKECONCH %d %s\n", conchFile->h,+ rc==SQLITE_OK?"ok":"failed"));+ return rc;+ } while (1); /* in case we need to retry the :auto: lock file - + ** we should never get here except via the 'continue' call. */+ }+}++/*+** If pFile holds a lock on a conch file, then release that lock.+*/+static int proxyReleaseConch(unixFile *pFile){+ int rc = SQLITE_OK; /* Subroutine return code */+ proxyLockingContext *pCtx; /* The locking context for the proxy lock */+ unixFile *conchFile; /* Name of the conch file */++ pCtx = (proxyLockingContext *)pFile->lockingContext;+ conchFile = pCtx->conchFile;+ OSTRACE(("RELEASECONCH %d for %s pid=%d\n", conchFile->h,+ (pCtx->lockProxyPath ? pCtx->lockProxyPath : ":auto:"), + osGetpid(0)));+ if( pCtx->conchHeld>0 ){+ rc = conchFile->pMethod->xUnlock((sqlite3_file*)conchFile, NO_LOCK);+ }+ pCtx->conchHeld = 0;+ OSTRACE(("RELEASECONCH %d %s\n", conchFile->h,+ (rc==SQLITE_OK ? "ok" : "failed")));+ return rc;+}++/*+** Given the name of a database file, compute the name of its conch file.+** Store the conch filename in memory obtained from sqlite3_malloc64().+** Make *pConchPath point to the new name. Return SQLITE_OK on success+** or SQLITE_NOMEM if unable to obtain memory.+**+** The caller is responsible for ensuring that the allocated memory+** space is eventually freed.+**+** *pConchPath is set to NULL if a memory allocation error occurs.+*/+static int proxyCreateConchPathname(char *dbPath, char **pConchPath){+ int i; /* Loop counter */+ int len = (int)strlen(dbPath); /* Length of database filename - dbPath */+ char *conchPath; /* buffer in which to construct conch name */++ /* Allocate space for the conch filename and initialize the name to+ ** the name of the original database file. */ + *pConchPath = conchPath = (char *)sqlite3_malloc64(len + 8);+ if( conchPath==0 ){+ return SQLITE_NOMEM;+ }+ memcpy(conchPath, dbPath, len+1);+ + /* now insert a "." before the last / character */+ for( i=(len-1); i>=0; i-- ){+ if( conchPath[i]=='/' ){+ i++;+ break;+ }+ }+ conchPath[i]='.';+ while ( i<len ){+ conchPath[i+1]=dbPath[i];+ i++;+ }++ /* append the "-conch" suffix to the file */+ memcpy(&conchPath[i+1], "-conch", 7);+ assert( (int)strlen(conchPath) == len+7 );++ return SQLITE_OK;+}+++/* Takes a fully configured proxy locking-style unix file and switches+** the local lock file path +*/+static int switchLockProxyPath(unixFile *pFile, const char *path) {+ proxyLockingContext *pCtx = (proxyLockingContext*)pFile->lockingContext;+ char *oldPath = pCtx->lockProxyPath;+ int rc = SQLITE_OK;++ if( pFile->eFileLock!=NO_LOCK ){+ return SQLITE_BUSY;+ } ++ /* nothing to do if the path is NULL, :auto: or matches the existing path */+ if( !path || path[0]=='\0' || !strcmp(path, ":auto:") ||+ (oldPath && !strncmp(oldPath, path, MAXPATHLEN)) ){+ return SQLITE_OK;+ }else{+ unixFile *lockProxy = pCtx->lockProxy;+ pCtx->lockProxy=NULL;+ pCtx->conchHeld = 0;+ if( lockProxy!=NULL ){+ rc=lockProxy->pMethod->xClose((sqlite3_file *)lockProxy);+ if( rc ) return rc;+ sqlite3_free(lockProxy);+ }+ sqlite3_free(oldPath);+ pCtx->lockProxyPath = sqlite3DbStrDup(0, path);+ }+ + return rc;+}++/*+** pFile is a file that has been opened by a prior xOpen call. dbPath+** is a string buffer at least MAXPATHLEN+1 characters in size.+**+** This routine find the filename associated with pFile and writes it+** int dbPath.+*/+static int proxyGetDbPathForUnixFile(unixFile *pFile, char *dbPath){+#if defined(__APPLE__)+ if( pFile->pMethod == &afpIoMethods ){+ /* afp style keeps a reference to the db path in the filePath field + ** of the struct */+ assert( (int)strlen((char*)pFile->lockingContext)<=MAXPATHLEN );+ strlcpy(dbPath, ((afpLockingContext *)pFile->lockingContext)->dbPath,+ MAXPATHLEN);+ } else+#endif+ if( pFile->pMethod == &dotlockIoMethods ){+ /* dot lock style uses the locking context to store the dot lock+ ** file path */+ int len = strlen((char *)pFile->lockingContext) - strlen(DOTLOCK_SUFFIX);+ memcpy(dbPath, (char *)pFile->lockingContext, len + 1);+ }else{+ /* all other styles use the locking context to store the db file path */+ assert( strlen((char*)pFile->lockingContext)<=MAXPATHLEN );+ strlcpy(dbPath, (char *)pFile->lockingContext, MAXPATHLEN);+ }+ return SQLITE_OK;+}++/*+** Takes an already filled in unix file and alters it so all file locking +** will be performed on the local proxy lock file. The following fields+** are preserved in the locking context so that they can be restored and +** the unix structure properly cleaned up at close time:+** ->lockingContext+** ->pMethod+*/+static int proxyTransformUnixFile(unixFile *pFile, const char *path) {+ proxyLockingContext *pCtx;+ char dbPath[MAXPATHLEN+1]; /* Name of the database file */+ char *lockPath=NULL;+ int rc = SQLITE_OK;+ + if( pFile->eFileLock!=NO_LOCK ){+ return SQLITE_BUSY;+ }+ proxyGetDbPathForUnixFile(pFile, dbPath);+ if( !path || path[0]=='\0' || !strcmp(path, ":auto:") ){+ lockPath=NULL;+ }else{+ lockPath=(char *)path;+ }+ + OSTRACE(("TRANSPROXY %d for %s pid=%d\n", pFile->h,+ (lockPath ? lockPath : ":auto:"), osGetpid(0)));++ pCtx = sqlite3_malloc64( sizeof(*pCtx) );+ if( pCtx==0 ){+ return SQLITE_NOMEM;+ }+ memset(pCtx, 0, sizeof(*pCtx));++ rc = proxyCreateConchPathname(dbPath, &pCtx->conchFilePath);+ if( rc==SQLITE_OK ){+ rc = proxyCreateUnixFile(pCtx->conchFilePath, &pCtx->conchFile, 0);+ if( rc==SQLITE_CANTOPEN && ((pFile->openFlags&O_RDWR) == 0) ){+ /* if (a) the open flags are not O_RDWR, (b) the conch isn't there, and+ ** (c) the file system is read-only, then enable no-locking access.+ ** Ugh, since O_RDONLY==0x0000 we test for !O_RDWR since unixOpen asserts+ ** that openFlags will have only one of O_RDONLY or O_RDWR.+ */+ struct statfs fsInfo;+ struct stat conchInfo;+ int goLockless = 0;++ if( osStat(pCtx->conchFilePath, &conchInfo) == -1 ) {+ int err = errno;+ if( (err==ENOENT) && (statfs(dbPath, &fsInfo) != -1) ){+ goLockless = (fsInfo.f_flags&MNT_RDONLY) == MNT_RDONLY;+ }+ }+ if( goLockless ){+ pCtx->conchHeld = -1; /* read only FS/ lockless */+ rc = SQLITE_OK;+ }+ }+ } + if( rc==SQLITE_OK && lockPath ){+ pCtx->lockProxyPath = sqlite3DbStrDup(0, lockPath);+ }++ if( rc==SQLITE_OK ){+ pCtx->dbPath = sqlite3DbStrDup(0, dbPath);+ if( pCtx->dbPath==NULL ){+ rc = SQLITE_NOMEM;+ }+ }+ if( rc==SQLITE_OK ){+ /* all memory is allocated, proxys are created and assigned, + ** switch the locking context and pMethod then return.+ */+ pCtx->oldLockingContext = pFile->lockingContext;+ pFile->lockingContext = pCtx;+ pCtx->pOldMethod = pFile->pMethod;+ pFile->pMethod = &proxyIoMethods;+ }else{+ if( pCtx->conchFile ){ + pCtx->conchFile->pMethod->xClose((sqlite3_file *)pCtx->conchFile);+ sqlite3_free(pCtx->conchFile);+ }+ sqlite3DbFree(0, pCtx->lockProxyPath);+ sqlite3_free(pCtx->conchFilePath); + sqlite3_free(pCtx);+ }+ OSTRACE(("TRANSPROXY %d %s\n", pFile->h,+ (rc==SQLITE_OK ? "ok" : "failed")));+ return rc;+}+++/*+** This routine handles sqlite3_file_control() calls that are specific+** to proxy locking.+*/+static int proxyFileControl(sqlite3_file *id, int op, void *pArg){+ switch( op ){+ case SQLITE_FCNTL_GET_LOCKPROXYFILE: {+ unixFile *pFile = (unixFile*)id;+ if( pFile->pMethod == &proxyIoMethods ){+ proxyLockingContext *pCtx = (proxyLockingContext*)pFile->lockingContext;+ proxyTakeConch(pFile);+ if( pCtx->lockProxyPath ){+ *(const char **)pArg = pCtx->lockProxyPath;+ }else{+ *(const char **)pArg = ":auto: (not held)";+ }+ } else {+ *(const char **)pArg = NULL;+ }+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_SET_LOCKPROXYFILE: {+ unixFile *pFile = (unixFile*)id;+ int rc = SQLITE_OK;+ int isProxyStyle = (pFile->pMethod == &proxyIoMethods);+ if( pArg==NULL || (const char *)pArg==0 ){+ if( isProxyStyle ){+ /* turn off proxy locking - not supported. If support is added for+ ** switching proxy locking mode off then it will need to fail if+ ** the journal mode is WAL mode. + */+ rc = SQLITE_ERROR /*SQLITE_PROTOCOL? SQLITE_MISUSE?*/;+ }else{+ /* turn off proxy locking - already off - NOOP */+ rc = SQLITE_OK;+ }+ }else{+ const char *proxyPath = (const char *)pArg;+ if( isProxyStyle ){+ proxyLockingContext *pCtx = + (proxyLockingContext*)pFile->lockingContext;+ if( !strcmp(pArg, ":auto:") + || (pCtx->lockProxyPath &&+ !strncmp(pCtx->lockProxyPath, proxyPath, MAXPATHLEN))+ ){+ rc = SQLITE_OK;+ }else{+ rc = switchLockProxyPath(pFile, proxyPath);+ }+ }else{+ /* turn on proxy file locking */+ rc = proxyTransformUnixFile(pFile, proxyPath);+ }+ }+ return rc;+ }+ default: {+ assert( 0 ); /* The call assures that only valid opcodes are sent */+ }+ }+ /*NOTREACHED*/+ return SQLITE_ERROR;+}++/*+** Within this division (the proxying locking implementation) the procedures+** above this point are all utilities. The lock-related methods of the+** proxy-locking sqlite3_io_method object follow.+*/+++/*+** This routine checks if there is a RESERVED lock held on the specified+** file by this or any other process. If such a lock is held, set *pResOut+** to a non-zero value otherwise *pResOut is set to zero. The return value+** is set to SQLITE_OK unless an I/O error occurs during lock checking.+*/+static int proxyCheckReservedLock(sqlite3_file *id, int *pResOut) {+ unixFile *pFile = (unixFile*)id;+ int rc = proxyTakeConch(pFile);+ if( rc==SQLITE_OK ){+ proxyLockingContext *pCtx = (proxyLockingContext *)pFile->lockingContext;+ if( pCtx->conchHeld>0 ){+ unixFile *proxy = pCtx->lockProxy;+ return proxy->pMethod->xCheckReservedLock((sqlite3_file*)proxy, pResOut);+ }else{ /* conchHeld < 0 is lockless */+ pResOut=0;+ }+ }+ return rc;+}++/*+** Lock the file with the lock specified by parameter eFileLock - one+** of the following:+**+** (1) SHARED_LOCK+** (2) RESERVED_LOCK+** (3) PENDING_LOCK+** (4) EXCLUSIVE_LOCK+**+** Sometimes when requesting one lock state, additional lock states+** are inserted in between. The locking might fail on one of the later+** transitions leaving the lock state different from what it started but+** still short of its goal. The following chart shows the allowed+** transitions and the inserted intermediate states:+**+** UNLOCKED -> SHARED+** SHARED -> RESERVED+** SHARED -> (PENDING) -> EXCLUSIVE+** RESERVED -> (PENDING) -> EXCLUSIVE+** PENDING -> EXCLUSIVE+**+** This routine will only increase a lock. Use the sqlite3OsUnlock()+** routine to lower a locking level.+*/+static int proxyLock(sqlite3_file *id, int eFileLock) {+ unixFile *pFile = (unixFile*)id;+ int rc = proxyTakeConch(pFile);+ if( rc==SQLITE_OK ){+ proxyLockingContext *pCtx = (proxyLockingContext *)pFile->lockingContext;+ if( pCtx->conchHeld>0 ){+ unixFile *proxy = pCtx->lockProxy;+ rc = proxy->pMethod->xLock((sqlite3_file*)proxy, eFileLock);+ pFile->eFileLock = proxy->eFileLock;+ }else{+ /* conchHeld < 0 is lockless */+ }+ }+ return rc;+}+++/*+** Lower the locking level on file descriptor pFile to eFileLock. eFileLock+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+*/+static int proxyUnlock(sqlite3_file *id, int eFileLock) {+ unixFile *pFile = (unixFile*)id;+ int rc = proxyTakeConch(pFile);+ if( rc==SQLITE_OK ){+ proxyLockingContext *pCtx = (proxyLockingContext *)pFile->lockingContext;+ if( pCtx->conchHeld>0 ){+ unixFile *proxy = pCtx->lockProxy;+ rc = proxy->pMethod->xUnlock((sqlite3_file*)proxy, eFileLock);+ pFile->eFileLock = proxy->eFileLock;+ }else{+ /* conchHeld < 0 is lockless */+ }+ }+ return rc;+}++/*+** Close a file that uses proxy locks.+*/+static int proxyClose(sqlite3_file *id) {+ if( id ){+ unixFile *pFile = (unixFile*)id;+ proxyLockingContext *pCtx = (proxyLockingContext *)pFile->lockingContext;+ unixFile *lockProxy = pCtx->lockProxy;+ unixFile *conchFile = pCtx->conchFile;+ int rc = SQLITE_OK;+ + if( lockProxy ){+ rc = lockProxy->pMethod->xUnlock((sqlite3_file*)lockProxy, NO_LOCK);+ if( rc ) return rc;+ rc = lockProxy->pMethod->xClose((sqlite3_file*)lockProxy);+ if( rc ) return rc;+ sqlite3_free(lockProxy);+ pCtx->lockProxy = 0;+ }+ if( conchFile ){+ if( pCtx->conchHeld ){+ rc = proxyReleaseConch(pFile);+ if( rc ) return rc;+ }+ rc = conchFile->pMethod->xClose((sqlite3_file*)conchFile);+ if( rc ) return rc;+ sqlite3_free(conchFile);+ }+ sqlite3DbFree(0, pCtx->lockProxyPath);+ sqlite3_free(pCtx->conchFilePath);+ sqlite3DbFree(0, pCtx->dbPath);+ /* restore the original locking context and pMethod then close it */+ pFile->lockingContext = pCtx->oldLockingContext;+ pFile->pMethod = pCtx->pOldMethod;+ sqlite3_free(pCtx);+ return pFile->pMethod->xClose(id);+ }+ return SQLITE_OK;+}++++#endif /* defined(__APPLE__) && SQLITE_ENABLE_LOCKING_STYLE */+/*+** The proxy locking style is intended for use with AFP filesystems.+** And since AFP is only supported on MacOSX, the proxy locking is also+** restricted to MacOSX.+** +**+******************* End of the proxy lock implementation **********************+******************************************************************************/++/*+** Initialize the operating system interface.+**+** This routine registers all VFS implementations for unix-like operating+** systems. This routine, and the sqlite3_os_end() routine that follows,+** should be the only routines in this file that are visible from other+** files.+**+** This routine is called once during SQLite initialization and by a+** single thread. The memory allocation and mutex subsystems have not+** necessarily been initialized when this routine is called, and so they+** should not be used.+*/+SQLITE_PRIVATE int sqlite3_os_init(void){ + /* + ** The following macro defines an initializer for an sqlite3_vfs object.+ ** The name of the VFS is NAME. The pAppData is a pointer to a pointer+ ** to the "finder" function. (pAppData is a pointer to a pointer because+ ** silly C90 rules prohibit a void* from being cast to a function pointer+ ** and so we have to go through the intermediate pointer to avoid problems+ ** when compiling with -pedantic-errors on GCC.)+ **+ ** The FINDER parameter to this macro is the name of the pointer to the+ ** finder-function. The finder-function returns a pointer to the+ ** sqlite_io_methods object that implements the desired locking+ ** behaviors. See the division above that contains the IOMETHODS+ ** macro for addition information on finder-functions.+ **+ ** Most finders simply return a pointer to a fixed sqlite3_io_methods+ ** object. But the "autolockIoFinder" available on MacOSX does a little+ ** more than that; it looks at the filesystem type that hosts the + ** database file and tries to choose an locking method appropriate for+ ** that filesystem time.+ */+ #define UNIXVFS(VFSNAME, FINDER) { \+ 3, /* iVersion */ \+ sizeof(unixFile), /* szOsFile */ \+ MAX_PATHNAME, /* mxPathname */ \+ 0, /* pNext */ \+ VFSNAME, /* zName */ \+ (void*)&FINDER, /* pAppData */ \+ unixOpen, /* xOpen */ \+ unixDelete, /* xDelete */ \+ unixAccess, /* xAccess */ \+ unixFullPathname, /* xFullPathname */ \+ unixDlOpen, /* xDlOpen */ \+ unixDlError, /* xDlError */ \+ unixDlSym, /* xDlSym */ \+ unixDlClose, /* xDlClose */ \+ unixRandomness, /* xRandomness */ \+ unixSleep, /* xSleep */ \+ unixCurrentTime, /* xCurrentTime */ \+ unixGetLastError, /* xGetLastError */ \+ unixCurrentTimeInt64, /* xCurrentTimeInt64 */ \+ unixSetSystemCall, /* xSetSystemCall */ \+ unixGetSystemCall, /* xGetSystemCall */ \+ unixNextSystemCall, /* xNextSystemCall */ \+ }++ /*+ ** All default VFSes for unix are contained in the following array.+ **+ ** Note that the sqlite3_vfs.pNext field of the VFS object is modified+ ** by the SQLite core when the VFS is registered. So the following+ ** array cannot be const.+ */+ static sqlite3_vfs aVfs[] = {+#if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__)+ UNIXVFS("unix", autolockIoFinder ),+#elif OS_VXWORKS+ UNIXVFS("unix", vxworksIoFinder ),+#else+ UNIXVFS("unix", posixIoFinder ),+#endif+ UNIXVFS("unix-none", nolockIoFinder ),+ UNIXVFS("unix-dotfile", dotlockIoFinder ),+ UNIXVFS("unix-excl", posixIoFinder ),+#if OS_VXWORKS+ UNIXVFS("unix-namedsem", semIoFinder ),+#endif+#if SQLITE_ENABLE_LOCKING_STYLE || OS_VXWORKS+ UNIXVFS("unix-posix", posixIoFinder ),+#endif+#if SQLITE_ENABLE_LOCKING_STYLE+ UNIXVFS("unix-flock", flockIoFinder ),+#endif+#if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__)+ UNIXVFS("unix-afp", afpIoFinder ),+ UNIXVFS("unix-nfs", nfsIoFinder ),+ UNIXVFS("unix-proxy", proxyIoFinder ),+#endif+ };+ unsigned int i; /* Loop counter */++ /* Double-check that the aSyscall[] array has been constructed+ ** correctly. See ticket [bb3a86e890c8e96ab] */+ assert( ArraySize(aSyscall)==25 );++ /* Register all VFSes defined in the aVfs[] array */+ for(i=0; i<(sizeof(aVfs)/sizeof(sqlite3_vfs)); i++){+ sqlite3_vfs_register(&aVfs[i], i==0);+ }+ return SQLITE_OK; +}++/*+** Shutdown the operating system interface.+**+** Some operating systems might need to do some cleanup in this routine,+** to release dynamically allocated objects. But not on unix.+** This routine is a no-op for unix.+*/+SQLITE_PRIVATE int sqlite3_os_end(void){ + return SQLITE_OK; +}+ +#endif /* SQLITE_OS_UNIX */++/************** End of os_unix.c *********************************************/+/************** Begin file os_win.c ******************************************/+/*+** 2004 May 22+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains code that is specific to Windows.+*/+/* #include "sqliteInt.h" */+#if SQLITE_OS_WIN /* This file is used for Windows only */++/*+** Include code that is common to all os_*.c files+*/+/************** Include os_common.h in the middle of os_win.c ****************/+/************** Begin file os_common.h ***************************************/+/*+** 2004 May 22+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+******************************************************************************+**+** This file contains macros and a little bit of code that is common to+** all of the platform-specific files (os_*.c) and is #included into those+** files.+**+** This file should be #included by the os_*.c files only. It is not a+** general purpose header file.+*/+#ifndef _OS_COMMON_H_+#define _OS_COMMON_H_++/*+** At least two bugs have slipped in because we changed the MEMORY_DEBUG+** macro to SQLITE_DEBUG and some older makefiles have not yet made the+** switch. The following code should catch this problem at compile-time.+*/+#ifdef MEMORY_DEBUG+# error "The MEMORY_DEBUG macro is obsolete. Use SQLITE_DEBUG instead."+#endif++/*+** Macros for performance tracing. Normally turned off. Only works+** on i486 hardware.+*/+#ifdef SQLITE_PERFORMANCE_TRACE++/* +** hwtime.h contains inline assembler code for implementing +** high-performance timing routines.+*/+/* #include "hwtime.h" */++static sqlite_uint64 g_start;+static sqlite_uint64 g_elapsed;+#define TIMER_START g_start=sqlite3Hwtime()+#define TIMER_END g_elapsed=sqlite3Hwtime()-g_start+#define TIMER_ELAPSED g_elapsed+#else+#define TIMER_START+#define TIMER_END+#define TIMER_ELAPSED ((sqlite_uint64)0)+#endif++/*+** If we compile with the SQLITE_TEST macro set, then the following block+** of code will give us the ability to simulate a disk I/O error. This+** is used for testing the I/O recovery logic.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_io_error_hit = 0; /* Total number of I/O Errors */+SQLITE_PRIVATE int sqlite3_io_error_hardhit = 0; /* Number of non-benign errors */+SQLITE_PRIVATE int sqlite3_io_error_pending = 0; /* Count down to first I/O error */+SQLITE_PRIVATE int sqlite3_io_error_persist = 0; /* True if I/O errors persist */+SQLITE_PRIVATE int sqlite3_io_error_benign = 0; /* True if errors are benign */+SQLITE_PRIVATE int sqlite3_diskfull_pending = 0;+SQLITE_PRIVATE int sqlite3_diskfull = 0;+#define SimulateIOErrorBenign(X) sqlite3_io_error_benign=(X)+#define SimulateIOError(CODE) \+ if( (sqlite3_io_error_persist && sqlite3_io_error_hit) \+ || sqlite3_io_error_pending-- == 1 ) \+ { local_ioerr(); CODE; }+static void local_ioerr(){+ IOTRACE(("IOERR\n"));+ sqlite3_io_error_hit++;+ if( !sqlite3_io_error_benign ) sqlite3_io_error_hardhit++;+}+#define SimulateDiskfullError(CODE) \+ if( sqlite3_diskfull_pending ){ \+ if( sqlite3_diskfull_pending == 1 ){ \+ local_ioerr(); \+ sqlite3_diskfull = 1; \+ sqlite3_io_error_hit = 1; \+ CODE; \+ }else{ \+ sqlite3_diskfull_pending--; \+ } \+ }+#else+#define SimulateIOErrorBenign(X)+#define SimulateIOError(A)+#define SimulateDiskfullError(A)+#endif++/*+** When testing, keep a count of the number of open files.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_open_file_count = 0;+#define OpenCounter(X) sqlite3_open_file_count+=(X)+#else+#define OpenCounter(X)+#endif++#endif /* !defined(_OS_COMMON_H_) */++/************** End of os_common.h *******************************************/+/************** Continuing where we left off in os_win.c *********************/++/*+** Include the header file for the Windows VFS.+*/+/* #include "os_win.h" */++/*+** Compiling and using WAL mode requires several APIs that are only+** available in Windows platforms based on the NT kernel.+*/+#if !SQLITE_OS_WINNT && !defined(SQLITE_OMIT_WAL)+# error "WAL mode requires support from the Windows NT kernel, compile\+ with SQLITE_OMIT_WAL."+#endif++#if !SQLITE_OS_WINNT && SQLITE_MAX_MMAP_SIZE>0+# error "Memory mapped files require support from the Windows NT kernel,\+ compile with SQLITE_MAX_MMAP_SIZE=0."+#endif++/*+** Are most of the Win32 ANSI APIs available (i.e. with certain exceptions+** based on the sub-platform)?+*/+#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && !defined(SQLITE_WIN32_NO_ANSI)+# define SQLITE_WIN32_HAS_ANSI+#endif++/*+** Are most of the Win32 Unicode APIs available (i.e. with certain exceptions+** based on the sub-platform)?+*/+#if (SQLITE_OS_WINCE || SQLITE_OS_WINNT || SQLITE_OS_WINRT) && \+ !defined(SQLITE_WIN32_NO_WIDE)+# define SQLITE_WIN32_HAS_WIDE+#endif++/*+** Make sure at least one set of Win32 APIs is available.+*/+#if !defined(SQLITE_WIN32_HAS_ANSI) && !defined(SQLITE_WIN32_HAS_WIDE)+# error "At least one of SQLITE_WIN32_HAS_ANSI and SQLITE_WIN32_HAS_WIDE\+ must be defined."+#endif++/*+** Define the required Windows SDK version constants if they are not+** already available.+*/+#ifndef NTDDI_WIN8+# define NTDDI_WIN8 0x06020000+#endif++#ifndef NTDDI_WINBLUE+# define NTDDI_WINBLUE 0x06030000+#endif++/*+** Check to see if the GetVersionEx[AW] functions are deprecated on the+** target system. GetVersionEx was first deprecated in Win8.1.+*/+#ifndef SQLITE_WIN32_GETVERSIONEX+# if defined(NTDDI_VERSION) && NTDDI_VERSION >= NTDDI_WINBLUE+# define SQLITE_WIN32_GETVERSIONEX 0 /* GetVersionEx() is deprecated */+# else+# define SQLITE_WIN32_GETVERSIONEX 1 /* GetVersionEx() is current */+# endif+#endif++/*+** This constant should already be defined (in the "WinDef.h" SDK file).+*/+#ifndef MAX_PATH+# define MAX_PATH (260)+#endif++/*+** Maximum pathname length (in chars) for Win32. This should normally be+** MAX_PATH.+*/+#ifndef SQLITE_WIN32_MAX_PATH_CHARS+# define SQLITE_WIN32_MAX_PATH_CHARS (MAX_PATH)+#endif++/*+** This constant should already be defined (in the "WinNT.h" SDK file).+*/+#ifndef UNICODE_STRING_MAX_CHARS+# define UNICODE_STRING_MAX_CHARS (32767)+#endif++/*+** Maximum pathname length (in chars) for WinNT. This should normally be+** UNICODE_STRING_MAX_CHARS.+*/+#ifndef SQLITE_WINNT_MAX_PATH_CHARS+# define SQLITE_WINNT_MAX_PATH_CHARS (UNICODE_STRING_MAX_CHARS)+#endif++/*+** Maximum pathname length (in bytes) for Win32. The MAX_PATH macro is in+** characters, so we allocate 4 bytes per character assuming worst-case of+** 4-bytes-per-character for UTF8.+*/+#ifndef SQLITE_WIN32_MAX_PATH_BYTES+# define SQLITE_WIN32_MAX_PATH_BYTES (SQLITE_WIN32_MAX_PATH_CHARS*4)+#endif++/*+** Maximum pathname length (in bytes) for WinNT. This should normally be+** UNICODE_STRING_MAX_CHARS * sizeof(WCHAR).+*/+#ifndef SQLITE_WINNT_MAX_PATH_BYTES+# define SQLITE_WINNT_MAX_PATH_BYTES \+ (sizeof(WCHAR) * SQLITE_WINNT_MAX_PATH_CHARS)+#endif++/*+** Maximum error message length (in chars) for WinRT.+*/+#ifndef SQLITE_WIN32_MAX_ERRMSG_CHARS+# define SQLITE_WIN32_MAX_ERRMSG_CHARS (1024)+#endif++/*+** Returns non-zero if the character should be treated as a directory+** separator.+*/+#ifndef winIsDirSep+# define winIsDirSep(a) (((a) == '/') || ((a) == '\\'))+#endif++/*+** This macro is used when a local variable is set to a value that is+** [sometimes] not used by the code (e.g. via conditional compilation).+*/+#ifndef UNUSED_VARIABLE_VALUE+# define UNUSED_VARIABLE_VALUE(x) (void)(x)+#endif++/*+** Returns the character that should be used as the directory separator.+*/+#ifndef winGetDirSep+# define winGetDirSep() '\\'+#endif++/*+** Do we need to manually define the Win32 file mapping APIs for use with WAL+** mode or memory mapped files (e.g. these APIs are available in the Windows+** CE SDK; however, they are not present in the header file)?+*/+#if SQLITE_WIN32_FILEMAPPING_API && \+ (!defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0)+/*+** Two of the file mapping APIs are different under WinRT. Figure out which+** set we need.+*/+#if SQLITE_OS_WINRT+WINBASEAPI HANDLE WINAPI CreateFileMappingFromApp(HANDLE, \+ LPSECURITY_ATTRIBUTES, ULONG, ULONG64, LPCWSTR);++WINBASEAPI LPVOID WINAPI MapViewOfFileFromApp(HANDLE, ULONG, ULONG64, SIZE_T);+#else+#if defined(SQLITE_WIN32_HAS_ANSI)+WINBASEAPI HANDLE WINAPI CreateFileMappingA(HANDLE, LPSECURITY_ATTRIBUTES, \+ DWORD, DWORD, DWORD, LPCSTR);+#endif /* defined(SQLITE_WIN32_HAS_ANSI) */++#if defined(SQLITE_WIN32_HAS_WIDE)+WINBASEAPI HANDLE WINAPI CreateFileMappingW(HANDLE, LPSECURITY_ATTRIBUTES, \+ DWORD, DWORD, DWORD, LPCWSTR);+#endif /* defined(SQLITE_WIN32_HAS_WIDE) */++WINBASEAPI LPVOID WINAPI MapViewOfFile(HANDLE, DWORD, DWORD, DWORD, SIZE_T);+#endif /* SQLITE_OS_WINRT */++/*+** These file mapping APIs are common to both Win32 and WinRT.+*/++WINBASEAPI BOOL WINAPI FlushViewOfFile(LPCVOID, SIZE_T);+WINBASEAPI BOOL WINAPI UnmapViewOfFile(LPCVOID);+#endif /* SQLITE_WIN32_FILEMAPPING_API */++/*+** Some Microsoft compilers lack this definition.+*/+#ifndef INVALID_FILE_ATTRIBUTES+# define INVALID_FILE_ATTRIBUTES ((DWORD)-1)+#endif++#ifndef FILE_FLAG_MASK+# define FILE_FLAG_MASK (0xFF3C0000)+#endif++#ifndef FILE_ATTRIBUTE_MASK+# define FILE_ATTRIBUTE_MASK (0x0003FFF7)+#endif++#ifndef SQLITE_OMIT_WAL+/* Forward references to structures used for WAL */+typedef struct winShm winShm; /* A connection to shared-memory */+typedef struct winShmNode winShmNode; /* A region of shared-memory */+#endif++/*+** WinCE lacks native support for file locking so we have to fake it+** with some code of our own.+*/+#if SQLITE_OS_WINCE+typedef struct winceLock {+ int nReaders; /* Number of reader locks obtained */+ BOOL bPending; /* Indicates a pending lock has been obtained */+ BOOL bReserved; /* Indicates a reserved lock has been obtained */+ BOOL bExclusive; /* Indicates an exclusive lock has been obtained */+} winceLock;+#endif++/*+** The winFile structure is a subclass of sqlite3_file* specific to the win32+** portability layer.+*/+typedef struct winFile winFile;+struct winFile {+ const sqlite3_io_methods *pMethod; /*** Must be first ***/+ sqlite3_vfs *pVfs; /* The VFS used to open this file */+ HANDLE h; /* Handle for accessing the file */+ u8 locktype; /* Type of lock currently held on this file */+ short sharedLockByte; /* Randomly chosen byte used as a shared lock */+ u8 ctrlFlags; /* Flags. See WINFILE_* below */+ DWORD lastErrno; /* The Windows errno from the last I/O error */+#ifndef SQLITE_OMIT_WAL+ winShm *pShm; /* Instance of shared memory on this file */+#endif+ const char *zPath; /* Full pathname of this file */+ int szChunk; /* Chunk size configured by FCNTL_CHUNK_SIZE */+#if SQLITE_OS_WINCE+ LPWSTR zDeleteOnClose; /* Name of file to delete when closing */+ HANDLE hMutex; /* Mutex used to control access to shared lock */+ HANDLE hShared; /* Shared memory segment used for locking */+ winceLock local; /* Locks obtained by this instance of winFile */+ winceLock *shared; /* Global shared lock memory for the file */+#endif+#if SQLITE_MAX_MMAP_SIZE>0+ int nFetchOut; /* Number of outstanding xFetch references */+ HANDLE hMap; /* Handle for accessing memory mapping */+ void *pMapRegion; /* Area memory mapped */+ sqlite3_int64 mmapSize; /* Usable size of mapped region */+ sqlite3_int64 mmapSizeActual; /* Actual size of mapped region */+ sqlite3_int64 mmapSizeMax; /* Configured FCNTL_MMAP_SIZE value */+#endif+};++/*+** Allowed values for winFile.ctrlFlags+*/+#define WINFILE_RDONLY 0x02 /* Connection is read only */+#define WINFILE_PERSIST_WAL 0x04 /* Persistent WAL mode */+#define WINFILE_PSOW 0x10 /* SQLITE_IOCAP_POWERSAFE_OVERWRITE */++/*+ * The value used with sqlite3_win32_set_directory() to specify that+ * the temporary directory should be changed.+ */+#ifndef SQLITE_WIN32_TEMP_DIRECTORY_TYPE+# define SQLITE_WIN32_TEMP_DIRECTORY_TYPE (2)+#endif++/*+ * If compiled with SQLITE_WIN32_MALLOC on Windows, we will use the+ * various Win32 API heap functions instead of our own.+ */+#ifdef SQLITE_WIN32_MALLOC++/*+ * If this is non-zero, an isolated heap will be created by the native Win32+ * allocator subsystem; otherwise, the default process heap will be used. This+ * setting has no effect when compiling for WinRT. By default, this is enabled+ * and an isolated heap will be created to store all allocated data.+ *+ ******************************************************************************+ * WARNING: It is important to note that when this setting is non-zero and the+ * winMemShutdown function is called (e.g. by the sqlite3BtreeShutdown+ * function), all data that was allocated using the isolated heap will+ * be freed immediately and any attempt to access any of that freed+ * data will almost certainly result in an immediate access violation.+ ******************************************************************************+ */+#ifndef SQLITE_WIN32_HEAP_CREATE+# define SQLITE_WIN32_HEAP_CREATE (TRUE)+#endif++/*+ * The initial size of the Win32-specific heap. This value may be zero.+ */+#ifndef SQLITE_WIN32_HEAP_INIT_SIZE+# define SQLITE_WIN32_HEAP_INIT_SIZE ((SQLITE_DEFAULT_CACHE_SIZE) * \+ (SQLITE_DEFAULT_PAGE_SIZE) + 4194304)+#endif++/*+ * The maximum size of the Win32-specific heap. This value may be zero.+ */+#ifndef SQLITE_WIN32_HEAP_MAX_SIZE+# define SQLITE_WIN32_HEAP_MAX_SIZE (0)+#endif++/*+ * The extra flags to use in calls to the Win32 heap APIs. This value may be+ * zero for the default behavior.+ */+#ifndef SQLITE_WIN32_HEAP_FLAGS+# define SQLITE_WIN32_HEAP_FLAGS (0)+#endif+++/*+** The winMemData structure stores information required by the Win32-specific+** sqlite3_mem_methods implementation.+*/+typedef struct winMemData winMemData;+struct winMemData {+#ifndef NDEBUG+ u32 magic1; /* Magic number to detect structure corruption. */+#endif+ HANDLE hHeap; /* The handle to our heap. */+ BOOL bOwned; /* Do we own the heap (i.e. destroy it on shutdown)? */+#ifndef NDEBUG+ u32 magic2; /* Magic number to detect structure corruption. */+#endif+};++#ifndef NDEBUG+#define WINMEM_MAGIC1 0x42b2830b+#define WINMEM_MAGIC2 0xbd4d7cf4+#endif++static struct winMemData win_mem_data = {+#ifndef NDEBUG+ WINMEM_MAGIC1,+#endif+ NULL, FALSE+#ifndef NDEBUG+ ,WINMEM_MAGIC2+#endif+};++#ifndef NDEBUG+#define winMemAssertMagic1() assert( win_mem_data.magic1==WINMEM_MAGIC1 )+#define winMemAssertMagic2() assert( win_mem_data.magic2==WINMEM_MAGIC2 )+#define winMemAssertMagic() winMemAssertMagic1(); winMemAssertMagic2();+#else+#define winMemAssertMagic()+#endif++#define winMemGetDataPtr() &win_mem_data+#define winMemGetHeap() win_mem_data.hHeap+#define winMemGetOwned() win_mem_data.bOwned++static void *winMemMalloc(int nBytes);+static void winMemFree(void *pPrior);+static void *winMemRealloc(void *pPrior, int nBytes);+static int winMemSize(void *p);+static int winMemRoundup(int n);+static int winMemInit(void *pAppData);+static void winMemShutdown(void *pAppData);++SQLITE_PRIVATE const sqlite3_mem_methods *sqlite3MemGetWin32(void);+#endif /* SQLITE_WIN32_MALLOC */++/*+** The following variable is (normally) set once and never changes+** thereafter. It records whether the operating system is Win9x+** or WinNT.+**+** 0: Operating system unknown.+** 1: Operating system is Win9x.+** 2: Operating system is WinNT.+**+** In order to facilitate testing on a WinNT system, the test fixture+** can manually set this value to 1 to emulate Win98 behavior.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE LONG SQLITE_WIN32_VOLATILE sqlite3_os_type = 0;+#else+static LONG SQLITE_WIN32_VOLATILE sqlite3_os_type = 0;+#endif++#ifndef SYSCALL+# define SYSCALL sqlite3_syscall_ptr+#endif++/*+** This function is not available on Windows CE or WinRT.+ */++#if SQLITE_OS_WINCE || SQLITE_OS_WINRT+# define osAreFileApisANSI() 1+#endif++/*+** Many system calls are accessed through pointer-to-functions so that+** they may be overridden at runtime to facilitate fault injection during+** testing and sandboxing. The following array holds the names and pointers+** to all overrideable system calls.+*/+static struct win_syscall {+ const char *zName; /* Name of the system call */+ sqlite3_syscall_ptr pCurrent; /* Current value of the system call */+ sqlite3_syscall_ptr pDefault; /* Default value */+} aSyscall[] = {+#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT+ { "AreFileApisANSI", (SYSCALL)AreFileApisANSI, 0 },+#else+ { "AreFileApisANSI", (SYSCALL)0, 0 },+#endif++#ifndef osAreFileApisANSI+#define osAreFileApisANSI ((BOOL(WINAPI*)(VOID))aSyscall[0].pCurrent)+#endif++#if SQLITE_OS_WINCE && defined(SQLITE_WIN32_HAS_WIDE)+ { "CharLowerW", (SYSCALL)CharLowerW, 0 },+#else+ { "CharLowerW", (SYSCALL)0, 0 },+#endif++#define osCharLowerW ((LPWSTR(WINAPI*)(LPWSTR))aSyscall[1].pCurrent)++#if SQLITE_OS_WINCE && defined(SQLITE_WIN32_HAS_WIDE)+ { "CharUpperW", (SYSCALL)CharUpperW, 0 },+#else+ { "CharUpperW", (SYSCALL)0, 0 },+#endif++#define osCharUpperW ((LPWSTR(WINAPI*)(LPWSTR))aSyscall[2].pCurrent)++ { "CloseHandle", (SYSCALL)CloseHandle, 0 },++#define osCloseHandle ((BOOL(WINAPI*)(HANDLE))aSyscall[3].pCurrent)++#if defined(SQLITE_WIN32_HAS_ANSI)+ { "CreateFileA", (SYSCALL)CreateFileA, 0 },+#else+ { "CreateFileA", (SYSCALL)0, 0 },+#endif++#define osCreateFileA ((HANDLE(WINAPI*)(LPCSTR,DWORD,DWORD, \+ LPSECURITY_ATTRIBUTES,DWORD,DWORD,HANDLE))aSyscall[4].pCurrent)++#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE)+ { "CreateFileW", (SYSCALL)CreateFileW, 0 },+#else+ { "CreateFileW", (SYSCALL)0, 0 },+#endif++#define osCreateFileW ((HANDLE(WINAPI*)(LPCWSTR,DWORD,DWORD, \+ LPSECURITY_ATTRIBUTES,DWORD,DWORD,HANDLE))aSyscall[5].pCurrent)++#if (!SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_ANSI) && \+ (!defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0))+ { "CreateFileMappingA", (SYSCALL)CreateFileMappingA, 0 },+#else+ { "CreateFileMappingA", (SYSCALL)0, 0 },+#endif++#define osCreateFileMappingA ((HANDLE(WINAPI*)(HANDLE,LPSECURITY_ATTRIBUTES, \+ DWORD,DWORD,DWORD,LPCSTR))aSyscall[6].pCurrent)++#if SQLITE_OS_WINCE || (!SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE) && \+ (!defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0))+ { "CreateFileMappingW", (SYSCALL)CreateFileMappingW, 0 },+#else+ { "CreateFileMappingW", (SYSCALL)0, 0 },+#endif++#define osCreateFileMappingW ((HANDLE(WINAPI*)(HANDLE,LPSECURITY_ATTRIBUTES, \+ DWORD,DWORD,DWORD,LPCWSTR))aSyscall[7].pCurrent)++#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE)+ { "CreateMutexW", (SYSCALL)CreateMutexW, 0 },+#else+ { "CreateMutexW", (SYSCALL)0, 0 },+#endif++#define osCreateMutexW ((HANDLE(WINAPI*)(LPSECURITY_ATTRIBUTES,BOOL, \+ LPCWSTR))aSyscall[8].pCurrent)++#if defined(SQLITE_WIN32_HAS_ANSI)+ { "DeleteFileA", (SYSCALL)DeleteFileA, 0 },+#else+ { "DeleteFileA", (SYSCALL)0, 0 },+#endif++#define osDeleteFileA ((BOOL(WINAPI*)(LPCSTR))aSyscall[9].pCurrent)++#if defined(SQLITE_WIN32_HAS_WIDE)+ { "DeleteFileW", (SYSCALL)DeleteFileW, 0 },+#else+ { "DeleteFileW", (SYSCALL)0, 0 },+#endif++#define osDeleteFileW ((BOOL(WINAPI*)(LPCWSTR))aSyscall[10].pCurrent)++#if SQLITE_OS_WINCE+ { "FileTimeToLocalFileTime", (SYSCALL)FileTimeToLocalFileTime, 0 },+#else+ { "FileTimeToLocalFileTime", (SYSCALL)0, 0 },+#endif++#define osFileTimeToLocalFileTime ((BOOL(WINAPI*)(CONST FILETIME*, \+ LPFILETIME))aSyscall[11].pCurrent)++#if SQLITE_OS_WINCE+ { "FileTimeToSystemTime", (SYSCALL)FileTimeToSystemTime, 0 },+#else+ { "FileTimeToSystemTime", (SYSCALL)0, 0 },+#endif++#define osFileTimeToSystemTime ((BOOL(WINAPI*)(CONST FILETIME*, \+ LPSYSTEMTIME))aSyscall[12].pCurrent)++ { "FlushFileBuffers", (SYSCALL)FlushFileBuffers, 0 },++#define osFlushFileBuffers ((BOOL(WINAPI*)(HANDLE))aSyscall[13].pCurrent)++#if defined(SQLITE_WIN32_HAS_ANSI)+ { "FormatMessageA", (SYSCALL)FormatMessageA, 0 },+#else+ { "FormatMessageA", (SYSCALL)0, 0 },+#endif++#define osFormatMessageA ((DWORD(WINAPI*)(DWORD,LPCVOID,DWORD,DWORD,LPSTR, \+ DWORD,va_list*))aSyscall[14].pCurrent)++#if defined(SQLITE_WIN32_HAS_WIDE)+ { "FormatMessageW", (SYSCALL)FormatMessageW, 0 },+#else+ { "FormatMessageW", (SYSCALL)0, 0 },+#endif++#define osFormatMessageW ((DWORD(WINAPI*)(DWORD,LPCVOID,DWORD,DWORD,LPWSTR, \+ DWORD,va_list*))aSyscall[15].pCurrent)++ { "FreeLibrary", (SYSCALL)0, 0 },++#define osFreeLibrary ((BOOL(WINAPI*)(HMODULE))aSyscall[16].pCurrent)++ { "GetCurrentProcessId", (SYSCALL)GetCurrentProcessId, 0 },++#define osGetCurrentProcessId ((DWORD(WINAPI*)(VOID))aSyscall[17].pCurrent)++#if !SQLITE_OS_WINCE && defined(SQLITE_WIN32_HAS_ANSI)+ { "GetDiskFreeSpaceA", (SYSCALL)GetDiskFreeSpaceA, 0 },+#else+ { "GetDiskFreeSpaceA", (SYSCALL)0, 0 },+#endif++#define osGetDiskFreeSpaceA ((BOOL(WINAPI*)(LPCSTR,LPDWORD,LPDWORD,LPDWORD, \+ LPDWORD))aSyscall[18].pCurrent)++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE)+ { "GetDiskFreeSpaceW", (SYSCALL)GetDiskFreeSpaceW, 0 },+#else+ { "GetDiskFreeSpaceW", (SYSCALL)0, 0 },+#endif++#define osGetDiskFreeSpaceW ((BOOL(WINAPI*)(LPCWSTR,LPDWORD,LPDWORD,LPDWORD, \+ LPDWORD))aSyscall[19].pCurrent)++#if defined(SQLITE_WIN32_HAS_ANSI)+ { "GetFileAttributesA", (SYSCALL)GetFileAttributesA, 0 },+#else+ { "GetFileAttributesA", (SYSCALL)0, 0 },+#endif++#define osGetFileAttributesA ((DWORD(WINAPI*)(LPCSTR))aSyscall[20].pCurrent)++#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE)+ { "GetFileAttributesW", (SYSCALL)GetFileAttributesW, 0 },+#else+ { "GetFileAttributesW", (SYSCALL)0, 0 },+#endif++#define osGetFileAttributesW ((DWORD(WINAPI*)(LPCWSTR))aSyscall[21].pCurrent)++#if defined(SQLITE_WIN32_HAS_WIDE)+ { "GetFileAttributesExW", (SYSCALL)GetFileAttributesExW, 0 },+#else+ { "GetFileAttributesExW", (SYSCALL)0, 0 },+#endif++#define osGetFileAttributesExW ((BOOL(WINAPI*)(LPCWSTR,GET_FILEEX_INFO_LEVELS, \+ LPVOID))aSyscall[22].pCurrent)++#if !SQLITE_OS_WINRT+ { "GetFileSize", (SYSCALL)GetFileSize, 0 },+#else+ { "GetFileSize", (SYSCALL)0, 0 },+#endif++#define osGetFileSize ((DWORD(WINAPI*)(HANDLE,LPDWORD))aSyscall[23].pCurrent)++#if !SQLITE_OS_WINCE && defined(SQLITE_WIN32_HAS_ANSI)+ { "GetFullPathNameA", (SYSCALL)GetFullPathNameA, 0 },+#else+ { "GetFullPathNameA", (SYSCALL)0, 0 },+#endif++#define osGetFullPathNameA ((DWORD(WINAPI*)(LPCSTR,DWORD,LPSTR, \+ LPSTR*))aSyscall[24].pCurrent)++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE)+ { "GetFullPathNameW", (SYSCALL)GetFullPathNameW, 0 },+#else+ { "GetFullPathNameW", (SYSCALL)0, 0 },+#endif++#define osGetFullPathNameW ((DWORD(WINAPI*)(LPCWSTR,DWORD,LPWSTR, \+ LPWSTR*))aSyscall[25].pCurrent)++ { "GetLastError", (SYSCALL)GetLastError, 0 },++#define osGetLastError ((DWORD(WINAPI*)(VOID))aSyscall[26].pCurrent)++ { "GetProcAddressA", (SYSCALL)0, 0 },++#define osGetProcAddressA ((FARPROC(WINAPI*)(HMODULE, \+ LPCSTR))aSyscall[27].pCurrent)++#if !SQLITE_OS_WINRT+ { "GetSystemInfo", (SYSCALL)GetSystemInfo, 0 },+#else+ { "GetSystemInfo", (SYSCALL)0, 0 },+#endif++#define osGetSystemInfo ((VOID(WINAPI*)(LPSYSTEM_INFO))aSyscall[28].pCurrent)++ { "GetSystemTime", (SYSCALL)GetSystemTime, 0 },++#define osGetSystemTime ((VOID(WINAPI*)(LPSYSTEMTIME))aSyscall[29].pCurrent)++#if !SQLITE_OS_WINCE+ { "GetSystemTimeAsFileTime", (SYSCALL)GetSystemTimeAsFileTime, 0 },+#else+ { "GetSystemTimeAsFileTime", (SYSCALL)0, 0 },+#endif++#define osGetSystemTimeAsFileTime ((VOID(WINAPI*)( \+ LPFILETIME))aSyscall[30].pCurrent)++#if defined(SQLITE_WIN32_HAS_ANSI)+ { "GetTempPathA", (SYSCALL)GetTempPathA, 0 },+#else+ { "GetTempPathA", (SYSCALL)0, 0 },+#endif++#define osGetTempPathA ((DWORD(WINAPI*)(DWORD,LPSTR))aSyscall[31].pCurrent)++#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE)+ { "GetTempPathW", (SYSCALL)GetTempPathW, 0 },+#else+ { "GetTempPathW", (SYSCALL)0, 0 },+#endif++#define osGetTempPathW ((DWORD(WINAPI*)(DWORD,LPWSTR))aSyscall[32].pCurrent)++#if !SQLITE_OS_WINRT+ { "GetTickCount", (SYSCALL)GetTickCount, 0 },+#else+ { "GetTickCount", (SYSCALL)0, 0 },+#endif++#define osGetTickCount ((DWORD(WINAPI*)(VOID))aSyscall[33].pCurrent)++#if defined(SQLITE_WIN32_HAS_ANSI) && defined(SQLITE_WIN32_GETVERSIONEX) && \+ SQLITE_WIN32_GETVERSIONEX+ { "GetVersionExA", (SYSCALL)GetVersionExA, 0 },+#else+ { "GetVersionExA", (SYSCALL)0, 0 },+#endif++#define osGetVersionExA ((BOOL(WINAPI*)( \+ LPOSVERSIONINFOA))aSyscall[34].pCurrent)++#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE) && \+ defined(SQLITE_WIN32_GETVERSIONEX) && SQLITE_WIN32_GETVERSIONEX+ { "GetVersionExW", (SYSCALL)GetVersionExW, 0 },+#else+ { "GetVersionExW", (SYSCALL)0, 0 },+#endif++#define osGetVersionExW ((BOOL(WINAPI*)( \+ LPOSVERSIONINFOW))aSyscall[35].pCurrent)++ { "HeapAlloc", (SYSCALL)HeapAlloc, 0 },++#define osHeapAlloc ((LPVOID(WINAPI*)(HANDLE,DWORD, \+ SIZE_T))aSyscall[36].pCurrent)++#if !SQLITE_OS_WINRT+ { "HeapCreate", (SYSCALL)HeapCreate, 0 },+#else+ { "HeapCreate", (SYSCALL)0, 0 },+#endif++#define osHeapCreate ((HANDLE(WINAPI*)(DWORD,SIZE_T, \+ SIZE_T))aSyscall[37].pCurrent)++#if !SQLITE_OS_WINRT+ { "HeapDestroy", (SYSCALL)HeapDestroy, 0 },+#else+ { "HeapDestroy", (SYSCALL)0, 0 },+#endif++#define osHeapDestroy ((BOOL(WINAPI*)(HANDLE))aSyscall[38].pCurrent)++ { "HeapFree", (SYSCALL)HeapFree, 0 },++#define osHeapFree ((BOOL(WINAPI*)(HANDLE,DWORD,LPVOID))aSyscall[39].pCurrent)++ { "HeapReAlloc", (SYSCALL)HeapReAlloc, 0 },++#define osHeapReAlloc ((LPVOID(WINAPI*)(HANDLE,DWORD,LPVOID, \+ SIZE_T))aSyscall[40].pCurrent)++ { "HeapSize", (SYSCALL)HeapSize, 0 },++#define osHeapSize ((SIZE_T(WINAPI*)(HANDLE,DWORD, \+ LPCVOID))aSyscall[41].pCurrent)++#if !SQLITE_OS_WINRT+ { "HeapValidate", (SYSCALL)HeapValidate, 0 },+#else+ { "HeapValidate", (SYSCALL)0, 0 },+#endif++#define osHeapValidate ((BOOL(WINAPI*)(HANDLE,DWORD, \+ LPCVOID))aSyscall[42].pCurrent)++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT+ { "HeapCompact", (SYSCALL)HeapCompact, 0 },+#else+ { "HeapCompact", (SYSCALL)0, 0 },+#endif++#define osHeapCompact ((UINT(WINAPI*)(HANDLE,DWORD))aSyscall[43].pCurrent)++ { "LoadLibraryA", (SYSCALL)0, 0 },++#define osLoadLibraryA ((HMODULE(WINAPI*)(LPCSTR))aSyscall[44].pCurrent)++#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_HAS_WIDE)+ { "LoadLibraryW", (SYSCALL)LoadLibraryW, 0 },+#else+ { "LoadLibraryW", (SYSCALL)0, 0 },+#endif++#define osLoadLibraryW ((HMODULE(WINAPI*)(LPCWSTR))aSyscall[45].pCurrent)++#if !SQLITE_OS_WINRT+ { "LocalFree", (SYSCALL)LocalFree, 0 },+#else+ { "LocalFree", (SYSCALL)0, 0 },+#endif++#define osLocalFree ((HLOCAL(WINAPI*)(HLOCAL))aSyscall[46].pCurrent)++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT+ { "LockFile", (SYSCALL)LockFile, 0 },+#else+ { "LockFile", (SYSCALL)0, 0 },+#endif++#ifndef osLockFile+#define osLockFile ((BOOL(WINAPI*)(HANDLE,DWORD,DWORD,DWORD, \+ DWORD))aSyscall[47].pCurrent)+#endif++#if !SQLITE_OS_WINCE+ { "LockFileEx", (SYSCALL)LockFileEx, 0 },+#else+ { "LockFileEx", (SYSCALL)0, 0 },+#endif++#ifndef osLockFileEx+#define osLockFileEx ((BOOL(WINAPI*)(HANDLE,DWORD,DWORD,DWORD,DWORD, \+ LPOVERLAPPED))aSyscall[48].pCurrent)+#endif++#if SQLITE_OS_WINCE || (!SQLITE_OS_WINRT && \+ (!defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0))+ { "MapViewOfFile", (SYSCALL)MapViewOfFile, 0 },+#else+ { "MapViewOfFile", (SYSCALL)0, 0 },+#endif++#define osMapViewOfFile ((LPVOID(WINAPI*)(HANDLE,DWORD,DWORD,DWORD, \+ SIZE_T))aSyscall[49].pCurrent)++ { "MultiByteToWideChar", (SYSCALL)MultiByteToWideChar, 0 },++#define osMultiByteToWideChar ((int(WINAPI*)(UINT,DWORD,LPCSTR,int,LPWSTR, \+ int))aSyscall[50].pCurrent)++ { "QueryPerformanceCounter", (SYSCALL)QueryPerformanceCounter, 0 },++#define osQueryPerformanceCounter ((BOOL(WINAPI*)( \+ LARGE_INTEGER*))aSyscall[51].pCurrent)++ { "ReadFile", (SYSCALL)ReadFile, 0 },++#define osReadFile ((BOOL(WINAPI*)(HANDLE,LPVOID,DWORD,LPDWORD, \+ LPOVERLAPPED))aSyscall[52].pCurrent)++ { "SetEndOfFile", (SYSCALL)SetEndOfFile, 0 },++#define osSetEndOfFile ((BOOL(WINAPI*)(HANDLE))aSyscall[53].pCurrent)++#if !SQLITE_OS_WINRT+ { "SetFilePointer", (SYSCALL)SetFilePointer, 0 },+#else+ { "SetFilePointer", (SYSCALL)0, 0 },+#endif++#define osSetFilePointer ((DWORD(WINAPI*)(HANDLE,LONG,PLONG, \+ DWORD))aSyscall[54].pCurrent)++#if !SQLITE_OS_WINRT+ { "Sleep", (SYSCALL)Sleep, 0 },+#else+ { "Sleep", (SYSCALL)0, 0 },+#endif++#define osSleep ((VOID(WINAPI*)(DWORD))aSyscall[55].pCurrent)++ { "SystemTimeToFileTime", (SYSCALL)SystemTimeToFileTime, 0 },++#define osSystemTimeToFileTime ((BOOL(WINAPI*)(CONST SYSTEMTIME*, \+ LPFILETIME))aSyscall[56].pCurrent)++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT+ { "UnlockFile", (SYSCALL)UnlockFile, 0 },+#else+ { "UnlockFile", (SYSCALL)0, 0 },+#endif++#ifndef osUnlockFile+#define osUnlockFile ((BOOL(WINAPI*)(HANDLE,DWORD,DWORD,DWORD, \+ DWORD))aSyscall[57].pCurrent)+#endif++#if !SQLITE_OS_WINCE+ { "UnlockFileEx", (SYSCALL)UnlockFileEx, 0 },+#else+ { "UnlockFileEx", (SYSCALL)0, 0 },+#endif++#define osUnlockFileEx ((BOOL(WINAPI*)(HANDLE,DWORD,DWORD,DWORD, \+ LPOVERLAPPED))aSyscall[58].pCurrent)++#if SQLITE_OS_WINCE || !defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0+ { "UnmapViewOfFile", (SYSCALL)UnmapViewOfFile, 0 },+#else+ { "UnmapViewOfFile", (SYSCALL)0, 0 },+#endif++#define osUnmapViewOfFile ((BOOL(WINAPI*)(LPCVOID))aSyscall[59].pCurrent)++ { "WideCharToMultiByte", (SYSCALL)WideCharToMultiByte, 0 },++#define osWideCharToMultiByte ((int(WINAPI*)(UINT,DWORD,LPCWSTR,int,LPSTR,int, \+ LPCSTR,LPBOOL))aSyscall[60].pCurrent)++ { "WriteFile", (SYSCALL)WriteFile, 0 },++#define osWriteFile ((BOOL(WINAPI*)(HANDLE,LPCVOID,DWORD,LPDWORD, \+ LPOVERLAPPED))aSyscall[61].pCurrent)++#if SQLITE_OS_WINRT+ { "CreateEventExW", (SYSCALL)CreateEventExW, 0 },+#else+ { "CreateEventExW", (SYSCALL)0, 0 },+#endif++#define osCreateEventExW ((HANDLE(WINAPI*)(LPSECURITY_ATTRIBUTES,LPCWSTR, \+ DWORD,DWORD))aSyscall[62].pCurrent)++#if !SQLITE_OS_WINRT+ { "WaitForSingleObject", (SYSCALL)WaitForSingleObject, 0 },+#else+ { "WaitForSingleObject", (SYSCALL)0, 0 },+#endif++#define osWaitForSingleObject ((DWORD(WINAPI*)(HANDLE, \+ DWORD))aSyscall[63].pCurrent)++#if !SQLITE_OS_WINCE+ { "WaitForSingleObjectEx", (SYSCALL)WaitForSingleObjectEx, 0 },+#else+ { "WaitForSingleObjectEx", (SYSCALL)0, 0 },+#endif++#define osWaitForSingleObjectEx ((DWORD(WINAPI*)(HANDLE,DWORD, \+ BOOL))aSyscall[64].pCurrent)++#if SQLITE_OS_WINRT+ { "SetFilePointerEx", (SYSCALL)SetFilePointerEx, 0 },+#else+ { "SetFilePointerEx", (SYSCALL)0, 0 },+#endif++#define osSetFilePointerEx ((BOOL(WINAPI*)(HANDLE,LARGE_INTEGER, \+ PLARGE_INTEGER,DWORD))aSyscall[65].pCurrent)++#if SQLITE_OS_WINRT+ { "GetFileInformationByHandleEx", (SYSCALL)GetFileInformationByHandleEx, 0 },+#else+ { "GetFileInformationByHandleEx", (SYSCALL)0, 0 },+#endif++#define osGetFileInformationByHandleEx ((BOOL(WINAPI*)(HANDLE, \+ FILE_INFO_BY_HANDLE_CLASS,LPVOID,DWORD))aSyscall[66].pCurrent)++#if SQLITE_OS_WINRT && (!defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0)+ { "MapViewOfFileFromApp", (SYSCALL)MapViewOfFileFromApp, 0 },+#else+ { "MapViewOfFileFromApp", (SYSCALL)0, 0 },+#endif++#define osMapViewOfFileFromApp ((LPVOID(WINAPI*)(HANDLE,ULONG,ULONG64, \+ SIZE_T))aSyscall[67].pCurrent)++#if SQLITE_OS_WINRT+ { "CreateFile2", (SYSCALL)CreateFile2, 0 },+#else+ { "CreateFile2", (SYSCALL)0, 0 },+#endif++#define osCreateFile2 ((HANDLE(WINAPI*)(LPCWSTR,DWORD,DWORD,DWORD, \+ LPCREATEFILE2_EXTENDED_PARAMETERS))aSyscall[68].pCurrent)++ { "LoadPackagedLibrary", (SYSCALL)0, 0 },++#define osLoadPackagedLibrary ((HMODULE(WINAPI*)(LPCWSTR, \+ DWORD))aSyscall[69].pCurrent)++#if SQLITE_OS_WINRT+ { "GetTickCount64", (SYSCALL)GetTickCount64, 0 },+#else+ { "GetTickCount64", (SYSCALL)0, 0 },+#endif++#define osGetTickCount64 ((ULONGLONG(WINAPI*)(VOID))aSyscall[70].pCurrent)++#if SQLITE_OS_WINRT+ { "GetNativeSystemInfo", (SYSCALL)GetNativeSystemInfo, 0 },+#else+ { "GetNativeSystemInfo", (SYSCALL)0, 0 },+#endif++#define osGetNativeSystemInfo ((VOID(WINAPI*)( \+ LPSYSTEM_INFO))aSyscall[71].pCurrent)++#if defined(SQLITE_WIN32_HAS_ANSI)+ { "OutputDebugStringA", (SYSCALL)OutputDebugStringA, 0 },+#else+ { "OutputDebugStringA", (SYSCALL)0, 0 },+#endif++#define osOutputDebugStringA ((VOID(WINAPI*)(LPCSTR))aSyscall[72].pCurrent)++#if defined(SQLITE_WIN32_HAS_WIDE)+ { "OutputDebugStringW", (SYSCALL)OutputDebugStringW, 0 },+#else+ { "OutputDebugStringW", (SYSCALL)0, 0 },+#endif++#define osOutputDebugStringW ((VOID(WINAPI*)(LPCWSTR))aSyscall[73].pCurrent)++ { "GetProcessHeap", (SYSCALL)GetProcessHeap, 0 },++#define osGetProcessHeap ((HANDLE(WINAPI*)(VOID))aSyscall[74].pCurrent)++#if SQLITE_OS_WINRT && (!defined(SQLITE_OMIT_WAL) || SQLITE_MAX_MMAP_SIZE>0)+ { "CreateFileMappingFromApp", (SYSCALL)CreateFileMappingFromApp, 0 },+#else+ { "CreateFileMappingFromApp", (SYSCALL)0, 0 },+#endif++#define osCreateFileMappingFromApp ((HANDLE(WINAPI*)(HANDLE, \+ LPSECURITY_ATTRIBUTES,ULONG,ULONG64,LPCWSTR))aSyscall[75].pCurrent)++/*+** NOTE: On some sub-platforms, the InterlockedCompareExchange "function"+** is really just a macro that uses a compiler intrinsic (e.g. x64).+** So do not try to make this is into a redefinable interface.+*/+#if defined(InterlockedCompareExchange)+ { "InterlockedCompareExchange", (SYSCALL)0, 0 },++#define osInterlockedCompareExchange InterlockedCompareExchange+#else+ { "InterlockedCompareExchange", (SYSCALL)InterlockedCompareExchange, 0 },++#define osInterlockedCompareExchange ((LONG(WINAPI*)(LONG \+ SQLITE_WIN32_VOLATILE*, LONG,LONG))aSyscall[76].pCurrent)+#endif /* defined(InterlockedCompareExchange) */++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && SQLITE_WIN32_USE_UUID+ { "UuidCreate", (SYSCALL)UuidCreate, 0 },+#else+ { "UuidCreate", (SYSCALL)0, 0 },+#endif++#define osUuidCreate ((RPC_STATUS(RPC_ENTRY*)(UUID*))aSyscall[77].pCurrent)++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && SQLITE_WIN32_USE_UUID+ { "UuidCreateSequential", (SYSCALL)UuidCreateSequential, 0 },+#else+ { "UuidCreateSequential", (SYSCALL)0, 0 },+#endif++#define osUuidCreateSequential \+ ((RPC_STATUS(RPC_ENTRY*)(UUID*))aSyscall[78].pCurrent)++#if !defined(SQLITE_NO_SYNC) && SQLITE_MAX_MMAP_SIZE>0+ { "FlushViewOfFile", (SYSCALL)FlushViewOfFile, 0 },+#else+ { "FlushViewOfFile", (SYSCALL)0, 0 },+#endif++#define osFlushViewOfFile \+ ((BOOL(WINAPI*)(LPCVOID,SIZE_T))aSyscall[79].pCurrent)++}; /* End of the overrideable system calls */++/*+** This is the xSetSystemCall() method of sqlite3_vfs for all of the+** "win32" VFSes. Return SQLITE_OK opon successfully updating the+** system call pointer, or SQLITE_NOTFOUND if there is no configurable+** system call named zName.+*/+static int winSetSystemCall(+ sqlite3_vfs *pNotUsed, /* The VFS pointer. Not used */+ const char *zName, /* Name of system call to override */+ sqlite3_syscall_ptr pNewFunc /* Pointer to new system call value */+){+ unsigned int i;+ int rc = SQLITE_NOTFOUND;++ UNUSED_PARAMETER(pNotUsed);+ if( zName==0 ){+ /* If no zName is given, restore all system calls to their default+ ** settings and return NULL+ */+ rc = SQLITE_OK;+ for(i=0; i<sizeof(aSyscall)/sizeof(aSyscall[0]); i++){+ if( aSyscall[i].pDefault ){+ aSyscall[i].pCurrent = aSyscall[i].pDefault;+ }+ }+ }else{+ /* If zName is specified, operate on only the one system call+ ** specified.+ */+ for(i=0; i<sizeof(aSyscall)/sizeof(aSyscall[0]); i++){+ if( strcmp(zName, aSyscall[i].zName)==0 ){+ if( aSyscall[i].pDefault==0 ){+ aSyscall[i].pDefault = aSyscall[i].pCurrent;+ }+ rc = SQLITE_OK;+ if( pNewFunc==0 ) pNewFunc = aSyscall[i].pDefault;+ aSyscall[i].pCurrent = pNewFunc;+ break;+ }+ }+ }+ return rc;+}++/*+** Return the value of a system call. Return NULL if zName is not a+** recognized system call name. NULL is also returned if the system call+** is currently undefined.+*/+static sqlite3_syscall_ptr winGetSystemCall(+ sqlite3_vfs *pNotUsed,+ const char *zName+){+ unsigned int i;++ UNUSED_PARAMETER(pNotUsed);+ for(i=0; i<sizeof(aSyscall)/sizeof(aSyscall[0]); i++){+ if( strcmp(zName, aSyscall[i].zName)==0 ) return aSyscall[i].pCurrent;+ }+ return 0;+}++/*+** Return the name of the first system call after zName. If zName==NULL+** then return the name of the first system call. Return NULL if zName+** is the last system call or if zName is not the name of a valid+** system call.+*/+static const char *winNextSystemCall(sqlite3_vfs *p, const char *zName){+ int i = -1;++ UNUSED_PARAMETER(p);+ if( zName ){+ for(i=0; i<ArraySize(aSyscall)-1; i++){+ if( strcmp(zName, aSyscall[i].zName)==0 ) break;+ }+ }+ for(i++; i<ArraySize(aSyscall); i++){+ if( aSyscall[i].pCurrent!=0 ) return aSyscall[i].zName;+ }+ return 0;+}++#ifdef SQLITE_WIN32_MALLOC+/*+** If a Win32 native heap has been configured, this function will attempt to+** compact it. Upon success, SQLITE_OK will be returned. Upon failure, one+** of SQLITE_NOMEM, SQLITE_ERROR, or SQLITE_NOTFOUND will be returned. The+** "pnLargest" argument, if non-zero, will be used to return the size of the+** largest committed free block in the heap, in bytes.+*/+SQLITE_PRIVATE int sqlite3_win32_compact_heap(LPUINT pnLargest){+ int rc = SQLITE_OK;+ UINT nLargest = 0;+ HANDLE hHeap;++ winMemAssertMagic();+ hHeap = winMemGetHeap();+ assert( hHeap!=0 );+ assert( hHeap!=INVALID_HANDLE_VALUE );+#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_MALLOC_VALIDATE)+ assert( osHeapValidate(hHeap, SQLITE_WIN32_HEAP_FLAGS, NULL) );+#endif+#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT+ if( (nLargest=osHeapCompact(hHeap, SQLITE_WIN32_HEAP_FLAGS))==0 ){+ DWORD lastErrno = osGetLastError();+ if( lastErrno==NO_ERROR ){+ sqlite3_log(SQLITE_NOMEM, "failed to HeapCompact (no space), heap=%p",+ (void*)hHeap);+ rc = SQLITE_NOMEM;+ }else{+ sqlite3_log(SQLITE_ERROR, "failed to HeapCompact (%lu), heap=%p",+ osGetLastError(), (void*)hHeap);+ rc = SQLITE_ERROR;+ }+ }+#else+ sqlite3_log(SQLITE_NOTFOUND, "failed to HeapCompact, heap=%p",+ (void*)hHeap);+ rc = SQLITE_NOTFOUND;+#endif+ if( pnLargest ) *pnLargest = nLargest;+ return rc;+}++/*+** If a Win32 native heap has been configured, this function will attempt to+** destroy and recreate it. If the Win32 native heap is not isolated and/or+** the sqlite3_memory_used() function does not return zero, SQLITE_BUSY will+** be returned and no changes will be made to the Win32 native heap.+*/+SQLITE_PRIVATE int sqlite3_win32_reset_heap(){+ int rc;+ MUTEX_LOGIC( sqlite3_mutex *pMaster; ) /* The main static mutex */+ MUTEX_LOGIC( sqlite3_mutex *pMem; ) /* The memsys static mutex */+ MUTEX_LOGIC( pMaster = sqlite3_mutex_alloc(SQLITE_MUTEX_STATIC_MASTER); )+ MUTEX_LOGIC( pMem = sqlite3_mutex_alloc(SQLITE_MUTEX_STATIC_MEM); )+ sqlite3_mutex_enter(pMaster);+ sqlite3_mutex_enter(pMem);+ winMemAssertMagic();+ if( winMemGetHeap()!=NULL && winMemGetOwned() && sqlite3_memory_used()==0 ){+ /*+ ** At this point, there should be no outstanding memory allocations on+ ** the heap. Also, since both the master and memsys locks are currently+ ** being held by us, no other function (i.e. from another thread) should+ ** be able to even access the heap. Attempt to destroy and recreate our+ ** isolated Win32 native heap now.+ */+ assert( winMemGetHeap()!=NULL );+ assert( winMemGetOwned() );+ assert( sqlite3_memory_used()==0 );+ winMemShutdown(winMemGetDataPtr());+ assert( winMemGetHeap()==NULL );+ assert( !winMemGetOwned() );+ assert( sqlite3_memory_used()==0 );+ rc = winMemInit(winMemGetDataPtr());+ assert( rc!=SQLITE_OK || winMemGetHeap()!=NULL );+ assert( rc!=SQLITE_OK || winMemGetOwned() );+ assert( rc!=SQLITE_OK || sqlite3_memory_used()==0 );+ }else{+ /*+ ** The Win32 native heap cannot be modified because it may be in use.+ */+ rc = SQLITE_BUSY;+ }+ sqlite3_mutex_leave(pMem);+ sqlite3_mutex_leave(pMaster);+ return rc;+}+#endif /* SQLITE_WIN32_MALLOC */++/*+** The following routine suspends the current thread for at least ms+** milliseconds. This is equivalent to the Win32 Sleep() interface.+*/+#if SQLITE_OS_WINRT+static HANDLE sleepObj = NULL;+#endif++SQLITE_PRIVATE void sqlite3_win32_sleep(DWORD milliseconds){+#if SQLITE_OS_WINRT+ if ( sleepObj==NULL ){+ sleepObj = osCreateEventExW(NULL, NULL, CREATE_EVENT_MANUAL_RESET,+ SYNCHRONIZE);+ }+ assert( sleepObj!=NULL );+ osWaitForSingleObjectEx(sleepObj, milliseconds, FALSE);+#else+ osSleep(milliseconds);+#endif+}++#if SQLITE_MAX_WORKER_THREADS>0 && !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && \+ SQLITE_THREADSAFE>0+SQLITE_PRIVATE DWORD sqlite3Win32Wait(HANDLE hObject){+ DWORD rc;+ while( (rc = osWaitForSingleObjectEx(hObject, INFINITE,+ TRUE))==WAIT_IO_COMPLETION ){}+ return rc;+}+#endif++/*+** Return true (non-zero) if we are running under WinNT, Win2K, WinXP,+** or WinCE. Return false (zero) for Win95, Win98, or WinME.+**+** Here is an interesting observation: Win95, Win98, and WinME lack+** the LockFileEx() API. But we can still statically link against that+** API as long as we don't call it when running Win95/98/ME. A call to+** this routine is used to determine if the host is Win95/98/ME or+** WinNT/2K/XP so that we will know whether or not we can safely call+** the LockFileEx() API.+*/++#if !defined(SQLITE_WIN32_GETVERSIONEX) || !SQLITE_WIN32_GETVERSIONEX+# define osIsNT() (1)+#elif SQLITE_OS_WINCE || SQLITE_OS_WINRT || !defined(SQLITE_WIN32_HAS_ANSI)+# define osIsNT() (1)+#elif !defined(SQLITE_WIN32_HAS_WIDE)+# define osIsNT() (0)+#else+# define osIsNT() ((sqlite3_os_type==2) || sqlite3_win32_is_nt())+#endif++/*+** This function determines if the machine is running a version of Windows+** based on the NT kernel.+*/+SQLITE_PRIVATE int sqlite3_win32_is_nt(void){+#if SQLITE_OS_WINRT+ /*+ ** NOTE: The WinRT sub-platform is always assumed to be based on the NT+ ** kernel.+ */+ return 1;+#elif defined(SQLITE_WIN32_GETVERSIONEX) && SQLITE_WIN32_GETVERSIONEX+ if( osInterlockedCompareExchange(&sqlite3_os_type, 0, 0)==0 ){+#if defined(SQLITE_WIN32_HAS_ANSI)+ OSVERSIONINFOA sInfo;+ sInfo.dwOSVersionInfoSize = sizeof(sInfo);+ osGetVersionExA(&sInfo);+ osInterlockedCompareExchange(&sqlite3_os_type,+ (sInfo.dwPlatformId == VER_PLATFORM_WIN32_NT) ? 2 : 1, 0);+#elif defined(SQLITE_WIN32_HAS_WIDE)+ OSVERSIONINFOW sInfo;+ sInfo.dwOSVersionInfoSize = sizeof(sInfo);+ osGetVersionExW(&sInfo);+ osInterlockedCompareExchange(&sqlite3_os_type,+ (sInfo.dwPlatformId == VER_PLATFORM_WIN32_NT) ? 2 : 1, 0);+#endif+ }+ return osInterlockedCompareExchange(&sqlite3_os_type, 2, 2)==2;+#elif SQLITE_TEST+ return osInterlockedCompareExchange(&sqlite3_os_type, 2, 2)==2;+#else+ /*+ ** NOTE: All sub-platforms where the GetVersionEx[AW] functions are+ ** deprecated are always assumed to be based on the NT kernel.+ */+ return 1;+#endif+}++#ifdef SQLITE_WIN32_MALLOC+/*+** Allocate nBytes of memory.+*/+static void *winMemMalloc(int nBytes){+ HANDLE hHeap;+ void *p;++ winMemAssertMagic();+ hHeap = winMemGetHeap();+ assert( hHeap!=0 );+ assert( hHeap!=INVALID_HANDLE_VALUE );+#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_MALLOC_VALIDATE)+ assert( osHeapValidate(hHeap, SQLITE_WIN32_HEAP_FLAGS, NULL) );+#endif+ assert( nBytes>=0 );+ p = osHeapAlloc(hHeap, SQLITE_WIN32_HEAP_FLAGS, (SIZE_T)nBytes);+ if( !p ){+ sqlite3_log(SQLITE_NOMEM, "failed to HeapAlloc %u bytes (%lu), heap=%p",+ nBytes, osGetLastError(), (void*)hHeap);+ }+ return p;+}++/*+** Free memory.+*/+static void winMemFree(void *pPrior){+ HANDLE hHeap;++ winMemAssertMagic();+ hHeap = winMemGetHeap();+ assert( hHeap!=0 );+ assert( hHeap!=INVALID_HANDLE_VALUE );+#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_MALLOC_VALIDATE)+ assert( osHeapValidate(hHeap, SQLITE_WIN32_HEAP_FLAGS, pPrior) );+#endif+ if( !pPrior ) return; /* Passing NULL to HeapFree is undefined. */+ if( !osHeapFree(hHeap, SQLITE_WIN32_HEAP_FLAGS, pPrior) ){+ sqlite3_log(SQLITE_NOMEM, "failed to HeapFree block %p (%lu), heap=%p",+ pPrior, osGetLastError(), (void*)hHeap);+ }+}++/*+** Change the size of an existing memory allocation+*/+static void *winMemRealloc(void *pPrior, int nBytes){+ HANDLE hHeap;+ void *p;++ winMemAssertMagic();+ hHeap = winMemGetHeap();+ assert( hHeap!=0 );+ assert( hHeap!=INVALID_HANDLE_VALUE );+#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_MALLOC_VALIDATE)+ assert( osHeapValidate(hHeap, SQLITE_WIN32_HEAP_FLAGS, pPrior) );+#endif+ assert( nBytes>=0 );+ if( !pPrior ){+ p = osHeapAlloc(hHeap, SQLITE_WIN32_HEAP_FLAGS, (SIZE_T)nBytes);+ }else{+ p = osHeapReAlloc(hHeap, SQLITE_WIN32_HEAP_FLAGS, pPrior, (SIZE_T)nBytes);+ }+ if( !p ){+ sqlite3_log(SQLITE_NOMEM, "failed to %s %u bytes (%lu), heap=%p",+ pPrior ? "HeapReAlloc" : "HeapAlloc", nBytes, osGetLastError(),+ (void*)hHeap);+ }+ return p;+}++/*+** Return the size of an outstanding allocation, in bytes.+*/+static int winMemSize(void *p){+ HANDLE hHeap;+ SIZE_T n;++ winMemAssertMagic();+ hHeap = winMemGetHeap();+ assert( hHeap!=0 );+ assert( hHeap!=INVALID_HANDLE_VALUE );+#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_MALLOC_VALIDATE)+ assert( osHeapValidate(hHeap, SQLITE_WIN32_HEAP_FLAGS, p) );+#endif+ if( !p ) return 0;+ n = osHeapSize(hHeap, SQLITE_WIN32_HEAP_FLAGS, p);+ if( n==(SIZE_T)-1 ){+ sqlite3_log(SQLITE_NOMEM, "failed to HeapSize block %p (%lu), heap=%p",+ p, osGetLastError(), (void*)hHeap);+ return 0;+ }+ return (int)n;+}++/*+** Round up a request size to the next valid allocation size.+*/+static int winMemRoundup(int n){+ return n;+}++/*+** Initialize this module.+*/+static int winMemInit(void *pAppData){+ winMemData *pWinMemData = (winMemData *)pAppData;++ if( !pWinMemData ) return SQLITE_ERROR;+ assert( pWinMemData->magic1==WINMEM_MAGIC1 );+ assert( pWinMemData->magic2==WINMEM_MAGIC2 );++#if !SQLITE_OS_WINRT && SQLITE_WIN32_HEAP_CREATE+ if( !pWinMemData->hHeap ){+ DWORD dwInitialSize = SQLITE_WIN32_HEAP_INIT_SIZE;+ DWORD dwMaximumSize = (DWORD)sqlite3GlobalConfig.nHeap;+ if( dwMaximumSize==0 ){+ dwMaximumSize = SQLITE_WIN32_HEAP_MAX_SIZE;+ }else if( dwInitialSize>dwMaximumSize ){+ dwInitialSize = dwMaximumSize;+ }+ pWinMemData->hHeap = osHeapCreate(SQLITE_WIN32_HEAP_FLAGS,+ dwInitialSize, dwMaximumSize);+ if( !pWinMemData->hHeap ){+ sqlite3_log(SQLITE_NOMEM,+ "failed to HeapCreate (%lu), flags=%u, initSize=%lu, maxSize=%lu",+ osGetLastError(), SQLITE_WIN32_HEAP_FLAGS, dwInitialSize,+ dwMaximumSize);+ return SQLITE_NOMEM;+ }+ pWinMemData->bOwned = TRUE;+ assert( pWinMemData->bOwned );+ }+#else+ pWinMemData->hHeap = osGetProcessHeap();+ if( !pWinMemData->hHeap ){+ sqlite3_log(SQLITE_NOMEM,+ "failed to GetProcessHeap (%lu)", osGetLastError());+ return SQLITE_NOMEM;+ }+ pWinMemData->bOwned = FALSE;+ assert( !pWinMemData->bOwned );+#endif+ assert( pWinMemData->hHeap!=0 );+ assert( pWinMemData->hHeap!=INVALID_HANDLE_VALUE );+#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_MALLOC_VALIDATE)+ assert( osHeapValidate(pWinMemData->hHeap, SQLITE_WIN32_HEAP_FLAGS, NULL) );+#endif+ return SQLITE_OK;+}++/*+** Deinitialize this module.+*/+static void winMemShutdown(void *pAppData){+ winMemData *pWinMemData = (winMemData *)pAppData;++ if( !pWinMemData ) return;+ assert( pWinMemData->magic1==WINMEM_MAGIC1 );+ assert( pWinMemData->magic2==WINMEM_MAGIC2 );++ if( pWinMemData->hHeap ){+ assert( pWinMemData->hHeap!=INVALID_HANDLE_VALUE );+#if !SQLITE_OS_WINRT && defined(SQLITE_WIN32_MALLOC_VALIDATE)+ assert( osHeapValidate(pWinMemData->hHeap, SQLITE_WIN32_HEAP_FLAGS, NULL) );+#endif+ if( pWinMemData->bOwned ){+ if( !osHeapDestroy(pWinMemData->hHeap) ){+ sqlite3_log(SQLITE_NOMEM, "failed to HeapDestroy (%lu), heap=%p",+ osGetLastError(), (void*)pWinMemData->hHeap);+ }+ pWinMemData->bOwned = FALSE;+ }+ pWinMemData->hHeap = NULL;+ }+}++/*+** Populate the low-level memory allocation function pointers in+** sqlite3GlobalConfig.m with pointers to the routines in this file. The+** arguments specify the block of memory to manage.+**+** This routine is only called by sqlite3_config(), and therefore+** is not required to be threadsafe (it is not).+*/+SQLITE_PRIVATE const sqlite3_mem_methods *sqlite3MemGetWin32(void){+ static const sqlite3_mem_methods winMemMethods = {+ winMemMalloc,+ winMemFree,+ winMemRealloc,+ winMemSize,+ winMemRoundup,+ winMemInit,+ winMemShutdown,+ &win_mem_data+ };+ return &winMemMethods;+}++SQLITE_PRIVATE void sqlite3MemSetDefault(void){+ sqlite3_config(SQLITE_CONFIG_MALLOC, sqlite3MemGetWin32());+}+#endif /* SQLITE_WIN32_MALLOC */++/*+** Convert a UTF-8 string to Microsoft Unicode (UTF-16?).+**+** Space to hold the returned string is obtained from malloc.+*/+static LPWSTR winUtf8ToUnicode(const char *zFilename){+ int nChar;+ LPWSTR zWideFilename;++ nChar = osMultiByteToWideChar(CP_UTF8, 0, zFilename, -1, NULL, 0);+ if( nChar==0 ){+ return 0;+ }+ zWideFilename = sqlite3MallocZero( nChar*sizeof(zWideFilename[0]) );+ if( zWideFilename==0 ){+ return 0;+ }+ nChar = osMultiByteToWideChar(CP_UTF8, 0, zFilename, -1, zWideFilename,+ nChar);+ if( nChar==0 ){+ sqlite3_free(zWideFilename);+ zWideFilename = 0;+ }+ return zWideFilename;+}++/*+** Convert Microsoft Unicode to UTF-8. Space to hold the returned string is+** obtained from sqlite3_malloc().+*/+static char *winUnicodeToUtf8(LPCWSTR zWideFilename){+ int nByte;+ char *zFilename;++ nByte = osWideCharToMultiByte(CP_UTF8, 0, zWideFilename, -1, 0, 0, 0, 0);+ if( nByte == 0 ){+ return 0;+ }+ zFilename = sqlite3MallocZero( nByte );+ if( zFilename==0 ){+ return 0;+ }+ nByte = osWideCharToMultiByte(CP_UTF8, 0, zWideFilename, -1, zFilename, nByte,+ 0, 0);+ if( nByte == 0 ){+ sqlite3_free(zFilename);+ zFilename = 0;+ }+ return zFilename;+}++/*+** Convert an ANSI string to Microsoft Unicode, based on the+** current codepage settings for file apis.+**+** Space to hold the returned string is obtained+** from sqlite3_malloc.+*/+static LPWSTR winMbcsToUnicode(const char *zFilename){+ int nByte;+ LPWSTR zMbcsFilename;+ int codepage = osAreFileApisANSI() ? CP_ACP : CP_OEMCP;++ nByte = osMultiByteToWideChar(codepage, 0, zFilename, -1, NULL,+ 0)*sizeof(WCHAR);+ if( nByte==0 ){+ return 0;+ }+ zMbcsFilename = sqlite3MallocZero( nByte*sizeof(zMbcsFilename[0]) );+ if( zMbcsFilename==0 ){+ return 0;+ }+ nByte = osMultiByteToWideChar(codepage, 0, zFilename, -1, zMbcsFilename,+ nByte);+ if( nByte==0 ){+ sqlite3_free(zMbcsFilename);+ zMbcsFilename = 0;+ }+ return zMbcsFilename;+}++/*+** Convert Microsoft Unicode to multi-byte character string, based on the+** user's ANSI codepage.+**+** Space to hold the returned string is obtained from+** sqlite3_malloc().+*/+static char *winUnicodeToMbcs(LPCWSTR zWideFilename){+ int nByte;+ char *zFilename;+ int codepage = osAreFileApisANSI() ? CP_ACP : CP_OEMCP;++ nByte = osWideCharToMultiByte(codepage, 0, zWideFilename, -1, 0, 0, 0, 0);+ if( nByte == 0 ){+ return 0;+ }+ zFilename = sqlite3MallocZero( nByte );+ if( zFilename==0 ){+ return 0;+ }+ nByte = osWideCharToMultiByte(codepage, 0, zWideFilename, -1, zFilename,+ nByte, 0, 0);+ if( nByte == 0 ){+ sqlite3_free(zFilename);+ zFilename = 0;+ }+ return zFilename;+}++/*+** Convert multibyte character string to UTF-8. Space to hold the+** returned string is obtained from sqlite3_malloc().+*/+SQLITE_PRIVATE char *sqlite3_win32_mbcs_to_utf8(const char *zFilename){+ char *zFilenameUtf8;+ LPWSTR zTmpWide;++ zTmpWide = winMbcsToUnicode(zFilename);+ if( zTmpWide==0 ){+ return 0;+ }+ zFilenameUtf8 = winUnicodeToUtf8(zTmpWide);+ sqlite3_free(zTmpWide);+ return zFilenameUtf8;+}++/*+** Convert UTF-8 to multibyte character string. Space to hold the+** returned string is obtained from sqlite3_malloc().+*/+SQLITE_PRIVATE char *sqlite3_win32_utf8_to_mbcs(const char *zFilename){+ char *zFilenameMbcs;+ LPWSTR zTmpWide;++ zTmpWide = winUtf8ToUnicode(zFilename);+ if( zTmpWide==0 ){+ return 0;+ }+ zFilenameMbcs = winUnicodeToMbcs(zTmpWide);+ sqlite3_free(zTmpWide);+ return zFilenameMbcs;+}++/*+** The return value of winGetLastErrorMsg+** is zero if the error message fits in the buffer, or non-zero+** otherwise (if the message was truncated).+*/+static int winGetLastErrorMsg(DWORD lastErrno, int nBuf, char *zBuf){+ /* FormatMessage returns 0 on failure. Otherwise it+ ** returns the number of TCHARs written to the output+ ** buffer, excluding the terminating null char.+ */+ DWORD dwLen = 0;+ char *zOut = 0;++ if( osIsNT() ){+#if SQLITE_OS_WINRT+ WCHAR zTempWide[SQLITE_WIN32_MAX_ERRMSG_CHARS+1];+ dwLen = osFormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM |+ FORMAT_MESSAGE_IGNORE_INSERTS,+ NULL,+ lastErrno,+ 0,+ zTempWide,+ SQLITE_WIN32_MAX_ERRMSG_CHARS,+ 0);+#else+ LPWSTR zTempWide = NULL;+ dwLen = osFormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER |+ FORMAT_MESSAGE_FROM_SYSTEM |+ FORMAT_MESSAGE_IGNORE_INSERTS,+ NULL,+ lastErrno,+ 0,+ (LPWSTR) &zTempWide,+ 0,+ 0);+#endif+ if( dwLen > 0 ){+ /* allocate a buffer and convert to UTF8 */+ zOut = winUnicodeToUtf8(zTempWide);+#if !SQLITE_OS_WINRT+ /* free the system buffer allocated by FormatMessage */+ osLocalFree(zTempWide);+#endif+ }+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ char *zTemp = NULL;+ dwLen = osFormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER |+ FORMAT_MESSAGE_FROM_SYSTEM |+ FORMAT_MESSAGE_IGNORE_INSERTS,+ NULL,+ lastErrno,+ 0,+ (LPSTR) &zTemp,+ 0,+ 0);+ if( dwLen > 0 ){+ /* allocate a buffer and convert to UTF8 */+ zOut = sqlite3_win32_mbcs_to_utf8(zTemp);+ /* free the system buffer allocated by FormatMessage */+ osLocalFree(zTemp);+ }+ }+#endif+ if( 0 == dwLen ){+ sqlite3_snprintf(nBuf, zBuf, "OsError 0x%lx (%lu)", lastErrno, lastErrno);+ }else{+ /* copy a maximum of nBuf chars to output buffer */+ sqlite3_snprintf(nBuf, zBuf, "%s", zOut);+ /* free the UTF8 buffer */+ sqlite3_free(zOut);+ }+ return 0;+}++/*+**+** This function - winLogErrorAtLine() - is only ever called via the macro+** winLogError().+**+** This routine is invoked after an error occurs in an OS function.+** It logs a message using sqlite3_log() containing the current value of+** error code and, if possible, the human-readable equivalent from+** FormatMessage.+**+** The first argument passed to the macro should be the error code that+** will be returned to SQLite (e.g. SQLITE_IOERR_DELETE, SQLITE_CANTOPEN).+** The two subsequent arguments should be the name of the OS function that+** failed and the associated file-system path, if any.+*/+#define winLogError(a,b,c,d) winLogErrorAtLine(a,b,c,d,__LINE__)+static int winLogErrorAtLine(+ int errcode, /* SQLite error code */+ DWORD lastErrno, /* Win32 last error */+ const char *zFunc, /* Name of OS function that failed */+ const char *zPath, /* File path associated with error */+ int iLine /* Source line number where error occurred */+){+ char zMsg[500]; /* Human readable error text */+ int i; /* Loop counter */++ zMsg[0] = 0;+ winGetLastErrorMsg(lastErrno, sizeof(zMsg), zMsg);+ assert( errcode!=SQLITE_OK );+ if( zPath==0 ) zPath = "";+ for(i=0; zMsg[i] && zMsg[i]!='\r' && zMsg[i]!='\n'; i++){}+ zMsg[i] = 0;+ sqlite3_log(errcode,+ "os_win.c:%d: (%lu) %s(%s) - %s",+ iLine, lastErrno, zFunc, zPath, zMsg+ );++ return errcode;+}++/*+** The number of times that a ReadFile(), WriteFile(), and DeleteFile()+** will be retried following a locking error - probably caused by+** antivirus software. Also the initial delay before the first retry.+** The delay increases linearly with each retry.+*/+#ifndef SQLITE_WIN32_IOERR_RETRY+# define SQLITE_WIN32_IOERR_RETRY 10+#endif+#ifndef SQLITE_WIN32_IOERR_RETRY_DELAY+# define SQLITE_WIN32_IOERR_RETRY_DELAY 25+#endif+static int winIoerrRetry = SQLITE_WIN32_IOERR_RETRY;+static int winIoerrRetryDelay = SQLITE_WIN32_IOERR_RETRY_DELAY;++/*+** The "winIoerrCanRetry1" macro is used to determine if a particular I/O+** error code obtained via GetLastError() is eligible to be retried. It+** must accept the error code DWORD as its only argument and should return+** non-zero if the error code is transient in nature and the operation+** responsible for generating the original error might succeed upon being+** retried. The argument to this macro should be a variable.+**+** Additionally, a macro named "winIoerrCanRetry2" may be defined. If it+** is defined, it will be consulted only when the macro "winIoerrCanRetry1"+** returns zero. The "winIoerrCanRetry2" macro is completely optional and+** may be used to include additional error codes in the set that should+** result in the failing I/O operation being retried by the caller. If+** defined, the "winIoerrCanRetry2" macro must exhibit external semantics+** identical to those of the "winIoerrCanRetry1" macro.+*/+#if !defined(winIoerrCanRetry1)+#define winIoerrCanRetry1(a) (((a)==ERROR_ACCESS_DENIED) || \+ ((a)==ERROR_SHARING_VIOLATION) || \+ ((a)==ERROR_LOCK_VIOLATION) || \+ ((a)==ERROR_DEV_NOT_EXIST) || \+ ((a)==ERROR_NETNAME_DELETED) || \+ ((a)==ERROR_SEM_TIMEOUT) || \+ ((a)==ERROR_NETWORK_UNREACHABLE))+#endif++/*+** If a ReadFile() or WriteFile() error occurs, invoke this routine+** to see if it should be retried. Return TRUE to retry. Return FALSE+** to give up with an error.+*/+static int winRetryIoerr(int *pnRetry, DWORD *pError){+ DWORD e = osGetLastError();+ if( *pnRetry>=winIoerrRetry ){+ if( pError ){+ *pError = e;+ }+ return 0;+ }+ if( winIoerrCanRetry1(e) ){+ sqlite3_win32_sleep(winIoerrRetryDelay*(1+*pnRetry));+ ++*pnRetry;+ return 1;+ }+#if defined(winIoerrCanRetry2)+ else if( winIoerrCanRetry2(e) ){+ sqlite3_win32_sleep(winIoerrRetryDelay*(1+*pnRetry));+ ++*pnRetry;+ return 1;+ }+#endif+ if( pError ){+ *pError = e;+ }+ return 0;+}++/*+** Log a I/O error retry episode.+*/+static void winLogIoerr(int nRetry, int lineno){+ if( nRetry ){+ sqlite3_log(SQLITE_NOTICE,+ "delayed %dms for lock/sharing conflict at line %d",+ winIoerrRetryDelay*nRetry*(nRetry+1)/2, lineno+ );+ }+}++#if SQLITE_OS_WINCE+/*************************************************************************+** This section contains code for WinCE only.+*/+#if !defined(SQLITE_MSVC_LOCALTIME_API) || !SQLITE_MSVC_LOCALTIME_API+/*+** The MSVC CRT on Windows CE may not have a localtime() function. So+** create a substitute.+*/+/* #include <time.h> */+struct tm *__cdecl localtime(const time_t *t)+{+ static struct tm y;+ FILETIME uTm, lTm;+ SYSTEMTIME pTm;+ sqlite3_int64 t64;+ t64 = *t;+ t64 = (t64 + 11644473600)*10000000;+ uTm.dwLowDateTime = (DWORD)(t64 & 0xFFFFFFFF);+ uTm.dwHighDateTime= (DWORD)(t64 >> 32);+ osFileTimeToLocalFileTime(&uTm,&lTm);+ osFileTimeToSystemTime(&lTm,&pTm);+ y.tm_year = pTm.wYear - 1900;+ y.tm_mon = pTm.wMonth - 1;+ y.tm_wday = pTm.wDayOfWeek;+ y.tm_mday = pTm.wDay;+ y.tm_hour = pTm.wHour;+ y.tm_min = pTm.wMinute;+ y.tm_sec = pTm.wSecond;+ return &y;+}+#endif++#define HANDLE_TO_WINFILE(a) (winFile*)&((char*)a)[-(int)offsetof(winFile,h)]++/*+** Acquire a lock on the handle h+*/+static void winceMutexAcquire(HANDLE h){+ DWORD dwErr;+ do {+ dwErr = osWaitForSingleObject(h, INFINITE);+ } while (dwErr != WAIT_OBJECT_0 && dwErr != WAIT_ABANDONED);+}+/*+** Release a lock acquired by winceMutexAcquire()+*/+#define winceMutexRelease(h) ReleaseMutex(h)++/*+** Create the mutex and shared memory used for locking in the file+** descriptor pFile+*/+static int winceCreateLock(const char *zFilename, winFile *pFile){+ LPWSTR zTok;+ LPWSTR zName;+ DWORD lastErrno;+ BOOL bLogged = FALSE;+ BOOL bInit = TRUE;++ zName = winUtf8ToUnicode(zFilename);+ if( zName==0 ){+ /* out of memory */+ return SQLITE_IOERR_NOMEM;+ }++ /* Initialize the local lockdata */+ memset(&pFile->local, 0, sizeof(pFile->local));++ /* Replace the backslashes from the filename and lowercase it+ ** to derive a mutex name. */+ zTok = osCharLowerW(zName);+ for (;*zTok;zTok++){+ if (*zTok == '\\') *zTok = '_';+ }++ /* Create/open the named mutex */+ pFile->hMutex = osCreateMutexW(NULL, FALSE, zName);+ if (!pFile->hMutex){+ pFile->lastErrno = osGetLastError();+ sqlite3_free(zName);+ return winLogError(SQLITE_IOERR, pFile->lastErrno,+ "winceCreateLock1", zFilename);+ }++ /* Acquire the mutex before continuing */+ winceMutexAcquire(pFile->hMutex);++ /* Since the names of named mutexes, semaphores, file mappings etc are+ ** case-sensitive, take advantage of that by uppercasing the mutex name+ ** and using that as the shared filemapping name.+ */+ osCharUpperW(zName);+ pFile->hShared = osCreateFileMappingW(INVALID_HANDLE_VALUE, NULL,+ PAGE_READWRITE, 0, sizeof(winceLock),+ zName);++ /* Set a flag that indicates we're the first to create the memory so it+ ** must be zero-initialized */+ lastErrno = osGetLastError();+ if (lastErrno == ERROR_ALREADY_EXISTS){+ bInit = FALSE;+ }++ sqlite3_free(zName);++ /* If we succeeded in making the shared memory handle, map it. */+ if( pFile->hShared ){+ pFile->shared = (winceLock*)osMapViewOfFile(pFile->hShared,+ FILE_MAP_READ|FILE_MAP_WRITE, 0, 0, sizeof(winceLock));+ /* If mapping failed, close the shared memory handle and erase it */+ if( !pFile->shared ){+ pFile->lastErrno = osGetLastError();+ winLogError(SQLITE_IOERR, pFile->lastErrno,+ "winceCreateLock2", zFilename);+ bLogged = TRUE;+ osCloseHandle(pFile->hShared);+ pFile->hShared = NULL;+ }+ }++ /* If shared memory could not be created, then close the mutex and fail */+ if( pFile->hShared==NULL ){+ if( !bLogged ){+ pFile->lastErrno = lastErrno;+ winLogError(SQLITE_IOERR, pFile->lastErrno,+ "winceCreateLock3", zFilename);+ bLogged = TRUE;+ }+ winceMutexRelease(pFile->hMutex);+ osCloseHandle(pFile->hMutex);+ pFile->hMutex = NULL;+ return SQLITE_IOERR;+ }++ /* Initialize the shared memory if we're supposed to */+ if( bInit ){+ memset(pFile->shared, 0, sizeof(winceLock));+ }++ winceMutexRelease(pFile->hMutex);+ return SQLITE_OK;+}++/*+** Destroy the part of winFile that deals with wince locks+*/+static void winceDestroyLock(winFile *pFile){+ if (pFile->hMutex){+ /* Acquire the mutex */+ winceMutexAcquire(pFile->hMutex);++ /* The following blocks should probably assert in debug mode, but they+ are to cleanup in case any locks remained open */+ if (pFile->local.nReaders){+ pFile->shared->nReaders --;+ }+ if (pFile->local.bReserved){+ pFile->shared->bReserved = FALSE;+ }+ if (pFile->local.bPending){+ pFile->shared->bPending = FALSE;+ }+ if (pFile->local.bExclusive){+ pFile->shared->bExclusive = FALSE;+ }++ /* De-reference and close our copy of the shared memory handle */+ osUnmapViewOfFile(pFile->shared);+ osCloseHandle(pFile->hShared);++ /* Done with the mutex */+ winceMutexRelease(pFile->hMutex);+ osCloseHandle(pFile->hMutex);+ pFile->hMutex = NULL;+ }+}++/*+** An implementation of the LockFile() API of Windows for CE+*/+static BOOL winceLockFile(+ LPHANDLE phFile,+ DWORD dwFileOffsetLow,+ DWORD dwFileOffsetHigh,+ DWORD nNumberOfBytesToLockLow,+ DWORD nNumberOfBytesToLockHigh+){+ winFile *pFile = HANDLE_TO_WINFILE(phFile);+ BOOL bReturn = FALSE;++ UNUSED_PARAMETER(dwFileOffsetHigh);+ UNUSED_PARAMETER(nNumberOfBytesToLockHigh);++ if (!pFile->hMutex) return TRUE;+ winceMutexAcquire(pFile->hMutex);++ /* Wanting an exclusive lock? */+ if (dwFileOffsetLow == (DWORD)SHARED_FIRST+ && nNumberOfBytesToLockLow == (DWORD)SHARED_SIZE){+ if (pFile->shared->nReaders == 0 && pFile->shared->bExclusive == 0){+ pFile->shared->bExclusive = TRUE;+ pFile->local.bExclusive = TRUE;+ bReturn = TRUE;+ }+ }++ /* Want a read-only lock? */+ else if (dwFileOffsetLow == (DWORD)SHARED_FIRST &&+ nNumberOfBytesToLockLow == 1){+ if (pFile->shared->bExclusive == 0){+ pFile->local.nReaders ++;+ if (pFile->local.nReaders == 1){+ pFile->shared->nReaders ++;+ }+ bReturn = TRUE;+ }+ }++ /* Want a pending lock? */+ else if (dwFileOffsetLow == (DWORD)PENDING_BYTE+ && nNumberOfBytesToLockLow == 1){+ /* If no pending lock has been acquired, then acquire it */+ if (pFile->shared->bPending == 0) {+ pFile->shared->bPending = TRUE;+ pFile->local.bPending = TRUE;+ bReturn = TRUE;+ }+ }++ /* Want a reserved lock? */+ else if (dwFileOffsetLow == (DWORD)RESERVED_BYTE+ && nNumberOfBytesToLockLow == 1){+ if (pFile->shared->bReserved == 0) {+ pFile->shared->bReserved = TRUE;+ pFile->local.bReserved = TRUE;+ bReturn = TRUE;+ }+ }++ winceMutexRelease(pFile->hMutex);+ return bReturn;+}++/*+** An implementation of the UnlockFile API of Windows for CE+*/+static BOOL winceUnlockFile(+ LPHANDLE phFile,+ DWORD dwFileOffsetLow,+ DWORD dwFileOffsetHigh,+ DWORD nNumberOfBytesToUnlockLow,+ DWORD nNumberOfBytesToUnlockHigh+){+ winFile *pFile = HANDLE_TO_WINFILE(phFile);+ BOOL bReturn = FALSE;++ UNUSED_PARAMETER(dwFileOffsetHigh);+ UNUSED_PARAMETER(nNumberOfBytesToUnlockHigh);++ if (!pFile->hMutex) return TRUE;+ winceMutexAcquire(pFile->hMutex);++ /* Releasing a reader lock or an exclusive lock */+ if (dwFileOffsetLow == (DWORD)SHARED_FIRST){+ /* Did we have an exclusive lock? */+ if (pFile->local.bExclusive){+ assert(nNumberOfBytesToUnlockLow == (DWORD)SHARED_SIZE);+ pFile->local.bExclusive = FALSE;+ pFile->shared->bExclusive = FALSE;+ bReturn = TRUE;+ }++ /* Did we just have a reader lock? */+ else if (pFile->local.nReaders){+ assert(nNumberOfBytesToUnlockLow == (DWORD)SHARED_SIZE+ || nNumberOfBytesToUnlockLow == 1);+ pFile->local.nReaders --;+ if (pFile->local.nReaders == 0)+ {+ pFile->shared->nReaders --;+ }+ bReturn = TRUE;+ }+ }++ /* Releasing a pending lock */+ else if (dwFileOffsetLow == (DWORD)PENDING_BYTE+ && nNumberOfBytesToUnlockLow == 1){+ if (pFile->local.bPending){+ pFile->local.bPending = FALSE;+ pFile->shared->bPending = FALSE;+ bReturn = TRUE;+ }+ }+ /* Releasing a reserved lock */+ else if (dwFileOffsetLow == (DWORD)RESERVED_BYTE+ && nNumberOfBytesToUnlockLow == 1){+ if (pFile->local.bReserved) {+ pFile->local.bReserved = FALSE;+ pFile->shared->bReserved = FALSE;+ bReturn = TRUE;+ }+ }++ winceMutexRelease(pFile->hMutex);+ return bReturn;+}+/*+** End of the special code for wince+*****************************************************************************/+#endif /* SQLITE_OS_WINCE */++/*+** Lock a file region.+*/+static BOOL winLockFile(+ LPHANDLE phFile,+ DWORD flags,+ DWORD offsetLow,+ DWORD offsetHigh,+ DWORD numBytesLow,+ DWORD numBytesHigh+){+#if SQLITE_OS_WINCE+ /*+ ** NOTE: Windows CE is handled differently here due its lack of the Win32+ ** API LockFile.+ */+ return winceLockFile(phFile, offsetLow, offsetHigh,+ numBytesLow, numBytesHigh);+#else+ if( osIsNT() ){+ OVERLAPPED ovlp;+ memset(&ovlp, 0, sizeof(OVERLAPPED));+ ovlp.Offset = offsetLow;+ ovlp.OffsetHigh = offsetHigh;+ return osLockFileEx(*phFile, flags, 0, numBytesLow, numBytesHigh, &ovlp);+ }else{+ return osLockFile(*phFile, offsetLow, offsetHigh, numBytesLow,+ numBytesHigh);+ }+#endif+}++/*+** Unlock a file region.+ */+static BOOL winUnlockFile(+ LPHANDLE phFile,+ DWORD offsetLow,+ DWORD offsetHigh,+ DWORD numBytesLow,+ DWORD numBytesHigh+){+#if SQLITE_OS_WINCE+ /*+ ** NOTE: Windows CE is handled differently here due its lack of the Win32+ ** API UnlockFile.+ */+ return winceUnlockFile(phFile, offsetLow, offsetHigh,+ numBytesLow, numBytesHigh);+#else+ if( osIsNT() ){+ OVERLAPPED ovlp;+ memset(&ovlp, 0, sizeof(OVERLAPPED));+ ovlp.Offset = offsetLow;+ ovlp.OffsetHigh = offsetHigh;+ return osUnlockFileEx(*phFile, 0, numBytesLow, numBytesHigh, &ovlp);+ }else{+ return osUnlockFile(*phFile, offsetLow, offsetHigh, numBytesLow,+ numBytesHigh);+ }+#endif+}++/*****************************************************************************+** The next group of routines implement the I/O methods specified+** by the sqlite3_io_methods object.+******************************************************************************/++/*+** Some Microsoft compilers lack this definition.+*/+#ifndef INVALID_SET_FILE_POINTER+# define INVALID_SET_FILE_POINTER ((DWORD)-1)+#endif++/*+** Move the current position of the file handle passed as the first+** argument to offset iOffset within the file. If successful, return 0.+** Otherwise, set pFile->lastErrno and return non-zero.+*/+static int winSeekFile(winFile *pFile, sqlite3_int64 iOffset){+#if !SQLITE_OS_WINRT+ LONG upperBits; /* Most sig. 32 bits of new offset */+ LONG lowerBits; /* Least sig. 32 bits of new offset */+ DWORD dwRet; /* Value returned by SetFilePointer() */+ DWORD lastErrno; /* Value returned by GetLastError() */++ OSTRACE(("SEEK file=%p, offset=%lld\n", pFile->h, iOffset));++ upperBits = (LONG)((iOffset>>32) & 0x7fffffff);+ lowerBits = (LONG)(iOffset & 0xffffffff);++ /* API oddity: If successful, SetFilePointer() returns a dword+ ** containing the lower 32-bits of the new file-offset. Or, if it fails,+ ** it returns INVALID_SET_FILE_POINTER. However according to MSDN,+ ** INVALID_SET_FILE_POINTER may also be a valid new offset. So to determine+ ** whether an error has actually occurred, it is also necessary to call+ ** GetLastError().+ */+ dwRet = osSetFilePointer(pFile->h, lowerBits, &upperBits, FILE_BEGIN);++ if( (dwRet==INVALID_SET_FILE_POINTER+ && ((lastErrno = osGetLastError())!=NO_ERROR)) ){+ pFile->lastErrno = lastErrno;+ winLogError(SQLITE_IOERR_SEEK, pFile->lastErrno,+ "winSeekFile", pFile->zPath);+ OSTRACE(("SEEK file=%p, rc=SQLITE_IOERR_SEEK\n", pFile->h));+ return 1;+ }++ OSTRACE(("SEEK file=%p, rc=SQLITE_OK\n", pFile->h));+ return 0;+#else+ /*+ ** Same as above, except that this implementation works for WinRT.+ */++ LARGE_INTEGER x; /* The new offset */+ BOOL bRet; /* Value returned by SetFilePointerEx() */++ x.QuadPart = iOffset;+ bRet = osSetFilePointerEx(pFile->h, x, 0, FILE_BEGIN);++ if(!bRet){+ pFile->lastErrno = osGetLastError();+ winLogError(SQLITE_IOERR_SEEK, pFile->lastErrno,+ "winSeekFile", pFile->zPath);+ OSTRACE(("SEEK file=%p, rc=SQLITE_IOERR_SEEK\n", pFile->h));+ return 1;+ }++ OSTRACE(("SEEK file=%p, rc=SQLITE_OK\n", pFile->h));+ return 0;+#endif+}++#if SQLITE_MAX_MMAP_SIZE>0+/* Forward references to VFS helper methods used for memory mapped files */+static int winMapfile(winFile*, sqlite3_int64);+static int winUnmapfile(winFile*);+#endif++/*+** Close a file.+**+** It is reported that an attempt to close a handle might sometimes+** fail. This is a very unreasonable result, but Windows is notorious+** for being unreasonable so I do not doubt that it might happen. If+** the close fails, we pause for 100 milliseconds and try again. As+** many as MX_CLOSE_ATTEMPT attempts to close the handle are made before+** giving up and returning an error.+*/+#define MX_CLOSE_ATTEMPT 3+static int winClose(sqlite3_file *id){+ int rc, cnt = 0;+ winFile *pFile = (winFile*)id;++ assert( id!=0 );+#ifndef SQLITE_OMIT_WAL+ assert( pFile->pShm==0 );+#endif+ assert( pFile->h!=NULL && pFile->h!=INVALID_HANDLE_VALUE );+ OSTRACE(("CLOSE pid=%lu, pFile=%p, file=%p\n",+ osGetCurrentProcessId(), pFile, pFile->h));++#if SQLITE_MAX_MMAP_SIZE>0+ winUnmapfile(pFile);+#endif++ do{+ rc = osCloseHandle(pFile->h);+ /* SimulateIOError( rc=0; cnt=MX_CLOSE_ATTEMPT; ); */+ }while( rc==0 && ++cnt < MX_CLOSE_ATTEMPT && (sqlite3_win32_sleep(100), 1) );+#if SQLITE_OS_WINCE+#define WINCE_DELETION_ATTEMPTS 3+ winceDestroyLock(pFile);+ if( pFile->zDeleteOnClose ){+ int cnt = 0;+ while(+ osDeleteFileW(pFile->zDeleteOnClose)==0+ && osGetFileAttributesW(pFile->zDeleteOnClose)!=0xffffffff+ && cnt++ < WINCE_DELETION_ATTEMPTS+ ){+ sqlite3_win32_sleep(100); /* Wait a little before trying again */+ }+ sqlite3_free(pFile->zDeleteOnClose);+ }+#endif+ if( rc ){+ pFile->h = NULL;+ }+ OpenCounter(-1);+ OSTRACE(("CLOSE pid=%lu, pFile=%p, file=%p, rc=%s\n",+ osGetCurrentProcessId(), pFile, pFile->h, rc ? "ok" : "failed"));+ return rc ? SQLITE_OK+ : winLogError(SQLITE_IOERR_CLOSE, osGetLastError(),+ "winClose", pFile->zPath);+}++/*+** Read data from a file into a buffer. Return SQLITE_OK if all+** bytes were read successfully and SQLITE_IOERR if anything goes+** wrong.+*/+static int winRead(+ sqlite3_file *id, /* File to read from */+ void *pBuf, /* Write content into this buffer */+ int amt, /* Number of bytes to read */+ sqlite3_int64 offset /* Begin reading at this offset */+){+#if !SQLITE_OS_WINCE && !defined(SQLITE_WIN32_NO_OVERLAPPED)+ OVERLAPPED overlapped; /* The offset for ReadFile. */+#endif+ winFile *pFile = (winFile*)id; /* file handle */+ DWORD nRead; /* Number of bytes actually read from file */+ int nRetry = 0; /* Number of retrys */++ assert( id!=0 );+ assert( amt>0 );+ assert( offset>=0 );+ SimulateIOError(return SQLITE_IOERR_READ);+ OSTRACE(("READ pid=%lu, pFile=%p, file=%p, buffer=%p, amount=%d, "+ "offset=%lld, lock=%d\n", osGetCurrentProcessId(), pFile,+ pFile->h, pBuf, amt, offset, pFile->locktype));++#if SQLITE_MAX_MMAP_SIZE>0+ /* Deal with as much of this read request as possible by transfering+ ** data from the memory mapping using memcpy(). */+ if( offset<pFile->mmapSize ){+ if( offset+amt <= pFile->mmapSize ){+ memcpy(pBuf, &((u8 *)(pFile->pMapRegion))[offset], amt);+ OSTRACE(("READ-MMAP pid=%lu, pFile=%p, file=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_OK;+ }else{+ int nCopy = (int)(pFile->mmapSize - offset);+ memcpy(pBuf, &((u8 *)(pFile->pMapRegion))[offset], nCopy);+ pBuf = &((u8 *)pBuf)[nCopy];+ amt -= nCopy;+ offset += nCopy;+ }+ }+#endif++#if SQLITE_OS_WINCE || defined(SQLITE_WIN32_NO_OVERLAPPED)+ if( winSeekFile(pFile, offset) ){+ OSTRACE(("READ pid=%lu, pFile=%p, file=%p, rc=SQLITE_FULL\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_FULL;+ }+ while( !osReadFile(pFile->h, pBuf, amt, &nRead, 0) ){+#else+ memset(&overlapped, 0, sizeof(OVERLAPPED));+ overlapped.Offset = (LONG)(offset & 0xffffffff);+ overlapped.OffsetHigh = (LONG)((offset>>32) & 0x7fffffff);+ while( !osReadFile(pFile->h, pBuf, amt, &nRead, &overlapped) &&+ osGetLastError()!=ERROR_HANDLE_EOF ){+#endif+ DWORD lastErrno;+ if( winRetryIoerr(&nRetry, &lastErrno) ) continue;+ pFile->lastErrno = lastErrno;+ OSTRACE(("READ pid=%lu, pFile=%p, file=%p, rc=SQLITE_IOERR_READ\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return winLogError(SQLITE_IOERR_READ, pFile->lastErrno,+ "winRead", pFile->zPath);+ }+ winLogIoerr(nRetry, __LINE__);+ if( nRead<(DWORD)amt ){+ /* Unread parts of the buffer must be zero-filled */+ memset(&((char*)pBuf)[nRead], 0, amt-nRead);+ OSTRACE(("READ pid=%lu, pFile=%p, file=%p, rc=SQLITE_IOERR_SHORT_READ\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_IOERR_SHORT_READ;+ }++ OSTRACE(("READ pid=%lu, pFile=%p, file=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_OK;+}++/*+** Write data from a buffer into a file. Return SQLITE_OK on success+** or some other error code on failure.+*/+static int winWrite(+ sqlite3_file *id, /* File to write into */+ const void *pBuf, /* The bytes to be written */+ int amt, /* Number of bytes to write */+ sqlite3_int64 offset /* Offset into the file to begin writing at */+){+ int rc = 0; /* True if error has occurred, else false */+ winFile *pFile = (winFile*)id; /* File handle */+ int nRetry = 0; /* Number of retries */++ assert( amt>0 );+ assert( pFile );+ SimulateIOError(return SQLITE_IOERR_WRITE);+ SimulateDiskfullError(return SQLITE_FULL);++ OSTRACE(("WRITE pid=%lu, pFile=%p, file=%p, buffer=%p, amount=%d, "+ "offset=%lld, lock=%d\n", osGetCurrentProcessId(), pFile,+ pFile->h, pBuf, amt, offset, pFile->locktype));++#if SQLITE_MAX_MMAP_SIZE>0+ /* Deal with as much of this write request as possible by transfering+ ** data from the memory mapping using memcpy(). */+ if( offset<pFile->mmapSize ){+ if( offset+amt <= pFile->mmapSize ){+ memcpy(&((u8 *)(pFile->pMapRegion))[offset], pBuf, amt);+ OSTRACE(("WRITE-MMAP pid=%lu, pFile=%p, file=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_OK;+ }else{+ int nCopy = (int)(pFile->mmapSize - offset);+ memcpy(&((u8 *)(pFile->pMapRegion))[offset], pBuf, nCopy);+ pBuf = &((u8 *)pBuf)[nCopy];+ amt -= nCopy;+ offset += nCopy;+ }+ }+#endif++#if SQLITE_OS_WINCE || defined(SQLITE_WIN32_NO_OVERLAPPED)+ rc = winSeekFile(pFile, offset);+ if( rc==0 ){+#else+ {+#endif+#if !SQLITE_OS_WINCE && !defined(SQLITE_WIN32_NO_OVERLAPPED)+ OVERLAPPED overlapped; /* The offset for WriteFile. */+#endif+ u8 *aRem = (u8 *)pBuf; /* Data yet to be written */+ int nRem = amt; /* Number of bytes yet to be written */+ DWORD nWrite; /* Bytes written by each WriteFile() call */+ DWORD lastErrno = NO_ERROR; /* Value returned by GetLastError() */++#if !SQLITE_OS_WINCE && !defined(SQLITE_WIN32_NO_OVERLAPPED)+ memset(&overlapped, 0, sizeof(OVERLAPPED));+ overlapped.Offset = (LONG)(offset & 0xffffffff);+ overlapped.OffsetHigh = (LONG)((offset>>32) & 0x7fffffff);+#endif++ while( nRem>0 ){+#if SQLITE_OS_WINCE || defined(SQLITE_WIN32_NO_OVERLAPPED)+ if( !osWriteFile(pFile->h, aRem, nRem, &nWrite, 0) ){+#else+ if( !osWriteFile(pFile->h, aRem, nRem, &nWrite, &overlapped) ){+#endif+ if( winRetryIoerr(&nRetry, &lastErrno) ) continue;+ break;+ }+ assert( nWrite==0 || nWrite<=(DWORD)nRem );+ if( nWrite==0 || nWrite>(DWORD)nRem ){+ lastErrno = osGetLastError();+ break;+ }+#if !SQLITE_OS_WINCE && !defined(SQLITE_WIN32_NO_OVERLAPPED)+ offset += nWrite;+ overlapped.Offset = (LONG)(offset & 0xffffffff);+ overlapped.OffsetHigh = (LONG)((offset>>32) & 0x7fffffff);+#endif+ aRem += nWrite;+ nRem -= nWrite;+ }+ if( nRem>0 ){+ pFile->lastErrno = lastErrno;+ rc = 1;+ }+ }++ if( rc ){+ if( ( pFile->lastErrno==ERROR_HANDLE_DISK_FULL )+ || ( pFile->lastErrno==ERROR_DISK_FULL )){+ OSTRACE(("WRITE pid=%lu, pFile=%p, file=%p, rc=SQLITE_FULL\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return winLogError(SQLITE_FULL, pFile->lastErrno,+ "winWrite1", pFile->zPath);+ }+ OSTRACE(("WRITE pid=%lu, pFile=%p, file=%p, rc=SQLITE_IOERR_WRITE\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return winLogError(SQLITE_IOERR_WRITE, pFile->lastErrno,+ "winWrite2", pFile->zPath);+ }else{+ winLogIoerr(nRetry, __LINE__);+ }+ OSTRACE(("WRITE pid=%lu, pFile=%p, file=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_OK;+}++/*+** Truncate an open file to a specified size+*/+static int winTruncate(sqlite3_file *id, sqlite3_int64 nByte){+ winFile *pFile = (winFile*)id; /* File handle object */+ int rc = SQLITE_OK; /* Return code for this function */+ DWORD lastErrno;++ assert( pFile );+ SimulateIOError(return SQLITE_IOERR_TRUNCATE);+ OSTRACE(("TRUNCATE pid=%lu, pFile=%p, file=%p, size=%lld, lock=%d\n",+ osGetCurrentProcessId(), pFile, pFile->h, nByte, pFile->locktype));++ /* If the user has configured a chunk-size for this file, truncate the+ ** file so that it consists of an integer number of chunks (i.e. the+ ** actual file size after the operation may be larger than the requested+ ** size).+ */+ if( pFile->szChunk>0 ){+ nByte = ((nByte + pFile->szChunk - 1)/pFile->szChunk) * pFile->szChunk;+ }++ /* SetEndOfFile() returns non-zero when successful, or zero when it fails. */+ if( winSeekFile(pFile, nByte) ){+ rc = winLogError(SQLITE_IOERR_TRUNCATE, pFile->lastErrno,+ "winTruncate1", pFile->zPath);+ }else if( 0==osSetEndOfFile(pFile->h) &&+ ((lastErrno = osGetLastError())!=ERROR_USER_MAPPED_FILE) ){+ pFile->lastErrno = lastErrno;+ rc = winLogError(SQLITE_IOERR_TRUNCATE, pFile->lastErrno,+ "winTruncate2", pFile->zPath);+ }++#if SQLITE_MAX_MMAP_SIZE>0+ /* If the file was truncated to a size smaller than the currently+ ** mapped region, reduce the effective mapping size as well. SQLite will+ ** use read() and write() to access data beyond this point from now on.+ */+ if( pFile->pMapRegion && nByte<pFile->mmapSize ){+ pFile->mmapSize = nByte;+ }+#endif++ OSTRACE(("TRUNCATE pid=%lu, pFile=%p, file=%p, rc=%s\n",+ osGetCurrentProcessId(), pFile, pFile->h, sqlite3ErrName(rc)));+ return rc;+}++#ifdef SQLITE_TEST+/*+** Count the number of fullsyncs and normal syncs. This is used to test+** that syncs and fullsyncs are occuring at the right times.+*/+SQLITE_PRIVATE int sqlite3_sync_count = 0;+SQLITE_PRIVATE int sqlite3_fullsync_count = 0;+#endif++/*+** Make sure all writes to a particular file are committed to disk.+*/+static int winSync(sqlite3_file *id, int flags){+#ifndef SQLITE_NO_SYNC+ /*+ ** Used only when SQLITE_NO_SYNC is not defined.+ */+ BOOL rc;+#endif+#if !defined(NDEBUG) || !defined(SQLITE_NO_SYNC) || \+ defined(SQLITE_HAVE_OS_TRACE)+ /*+ ** Used when SQLITE_NO_SYNC is not defined and by the assert() and/or+ ** OSTRACE() macros.+ */+ winFile *pFile = (winFile*)id;+#else+ UNUSED_PARAMETER(id);+#endif++ assert( pFile );+ /* Check that one of SQLITE_SYNC_NORMAL or FULL was passed */+ assert((flags&0x0F)==SQLITE_SYNC_NORMAL+ || (flags&0x0F)==SQLITE_SYNC_FULL+ );++ /* Unix cannot, but some systems may return SQLITE_FULL from here. This+ ** line is to test that doing so does not cause any problems.+ */+ SimulateDiskfullError( return SQLITE_FULL );++ OSTRACE(("SYNC pid=%lu, pFile=%p, file=%p, flags=%x, lock=%d\n",+ osGetCurrentProcessId(), pFile, pFile->h, flags,+ pFile->locktype));++#ifndef SQLITE_TEST+ UNUSED_PARAMETER(flags);+#else+ if( (flags&0x0F)==SQLITE_SYNC_FULL ){+ sqlite3_fullsync_count++;+ }+ sqlite3_sync_count++;+#endif++ /* If we compiled with the SQLITE_NO_SYNC flag, then syncing is a+ ** no-op+ */+#ifdef SQLITE_NO_SYNC+ OSTRACE(("SYNC-NOP pid=%lu, pFile=%p, file=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_OK;+#else+#if SQLITE_MAX_MMAP_SIZE>0+ if( pFile->pMapRegion ){+ if( osFlushViewOfFile(pFile->pMapRegion, 0) ){+ OSTRACE(("SYNC-MMAP pid=%lu, pFile=%p, pMapRegion=%p, "+ "rc=SQLITE_OK\n", osGetCurrentProcessId(),+ pFile, pFile->pMapRegion));+ }else{+ pFile->lastErrno = osGetLastError();+ OSTRACE(("SYNC-MMAP pid=%lu, pFile=%p, pMapRegion=%p, "+ "rc=SQLITE_IOERR_MMAP\n", osGetCurrentProcessId(),+ pFile, pFile->pMapRegion));+ return winLogError(SQLITE_IOERR_MMAP, pFile->lastErrno,+ "winSync1", pFile->zPath);+ }+ }+#endif+ rc = osFlushFileBuffers(pFile->h);+ SimulateIOError( rc=FALSE );+ if( rc ){+ OSTRACE(("SYNC pid=%lu, pFile=%p, file=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return SQLITE_OK;+ }else{+ pFile->lastErrno = osGetLastError();+ OSTRACE(("SYNC pid=%lu, pFile=%p, file=%p, rc=SQLITE_IOERR_FSYNC\n",+ osGetCurrentProcessId(), pFile, pFile->h));+ return winLogError(SQLITE_IOERR_FSYNC, pFile->lastErrno,+ "winSync2", pFile->zPath);+ }+#endif+}++/*+** Determine the current size of a file in bytes+*/+static int winFileSize(sqlite3_file *id, sqlite3_int64 *pSize){+ winFile *pFile = (winFile*)id;+ int rc = SQLITE_OK;++ assert( id!=0 );+ assert( pSize!=0 );+ SimulateIOError(return SQLITE_IOERR_FSTAT);+ OSTRACE(("SIZE file=%p, pSize=%p\n", pFile->h, pSize));++#if SQLITE_OS_WINRT+ {+ FILE_STANDARD_INFO info;+ if( osGetFileInformationByHandleEx(pFile->h, FileStandardInfo,+ &info, sizeof(info)) ){+ *pSize = info.EndOfFile.QuadPart;+ }else{+ pFile->lastErrno = osGetLastError();+ rc = winLogError(SQLITE_IOERR_FSTAT, pFile->lastErrno,+ "winFileSize", pFile->zPath);+ }+ }+#else+ {+ DWORD upperBits;+ DWORD lowerBits;+ DWORD lastErrno;++ lowerBits = osGetFileSize(pFile->h, &upperBits);+ *pSize = (((sqlite3_int64)upperBits)<<32) + lowerBits;+ if( (lowerBits == INVALID_FILE_SIZE)+ && ((lastErrno = osGetLastError())!=NO_ERROR) ){+ pFile->lastErrno = lastErrno;+ rc = winLogError(SQLITE_IOERR_FSTAT, pFile->lastErrno,+ "winFileSize", pFile->zPath);+ }+ }+#endif+ OSTRACE(("SIZE file=%p, pSize=%p, *pSize=%lld, rc=%s\n",+ pFile->h, pSize, *pSize, sqlite3ErrName(rc)));+ return rc;+}++/*+** LOCKFILE_FAIL_IMMEDIATELY is undefined on some Windows systems.+*/+#ifndef LOCKFILE_FAIL_IMMEDIATELY+# define LOCKFILE_FAIL_IMMEDIATELY 1+#endif++#ifndef LOCKFILE_EXCLUSIVE_LOCK+# define LOCKFILE_EXCLUSIVE_LOCK 2+#endif++/*+** Historically, SQLite has used both the LockFile and LockFileEx functions.+** When the LockFile function was used, it was always expected to fail+** immediately if the lock could not be obtained. Also, it always expected to+** obtain an exclusive lock. These flags are used with the LockFileEx function+** and reflect those expectations; therefore, they should not be changed.+*/+#ifndef SQLITE_LOCKFILE_FLAGS+# define SQLITE_LOCKFILE_FLAGS (LOCKFILE_FAIL_IMMEDIATELY | \+ LOCKFILE_EXCLUSIVE_LOCK)+#endif++/*+** Currently, SQLite never calls the LockFileEx function without wanting the+** call to fail immediately if the lock cannot be obtained.+*/+#ifndef SQLITE_LOCKFILEEX_FLAGS+# define SQLITE_LOCKFILEEX_FLAGS (LOCKFILE_FAIL_IMMEDIATELY)+#endif++/*+** Acquire a reader lock.+** Different API routines are called depending on whether or not this+** is Win9x or WinNT.+*/+static int winGetReadLock(winFile *pFile){+ int res;+ OSTRACE(("READ-LOCK file=%p, lock=%d\n", pFile->h, pFile->locktype));+ if( osIsNT() ){+#if SQLITE_OS_WINCE+ /*+ ** NOTE: Windows CE is handled differently here due its lack of the Win32+ ** API LockFileEx.+ */+ res = winceLockFile(&pFile->h, SHARED_FIRST, 0, 1, 0);+#else+ res = winLockFile(&pFile->h, SQLITE_LOCKFILEEX_FLAGS, SHARED_FIRST, 0,+ SHARED_SIZE, 0);+#endif+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ int lk;+ sqlite3_randomness(sizeof(lk), &lk);+ pFile->sharedLockByte = (short)((lk & 0x7fffffff)%(SHARED_SIZE - 1));+ res = winLockFile(&pFile->h, SQLITE_LOCKFILE_FLAGS,+ SHARED_FIRST+pFile->sharedLockByte, 0, 1, 0);+ }+#endif+ if( res == 0 ){+ pFile->lastErrno = osGetLastError();+ /* No need to log a failure to lock */+ }+ OSTRACE(("READ-LOCK file=%p, result=%d\n", pFile->h, res));+ return res;+}++/*+** Undo a readlock+*/+static int winUnlockReadLock(winFile *pFile){+ int res;+ DWORD lastErrno;+ OSTRACE(("READ-UNLOCK file=%p, lock=%d\n", pFile->h, pFile->locktype));+ if( osIsNT() ){+ res = winUnlockFile(&pFile->h, SHARED_FIRST, 0, SHARED_SIZE, 0);+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ res = winUnlockFile(&pFile->h, SHARED_FIRST+pFile->sharedLockByte, 0, 1, 0);+ }+#endif+ if( res==0 && ((lastErrno = osGetLastError())!=ERROR_NOT_LOCKED) ){+ pFile->lastErrno = lastErrno;+ winLogError(SQLITE_IOERR_UNLOCK, pFile->lastErrno,+ "winUnlockReadLock", pFile->zPath);+ }+ OSTRACE(("READ-UNLOCK file=%p, result=%d\n", pFile->h, res));+ return res;+}++/*+** Lock the file with the lock specified by parameter locktype - one+** of the following:+**+** (1) SHARED_LOCK+** (2) RESERVED_LOCK+** (3) PENDING_LOCK+** (4) EXCLUSIVE_LOCK+**+** Sometimes when requesting one lock state, additional lock states+** are inserted in between. The locking might fail on one of the later+** transitions leaving the lock state different from what it started but+** still short of its goal. The following chart shows the allowed+** transitions and the inserted intermediate states:+**+** UNLOCKED -> SHARED+** SHARED -> RESERVED+** SHARED -> (PENDING) -> EXCLUSIVE+** RESERVED -> (PENDING) -> EXCLUSIVE+** PENDING -> EXCLUSIVE+**+** This routine will only increase a lock. The winUnlock() routine+** erases all locks at once and returns us immediately to locking level 0.+** It is not possible to lower the locking level one step at a time. You+** must go straight to locking level 0.+*/+static int winLock(sqlite3_file *id, int locktype){+ int rc = SQLITE_OK; /* Return code from subroutines */+ int res = 1; /* Result of a Windows lock call */+ int newLocktype; /* Set pFile->locktype to this value before exiting */+ int gotPendingLock = 0;/* True if we acquired a PENDING lock this time */+ winFile *pFile = (winFile*)id;+ DWORD lastErrno = NO_ERROR;++ assert( id!=0 );+ OSTRACE(("LOCK file=%p, oldLock=%d(%d), newLock=%d\n",+ pFile->h, pFile->locktype, pFile->sharedLockByte, locktype));++ /* If there is already a lock of this type or more restrictive on the+ ** OsFile, do nothing. Don't use the end_lock: exit path, as+ ** sqlite3OsEnterMutex() hasn't been called yet.+ */+ if( pFile->locktype>=locktype ){+ OSTRACE(("LOCK-HELD file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }++ /* Do not allow any kind of write-lock on a read-only database+ */+ if( (pFile->ctrlFlags & WINFILE_RDONLY)!=0 && locktype>=RESERVED_LOCK ){+ return SQLITE_IOERR_LOCK;+ }++ /* Make sure the locking sequence is correct+ */+ assert( pFile->locktype!=NO_LOCK || locktype==SHARED_LOCK );+ assert( locktype!=PENDING_LOCK );+ assert( locktype!=RESERVED_LOCK || pFile->locktype==SHARED_LOCK );++ /* Lock the PENDING_LOCK byte if we need to acquire a PENDING lock or+ ** a SHARED lock. If we are acquiring a SHARED lock, the acquisition of+ ** the PENDING_LOCK byte is temporary.+ */+ newLocktype = pFile->locktype;+ if( (pFile->locktype==NO_LOCK)+ || ( (locktype==EXCLUSIVE_LOCK)+ && (pFile->locktype==RESERVED_LOCK))+ ){+ int cnt = 3;+ while( cnt-->0 && (res = winLockFile(&pFile->h, SQLITE_LOCKFILE_FLAGS,+ PENDING_BYTE, 0, 1, 0))==0 ){+ /* Try 3 times to get the pending lock. This is needed to work+ ** around problems caused by indexing and/or anti-virus software on+ ** Windows systems.+ ** If you are using this code as a model for alternative VFSes, do not+ ** copy this retry logic. It is a hack intended for Windows only.+ */+ lastErrno = osGetLastError();+ OSTRACE(("LOCK-PENDING-FAIL file=%p, count=%d, result=%d\n",+ pFile->h, cnt, res));+ if( lastErrno==ERROR_INVALID_HANDLE ){+ pFile->lastErrno = lastErrno;+ rc = SQLITE_IOERR_LOCK;+ OSTRACE(("LOCK-FAIL file=%p, count=%d, rc=%s\n",+ pFile->h, cnt, sqlite3ErrName(rc)));+ return rc;+ }+ if( cnt ) sqlite3_win32_sleep(1);+ }+ gotPendingLock = res;+ if( !res ){+ lastErrno = osGetLastError();+ }+ }++ /* Acquire a shared lock+ */+ if( locktype==SHARED_LOCK && res ){+ assert( pFile->locktype==NO_LOCK );+ res = winGetReadLock(pFile);+ if( res ){+ newLocktype = SHARED_LOCK;+ }else{+ lastErrno = osGetLastError();+ }+ }++ /* Acquire a RESERVED lock+ */+ if( locktype==RESERVED_LOCK && res ){+ assert( pFile->locktype==SHARED_LOCK );+ res = winLockFile(&pFile->h, SQLITE_LOCKFILE_FLAGS, RESERVED_BYTE, 0, 1, 0);+ if( res ){+ newLocktype = RESERVED_LOCK;+ }else{+ lastErrno = osGetLastError();+ }+ }++ /* Acquire a PENDING lock+ */+ if( locktype==EXCLUSIVE_LOCK && res ){+ newLocktype = PENDING_LOCK;+ gotPendingLock = 0;+ }++ /* Acquire an EXCLUSIVE lock+ */+ if( locktype==EXCLUSIVE_LOCK && res ){+ assert( pFile->locktype>=SHARED_LOCK );+ res = winUnlockReadLock(pFile);+ res = winLockFile(&pFile->h, SQLITE_LOCKFILE_FLAGS, SHARED_FIRST, 0,+ SHARED_SIZE, 0);+ if( res ){+ newLocktype = EXCLUSIVE_LOCK;+ }else{+ lastErrno = osGetLastError();+ winGetReadLock(pFile);+ }+ }++ /* If we are holding a PENDING lock that ought to be released, then+ ** release it now.+ */+ if( gotPendingLock && locktype==SHARED_LOCK ){+ winUnlockFile(&pFile->h, PENDING_BYTE, 0, 1, 0);+ }++ /* Update the state of the lock has held in the file descriptor then+ ** return the appropriate result code.+ */+ if( res ){+ rc = SQLITE_OK;+ }else{+ pFile->lastErrno = lastErrno;+ rc = SQLITE_BUSY;+ OSTRACE(("LOCK-FAIL file=%p, wanted=%d, got=%d\n",+ pFile->h, locktype, newLocktype));+ }+ pFile->locktype = (u8)newLocktype;+ OSTRACE(("LOCK file=%p, lock=%d, rc=%s\n",+ pFile->h, pFile->locktype, sqlite3ErrName(rc)));+ return rc;+}++/*+** This routine checks if there is a RESERVED lock held on the specified+** file by this or any other process. If such a lock is held, return+** non-zero, otherwise zero.+*/+static int winCheckReservedLock(sqlite3_file *id, int *pResOut){+ int res;+ winFile *pFile = (winFile*)id;++ SimulateIOError( return SQLITE_IOERR_CHECKRESERVEDLOCK; );+ OSTRACE(("TEST-WR-LOCK file=%p, pResOut=%p\n", pFile->h, pResOut));++ assert( id!=0 );+ if( pFile->locktype>=RESERVED_LOCK ){+ res = 1;+ OSTRACE(("TEST-WR-LOCK file=%p, result=%d (local)\n", pFile->h, res));+ }else{+ res = winLockFile(&pFile->h, SQLITE_LOCKFILEEX_FLAGS,RESERVED_BYTE, 0, 1, 0);+ if( res ){+ winUnlockFile(&pFile->h, RESERVED_BYTE, 0, 1, 0);+ }+ res = !res;+ OSTRACE(("TEST-WR-LOCK file=%p, result=%d (remote)\n", pFile->h, res));+ }+ *pResOut = res;+ OSTRACE(("TEST-WR-LOCK file=%p, pResOut=%p, *pResOut=%d, rc=SQLITE_OK\n",+ pFile->h, pResOut, *pResOut));+ return SQLITE_OK;+}++/*+** Lower the locking level on file descriptor id to locktype. locktype+** must be either NO_LOCK or SHARED_LOCK.+**+** If the locking level of the file descriptor is already at or below+** the requested locking level, this routine is a no-op.+**+** It is not possible for this routine to fail if the second argument+** is NO_LOCK. If the second argument is SHARED_LOCK then this routine+** might return SQLITE_IOERR;+*/+static int winUnlock(sqlite3_file *id, int locktype){+ int type;+ winFile *pFile = (winFile*)id;+ int rc = SQLITE_OK;+ assert( pFile!=0 );+ assert( locktype<=SHARED_LOCK );+ OSTRACE(("UNLOCK file=%p, oldLock=%d(%d), newLock=%d\n",+ pFile->h, pFile->locktype, pFile->sharedLockByte, locktype));+ type = pFile->locktype;+ if( type>=EXCLUSIVE_LOCK ){+ winUnlockFile(&pFile->h, SHARED_FIRST, 0, SHARED_SIZE, 0);+ if( locktype==SHARED_LOCK && !winGetReadLock(pFile) ){+ /* This should never happen. We should always be able to+ ** reacquire the read lock */+ rc = winLogError(SQLITE_IOERR_UNLOCK, osGetLastError(),+ "winUnlock", pFile->zPath);+ }+ }+ if( type>=RESERVED_LOCK ){+ winUnlockFile(&pFile->h, RESERVED_BYTE, 0, 1, 0);+ }+ if( locktype==NO_LOCK && type>=SHARED_LOCK ){+ winUnlockReadLock(pFile);+ }+ if( type>=PENDING_LOCK ){+ winUnlockFile(&pFile->h, PENDING_BYTE, 0, 1, 0);+ }+ pFile->locktype = (u8)locktype;+ OSTRACE(("UNLOCK file=%p, lock=%d, rc=%s\n",+ pFile->h, pFile->locktype, sqlite3ErrName(rc)));+ return rc;+}++/*+** If *pArg is initially negative then this is a query. Set *pArg to+** 1 or 0 depending on whether or not bit mask of pFile->ctrlFlags is set.+**+** If *pArg is 0 or 1, then clear or set the mask bit of pFile->ctrlFlags.+*/+static void winModeBit(winFile *pFile, unsigned char mask, int *pArg){+ if( *pArg<0 ){+ *pArg = (pFile->ctrlFlags & mask)!=0;+ }else if( (*pArg)==0 ){+ pFile->ctrlFlags &= ~mask;+ }else{+ pFile->ctrlFlags |= mask;+ }+}++/* Forward references to VFS helper methods used for temporary files */+static int winGetTempname(sqlite3_vfs *, char **);+static int winIsDir(const void *);+static BOOL winIsDriveLetterAndColon(const char *);++/*+** Control and query of the open file handle.+*/+static int winFileControl(sqlite3_file *id, int op, void *pArg){+ winFile *pFile = (winFile*)id;+ OSTRACE(("FCNTL file=%p, op=%d, pArg=%p\n", pFile->h, op, pArg));+ switch( op ){+ case SQLITE_FCNTL_LOCKSTATE: {+ *(int*)pArg = pFile->locktype;+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_LAST_ERRNO: {+ *(int*)pArg = (int)pFile->lastErrno;+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_CHUNK_SIZE: {+ pFile->szChunk = *(int *)pArg;+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_SIZE_HINT: {+ if( pFile->szChunk>0 ){+ sqlite3_int64 oldSz;+ int rc = winFileSize(id, &oldSz);+ if( rc==SQLITE_OK ){+ sqlite3_int64 newSz = *(sqlite3_int64*)pArg;+ if( newSz>oldSz ){+ SimulateIOErrorBenign(1);+ rc = winTruncate(id, newSz);+ SimulateIOErrorBenign(0);+ }+ }+ OSTRACE(("FCNTL file=%p, rc=%s\n", pFile->h, sqlite3ErrName(rc)));+ return rc;+ }+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_PERSIST_WAL: {+ winModeBit(pFile, WINFILE_PERSIST_WAL, (int*)pArg);+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_POWERSAFE_OVERWRITE: {+ winModeBit(pFile, WINFILE_PSOW, (int*)pArg);+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_VFSNAME: {+ *(char**)pArg = sqlite3_mprintf("%s", pFile->pVfs->zName);+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+ case SQLITE_FCNTL_WIN32_AV_RETRY: {+ int *a = (int*)pArg;+ if( a[0]>0 ){+ winIoerrRetry = a[0];+ }else{+ a[0] = winIoerrRetry;+ }+ if( a[1]>0 ){+ winIoerrRetryDelay = a[1];+ }else{+ a[1] = winIoerrRetryDelay;+ }+ OSTRACE(("FCNTL file=%p, rc=SQLITE_OK\n", pFile->h));+ return SQLITE_OK;+ }+#ifdef SQLITE_TEST+ case SQLITE_FCNTL_WIN32_SET_HANDLE: {+ LPHANDLE phFile = (LPHANDLE)pArg;+ HANDLE hOldFile = pFile->h;+ pFile->h = *phFile;+ *phFile = hOldFile;+ OSTRACE(("FCNTL oldFile=%p, newFile=%p, rc=SQLITE_OK\n",+ hOldFile, pFile->h));+ return SQLITE_OK;+ }+#endif+ case SQLITE_FCNTL_TEMPFILENAME: {+ char *zTFile = 0;+ int rc = winGetTempname(pFile->pVfs, &zTFile);+ if( rc==SQLITE_OK ){+ *(char**)pArg = zTFile;+ }+ OSTRACE(("FCNTL file=%p, rc=%s\n", pFile->h, sqlite3ErrName(rc)));+ return rc;+ }+#if SQLITE_MAX_MMAP_SIZE>0+ case SQLITE_FCNTL_MMAP_SIZE: {+ i64 newLimit = *(i64*)pArg;+ int rc = SQLITE_OK;+ if( newLimit>sqlite3GlobalConfig.mxMmap ){+ newLimit = sqlite3GlobalConfig.mxMmap;+ }+ *(i64*)pArg = pFile->mmapSizeMax;+ if( newLimit>=0 && newLimit!=pFile->mmapSizeMax && pFile->nFetchOut==0 ){+ pFile->mmapSizeMax = newLimit;+ if( pFile->mmapSize>0 ){+ winUnmapfile(pFile);+ rc = winMapfile(pFile, -1);+ }+ }+ OSTRACE(("FCNTL file=%p, rc=%s\n", pFile->h, sqlite3ErrName(rc)));+ return rc;+ }+#endif+ }+ OSTRACE(("FCNTL file=%p, rc=SQLITE_NOTFOUND\n", pFile->h));+ return SQLITE_NOTFOUND;+}++/*+** Return the sector size in bytes of the underlying block device for+** the specified file. This is almost always 512 bytes, but may be+** larger for some devices.+**+** SQLite code assumes this function cannot fail. It also assumes that+** if two files are created in the same file-system directory (i.e.+** a database and its journal file) that the sector size will be the+** same for both.+*/+static int winSectorSize(sqlite3_file *id){+ (void)id;+ return SQLITE_DEFAULT_SECTOR_SIZE;+}++/*+** Return a vector of device characteristics.+*/+static int winDeviceCharacteristics(sqlite3_file *id){+ winFile *p = (winFile*)id;+ return SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN |+ ((p->ctrlFlags & WINFILE_PSOW)?SQLITE_IOCAP_POWERSAFE_OVERWRITE:0);+}++/*+** Windows will only let you create file view mappings+** on allocation size granularity boundaries.+** During sqlite3_os_init() we do a GetSystemInfo()+** to get the granularity size.+*/+static SYSTEM_INFO winSysInfo;++#ifndef SQLITE_OMIT_WAL++/*+** Helper functions to obtain and relinquish the global mutex. The+** global mutex is used to protect the winLockInfo objects used by+** this file, all of which may be shared by multiple threads.+**+** Function winShmMutexHeld() is used to assert() that the global mutex+** is held when required. This function is only used as part of assert()+** statements. e.g.+**+** winShmEnterMutex()+** assert( winShmMutexHeld() );+** winShmLeaveMutex()+*/+static void winShmEnterMutex(void){+ sqlite3_mutex_enter(sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_VFS1));+}+static void winShmLeaveMutex(void){+ sqlite3_mutex_leave(sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_VFS1));+}+#ifndef NDEBUG+static int winShmMutexHeld(void) {+ return sqlite3_mutex_held(sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_VFS1));+}+#endif++/*+** Object used to represent a single file opened and mmapped to provide+** shared memory. When multiple threads all reference the same+** log-summary, each thread has its own winFile object, but they all+** point to a single instance of this object. In other words, each+** log-summary is opened only once per process.+**+** winShmMutexHeld() must be true when creating or destroying+** this object or while reading or writing the following fields:+**+** nRef+** pNext+**+** The following fields are read-only after the object is created:+**+** fid+** zFilename+**+** Either winShmNode.mutex must be held or winShmNode.nRef==0 and+** winShmMutexHeld() is true when reading or writing any other field+** in this structure.+**+*/+struct winShmNode {+ sqlite3_mutex *mutex; /* Mutex to access this object */+ char *zFilename; /* Name of the file */+ winFile hFile; /* File handle from winOpen */++ int szRegion; /* Size of shared-memory regions */+ int nRegion; /* Size of array apRegion */+ struct ShmRegion {+ HANDLE hMap; /* File handle from CreateFileMapping */+ void *pMap;+ } *aRegion;+ DWORD lastErrno; /* The Windows errno from the last I/O error */++ int nRef; /* Number of winShm objects pointing to this */+ winShm *pFirst; /* All winShm objects pointing to this */+ winShmNode *pNext; /* Next in list of all winShmNode objects */+#if defined(SQLITE_DEBUG) || defined(SQLITE_HAVE_OS_TRACE)+ u8 nextShmId; /* Next available winShm.id value */+#endif+};++/*+** A global array of all winShmNode objects.+**+** The winShmMutexHeld() must be true while reading or writing this list.+*/+static winShmNode *winShmNodeList = 0;++/*+** Structure used internally by this VFS to record the state of an+** open shared memory connection.+**+** The following fields are initialized when this object is created and+** are read-only thereafter:+**+** winShm.pShmNode+** winShm.id+**+** All other fields are read/write. The winShm.pShmNode->mutex must be held+** while accessing any read/write fields.+*/+struct winShm {+ winShmNode *pShmNode; /* The underlying winShmNode object */+ winShm *pNext; /* Next winShm with the same winShmNode */+ u8 hasMutex; /* True if holding the winShmNode mutex */+ u16 sharedMask; /* Mask of shared locks held */+ u16 exclMask; /* Mask of exclusive locks held */+#if defined(SQLITE_DEBUG) || defined(SQLITE_HAVE_OS_TRACE)+ u8 id; /* Id of this connection with its winShmNode */+#endif+};++/*+** Constants used for locking+*/+#define WIN_SHM_BASE ((22+SQLITE_SHM_NLOCK)*4) /* first lock byte */+#define WIN_SHM_DMS (WIN_SHM_BASE+SQLITE_SHM_NLOCK) /* deadman switch */++/*+** Apply advisory locks for all n bytes beginning at ofst.+*/+#define _SHM_UNLCK 1+#define _SHM_RDLCK 2+#define _SHM_WRLCK 3+static int winShmSystemLock(+ winShmNode *pFile, /* Apply locks to this open shared-memory segment */+ int lockType, /* _SHM_UNLCK, _SHM_RDLCK, or _SHM_WRLCK */+ int ofst, /* Offset to first byte to be locked/unlocked */+ int nByte /* Number of bytes to lock or unlock */+){+ int rc = 0; /* Result code form Lock/UnlockFileEx() */++ /* Access to the winShmNode object is serialized by the caller */+ assert( sqlite3_mutex_held(pFile->mutex) || pFile->nRef==0 );++ OSTRACE(("SHM-LOCK file=%p, lock=%d, offset=%d, size=%d\n",+ pFile->hFile.h, lockType, ofst, nByte));++ /* Release/Acquire the system-level lock */+ if( lockType==_SHM_UNLCK ){+ rc = winUnlockFile(&pFile->hFile.h, ofst, 0, nByte, 0);+ }else{+ /* Initialize the locking parameters */+ DWORD dwFlags = LOCKFILE_FAIL_IMMEDIATELY;+ if( lockType == _SHM_WRLCK ) dwFlags |= LOCKFILE_EXCLUSIVE_LOCK;+ rc = winLockFile(&pFile->hFile.h, dwFlags, ofst, 0, nByte, 0);+ }++ if( rc!= 0 ){+ rc = SQLITE_OK;+ }else{+ pFile->lastErrno = osGetLastError();+ rc = SQLITE_BUSY;+ }++ OSTRACE(("SHM-LOCK file=%p, func=%s, errno=%lu, rc=%s\n",+ pFile->hFile.h, (lockType == _SHM_UNLCK) ? "winUnlockFile" :+ "winLockFile", pFile->lastErrno, sqlite3ErrName(rc)));++ return rc;+}++/* Forward references to VFS methods */+static int winOpen(sqlite3_vfs*,const char*,sqlite3_file*,int,int*);+static int winDelete(sqlite3_vfs *,const char*,int);++/*+** Purge the winShmNodeList list of all entries with winShmNode.nRef==0.+**+** This is not a VFS shared-memory method; it is a utility function called+** by VFS shared-memory methods.+*/+static void winShmPurge(sqlite3_vfs *pVfs, int deleteFlag){+ winShmNode **pp;+ winShmNode *p;+ assert( winShmMutexHeld() );+ OSTRACE(("SHM-PURGE pid=%lu, deleteFlag=%d\n",+ osGetCurrentProcessId(), deleteFlag));+ pp = &winShmNodeList;+ while( (p = *pp)!=0 ){+ if( p->nRef==0 ){+ int i;+ if( p->mutex ){ sqlite3_mutex_free(p->mutex); }+ for(i=0; i<p->nRegion; i++){+ BOOL bRc = osUnmapViewOfFile(p->aRegion[i].pMap);+ OSTRACE(("SHM-PURGE-UNMAP pid=%lu, region=%d, rc=%s\n",+ osGetCurrentProcessId(), i, bRc ? "ok" : "failed"));+ UNUSED_VARIABLE_VALUE(bRc);+ bRc = osCloseHandle(p->aRegion[i].hMap);+ OSTRACE(("SHM-PURGE-CLOSE pid=%lu, region=%d, rc=%s\n",+ osGetCurrentProcessId(), i, bRc ? "ok" : "failed"));+ UNUSED_VARIABLE_VALUE(bRc);+ }+ if( p->hFile.h!=NULL && p->hFile.h!=INVALID_HANDLE_VALUE ){+ SimulateIOErrorBenign(1);+ winClose((sqlite3_file *)&p->hFile);+ SimulateIOErrorBenign(0);+ }+ if( deleteFlag ){+ SimulateIOErrorBenign(1);+ winDelete(pVfs, p->zFilename, 0);+ SimulateIOErrorBenign(0);+ }+ *pp = p->pNext;+ sqlite3_free(p->aRegion);+ sqlite3_free(p);+ }else{+ pp = &p->pNext;+ }+ }+}++/*+** Open the shared-memory area associated with database file pDbFd.+**+** When opening a new shared-memory file, if no other instances of that+** file are currently open, in this process or in other processes, then+** the file must be truncated to zero length or have its header cleared.+*/+static int winOpenSharedMemory(winFile *pDbFd){+ struct winShm *p; /* The connection to be opened */+ struct winShmNode *pShmNode = 0; /* The underlying mmapped file */+ int rc; /* Result code */+ struct winShmNode *pNew; /* Newly allocated winShmNode */+ int nName; /* Size of zName in bytes */++ assert( pDbFd->pShm==0 ); /* Not previously opened */++ /* Allocate space for the new sqlite3_shm object. Also speculatively+ ** allocate space for a new winShmNode and filename.+ */+ p = sqlite3MallocZero( sizeof(*p) );+ if( p==0 ) return SQLITE_IOERR_NOMEM;+ nName = sqlite3Strlen30(pDbFd->zPath);+ pNew = sqlite3MallocZero( sizeof(*pShmNode) + nName + 17 );+ if( pNew==0 ){+ sqlite3_free(p);+ return SQLITE_IOERR_NOMEM;+ }+ pNew->zFilename = (char*)&pNew[1];+ sqlite3_snprintf(nName+15, pNew->zFilename, "%s-shm", pDbFd->zPath);++ /* Look to see if there is an existing winShmNode that can be used.+ ** If no matching winShmNode currently exists, create a new one.+ */+ winShmEnterMutex();+ for(pShmNode = winShmNodeList; pShmNode; pShmNode=pShmNode->pNext){+ /* TBD need to come up with better match here. Perhaps+ ** use FILE_ID_BOTH_DIR_INFO Structure.+ */+ if( sqlite3StrICmp(pShmNode->zFilename, pNew->zFilename)==0 ) break;+ }+ if( pShmNode ){+ sqlite3_free(pNew);+ }else{+ pShmNode = pNew;+ pNew = 0;+ ((winFile*)(&pShmNode->hFile))->h = INVALID_HANDLE_VALUE;+ pShmNode->pNext = winShmNodeList;+ winShmNodeList = pShmNode;++ pShmNode->mutex = sqlite3_mutex_alloc(SQLITE_MUTEX_FAST);+ if( pShmNode->mutex==0 ){+ rc = SQLITE_IOERR_NOMEM;+ goto shm_open_err;+ }++ rc = winOpen(pDbFd->pVfs,+ pShmNode->zFilename, /* Name of the file (UTF-8) */+ (sqlite3_file*)&pShmNode->hFile, /* File handle here */+ SQLITE_OPEN_WAL | SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE,+ 0);+ if( SQLITE_OK!=rc ){+ goto shm_open_err;+ }++ /* Check to see if another process is holding the dead-man switch.+ ** If not, truncate the file to zero length.+ */+ if( winShmSystemLock(pShmNode, _SHM_WRLCK, WIN_SHM_DMS, 1)==SQLITE_OK ){+ rc = winTruncate((sqlite3_file *)&pShmNode->hFile, 0);+ if( rc!=SQLITE_OK ){+ rc = winLogError(SQLITE_IOERR_SHMOPEN, osGetLastError(),+ "winOpenShm", pDbFd->zPath);+ }+ }+ if( rc==SQLITE_OK ){+ winShmSystemLock(pShmNode, _SHM_UNLCK, WIN_SHM_DMS, 1);+ rc = winShmSystemLock(pShmNode, _SHM_RDLCK, WIN_SHM_DMS, 1);+ }+ if( rc ) goto shm_open_err;+ }++ /* Make the new connection a child of the winShmNode */+ p->pShmNode = pShmNode;+#if defined(SQLITE_DEBUG) || defined(SQLITE_HAVE_OS_TRACE)+ p->id = pShmNode->nextShmId++;+#endif+ pShmNode->nRef++;+ pDbFd->pShm = p;+ winShmLeaveMutex();++ /* The reference count on pShmNode has already been incremented under+ ** the cover of the winShmEnterMutex() mutex and the pointer from the+ ** new (struct winShm) object to the pShmNode has been set. All that is+ ** left to do is to link the new object into the linked list starting+ ** at pShmNode->pFirst. This must be done while holding the pShmNode->mutex+ ** mutex.+ */+ sqlite3_mutex_enter(pShmNode->mutex);+ p->pNext = pShmNode->pFirst;+ pShmNode->pFirst = p;+ sqlite3_mutex_leave(pShmNode->mutex);+ return SQLITE_OK;++ /* Jump here on any error */+shm_open_err:+ winShmSystemLock(pShmNode, _SHM_UNLCK, WIN_SHM_DMS, 1);+ winShmPurge(pDbFd->pVfs, 0); /* This call frees pShmNode if required */+ sqlite3_free(p);+ sqlite3_free(pNew);+ winShmLeaveMutex();+ return rc;+}++/*+** Close a connection to shared-memory. Delete the underlying+** storage if deleteFlag is true.+*/+static int winShmUnmap(+ sqlite3_file *fd, /* Database holding shared memory */+ int deleteFlag /* Delete after closing if true */+){+ winFile *pDbFd; /* Database holding shared-memory */+ winShm *p; /* The connection to be closed */+ winShmNode *pShmNode; /* The underlying shared-memory file */+ winShm **pp; /* For looping over sibling connections */++ pDbFd = (winFile*)fd;+ p = pDbFd->pShm;+ if( p==0 ) return SQLITE_OK;+ pShmNode = p->pShmNode;++ /* Remove connection p from the set of connections associated+ ** with pShmNode */+ sqlite3_mutex_enter(pShmNode->mutex);+ for(pp=&pShmNode->pFirst; (*pp)!=p; pp = &(*pp)->pNext){}+ *pp = p->pNext;++ /* Free the connection p */+ sqlite3_free(p);+ pDbFd->pShm = 0;+ sqlite3_mutex_leave(pShmNode->mutex);++ /* If pShmNode->nRef has reached 0, then close the underlying+ ** shared-memory file, too */+ winShmEnterMutex();+ assert( pShmNode->nRef>0 );+ pShmNode->nRef--;+ if( pShmNode->nRef==0 ){+ winShmPurge(pDbFd->pVfs, deleteFlag);+ }+ winShmLeaveMutex();++ return SQLITE_OK;+}++/*+** Change the lock state for a shared-memory segment.+*/+static int winShmLock(+ sqlite3_file *fd, /* Database file holding the shared memory */+ int ofst, /* First lock to acquire or release */+ int n, /* Number of locks to acquire or release */+ int flags /* What to do with the lock */+){+ winFile *pDbFd = (winFile*)fd; /* Connection holding shared memory */+ winShm *p = pDbFd->pShm; /* The shared memory being locked */+ winShm *pX; /* For looping over all siblings */+ winShmNode *pShmNode = p->pShmNode;+ int rc = SQLITE_OK; /* Result code */+ u16 mask; /* Mask of locks to take or release */++ assert( ofst>=0 && ofst+n<=SQLITE_SHM_NLOCK );+ assert( n>=1 );+ assert( flags==(SQLITE_SHM_LOCK | SQLITE_SHM_SHARED)+ || flags==(SQLITE_SHM_LOCK | SQLITE_SHM_EXCLUSIVE)+ || flags==(SQLITE_SHM_UNLOCK | SQLITE_SHM_SHARED)+ || flags==(SQLITE_SHM_UNLOCK | SQLITE_SHM_EXCLUSIVE) );+ assert( n==1 || (flags & SQLITE_SHM_EXCLUSIVE)!=0 );++ mask = (u16)((1U<<(ofst+n)) - (1U<<ofst));+ assert( n>1 || mask==(1<<ofst) );+ sqlite3_mutex_enter(pShmNode->mutex);+ if( flags & SQLITE_SHM_UNLOCK ){+ u16 allMask = 0; /* Mask of locks held by siblings */++ /* See if any siblings hold this same lock */+ for(pX=pShmNode->pFirst; pX; pX=pX->pNext){+ if( pX==p ) continue;+ assert( (pX->exclMask & (p->exclMask|p->sharedMask))==0 );+ allMask |= pX->sharedMask;+ }++ /* Unlock the system-level locks */+ if( (mask & allMask)==0 ){+ rc = winShmSystemLock(pShmNode, _SHM_UNLCK, ofst+WIN_SHM_BASE, n);+ }else{+ rc = SQLITE_OK;+ }++ /* Undo the local locks */+ if( rc==SQLITE_OK ){+ p->exclMask &= ~mask;+ p->sharedMask &= ~mask;+ }+ }else if( flags & SQLITE_SHM_SHARED ){+ u16 allShared = 0; /* Union of locks held by connections other than "p" */++ /* Find out which shared locks are already held by sibling connections.+ ** If any sibling already holds an exclusive lock, go ahead and return+ ** SQLITE_BUSY.+ */+ for(pX=pShmNode->pFirst; pX; pX=pX->pNext){+ if( (pX->exclMask & mask)!=0 ){+ rc = SQLITE_BUSY;+ break;+ }+ allShared |= pX->sharedMask;+ }++ /* Get shared locks at the system level, if necessary */+ if( rc==SQLITE_OK ){+ if( (allShared & mask)==0 ){+ rc = winShmSystemLock(pShmNode, _SHM_RDLCK, ofst+WIN_SHM_BASE, n);+ }else{+ rc = SQLITE_OK;+ }+ }++ /* Get the local shared locks */+ if( rc==SQLITE_OK ){+ p->sharedMask |= mask;+ }+ }else{+ /* Make sure no sibling connections hold locks that will block this+ ** lock. If any do, return SQLITE_BUSY right away.+ */+ for(pX=pShmNode->pFirst; pX; pX=pX->pNext){+ if( (pX->exclMask & mask)!=0 || (pX->sharedMask & mask)!=0 ){+ rc = SQLITE_BUSY;+ break;+ }+ }++ /* Get the exclusive locks at the system level. Then if successful+ ** also mark the local connection as being locked.+ */+ if( rc==SQLITE_OK ){+ rc = winShmSystemLock(pShmNode, _SHM_WRLCK, ofst+WIN_SHM_BASE, n);+ if( rc==SQLITE_OK ){+ assert( (p->sharedMask & mask)==0 );+ p->exclMask |= mask;+ }+ }+ }+ sqlite3_mutex_leave(pShmNode->mutex);+ OSTRACE(("SHM-LOCK pid=%lu, id=%d, sharedMask=%03x, exclMask=%03x, rc=%s\n",+ osGetCurrentProcessId(), p->id, p->sharedMask, p->exclMask,+ sqlite3ErrName(rc)));+ return rc;+}++/*+** Implement a memory barrier or memory fence on shared memory.+**+** All loads and stores begun before the barrier must complete before+** any load or store begun after the barrier.+*/+static void winShmBarrier(+ sqlite3_file *fd /* Database holding the shared memory */+){+ UNUSED_PARAMETER(fd);+ sqlite3MemoryBarrier(); /* compiler-defined memory barrier */+ winShmEnterMutex(); /* Also mutex, for redundancy */+ winShmLeaveMutex();+}++/*+** This function is called to obtain a pointer to region iRegion of the+** shared-memory associated with the database file fd. Shared-memory regions+** are numbered starting from zero. Each shared-memory region is szRegion+** bytes in size.+**+** If an error occurs, an error code is returned and *pp is set to NULL.+**+** Otherwise, if the isWrite parameter is 0 and the requested shared-memory+** region has not been allocated (by any client, including one running in a+** separate process), then *pp is set to NULL and SQLITE_OK returned. If+** isWrite is non-zero and the requested shared-memory region has not yet+** been allocated, it is allocated by this function.+**+** If the shared-memory region has already been allocated or is allocated by+** this call as described above, then it is mapped into this processes+** address space (if it is not already), *pp is set to point to the mapped+** memory and SQLITE_OK returned.+*/+static int winShmMap(+ sqlite3_file *fd, /* Handle open on database file */+ int iRegion, /* Region to retrieve */+ int szRegion, /* Size of regions */+ int isWrite, /* True to extend file if necessary */+ void volatile **pp /* OUT: Mapped memory */+){+ winFile *pDbFd = (winFile*)fd;+ winShm *pShm = pDbFd->pShm;+ winShmNode *pShmNode;+ int rc = SQLITE_OK;++ if( !pShm ){+ rc = winOpenSharedMemory(pDbFd);+ if( rc!=SQLITE_OK ) return rc;+ pShm = pDbFd->pShm;+ }+ pShmNode = pShm->pShmNode;++ sqlite3_mutex_enter(pShmNode->mutex);+ assert( szRegion==pShmNode->szRegion || pShmNode->nRegion==0 );++ if( pShmNode->nRegion<=iRegion ){+ struct ShmRegion *apNew; /* New aRegion[] array */+ int nByte = (iRegion+1)*szRegion; /* Minimum required file size */+ sqlite3_int64 sz; /* Current size of wal-index file */++ pShmNode->szRegion = szRegion;++ /* The requested region is not mapped into this processes address space.+ ** Check to see if it has been allocated (i.e. if the wal-index file is+ ** large enough to contain the requested region).+ */+ rc = winFileSize((sqlite3_file *)&pShmNode->hFile, &sz);+ if( rc!=SQLITE_OK ){+ rc = winLogError(SQLITE_IOERR_SHMSIZE, osGetLastError(),+ "winShmMap1", pDbFd->zPath);+ goto shmpage_out;+ }++ if( sz<nByte ){+ /* The requested memory region does not exist. If isWrite is set to+ ** zero, exit early. *pp will be set to NULL and SQLITE_OK returned.+ **+ ** Alternatively, if isWrite is non-zero, use ftruncate() to allocate+ ** the requested memory region.+ */+ if( !isWrite ) goto shmpage_out;+ rc = winTruncate((sqlite3_file *)&pShmNode->hFile, nByte);+ if( rc!=SQLITE_OK ){+ rc = winLogError(SQLITE_IOERR_SHMSIZE, osGetLastError(),+ "winShmMap2", pDbFd->zPath);+ goto shmpage_out;+ }+ }++ /* Map the requested memory region into this processes address space. */+ apNew = (struct ShmRegion *)sqlite3_realloc64(+ pShmNode->aRegion, (iRegion+1)*sizeof(apNew[0])+ );+ if( !apNew ){+ rc = SQLITE_IOERR_NOMEM;+ goto shmpage_out;+ }+ pShmNode->aRegion = apNew;++ while( pShmNode->nRegion<=iRegion ){+ HANDLE hMap = NULL; /* file-mapping handle */+ void *pMap = 0; /* Mapped memory region */++#if SQLITE_OS_WINRT+ hMap = osCreateFileMappingFromApp(pShmNode->hFile.h,+ NULL, PAGE_READWRITE, nByte, NULL+ );+#elif defined(SQLITE_WIN32_HAS_WIDE)+ hMap = osCreateFileMappingW(pShmNode->hFile.h,+ NULL, PAGE_READWRITE, 0, nByte, NULL+ );+#elif defined(SQLITE_WIN32_HAS_ANSI)+ hMap = osCreateFileMappingA(pShmNode->hFile.h,+ NULL, PAGE_READWRITE, 0, nByte, NULL+ );+#endif+ OSTRACE(("SHM-MAP-CREATE pid=%lu, region=%d, size=%d, rc=%s\n",+ osGetCurrentProcessId(), pShmNode->nRegion, nByte,+ hMap ? "ok" : "failed"));+ if( hMap ){+ int iOffset = pShmNode->nRegion*szRegion;+ int iOffsetShift = iOffset % winSysInfo.dwAllocationGranularity;+#if SQLITE_OS_WINRT+ pMap = osMapViewOfFileFromApp(hMap, FILE_MAP_WRITE | FILE_MAP_READ,+ iOffset - iOffsetShift, szRegion + iOffsetShift+ );+#else+ pMap = osMapViewOfFile(hMap, FILE_MAP_WRITE | FILE_MAP_READ,+ 0, iOffset - iOffsetShift, szRegion + iOffsetShift+ );+#endif+ OSTRACE(("SHM-MAP-MAP pid=%lu, region=%d, offset=%d, size=%d, rc=%s\n",+ osGetCurrentProcessId(), pShmNode->nRegion, iOffset,+ szRegion, pMap ? "ok" : "failed"));+ }+ if( !pMap ){+ pShmNode->lastErrno = osGetLastError();+ rc = winLogError(SQLITE_IOERR_SHMMAP, pShmNode->lastErrno,+ "winShmMap3", pDbFd->zPath);+ if( hMap ) osCloseHandle(hMap);+ goto shmpage_out;+ }++ pShmNode->aRegion[pShmNode->nRegion].pMap = pMap;+ pShmNode->aRegion[pShmNode->nRegion].hMap = hMap;+ pShmNode->nRegion++;+ }+ }++shmpage_out:+ if( pShmNode->nRegion>iRegion ){+ int iOffset = iRegion*szRegion;+ int iOffsetShift = iOffset % winSysInfo.dwAllocationGranularity;+ char *p = (char *)pShmNode->aRegion[iRegion].pMap;+ *pp = (void *)&p[iOffsetShift];+ }else{+ *pp = 0;+ }+ sqlite3_mutex_leave(pShmNode->mutex);+ return rc;+}++#else+# define winShmMap 0+# define winShmLock 0+# define winShmBarrier 0+# define winShmUnmap 0+#endif /* #ifndef SQLITE_OMIT_WAL */++/*+** Cleans up the mapped region of the specified file, if any.+*/+#if SQLITE_MAX_MMAP_SIZE>0+static int winUnmapfile(winFile *pFile){+ assert( pFile!=0 );+ OSTRACE(("UNMAP-FILE pid=%lu, pFile=%p, hMap=%p, pMapRegion=%p, "+ "mmapSize=%lld, mmapSizeActual=%lld, mmapSizeMax=%lld\n",+ osGetCurrentProcessId(), pFile, pFile->hMap, pFile->pMapRegion,+ pFile->mmapSize, pFile->mmapSizeActual, pFile->mmapSizeMax));+ if( pFile->pMapRegion ){+ if( !osUnmapViewOfFile(pFile->pMapRegion) ){+ pFile->lastErrno = osGetLastError();+ OSTRACE(("UNMAP-FILE pid=%lu, pFile=%p, pMapRegion=%p, "+ "rc=SQLITE_IOERR_MMAP\n", osGetCurrentProcessId(), pFile,+ pFile->pMapRegion));+ return winLogError(SQLITE_IOERR_MMAP, pFile->lastErrno,+ "winUnmapfile1", pFile->zPath);+ }+ pFile->pMapRegion = 0;+ pFile->mmapSize = 0;+ pFile->mmapSizeActual = 0;+ }+ if( pFile->hMap!=NULL ){+ if( !osCloseHandle(pFile->hMap) ){+ pFile->lastErrno = osGetLastError();+ OSTRACE(("UNMAP-FILE pid=%lu, pFile=%p, hMap=%p, rc=SQLITE_IOERR_MMAP\n",+ osGetCurrentProcessId(), pFile, pFile->hMap));+ return winLogError(SQLITE_IOERR_MMAP, pFile->lastErrno,+ "winUnmapfile2", pFile->zPath);+ }+ pFile->hMap = NULL;+ }+ OSTRACE(("UNMAP-FILE pid=%lu, pFile=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFile));+ return SQLITE_OK;+}++/*+** Memory map or remap the file opened by file-descriptor pFd (if the file+** is already mapped, the existing mapping is replaced by the new). Or, if+** there already exists a mapping for this file, and there are still+** outstanding xFetch() references to it, this function is a no-op.+**+** If parameter nByte is non-negative, then it is the requested size of+** the mapping to create. Otherwise, if nByte is less than zero, then the+** requested size is the size of the file on disk. The actual size of the+** created mapping is either the requested size or the value configured+** using SQLITE_FCNTL_MMAP_SIZE, whichever is smaller.+**+** SQLITE_OK is returned if no error occurs (even if the mapping is not+** recreated as a result of outstanding references) or an SQLite error+** code otherwise.+*/+static int winMapfile(winFile *pFd, sqlite3_int64 nByte){+ sqlite3_int64 nMap = nByte;+ int rc;++ assert( nMap>=0 || pFd->nFetchOut==0 );+ OSTRACE(("MAP-FILE pid=%lu, pFile=%p, size=%lld\n",+ osGetCurrentProcessId(), pFd, nByte));++ if( pFd->nFetchOut>0 ) return SQLITE_OK;++ if( nMap<0 ){+ rc = winFileSize((sqlite3_file*)pFd, &nMap);+ if( rc ){+ OSTRACE(("MAP-FILE pid=%lu, pFile=%p, rc=SQLITE_IOERR_FSTAT\n",+ osGetCurrentProcessId(), pFd));+ return SQLITE_IOERR_FSTAT;+ }+ }+ if( nMap>pFd->mmapSizeMax ){+ nMap = pFd->mmapSizeMax;+ }+ nMap &= ~(sqlite3_int64)(winSysInfo.dwPageSize - 1);++ if( nMap==0 && pFd->mmapSize>0 ){+ winUnmapfile(pFd);+ }+ if( nMap!=pFd->mmapSize ){+ void *pNew = 0;+ DWORD protect = PAGE_READONLY;+ DWORD flags = FILE_MAP_READ;++ winUnmapfile(pFd);+ if( (pFd->ctrlFlags & WINFILE_RDONLY)==0 ){+ protect = PAGE_READWRITE;+ flags |= FILE_MAP_WRITE;+ }+#if SQLITE_OS_WINRT+ pFd->hMap = osCreateFileMappingFromApp(pFd->h, NULL, protect, nMap, NULL);+#elif defined(SQLITE_WIN32_HAS_WIDE)+ pFd->hMap = osCreateFileMappingW(pFd->h, NULL, protect,+ (DWORD)((nMap>>32) & 0xffffffff),+ (DWORD)(nMap & 0xffffffff), NULL);+#elif defined(SQLITE_WIN32_HAS_ANSI)+ pFd->hMap = osCreateFileMappingA(pFd->h, NULL, protect,+ (DWORD)((nMap>>32) & 0xffffffff),+ (DWORD)(nMap & 0xffffffff), NULL);+#endif+ if( pFd->hMap==NULL ){+ pFd->lastErrno = osGetLastError();+ rc = winLogError(SQLITE_IOERR_MMAP, pFd->lastErrno,+ "winMapfile1", pFd->zPath);+ /* Log the error, but continue normal operation using xRead/xWrite */+ OSTRACE(("MAP-FILE-CREATE pid=%lu, pFile=%p, rc=%s\n",+ osGetCurrentProcessId(), pFd, sqlite3ErrName(rc)));+ return SQLITE_OK;+ }+ assert( (nMap % winSysInfo.dwPageSize)==0 );+ assert( sizeof(SIZE_T)==sizeof(sqlite3_int64) || nMap<=0xffffffff );+#if SQLITE_OS_WINRT+ pNew = osMapViewOfFileFromApp(pFd->hMap, flags, 0, (SIZE_T)nMap);+#else+ pNew = osMapViewOfFile(pFd->hMap, flags, 0, 0, (SIZE_T)nMap);+#endif+ if( pNew==NULL ){+ osCloseHandle(pFd->hMap);+ pFd->hMap = NULL;+ pFd->lastErrno = osGetLastError();+ rc = winLogError(SQLITE_IOERR_MMAP, pFd->lastErrno,+ "winMapfile2", pFd->zPath);+ /* Log the error, but continue normal operation using xRead/xWrite */+ OSTRACE(("MAP-FILE-MAP pid=%lu, pFile=%p, rc=%s\n",+ osGetCurrentProcessId(), pFd, sqlite3ErrName(rc)));+ return SQLITE_OK;+ }+ pFd->pMapRegion = pNew;+ pFd->mmapSize = nMap;+ pFd->mmapSizeActual = nMap;+ }++ OSTRACE(("MAP-FILE pid=%lu, pFile=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), pFd));+ return SQLITE_OK;+}+#endif /* SQLITE_MAX_MMAP_SIZE>0 */++/*+** If possible, return a pointer to a mapping of file fd starting at offset+** iOff. The mapping must be valid for at least nAmt bytes.+**+** If such a pointer can be obtained, store it in *pp and return SQLITE_OK.+** Or, if one cannot but no error occurs, set *pp to 0 and return SQLITE_OK.+** Finally, if an error does occur, return an SQLite error code. The final+** value of *pp is undefined in this case.+**+** If this function does return a pointer, the caller must eventually+** release the reference by calling winUnfetch().+*/+static int winFetch(sqlite3_file *fd, i64 iOff, int nAmt, void **pp){+#if SQLITE_MAX_MMAP_SIZE>0+ winFile *pFd = (winFile*)fd; /* The underlying database file */+#endif+ *pp = 0;++ OSTRACE(("FETCH pid=%lu, pFile=%p, offset=%lld, amount=%d, pp=%p\n",+ osGetCurrentProcessId(), fd, iOff, nAmt, pp));++#if SQLITE_MAX_MMAP_SIZE>0+ if( pFd->mmapSizeMax>0 ){+ if( pFd->pMapRegion==0 ){+ int rc = winMapfile(pFd, -1);+ if( rc!=SQLITE_OK ){+ OSTRACE(("FETCH pid=%lu, pFile=%p, rc=%s\n",+ osGetCurrentProcessId(), pFd, sqlite3ErrName(rc)));+ return rc;+ }+ }+ if( pFd->mmapSize >= iOff+nAmt ){+ *pp = &((u8 *)pFd->pMapRegion)[iOff];+ pFd->nFetchOut++;+ }+ }+#endif++ OSTRACE(("FETCH pid=%lu, pFile=%p, pp=%p, *pp=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), fd, pp, *pp));+ return SQLITE_OK;+}++/*+** If the third argument is non-NULL, then this function releases a+** reference obtained by an earlier call to winFetch(). The second+** argument passed to this function must be the same as the corresponding+** argument that was passed to the winFetch() invocation.+**+** Or, if the third argument is NULL, then this function is being called+** to inform the VFS layer that, according to POSIX, any existing mapping+** may now be invalid and should be unmapped.+*/+static int winUnfetch(sqlite3_file *fd, i64 iOff, void *p){+#if SQLITE_MAX_MMAP_SIZE>0+ winFile *pFd = (winFile*)fd; /* The underlying database file */++ /* If p==0 (unmap the entire file) then there must be no outstanding+ ** xFetch references. Or, if p!=0 (meaning it is an xFetch reference),+ ** then there must be at least one outstanding. */+ assert( (p==0)==(pFd->nFetchOut==0) );++ /* If p!=0, it must match the iOff value. */+ assert( p==0 || p==&((u8 *)pFd->pMapRegion)[iOff] );++ OSTRACE(("UNFETCH pid=%lu, pFile=%p, offset=%lld, p=%p\n",+ osGetCurrentProcessId(), pFd, iOff, p));++ if( p ){+ pFd->nFetchOut--;+ }else{+ /* FIXME: If Windows truly always prevents truncating or deleting a+ ** file while a mapping is held, then the following winUnmapfile() call+ ** is unnecessary can be omitted - potentially improving+ ** performance. */+ winUnmapfile(pFd);+ }++ assert( pFd->nFetchOut>=0 );+#endif++ OSTRACE(("UNFETCH pid=%lu, pFile=%p, rc=SQLITE_OK\n",+ osGetCurrentProcessId(), fd));+ return SQLITE_OK;+}++/*+** Here ends the implementation of all sqlite3_file methods.+**+********************** End sqlite3_file Methods *******************************+******************************************************************************/++/*+** This vector defines all the methods that can operate on an+** sqlite3_file for win32.+*/+static const sqlite3_io_methods winIoMethod = {+ 3, /* iVersion */+ winClose, /* xClose */+ winRead, /* xRead */+ winWrite, /* xWrite */+ winTruncate, /* xTruncate */+ winSync, /* xSync */+ winFileSize, /* xFileSize */+ winLock, /* xLock */+ winUnlock, /* xUnlock */+ winCheckReservedLock, /* xCheckReservedLock */+ winFileControl, /* xFileControl */+ winSectorSize, /* xSectorSize */+ winDeviceCharacteristics, /* xDeviceCharacteristics */+ winShmMap, /* xShmMap */+ winShmLock, /* xShmLock */+ winShmBarrier, /* xShmBarrier */+ winShmUnmap, /* xShmUnmap */+ winFetch, /* xFetch */+ winUnfetch /* xUnfetch */+};++/****************************************************************************+**************************** sqlite3_vfs methods ****************************+**+** This division contains the implementation of methods on the+** sqlite3_vfs object.+*/++#if defined(__CYGWIN__)+/*+** Convert a filename from whatever the underlying operating system+** supports for filenames into UTF-8. Space to hold the result is+** obtained from malloc and must be freed by the calling function.+*/+static char *winConvertToUtf8Filename(const void *zFilename){+ char *zConverted = 0;+ if( osIsNT() ){+ zConverted = winUnicodeToUtf8(zFilename);+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ zConverted = sqlite3_win32_mbcs_to_utf8(zFilename);+ }+#endif+ /* caller will handle out of memory */+ return zConverted;+}+#endif++/*+** Convert a UTF-8 filename into whatever form the underlying+** operating system wants filenames in. Space to hold the result+** is obtained from malloc and must be freed by the calling+** function.+*/+static void *winConvertFromUtf8Filename(const char *zFilename){+ void *zConverted = 0;+ if( osIsNT() ){+ zConverted = winUtf8ToUnicode(zFilename);+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ zConverted = sqlite3_win32_utf8_to_mbcs(zFilename);+ }+#endif+ /* caller will handle out of memory */+ return zConverted;+}++/*+** This function returns non-zero if the specified UTF-8 string buffer+** ends with a directory separator character or one was successfully+** added to it.+*/+static int winMakeEndInDirSep(int nBuf, char *zBuf){+ if( zBuf ){+ int nLen = sqlite3Strlen30(zBuf);+ if( nLen>0 ){+ if( winIsDirSep(zBuf[nLen-1]) ){+ return 1;+ }else if( nLen+1<nBuf ){+ zBuf[nLen] = winGetDirSep();+ zBuf[nLen+1] = '\0';+ return 1;+ }+ }+ }+ return 0;+}++/*+** Create a temporary file name and store the resulting pointer into pzBuf.+** The pointer returned in pzBuf must be freed via sqlite3_free().+*/+static int winGetTempname(sqlite3_vfs *pVfs, char **pzBuf){+ static char zChars[] =+ "abcdefghijklmnopqrstuvwxyz"+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"+ "0123456789";+ size_t i, j;+ int nPre = sqlite3Strlen30(SQLITE_TEMP_FILE_PREFIX);+ int nMax, nBuf, nDir, nLen;+ char *zBuf;++ /* It's odd to simulate an io-error here, but really this is just+ ** using the io-error infrastructure to test that SQLite handles this+ ** function failing.+ */+ SimulateIOError( return SQLITE_IOERR );++ /* Allocate a temporary buffer to store the fully qualified file+ ** name for the temporary file. If this fails, we cannot continue.+ */+ nMax = pVfs->mxPathname; nBuf = nMax + 2;+ zBuf = sqlite3MallocZero( nBuf );+ if( !zBuf ){+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }++ /* Figure out the effective temporary directory. First, check if one+ ** has been explicitly set by the application; otherwise, use the one+ ** configured by the operating system.+ */+ nDir = nMax - (nPre + 15);+ assert( nDir>0 );+ if( sqlite3_temp_directory ){+ int nDirLen = sqlite3Strlen30(sqlite3_temp_directory);+ if( nDirLen>0 ){+ if( !winIsDirSep(sqlite3_temp_directory[nDirLen-1]) ){+ nDirLen++;+ }+ if( nDirLen>nDir ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_ERROR\n"));+ return winLogError(SQLITE_ERROR, 0, "winGetTempname1", 0);+ }+ sqlite3_snprintf(nMax, zBuf, "%s", sqlite3_temp_directory);+ }+ }+#if defined(__CYGWIN__)+ else{+ static const char *azDirs[] = {+ 0, /* getenv("SQLITE_TMPDIR") */+ 0, /* getenv("TMPDIR") */+ 0, /* getenv("TMP") */+ 0, /* getenv("TEMP") */+ 0, /* getenv("USERPROFILE") */+ "/var/tmp",+ "/usr/tmp",+ "/tmp",+ ".",+ 0 /* List terminator */+ };+ unsigned int i;+ const char *zDir = 0;++ if( !azDirs[0] ) azDirs[0] = getenv("SQLITE_TMPDIR");+ if( !azDirs[1] ) azDirs[1] = getenv("TMPDIR");+ if( !azDirs[2] ) azDirs[2] = getenv("TMP");+ if( !azDirs[3] ) azDirs[3] = getenv("TEMP");+ if( !azDirs[4] ) azDirs[4] = getenv("USERPROFILE");+ for(i=0; i<sizeof(azDirs)/sizeof(azDirs[0]); zDir=azDirs[i++]){+ void *zConverted;+ if( zDir==0 ) continue;+ /* If the path starts with a drive letter followed by the colon+ ** character, assume it is already a native Win32 path; otherwise,+ ** it must be converted to a native Win32 path via the Cygwin API+ ** prior to using it.+ */+ if( winIsDriveLetterAndColon(zDir) ){+ zConverted = winConvertFromUtf8Filename(zDir);+ if( !zConverted ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }+ if( winIsDir(zConverted) ){+ sqlite3_snprintf(nMax, zBuf, "%s", zDir);+ sqlite3_free(zConverted);+ break;+ }+ sqlite3_free(zConverted);+ }else{+ zConverted = sqlite3MallocZero( nMax+1 );+ if( !zConverted ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }+ if( cygwin_conv_path(+ osIsNT() ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_A, zDir,+ zConverted, nMax+1)<0 ){+ sqlite3_free(zConverted);+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_CONVPATH\n"));+ return winLogError(SQLITE_IOERR_CONVPATH, (DWORD)errno,+ "winGetTempname2", zDir);+ }+ if( winIsDir(zConverted) ){+ /* At this point, we know the candidate directory exists and should+ ** be used. However, we may need to convert the string containing+ ** its name into UTF-8 (i.e. if it is UTF-16 right now).+ */+ char *zUtf8 = winConvertToUtf8Filename(zConverted);+ if( !zUtf8 ){+ sqlite3_free(zConverted);+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }+ sqlite3_snprintf(nMax, zBuf, "%s", zUtf8);+ sqlite3_free(zUtf8);+ sqlite3_free(zConverted);+ break;+ }+ sqlite3_free(zConverted);+ }+ }+ }+#elif !SQLITE_OS_WINRT && !defined(__CYGWIN__)+ else if( osIsNT() ){+ char *zMulti;+ LPWSTR zWidePath = sqlite3MallocZero( nMax*sizeof(WCHAR) );+ if( !zWidePath ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }+ if( osGetTempPathW(nMax, zWidePath)==0 ){+ sqlite3_free(zWidePath);+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_GETTEMPPATH\n"));+ return winLogError(SQLITE_IOERR_GETTEMPPATH, osGetLastError(),+ "winGetTempname2", 0);+ }+ zMulti = winUnicodeToUtf8(zWidePath);+ if( zMulti ){+ sqlite3_snprintf(nMax, zBuf, "%s", zMulti);+ sqlite3_free(zMulti);+ sqlite3_free(zWidePath);+ }else{+ sqlite3_free(zWidePath);+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ char *zUtf8;+ char *zMbcsPath = sqlite3MallocZero( nMax );+ if( !zMbcsPath ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }+ if( osGetTempPathA(nMax, zMbcsPath)==0 ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_GETTEMPPATH\n"));+ return winLogError(SQLITE_IOERR_GETTEMPPATH, osGetLastError(),+ "winGetTempname3", 0);+ }+ zUtf8 = sqlite3_win32_mbcs_to_utf8(zMbcsPath);+ if( zUtf8 ){+ sqlite3_snprintf(nMax, zBuf, "%s", zUtf8);+ sqlite3_free(zUtf8);+ }else{+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_IOERR_NOMEM\n"));+ return SQLITE_IOERR_NOMEM;+ }+ }+#endif /* SQLITE_WIN32_HAS_ANSI */+#endif /* !SQLITE_OS_WINRT */++ /*+ ** Check to make sure the temporary directory ends with an appropriate+ ** separator. If it does not and there is not enough space left to add+ ** one, fail.+ */+ if( !winMakeEndInDirSep(nDir+1, zBuf) ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_ERROR\n"));+ return winLogError(SQLITE_ERROR, 0, "winGetTempname4", 0);+ }++ /*+ ** Check that the output buffer is large enough for the temporary file+ ** name in the following format:+ **+ ** "<temporary_directory>/etilqs_XXXXXXXXXXXXXXX\0\0"+ **+ ** If not, return SQLITE_ERROR. The number 17 is used here in order to+ ** account for the space used by the 15 character random suffix and the+ ** two trailing NUL characters. The final directory separator character+ ** has already added if it was not already present.+ */+ nLen = sqlite3Strlen30(zBuf);+ if( (nLen + nPre + 17) > nBuf ){+ sqlite3_free(zBuf);+ OSTRACE(("TEMP-FILENAME rc=SQLITE_ERROR\n"));+ return winLogError(SQLITE_ERROR, 0, "winGetTempname5", 0);+ }++ sqlite3_snprintf(nBuf-16-nLen, zBuf+nLen, SQLITE_TEMP_FILE_PREFIX);++ j = sqlite3Strlen30(zBuf);+ sqlite3_randomness(15, &zBuf[j]);+ for(i=0; i<15; i++, j++){+ zBuf[j] = (char)zChars[ ((unsigned char)zBuf[j])%(sizeof(zChars)-1) ];+ }+ zBuf[j] = 0;+ zBuf[j+1] = 0;+ *pzBuf = zBuf;++ OSTRACE(("TEMP-FILENAME name=%s, rc=SQLITE_OK\n", zBuf));+ return SQLITE_OK;+}++/*+** Return TRUE if the named file is really a directory. Return false if+** it is something other than a directory, or if there is any kind of memory+** allocation failure.+*/+static int winIsDir(const void *zConverted){+ DWORD attr;+ int rc = 0;+ DWORD lastErrno;++ if( osIsNT() ){+ int cnt = 0;+ WIN32_FILE_ATTRIBUTE_DATA sAttrData;+ memset(&sAttrData, 0, sizeof(sAttrData));+ while( !(rc = osGetFileAttributesExW((LPCWSTR)zConverted,+ GetFileExInfoStandard,+ &sAttrData)) && winRetryIoerr(&cnt, &lastErrno) ){}+ if( !rc ){+ return 0; /* Invalid name? */+ }+ attr = sAttrData.dwFileAttributes;+#if SQLITE_OS_WINCE==0+ }else{+ attr = osGetFileAttributesA((char*)zConverted);+#endif+ }+ return (attr!=INVALID_FILE_ATTRIBUTES) && (attr&FILE_ATTRIBUTE_DIRECTORY);+}++/*+** Open a file.+*/+static int winOpen(+ sqlite3_vfs *pVfs, /* Used to get maximum path name length */+ const char *zName, /* Name of the file (UTF-8) */+ sqlite3_file *id, /* Write the SQLite file handle here */+ int flags, /* Open mode flags */+ int *pOutFlags /* Status return flags */+){+ HANDLE h;+ DWORD lastErrno = 0;+ DWORD dwDesiredAccess;+ DWORD dwShareMode;+ DWORD dwCreationDisposition;+ DWORD dwFlagsAndAttributes = 0;+#if SQLITE_OS_WINCE+ int isTemp = 0;+#endif+ winFile *pFile = (winFile*)id;+ void *zConverted; /* Filename in OS encoding */+ const char *zUtf8Name = zName; /* Filename in UTF-8 encoding */+ int cnt = 0;++ /* If argument zPath is a NULL pointer, this function is required to open+ ** a temporary file. Use this buffer to store the file name in.+ */+ char *zTmpname = 0; /* For temporary filename, if necessary. */++ int rc = SQLITE_OK; /* Function Return Code */+#if !defined(NDEBUG) || SQLITE_OS_WINCE+ int eType = flags&0xFFFFFF00; /* Type of file to open */+#endif++ int isExclusive = (flags & SQLITE_OPEN_EXCLUSIVE);+ int isDelete = (flags & SQLITE_OPEN_DELETEONCLOSE);+ int isCreate = (flags & SQLITE_OPEN_CREATE);+ int isReadonly = (flags & SQLITE_OPEN_READONLY);+ int isReadWrite = (flags & SQLITE_OPEN_READWRITE);++#ifndef NDEBUG+ int isOpenJournal = (isCreate && (+ eType==SQLITE_OPEN_MASTER_JOURNAL+ || eType==SQLITE_OPEN_MAIN_JOURNAL+ || eType==SQLITE_OPEN_WAL+ ));+#endif++ OSTRACE(("OPEN name=%s, pFile=%p, flags=%x, pOutFlags=%p\n",+ zUtf8Name, id, flags, pOutFlags));++ /* Check the following statements are true:+ **+ ** (a) Exactly one of the READWRITE and READONLY flags must be set, and+ ** (b) if CREATE is set, then READWRITE must also be set, and+ ** (c) if EXCLUSIVE is set, then CREATE must also be set.+ ** (d) if DELETEONCLOSE is set, then CREATE must also be set.+ */+ assert((isReadonly==0 || isReadWrite==0) && (isReadWrite || isReadonly));+ assert(isCreate==0 || isReadWrite);+ assert(isExclusive==0 || isCreate);+ assert(isDelete==0 || isCreate);++ /* The main DB, main journal, WAL file and master journal are never+ ** automatically deleted. Nor are they ever temporary files. */+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_MAIN_DB );+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_MAIN_JOURNAL );+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_MASTER_JOURNAL );+ assert( (!isDelete && zName) || eType!=SQLITE_OPEN_WAL );++ /* Assert that the upper layer has set one of the "file-type" flags. */+ assert( eType==SQLITE_OPEN_MAIN_DB || eType==SQLITE_OPEN_TEMP_DB+ || eType==SQLITE_OPEN_MAIN_JOURNAL || eType==SQLITE_OPEN_TEMP_JOURNAL+ || eType==SQLITE_OPEN_SUBJOURNAL || eType==SQLITE_OPEN_MASTER_JOURNAL+ || eType==SQLITE_OPEN_TRANSIENT_DB || eType==SQLITE_OPEN_WAL+ );++ assert( pFile!=0 );+ memset(pFile, 0, sizeof(winFile));+ pFile->h = INVALID_HANDLE_VALUE;++#if SQLITE_OS_WINRT+ if( !zUtf8Name && !sqlite3_temp_directory ){+ sqlite3_log(SQLITE_ERROR,+ "sqlite3_temp_directory variable should be set for WinRT");+ }+#endif++ /* If the second argument to this function is NULL, generate a+ ** temporary file name to use+ */+ if( !zUtf8Name ){+ assert( isDelete && !isOpenJournal );+ rc = winGetTempname(pVfs, &zTmpname);+ if( rc!=SQLITE_OK ){+ OSTRACE(("OPEN name=%s, rc=%s", zUtf8Name, sqlite3ErrName(rc)));+ return rc;+ }+ zUtf8Name = zTmpname;+ }++ /* Database filenames are double-zero terminated if they are not+ ** URIs with parameters. Hence, they can always be passed into+ ** sqlite3_uri_parameter().+ */+ assert( (eType!=SQLITE_OPEN_MAIN_DB) || (flags & SQLITE_OPEN_URI) ||+ zUtf8Name[sqlite3Strlen30(zUtf8Name)+1]==0 );++ /* Convert the filename to the system encoding. */+ zConverted = winConvertFromUtf8Filename(zUtf8Name);+ if( zConverted==0 ){+ sqlite3_free(zTmpname);+ OSTRACE(("OPEN name=%s, rc=SQLITE_IOERR_NOMEM", zUtf8Name));+ return SQLITE_IOERR_NOMEM;+ }++ if( winIsDir(zConverted) ){+ sqlite3_free(zConverted);+ sqlite3_free(zTmpname);+ OSTRACE(("OPEN name=%s, rc=SQLITE_CANTOPEN_ISDIR", zUtf8Name));+ return SQLITE_CANTOPEN_ISDIR;+ }++ if( isReadWrite ){+ dwDesiredAccess = GENERIC_READ | GENERIC_WRITE;+ }else{+ dwDesiredAccess = GENERIC_READ;+ }++ /* SQLITE_OPEN_EXCLUSIVE is used to make sure that a new file is+ ** created. SQLite doesn't use it to indicate "exclusive access"+ ** as it is usually understood.+ */+ if( isExclusive ){+ /* Creates a new file, only if it does not already exist. */+ /* If the file exists, it fails. */+ dwCreationDisposition = CREATE_NEW;+ }else if( isCreate ){+ /* Open existing file, or create if it doesn't exist */+ dwCreationDisposition = OPEN_ALWAYS;+ }else{+ /* Opens a file, only if it exists. */+ dwCreationDisposition = OPEN_EXISTING;+ }++ dwShareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;++ if( isDelete ){+#if SQLITE_OS_WINCE+ dwFlagsAndAttributes = FILE_ATTRIBUTE_HIDDEN;+ isTemp = 1;+#else+ dwFlagsAndAttributes = FILE_ATTRIBUTE_TEMPORARY+ | FILE_ATTRIBUTE_HIDDEN+ | FILE_FLAG_DELETE_ON_CLOSE;+#endif+ }else{+ dwFlagsAndAttributes = FILE_ATTRIBUTE_NORMAL;+ }+ /* Reports from the internet are that performance is always+ ** better if FILE_FLAG_RANDOM_ACCESS is used. Ticket #2699. */+#if SQLITE_OS_WINCE+ dwFlagsAndAttributes |= FILE_FLAG_RANDOM_ACCESS;+#endif++ if( osIsNT() ){+#if SQLITE_OS_WINRT+ CREATEFILE2_EXTENDED_PARAMETERS extendedParameters;+ extendedParameters.dwSize = sizeof(CREATEFILE2_EXTENDED_PARAMETERS);+ extendedParameters.dwFileAttributes =+ dwFlagsAndAttributes & FILE_ATTRIBUTE_MASK;+ extendedParameters.dwFileFlags = dwFlagsAndAttributes & FILE_FLAG_MASK;+ extendedParameters.dwSecurityQosFlags = SECURITY_ANONYMOUS;+ extendedParameters.lpSecurityAttributes = NULL;+ extendedParameters.hTemplateFile = NULL;+ while( (h = osCreateFile2((LPCWSTR)zConverted,+ dwDesiredAccess,+ dwShareMode,+ dwCreationDisposition,+ &extendedParameters))==INVALID_HANDLE_VALUE &&+ winRetryIoerr(&cnt, &lastErrno) ){+ /* Noop */+ }+#else+ while( (h = osCreateFileW((LPCWSTR)zConverted,+ dwDesiredAccess,+ dwShareMode, NULL,+ dwCreationDisposition,+ dwFlagsAndAttributes,+ NULL))==INVALID_HANDLE_VALUE &&+ winRetryIoerr(&cnt, &lastErrno) ){+ /* Noop */+ }+#endif+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ while( (h = osCreateFileA((LPCSTR)zConverted,+ dwDesiredAccess,+ dwShareMode, NULL,+ dwCreationDisposition,+ dwFlagsAndAttributes,+ NULL))==INVALID_HANDLE_VALUE &&+ winRetryIoerr(&cnt, &lastErrno) ){+ /* Noop */+ }+ }+#endif+ winLogIoerr(cnt, __LINE__);++ OSTRACE(("OPEN file=%p, name=%s, access=%lx, rc=%s\n", h, zUtf8Name,+ dwDesiredAccess, (h==INVALID_HANDLE_VALUE) ? "failed" : "ok"));++ if( h==INVALID_HANDLE_VALUE ){+ pFile->lastErrno = lastErrno;+ winLogError(SQLITE_CANTOPEN, pFile->lastErrno, "winOpen", zUtf8Name);+ sqlite3_free(zConverted);+ sqlite3_free(zTmpname);+ if( isReadWrite && !isExclusive ){+ return winOpen(pVfs, zName, id,+ ((flags|SQLITE_OPEN_READONLY) &+ ~(SQLITE_OPEN_CREATE|SQLITE_OPEN_READWRITE)),+ pOutFlags);+ }else{+ return SQLITE_CANTOPEN_BKPT;+ }+ }++ if( pOutFlags ){+ if( isReadWrite ){+ *pOutFlags = SQLITE_OPEN_READWRITE;+ }else{+ *pOutFlags = SQLITE_OPEN_READONLY;+ }+ }++ OSTRACE(("OPEN file=%p, name=%s, access=%lx, pOutFlags=%p, *pOutFlags=%d, "+ "rc=%s\n", h, zUtf8Name, dwDesiredAccess, pOutFlags, pOutFlags ?+ *pOutFlags : 0, (h==INVALID_HANDLE_VALUE) ? "failed" : "ok"));++#if SQLITE_OS_WINCE+ if( isReadWrite && eType==SQLITE_OPEN_MAIN_DB+ && (rc = winceCreateLock(zName, pFile))!=SQLITE_OK+ ){+ osCloseHandle(h);+ sqlite3_free(zConverted);+ sqlite3_free(zTmpname);+ OSTRACE(("OPEN-CE-LOCK name=%s, rc=%s\n", zName, sqlite3ErrName(rc)));+ return rc;+ }+ if( isTemp ){+ pFile->zDeleteOnClose = zConverted;+ }else+#endif+ {+ sqlite3_free(zConverted);+ }++ sqlite3_free(zTmpname);+ pFile->pMethod = &winIoMethod;+ pFile->pVfs = pVfs;+ pFile->h = h;+ if( isReadonly ){+ pFile->ctrlFlags |= WINFILE_RDONLY;+ }+ pFile->lastErrno = NO_ERROR;+ pFile->zPath = zName;+#if SQLITE_MAX_MMAP_SIZE>0+ pFile->hMap = NULL;+ pFile->pMapRegion = 0;+ pFile->mmapSize = 0;+ pFile->mmapSizeActual = 0;+ pFile->mmapSizeMax = sqlite3GlobalConfig.szMmap;+#endif++ OpenCounter(+1);+ return rc;+}++/*+** Delete the named file.+**+** Note that Windows does not allow a file to be deleted if some other+** process has it open. Sometimes a virus scanner or indexing program+** will open a journal file shortly after it is created in order to do+** whatever it does. While this other process is holding the+** file open, we will be unable to delete it. To work around this+** problem, we delay 100 milliseconds and try to delete again. Up+** to MX_DELETION_ATTEMPTs deletion attempts are run before giving+** up and returning an error.+*/+static int winDelete(+ sqlite3_vfs *pVfs, /* Not used on win32 */+ const char *zFilename, /* Name of file to delete */+ int syncDir /* Not used on win32 */+){+ int cnt = 0;+ int rc;+ DWORD attr;+ DWORD lastErrno = 0;+ void *zConverted;+ UNUSED_PARAMETER(pVfs);+ UNUSED_PARAMETER(syncDir);++ SimulateIOError(return SQLITE_IOERR_DELETE);+ OSTRACE(("DELETE name=%s, syncDir=%d\n", zFilename, syncDir));++ zConverted = winConvertFromUtf8Filename(zFilename);+ if( zConverted==0 ){+ OSTRACE(("DELETE name=%s, rc=SQLITE_IOERR_NOMEM\n", zFilename));+ return SQLITE_IOERR_NOMEM;+ }+ if( osIsNT() ){+ do {+#if SQLITE_OS_WINRT+ WIN32_FILE_ATTRIBUTE_DATA sAttrData;+ memset(&sAttrData, 0, sizeof(sAttrData));+ if ( osGetFileAttributesExW(zConverted, GetFileExInfoStandard,+ &sAttrData) ){+ attr = sAttrData.dwFileAttributes;+ }else{+ lastErrno = osGetLastError();+ if( lastErrno==ERROR_FILE_NOT_FOUND+ || lastErrno==ERROR_PATH_NOT_FOUND ){+ rc = SQLITE_IOERR_DELETE_NOENT; /* Already gone? */+ }else{+ rc = SQLITE_ERROR;+ }+ break;+ }+#else+ attr = osGetFileAttributesW(zConverted);+#endif+ if ( attr==INVALID_FILE_ATTRIBUTES ){+ lastErrno = osGetLastError();+ if( lastErrno==ERROR_FILE_NOT_FOUND+ || lastErrno==ERROR_PATH_NOT_FOUND ){+ rc = SQLITE_IOERR_DELETE_NOENT; /* Already gone? */+ }else{+ rc = SQLITE_ERROR;+ }+ break;+ }+ if ( attr&FILE_ATTRIBUTE_DIRECTORY ){+ rc = SQLITE_ERROR; /* Files only. */+ break;+ }+ if ( osDeleteFileW(zConverted) ){+ rc = SQLITE_OK; /* Deleted OK. */+ break;+ }+ if ( !winRetryIoerr(&cnt, &lastErrno) ){+ rc = SQLITE_ERROR; /* No more retries. */+ break;+ }+ } while(1);+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ do {+ attr = osGetFileAttributesA(zConverted);+ if ( attr==INVALID_FILE_ATTRIBUTES ){+ lastErrno = osGetLastError();+ if( lastErrno==ERROR_FILE_NOT_FOUND+ || lastErrno==ERROR_PATH_NOT_FOUND ){+ rc = SQLITE_IOERR_DELETE_NOENT; /* Already gone? */+ }else{+ rc = SQLITE_ERROR;+ }+ break;+ }+ if ( attr&FILE_ATTRIBUTE_DIRECTORY ){+ rc = SQLITE_ERROR; /* Files only. */+ break;+ }+ if ( osDeleteFileA(zConverted) ){+ rc = SQLITE_OK; /* Deleted OK. */+ break;+ }+ if ( !winRetryIoerr(&cnt, &lastErrno) ){+ rc = SQLITE_ERROR; /* No more retries. */+ break;+ }+ } while(1);+ }+#endif+ if( rc && rc!=SQLITE_IOERR_DELETE_NOENT ){+ rc = winLogError(SQLITE_IOERR_DELETE, lastErrno, "winDelete", zFilename);+ }else{+ winLogIoerr(cnt, __LINE__);+ }+ sqlite3_free(zConverted);+ OSTRACE(("DELETE name=%s, rc=%s\n", zFilename, sqlite3ErrName(rc)));+ return rc;+}++/*+** Check the existence and status of a file.+*/+static int winAccess(+ sqlite3_vfs *pVfs, /* Not used on win32 */+ const char *zFilename, /* Name of file to check */+ int flags, /* Type of test to make on this file */+ int *pResOut /* OUT: Result */+){+ DWORD attr;+ int rc = 0;+ DWORD lastErrno = 0;+ void *zConverted;+ UNUSED_PARAMETER(pVfs);++ SimulateIOError( return SQLITE_IOERR_ACCESS; );+ OSTRACE(("ACCESS name=%s, flags=%x, pResOut=%p\n",+ zFilename, flags, pResOut));++ zConverted = winConvertFromUtf8Filename(zFilename);+ if( zConverted==0 ){+ OSTRACE(("ACCESS name=%s, rc=SQLITE_IOERR_NOMEM\n", zFilename));+ return SQLITE_IOERR_NOMEM;+ }+ if( osIsNT() ){+ int cnt = 0;+ WIN32_FILE_ATTRIBUTE_DATA sAttrData;+ memset(&sAttrData, 0, sizeof(sAttrData));+ while( !(rc = osGetFileAttributesExW((LPCWSTR)zConverted,+ GetFileExInfoStandard,+ &sAttrData)) && winRetryIoerr(&cnt, &lastErrno) ){}+ if( rc ){+ /* For an SQLITE_ACCESS_EXISTS query, treat a zero-length file+ ** as if it does not exist.+ */+ if( flags==SQLITE_ACCESS_EXISTS+ && sAttrData.nFileSizeHigh==0+ && sAttrData.nFileSizeLow==0 ){+ attr = INVALID_FILE_ATTRIBUTES;+ }else{+ attr = sAttrData.dwFileAttributes;+ }+ }else{+ winLogIoerr(cnt, __LINE__);+ if( lastErrno!=ERROR_FILE_NOT_FOUND && lastErrno!=ERROR_PATH_NOT_FOUND ){+ sqlite3_free(zConverted);+ return winLogError(SQLITE_IOERR_ACCESS, lastErrno, "winAccess",+ zFilename);+ }else{+ attr = INVALID_FILE_ATTRIBUTES;+ }+ }+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ attr = osGetFileAttributesA((char*)zConverted);+ }+#endif+ sqlite3_free(zConverted);+ switch( flags ){+ case SQLITE_ACCESS_READ:+ case SQLITE_ACCESS_EXISTS:+ rc = attr!=INVALID_FILE_ATTRIBUTES;+ break;+ case SQLITE_ACCESS_READWRITE:+ rc = attr!=INVALID_FILE_ATTRIBUTES &&+ (attr & FILE_ATTRIBUTE_READONLY)==0;+ break;+ default:+ assert(!"Invalid flags argument");+ }+ *pResOut = rc;+ OSTRACE(("ACCESS name=%s, pResOut=%p, *pResOut=%d, rc=SQLITE_OK\n",+ zFilename, pResOut, *pResOut));+ return SQLITE_OK;+}++/*+** Returns non-zero if the specified path name starts with a drive letter+** followed by a colon character.+*/+static BOOL winIsDriveLetterAndColon(+ const char *zPathname+){+ return ( sqlite3Isalpha(zPathname[0]) && zPathname[1]==':' );+}++/*+** Turn a relative pathname into a full pathname. Write the full+** pathname into zOut[]. zOut[] will be at least pVfs->mxPathname+** bytes in size.+*/+static int winFullPathname(+ sqlite3_vfs *pVfs, /* Pointer to vfs object */+ const char *zRelative, /* Possibly relative input path */+ int nFull, /* Size of output buffer in bytes */+ char *zFull /* Output buffer */+){++#if defined(__CYGWIN__)+ SimulateIOError( return SQLITE_ERROR );+ UNUSED_PARAMETER(nFull);+ assert( nFull>=pVfs->mxPathname );+ char *zOut = sqlite3MallocZero( pVfs->mxPathname+1 );+ if( !zOut ){+ return SQLITE_IOERR_NOMEM;+ }+ if( cygwin_conv_path(+ (osIsNT() ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_A),+ zRelative, zOut, pVfs->mxPathname+1)<0 ){+ sqlite3_free(zOut);+ return winLogError(SQLITE_CANTOPEN_CONVPATH, (DWORD)errno,+ "winFullPathname2", zRelative);+ }else{+ char *zUtf8 = winConvertToUtf8Filename(zOut);+ if( !zUtf8 ){+ sqlite3_free(zOut);+ return SQLITE_IOERR_NOMEM;+ }+ sqlite3_snprintf(MIN(nFull, pVfs->mxPathname), zFull, "%s", zUtf8);+ sqlite3_free(zUtf8);+ sqlite3_free(zOut);+ }+ return SQLITE_OK;+#endif++#if (SQLITE_OS_WINCE || SQLITE_OS_WINRT) && !defined(__CYGWIN__)+ SimulateIOError( return SQLITE_ERROR );+ /* WinCE has no concept of a relative pathname, or so I am told. */+ /* WinRT has no way to convert a relative path to an absolute one. */+ sqlite3_snprintf(MIN(nFull, pVfs->mxPathname), zFull, "%s", zRelative);+ return SQLITE_OK;+#endif++#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && !defined(__CYGWIN__)+ DWORD nByte;+ void *zConverted;+ char *zOut;++ /* If this path name begins with "/X:", where "X" is any alphabetic+ ** character, discard the initial "/" from the pathname.+ */+ if( zRelative[0]=='/' && winIsDriveLetterAndColon(zRelative+1) ){+ zRelative++;+ }++ /* It's odd to simulate an io-error here, but really this is just+ ** using the io-error infrastructure to test that SQLite handles this+ ** function failing. This function could fail if, for example, the+ ** current working directory has been unlinked.+ */+ SimulateIOError( return SQLITE_ERROR );+ zConverted = winConvertFromUtf8Filename(zRelative);+ if( zConverted==0 ){+ return SQLITE_IOERR_NOMEM;+ }+ if( osIsNT() ){+ LPWSTR zTemp;+ nByte = osGetFullPathNameW((LPCWSTR)zConverted, 0, 0, 0);+ if( nByte==0 ){+ sqlite3_free(zConverted);+ return winLogError(SQLITE_CANTOPEN_FULLPATH, osGetLastError(),+ "winFullPathname1", zRelative);+ }+ nByte += 3;+ zTemp = sqlite3MallocZero( nByte*sizeof(zTemp[0]) );+ if( zTemp==0 ){+ sqlite3_free(zConverted);+ return SQLITE_IOERR_NOMEM;+ }+ nByte = osGetFullPathNameW((LPCWSTR)zConverted, nByte, zTemp, 0);+ if( nByte==0 ){+ sqlite3_free(zConverted);+ sqlite3_free(zTemp);+ return winLogError(SQLITE_CANTOPEN_FULLPATH, osGetLastError(),+ "winFullPathname2", zRelative);+ }+ sqlite3_free(zConverted);+ zOut = winUnicodeToUtf8(zTemp);+ sqlite3_free(zTemp);+ }+#ifdef SQLITE_WIN32_HAS_ANSI+ else{+ char *zTemp;+ nByte = osGetFullPathNameA((char*)zConverted, 0, 0, 0);+ if( nByte==0 ){+ sqlite3_free(zConverted);+ return winLogError(SQLITE_CANTOPEN_FULLPATH, osGetLastError(),+ "winFullPathname3", zRelative);+ }+ nByte += 3;+ zTemp = sqlite3MallocZero( nByte*sizeof(zTemp[0]) );+ if( zTemp==0 ){+ sqlite3_free(zConverted);+ return SQLITE_IOERR_NOMEM;+ }+ nByte = osGetFullPathNameA((char*)zConverted, nByte, zTemp, 0);+ if( nByte==0 ){+ sqlite3_free(zConverted);+ sqlite3_free(zTemp);+ return winLogError(SQLITE_CANTOPEN_FULLPATH, osGetLastError(),+ "winFullPathname4", zRelative);+ }+ sqlite3_free(zConverted);+ zOut = sqlite3_win32_mbcs_to_utf8(zTemp);+ sqlite3_free(zTemp);+ }+#endif+ if( zOut ){+ sqlite3_snprintf(MIN(nFull, pVfs->mxPathname), zFull, "%s", zOut);+ sqlite3_free(zOut);+ return SQLITE_OK;+ }else{+ return SQLITE_IOERR_NOMEM;+ }+#endif+}++ #define winDlOpen 0+ #define winDlError 0+ #define winDlSym 0+ #define winDlClose 0+++/*+** Write up to nBuf bytes of randomness into zBuf.+*/+static int winRandomness(sqlite3_vfs *pVfs, int nBuf, char *zBuf){+ int n = 0;+ UNUSED_PARAMETER(pVfs);+#if defined(SQLITE_TEST) || defined(SQLITE_OMIT_RANDOMNESS)+ n = nBuf;+ memset(zBuf, 0, nBuf);+#else+ if( sizeof(SYSTEMTIME)<=nBuf-n ){+ SYSTEMTIME x;+ osGetSystemTime(&x);+ memcpy(&zBuf[n], &x, sizeof(x));+ n += sizeof(x);+ }+ if( sizeof(DWORD)<=nBuf-n ){+ DWORD pid = osGetCurrentProcessId();+ memcpy(&zBuf[n], &pid, sizeof(pid));+ n += sizeof(pid);+ }+#if SQLITE_OS_WINRT+ if( sizeof(ULONGLONG)<=nBuf-n ){+ ULONGLONG cnt = osGetTickCount64();+ memcpy(&zBuf[n], &cnt, sizeof(cnt));+ n += sizeof(cnt);+ }+#else+ if( sizeof(DWORD)<=nBuf-n ){+ DWORD cnt = osGetTickCount();+ memcpy(&zBuf[n], &cnt, sizeof(cnt));+ n += sizeof(cnt);+ }+#endif+ if( sizeof(LARGE_INTEGER)<=nBuf-n ){+ LARGE_INTEGER i;+ osQueryPerformanceCounter(&i);+ memcpy(&zBuf[n], &i, sizeof(i));+ n += sizeof(i);+ }+#if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT && SQLITE_WIN32_USE_UUID+ if( sizeof(UUID)<=nBuf-n ){+ UUID id;+ memset(&id, 0, sizeof(UUID));+ osUuidCreate(&id);+ memcpy(&zBuf[n], &id, sizeof(UUID));+ n += sizeof(UUID);+ }+ if( sizeof(UUID)<=nBuf-n ){+ UUID id;+ memset(&id, 0, sizeof(UUID));+ osUuidCreateSequential(&id);+ memcpy(&zBuf[n], &id, sizeof(UUID));+ n += sizeof(UUID);+ }+#endif+#endif /* defined(SQLITE_TEST) || defined(SQLITE_ZERO_PRNG_SEED) */+ return n;+}+++/*+** Sleep for a little while. Return the amount of time slept.+*/+static int winSleep(sqlite3_vfs *pVfs, int microsec){+ sqlite3_win32_sleep((microsec+999)/1000);+ UNUSED_PARAMETER(pVfs);+ return ((microsec+999)/1000)*1000;+}++/*+** The following variable, if set to a non-zero value, is interpreted as+** the number of seconds since 1970 and is used to set the result of+** sqlite3OsCurrentTime() during testing.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_current_time = 0; /* Fake system time in seconds since 1970. */+#endif++/*+** Find the current time (in Universal Coordinated Time). Write into *piNow+** the current time and date as a Julian Day number times 86_400_000. In+** other words, write into *piNow the number of milliseconds since the Julian+** epoch of noon in Greenwich on November 24, 4714 B.C according to the+** proleptic Gregorian calendar.+**+** On success, return SQLITE_OK. Return SQLITE_ERROR if the time and date+** cannot be found.+*/+static int winCurrentTimeInt64(sqlite3_vfs *pVfs, sqlite3_int64 *piNow){+ /* FILETIME structure is a 64-bit value representing the number of+ 100-nanosecond intervals since January 1, 1601 (= JD 2305813.5).+ */+ FILETIME ft;+ static const sqlite3_int64 winFiletimeEpoch = 23058135*(sqlite3_int64)8640000;+#ifdef SQLITE_TEST+ static const sqlite3_int64 unixEpoch = 24405875*(sqlite3_int64)8640000;+#endif+ /* 2^32 - to avoid use of LL and warnings in gcc */+ static const sqlite3_int64 max32BitValue =+ (sqlite3_int64)2000000000 + (sqlite3_int64)2000000000 ++ (sqlite3_int64)294967296;++#if SQLITE_OS_WINCE+ SYSTEMTIME time;+ osGetSystemTime(&time);+ /* if SystemTimeToFileTime() fails, it returns zero. */+ if (!osSystemTimeToFileTime(&time,&ft)){+ return SQLITE_ERROR;+ }+#else+ osGetSystemTimeAsFileTime( &ft );+#endif++ *piNow = winFiletimeEpoch ++ ((((sqlite3_int64)ft.dwHighDateTime)*max32BitValue) ++ (sqlite3_int64)ft.dwLowDateTime)/(sqlite3_int64)10000;++#ifdef SQLITE_TEST+ if( sqlite3_current_time ){+ *piNow = 1000*(sqlite3_int64)sqlite3_current_time + unixEpoch;+ }+#endif+ UNUSED_PARAMETER(pVfs);+ return SQLITE_OK;+}++/*+** Find the current time (in Universal Coordinated Time). Write the+** current time and date as a Julian Day number into *prNow and+** return 0. Return 1 if the time and date cannot be found.+*/+static int winCurrentTime(sqlite3_vfs *pVfs, double *prNow){+ int rc;+ sqlite3_int64 i;+ rc = winCurrentTimeInt64(pVfs, &i);+ if( !rc ){+ *prNow = i/86400000.0;+ }+ return rc;+}++/*+** The idea is that this function works like a combination of+** GetLastError() and FormatMessage() on Windows (or errno and+** strerror_r() on Unix). After an error is returned by an OS+** function, SQLite calls this function with zBuf pointing to+** a buffer of nBuf bytes. The OS layer should populate the+** buffer with a nul-terminated UTF-8 encoded error message+** describing the last IO error to have occurred within the calling+** thread.+**+** If the error message is too large for the supplied buffer,+** it should be truncated. The return value of xGetLastError+** is zero if the error message fits in the buffer, or non-zero+** otherwise (if the message was truncated). If non-zero is returned,+** then it is not necessary to include the nul-terminator character+** in the output buffer.+**+** Not supplying an error message will have no adverse effect+** on SQLite. It is fine to have an implementation that never+** returns an error message:+**+** int xGetLastError(sqlite3_vfs *pVfs, int nBuf, char *zBuf){+** assert(zBuf[0]=='\0');+** return 0;+** }+**+** However if an error message is supplied, it will be incorporated+** by sqlite into the error message available to the user using+** sqlite3_errmsg(), possibly making IO errors easier to debug.+*/+static int winGetLastError(sqlite3_vfs *pVfs, int nBuf, char *zBuf){+ UNUSED_PARAMETER(pVfs);+ return winGetLastErrorMsg(osGetLastError(), nBuf, zBuf);+}++/*+** Initialize and deinitialize the operating system interface.+*/+SQLITE_PRIVATE int sqlite3_os_init(void){+ static sqlite3_vfs winVfs = {+ 3, /* iVersion */+ sizeof(winFile), /* szOsFile */+ SQLITE_WIN32_MAX_PATH_BYTES, /* mxPathname */+ 0, /* pNext */+ "win32", /* zName */+ 0, /* pAppData */+ winOpen, /* xOpen */+ winDelete, /* xDelete */+ winAccess, /* xAccess */+ winFullPathname, /* xFullPathname */+ winDlOpen, /* xDlOpen */+ winDlError, /* xDlError */+ winDlSym, /* xDlSym */+ winDlClose, /* xDlClose */+ winRandomness, /* xRandomness */+ winSleep, /* xSleep */+ winCurrentTime, /* xCurrentTime */+ winGetLastError, /* xGetLastError */+ winCurrentTimeInt64, /* xCurrentTimeInt64 */+ winSetSystemCall, /* xSetSystemCall */+ winGetSystemCall, /* xGetSystemCall */+ winNextSystemCall, /* xNextSystemCall */+ };+#if defined(SQLITE_WIN32_HAS_WIDE)+ static sqlite3_vfs winLongPathVfs = {+ 3, /* iVersion */+ sizeof(winFile), /* szOsFile */+ SQLITE_WINNT_MAX_PATH_BYTES, /* mxPathname */+ 0, /* pNext */+ "win32-longpath", /* zName */+ 0, /* pAppData */+ winOpen, /* xOpen */+ winDelete, /* xDelete */+ winAccess, /* xAccess */+ winFullPathname, /* xFullPathname */+ winDlOpen, /* xDlOpen */+ winDlError, /* xDlError */+ winDlSym, /* xDlSym */+ winDlClose, /* xDlClose */+ winRandomness, /* xRandomness */+ winSleep, /* xSleep */+ winCurrentTime, /* xCurrentTime */+ winGetLastError, /* xGetLastError */+ winCurrentTimeInt64, /* xCurrentTimeInt64 */+ winSetSystemCall, /* xSetSystemCall */+ winGetSystemCall, /* xGetSystemCall */+ winNextSystemCall, /* xNextSystemCall */+ };+#endif++ /* Double-check that the aSyscall[] array has been constructed+ ** correctly. See ticket [bb3a86e890c8e96ab] */+ assert( ArraySize(aSyscall)==80 );++ /* get memory map allocation granularity */+ memset(&winSysInfo, 0, sizeof(SYSTEM_INFO));+#if SQLITE_OS_WINRT+ osGetNativeSystemInfo(&winSysInfo);+#else+ osGetSystemInfo(&winSysInfo);+#endif+ assert( winSysInfo.dwAllocationGranularity>0 );+ assert( winSysInfo.dwPageSize>0 );++ sqlite3_vfs_register(&winVfs, 1);++#if defined(SQLITE_WIN32_HAS_WIDE)+ sqlite3_vfs_register(&winLongPathVfs, 0);+#endif++ return SQLITE_OK;+}++SQLITE_PRIVATE int sqlite3_os_end(void){+#if SQLITE_OS_WINRT+ if( sleepObj!=NULL ){+ osCloseHandle(sleepObj);+ sleepObj = NULL;+ }+#endif+ return SQLITE_OK;+}++#endif /* SQLITE_OS_WIN */++/************** End of os_win.c **********************************************/+/************** Begin file bitvec.c ******************************************/+/*+** 2008 February 16+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file implements an object that represents a fixed-length+** bitmap. Bits are numbered starting with 1.+**+** A bitmap is used to record which pages of a database file have been+** journalled during a transaction, or which pages have the "dont-write"+** property. Usually only a few pages are meet either condition.+** So the bitmap is usually sparse and has low cardinality.+** But sometimes (for example when during a DROP of a large table) most+** or all of the pages in a database can get journalled. In those cases, +** the bitmap becomes dense with high cardinality. The algorithm needs +** to handle both cases well.+**+** The size of the bitmap is fixed when the object is created.+**+** All bits are clear when the bitmap is created. Individual bits+** may be set or cleared one at a time.+**+** Test operations are about 100 times more common that set operations.+** Clear operations are exceedingly rare. There are usually between+** 5 and 500 set operations per Bitvec object, though the number of sets can+** sometimes grow into tens of thousands or larger. The size of the+** Bitvec object is the number of pages in the database file at the+** start of a transaction, and is thus usually less than a few thousand,+** but can be as large as 2 billion for a really big database.+*/+/* #include "sqliteInt.h" */++/* Size of the Bitvec structure in bytes. */+#define BITVEC_SZ 512++/* Round the union size down to the nearest pointer boundary, since that's how +** it will be aligned within the Bitvec struct. */+#define BITVEC_USIZE (((BITVEC_SZ-(3*sizeof(u32)))/sizeof(Bitvec*))*sizeof(Bitvec*))++/* Type of the array "element" for the bitmap representation. +** Should be a power of 2, and ideally, evenly divide into BITVEC_USIZE. +** Setting this to the "natural word" size of your CPU may improve+** performance. */+#define BITVEC_TELEM u8+/* Size, in bits, of the bitmap element. */+#define BITVEC_SZELEM 8+/* Number of elements in a bitmap array. */+#define BITVEC_NELEM (BITVEC_USIZE/sizeof(BITVEC_TELEM))+/* Number of bits in the bitmap array. */+#define BITVEC_NBIT (BITVEC_NELEM*BITVEC_SZELEM)++/* Number of u32 values in hash table. */+#define BITVEC_NINT (BITVEC_USIZE/sizeof(u32))+/* Maximum number of entries in hash table before +** sub-dividing and re-hashing. */+#define BITVEC_MXHASH (BITVEC_NINT/2)+/* Hashing function for the aHash representation.+** Empirical testing showed that the *37 multiplier +** (an arbitrary prime)in the hash function provided +** no fewer collisions than the no-op *1. */+#define BITVEC_HASH(X) (((X)*1)%BITVEC_NINT)++#define BITVEC_NPTR (BITVEC_USIZE/sizeof(Bitvec *))+++/*+** A bitmap is an instance of the following structure.+**+** This bitmap records the existence of zero or more bits+** with values between 1 and iSize, inclusive.+**+** There are three possible representations of the bitmap.+** If iSize<=BITVEC_NBIT, then Bitvec.u.aBitmap[] is a straight+** bitmap. The least significant bit is bit 1.+**+** If iSize>BITVEC_NBIT and iDivisor==0 then Bitvec.u.aHash[] is+** a hash table that will hold up to BITVEC_MXHASH distinct values.+**+** Otherwise, the value i is redirected into one of BITVEC_NPTR+** sub-bitmaps pointed to by Bitvec.u.apSub[]. Each subbitmap+** handles up to iDivisor separate values of i. apSub[0] holds+** values between 1 and iDivisor. apSub[1] holds values between+** iDivisor+1 and 2*iDivisor. apSub[N] holds values between+** N*iDivisor+1 and (N+1)*iDivisor. Each subbitmap is normalized+** to hold deal with values between 1 and iDivisor.+*/+struct Bitvec {+ u32 iSize; /* Maximum bit index. Max iSize is 4,294,967,296. */+ u32 nSet; /* Number of bits that are set - only valid for aHash+ ** element. Max is BITVEC_NINT. For BITVEC_SZ of 512,+ ** this would be 125. */+ u32 iDivisor; /* Number of bits handled by each apSub[] entry. */+ /* Should >=0 for apSub element. */+ /* Max iDivisor is max(u32) / BITVEC_NPTR + 1. */+ /* For a BITVEC_SZ of 512, this would be 34,359,739. */+ union {+ BITVEC_TELEM aBitmap[BITVEC_NELEM]; /* Bitmap representation */+ u32 aHash[BITVEC_NINT]; /* Hash table representation */+ Bitvec *apSub[BITVEC_NPTR]; /* Recursive representation */+ } u;+};++/*+** Create a new bitmap object able to handle bits between 0 and iSize,+** inclusive. Return a pointer to the new object. Return NULL if +** malloc fails.+*/+SQLITE_PRIVATE Bitvec *sqlite3BitvecCreate(u32 iSize){+ Bitvec *p;+ assert( sizeof(*p)==BITVEC_SZ );+ p = sqlite3MallocZero( sizeof(*p) );+ if( p ){+ p->iSize = iSize;+ }+ return p;+}++/*+** Check to see if the i-th bit is set. Return true or false.+** If p is NULL (if the bitmap has not been created) or if+** i is out of range, then return false.+*/+SQLITE_PRIVATE int sqlite3BitvecTestNotNull(Bitvec *p, u32 i){+ assert( p!=0 );+ i--;+ if( i>=p->iSize ) return 0;+ while( p->iDivisor ){+ u32 bin = i/p->iDivisor;+ i = i%p->iDivisor;+ p = p->u.apSub[bin];+ if (!p) {+ return 0;+ }+ }+ if( p->iSize<=BITVEC_NBIT ){+ return (p->u.aBitmap[i/BITVEC_SZELEM] & (1<<(i&(BITVEC_SZELEM-1))))!=0;+ } else{+ u32 h = BITVEC_HASH(i++);+ while( p->u.aHash[h] ){+ if( p->u.aHash[h]==i ) return 1;+ h = (h+1) % BITVEC_NINT;+ }+ return 0;+ }+}+SQLITE_PRIVATE int sqlite3BitvecTest(Bitvec *p, u32 i){+ return p!=0 && sqlite3BitvecTestNotNull(p,i);+}++/*+** Set the i-th bit. Return 0 on success and an error code if+** anything goes wrong.+**+** This routine might cause sub-bitmaps to be allocated. Failing+** to get the memory needed to hold the sub-bitmap is the only+** that can go wrong with an insert, assuming p and i are valid.+**+** The calling function must ensure that p is a valid Bitvec object+** and that the value for "i" is within range of the Bitvec object.+** Otherwise the behavior is undefined.+*/+SQLITE_PRIVATE int sqlite3BitvecSet(Bitvec *p, u32 i){+ u32 h;+ if( p==0 ) return SQLITE_OK;+ assert( i>0 );+ assert( i<=p->iSize );+ i--;+ while((p->iSize > BITVEC_NBIT) && p->iDivisor) {+ u32 bin = i/p->iDivisor;+ i = i%p->iDivisor;+ if( p->u.apSub[bin]==0 ){+ p->u.apSub[bin] = sqlite3BitvecCreate( p->iDivisor );+ if( p->u.apSub[bin]==0 ) return SQLITE_NOMEM;+ }+ p = p->u.apSub[bin];+ }+ if( p->iSize<=BITVEC_NBIT ){+ p->u.aBitmap[i/BITVEC_SZELEM] |= 1 << (i&(BITVEC_SZELEM-1));+ return SQLITE_OK;+ }+ h = BITVEC_HASH(i++);+ /* if there wasn't a hash collision, and this doesn't */+ /* completely fill the hash, then just add it without */+ /* worring about sub-dividing and re-hashing. */+ if( !p->u.aHash[h] ){+ if (p->nSet<(BITVEC_NINT-1)) {+ goto bitvec_set_end;+ } else {+ goto bitvec_set_rehash;+ }+ }+ /* there was a collision, check to see if it's already */+ /* in hash, if not, try to find a spot for it */+ do {+ if( p->u.aHash[h]==i ) return SQLITE_OK;+ h++;+ if( h>=BITVEC_NINT ) h = 0;+ } while( p->u.aHash[h] );+ /* we didn't find it in the hash. h points to the first */+ /* available free spot. check to see if this is going to */+ /* make our hash too "full". */+bitvec_set_rehash:+ if( p->nSet>=BITVEC_MXHASH ){+ unsigned int j;+ int rc;+ u32 *aiValues = sqlite3StackAllocRaw(0, sizeof(p->u.aHash));+ if( aiValues==0 ){+ return SQLITE_NOMEM;+ }else{+ memcpy(aiValues, p->u.aHash, sizeof(p->u.aHash));+ memset(p->u.apSub, 0, sizeof(p->u.apSub));+ p->iDivisor = (p->iSize + BITVEC_NPTR - 1)/BITVEC_NPTR;+ rc = sqlite3BitvecSet(p, i);+ for(j=0; j<BITVEC_NINT; j++){+ if( aiValues[j] ) rc |= sqlite3BitvecSet(p, aiValues[j]);+ }+ sqlite3StackFree(0, aiValues);+ return rc;+ }+ }+bitvec_set_end:+ p->nSet++;+ p->u.aHash[h] = i;+ return SQLITE_OK;+}++/*+** Clear the i-th bit.+**+** pBuf must be a pointer to at least BITVEC_SZ bytes of temporary storage+** that BitvecClear can use to rebuilt its hash table.+*/+SQLITE_PRIVATE void sqlite3BitvecClear(Bitvec *p, u32 i, void *pBuf){+ if( p==0 ) return;+ assert( i>0 );+ i--;+ while( p->iDivisor ){+ u32 bin = i/p->iDivisor;+ i = i%p->iDivisor;+ p = p->u.apSub[bin];+ if (!p) {+ return;+ }+ }+ if( p->iSize<=BITVEC_NBIT ){+ p->u.aBitmap[i/BITVEC_SZELEM] &= ~(1 << (i&(BITVEC_SZELEM-1)));+ }else{+ unsigned int j;+ u32 *aiValues = pBuf;+ memcpy(aiValues, p->u.aHash, sizeof(p->u.aHash));+ memset(p->u.aHash, 0, sizeof(p->u.aHash));+ p->nSet = 0;+ for(j=0; j<BITVEC_NINT; j++){+ if( aiValues[j] && aiValues[j]!=(i+1) ){+ u32 h = BITVEC_HASH(aiValues[j]-1);+ p->nSet++;+ while( p->u.aHash[h] ){+ h++;+ if( h>=BITVEC_NINT ) h = 0;+ }+ p->u.aHash[h] = aiValues[j];+ }+ }+ }+}++/*+** Destroy a bitmap object. Reclaim all memory used.+*/+SQLITE_PRIVATE void sqlite3BitvecDestroy(Bitvec *p){+ if( p==0 ) return;+ if( p->iDivisor ){+ unsigned int i;+ for(i=0; i<BITVEC_NPTR; i++){+ sqlite3BitvecDestroy(p->u.apSub[i]);+ }+ }+ sqlite3_free(p);+}++/*+** Return the value of the iSize parameter specified when Bitvec *p+** was created.+*/+SQLITE_PRIVATE u32 sqlite3BitvecSize(Bitvec *p){+ return p->iSize;+}++/************** End of bitvec.c **********************************************/+/************** Begin file pcache.c ******************************************/+/*+** 2008 August 05+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file implements that page cache.+*/+/* #include "sqliteInt.h" */++/*+** A complete page cache is an instance of this structure.+*/+struct PCache {+ PgHdr *pDirty, *pDirtyTail; /* List of dirty pages in LRU order */+ PgHdr *pSynced; /* Last synced page in dirty page list */+ int nRefSum; /* Sum of ref counts over all pages */+ int szCache; /* Configured cache size */+ int szPage; /* Size of every page in this cache */+ int szExtra; /* Size of extra space for each page */+ u8 bPurgeable; /* True if pages are on backing store */+ u8 eCreate; /* eCreate value for for xFetch() */+ int (*xStress)(void*,PgHdr*); /* Call to try make a page clean */+ void *pStress; /* Argument to xStress */+ sqlite3_pcache *pCache; /* Pluggable cache module */+};++/********************************** Linked List Management ********************/++/* Allowed values for second argument to pcacheManageDirtyList() */+#define PCACHE_DIRTYLIST_REMOVE 1 /* Remove pPage from dirty list */+#define PCACHE_DIRTYLIST_ADD 2 /* Add pPage to the dirty list */+#define PCACHE_DIRTYLIST_FRONT 3 /* Move pPage to the front of the list */++/*+** Manage pPage's participation on the dirty list. Bits of the addRemove+** argument determines what operation to do. The 0x01 bit means first+** remove pPage from the dirty list. The 0x02 means add pPage back to+** the dirty list. Doing both moves pPage to the front of the dirty list.+*/+static void pcacheManageDirtyList(PgHdr *pPage, u8 addRemove){+ PCache *p = pPage->pCache;++ if( addRemove & PCACHE_DIRTYLIST_REMOVE ){+ assert( pPage->pDirtyNext || pPage==p->pDirtyTail );+ assert( pPage->pDirtyPrev || pPage==p->pDirty );+ + /* Update the PCache1.pSynced variable if necessary. */+ if( p->pSynced==pPage ){+ PgHdr *pSynced = pPage->pDirtyPrev;+ while( pSynced && (pSynced->flags&PGHDR_NEED_SYNC) ){+ pSynced = pSynced->pDirtyPrev;+ }+ p->pSynced = pSynced;+ }+ + if( pPage->pDirtyNext ){+ pPage->pDirtyNext->pDirtyPrev = pPage->pDirtyPrev;+ }else{+ assert( pPage==p->pDirtyTail );+ p->pDirtyTail = pPage->pDirtyPrev;+ }+ if( pPage->pDirtyPrev ){+ pPage->pDirtyPrev->pDirtyNext = pPage->pDirtyNext;+ }else{+ assert( pPage==p->pDirty );+ p->pDirty = pPage->pDirtyNext;+ if( p->pDirty==0 && p->bPurgeable ){+ assert( p->eCreate==1 );+ p->eCreate = 2;+ }+ }+ pPage->pDirtyNext = 0;+ pPage->pDirtyPrev = 0;+ }+ if( addRemove & PCACHE_DIRTYLIST_ADD ){+ assert( pPage->pDirtyNext==0 && pPage->pDirtyPrev==0 && p->pDirty!=pPage );+ + pPage->pDirtyNext = p->pDirty;+ if( pPage->pDirtyNext ){+ assert( pPage->pDirtyNext->pDirtyPrev==0 );+ pPage->pDirtyNext->pDirtyPrev = pPage;+ }else{+ p->pDirtyTail = pPage;+ if( p->bPurgeable ){+ assert( p->eCreate==2 );+ p->eCreate = 1;+ }+ }+ p->pDirty = pPage;+ if( !p->pSynced && 0==(pPage->flags&PGHDR_NEED_SYNC) ){+ p->pSynced = pPage;+ }+ }+}++/*+** Wrapper around the pluggable caches xUnpin method. If the cache is+** being used for an in-memory database, this function is a no-op.+*/+static void pcacheUnpin(PgHdr *p){+ if( p->pCache->bPurgeable ){+ sqlite3GlobalConfig.pcache2.xUnpin(p->pCache->pCache, p->pPage, 0);+ }+}++/*+** Compute the number of pages of cache requested. p->szCache is the+** cache size requested by the "PRAGMA cache_size" statement.+**+**+*/+static int numberOfCachePages(PCache *p){+ if( p->szCache>=0 ){+ /* IMPLEMENTATION-OF: R-42059-47211 If the argument N is positive then the+ ** suggested cache size is set to N. */+ return p->szCache;+ }else{+ /* IMPLEMENTATION-OF: R-61436-13639 If the argument N is negative, then+ ** the number of cache pages is adjusted to use approximately abs(N*1024)+ ** bytes of memory. */+ return (int)((-1024*(i64)p->szCache)/(p->szPage+p->szExtra));+ }+}++/*************************************************** General Interfaces ******+**+** Initialize and shutdown the page cache subsystem. Neither of these +** functions are threadsafe.+*/+SQLITE_PRIVATE int sqlite3PcacheInitialize(void){+ if( sqlite3GlobalConfig.pcache2.xInit==0 ){+ /* IMPLEMENTATION-OF: R-26801-64137 If the xInit() method is NULL, then the+ ** built-in default page cache is used instead of the application defined+ ** page cache. */+ sqlite3PCacheSetDefault();+ }+ return sqlite3GlobalConfig.pcache2.xInit(sqlite3GlobalConfig.pcache2.pArg);+}+SQLITE_PRIVATE void sqlite3PcacheShutdown(void){+ if( sqlite3GlobalConfig.pcache2.xShutdown ){+ /* IMPLEMENTATION-OF: R-26000-56589 The xShutdown() method may be NULL. */+ sqlite3GlobalConfig.pcache2.xShutdown(sqlite3GlobalConfig.pcache2.pArg);+ }+}++/*+** Return the size in bytes of a PCache object.+*/+SQLITE_PRIVATE int sqlite3PcacheSize(void){ return sizeof(PCache); }++/*+** Create a new PCache object. Storage space to hold the object+** has already been allocated and is passed in as the p pointer. +** The caller discovers how much space needs to be allocated by +** calling sqlite3PcacheSize().+*/+SQLITE_PRIVATE int sqlite3PcacheOpen(+ int szPage, /* Size of every page */+ int szExtra, /* Extra space associated with each page */+ int bPurgeable, /* True if pages are on backing store */+ int (*xStress)(void*,PgHdr*),/* Call to try to make pages clean */+ void *pStress, /* Argument to xStress */+ PCache *p /* Preallocated space for the PCache */+){+ memset(p, 0, sizeof(PCache));+ p->szPage = 1;+ p->szExtra = szExtra;+ p->bPurgeable = bPurgeable;+ p->eCreate = 2;+ p->xStress = xStress;+ p->pStress = pStress;+ p->szCache = 100;+ return sqlite3PcacheSetPageSize(p, szPage);+}++/*+** Change the page size for PCache object. The caller must ensure that there+** are no outstanding page references when this function is called.+*/+SQLITE_PRIVATE int sqlite3PcacheSetPageSize(PCache *pCache, int szPage){+ assert( pCache->nRefSum==0 && pCache->pDirty==0 );+ if( pCache->szPage ){+ sqlite3_pcache *pNew;+ pNew = sqlite3GlobalConfig.pcache2.xCreate(+ szPage, pCache->szExtra + ROUND8(sizeof(PgHdr)),+ pCache->bPurgeable+ );+ if( pNew==0 ) return SQLITE_NOMEM;+ sqlite3GlobalConfig.pcache2.xCachesize(pNew, numberOfCachePages(pCache));+ if( pCache->pCache ){+ sqlite3GlobalConfig.pcache2.xDestroy(pCache->pCache);+ }+ pCache->pCache = pNew;+ pCache->szPage = szPage;+ }+ return SQLITE_OK;+}++/*+** Try to obtain a page from the cache.+**+** This routine returns a pointer to an sqlite3_pcache_page object if+** such an object is already in cache, or if a new one is created.+** This routine returns a NULL pointer if the object was not in cache+** and could not be created.+**+** The createFlags should be 0 to check for existing pages and should+** be 3 (not 1, but 3) to try to create a new page.+**+** If the createFlag is 0, then NULL is always returned if the page+** is not already in the cache. If createFlag is 1, then a new page+** is created only if that can be done without spilling dirty pages+** and without exceeding the cache size limit.+**+** The caller needs to invoke sqlite3PcacheFetchFinish() to properly+** initialize the sqlite3_pcache_page object and convert it into a+** PgHdr object. The sqlite3PcacheFetch() and sqlite3PcacheFetchFinish()+** routines are split this way for performance reasons. When separated+** they can both (usually) operate without having to push values to+** the stack on entry and pop them back off on exit, which saves a+** lot of pushing and popping.+*/+SQLITE_PRIVATE sqlite3_pcache_page *sqlite3PcacheFetch(+ PCache *pCache, /* Obtain the page from this cache */+ Pgno pgno, /* Page number to obtain */+ int createFlag /* If true, create page if it does not exist already */+){+ int eCreate;++ assert( pCache!=0 );+ assert( pCache->pCache!=0 );+ assert( createFlag==3 || createFlag==0 );+ assert( pgno>0 );++ /* eCreate defines what to do if the page does not exist.+ ** 0 Do not allocate a new page. (createFlag==0)+ ** 1 Allocate a new page if doing so is inexpensive.+ ** (createFlag==1 AND bPurgeable AND pDirty)+ ** 2 Allocate a new page even it doing so is difficult.+ ** (createFlag==1 AND !(bPurgeable AND pDirty)+ */+ eCreate = createFlag & pCache->eCreate;+ assert( eCreate==0 || eCreate==1 || eCreate==2 );+ assert( createFlag==0 || pCache->eCreate==eCreate );+ assert( createFlag==0 || eCreate==1+(!pCache->bPurgeable||!pCache->pDirty) );+ return sqlite3GlobalConfig.pcache2.xFetch(pCache->pCache, pgno, eCreate);+}++/*+** If the sqlite3PcacheFetch() routine is unable to allocate a new+** page because new clean pages are available for reuse and the cache+** size limit has been reached, then this routine can be invoked to +** try harder to allocate a page. This routine might invoke the stress+** callback to spill dirty pages to the journal. It will then try to+** allocate the new page and will only fail to allocate a new page on+** an OOM error.+**+** This routine should be invoked only after sqlite3PcacheFetch() fails.+*/+SQLITE_PRIVATE int sqlite3PcacheFetchStress(+ PCache *pCache, /* Obtain the page from this cache */+ Pgno pgno, /* Page number to obtain */+ sqlite3_pcache_page **ppPage /* Write result here */+){+ PgHdr *pPg;+ if( pCache->eCreate==2 ) return 0;+++ /* Find a dirty page to write-out and recycle. First try to find a + ** page that does not require a journal-sync (one with PGHDR_NEED_SYNC+ ** cleared), but if that is not possible settle for any other + ** unreferenced dirty page.+ */+ for(pPg=pCache->pSynced; + pPg && (pPg->nRef || (pPg->flags&PGHDR_NEED_SYNC)); + pPg=pPg->pDirtyPrev+ );+ pCache->pSynced = pPg;+ if( !pPg ){+ for(pPg=pCache->pDirtyTail; pPg && pPg->nRef; pPg=pPg->pDirtyPrev);+ }+ if( pPg ){+ int rc;+#ifdef SQLITE_LOG_CACHE_SPILL+ sqlite3_log(SQLITE_FULL, + "spill page %d making room for %d - cache used: %d/%d",+ pPg->pgno, pgno,+ sqlite3GlobalConfig.pcache.xPagecount(pCache->pCache),+ numberOfCachePages(pCache));+#endif+ rc = pCache->xStress(pCache->pStress, pPg);+ if( rc!=SQLITE_OK && rc!=SQLITE_BUSY ){+ return rc;+ }+ }+ *ppPage = sqlite3GlobalConfig.pcache2.xFetch(pCache->pCache, pgno, 2);+ return *ppPage==0 ? SQLITE_NOMEM : SQLITE_OK;+}++/*+** This is a helper routine for sqlite3PcacheFetchFinish()+**+** In the uncommon case where the page being fetched has not been+** initialized, this routine is invoked to do the initialization.+** This routine is broken out into a separate function since it+** requires extra stack manipulation that can be avoided in the common+** case.+*/+static SQLITE_NOINLINE PgHdr *pcacheFetchFinishWithInit(+ PCache *pCache, /* Obtain the page from this cache */+ Pgno pgno, /* Page number obtained */+ sqlite3_pcache_page *pPage /* Page obtained by prior PcacheFetch() call */+){+ PgHdr *pPgHdr;+ assert( pPage!=0 );+ pPgHdr = (PgHdr*)pPage->pExtra;+ assert( pPgHdr->pPage==0 );+ memset(pPgHdr, 0, sizeof(PgHdr));+ pPgHdr->pPage = pPage;+ pPgHdr->pData = pPage->pBuf;+ pPgHdr->pExtra = (void *)&pPgHdr[1];+ memset(pPgHdr->pExtra, 0, pCache->szExtra);+ pPgHdr->pCache = pCache;+ pPgHdr->pgno = pgno;+ pPgHdr->flags = PGHDR_CLEAN;+ return sqlite3PcacheFetchFinish(pCache,pgno,pPage);+}++/*+** This routine converts the sqlite3_pcache_page object returned by+** sqlite3PcacheFetch() into an initialized PgHdr object. This routine+** must be called after sqlite3PcacheFetch() in order to get a usable+** result.+*/+SQLITE_PRIVATE PgHdr *sqlite3PcacheFetchFinish(+ PCache *pCache, /* Obtain the page from this cache */+ Pgno pgno, /* Page number obtained */+ sqlite3_pcache_page *pPage /* Page obtained by prior PcacheFetch() call */+){+ PgHdr *pPgHdr;++ assert( pPage!=0 );+ pPgHdr = (PgHdr *)pPage->pExtra;++ if( !pPgHdr->pPage ){+ return pcacheFetchFinishWithInit(pCache, pgno, pPage);+ }+ pCache->nRefSum++;+ pPgHdr->nRef++;+ return pPgHdr;+}++/*+** Decrement the reference count on a page. If the page is clean and the+** reference count drops to 0, then it is made eligible for recycling.+*/+SQLITE_PRIVATE void SQLITE_NOINLINE sqlite3PcacheRelease(PgHdr *p){+ assert( p->nRef>0 );+ p->pCache->nRefSum--;+ if( (--p->nRef)==0 ){+ if( p->flags&PGHDR_CLEAN ){+ pcacheUnpin(p);+ }else if( p->pDirtyPrev!=0 ){+ /* Move the page to the head of the dirty list. */+ pcacheManageDirtyList(p, PCACHE_DIRTYLIST_FRONT);+ }+ }+}++/*+** Increase the reference count of a supplied page by 1.+*/+SQLITE_PRIVATE void sqlite3PcacheRef(PgHdr *p){+ assert(p->nRef>0);+ p->nRef++;+ p->pCache->nRefSum++;+}++/*+** Drop a page from the cache. There must be exactly one reference to the+** page. This function deletes that reference, so after it returns the+** page pointed to by p is invalid.+*/+SQLITE_PRIVATE void sqlite3PcacheDrop(PgHdr *p){+ assert( p->nRef==1 );+ if( p->flags&PGHDR_DIRTY ){+ pcacheManageDirtyList(p, PCACHE_DIRTYLIST_REMOVE);+ }+ p->pCache->nRefSum--;+ sqlite3GlobalConfig.pcache2.xUnpin(p->pCache->pCache, p->pPage, 1);+}++/*+** Make sure the page is marked as dirty. If it isn't dirty already,+** make it so.+*/+SQLITE_PRIVATE void sqlite3PcacheMakeDirty(PgHdr *p){+ assert( p->nRef>0 );+ if( p->flags & (PGHDR_CLEAN|PGHDR_DONT_WRITE) ){+ p->flags &= ~PGHDR_DONT_WRITE;+ if( p->flags & PGHDR_CLEAN ){+ p->flags ^= (PGHDR_DIRTY|PGHDR_CLEAN);+ assert( (p->flags & (PGHDR_DIRTY|PGHDR_CLEAN))==PGHDR_DIRTY );+ pcacheManageDirtyList(p, PCACHE_DIRTYLIST_ADD);+ }+ }+}++/*+** Make sure the page is marked as clean. If it isn't clean already,+** make it so.+*/+SQLITE_PRIVATE void sqlite3PcacheMakeClean(PgHdr *p){+ if( (p->flags & PGHDR_DIRTY) ){+ assert( (p->flags & PGHDR_CLEAN)==0 );+ pcacheManageDirtyList(p, PCACHE_DIRTYLIST_REMOVE);+ p->flags &= ~(PGHDR_DIRTY|PGHDR_NEED_SYNC|PGHDR_WRITEABLE);+ p->flags |= PGHDR_CLEAN;+ if( p->nRef==0 ){+ pcacheUnpin(p);+ }+ }+}++/*+** Make every page in the cache clean.+*/+SQLITE_PRIVATE void sqlite3PcacheCleanAll(PCache *pCache){+ PgHdr *p;+ while( (p = pCache->pDirty)!=0 ){+ sqlite3PcacheMakeClean(p);+ }+}++/*+** Clear the PGHDR_NEED_SYNC flag from all dirty pages.+*/+SQLITE_PRIVATE void sqlite3PcacheClearSyncFlags(PCache *pCache){+ PgHdr *p;+ for(p=pCache->pDirty; p; p=p->pDirtyNext){+ p->flags &= ~PGHDR_NEED_SYNC;+ }+ pCache->pSynced = pCache->pDirtyTail;+}++/*+** Change the page number of page p to newPgno. +*/+SQLITE_PRIVATE void sqlite3PcacheMove(PgHdr *p, Pgno newPgno){+ PCache *pCache = p->pCache;+ assert( p->nRef>0 );+ assert( newPgno>0 );+ sqlite3GlobalConfig.pcache2.xRekey(pCache->pCache, p->pPage, p->pgno,newPgno);+ p->pgno = newPgno;+ if( (p->flags&PGHDR_DIRTY) && (p->flags&PGHDR_NEED_SYNC) ){+ pcacheManageDirtyList(p, PCACHE_DIRTYLIST_FRONT);+ }+}++/*+** Drop every cache entry whose page number is greater than "pgno". The+** caller must ensure that there are no outstanding references to any pages+** other than page 1 with a page number greater than pgno.+**+** If there is a reference to page 1 and the pgno parameter passed to this+** function is 0, then the data area associated with page 1 is zeroed, but+** the page object is not dropped.+*/+SQLITE_PRIVATE void sqlite3PcacheTruncate(PCache *pCache, Pgno pgno){+ if( pCache->pCache ){+ PgHdr *p;+ PgHdr *pNext;+ for(p=pCache->pDirty; p; p=pNext){+ pNext = p->pDirtyNext;+ /* This routine never gets call with a positive pgno except right+ ** after sqlite3PcacheCleanAll(). So if there are dirty pages,+ ** it must be that pgno==0.+ */+ assert( p->pgno>0 );+ if( ALWAYS(p->pgno>pgno) ){+ assert( p->flags&PGHDR_DIRTY );+ sqlite3PcacheMakeClean(p);+ }+ }+ if( pgno==0 && pCache->nRefSum ){+ sqlite3_pcache_page *pPage1;+ pPage1 = sqlite3GlobalConfig.pcache2.xFetch(pCache->pCache,1,0);+ if( ALWAYS(pPage1) ){ /* Page 1 is always available in cache, because+ ** pCache->nRefSum>0 */+ memset(pPage1->pBuf, 0, pCache->szPage);+ pgno = 1;+ }+ }+ sqlite3GlobalConfig.pcache2.xTruncate(pCache->pCache, pgno+1);+ }+}++/*+** Close a cache.+*/+SQLITE_PRIVATE void sqlite3PcacheClose(PCache *pCache){+ assert( pCache->pCache!=0 );+ sqlite3GlobalConfig.pcache2.xDestroy(pCache->pCache);+}++/* +** Discard the contents of the cache.+*/+SQLITE_PRIVATE void sqlite3PcacheClear(PCache *pCache){+ sqlite3PcacheTruncate(pCache, 0);+}++/*+** Merge two lists of pages connected by pDirty and in pgno order.+** Do not both fixing the pDirtyPrev pointers.+*/+static PgHdr *pcacheMergeDirtyList(PgHdr *pA, PgHdr *pB){+ PgHdr result, *pTail;+ pTail = &result;+ while( pA && pB ){+ if( pA->pgno<pB->pgno ){+ pTail->pDirty = pA;+ pTail = pA;+ pA = pA->pDirty;+ }else{+ pTail->pDirty = pB;+ pTail = pB;+ pB = pB->pDirty;+ }+ }+ if( pA ){+ pTail->pDirty = pA;+ }else if( pB ){+ pTail->pDirty = pB;+ }else{+ pTail->pDirty = 0;+ }+ return result.pDirty;+}++/*+** Sort the list of pages in accending order by pgno. Pages are+** connected by pDirty pointers. The pDirtyPrev pointers are+** corrupted by this sort.+**+** Since there cannot be more than 2^31 distinct pages in a database,+** there cannot be more than 31 buckets required by the merge sorter.+** One extra bucket is added to catch overflow in case something+** ever changes to make the previous sentence incorrect.+*/+#define N_SORT_BUCKET 32+static PgHdr *pcacheSortDirtyList(PgHdr *pIn){+ PgHdr *a[N_SORT_BUCKET], *p;+ int i;+ memset(a, 0, sizeof(a));+ while( pIn ){+ p = pIn;+ pIn = p->pDirty;+ p->pDirty = 0;+ for(i=0; ALWAYS(i<N_SORT_BUCKET-1); i++){+ if( a[i]==0 ){+ a[i] = p;+ break;+ }else{+ p = pcacheMergeDirtyList(a[i], p);+ a[i] = 0;+ }+ }+ if( NEVER(i==N_SORT_BUCKET-1) ){+ /* To get here, there need to be 2^(N_SORT_BUCKET) elements in+ ** the input list. But that is impossible.+ */+ a[i] = pcacheMergeDirtyList(a[i], p);+ }+ }+ p = a[0];+ for(i=1; i<N_SORT_BUCKET; i++){+ p = pcacheMergeDirtyList(p, a[i]);+ }+ return p;+}++/*+** Return a list of all dirty pages in the cache, sorted by page number.+*/+SQLITE_PRIVATE PgHdr *sqlite3PcacheDirtyList(PCache *pCache){+ PgHdr *p;+ for(p=pCache->pDirty; p; p=p->pDirtyNext){+ p->pDirty = p->pDirtyNext;+ }+ return pcacheSortDirtyList(pCache->pDirty);+}++/* +** Return the total number of references to all pages held by the cache.+**+** This is not the total number of pages referenced, but the sum of the+** reference count for all pages.+*/+SQLITE_PRIVATE int sqlite3PcacheRefCount(PCache *pCache){+ return pCache->nRefSum;+}++/*+** Return the number of references to the page supplied as an argument.+*/+SQLITE_PRIVATE int sqlite3PcachePageRefcount(PgHdr *p){+ return p->nRef;+}++#ifdef SQLITE_TEST+/* +** Return the total number of pages in the cache.+*/+SQLITE_PRIVATE int sqlite3PcachePagecount(PCache *pCache){+ assert( pCache->pCache!=0 );+ return sqlite3GlobalConfig.pcache2.xPagecount(pCache->pCache);+}++/*+** Get the suggested cache-size value.+*/+SQLITE_PRIVATE int sqlite3PcacheGetCachesize(PCache *pCache){+ return numberOfCachePages(pCache);+}+#endif++/*+** Set the suggested cache-size value.+*/+SQLITE_PRIVATE void sqlite3PcacheSetCachesize(PCache *pCache, int mxPage){+ assert( pCache->pCache!=0 );+ pCache->szCache = mxPage;+ sqlite3GlobalConfig.pcache2.xCachesize(pCache->pCache,+ numberOfCachePages(pCache));+}++#if 0+/*+** Free up as much memory as possible from the page cache.+*/+SQLITE_PRIVATE void sqlite3PcacheShrink(PCache *pCache){+ assert( pCache->pCache!=0 );+ sqlite3GlobalConfig.pcache2.xShrink(pCache->pCache);+}+#endif++/*+** Return the size of the header added by this middleware layer+** in the page-cache hierarchy.+*/+SQLITE_PRIVATE int sqlite3HeaderSizePcache(void){ return ROUND8(sizeof(PgHdr)); }+++#if defined(SQLITE_CHECK_PAGES) || defined(SQLITE_DEBUG)+/*+** For all dirty pages currently in the cache, invoke the specified+** callback. This is only used if the SQLITE_CHECK_PAGES macro is+** defined.+*/+SQLITE_PRIVATE void sqlite3PcacheIterateDirty(PCache *pCache, void (*xIter)(PgHdr *)){+ PgHdr *pDirty;+ for(pDirty=pCache->pDirty; pDirty; pDirty=pDirty->pDirtyNext){+ xIter(pDirty);+ }+}+#endif++/************** End of pcache.c **********************************************/+/************** Begin file pcache1.c *****************************************/+/*+** 2008 November 05+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file implements the default page cache implementation (the+** sqlite3_pcache interface). It also contains part of the implementation+** of the SQLITE_CONFIG_PAGECACHE and sqlite3_release_memory() features.+** If the default page cache implementation is overridden, then neither of+** these two features are available.+**+** A Page cache line looks like this:+**+** -------------------------------------------------------------+** | database page content | PgHdr1 | MemPage | PgHdr |+** -------------------------------------------------------------+**+** The database page content is up front (so that buffer overreads tend to+** flow harmlessly into the PgHdr1, MemPage, and PgHdr extensions). MemPage+** is the extension added by the btree.c module containing information such+** as the database page number and how that database page is used. PgHdr+** is added by the pcache.c layer and contains information used to keep track+** of which pages are "dirty". PgHdr1 is an extension added by this+** module (pcache1.c). The PgHdr1 header is a subclass of sqlite3_pcache_page.+** PgHdr1 contains information needed to look up a page by its page number.+** The superclass sqlite3_pcache_page.pBuf points to the start of the+** database page content and sqlite3_pcache_page.pExtra points to PgHdr.+**+** The size of the extension (MemPage+PgHdr+PgHdr1) can be determined at+** runtime using sqlite3_config(SQLITE_CONFIG_PCACHE_HDRSZ, &size). The+** sizes of the extensions sum to 272 bytes on x64 for 3.8.10, but this+** size can vary according to architecture, compile-time options, and+** SQLite library version number.+**+** If SQLITE_PCACHE_SEPARATE_HEADER is defined, then the extension is obtained+** using a separate memory allocation from the database page content. This+** seeks to overcome the "clownshoe" problem (also called "internal+** fragmentation" in academic literature) of allocating a few bytes more+** than a power of two with the memory allocator rounding up to the next+** power of two, and leaving the rounded-up space unused.+**+** This module tracks pointers to PgHdr1 objects. Only pcache.c communicates+** with this module. Information is passed back and forth as PgHdr1 pointers.+**+** The pcache.c and pager.c modules deal pointers to PgHdr objects.+** The btree.c module deals with pointers to MemPage objects.+**+** SOURCE OF PAGE CACHE MEMORY:+**+** Memory for a page might come from any of three sources:+**+** (1) The general-purpose memory allocator - sqlite3Malloc()+** (2) Global page-cache memory provided using sqlite3_config() with+** SQLITE_CONFIG_PAGECACHE.+** (3) PCache-local bulk allocation.+**+** The third case is a chunk of heap memory (defaulting to 100 pages worth)+** that is allocated when the page cache is created. The size of the local+** bulk allocation can be adjusted using +**+** sqlite3_config(SQLITE_CONFIG_PAGECACHE, 0, 0, N).+**+** If N is positive, then N pages worth of memory are allocated using a single+** sqlite3Malloc() call and that memory is used for the first N pages allocated.+** Or if N is negative, then -1024*N bytes of memory are allocated and used+** for as many pages as can be accomodated.+**+** Only one of (2) or (3) can be used. Once the memory available to (2) or+** (3) is exhausted, subsequent allocations fail over to the general-purpose+** memory allocator (1).+**+** Earlier versions of SQLite used only methods (1) and (2). But experiments+** show that method (3) with N==100 provides about a 5% performance boost for+** common workloads.+*/+/* #include "sqliteInt.h" */++typedef struct PCache1 PCache1;+typedef struct PgHdr1 PgHdr1;+typedef struct PgFreeslot PgFreeslot;+typedef struct PGroup PGroup;++/*+** Each cache entry is represented by an instance of the following +** structure. Unless SQLITE_PCACHE_SEPARATE_HEADER is defined, a buffer of+** PgHdr1.pCache->szPage bytes is allocated directly before this structure +** in memory.+*/+struct PgHdr1 {+ sqlite3_pcache_page page; /* Base class. Must be first. pBuf & pExtra */+ unsigned int iKey; /* Key value (page number) */+ u8 isPinned; /* Page in use, not on the LRU list */+ u8 isBulkLocal; /* This page from bulk local storage */+ u8 isAnchor; /* This is the PGroup.lru element */+ PgHdr1 *pNext; /* Next in hash table chain */+ PCache1 *pCache; /* Cache that currently owns this page */+ PgHdr1 *pLruNext; /* Next in LRU list of unpinned pages */+ PgHdr1 *pLruPrev; /* Previous in LRU list of unpinned pages */+};++/* Each page cache (or PCache) belongs to a PGroup. A PGroup is a set +** of one or more PCaches that are able to recycle each other's unpinned+** pages when they are under memory pressure. A PGroup is an instance of+** the following object.+**+** This page cache implementation works in one of two modes:+**+** (1) Every PCache is the sole member of its own PGroup. There is+** one PGroup per PCache.+**+** (2) There is a single global PGroup that all PCaches are a member+** of.+**+** Mode 1 uses more memory (since PCache instances are not able to rob+** unused pages from other PCaches) but it also operates without a mutex,+** and is therefore often faster. Mode 2 requires a mutex in order to be+** threadsafe, but recycles pages more efficiently.+**+** For mode (1), PGroup.mutex is NULL. For mode (2) there is only a single+** PGroup which is the pcache1.grp global variable and its mutex is+** SQLITE_MUTEX_STATIC_LRU.+*/+struct PGroup {+ sqlite3_mutex *mutex; /* MUTEX_STATIC_LRU or NULL */+ unsigned int nMaxPage; /* Sum of nMax for purgeable caches */+ unsigned int nMinPage; /* Sum of nMin for purgeable caches */+ unsigned int mxPinned; /* nMaxpage + 10 - nMinPage */+ unsigned int nCurrentPage; /* Number of purgeable pages allocated */+ PgHdr1 lru; /* The beginning and end of the LRU list */+};++/* Each page cache is an instance of the following object. Every+** open database file (including each in-memory database and each+** temporary or transient database) has a single page cache which+** is an instance of this object.+**+** Pointers to structures of this type are cast and returned as +** opaque sqlite3_pcache* handles.+*/+struct PCache1 {+ /* Cache configuration parameters. Page size (szPage) and the purgeable+ ** flag (bPurgeable) are set when the cache is created. nMax may be + ** modified at any time by a call to the pcache1Cachesize() method.+ ** The PGroup mutex must be held when accessing nMax.+ */+ PGroup *pGroup; /* PGroup this cache belongs to */+ int szPage; /* Size of database content section */+ int szExtra; /* sizeof(MemPage)+sizeof(PgHdr) */+ int szAlloc; /* Total size of one pcache line */+ int bPurgeable; /* True if cache is purgeable */+ unsigned int nMin; /* Minimum number of pages reserved */+ unsigned int nMax; /* Configured "cache_size" value */+ unsigned int n90pct; /* nMax*9/10 */+ unsigned int iMaxKey; /* Largest key seen since xTruncate() */++ /* Hash table of all pages. The following variables may only be accessed+ ** when the accessor is holding the PGroup mutex.+ */+ unsigned int nRecyclable; /* Number of pages in the LRU list */+ unsigned int nPage; /* Total number of pages in apHash */+ unsigned int nHash; /* Number of slots in apHash[] */+ PgHdr1 **apHash; /* Hash table for fast lookup by key */+ PgHdr1 *pFree; /* List of unused pcache-local pages */+ void *pBulk; /* Bulk memory used by pcache-local */+};++/*+** Free slots in the allocator used to divide up the global page cache+** buffer provided using the SQLITE_CONFIG_PAGECACHE mechanism.+*/+struct PgFreeslot {+ PgFreeslot *pNext; /* Next free slot */+};++/*+** Global data used by this cache.+*/+static SQLITE_WSD struct PCacheGlobal {+ PGroup grp; /* The global PGroup for mode (2) */++ /* Variables related to SQLITE_CONFIG_PAGECACHE settings. The+ ** szSlot, nSlot, pStart, pEnd, nReserve, and isInit values are all+ ** fixed at sqlite3BtreeInitialize() time and do not require mutex protection.+ ** The nFreeSlot and pFree values do require mutex protection.+ */+ int isInit; /* True if initialized */+ int separateCache; /* Use a new PGroup for each PCache */+ int nInitPage; /* Initial bulk allocation size */ + int szSlot; /* Size of each free slot */+ int nSlot; /* The number of pcache slots */+ int nReserve; /* Try to keep nFreeSlot above this */+ void *pStart, *pEnd; /* Bounds of global page cache memory */+ /* Above requires no mutex. Use mutex below for variable that follow. */+ sqlite3_mutex *mutex; /* Mutex for accessing the following: */+ PgFreeslot *pFree; /* Free page blocks */+ int nFreeSlot; /* Number of unused pcache slots */+ /* The following value requires a mutex to change. We skip the mutex on+ ** reading because (1) most platforms read a 32-bit integer atomically and+ ** (2) even if an incorrect value is read, no great harm is done since this+ ** is really just an optimization. */+ int bUnderPressure; /* True if low on PAGECACHE memory */+} pcache1_g;++/*+** All code in this file should access the global structure above via the+** alias "pcache1". This ensures that the WSD emulation is used when+** compiling for systems that do not support real WSD.+*/+#define pcache1 (GLOBAL(struct PCacheGlobal, pcache1_g))++/*+** Macros to enter and leave the PCache LRU mutex.+*/+#if !defined(SQLITE_ENABLE_MEMORY_MANAGEMENT) || SQLITE_THREADSAFE==0+# define pcache1EnterMutex(X) assert((X)->mutex==0)+# define pcache1LeaveMutex(X) assert((X)->mutex==0)+# define PCACHE1_MIGHT_USE_GROUP_MUTEX 0+#else+# define pcache1EnterMutex(X) sqlite3_mutex_enter((X)->mutex)+# define pcache1LeaveMutex(X) sqlite3_mutex_leave((X)->mutex)+# define PCACHE1_MIGHT_USE_GROUP_MUTEX 1+#endif++/******************************************************************************/+/******** Page Allocation/SQLITE_CONFIG_PCACHE Related Functions **************/+++/*+** This function is called during initialization if a static buffer is +** supplied to use for the page-cache by passing the SQLITE_CONFIG_PAGECACHE+** verb to sqlite3_config(). Parameter pBuf points to an allocation large+** enough to contain 'n' buffers of 'sz' bytes each.+**+** This routine is called from sqlite3_initialize() and so it is guaranteed+** to be serialized already. There is no need for further mutexing.+*/+SQLITE_PRIVATE void sqlite3PCacheBufferSetup(void *pBuf, int sz, int n){+ if( pcache1.isInit ){+ PgFreeslot *p;+ if( pBuf==0 ) sz = n = 0;+ sz = ROUNDDOWN8(sz);+ pcache1.szSlot = sz;+ pcache1.nSlot = pcache1.nFreeSlot = n;+ pcache1.nReserve = n>90 ? 10 : (n/10 + 1);+ pcache1.pStart = pBuf;+ pcache1.pFree = 0;+ pcache1.bUnderPressure = 0;+ while( n-- ){+ p = (PgFreeslot*)pBuf;+ p->pNext = pcache1.pFree;+ pcache1.pFree = p;+ pBuf = (void*)&((char*)pBuf)[sz];+ }+ pcache1.pEnd = pBuf;+ }+}++/*+** Try to initialize the pCache->pFree and pCache->pBulk fields. Return+** true if pCache->pFree ends up containing one or more free pages.+*/+static int pcache1InitBulk(PCache1 *pCache){+ i64 szBulk;+ char *zBulk;+ if( pcache1.nInitPage==0 ) return 0;+ /* Do not bother with a bulk allocation if the cache size very small */+ if( pCache->nMax<3 ) return 0;+ if( pcache1.nInitPage>0 ){+ szBulk = pCache->szAlloc * (i64)pcache1.nInitPage;+ }else{+ szBulk = -1024 * (i64)pcache1.nInitPage;+ }+ if( szBulk > pCache->szAlloc*(i64)pCache->nMax ){+ szBulk = pCache->szAlloc*pCache->nMax;+ }+ zBulk = pCache->pBulk = sqlite3Malloc( szBulk );+ if( zBulk ){+ int nBulk = sqlite3MallocSize(zBulk)/pCache->szAlloc;+ int i;+ for(i=0; i<nBulk; i++){+ PgHdr1 *pX = (PgHdr1*)&zBulk[pCache->szPage];+ pX->page.pBuf = zBulk;+ pX->page.pExtra = &pX[1];+ pX->isBulkLocal = 1;+ pX->isAnchor = 0;+ pX->pNext = pCache->pFree;+ pCache->pFree = pX;+ zBulk += pCache->szAlloc;+ }+ }+ return pCache->pFree!=0;+}++/*+** Malloc function used within this file to allocate space from the buffer+** configured using sqlite3_config(SQLITE_CONFIG_PAGECACHE) option. If no +** such buffer exists or there is no space left in it, this function falls +** back to sqlite3Malloc().+**+** Multiple threads can run this routine at the same time. Global variables+** in pcache1 need to be protected via mutex.+*/+static void *pcache1Alloc(int nByte){+ void *p = 0;+ assert( sqlite3_mutex_notheld(pcache1.grp.mutex) );+ if( nByte<=pcache1.szSlot ){+ sqlite3_mutex_enter(pcache1.mutex);+ p = (PgHdr1 *)pcache1.pFree;+ if( p ){+ pcache1.pFree = pcache1.pFree->pNext;+ pcache1.nFreeSlot--;+ pcache1.bUnderPressure = pcache1.nFreeSlot<pcache1.nReserve;+ assert( pcache1.nFreeSlot>=0 );+ sqlite3StatusSet(SQLITE_STATUS_PAGECACHE_SIZE, nByte);+ sqlite3StatusUp(SQLITE_STATUS_PAGECACHE_USED, 1);+ }+ sqlite3_mutex_leave(pcache1.mutex);+ }+ if( p==0 ){+ /* Memory is not available in the SQLITE_CONFIG_PAGECACHE pool. Get+ ** it from sqlite3Malloc instead.+ */+ p = sqlite3Malloc(nByte);+#ifndef SQLITE_DISABLE_PAGECACHE_OVERFLOW_STATS+ if( p ){+ int sz = sqlite3MallocSize(p);+ sqlite3_mutex_enter(pcache1.mutex);+ sqlite3StatusSet(SQLITE_STATUS_PAGECACHE_SIZE, nByte);+ sqlite3StatusUp(SQLITE_STATUS_PAGECACHE_OVERFLOW, sz);+ sqlite3_mutex_leave(pcache1.mutex);+ }+#endif+ sqlite3MemdebugSetType(p, MEMTYPE_PCACHE);+ }+ return p;+}++/*+** Free an allocated buffer obtained from pcache1Alloc().+*/+static void pcache1Free(void *p){+ int nFreed = 0;+ if( p==0 ) return;+ if( p>=pcache1.pStart && p<pcache1.pEnd ){+ PgFreeslot *pSlot;+ sqlite3_mutex_enter(pcache1.mutex);+ sqlite3StatusDown(SQLITE_STATUS_PAGECACHE_USED, 1);+ pSlot = (PgFreeslot*)p;+ pSlot->pNext = pcache1.pFree;+ pcache1.pFree = pSlot;+ pcache1.nFreeSlot++;+ pcache1.bUnderPressure = pcache1.nFreeSlot<pcache1.nReserve;+ assert( pcache1.nFreeSlot<=pcache1.nSlot );+ sqlite3_mutex_leave(pcache1.mutex);+ }else{+ assert( sqlite3MemdebugHasType(p, MEMTYPE_PCACHE) );+ sqlite3MemdebugSetType(p, MEMTYPE_HEAP);+#ifndef SQLITE_DISABLE_PAGECACHE_OVERFLOW_STATS+ nFreed = sqlite3MallocSize(p);+ sqlite3_mutex_enter(pcache1.mutex);+ sqlite3StatusDown(SQLITE_STATUS_PAGECACHE_OVERFLOW, nFreed);+ sqlite3_mutex_leave(pcache1.mutex);+#endif+ sqlite3_free(p);+ }+}++#ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT+/*+** Return the size of a pcache allocation+*/+static int pcache1MemSize(void *p){+ if( p>=pcache1.pStart && p<pcache1.pEnd ){+ return pcache1.szSlot;+ }else{+ int iSize;+ assert( sqlite3MemdebugHasType(p, MEMTYPE_PCACHE) );+ sqlite3MemdebugSetType(p, MEMTYPE_HEAP);+ iSize = sqlite3MallocSize(p);+ sqlite3MemdebugSetType(p, MEMTYPE_PCACHE);+ return iSize;+ }+}+#endif /* SQLITE_ENABLE_MEMORY_MANAGEMENT */++/*+** Allocate a new page object initially associated with cache pCache.+*/+static PgHdr1 *pcache1AllocPage(PCache1 *pCache, int benignMalloc){+ PgHdr1 *p = 0;+ void *pPg;++ assert( sqlite3_mutex_held(pCache->pGroup->mutex) );+ if( pCache->pFree || (pCache->nPage==0 && pcache1InitBulk(pCache)) ){+ p = pCache->pFree;+ pCache->pFree = p->pNext;+ p->pNext = 0;+ }else{+#ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT+ /* The group mutex must be released before pcache1Alloc() is called. This+ ** is because it might call sqlite3_release_memory(), which assumes that + ** this mutex is not held. */+ assert( pcache1.separateCache==0 );+ assert( pCache->pGroup==&pcache1.grp );+ pcache1LeaveMutex(pCache->pGroup);+#endif+#ifdef SQLITE_PCACHE_SEPARATE_HEADER+ pPg = pcache1Alloc(pCache->szPage);+ p = sqlite3Malloc(sizeof(PgHdr1) + pCache->szExtra);+ if( !pPg || !p ){+ pcache1Free(pPg);+ sqlite3_free(p);+ pPg = 0;+ }+#else+ pPg = pcache1Alloc(pCache->szAlloc);+ p = (PgHdr1 *)&((u8 *)pPg)[pCache->szPage];+#endif+#ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT+ pcache1EnterMutex(pCache->pGroup);+#endif+ if( pPg==0 ) return 0;+ p->page.pBuf = pPg;+ p->page.pExtra = &p[1];+ p->isBulkLocal = 0;+ p->isAnchor = 0;+ }+ if( pCache->bPurgeable ){+ pCache->pGroup->nCurrentPage++;+ }+ return p;+}++/*+** Free a page object allocated by pcache1AllocPage().+*/+static void pcache1FreePage(PgHdr1 *p){+ PCache1 *pCache;+ assert( p!=0 );+ pCache = p->pCache;+ assert( sqlite3_mutex_held(p->pCache->pGroup->mutex) );+ if( p->isBulkLocal ){+ p->pNext = pCache->pFree;+ pCache->pFree = p;+ }else{+ pcache1Free(p->page.pBuf);+#ifdef SQLITE_PCACHE_SEPARATE_HEADER+ sqlite3_free(p);+#endif+ }+ if( pCache->bPurgeable ){+ pCache->pGroup->nCurrentPage--;+ }+}++/*+** Malloc function used by SQLite to obtain space from the buffer configured+** using sqlite3_config(SQLITE_CONFIG_PAGECACHE) option. If no such buffer+** exists, this function falls back to sqlite3Malloc().+*/+SQLITE_PRIVATE void *sqlite3PageMalloc(int sz){+ return pcache1Alloc(sz);+}++/*+** Free an allocated buffer obtained from sqlite3PageMalloc().+*/+SQLITE_PRIVATE void sqlite3PageFree(void *p){+ pcache1Free(p);+}+++/*+** Return true if it desirable to avoid allocating a new page cache+** entry.+**+** If memory was allocated specifically to the page cache using+** SQLITE_CONFIG_PAGECACHE but that memory has all been used, then+** it is desirable to avoid allocating a new page cache entry because+** presumably SQLITE_CONFIG_PAGECACHE was suppose to be sufficient+** for all page cache needs and we should not need to spill the+** allocation onto the heap.+**+** Or, the heap is used for all page cache memory but the heap is+** under memory pressure, then again it is desirable to avoid+** allocating a new page cache entry in order to avoid stressing+** the heap even further.+*/+static int pcache1UnderMemoryPressure(PCache1 *pCache){+ if( pcache1.nSlot && (pCache->szPage+pCache->szExtra)<=pcache1.szSlot ){+ return pcache1.bUnderPressure;+ }else{+ return sqlite3HeapNearlyFull();+ }+}++/******************************************************************************/+/******** General Implementation Functions ************************************/++/*+** This function is used to resize the hash table used by the cache passed+** as the first argument.+**+** The PCache mutex must be held when this function is called.+*/+static void pcache1ResizeHash(PCache1 *p){+ PgHdr1 **apNew;+ unsigned int nNew;+ unsigned int i;++ assert( sqlite3_mutex_held(p->pGroup->mutex) );++ nNew = p->nHash*2;+ if( nNew<256 ){+ nNew = 256;+ }++ pcache1LeaveMutex(p->pGroup);+ apNew = (PgHdr1 **)sqlite3MallocZero(sizeof(PgHdr1 *)*nNew);+ pcache1EnterMutex(p->pGroup);+ if( apNew ){+ for(i=0; i<p->nHash; i++){+ PgHdr1 *pPage;+ PgHdr1 *pNext = p->apHash[i];+ while( (pPage = pNext)!=0 ){+ unsigned int h = pPage->iKey % nNew;+ pNext = pPage->pNext;+ pPage->pNext = apNew[h];+ apNew[h] = pPage;+ }+ }+ sqlite3_free(p->apHash);+ p->apHash = apNew;+ p->nHash = nNew;+ }+}++/*+** This function is used internally to remove the page pPage from the +** PGroup LRU list, if is part of it. If pPage is not part of the PGroup+** LRU list, then this function is a no-op.+**+** The PGroup mutex must be held when this function is called.+*/+static PgHdr1 *pcache1PinPage(PgHdr1 *pPage){+ PCache1 *pCache;++ assert( pPage!=0 );+ assert( pPage->isPinned==0 );+ pCache = pPage->pCache;+ assert( pPage->pLruNext );+ assert( pPage->pLruPrev );+ assert( sqlite3_mutex_held(pCache->pGroup->mutex) );+ pPage->pLruPrev->pLruNext = pPage->pLruNext;+ pPage->pLruNext->pLruPrev = pPage->pLruPrev;+ pPage->pLruNext = 0;+ pPage->pLruPrev = 0;+ pPage->isPinned = 1;+ assert( pPage->isAnchor==0 );+ assert( pCache->pGroup->lru.isAnchor==1 );+ pCache->nRecyclable--;+ return pPage;+}+++/*+** Remove the page supplied as an argument from the hash table +** (PCache1.apHash structure) that it is currently stored in.+** Also free the page if freePage is true.+**+** The PGroup mutex must be held when this function is called.+*/+static void pcache1RemoveFromHash(PgHdr1 *pPage, int freeFlag){+ unsigned int h;+ PCache1 *pCache = pPage->pCache;+ PgHdr1 **pp;++ assert( sqlite3_mutex_held(pCache->pGroup->mutex) );+ h = pPage->iKey % pCache->nHash;+ for(pp=&pCache->apHash[h]; (*pp)!=pPage; pp=&(*pp)->pNext);+ *pp = (*pp)->pNext;++ pCache->nPage--;+ if( freeFlag ) pcache1FreePage(pPage);+}++/*+** If there are currently more than nMaxPage pages allocated, try+** to recycle pages to reduce the number allocated to nMaxPage.+*/+static void pcache1EnforceMaxPage(PCache1 *pCache){+ PGroup *pGroup = pCache->pGroup;+ PgHdr1 *p;+ assert( sqlite3_mutex_held(pGroup->mutex) );+ while( pGroup->nCurrentPage>pGroup->nMaxPage+ && (p=pGroup->lru.pLruPrev)->isAnchor==0+ ){+ assert( p->pCache->pGroup==pGroup );+ assert( p->isPinned==0 );+ pcache1PinPage(p);+ pcache1RemoveFromHash(p, 1);+ }+ if( pCache->nPage==0 && pCache->pBulk ){+ sqlite3_free(pCache->pBulk);+ pCache->pBulk = pCache->pFree = 0;+ }+}++/*+** Discard all pages from cache pCache with a page number (key value) +** greater than or equal to iLimit. Any pinned pages that meet this +** criteria are unpinned before they are discarded.+**+** The PCache mutex must be held when this function is called.+*/+static void pcache1TruncateUnsafe(+ PCache1 *pCache, /* The cache to truncate */+ unsigned int iLimit /* Drop pages with this pgno or larger */+){+ TESTONLY( unsigned int nPage = 0; ) /* To assert pCache->nPage is correct */+ unsigned int h;+ assert( sqlite3_mutex_held(pCache->pGroup->mutex) );+ for(h=0; h<pCache->nHash; h++){+ PgHdr1 **pp = &pCache->apHash[h]; + PgHdr1 *pPage;+ while( (pPage = *pp)!=0 ){+ if( pPage->iKey>=iLimit ){+ pCache->nPage--;+ *pp = pPage->pNext;+ if( !pPage->isPinned ) pcache1PinPage(pPage);+ pcache1FreePage(pPage);+ }else{+ pp = &pPage->pNext;+ TESTONLY( nPage++; )+ }+ }+ }+ assert( pCache->nPage==nPage );+}++/******************************************************************************/+/******** sqlite3_pcache Methods **********************************************/++/*+** Implementation of the sqlite3_pcache.xInit method.+*/+static int pcache1Init(void *NotUsed){+ UNUSED_PARAMETER(NotUsed);+ assert( pcache1.isInit==0 );+ memset(&pcache1, 0, sizeof(pcache1));+++ /*+ ** The pcache1.separateCache variable is true if each PCache has its own+ ** private PGroup (mode-1). pcache1.separateCache is false if the single+ ** PGroup in pcache1.grp is used for all page caches (mode-2).+ **+ ** * Always use a unified cache (mode-2) if ENABLE_MEMORY_MANAGEMENT+ **+ ** * Use a unified cache in single-threaded applications that have+ ** configured a start-time buffer for use as page-cache memory using+ ** sqlite3_config(SQLITE_CONFIG_PAGECACHE, pBuf, sz, N) with non-NULL + ** pBuf argument.+ **+ ** * Otherwise use separate caches (mode-1)+ */+#if defined(SQLITE_ENABLE_MEMORY_MANAGEMENT)+ pcache1.separateCache = 0;+#elif SQLITE_THREADSAFE+ pcache1.separateCache = sqlite3GlobalConfig.pPage==0+ || sqlite3GlobalConfig.bCoreMutex>0;+#else+ pcache1.separateCache = sqlite3GlobalConfig.pPage==0;+#endif++#if SQLITE_THREADSAFE+ if( sqlite3GlobalConfig.bCoreMutex ){+ pcache1.grp.mutex = sqlite3_mutex_alloc(SQLITE_MUTEX_STATIC_LRU);+ pcache1.mutex = sqlite3_mutex_alloc(SQLITE_MUTEX_STATIC_PMEM);+ }+#endif+ if( pcache1.separateCache+ && sqlite3GlobalConfig.nPage!=0+ && sqlite3GlobalConfig.pPage==0+ ){+ pcache1.nInitPage = sqlite3GlobalConfig.nPage;+ }else{+ pcache1.nInitPage = 0;+ }+ pcache1.grp.mxPinned = 10;+ pcache1.isInit = 1;+ return SQLITE_OK;+}++/*+** Implementation of the sqlite3_pcache.xShutdown method.+** Note that the static mutex allocated in xInit does +** not need to be freed.+*/+static void pcache1Shutdown(void *NotUsed){+ UNUSED_PARAMETER(NotUsed);+ assert( pcache1.isInit!=0 );+ memset(&pcache1, 0, sizeof(pcache1));+}++/* forward declaration */+static void pcache1Destroy(sqlite3_pcache *p);++/*+** Implementation of the sqlite3_pcache.xCreate method.+**+** Allocate a new cache.+*/+static sqlite3_pcache *pcache1Create(int szPage, int szExtra, int bPurgeable){+ PCache1 *pCache; /* The newly created page cache */+ PGroup *pGroup; /* The group the new page cache will belong to */+ int sz; /* Bytes of memory required to allocate the new cache */++ assert( (szPage & (szPage-1))==0 && szPage>=512 && szPage<=65536 );+ assert( szExtra < 300 );++ sz = sizeof(PCache1) + sizeof(PGroup)*pcache1.separateCache;+ pCache = (PCache1 *)sqlite3MallocZero(sz);+ if( pCache ){+ if( pcache1.separateCache ){+ pGroup = (PGroup*)&pCache[1];+ pGroup->mxPinned = 10;+ }else{+ pGroup = &pcache1.grp;+ }+ if( pGroup->lru.isAnchor==0 ){+ pGroup->lru.isAnchor = 1;+ pGroup->lru.pLruPrev = pGroup->lru.pLruNext = &pGroup->lru;+ }+ pCache->pGroup = pGroup;+ pCache->szPage = szPage;+ pCache->szExtra = szExtra;+ pCache->szAlloc = szPage + szExtra + ROUND8(sizeof(PgHdr1));+ pCache->bPurgeable = (bPurgeable ? 1 : 0);+ pcache1EnterMutex(pGroup);+ pcache1ResizeHash(pCache);+ if( bPurgeable ){+ pCache->nMin = 10;+ pGroup->nMinPage += pCache->nMin;+ pGroup->mxPinned = pGroup->nMaxPage + 10 - pGroup->nMinPage;+ }+ pcache1LeaveMutex(pGroup);+ if( pCache->nHash==0 ){+ pcache1Destroy((sqlite3_pcache*)pCache);+ pCache = 0;+ }+ }+ return (sqlite3_pcache *)pCache;+}++/*+** Implementation of the sqlite3_pcache.xCachesize method. +**+** Configure the cache_size limit for a cache.+*/+static void pcache1Cachesize(sqlite3_pcache *p, int nMax){+ PCache1 *pCache = (PCache1 *)p;+ if( pCache->bPurgeable ){+ PGroup *pGroup = pCache->pGroup;+ pcache1EnterMutex(pGroup);+ pGroup->nMaxPage += (nMax - pCache->nMax);+ pGroup->mxPinned = pGroup->nMaxPage + 10 - pGroup->nMinPage;+ pCache->nMax = nMax;+ pCache->n90pct = pCache->nMax*9/10;+ pcache1EnforceMaxPage(pCache);+ pcache1LeaveMutex(pGroup);+ }+}++/*+** Implementation of the sqlite3_pcache.xShrink method. +**+** Free up as much memory as possible.+*/+static void pcache1Shrink(sqlite3_pcache *p){+ PCache1 *pCache = (PCache1*)p;+ if( pCache->bPurgeable ){+ PGroup *pGroup = pCache->pGroup;+ int savedMaxPage;+ pcache1EnterMutex(pGroup);+ savedMaxPage = pGroup->nMaxPage;+ pGroup->nMaxPage = 0;+ pcache1EnforceMaxPage(pCache);+ pGroup->nMaxPage = savedMaxPage;+ pcache1LeaveMutex(pGroup);+ }+}++/*+** Implementation of the sqlite3_pcache.xPagecount method. +*/+static int pcache1Pagecount(sqlite3_pcache *p){+ int n;+ PCache1 *pCache = (PCache1*)p;+ pcache1EnterMutex(pCache->pGroup);+ n = pCache->nPage;+ pcache1LeaveMutex(pCache->pGroup);+ return n;+}+++/*+** Implement steps 3, 4, and 5 of the pcache1Fetch() algorithm described+** in the header of the pcache1Fetch() procedure.+**+** This steps are broken out into a separate procedure because they are+** usually not needed, and by avoiding the stack initialization required+** for these steps, the main pcache1Fetch() procedure can run faster.+*/+static SQLITE_NOINLINE PgHdr1 *pcache1FetchStage2(+ PCache1 *pCache, + unsigned int iKey, + int createFlag+){+ unsigned int nPinned;+ PGroup *pGroup = pCache->pGroup;+ PgHdr1 *pPage = 0;++ /* Step 3: Abort if createFlag is 1 but the cache is nearly full */+ assert( pCache->nPage >= pCache->nRecyclable );+ nPinned = pCache->nPage - pCache->nRecyclable;+ assert( pGroup->mxPinned == pGroup->nMaxPage + 10 - pGroup->nMinPage );+ assert( pCache->n90pct == pCache->nMax*9/10 );+ if( createFlag==1 && (+ nPinned>=pGroup->mxPinned+ || nPinned>=pCache->n90pct+ || (pcache1UnderMemoryPressure(pCache) && pCache->nRecyclable<nPinned)+ )){+ return 0;+ }++ if( pCache->nPage>=pCache->nHash ) pcache1ResizeHash(pCache);+ assert( pCache->nHash>0 && pCache->apHash );++ /* Step 4. Try to recycle a page. */+ if( pCache->bPurgeable+ && !pGroup->lru.pLruPrev->isAnchor+ && ((pCache->nPage+1>=pCache->nMax) || pcache1UnderMemoryPressure(pCache))+ ){+ PCache1 *pOther;+ pPage = pGroup->lru.pLruPrev;+ assert( pPage->isPinned==0 );+ pcache1RemoveFromHash(pPage, 0);+ pcache1PinPage(pPage);+ pOther = pPage->pCache;+ if( pOther->szAlloc != pCache->szAlloc ){+ pcache1FreePage(pPage);+ pPage = 0;+ }else{+ pGroup->nCurrentPage -= (pOther->bPurgeable - pCache->bPurgeable);+ }+ }++ /* Step 5. If a usable page buffer has still not been found, + ** attempt to allocate a new one. + */+ if( !pPage ){+ pPage = pcache1AllocPage(pCache, createFlag==1);+ }++ if( pPage ){+ unsigned int h = iKey % pCache->nHash;+ pCache->nPage++;+ pPage->iKey = iKey;+ pPage->pNext = pCache->apHash[h];+ pPage->pCache = pCache;+ pPage->pLruPrev = 0;+ pPage->pLruNext = 0;+ pPage->isPinned = 1;+ *(void **)pPage->page.pExtra = 0;+ pCache->apHash[h] = pPage;+ if( iKey>pCache->iMaxKey ){+ pCache->iMaxKey = iKey;+ }+ }+ return pPage;+}++/*+** Implementation of the sqlite3_pcache.xFetch method. +**+** Fetch a page by key value.+**+** Whether or not a new page may be allocated by this function depends on+** the value of the createFlag argument. 0 means do not allocate a new+** page. 1 means allocate a new page if space is easily available. 2 +** means to try really hard to allocate a new page.+**+** For a non-purgeable cache (a cache used as the storage for an in-memory+** database) there is really no difference between createFlag 1 and 2. So+** the calling function (pcache.c) will never have a createFlag of 1 on+** a non-purgeable cache.+**+** There are three different approaches to obtaining space for a page,+** depending on the value of parameter createFlag (which may be 0, 1 or 2).+**+** 1. Regardless of the value of createFlag, the cache is searched for a +** copy of the requested page. If one is found, it is returned.+**+** 2. If createFlag==0 and the page is not already in the cache, NULL is+** returned.+**+** 3. If createFlag is 1, and the page is not already in the cache, then+** return NULL (do not allocate a new page) if any of the following+** conditions are true:+**+** (a) the number of pages pinned by the cache is greater than+** PCache1.nMax, or+**+** (b) the number of pages pinned by the cache is greater than+** the sum of nMax for all purgeable caches, less the sum of +** nMin for all other purgeable caches, or+**+** 4. If none of the first three conditions apply and the cache is marked+** as purgeable, and if one of the following is true:+**+** (a) The number of pages allocated for the cache is already +** PCache1.nMax, or+**+** (b) The number of pages allocated for all purgeable caches is+** already equal to or greater than the sum of nMax for all+** purgeable caches,+**+** (c) The system is under memory pressure and wants to avoid+** unnecessary pages cache entry allocations+**+** then attempt to recycle a page from the LRU list. If it is the right+** size, return the recycled buffer. Otherwise, free the buffer and+** proceed to step 5. +**+** 5. Otherwise, allocate and return a new page buffer.+**+** There are two versions of this routine. pcache1FetchWithMutex() is+** the general case. pcache1FetchNoMutex() is a faster implementation for+** the common case where pGroup->mutex is NULL. The pcache1Fetch() wrapper+** invokes the appropriate routine.+*/+static PgHdr1 *pcache1FetchNoMutex(+ sqlite3_pcache *p, + unsigned int iKey, + int createFlag+){+ PCache1 *pCache = (PCache1 *)p;+ PgHdr1 *pPage = 0;++ /* Step 1: Search the hash table for an existing entry. */+ pPage = pCache->apHash[iKey % pCache->nHash];+ while( pPage && pPage->iKey!=iKey ){ pPage = pPage->pNext; }++ /* Step 2: If the page was found in the hash table, then return it.+ ** If the page was not in the hash table and createFlag is 0, abort.+ ** Otherwise (page not in hash and createFlag!=0) continue with+ ** subsequent steps to try to create the page. */+ if( pPage ){+ if( !pPage->isPinned ){+ return pcache1PinPage(pPage);+ }else{+ return pPage;+ }+ }else if( createFlag ){+ /* Steps 3, 4, and 5 implemented by this subroutine */+ return pcache1FetchStage2(pCache, iKey, createFlag);+ }else{+ return 0;+ }+}+#if PCACHE1_MIGHT_USE_GROUP_MUTEX+static PgHdr1 *pcache1FetchWithMutex(+ sqlite3_pcache *p, + unsigned int iKey, + int createFlag+){+ PCache1 *pCache = (PCache1 *)p;+ PgHdr1 *pPage;++ pcache1EnterMutex(pCache->pGroup);+ pPage = pcache1FetchNoMutex(p, iKey, createFlag);+ assert( pPage==0 || pCache->iMaxKey>=iKey );+ pcache1LeaveMutex(pCache->pGroup);+ return pPage;+}+#endif+static sqlite3_pcache_page *pcache1Fetch(+ sqlite3_pcache *p, + unsigned int iKey, + int createFlag+){+#if PCACHE1_MIGHT_USE_GROUP_MUTEX || defined(SQLITE_DEBUG)+ PCache1 *pCache = (PCache1 *)p;+#endif++ assert( offsetof(PgHdr1,page)==0 );+ assert( pCache->bPurgeable || createFlag!=1 );+ assert( pCache->bPurgeable || pCache->nMin==0 );+ assert( pCache->bPurgeable==0 || pCache->nMin==10 );+ assert( pCache->nMin==0 || pCache->bPurgeable );+ assert( pCache->nHash>0 );+#if PCACHE1_MIGHT_USE_GROUP_MUTEX+ if( pCache->pGroup->mutex ){+ return (sqlite3_pcache_page*)pcache1FetchWithMutex(p, iKey, createFlag);+ }else+#endif+ {+ return (sqlite3_pcache_page*)pcache1FetchNoMutex(p, iKey, createFlag);+ }+}+++/*+** Implementation of the sqlite3_pcache.xUnpin method.+**+** Mark a page as unpinned (eligible for asynchronous recycling).+*/+static void pcache1Unpin(+ sqlite3_pcache *p, + sqlite3_pcache_page *pPg, + int reuseUnlikely+){+ PCache1 *pCache = (PCache1 *)p;+ PgHdr1 *pPage = (PgHdr1 *)pPg;+ PGroup *pGroup = pCache->pGroup;+ + assert( pPage->pCache==pCache );+ pcache1EnterMutex(pGroup);++ /* It is an error to call this function if the page is already + ** part of the PGroup LRU list.+ */+ assert( pPage->pLruPrev==0 && pPage->pLruNext==0 );+ assert( pPage->isPinned==1 );++ if( reuseUnlikely || pGroup->nCurrentPage>pGroup->nMaxPage ){+ pcache1RemoveFromHash(pPage, 1);+ }else{+ /* Add the page to the PGroup LRU list. */+ PgHdr1 **ppFirst = &pGroup->lru.pLruNext;+ pPage->pLruPrev = &pGroup->lru;+ (pPage->pLruNext = *ppFirst)->pLruPrev = pPage;+ *ppFirst = pPage;+ pCache->nRecyclable++;+ pPage->isPinned = 0;+ }++ pcache1LeaveMutex(pCache->pGroup);+}++/*+** Implementation of the sqlite3_pcache.xRekey method. +*/+static void pcache1Rekey(+ sqlite3_pcache *p,+ sqlite3_pcache_page *pPg,+ unsigned int iOld,+ unsigned int iNew+){+ PCache1 *pCache = (PCache1 *)p;+ PgHdr1 *pPage = (PgHdr1 *)pPg;+ PgHdr1 **pp;+ unsigned int h; + assert( pPage->iKey==iOld );+ assert( pPage->pCache==pCache );++ pcache1EnterMutex(pCache->pGroup);++ h = iOld%pCache->nHash;+ pp = &pCache->apHash[h];+ while( (*pp)!=pPage ){+ pp = &(*pp)->pNext;+ }+ *pp = pPage->pNext;++ h = iNew%pCache->nHash;+ pPage->iKey = iNew;+ pPage->pNext = pCache->apHash[h];+ pCache->apHash[h] = pPage;+ if( iNew>pCache->iMaxKey ){+ pCache->iMaxKey = iNew;+ }++ pcache1LeaveMutex(pCache->pGroup);+}++/*+** Implementation of the sqlite3_pcache.xTruncate method. +**+** Discard all unpinned pages in the cache with a page number equal to+** or greater than parameter iLimit. Any pinned pages with a page number+** equal to or greater than iLimit are implicitly unpinned.+*/+static void pcache1Truncate(sqlite3_pcache *p, unsigned int iLimit){+ PCache1 *pCache = (PCache1 *)p;+ pcache1EnterMutex(pCache->pGroup);+ if( iLimit<=pCache->iMaxKey ){+ pcache1TruncateUnsafe(pCache, iLimit);+ pCache->iMaxKey = iLimit-1;+ }+ pcache1LeaveMutex(pCache->pGroup);+}++/*+** Implementation of the sqlite3_pcache.xDestroy method. +**+** Destroy a cache allocated using pcache1Create().+*/+static void pcache1Destroy(sqlite3_pcache *p){+ PCache1 *pCache = (PCache1 *)p;+ PGroup *pGroup = pCache->pGroup;+ assert( pCache->bPurgeable || (pCache->nMax==0 && pCache->nMin==0) );+ pcache1EnterMutex(pGroup);+ pcache1TruncateUnsafe(pCache, 0);+ assert( pGroup->nMaxPage >= pCache->nMax );+ pGroup->nMaxPage -= pCache->nMax;+ assert( pGroup->nMinPage >= pCache->nMin );+ pGroup->nMinPage -= pCache->nMin;+ pGroup->mxPinned = pGroup->nMaxPage + 10 - pGroup->nMinPage;+ pcache1EnforceMaxPage(pCache);+ pcache1LeaveMutex(pGroup);+ sqlite3_free(pCache->pBulk);+ sqlite3_free(pCache->apHash);+ sqlite3_free(pCache);+}++/*+** This function is called during initialization (sqlite3BtreeInitialize()) to+** install the default pluggable cache module, assuming the user has not+** already provided an alternative.+*/+SQLITE_PRIVATE void sqlite3PCacheSetDefault(void){+ static const sqlite3_pcache_methods2 defaultMethods = {+ 1, /* iVersion */+ 0, /* pArg */+ pcache1Init, /* xInit */+ pcache1Shutdown, /* xShutdown */+ pcache1Create, /* xCreate */+ pcache1Cachesize, /* xCachesize */+ pcache1Pagecount, /* xPagecount */+ pcache1Fetch, /* xFetch */+ pcache1Unpin, /* xUnpin */+ pcache1Rekey, /* xRekey */+ pcache1Truncate, /* xTruncate */+ pcache1Destroy, /* xDestroy */+ pcache1Shrink /* xShrink */+ };+ sqlite3_config(SQLITE_CONFIG_PCACHE2, &defaultMethods);+}++/*+** Return the size of the header on each page of this PCACHE implementation.+*/+SQLITE_PRIVATE int sqlite3HeaderSizePcache1(void){ return ROUND8(sizeof(PgHdr1)); }++/*+** Return the global mutex used by this PCACHE implementation. The+** sqlite3_status() routine needs access to this mutex.+*/+#ifndef NDEBUG+SQLITE_PRIVATE sqlite3_mutex *sqlite3Pcache1Mutex(void){+ return pcache1.mutex;+}+#endif++#ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT+/*+** This function is called to free superfluous dynamically allocated memory+** held by the pager system. Memory in use by any SQLite pager allocated+** by the current thread may be sqlite3_free()ed.+**+** nReq is the number of bytes of memory required. Once this much has+** been released, the function returns. The return value is the total number +** of bytes of memory released.+*/+SQLITE_PRIVATE int sqlite3PcacheReleaseMemory(int nReq){+ int nFree = 0;+ assert( sqlite3_mutex_notheld(pcache1.grp.mutex) );+ assert( sqlite3_mutex_notheld(pcache1.mutex) );+ if( sqlite3GlobalConfig.nPage==0 ){+ PgHdr1 *p;+ pcache1EnterMutex(&pcache1.grp);+ while( (nReq<0 || nFree<nReq)+ && (p=pcache1.grp.lru.pLruPrev)!=0+ && p->isAnchor==0+ ){+ nFree += pcache1MemSize(p->page.pBuf);+#ifdef SQLITE_PCACHE_SEPARATE_HEADER+ nFree += sqlite3MemSize(p);+#endif+ assert( p->isPinned==0 );+ pcache1PinPage(p);+ pcache1RemoveFromHash(p, 1);+ }+ pcache1LeaveMutex(&pcache1.grp);+ }+ return nFree;+}+#endif /* SQLITE_ENABLE_MEMORY_MANAGEMENT */++#ifdef SQLITE_TEST+/*+** This function is used by test procedures to inspect the internal state+** of the global cache.+*/+SQLITE_PRIVATE void sqlite3PcacheStats(+ int *pnCurrent, /* OUT: Total number of pages cached */+ int *pnMax, /* OUT: Global maximum cache size */+ int *pnMin, /* OUT: Sum of PCache1.nMin for purgeable caches */+ int *pnRecyclable /* OUT: Total number of pages available for recycling */+){+ PgHdr1 *p;+ int nRecyclable = 0;+ for(p=pcache1.grp.lru.pLruNext; p && !p->isAnchor; p=p->pLruNext){+ assert( p->isPinned==0 );+ nRecyclable++;+ }+ *pnCurrent = pcache1.grp.nCurrentPage;+ *pnMax = (int)pcache1.grp.nMaxPage;+ *pnMin = (int)pcache1.grp.nMinPage;+ *pnRecyclable = nRecyclable;+}+#endif++/************** End of pcache1.c *********************************************/+/************** Begin file pager.c *******************************************/+/*+** 2001 September 15+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This is the implementation of the page cache subsystem or "pager".+** +** The pager is used to access a database disk file. It implements+** atomic commit and rollback through the use of a journal file that+** is separate from the database file. The pager also implements file+** locking to prevent two processes from writing the same database+** file simultaneously, or one process from reading the database while+** another is writing.+*/+#ifndef SQLITE_OMIT_DISKIO+/* #include "sqliteInt.h" */+/************** Include wal.h in the middle of pager.c ***********************/+/************** Begin file wal.h *********************************************/+/*+** 2010 February 1+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This header file defines the interface to the write-ahead logging +** system. Refer to the comments below and the header comment attached to +** the implementation of each function in log.c for further details.+*/++#ifndef _WAL_H_+#define _WAL_H_++/* #include "sqliteInt.h" */++/* Additional values that can be added to the sync_flags argument of+** sqlite3WalFrames():+*/+#define WAL_SYNC_TRANSACTIONS 0x20 /* Sync at the end of each transaction */+#define SQLITE_SYNC_MASK 0x13 /* Mask off the SQLITE_SYNC_* values */++#ifdef SQLITE_OMIT_WAL+# define sqlite3WalOpen(x,y,z) 0+#if 0+# define sqlite3WalLimit(x,y)+#endif+# define sqlite3WalClose(w,x,y,z) 0+# define sqlite3WalBeginReadTransaction(y,z) 0+# define sqlite3WalEndReadTransaction(z)+# define sqlite3WalDbsize(y) 0+# define sqlite3WalBeginWriteTransaction(y) 0+# define sqlite3WalEndWriteTransaction(x) 0+# define sqlite3WalUndo(x,y,z) 0+# define sqlite3WalSavepoint(y,z)+# define sqlite3WalSavepointUndo(y,z) 0+# define sqlite3WalFrames(u,v,w,x,y,z) 0+# define sqlite3WalCheckpoint(r,s,t,u,v,w,x,y,z) 0+#if 0+# define sqlite3WalCallback(z) 0+#endif+# define sqlite3WalExclusiveMode(y,z) 0+#if 0+# define sqlite3WalHeapMemory(z) 0+#endif+# define sqlite3WalFramesize(z) 0+# define sqlite3WalFindFrame(x,y,z) 0+#else++#define WAL_SAVEPOINT_NDATA 4++/* Connection to a write-ahead log (WAL) file. +** There is one object of this type for each pager. +*/+typedef struct Wal Wal;++/* Open and close a connection to a write-ahead log. */+SQLITE_PRIVATE int sqlite3WalOpen(sqlite3_vfs*, sqlite3_file*, const char *, int, i64, Wal**);+SQLITE_PRIVATE int sqlite3WalClose(Wal *pWal, int sync_flags, int, u8 *);++#if 0+/* Set the limiting size of a WAL file. */+SQLITE_PRIVATE void sqlite3WalLimit(Wal*, i64);+#endif++/* Used by readers to open (lock) and close (unlock) a snapshot. A +** snapshot is like a read-transaction. It is the state of the database+** at an instant in time. sqlite3WalOpenSnapshot gets a read lock and+** preserves the current state even if the other threads or processes+** write to or checkpoint the WAL. sqlite3WalCloseSnapshot() closes the+** transaction and releases the lock.+*/+SQLITE_PRIVATE int sqlite3WalBeginReadTransaction(Wal *pWal, int *);+SQLITE_PRIVATE void sqlite3WalEndReadTransaction(Wal *pWal);++/* Read a page from the write-ahead log, if it is present. */+SQLITE_PRIVATE int sqlite3WalFindFrame(Wal *, Pgno, u32 *);+SQLITE_PRIVATE int sqlite3WalReadFrame(Wal *, u32, int, u8 *);++/* If the WAL is not empty, return the size of the database. */+SQLITE_PRIVATE Pgno sqlite3WalDbsize(Wal *pWal);++/* Obtain or release the WRITER lock. */+SQLITE_PRIVATE int sqlite3WalBeginWriteTransaction(Wal *pWal);+SQLITE_PRIVATE int sqlite3WalEndWriteTransaction(Wal *pWal);++/* Undo any frames written (but not committed) to the log */+SQLITE_PRIVATE int sqlite3WalUndo(Wal *pWal, int (*xUndo)(void *, Pgno), void *pUndoCtx);++/* Return an integer that records the current (uncommitted) write+** position in the WAL */+SQLITE_PRIVATE void sqlite3WalSavepoint(Wal *pWal, u32 *aWalData);++/* Move the write position of the WAL back to iFrame. Called in+** response to a ROLLBACK TO command. */+SQLITE_PRIVATE int sqlite3WalSavepointUndo(Wal *pWal, u32 *aWalData);++/* Write a frame or frames to the log. */+SQLITE_PRIVATE int sqlite3WalFrames(Wal *pWal, int, PgHdr *, Pgno, int, int);++/* Copy pages from the log to the database file */ +SQLITE_PRIVATE int sqlite3WalCheckpoint(+ Wal *pWal, /* Write-ahead log connection */+ int eMode, /* One of PASSIVE, FULL and RESTART */+ int (*xBusy)(void*), /* Function to call when busy */+ void *pBusyArg, /* Context argument for xBusyHandler */+ int sync_flags, /* Flags to sync db file with (or 0) */+ int nBuf, /* Size of buffer nBuf */+ u8 *zBuf, /* Temporary buffer to use */+ int *pnLog, /* OUT: Number of frames in WAL */+ int *pnCkpt /* OUT: Number of backfilled frames in WAL */+);++#if 0+/* Return the value to pass to a sqlite3_wal_hook callback, the+** number of frames in the WAL at the point of the last commit since+** sqlite3WalCallback() was called. If no commits have occurred since+** the last call, then return 0.+*/+SQLITE_PRIVATE int sqlite3WalCallback(Wal *pWal);+#endif++/* Tell the wal layer that an EXCLUSIVE lock has been obtained (or released)+** by the pager layer on the database file.+*/+SQLITE_PRIVATE int sqlite3WalExclusiveMode(Wal *pWal, int op);++#if 0+/* Return true if the argument is non-NULL and the WAL module is using+** heap-memory for the wal-index. Otherwise, if the argument is NULL or the+** WAL module is using shared-memory, return false. +*/+SQLITE_PRIVATE int sqlite3WalHeapMemory(Wal *pWal);+#endif++#ifdef SQLITE_ENABLE_ZIPVFS+/* If the WAL file is not empty, return the number of bytes of content+** stored in each frame (i.e. the db page-size when the WAL was created).+*/+SQLITE_PRIVATE int sqlite3WalFramesize(Wal *pWal);+#endif++#endif /* ifndef SQLITE_OMIT_WAL */+#endif /* _WAL_H_ */++/************** End of wal.h *************************************************/+/************** Continuing where we left off in pager.c **********************/+++/******************* NOTES ON THE DESIGN OF THE PAGER ************************+**+** This comment block describes invariants that hold when using a rollback+** journal. These invariants do not apply for journal_mode=WAL,+** journal_mode=MEMORY, or journal_mode=OFF.+**+** Within this comment block, a page is deemed to have been synced+** automatically as soon as it is written when PRAGMA synchronous=OFF.+** Otherwise, the page is not synced until the xSync method of the VFS+** is called successfully on the file containing the page.+**+** Definition: A page of the database file is said to be "overwriteable" if+** one or more of the following are true about the page:+** +** (a) The original content of the page as it was at the beginning of+** the transaction has been written into the rollback journal and+** synced.+** +** (b) The page was a freelist leaf page at the start of the transaction.+** +** (c) The page number is greater than the largest page that existed in+** the database file at the start of the transaction.+** +** (1) A page of the database file is never overwritten unless one of the+** following are true:+** +** (a) The page and all other pages on the same sector are overwriteable.+** +** (b) The atomic page write optimization is enabled, and the entire+** transaction other than the update of the transaction sequence+** number consists of a single page change.+** +** (2) The content of a page written into the rollback journal exactly matches+** both the content in the database when the rollback journal was written+** and the content in the database at the beginning of the current+** transaction.+** +** (3) Writes to the database file are an integer multiple of the page size+** in length and are aligned on a page boundary.+** +** (4) Reads from the database file are either aligned on a page boundary and+** an integer multiple of the page size in length or are taken from the+** first 100 bytes of the database file.+** +** (5) All writes to the database file are synced prior to the rollback journal+** being deleted, truncated, or zeroed.+** +** (6) If a master journal file is used, then all writes to the database file+** are synced prior to the master journal being deleted.+** +** Definition: Two databases (or the same database at two points it time)+** are said to be "logically equivalent" if they give the same answer to+** all queries. Note in particular the content of freelist leaf+** pages can be changed arbitrarily without affecting the logical equivalence+** of the database.+** +** (7) At any time, if any subset, including the empty set and the total set,+** of the unsynced changes to a rollback journal are removed and the +** journal is rolled back, the resulting database file will be logically+** equivalent to the database file at the beginning of the transaction.+** +** (8) When a transaction is rolled back, the xTruncate method of the VFS+** is called to restore the database file to the same size it was at+** the beginning of the transaction. (In some VFSes, the xTruncate+** method is a no-op, but that does not change the fact the SQLite will+** invoke it.)+** +** (9) Whenever the database file is modified, at least one bit in the range+** of bytes from 24 through 39 inclusive will be changed prior to releasing+** the EXCLUSIVE lock, thus signaling other connections on the same+** database to flush their caches.+**+** (10) The pattern of bits in bytes 24 through 39 shall not repeat in less+** than one billion transactions.+**+** (11) A database file is well-formed at the beginning and at the conclusion+** of every transaction.+**+** (12) An EXCLUSIVE lock is held on the database file when writing to+** the database file.+**+** (13) A SHARED lock is held on the database file while reading any+** content out of the database file.+**+******************************************************************************/++/*+** Macros for troubleshooting. Normally turned off+*/+#if 0+int sqlite3PagerTrace=1; /* True to enable tracing */+#define sqlite3DebugPrintf printf+#define PAGERTRACE(X) if( sqlite3PagerTrace ){ sqlite3DebugPrintf X; }+#else+#define PAGERTRACE(X)+#endif++/*+** The following two macros are used within the PAGERTRACE() macros above+** to print out file-descriptors. +**+** PAGERID() takes a pointer to a Pager struct as its argument. The+** associated file-descriptor is returned. FILEHANDLEID() takes an sqlite3_file+** struct as its argument.+*/+#define PAGERID(p) ((int)(p->fd))+#define FILEHANDLEID(fd) ((int)fd)++/*+** The Pager.eState variable stores the current 'state' of a pager. A+** pager may be in any one of the seven states shown in the following+** state diagram.+**+** OPEN <------+------++** | | |+** V | |+** +---------> READER-------+ |+** | | |+** | V |+** |<-------WRITER_LOCKED------> ERROR+** | | ^ +** | V |+** |<------WRITER_CACHEMOD-------->|+** | | |+** | V |+** |<-------WRITER_DBMOD---------->|+** | | |+** | V |+** +<------WRITER_FINISHED-------->++**+**+** List of state transitions and the C [function] that performs each:+** +** OPEN -> READER [sqlite3PagerSharedLock]+** READER -> OPEN [pager_unlock]+**+** READER -> WRITER_LOCKED [sqlite3PagerBegin]+** WRITER_LOCKED -> WRITER_CACHEMOD [pager_open_journal]+** WRITER_CACHEMOD -> WRITER_DBMOD [syncJournal]+** WRITER_DBMOD -> WRITER_FINISHED [sqlite3PagerCommitPhaseOne]+** WRITER_*** -> READER [pager_end_transaction]+**+** WRITER_*** -> ERROR [pager_error]+** ERROR -> OPEN [pager_unlock]+** +**+** OPEN:+**+** The pager starts up in this state. Nothing is guaranteed in this+** state - the file may or may not be locked and the database size is+** unknown. The database may not be read or written.+**+** * No read or write transaction is active.+** * Any lock, or no lock at all, may be held on the database file.+** * The dbSize, dbOrigSize and dbFileSize variables may not be trusted.+**+** READER:+**+** In this state all the requirements for reading the database in +** rollback (non-WAL) mode are met. Unless the pager is (or recently+** was) in exclusive-locking mode, a user-level read transaction is +** open. The database size is known in this state.+**+** A connection running with locking_mode=normal enters this state when+** it opens a read-transaction on the database and returns to state+** OPEN after the read-transaction is completed. However a connection+** running in locking_mode=exclusive (including temp databases) remains in+** this state even after the read-transaction is closed. The only way+** a locking_mode=exclusive connection can transition from READER to OPEN+** is via the ERROR state (see below).+** +** * A read transaction may be active (but a write-transaction cannot).+** * A SHARED or greater lock is held on the database file.+** * The dbSize variable may be trusted (even if a user-level read +** transaction is not active). The dbOrigSize and dbFileSize variables+** may not be trusted at this point.+** * If the database is a WAL database, then the WAL connection is open.+** * Even if a read-transaction is not open, it is guaranteed that +** there is no hot-journal in the file-system.+**+** WRITER_LOCKED:+**+** The pager moves to this state from READER when a write-transaction+** is first opened on the database. In WRITER_LOCKED state, all locks +** required to start a write-transaction are held, but no actual +** modifications to the cache or database have taken place.+**+** In rollback mode, a RESERVED or (if the transaction was opened with +** BEGIN EXCLUSIVE) EXCLUSIVE lock is obtained on the database file when+** moving to this state, but the journal file is not written to or opened +** to in this state. If the transaction is committed or rolled back while +** in WRITER_LOCKED state, all that is required is to unlock the database +** file.+**+** IN WAL mode, WalBeginWriteTransaction() is called to lock the log file.+** If the connection is running with locking_mode=exclusive, an attempt+** is made to obtain an EXCLUSIVE lock on the database file.+**+** * A write transaction is active.+** * If the connection is open in rollback-mode, a RESERVED or greater +** lock is held on the database file.+** * If the connection is open in WAL-mode, a WAL write transaction+** is open (i.e. sqlite3WalBeginWriteTransaction() has been successfully+** called).+** * The dbSize, dbOrigSize and dbFileSize variables are all valid.+** * The contents of the pager cache have not been modified.+** * The journal file may or may not be open.+** * Nothing (not even the first header) has been written to the journal.+**+** WRITER_CACHEMOD:+**+** A pager moves from WRITER_LOCKED state to this state when a page is+** first modified by the upper layer. In rollback mode the journal file+** is opened (if it is not already open) and a header written to the+** start of it. The database file on disk has not been modified.+**+** * A write transaction is active.+** * A RESERVED or greater lock is held on the database file.+** * The journal file is open and the first header has been written +** to it, but the header has not been synced to disk.+** * The contents of the page cache have been modified.+**+** WRITER_DBMOD:+**+** The pager transitions from WRITER_CACHEMOD into WRITER_DBMOD state+** when it modifies the contents of the database file. WAL connections+** never enter this state (since they do not modify the database file,+** just the log file).+**+** * A write transaction is active.+** * An EXCLUSIVE or greater lock is held on the database file.+** * The journal file is open and the first header has been written +** and synced to disk.+** * The contents of the page cache have been modified (and possibly+** written to disk).+**+** WRITER_FINISHED:+**+** It is not possible for a WAL connection to enter this state.+**+** A rollback-mode pager changes to WRITER_FINISHED state from WRITER_DBMOD+** state after the entire transaction has been successfully written into the+** database file. In this state the transaction may be committed simply+** by finalizing the journal file. Once in WRITER_FINISHED state, it is +** not possible to modify the database further. At this point, the upper +** layer must either commit or rollback the transaction.+**+** * A write transaction is active.+** * An EXCLUSIVE or greater lock is held on the database file.+** * All writing and syncing of journal and database data has finished.+** If no error occurred, all that remains is to finalize the journal to+** commit the transaction. If an error did occur, the caller will need+** to rollback the transaction. +**+** ERROR:+**+** The ERROR state is entered when an IO or disk-full error (including+** SQLITE_IOERR_NOMEM) occurs at a point in the code that makes it +** difficult to be sure that the in-memory pager state (cache contents, +** db size etc.) are consistent with the contents of the file-system.+**+** Temporary pager files may enter the ERROR state, but in-memory pagers+** cannot.+**+** For example, if an IO error occurs while performing a rollback, +** the contents of the page-cache may be left in an inconsistent state.+** At this point it would be dangerous to change back to READER state+** (as usually happens after a rollback). Any subsequent readers might+** report database corruption (due to the inconsistent cache), and if+** they upgrade to writers, they may inadvertently corrupt the database+** file. To avoid this hazard, the pager switches into the ERROR state+** instead of READER following such an error.+**+** Once it has entered the ERROR state, any attempt to use the pager+** to read or write data returns an error. Eventually, once all +** outstanding transactions have been abandoned, the pager is able to+** transition back to OPEN state, discarding the contents of the +** page-cache and any other in-memory state at the same time. Everything+** is reloaded from disk (and, if necessary, hot-journal rollback peformed)+** when a read-transaction is next opened on the pager (transitioning+** the pager into READER state). At that point the system has recovered +** from the error.+**+** Specifically, the pager jumps into the ERROR state if:+**+** 1. An error occurs while attempting a rollback. This happens in+** function sqlite3PagerRollback().+**+** 2. An error occurs while attempting to finalize a journal file+** following a commit in function sqlite3PagerCommitPhaseTwo().+**+** 3. An error occurs while attempting to write to the journal or+** database file in function pagerStress() in order to free up+** memory.+**+** In other cases, the error is returned to the b-tree layer. The b-tree+** layer then attempts a rollback operation. If the error condition +** persists, the pager enters the ERROR state via condition (1) above.+**+** Condition (3) is necessary because it can be triggered by a read-only+** statement executed within a transaction. In this case, if the error+** code were simply returned to the user, the b-tree layer would not+** automatically attempt a rollback, as it assumes that an error in a+** read-only statement cannot leave the pager in an internally inconsistent +** state.+**+** * The Pager.errCode variable is set to something other than SQLITE_OK.+** * There are one or more outstanding references to pages (after the+** last reference is dropped the pager should move back to OPEN state).+** * The pager is not an in-memory pager.+** +**+** Notes:+**+** * A pager is never in WRITER_DBMOD or WRITER_FINISHED state if the+** connection is open in WAL mode. A WAL connection is always in one+** of the first four states.+**+** * Normally, a connection open in exclusive mode is never in PAGER_OPEN+** state. There are two exceptions: immediately after exclusive-mode has+** been turned on (and before any read or write transactions are +** executed), and when the pager is leaving the "error state".+**+** * See also: assert_pager_state().+*/+#define PAGER_OPEN 0+#define PAGER_READER 1+#define PAGER_WRITER_LOCKED 2+#define PAGER_WRITER_CACHEMOD 3+#define PAGER_WRITER_DBMOD 4+#define PAGER_WRITER_FINISHED 5+#define PAGER_ERROR 6++/*+** The Pager.eLock variable is almost always set to one of the +** following locking-states, according to the lock currently held on+** the database file: NO_LOCK, SHARED_LOCK, RESERVED_LOCK or EXCLUSIVE_LOCK.+** This variable is kept up to date as locks are taken and released by+** the pagerLockDb() and pagerUnlockDb() wrappers.+**+** If the VFS xLock() or xUnlock() returns an error other than SQLITE_BUSY+** (i.e. one of the SQLITE_IOERR subtypes), it is not clear whether or not+** the operation was successful. In these circumstances pagerLockDb() and+** pagerUnlockDb() take a conservative approach - eLock is always updated+** when unlocking the file, and only updated when locking the file if the+** VFS call is successful. This way, the Pager.eLock variable may be set+** to a less exclusive (lower) value than the lock that is actually held+** at the system level, but it is never set to a more exclusive value.+**+** This is usually safe. If an xUnlock fails or appears to fail, there may +** be a few redundant xLock() calls or a lock may be held for longer than+** required, but nothing really goes wrong.+**+** The exception is when the database file is unlocked as the pager moves+** from ERROR to OPEN state. At this point there may be a hot-journal file +** in the file-system that needs to be rolled back (as part of an OPEN->SHARED+** transition, by the same pager or any other). If the call to xUnlock()+** fails at this point and the pager is left holding an EXCLUSIVE lock, this+** can confuse the call to xCheckReservedLock() call made later as part+** of hot-journal detection.+**+** xCheckReservedLock() is defined as returning true "if there is a RESERVED +** lock held by this process or any others". So xCheckReservedLock may +** return true because the caller itself is holding an EXCLUSIVE lock (but+** doesn't know it because of a previous error in xUnlock). If this happens+** a hot-journal may be mistaken for a journal being created by an active+** transaction in another process, causing SQLite to read from the database+** without rolling it back.+**+** To work around this, if a call to xUnlock() fails when unlocking the+** database in the ERROR state, Pager.eLock is set to UNKNOWN_LOCK. It+** is only changed back to a real locking state after a successful call+** to xLock(EXCLUSIVE). Also, the code to do the OPEN->SHARED state transition+** omits the check for a hot-journal if Pager.eLock is set to UNKNOWN_LOCK +** lock. Instead, it assumes a hot-journal exists and obtains an EXCLUSIVE+** lock on the database file before attempting to roll it back. See function+** PagerSharedLock() for more detail.+**+** Pager.eLock may only be set to UNKNOWN_LOCK when the pager is in +** PAGER_OPEN state.+*/+#define UNKNOWN_LOCK (EXCLUSIVE_LOCK+1)++/*+** A macro used for invoking the codec if there is one+*/+#ifdef SQLITE_HAS_CODEC+# define CODEC1(P,D,N,X,E) \+ if( P->xCodec && P->xCodec(P->pCodec,D,N,X)==0 ){ E; }+# define CODEC2(P,D,N,X,E,O) \+ if( P->xCodec==0 ){ O=(char*)D; }else \+ if( (O=(char*)(P->xCodec(P->pCodec,D,N,X)))==0 ){ E; }+#else+# define CODEC1(P,D,N,X,E) /* NO-OP */+# define CODEC2(P,D,N,X,E,O) O=(char*)D+#endif++/*+** The maximum allowed sector size. 64KiB. If the xSectorsize() method +** returns a value larger than this, then MAX_SECTOR_SIZE is used instead.+** This could conceivably cause corruption following a power failure on+** such a system. This is currently an undocumented limit.+*/+#define MAX_SECTOR_SIZE 0x10000++/*+** An instance of the following structure is allocated for each active+** savepoint and statement transaction in the system. All such structures+** are stored in the Pager.aSavepoint[] array, which is allocated and+** resized using sqlite3Realloc().+**+** When a savepoint is created, the PagerSavepoint.iHdrOffset field is+** set to 0. If a journal-header is written into the main journal while+** the savepoint is active, then iHdrOffset is set to the byte offset +** immediately following the last journal record written into the main+** journal before the journal-header. This is required during savepoint+** rollback (see pagerPlaybackSavepoint()).+*/+typedef struct PagerSavepoint PagerSavepoint;+struct PagerSavepoint {+ i64 iOffset; /* Starting offset in main journal */+ i64 iHdrOffset; /* See above */+ Bitvec *pInSavepoint; /* Set of pages in this savepoint */+ Pgno nOrig; /* Original number of pages in file */+ Pgno iSubRec; /* Index of first record in sub-journal */+#ifndef SQLITE_OMIT_WAL+ u32 aWalData[WAL_SAVEPOINT_NDATA]; /* WAL savepoint context */+#endif+};++/*+** Bits of the Pager.doNotSpill flag. See further description below.+*/+#define SPILLFLAG_OFF 0x01 /* Never spill cache. Set via pragma */+#define SPILLFLAG_ROLLBACK 0x02 /* Current rolling back, so do not spill */+#define SPILLFLAG_NOSYNC 0x04 /* Spill is ok, but do not sync */++/*+** An open page cache is an instance of struct Pager. A description of+** some of the more important member variables follows:+**+** eState+**+** The current 'state' of the pager object. See the comment and state+** diagram above for a description of the pager state.+**+** eLock+**+** For a real on-disk database, the current lock held on the database file -+** NO_LOCK, SHARED_LOCK, RESERVED_LOCK or EXCLUSIVE_LOCK.+**+** For a temporary or in-memory database (neither of which require any+** locks), this variable is always set to EXCLUSIVE_LOCK. Since such+** databases always have Pager.exclusiveMode==1, this tricks the pager+** logic into thinking that it already has all the locks it will ever+** need (and no reason to release them).+**+** In some (obscure) circumstances, this variable may also be set to+** UNKNOWN_LOCK. See the comment above the #define of UNKNOWN_LOCK for+** details.+**+** changeCountDone+**+** This boolean variable is used to make sure that the change-counter +** (the 4-byte header field at byte offset 24 of the database file) is +** not updated more often than necessary. +**+** It is set to true when the change-counter field is updated, which +** can only happen if an exclusive lock is held on the database file.+** It is cleared (set to false) whenever an exclusive lock is +** relinquished on the database file. Each time a transaction is committed,+** The changeCountDone flag is inspected. If it is true, the work of+** updating the change-counter is omitted for the current transaction.+**+** This mechanism means that when running in exclusive mode, a connection +** need only update the change-counter once, for the first transaction+** committed.+**+** setMaster+**+** When PagerCommitPhaseOne() is called to commit a transaction, it may+** (or may not) specify a master-journal name to be written into the +** journal file before it is synced to disk.+**+** Whether or not a journal file contains a master-journal pointer affects +** the way in which the journal file is finalized after the transaction is +** committed or rolled back when running in "journal_mode=PERSIST" mode.+** If a journal file does not contain a master-journal pointer, it is+** finalized by overwriting the first journal header with zeroes. If+** it does contain a master-journal pointer the journal file is finalized +** by truncating it to zero bytes, just as if the connection were +** running in "journal_mode=truncate" mode.+**+** Journal files that contain master journal pointers cannot be finalized+** simply by overwriting the first journal-header with zeroes, as the+** master journal pointer could interfere with hot-journal rollback of any+** subsequently interrupted transaction that reuses the journal file.+**+** The flag is cleared as soon as the journal file is finalized (either+** by PagerCommitPhaseTwo or PagerRollback). If an IO error prevents the+** journal file from being successfully finalized, the setMaster flag+** is cleared anyway (and the pager will move to ERROR state).+**+** doNotSpill+**+** This variables control the behavior of cache-spills (calls made by+** the pcache module to the pagerStress() routine to write cached data+** to the file-system in order to free up memory).+**+** When bits SPILLFLAG_OFF or SPILLFLAG_ROLLBACK of doNotSpill are set,+** writing to the database from pagerStress() is disabled altogether.+** The SPILLFLAG_ROLLBACK case is done in a very obscure case that+** comes up during savepoint rollback that requires the pcache module+** to allocate a new page to prevent the journal file from being written+** while it is being traversed by code in pager_playback(). The SPILLFLAG_OFF+** case is a user preference.+** +** If the SPILLFLAG_NOSYNC bit is set, writing to the database from+** pagerStress() is permitted, but syncing the journal file is not.+** This flag is set by sqlite3PagerWrite() when the file-system sector-size+** is larger than the database page-size in order to prevent a journal sync+** from happening in between the journalling of two pages on the same sector. +**+** subjInMemory+**+** This is a boolean variable. If true, then any required sub-journal+** is opened as an in-memory journal file. If false, then in-memory+** sub-journals are only used for in-memory pager files.+**+** This variable is updated by the upper layer each time a new +** write-transaction is opened.+**+** dbSize, dbOrigSize, dbFileSize+**+** Variable dbSize is set to the number of pages in the database file.+** It is valid in PAGER_READER and higher states (all states except for+** OPEN and ERROR). +**+** dbSize is set based on the size of the database file, which may be +** larger than the size of the database (the value stored at offset+** 28 of the database header by the btree). If the size of the file+** is not an integer multiple of the page-size, the value stored in+** dbSize is rounded down (i.e. a 5KB file with 2K page-size has dbSize==2).+** Except, any file that is greater than 0 bytes in size is considered+** to have at least one page. (i.e. a 1KB file with 2K page-size leads+** to dbSize==1).+**+** During a write-transaction, if pages with page-numbers greater than+** dbSize are modified in the cache, dbSize is updated accordingly.+** Similarly, if the database is truncated using PagerTruncateImage(), +** dbSize is updated.+**+** Variables dbOrigSize and dbFileSize are valid in states +** PAGER_WRITER_LOCKED and higher. dbOrigSize is a copy of the dbSize+** variable at the start of the transaction. It is used during rollback,+** and to determine whether or not pages need to be journalled before+** being modified.+**+** Throughout a write-transaction, dbFileSize contains the size of+** the file on disk in pages. It is set to a copy of dbSize when the+** write-transaction is first opened, and updated when VFS calls are made+** to write or truncate the database file on disk. +**+** The only reason the dbFileSize variable is required is to suppress +** unnecessary calls to xTruncate() after committing a transaction. If, +** when a transaction is committed, the dbFileSize variable indicates +** that the database file is larger than the database image (Pager.dbSize), +** pager_truncate() is called. The pager_truncate() call uses xFilesize()+** to measure the database file on disk, and then truncates it if required.+** dbFileSize is not used when rolling back a transaction. In this case+** pager_truncate() is called unconditionally (which means there may be+** a call to xFilesize() that is not strictly required). In either case,+** pager_truncate() may cause the file to become smaller or larger.+**+** dbHintSize+**+** The dbHintSize variable is used to limit the number of calls made to+** the VFS xFileControl(FCNTL_SIZE_HINT) method. +**+** dbHintSize is set to a copy of the dbSize variable when a+** write-transaction is opened (at the same time as dbFileSize and+** dbOrigSize). If the xFileControl(FCNTL_SIZE_HINT) method is called,+** dbHintSize is increased to the number of pages that correspond to the+** size-hint passed to the method call. See pager_write_pagelist() for +** details.+**+** errCode+**+** The Pager.errCode variable is only ever used in PAGER_ERROR state. It+** is set to zero in all other states. In PAGER_ERROR state, Pager.errCode +** is always set to SQLITE_FULL, SQLITE_IOERR or one of the SQLITE_IOERR_XXX +** sub-codes.+*/+struct Pager {+ sqlite3_vfs *pVfs; /* OS functions to use for IO */+ u8 exclusiveMode; /* Boolean. True if locking_mode==EXCLUSIVE */+ u8 journalMode; /* One of the PAGER_JOURNALMODE_* values */+ u8 useJournal; /* Use a rollback journal on this file */+ u8 noSync; /* Do not sync the journal if true */+ u8 fullSync; /* Do extra syncs of the journal for robustness */+ u8 ckptSyncFlags; /* SYNC_NORMAL or SYNC_FULL for checkpoint */+ u8 walSyncFlags; /* SYNC_NORMAL or SYNC_FULL for wal writes */+ u8 syncFlags; /* SYNC_NORMAL or SYNC_FULL otherwise */+ u8 tempFile; /* zFilename is a temporary or immutable file */+ u8 noLock; /* Do not lock (except in WAL mode) */+ u8 readOnly; /* True for a read-only database */+ u8 memDb; /* True to inhibit all file I/O */++ /**************************************************************************+ ** The following block contains those class members that change during+ ** routine operation. Class members not in this block are either fixed+ ** when the pager is first created or else only change when there is a+ ** significant mode change (such as changing the page_size, locking_mode,+ ** or the journal_mode). From another view, these class members describe+ ** the "state" of the pager, while other class members describe the+ ** "configuration" of the pager.+ */+ u8 eState; /* Pager state (OPEN, READER, WRITER_LOCKED..) */+ u8 eLock; /* Current lock held on database file */+ u8 changeCountDone; /* Set after incrementing the change-counter */+ u8 setMaster; /* True if a m-j name has been written to jrnl */+ u8 doNotSpill; /* Do not spill the cache when non-zero */+ u8 subjInMemory; /* True to use in-memory sub-journals */+ u8 bUseFetch; /* True to use xFetch() */+ u8 hasHeldSharedLock; /* True if a shared lock has ever been held */+ Pgno dbSize; /* Number of pages in the database */+ Pgno dbOrigSize; /* dbSize before the current transaction */+ Pgno dbFileSize; /* Number of pages in the database file */+ Pgno dbHintSize; /* Value passed to FCNTL_SIZE_HINT call */+ int errCode; /* One of several kinds of errors */+ int nRec; /* Pages journalled since last j-header written */+ u32 cksumInit; /* Quasi-random value added to every checksum */+ u32 nSubRec; /* Number of records written to sub-journal */+ Bitvec *pInJournal; /* One bit for each page in the database file */+ sqlite3_file *fd; /* File descriptor for database */+ sqlite3_file *jfd; /* File descriptor for main journal */+ sqlite3_file *sjfd; /* File descriptor for sub-journal */+ i64 journalOff; /* Current write offset in the journal file */+ i64 journalHdr; /* Byte offset to previous journal header */+ sqlite3_backup *pBackup; /* Pointer to list of ongoing backup processes */+ PagerSavepoint *aSavepoint; /* Array of active savepoints */+ int nSavepoint; /* Number of elements in aSavepoint[] */+ u32 iDataVersion; /* Changes whenever database content changes */+ char dbFileVers[16]; /* Changes whenever database file changes */++ int nMmapOut; /* Number of mmap pages currently outstanding */+ sqlite3_int64 szMmap; /* Desired maximum mmap size */+ PgHdr *pMmapFreelist; /* List of free mmap page headers (pDirty) */+ /*+ ** End of the routinely-changing class members+ ***************************************************************************/++ u16 nExtra; /* Add this many bytes to each in-memory page */+ i16 nReserve; /* Number of unused bytes at end of each page */+ u32 vfsFlags; /* Flags for sqlite3_vfs.xOpen() */+ u32 sectorSize; /* Assumed sector size during rollback */+ int pageSize; /* Number of bytes in a page */+ Pgno mxPgno; /* Maximum allowed size of the database */+ i64 journalSizeLimit; /* Size limit for persistent journal files */+ char *zFilename; /* Name of the database file */+ char *zJournal; /* Name of the journal file */+ int (*xBusyHandler)(void*); /* Function to call when busy */+ void *pBusyHandlerArg; /* Context argument for xBusyHandler */+ int aStat[3]; /* Total cache hits, misses and writes */+#ifdef SQLITE_TEST+ int nRead; /* Database pages read */+#endif+ void (*xReiniter)(DbPage*); /* Call this routine when reloading pages */+#ifdef SQLITE_HAS_CODEC+ void *(*xCodec)(void*,void*,Pgno,int); /* Routine for en/decoding data */+ void (*xCodecSizeChng)(void*,int,int); /* Notify of page size changes */+ void (*xCodecFree)(void*); /* Destructor for the codec */+ void *pCodec; /* First argument to xCodec... methods */+#endif+ char *pTmpSpace; /* Pager.pageSize bytes of space for tmp use */+ PCache *pPCache; /* Pointer to page cache object */+#ifndef SQLITE_OMIT_WAL+ Wal *pWal; /* Write-ahead log used by "journal_mode=wal" */+ char *zWal; /* File name for write-ahead log */+#endif+};++/*+** Indexes for use with Pager.aStat[]. The Pager.aStat[] array contains+** the values accessed by passing SQLITE_DBSTATUS_CACHE_HIT, CACHE_MISS +** or CACHE_WRITE to sqlite3_db_status().+*/+#define PAGER_STAT_HIT 0+#define PAGER_STAT_MISS 1+#define PAGER_STAT_WRITE 2++/*+** The following global variables hold counters used for+** testing purposes only. These variables do not exist in+** a non-testing build. These variables are not thread-safe.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_pager_readdb_count = 0; /* Number of full pages read from DB */+SQLITE_PRIVATE int sqlite3_pager_writedb_count = 0; /* Number of full pages written to DB */+SQLITE_PRIVATE int sqlite3_pager_writej_count = 0; /* Number of pages written to journal */+# define PAGER_INCR(v) v+++#else+# define PAGER_INCR(v)+#endif++++/*+** Journal files begin with the following magic string. The data+** was obtained from /dev/random. It is used only as a sanity check.+**+** Since version 2.8.0, the journal format contains additional sanity+** checking information. If the power fails while the journal is being+** written, semi-random garbage data might appear in the journal+** file after power is restored. If an attempt is then made+** to roll the journal back, the database could be corrupted. The additional+** sanity checking data is an attempt to discover the garbage in the+** journal and ignore it.+**+** The sanity checking information for the new journal format consists+** of a 32-bit checksum on each page of data. The checksum covers both+** the page number and the pPager->pageSize bytes of data for the page.+** This cksum is initialized to a 32-bit random value that appears in the+** journal file right after the header. The random initializer is important,+** because garbage data that appears at the end of a journal is likely+** data that was once in other files that have now been deleted. If the+** garbage data came from an obsolete journal file, the checksums might+** be correct. But by initializing the checksum to random value which+** is different for every journal, we minimize that risk.+*/+static const unsigned char aJournalMagic[] = {+ 0xd9, 0xd5, 0x05, 0xf9, 0x20, 0xa1, 0x63, 0xd7,+};++/*+** The size of the of each page record in the journal is given by+** the following macro.+*/+#define JOURNAL_PG_SZ(pPager) ((pPager->pageSize) + 8)++/*+** The journal header size for this pager. This is usually the same +** size as a single disk sector. See also setSectorSize().+*/+#define JOURNAL_HDR_SZ(pPager) (pPager->sectorSize)++/*+** The macro USEFETCH is true if we are allowed to use the xFetch and xUnfetch+** interfaces to access the database using memory-mapped I/O.+*/+#if SQLITE_MAX_MMAP_SIZE>0+# define USEFETCH(x) ((x)->bUseFetch)+#else+# define USEFETCH(x) 0+#endif++/*+** The maximum legal page number is (2^31 - 1).+*/+#define PAGER_MAX_PGNO 2147483647++/*+** The argument to this macro is a file descriptor (type sqlite3_file*).+** Return 0 if it is not open, or non-zero (but not 1) if it is.+**+** This is so that expressions can be written as:+**+** if( isOpen(pPager->jfd) ){ ...+**+** instead of+**+** if( pPager->jfd->pMethods ){ ...+*/+#define isOpen(pFd) ((pFd)->pMethods!=0)++/*+** Return true if this pager uses a write-ahead log instead of the usual+** rollback journal. Otherwise false.+*/+#ifndef SQLITE_OMIT_WAL+static int pagerUseWal(Pager *pPager){+ return (pPager->pWal!=0);+}+#else+# define pagerUseWal(x) 0+# define pagerRollbackWal(x) 0+# define pagerWalFrames(v,w,x,y) 0+# define pagerOpenWalIfPresent(z) SQLITE_OK+# define pagerBeginReadTransaction(z) SQLITE_OK+#endif++#ifndef NDEBUG +/*+** Usage:+**+** assert( assert_pager_state(pPager) );+**+** This function runs many asserts to try to find inconsistencies in+** the internal state of the Pager object.+*/+static int assert_pager_state(Pager *p){+ Pager *pPager = p;++ /* State must be valid. */+ assert( p->eState==PAGER_OPEN+ || p->eState==PAGER_READER+ || p->eState==PAGER_WRITER_LOCKED+ || p->eState==PAGER_WRITER_CACHEMOD+ || p->eState==PAGER_WRITER_DBMOD+ || p->eState==PAGER_WRITER_FINISHED+ || p->eState==PAGER_ERROR+ );++ /* Regardless of the current state, a temp-file connection always behaves+ ** as if it has an exclusive lock on the database file. It never updates+ ** the change-counter field, so the changeCountDone flag is always set.+ */+ assert( p->tempFile==0 || p->eLock==EXCLUSIVE_LOCK );+ assert( p->tempFile==0 || pPager->changeCountDone );++ /* If the useJournal flag is clear, the journal-mode must be "OFF". + ** And if the journal-mode is "OFF", the journal file must not be open.+ */+ assert( p->journalMode==PAGER_JOURNALMODE_OFF || p->useJournal );+ assert( p->journalMode!=PAGER_JOURNALMODE_OFF || !isOpen(p->jfd) );++ /* If changeCountDone is set, a RESERVED lock or greater must be held+ ** on the file.+ */+ assert( pPager->changeCountDone==0 || pPager->eLock>=RESERVED_LOCK );+ assert( p->eLock!=PENDING_LOCK );++ switch( p->eState ){+ case PAGER_OPEN:+ assert( pPager->errCode==SQLITE_OK );+ assert( sqlite3PcacheRefCount(pPager->pPCache)==0 || pPager->tempFile );+ break;++ case PAGER_READER:+ assert( pPager->errCode==SQLITE_OK );+ assert( p->eLock!=UNKNOWN_LOCK );+ assert( p->eLock>=SHARED_LOCK );+ break;++ case PAGER_WRITER_LOCKED:+ assert( p->eLock!=UNKNOWN_LOCK );+ assert( pPager->errCode==SQLITE_OK );+ if( !pagerUseWal(pPager) ){+ assert( p->eLock>=RESERVED_LOCK );+ }+ assert( pPager->dbSize==pPager->dbOrigSize );+ assert( pPager->dbOrigSize==pPager->dbFileSize );+ assert( pPager->dbOrigSize==pPager->dbHintSize );+ assert( pPager->setMaster==0 );+ break;++ case PAGER_WRITER_CACHEMOD:+ assert( p->eLock!=UNKNOWN_LOCK );+ assert( pPager->errCode==SQLITE_OK );+ if( !pagerUseWal(pPager) ){+ /* It is possible that if journal_mode=wal here that neither the+ ** journal file nor the WAL file are open. This happens during+ ** a rollback transaction that switches from journal_mode=off+ ** to journal_mode=wal.+ */+ assert( p->eLock>=RESERVED_LOCK );+ assert( isOpen(p->jfd) + || p->journalMode==PAGER_JOURNALMODE_OFF + || p->journalMode==PAGER_JOURNALMODE_WAL + );+ }+ assert( pPager->dbOrigSize==pPager->dbFileSize );+ assert( pPager->dbOrigSize==pPager->dbHintSize );+ break;++ case PAGER_WRITER_DBMOD:+ assert( p->eLock==EXCLUSIVE_LOCK );+ assert( pPager->errCode==SQLITE_OK );+ assert( !pagerUseWal(pPager) );+ assert( p->eLock>=EXCLUSIVE_LOCK );+ assert( isOpen(p->jfd) + || p->journalMode==PAGER_JOURNALMODE_OFF + || p->journalMode==PAGER_JOURNALMODE_WAL + );+ assert( pPager->dbOrigSize<=pPager->dbHintSize );+ break;++ case PAGER_WRITER_FINISHED:+ assert( p->eLock==EXCLUSIVE_LOCK );+ assert( pPager->errCode==SQLITE_OK );+ assert( !pagerUseWal(pPager) );+ assert( isOpen(p->jfd) + || p->journalMode==PAGER_JOURNALMODE_OFF + || p->journalMode==PAGER_JOURNALMODE_WAL + );+ break;++ case PAGER_ERROR:+ /* There must be at least one outstanding reference to the pager if+ ** in ERROR state. Otherwise the pager should have already dropped+ ** back to OPEN state.+ */+ assert( pPager->errCode!=SQLITE_OK );+ assert( sqlite3PcacheRefCount(pPager->pPCache)>0 );+ break;+ }++ return 1;+}+#endif /* ifndef NDEBUG */++#ifdef SQLITE_DEBUG +/*+** Return a pointer to a human readable string in a static buffer+** containing the state of the Pager object passed as an argument. This+** is intended to be used within debuggers. For example, as an alternative+** to "print *pPager" in gdb:+**+** (gdb) printf "%s", print_pager_state(pPager)+*/+static char *print_pager_state(Pager *p){+ static char zRet[1024];++ sqlite3_snprintf(1024, zRet,+ "Filename: %s\n"+ "State: %s errCode=%d\n"+ "Lock: %s\n"+ "Locking mode: locking_mode=%s\n"+ "Journal mode: journal_mode=%s\n"+ "Backing store: tempFile=%d memDb=%d useJournal=%d\n"+ "Journal: journalOff=%lld journalHdr=%lld\n"+ "Size: dbsize=%d dbOrigSize=%d dbFileSize=%d\n"+ , p->zFilename+ , p->eState==PAGER_OPEN ? "OPEN" :+ p->eState==PAGER_READER ? "READER" :+ p->eState==PAGER_WRITER_LOCKED ? "WRITER_LOCKED" :+ p->eState==PAGER_WRITER_CACHEMOD ? "WRITER_CACHEMOD" :+ p->eState==PAGER_WRITER_DBMOD ? "WRITER_DBMOD" :+ p->eState==PAGER_WRITER_FINISHED ? "WRITER_FINISHED" :+ p->eState==PAGER_ERROR ? "ERROR" : "?error?"+ , (int)p->errCode+ , p->eLock==NO_LOCK ? "NO_LOCK" :+ p->eLock==RESERVED_LOCK ? "RESERVED" :+ p->eLock==EXCLUSIVE_LOCK ? "EXCLUSIVE" :+ p->eLock==SHARED_LOCK ? "SHARED" :+ p->eLock==UNKNOWN_LOCK ? "UNKNOWN" : "?error?"+ , p->exclusiveMode ? "exclusive" : "normal"+ , p->journalMode==PAGER_JOURNALMODE_MEMORY ? "memory" :+ p->journalMode==PAGER_JOURNALMODE_OFF ? "off" :+ p->journalMode==PAGER_JOURNALMODE_DELETE ? "delete" :+ p->journalMode==PAGER_JOURNALMODE_PERSIST ? "persist" :+ p->journalMode==PAGER_JOURNALMODE_TRUNCATE ? "truncate" :+ p->journalMode==PAGER_JOURNALMODE_WAL ? "wal" : "?error?"+ , (int)p->tempFile, (int)p->memDb, (int)p->useJournal+ , p->journalOff, p->journalHdr+ , (int)p->dbSize, (int)p->dbOrigSize, (int)p->dbFileSize+ );++ return zRet;+}+#endif++/*+** Return true if it is necessary to write page *pPg into the sub-journal.+** A page needs to be written into the sub-journal if there exists one+** or more open savepoints for which:+**+** * The page-number is less than or equal to PagerSavepoint.nOrig, and+** * The bit corresponding to the page-number is not set in+** PagerSavepoint.pInSavepoint.+*/+static int subjRequiresPage(PgHdr *pPg){+ Pager *pPager = pPg->pPager;+ PagerSavepoint *p;+ Pgno pgno = pPg->pgno;+ int i;+ for(i=0; i<pPager->nSavepoint; i++){+ p = &pPager->aSavepoint[i];+ if( p->nOrig>=pgno && 0==sqlite3BitvecTestNotNull(p->pInSavepoint, pgno) ){+ return 1;+ }+ }+ return 0;+}++#ifdef SQLITE_DEBUG+/*+** Return true if the page is already in the journal file.+*/+static int pageInJournal(Pager *pPager, PgHdr *pPg){+ return sqlite3BitvecTest(pPager->pInJournal, pPg->pgno);+}+#endif++/*+** Read a 32-bit integer from the given file descriptor. Store the integer+** that is read in *pRes. Return SQLITE_OK if everything worked, or an+** error code is something goes wrong.+**+** All values are stored on disk as big-endian.+*/+static int read32bits(sqlite3_file *fd, i64 offset, u32 *pRes){+ unsigned char ac[4];+ int rc = sqlite3OsRead(fd, ac, sizeof(ac), offset);+ if( rc==SQLITE_OK ){+ *pRes = sqlite3Get4byte(ac);+ }+ return rc;+}++/*+** Write a 32-bit integer into a string buffer in big-endian byte order.+*/+#define put32bits(A,B) sqlite3Put4byte((u8*)A,B)+++/*+** Write a 32-bit integer into the given file descriptor. Return SQLITE_OK+** on success or an error code is something goes wrong.+*/+static int write32bits(sqlite3_file *fd, i64 offset, u32 val){+ char ac[4];+ put32bits(ac, val);+ return sqlite3OsWrite(fd, ac, 4, offset);+}++/*+** Unlock the database file to level eLock, which must be either NO_LOCK+** or SHARED_LOCK. Regardless of whether or not the call to xUnlock()+** succeeds, set the Pager.eLock variable to match the (attempted) new lock.+**+** Except, if Pager.eLock is set to UNKNOWN_LOCK when this function is+** called, do not modify it. See the comment above the #define of +** UNKNOWN_LOCK for an explanation of this.+*/+static int pagerUnlockDb(Pager *pPager, int eLock){+ int rc = SQLITE_OK;++ assert( !pPager->exclusiveMode || pPager->eLock==eLock );+ assert( eLock==NO_LOCK || eLock==SHARED_LOCK );+ assert( eLock!=NO_LOCK || pagerUseWal(pPager)==0 );+ if( isOpen(pPager->fd) ){+ assert( pPager->eLock>=eLock );+ rc = pPager->noLock ? SQLITE_OK : sqlite3OsUnlock(pPager->fd, eLock);+ if( pPager->eLock!=UNKNOWN_LOCK ){+ pPager->eLock = (u8)eLock;+ }+ IOTRACE(("UNLOCK %p %d\n", pPager, eLock))+ }+ return rc;+}++/*+** Lock the database file to level eLock, which must be either SHARED_LOCK,+** RESERVED_LOCK or EXCLUSIVE_LOCK. If the caller is successful, set the+** Pager.eLock variable to the new locking state. +**+** Except, if Pager.eLock is set to UNKNOWN_LOCK when this function is +** called, do not modify it unless the new locking state is EXCLUSIVE_LOCK. +** See the comment above the #define of UNKNOWN_LOCK for an explanation +** of this.+*/+static int pagerLockDb(Pager *pPager, int eLock){+ int rc = SQLITE_OK;++ assert( eLock==SHARED_LOCK || eLock==RESERVED_LOCK || eLock==EXCLUSIVE_LOCK );+ if( pPager->eLock<eLock || pPager->eLock==UNKNOWN_LOCK ){+ rc = pPager->noLock ? SQLITE_OK : sqlite3OsLock(pPager->fd, eLock);+ if( rc==SQLITE_OK && (pPager->eLock!=UNKNOWN_LOCK||eLock==EXCLUSIVE_LOCK) ){+ pPager->eLock = (u8)eLock;+ IOTRACE(("LOCK %p %d\n", pPager, eLock))+ }+ }+ return rc;+}++/*+** This function determines whether or not the atomic-write optimization+** can be used with this pager. The optimization can be used if:+**+** (a) the value returned by OsDeviceCharacteristics() indicates that+** a database page may be written atomically, and+** (b) the value returned by OsSectorSize() is less than or equal+** to the page size.+**+** The optimization is also always enabled for temporary files. It is+** an error to call this function if pPager is opened on an in-memory+** database.+**+** If the optimization cannot be used, 0 is returned. If it can be used,+** then the value returned is the size of the journal file when it+** contains rollback data for exactly one page.+*/+#ifdef SQLITE_ENABLE_ATOMIC_WRITE+static int jrnlBufferSize(Pager *pPager){+ if( !pPager->tempFile ){+ int dc; /* Device characteristics */+ int nSector; /* Sector size */+ int szPage; /* Page size */++ assert( isOpen(pPager->fd) );+ dc = sqlite3OsDeviceCharacteristics(pPager->fd);+ nSector = pPager->sectorSize;+ szPage = pPager->pageSize;++ assert(SQLITE_IOCAP_ATOMIC512==(512>>8));+ assert(SQLITE_IOCAP_ATOMIC64K==(65536>>8));+ if( 0==(dc&(SQLITE_IOCAP_ATOMIC|(szPage>>8)) || nSector>szPage) ){+ return 0;+ }+ }++ return JOURNAL_HDR_SZ(pPager) + JOURNAL_PG_SZ(pPager);+}+#endif++/*+** If SQLITE_CHECK_PAGES is defined then we do some sanity checking+** on the cache using a hash function. This is used for testing+** and debugging only.+*/+#ifdef SQLITE_CHECK_PAGES+/*+** Return a 32-bit hash of the page data for pPage.+*/+static u32 pager_datahash(int nByte, unsigned char *pData){+ u32 hash = 0;+ int i;+ for(i=0; i<nByte; i++){+ hash = (hash*1039) + pData[i];+ }+ return hash;+}+static u32 pager_pagehash(PgHdr *pPage){+ return pager_datahash(pPage->pPager->pageSize, (unsigned char *)pPage->pData);+}+static void pager_set_pagehash(PgHdr *pPage){+ pPage->pageHash = pager_pagehash(pPage);+}++/*+** The CHECK_PAGE macro takes a PgHdr* as an argument. If SQLITE_CHECK_PAGES+** is defined, and NDEBUG is not defined, an assert() statement checks+** that the page is either dirty or still matches the calculated page-hash.+*/+#define CHECK_PAGE(x) checkPage(x)+static void checkPage(PgHdr *pPg){+ Pager *pPager = pPg->pPager;+ assert( pPager->eState!=PAGER_ERROR );+ assert( (pPg->flags&PGHDR_DIRTY) || pPg->pageHash==pager_pagehash(pPg) );+}++#else+#define pager_datahash(X,Y) 0+#define pager_pagehash(X) 0+#define pager_set_pagehash(X)+#define CHECK_PAGE(x)+#endif /* SQLITE_CHECK_PAGES */++/*+** When this is called the journal file for pager pPager must be open.+** This function attempts to read a master journal file name from the +** end of the file and, if successful, copies it into memory supplied +** by the caller. See comments above writeMasterJournal() for the format+** used to store a master journal file name at the end of a journal file.+**+** zMaster must point to a buffer of at least nMaster bytes allocated by+** the caller. This should be sqlite3_vfs.mxPathname+1 (to ensure there is+** enough space to write the master journal name). If the master journal+** name in the journal is longer than nMaster bytes (including a+** nul-terminator), then this is handled as if no master journal name+** were present in the journal.+**+** If a master journal file name is present at the end of the journal+** file, then it is copied into the buffer pointed to by zMaster. A+** nul-terminator byte is appended to the buffer following the master+** journal file name.+**+** If it is determined that no master journal file name is present +** zMaster[0] is set to 0 and SQLITE_OK returned.+**+** If an error occurs while reading from the journal file, an SQLite+** error code is returned.+*/+static int readMasterJournal(sqlite3_file *pJrnl, char *zMaster, u32 nMaster){+ int rc; /* Return code */+ u32 len; /* Length in bytes of master journal name */+ i64 szJ; /* Total size in bytes of journal file pJrnl */+ u32 cksum; /* MJ checksum value read from journal */+ u32 u; /* Unsigned loop counter */+ unsigned char aMagic[8]; /* A buffer to hold the magic header */+ zMaster[0] = '\0';++ if( SQLITE_OK!=(rc = sqlite3OsFileSize(pJrnl, &szJ))+ || szJ<16+ || SQLITE_OK!=(rc = read32bits(pJrnl, szJ-16, &len))+ || len>=nMaster + || len==0 + || SQLITE_OK!=(rc = read32bits(pJrnl, szJ-12, &cksum))+ || SQLITE_OK!=(rc = sqlite3OsRead(pJrnl, aMagic, 8, szJ-8))+ || memcmp(aMagic, aJournalMagic, 8)+ || SQLITE_OK!=(rc = sqlite3OsRead(pJrnl, zMaster, len, szJ-16-len))+ ){+ return rc;+ }++ /* See if the checksum matches the master journal name */+ for(u=0; u<len; u++){+ cksum -= zMaster[u];+ }+ if( cksum ){+ /* If the checksum doesn't add up, then one or more of the disk sectors+ ** containing the master journal filename is corrupted. This means+ ** definitely roll back, so just return SQLITE_OK and report a (nul)+ ** master-journal filename.+ */+ len = 0;+ }+ zMaster[len] = '\0';+ + return SQLITE_OK;+}++/*+** Return the offset of the sector boundary at or immediately +** following the value in pPager->journalOff, assuming a sector +** size of pPager->sectorSize bytes.+**+** i.e for a sector size of 512:+**+** Pager.journalOff Return value+** ---------------------------------------+** 0 0+** 512 512+** 100 512+** 2000 2048+** +*/+static i64 journalHdrOffset(Pager *pPager){+ i64 offset = 0;+ i64 c = pPager->journalOff;+ if( c ){+ offset = ((c-1)/JOURNAL_HDR_SZ(pPager) + 1) * JOURNAL_HDR_SZ(pPager);+ }+ assert( offset%JOURNAL_HDR_SZ(pPager)==0 );+ assert( offset>=c );+ assert( (offset-c)<JOURNAL_HDR_SZ(pPager) );+ return offset;+}++/*+** The journal file must be open when this function is called.+**+** This function is a no-op if the journal file has not been written to+** within the current transaction (i.e. if Pager.journalOff==0).+**+** If doTruncate is non-zero or the Pager.journalSizeLimit variable is+** set to 0, then truncate the journal file to zero bytes in size. Otherwise,+** zero the 28-byte header at the start of the journal file. In either case, +** if the pager is not in no-sync mode, sync the journal file immediately +** after writing or truncating it.+**+** If Pager.journalSizeLimit is set to a positive, non-zero value, and+** following the truncation or zeroing described above the size of the +** journal file in bytes is larger than this value, then truncate the+** journal file to Pager.journalSizeLimit bytes. The journal file does+** not need to be synced following this operation.+**+** If an IO error occurs, abandon processing and return the IO error code.+** Otherwise, return SQLITE_OK.+*/+static int zeroJournalHdr(Pager *pPager, int doTruncate){+ int rc = SQLITE_OK; /* Return code */+ assert( isOpen(pPager->jfd) );+ if( pPager->journalOff ){+ const i64 iLimit = pPager->journalSizeLimit; /* Local cache of jsl */++ IOTRACE(("JZEROHDR %p\n", pPager))+ if( doTruncate || iLimit==0 ){+ rc = sqlite3OsTruncate(pPager->jfd, 0);+ }else{+ static const char zeroHdr[28] = {0};+ rc = sqlite3OsWrite(pPager->jfd, zeroHdr, sizeof(zeroHdr), 0);+ }+ if( rc==SQLITE_OK && !pPager->noSync ){+ rc = sqlite3OsSync(pPager->jfd, SQLITE_SYNC_DATAONLY|pPager->syncFlags);+ }++ /* At this point the transaction is committed but the write lock + ** is still held on the file. If there is a size limit configured for + ** the persistent journal and the journal file currently consumes more+ ** space than that limit allows for, truncate it now. There is no need+ ** to sync the file following this operation.+ */+ if( rc==SQLITE_OK && iLimit>0 ){+ i64 sz;+ rc = sqlite3OsFileSize(pPager->jfd, &sz);+ if( rc==SQLITE_OK && sz>iLimit ){+ rc = sqlite3OsTruncate(pPager->jfd, iLimit);+ }+ }+ }+ return rc;+}++/*+** The journal file must be open when this routine is called. A journal+** header (JOURNAL_HDR_SZ bytes) is written into the journal file at the+** current location.+**+** The format for the journal header is as follows:+** - 8 bytes: Magic identifying journal format.+** - 4 bytes: Number of records in journal, or -1 no-sync mode is on.+** - 4 bytes: Random number used for page hash.+** - 4 bytes: Initial database page count.+** - 4 bytes: Sector size used by the process that wrote this journal.+** - 4 bytes: Database page size.+** +** Followed by (JOURNAL_HDR_SZ - 28) bytes of unused space.+*/+static int writeJournalHdr(Pager *pPager){+ int rc = SQLITE_OK; /* Return code */+ char *zHeader = pPager->pTmpSpace; /* Temporary space used to build header */+ u32 nHeader = (u32)pPager->pageSize;/* Size of buffer pointed to by zHeader */+ u32 nWrite; /* Bytes of header sector written */+ int ii; /* Loop counter */++ assert( isOpen(pPager->jfd) ); /* Journal file must be open. */++ if( nHeader>JOURNAL_HDR_SZ(pPager) ){+ nHeader = JOURNAL_HDR_SZ(pPager);+ }++ /* If there are active savepoints and any of them were created + ** since the most recent journal header was written, update the + ** PagerSavepoint.iHdrOffset fields now.+ */+ for(ii=0; ii<pPager->nSavepoint; ii++){+ if( pPager->aSavepoint[ii].iHdrOffset==0 ){+ pPager->aSavepoint[ii].iHdrOffset = pPager->journalOff;+ }+ }++ pPager->journalHdr = pPager->journalOff = journalHdrOffset(pPager);++ /* + ** Write the nRec Field - the number of page records that follow this+ ** journal header. Normally, zero is written to this value at this time.+ ** After the records are added to the journal (and the journal synced, + ** if in full-sync mode), the zero is overwritten with the true number+ ** of records (see syncJournal()).+ **+ ** A faster alternative is to write 0xFFFFFFFF to the nRec field. When+ ** reading the journal this value tells SQLite to assume that the+ ** rest of the journal file contains valid page records. This assumption+ ** is dangerous, as if a failure occurred whilst writing to the journal+ ** file it may contain some garbage data. There are two scenarios+ ** where this risk can be ignored:+ **+ ** * When the pager is in no-sync mode. Corruption can follow a+ ** power failure in this case anyway.+ **+ ** * When the SQLITE_IOCAP_SAFE_APPEND flag is set. This guarantees+ ** that garbage data is never appended to the journal file.+ */+ assert( isOpen(pPager->fd) || pPager->noSync );+ if( pPager->noSync || (pPager->journalMode==PAGER_JOURNALMODE_MEMORY)+ || (sqlite3OsDeviceCharacteristics(pPager->fd)&SQLITE_IOCAP_SAFE_APPEND) + ){+ memcpy(zHeader, aJournalMagic, sizeof(aJournalMagic));+ put32bits(&zHeader[sizeof(aJournalMagic)], 0xffffffff);+ }else{+ memset(zHeader, 0, sizeof(aJournalMagic)+4);+ }++ /* The random check-hash initializer */ + sqlite3_randomness(sizeof(pPager->cksumInit), &pPager->cksumInit);+ put32bits(&zHeader[sizeof(aJournalMagic)+4], pPager->cksumInit);+ /* The initial database size */+ put32bits(&zHeader[sizeof(aJournalMagic)+8], pPager->dbOrigSize);+ /* The assumed sector size for this process */+ put32bits(&zHeader[sizeof(aJournalMagic)+12], pPager->sectorSize);++ /* The page size */+ put32bits(&zHeader[sizeof(aJournalMagic)+16], pPager->pageSize);++ /* Initializing the tail of the buffer is not necessary. Everything+ ** works find if the following memset() is omitted. But initializing+ ** the memory prevents valgrind from complaining, so we are willing to+ ** take the performance hit.+ */+ memset(&zHeader[sizeof(aJournalMagic)+20], 0,+ nHeader-(sizeof(aJournalMagic)+20));++ /* In theory, it is only necessary to write the 28 bytes that the + ** journal header consumes to the journal file here. Then increment the + ** Pager.journalOff variable by JOURNAL_HDR_SZ so that the next + ** record is written to the following sector (leaving a gap in the file+ ** that will be implicitly filled in by the OS).+ **+ ** However it has been discovered that on some systems this pattern can + ** be significantly slower than contiguously writing data to the file,+ ** even if that means explicitly writing data to the block of + ** (JOURNAL_HDR_SZ - 28) bytes that will not be used. So that is what+ ** is done. + **+ ** The loop is required here in case the sector-size is larger than the + ** database page size. Since the zHeader buffer is only Pager.pageSize+ ** bytes in size, more than one call to sqlite3OsWrite() may be required+ ** to populate the entire journal header sector.+ */ + for(nWrite=0; rc==SQLITE_OK&&nWrite<JOURNAL_HDR_SZ(pPager); nWrite+=nHeader){+ IOTRACE(("JHDR %p %lld %d\n", pPager, pPager->journalHdr, nHeader))+ rc = sqlite3OsWrite(pPager->jfd, zHeader, nHeader, pPager->journalOff);+ assert( pPager->journalHdr <= pPager->journalOff );+ pPager->journalOff += nHeader;+ }++ return rc;+}++/*+** The journal file must be open when this is called. A journal header file+** (JOURNAL_HDR_SZ bytes) is read from the current location in the journal+** file. The current location in the journal file is given by+** pPager->journalOff. See comments above function writeJournalHdr() for+** a description of the journal header format.+**+** If the header is read successfully, *pNRec is set to the number of+** page records following this header and *pDbSize is set to the size of the+** database before the transaction began, in pages. Also, pPager->cksumInit+** is set to the value read from the journal header. SQLITE_OK is returned+** in this case.+**+** If the journal header file appears to be corrupted, SQLITE_DONE is+** returned and *pNRec and *PDbSize are undefined. If JOURNAL_HDR_SZ bytes+** cannot be read from the journal file an error code is returned.+*/+static int readJournalHdr(+ Pager *pPager, /* Pager object */+ int isHot,+ i64 journalSize, /* Size of the open journal file in bytes */+ u32 *pNRec, /* OUT: Value read from the nRec field */+ u32 *pDbSize /* OUT: Value of original database size field */+){+ int rc; /* Return code */+ unsigned char aMagic[8]; /* A buffer to hold the magic header */+ i64 iHdrOff; /* Offset of journal header being read */++ assert( isOpen(pPager->jfd) ); /* Journal file must be open. */++ /* Advance Pager.journalOff to the start of the next sector. If the+ ** journal file is too small for there to be a header stored at this+ ** point, return SQLITE_DONE.+ */+ pPager->journalOff = journalHdrOffset(pPager);+ if( pPager->journalOff+JOURNAL_HDR_SZ(pPager) > journalSize ){+ return SQLITE_DONE;+ }+ iHdrOff = pPager->journalOff;++ /* Read in the first 8 bytes of the journal header. If they do not match+ ** the magic string found at the start of each journal header, return+ ** SQLITE_DONE. If an IO error occurs, return an error code. Otherwise,+ ** proceed.+ */+ if( isHot || iHdrOff!=pPager->journalHdr ){+ rc = sqlite3OsRead(pPager->jfd, aMagic, sizeof(aMagic), iHdrOff);+ if( rc ){+ return rc;+ }+ if( memcmp(aMagic, aJournalMagic, sizeof(aMagic))!=0 ){+ return SQLITE_DONE;+ }+ }++ /* Read the first three 32-bit fields of the journal header: The nRec+ ** field, the checksum-initializer and the database size at the start+ ** of the transaction. Return an error code if anything goes wrong.+ */+ if( SQLITE_OK!=(rc = read32bits(pPager->jfd, iHdrOff+8, pNRec))+ || SQLITE_OK!=(rc = read32bits(pPager->jfd, iHdrOff+12, &pPager->cksumInit))+ || SQLITE_OK!=(rc = read32bits(pPager->jfd, iHdrOff+16, pDbSize))+ ){+ return rc;+ }++ if( pPager->journalOff==0 ){+ u32 iPageSize; /* Page-size field of journal header */+ u32 iSectorSize; /* Sector-size field of journal header */++ /* Read the page-size and sector-size journal header fields. */+ if( SQLITE_OK!=(rc = read32bits(pPager->jfd, iHdrOff+20, &iSectorSize))+ || SQLITE_OK!=(rc = read32bits(pPager->jfd, iHdrOff+24, &iPageSize))+ ){+ return rc;+ }++ /* Versions of SQLite prior to 3.5.8 set the page-size field of the+ ** journal header to zero. In this case, assume that the Pager.pageSize+ ** variable is already set to the correct page size.+ */+ if( iPageSize==0 ){+ iPageSize = pPager->pageSize;+ }++ /* Check that the values read from the page-size and sector-size fields+ ** are within range. To be 'in range', both values need to be a power+ ** of two greater than or equal to 512 or 32, and not greater than their + ** respective compile time maximum limits.+ */+ if( iPageSize<512 || iSectorSize<32+ || iPageSize>SQLITE_MAX_PAGE_SIZE || iSectorSize>MAX_SECTOR_SIZE+ || ((iPageSize-1)&iPageSize)!=0 || ((iSectorSize-1)&iSectorSize)!=0 + ){+ /* If the either the page-size or sector-size in the journal-header is + ** invalid, then the process that wrote the journal-header must have + ** crashed before the header was synced. In this case stop reading + ** the journal file here.+ */+ return SQLITE_DONE;+ }++ /* Update the page-size to match the value read from the journal. + ** Use a testcase() macro to make sure that malloc failure within + ** PagerSetPagesize() is tested.+ */+ rc = sqlite3PagerSetPagesize(pPager, &iPageSize, -1);+ testcase( rc!=SQLITE_OK );++ /* Update the assumed sector-size to match the value used by + ** the process that created this journal. If this journal was+ ** created by a process other than this one, then this routine+ ** is being called from within pager_playback(). The local value+ ** of Pager.sectorSize is restored at the end of that routine.+ */+ pPager->sectorSize = iSectorSize;+ }++ pPager->journalOff += JOURNAL_HDR_SZ(pPager);+ return rc;+}+++/*+** Write the supplied master journal name into the journal file for pager+** pPager at the current location. The master journal name must be the last+** thing written to a journal file. If the pager is in full-sync mode, the+** journal file descriptor is advanced to the next sector boundary before+** anything is written. The format is:+**+** + 4 bytes: PAGER_MJ_PGNO.+** + N bytes: Master journal filename in utf-8.+** + 4 bytes: N (length of master journal name in bytes, no nul-terminator).+** + 4 bytes: Master journal name checksum.+** + 8 bytes: aJournalMagic[].+**+** The master journal page checksum is the sum of the bytes in the master+** journal name, where each byte is interpreted as a signed 8-bit integer.+**+** If zMaster is a NULL pointer (occurs for a single database transaction), +** this call is a no-op.+*/+static int writeMasterJournal(Pager *pPager, const char *zMaster){+ int rc; /* Return code */+ int nMaster; /* Length of string zMaster */+ i64 iHdrOff; /* Offset of header in journal file */+ i64 jrnlSize; /* Size of journal file on disk */+ u32 cksum = 0; /* Checksum of string zMaster */++ assert( pPager->setMaster==0 );+ assert( !pagerUseWal(pPager) );++ if( !zMaster + || pPager->journalMode==PAGER_JOURNALMODE_MEMORY + || !isOpen(pPager->jfd)+ ){+ return SQLITE_OK;+ }+ pPager->setMaster = 1;+ assert( pPager->journalHdr <= pPager->journalOff );++ /* Calculate the length in bytes and the checksum of zMaster */+ for(nMaster=0; zMaster[nMaster]; nMaster++){+ cksum += zMaster[nMaster];+ }++ /* If in full-sync mode, advance to the next disk sector before writing+ ** the master journal name. This is in case the previous page written to+ ** the journal has already been synced.+ */+ if( pPager->fullSync ){+ pPager->journalOff = journalHdrOffset(pPager);+ }+ iHdrOff = pPager->journalOff;++ /* Write the master journal data to the end of the journal file. If+ ** an error occurs, return the error code to the caller.+ */+ if( (0 != (rc = write32bits(pPager->jfd, iHdrOff, PAGER_MJ_PGNO(pPager))))+ || (0 != (rc = sqlite3OsWrite(pPager->jfd, zMaster, nMaster, iHdrOff+4)))+ || (0 != (rc = write32bits(pPager->jfd, iHdrOff+4+nMaster, nMaster)))+ || (0 != (rc = write32bits(pPager->jfd, iHdrOff+4+nMaster+4, cksum)))+ || (0 != (rc = sqlite3OsWrite(pPager->jfd, aJournalMagic, 8,+ iHdrOff+4+nMaster+8)))+ ){+ return rc;+ }+ pPager->journalOff += (nMaster+20);++ /* If the pager is in peristent-journal mode, then the physical + ** journal-file may extend past the end of the master-journal name+ ** and 8 bytes of magic data just written to the file. This is + ** dangerous because the code to rollback a hot-journal file+ ** will not be able to find the master-journal name to determine + ** whether or not the journal is hot. + **+ ** Easiest thing to do in this scenario is to truncate the journal + ** file to the required size.+ */ + if( SQLITE_OK==(rc = sqlite3OsFileSize(pPager->jfd, &jrnlSize))+ && jrnlSize>pPager->journalOff+ ){+ rc = sqlite3OsTruncate(pPager->jfd, pPager->journalOff);+ }+ return rc;+}++/*+** Discard the entire contents of the in-memory page-cache.+*/+static void pager_reset(Pager *pPager){+ pPager->iDataVersion++;+ sqlite3BackupRestart(pPager->pBackup);+ sqlite3PcacheClear(pPager->pPCache);+}++/*+** Return the pPager->iDataVersion value+*/+SQLITE_PRIVATE u32 sqlite3PagerDataVersion(Pager *pPager){+ assert( pPager->eState>PAGER_OPEN );+ return pPager->iDataVersion;+}++/*+** Free all structures in the Pager.aSavepoint[] array and set both+** Pager.aSavepoint and Pager.nSavepoint to zero. Close the sub-journal+** if it is open and the pager is not in exclusive mode.+*/+static void releaseAllSavepoints(Pager *pPager){+ int ii; /* Iterator for looping through Pager.aSavepoint */+ for(ii=0; ii<pPager->nSavepoint; ii++){+ sqlite3BitvecDestroy(pPager->aSavepoint[ii].pInSavepoint);+ }+ if( !pPager->exclusiveMode || sqlite3IsMemJournal(pPager->sjfd) ){+ sqlite3OsClose(pPager->sjfd);+ }+ sqlite3_free(pPager->aSavepoint);+ pPager->aSavepoint = 0;+ pPager->nSavepoint = 0;+ pPager->nSubRec = 0;+}++/*+** Set the bit number pgno in the PagerSavepoint.pInSavepoint +** bitvecs of all open savepoints. Return SQLITE_OK if successful+** or SQLITE_NOMEM if a malloc failure occurs.+*/+static int addToSavepointBitvecs(Pager *pPager, Pgno pgno){+ int ii; /* Loop counter */+ int rc = SQLITE_OK; /* Result code */++ for(ii=0; ii<pPager->nSavepoint; ii++){+ PagerSavepoint *p = &pPager->aSavepoint[ii];+ if( pgno<=p->nOrig ){+ rc |= sqlite3BitvecSet(p->pInSavepoint, pgno);+ testcase( rc==SQLITE_NOMEM );+ assert( rc==SQLITE_OK || rc==SQLITE_NOMEM );+ }+ }+ return rc;+}++/*+** This function is a no-op if the pager is in exclusive mode and not+** in the ERROR state. Otherwise, it switches the pager to PAGER_OPEN+** state.+**+** If the pager is not in exclusive-access mode, the database file is+** completely unlocked. If the file is unlocked and the file-system does+** not exhibit the UNDELETABLE_WHEN_OPEN property, the journal file is+** closed (if it is open).+**+** If the pager is in ERROR state when this function is called, the +** contents of the pager cache are discarded before switching back to +** the OPEN state. Regardless of whether the pager is in exclusive-mode+** or not, any journal file left in the file-system will be treated+** as a hot-journal and rolled back the next time a read-transaction+** is opened (by this or by any other connection).+*/+static void pager_unlock(Pager *pPager){++ assert( pPager->eState==PAGER_READER + || pPager->eState==PAGER_OPEN + || pPager->eState==PAGER_ERROR + );++ sqlite3BitvecDestroy(pPager->pInJournal);+ pPager->pInJournal = 0;+ releaseAllSavepoints(pPager);++ if( pagerUseWal(pPager) ){+ assert( !isOpen(pPager->jfd) );+ sqlite3WalEndReadTransaction(pPager->pWal);+ pPager->eState = PAGER_OPEN;+ }else if( !pPager->exclusiveMode ){+ int rc; /* Error code returned by pagerUnlockDb() */+ int iDc = isOpen(pPager->fd)?sqlite3OsDeviceCharacteristics(pPager->fd):0;++ /* If the operating system support deletion of open files, then+ ** close the journal file when dropping the database lock. Otherwise+ ** another connection with journal_mode=delete might delete the file+ ** out from under us.+ */+ assert( (PAGER_JOURNALMODE_MEMORY & 5)!=1 );+ assert( (PAGER_JOURNALMODE_OFF & 5)!=1 );+ assert( (PAGER_JOURNALMODE_WAL & 5)!=1 );+ assert( (PAGER_JOURNALMODE_DELETE & 5)!=1 );+ assert( (PAGER_JOURNALMODE_TRUNCATE & 5)==1 );+ assert( (PAGER_JOURNALMODE_PERSIST & 5)==1 );+ if( 0==(iDc & SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN)+ || 1!=(pPager->journalMode & 5)+ ){+ sqlite3OsClose(pPager->jfd);+ }++ /* If the pager is in the ERROR state and the call to unlock the database+ ** file fails, set the current lock to UNKNOWN_LOCK. See the comment+ ** above the #define for UNKNOWN_LOCK for an explanation of why this+ ** is necessary.+ */+ rc = pagerUnlockDb(pPager, NO_LOCK);+ if( rc!=SQLITE_OK && pPager->eState==PAGER_ERROR ){+ pPager->eLock = UNKNOWN_LOCK;+ }++ /* The pager state may be changed from PAGER_ERROR to PAGER_OPEN here+ ** without clearing the error code. This is intentional - the error+ ** code is cleared and the cache reset in the block below.+ */+ assert( pPager->errCode || pPager->eState!=PAGER_ERROR );+ pPager->changeCountDone = 0;+ pPager->eState = PAGER_OPEN;+ }++ /* If Pager.errCode is set, the contents of the pager cache cannot be+ ** trusted. Now that there are no outstanding references to the pager,+ ** it can safely move back to PAGER_OPEN state. This happens in both+ ** normal and exclusive-locking mode.+ */+ if( pPager->errCode ){+ pager_reset(pPager);+ pPager->changeCountDone = pPager->tempFile;+ pPager->eState = PAGER_OPEN;+ pPager->errCode = SQLITE_OK;+ if( USEFETCH(pPager) ) sqlite3OsUnfetch(pPager->fd, 0, 0);+ }++ pPager->journalOff = 0;+ pPager->journalHdr = 0;+ pPager->setMaster = 0;+}++/*+** This function is called whenever an IOERR or FULL error that requires+** the pager to transition into the ERROR state may ahve occurred.+** The first argument is a pointer to the pager structure, the second +** the error-code about to be returned by a pager API function. The +** value returned is a copy of the second argument to this function. +**+** If the second argument is SQLITE_FULL, SQLITE_IOERR or one of the+** IOERR sub-codes, the pager enters the ERROR state and the error code+** is stored in Pager.errCode. While the pager remains in the ERROR state,+** all major API calls on the Pager will immediately return Pager.errCode.+**+** The ERROR state indicates that the contents of the pager-cache +** cannot be trusted. This state can be cleared by completely discarding +** the contents of the pager-cache. If a transaction was active when+** the persistent error occurred, then the rollback journal may need+** to be replayed to restore the contents of the database file (as if+** it were a hot-journal).+*/+static int pager_error(Pager *pPager, int rc){+ int rc2 = rc & 0xff;+ assert( rc==SQLITE_OK );+ assert(+ pPager->errCode==SQLITE_FULL ||+ pPager->errCode==SQLITE_OK ||+ (pPager->errCode & 0xff)==SQLITE_IOERR+ );+ if( rc2==SQLITE_FULL || rc2==SQLITE_IOERR ){+ pPager->errCode = rc;+ pPager->eState = PAGER_ERROR;+ }+ return rc;+}++static int pager_truncate(Pager *pPager, Pgno nPage);++/*+** This routine ends a transaction. A transaction is usually ended by +** either a COMMIT or a ROLLBACK operation. This routine may be called +** after rollback of a hot-journal, or if an error occurs while opening+** the journal file or writing the very first journal-header of a+** database transaction.+** +** This routine is never called in PAGER_ERROR state. If it is called+** in PAGER_NONE or PAGER_SHARED state and the lock held is less+** exclusive than a RESERVED lock, it is a no-op.+**+** Otherwise, any active savepoints are released.+**+** If the journal file is open, then it is "finalized". Once a journal +** file has been finalized it is not possible to use it to roll back a +** transaction. Nor will it be considered to be a hot-journal by this+** or any other database connection. Exactly how a journal is finalized+** depends on whether or not the pager is running in exclusive mode and+** the current journal-mode (Pager.journalMode value), as follows:+**+** journalMode==MEMORY+** Journal file descriptor is simply closed. This destroys an +** in-memory journal.+**+** journalMode==TRUNCATE+** Journal file is truncated to zero bytes in size.+**+** journalMode==PERSIST+** The first 28 bytes of the journal file are zeroed. This invalidates+** the first journal header in the file, and hence the entire journal+** file. An invalid journal file cannot be rolled back.+**+** journalMode==DELETE+** The journal file is closed and deleted using sqlite3OsDelete().+**+** If the pager is running in exclusive mode, this method of finalizing+** the journal file is never used. Instead, if the journalMode is+** DELETE and the pager is in exclusive mode, the method described under+** journalMode==PERSIST is used instead.+**+** After the journal is finalized, the pager moves to PAGER_READER state.+** If running in non-exclusive rollback mode, the lock on the file is +** downgraded to a SHARED_LOCK.+**+** SQLITE_OK is returned if no error occurs. If an error occurs during+** any of the IO operations to finalize the journal file or unlock the+** database then the IO error code is returned to the user. If the +** operation to finalize the journal file fails, then the code still+** tries to unlock the database file if not in exclusive mode. If the+** unlock operation fails as well, then the first error code related+** to the first error encountered (the journal finalization one) is+** returned.+*/+static int pager_end_transaction(Pager *pPager, int hasMaster, int bCommit){+ int rc = SQLITE_OK; /* Error code from journal finalization operation */+ int rc2 = SQLITE_OK; /* Error code from db file unlock operation */++ /* Do nothing if the pager does not have an open write transaction+ ** or at least a RESERVED lock. This function may be called when there+ ** is no write-transaction active but a RESERVED or greater lock is+ ** held under two circumstances:+ **+ ** 1. After a successful hot-journal rollback, it is called with+ ** eState==PAGER_NONE and eLock==EXCLUSIVE_LOCK.+ **+ ** 2. If a connection with locking_mode=exclusive holding an EXCLUSIVE + ** lock switches back to locking_mode=normal and then executes a+ ** read-transaction, this function is called with eState==PAGER_READER + ** and eLock==EXCLUSIVE_LOCK when the read-transaction is closed.+ */+ assert( assert_pager_state(pPager) );+ assert( pPager->eState!=PAGER_ERROR );+ if( pPager->eState<PAGER_WRITER_LOCKED && pPager->eLock<RESERVED_LOCK ){+ return SQLITE_OK;+ }++ releaseAllSavepoints(pPager);+ assert( isOpen(pPager->jfd) || pPager->pInJournal==0 );+ if( isOpen(pPager->jfd) ){+ assert( !pagerUseWal(pPager) );++ /* Finalize the journal file. */+ if( sqlite3IsMemJournal(pPager->jfd) ){+ assert( pPager->journalMode==PAGER_JOURNALMODE_MEMORY );+ sqlite3OsClose(pPager->jfd);+ }else if( pPager->journalMode==PAGER_JOURNALMODE_TRUNCATE ){+ if( pPager->journalOff==0 ){+ rc = SQLITE_OK;+ }else{+ rc = sqlite3OsTruncate(pPager->jfd, 0);+ if( rc==SQLITE_OK && pPager->fullSync ){+ /* Make sure the new file size is written into the inode right away.+ ** Otherwise the journal might resurrect following a power loss and+ ** cause the last transaction to roll back. See+ ** https://bugzilla.mozilla.org/show_bug.cgi?id=1072773+ */+ rc = sqlite3OsSync(pPager->jfd, pPager->syncFlags);+ }+ }+ pPager->journalOff = 0;+ }else if( pPager->journalMode==PAGER_JOURNALMODE_PERSIST+ || (pPager->exclusiveMode && pPager->journalMode!=PAGER_JOURNALMODE_WAL)+ ){+ rc = zeroJournalHdr(pPager, hasMaster);+ pPager->journalOff = 0;+ }else{+ /* This branch may be executed with Pager.journalMode==MEMORY if+ ** a hot-journal was just rolled back. In this case the journal+ ** file should be closed and deleted. If this connection writes to+ ** the database file, it will do so using an in-memory journal. + */+ int bDelete = (!pPager->tempFile && sqlite3JournalExists(pPager->jfd));+ assert( pPager->journalMode==PAGER_JOURNALMODE_DELETE + || pPager->journalMode==PAGER_JOURNALMODE_MEMORY + || pPager->journalMode==PAGER_JOURNALMODE_WAL + );+ sqlite3OsClose(pPager->jfd);+ if( bDelete ){+ rc = sqlite3OsDelete(pPager->pVfs, pPager->zJournal, 0);+ }+ }+ }++#ifdef SQLITE_CHECK_PAGES+ sqlite3PcacheIterateDirty(pPager->pPCache, pager_set_pagehash);+ if( pPager->dbSize==0 && sqlite3PcacheRefCount(pPager->pPCache)>0 ){+ PgHdr *p = sqlite3PagerLookup(pPager, 1);+ if( p ){+ p->pageHash = 0;+ sqlite3PagerUnrefNotNull(p);+ }+ }+#endif++ sqlite3BitvecDestroy(pPager->pInJournal);+ pPager->pInJournal = 0;+ pPager->nRec = 0;+ sqlite3PcacheCleanAll(pPager->pPCache);+ sqlite3PcacheTruncate(pPager->pPCache, pPager->dbSize);++ if( pagerUseWal(pPager) ){+ /* Drop the WAL write-lock, if any. Also, if the connection was in + ** locking_mode=exclusive mode but is no longer, drop the EXCLUSIVE + ** lock held on the database file.+ */+ rc2 = sqlite3WalEndWriteTransaction(pPager->pWal);+ assert( rc2==SQLITE_OK );+ }else if( rc==SQLITE_OK && bCommit && pPager->dbFileSize>pPager->dbSize ){+ /* This branch is taken when committing a transaction in rollback-journal+ ** mode if the database file on disk is larger than the database image.+ ** At this point the journal has been finalized and the transaction + ** successfully committed, but the EXCLUSIVE lock is still held on the+ ** file. So it is safe to truncate the database file to its minimum+ ** required size. */+ assert( pPager->eLock==EXCLUSIVE_LOCK );+ rc = pager_truncate(pPager, pPager->dbSize);+ }++ if( rc==SQLITE_OK && bCommit && isOpen(pPager->fd) ){+ rc = sqlite3OsFileControl(pPager->fd, SQLITE_FCNTL_COMMIT_PHASETWO, 0);+ if( rc==SQLITE_NOTFOUND ) rc = SQLITE_OK;+ }++ if( !pPager->exclusiveMode + && (!pagerUseWal(pPager) || sqlite3WalExclusiveMode(pPager->pWal, 0))+ ){+ rc2 = pagerUnlockDb(pPager, SHARED_LOCK);+ pPager->changeCountDone = 0;+ }+ pPager->eState = PAGER_READER;+ pPager->setMaster = 0;++ return (rc==SQLITE_OK?rc2:rc);+}++/*+** Execute a rollback if a transaction is active and unlock the +** database file. +**+** If the pager has already entered the ERROR state, do not attempt +** the rollback at this time. Instead, pager_unlock() is called. The+** call to pager_unlock() will discard all in-memory pages, unlock+** the database file and move the pager back to OPEN state. If this +** means that there is a hot-journal left in the file-system, the next +** connection to obtain a shared lock on the pager (which may be this one) +** will roll it back.+**+** If the pager has not already entered the ERROR state, but an IO or+** malloc error occurs during a rollback, then this will itself cause +** the pager to enter the ERROR state. Which will be cleared by the+** call to pager_unlock(), as described above.+*/+static void pagerUnlockAndRollback(Pager *pPager){+ if( pPager->eState!=PAGER_ERROR && pPager->eState!=PAGER_OPEN ){+ assert( assert_pager_state(pPager) );+ if( pPager->eState>=PAGER_WRITER_LOCKED ){+ sqlite3PagerRollback(pPager);+ }else if( !pPager->exclusiveMode ){+ assert( pPager->eState==PAGER_READER );+ pager_end_transaction(pPager, 0, 0);+ }+ }+ pager_unlock(pPager);+}++/*+** Parameter aData must point to a buffer of pPager->pageSize bytes+** of data. Compute and return a checksum based ont the contents of the +** page of data and the current value of pPager->cksumInit.+**+** This is not a real checksum. It is really just the sum of the +** random initial value (pPager->cksumInit) and every 200th byte+** of the page data, starting with byte offset (pPager->pageSize%200).+** Each byte is interpreted as an 8-bit unsigned integer.+**+** Changing the formula used to compute this checksum results in an+** incompatible journal file format.+**+** If journal corruption occurs due to a power failure, the most likely +** scenario is that one end or the other of the record will be changed. +** It is much less likely that the two ends of the journal record will be+** correct and the middle be corrupt. Thus, this "checksum" scheme,+** though fast and simple, catches the mostly likely kind of corruption.+*/+static u32 pager_cksum(Pager *pPager, const u8 *aData){+ u32 cksum = pPager->cksumInit; /* Checksum value to return */+ int i = pPager->pageSize-200; /* Loop counter */+ while( i>0 ){+ cksum += aData[i];+ i -= 200;+ }+ return cksum;+}++/*+** Report the current page size and number of reserved bytes back+** to the codec.+*/+#ifdef SQLITE_HAS_CODEC+static void pagerReportSize(Pager *pPager){+ if( pPager->xCodecSizeChng ){+ pPager->xCodecSizeChng(pPager->pCodec, pPager->pageSize,+ (int)pPager->nReserve);+ }+}+#else+# define pagerReportSize(X) /* No-op if we do not support a codec */+#endif++#ifdef SQLITE_HAS_CODEC+/*+** Make sure the number of reserved bits is the same in the destination+** pager as it is in the source. This comes up when a VACUUM changes the+** number of reserved bits to the "optimal" amount.+*/+SQLITE_PRIVATE void sqlite3PagerAlignReserve(Pager *pDest, Pager *pSrc){+ if( pDest->nReserve!=pSrc->nReserve ){+ pDest->nReserve = pSrc->nReserve;+ pagerReportSize(pDest);+ }+}+#endif++/*+** Read a single page from either the journal file (if isMainJrnl==1) or+** from the sub-journal (if isMainJrnl==0) and playback that page.+** The page begins at offset *pOffset into the file. The *pOffset+** value is increased to the start of the next page in the journal.+**+** The main rollback journal uses checksums - the statement journal does +** not.+**+** If the page number of the page record read from the (sub-)journal file+** is greater than the current value of Pager.dbSize, then playback is+** skipped and SQLITE_OK is returned.+**+** If pDone is not NULL, then it is a record of pages that have already+** been played back. If the page at *pOffset has already been played back+** (if the corresponding pDone bit is set) then skip the playback.+** Make sure the pDone bit corresponding to the *pOffset page is set+** prior to returning.+**+** If the page record is successfully read from the (sub-)journal file+** and played back, then SQLITE_OK is returned. If an IO error occurs+** while reading the record from the (sub-)journal file or while writing+** to the database file, then the IO error code is returned. If data+** is successfully read from the (sub-)journal file but appears to be+** corrupted, SQLITE_DONE is returned. Data is considered corrupted in+** two circumstances:+** +** * If the record page-number is illegal (0 or PAGER_MJ_PGNO), or+** * If the record is being rolled back from the main journal file+** and the checksum field does not match the record content.+**+** Neither of these two scenarios are possible during a savepoint rollback.+**+** If this is a savepoint rollback, then memory may have to be dynamically+** allocated by this function. If this is the case and an allocation fails,+** SQLITE_NOMEM is returned.+*/+static int pager_playback_one_page(+ Pager *pPager, /* The pager being played back */+ i64 *pOffset, /* Offset of record to playback */+ Bitvec *pDone, /* Bitvec of pages already played back */+ int isMainJrnl, /* 1 -> main journal. 0 -> sub-journal. */+ int isSavepnt /* True for a savepoint rollback */+){+ int rc;+ PgHdr *pPg; /* An existing page in the cache */+ Pgno pgno; /* The page number of a page in journal */+ u32 cksum; /* Checksum used for sanity checking */+ char *aData; /* Temporary storage for the page */+ sqlite3_file *jfd; /* The file descriptor for the journal file */+ int isSynced; /* True if journal page is synced */++ assert( (isMainJrnl&~1)==0 ); /* isMainJrnl is 0 or 1 */+ assert( (isSavepnt&~1)==0 ); /* isSavepnt is 0 or 1 */+ assert( isMainJrnl || pDone ); /* pDone always used on sub-journals */+ assert( isSavepnt || pDone==0 ); /* pDone never used on non-savepoint */++ aData = pPager->pTmpSpace;+ assert( aData ); /* Temp storage must have already been allocated */+ assert( pagerUseWal(pPager)==0 || (!isMainJrnl && isSavepnt) );++ /* Either the state is greater than PAGER_WRITER_CACHEMOD (a transaction + ** or savepoint rollback done at the request of the caller) or this is+ ** a hot-journal rollback. If it is a hot-journal rollback, the pager+ ** is in state OPEN and holds an EXCLUSIVE lock. Hot-journal rollback+ ** only reads from the main journal, not the sub-journal.+ */+ assert( pPager->eState>=PAGER_WRITER_CACHEMOD+ || (pPager->eState==PAGER_OPEN && pPager->eLock==EXCLUSIVE_LOCK)+ );+ assert( pPager->eState>=PAGER_WRITER_CACHEMOD || isMainJrnl );++ /* Read the page number and page data from the journal or sub-journal+ ** file. Return an error code to the caller if an IO error occurs.+ */+ jfd = isMainJrnl ? pPager->jfd : pPager->sjfd;+ rc = read32bits(jfd, *pOffset, &pgno);+ if( rc!=SQLITE_OK ) return rc;+ rc = sqlite3OsRead(jfd, (u8*)aData, pPager->pageSize, (*pOffset)+4);+ if( rc!=SQLITE_OK ) return rc;+ *pOffset += pPager->pageSize + 4 + isMainJrnl*4;++ /* Sanity checking on the page. This is more important that I originally+ ** thought. If a power failure occurs while the journal is being written,+ ** it could cause invalid data to be written into the journal. We need to+ ** detect this invalid data (with high probability) and ignore it.+ */+ if( pgno==0 || pgno==PAGER_MJ_PGNO(pPager) ){+ assert( !isSavepnt );+ return SQLITE_DONE;+ }+ if( pgno>(Pgno)pPager->dbSize || sqlite3BitvecTest(pDone, pgno) ){+ return SQLITE_OK;+ }+ if( isMainJrnl ){+ rc = read32bits(jfd, (*pOffset)-4, &cksum);+ if( rc ) return rc;+ if( !isSavepnt && pager_cksum(pPager, (u8*)aData)!=cksum ){+ return SQLITE_DONE;+ }+ }++ /* If this page has already been played back before during the current+ ** rollback, then don't bother to play it back again.+ */+ if( pDone && (rc = sqlite3BitvecSet(pDone, pgno))!=SQLITE_OK ){+ return rc;+ }++ /* When playing back page 1, restore the nReserve setting+ */+ if( pgno==1 && pPager->nReserve!=((u8*)aData)[20] ){+ pPager->nReserve = ((u8*)aData)[20];+ pagerReportSize(pPager);+ }++ /* If the pager is in CACHEMOD state, then there must be a copy of this+ ** page in the pager cache. In this case just update the pager cache,+ ** not the database file. The page is left marked dirty in this case.+ **+ ** An exception to the above rule: If the database is in no-sync mode+ ** and a page is moved during an incremental vacuum then the page may+ ** not be in the pager cache. Later: if a malloc() or IO error occurs+ ** during a Movepage() call, then the page may not be in the cache+ ** either. So the condition described in the above paragraph is not+ ** assert()able.+ **+ ** If in WRITER_DBMOD, WRITER_FINISHED or OPEN state, then we update the+ ** pager cache if it exists and the main file. The page is then marked + ** not dirty. Since this code is only executed in PAGER_OPEN state for+ ** a hot-journal rollback, it is guaranteed that the page-cache is empty+ ** if the pager is in OPEN state.+ **+ ** Ticket #1171: The statement journal might contain page content that is+ ** different from the page content at the start of the transaction.+ ** This occurs when a page is changed prior to the start of a statement+ ** then changed again within the statement. When rolling back such a+ ** statement we must not write to the original database unless we know+ ** for certain that original page contents are synced into the main rollback+ ** journal. Otherwise, a power loss might leave modified data in the+ ** database file without an entry in the rollback journal that can+ ** restore the database to its original form. Two conditions must be+ ** met before writing to the database files. (1) the database must be+ ** locked. (2) we know that the original page content is fully synced+ ** in the main journal either because the page is not in cache or else+ ** the page is marked as needSync==0.+ **+ ** 2008-04-14: When attempting to vacuum a corrupt database file, it+ ** is possible to fail a statement on a database that does not yet exist.+ ** Do not attempt to write if database file has never been opened.+ */+ if( pagerUseWal(pPager) ){+ pPg = 0;+ }else{+ pPg = sqlite3PagerLookup(pPager, pgno);+ }+ assert( pPg );+ assert( pPager->eState!=PAGER_OPEN || pPg==0 );+ PAGERTRACE(("PLAYBACK %d page %d hash(%08x) %s\n",+ PAGERID(pPager), pgno, pager_datahash(pPager->pageSize, (u8*)aData),+ (isMainJrnl?"main-journal":"sub-journal")+ ));+ if( isMainJrnl ){+ isSynced = pPager->noSync || (*pOffset <= pPager->journalHdr);+ }else{+ isSynced = (pPg==0 || 0==(pPg->flags & PGHDR_NEED_SYNC));+ }+ if( isOpen(pPager->fd)+ && (pPager->eState>=PAGER_WRITER_DBMOD || pPager->eState==PAGER_OPEN)+ && isSynced+ ){+ i64 ofst = (pgno-1)*(i64)pPager->pageSize;+ testcase( !isSavepnt && pPg!=0 && (pPg->flags&PGHDR_NEED_SYNC)!=0 );+ assert( !pagerUseWal(pPager) );+ rc = sqlite3OsWrite(pPager->fd, (u8 *)aData, pPager->pageSize, ofst);+ if( pgno>pPager->dbFileSize ){+ pPager->dbFileSize = pgno;+ }+ if( pPager->pBackup ){+ CODEC1(pPager, aData, pgno, 3, rc=SQLITE_NOMEM);+ sqlite3BackupUpdate(pPager->pBackup, pgno, (u8*)aData);+ CODEC2(pPager, aData, pgno, 7, rc=SQLITE_NOMEM, aData);+ }+ }else if( !isMainJrnl && pPg==0 ){+ /* If this is a rollback of a savepoint and data was not written to+ ** the database and the page is not in-memory, there is a potential+ ** problem. When the page is next fetched by the b-tree layer, it + ** will be read from the database file, which may or may not be + ** current. + **+ ** There are a couple of different ways this can happen. All are quite+ ** obscure. When running in synchronous mode, this can only happen + ** if the page is on the free-list at the start of the transaction, then+ ** populated, then moved using sqlite3PagerMovepage().+ **+ ** The solution is to add an in-memory page to the cache containing+ ** the data just read from the sub-journal. Mark the page as dirty + ** and if the pager requires a journal-sync, then mark the page as + ** requiring a journal-sync before it is written.+ */+ assert( isSavepnt );+ assert( (pPager->doNotSpill & SPILLFLAG_ROLLBACK)==0 );+ pPager->doNotSpill |= SPILLFLAG_ROLLBACK;+ rc = sqlite3PagerAcquire(pPager, pgno, &pPg, 1);+ assert( (pPager->doNotSpill & SPILLFLAG_ROLLBACK)!=0 );+ pPager->doNotSpill &= ~SPILLFLAG_ROLLBACK;+ if( rc!=SQLITE_OK ) return rc;+ pPg->flags &= ~PGHDR_NEED_READ;+ sqlite3PcacheMakeDirty(pPg);+ }+ if( pPg ){+ /* No page should ever be explicitly rolled back that is in use, except+ ** for page 1 which is held in use in order to keep the lock on the+ ** database active. However such a page may be rolled back as a result+ ** of an internal error resulting in an automatic call to+ ** sqlite3PagerRollback().+ */+ void *pData;+ pData = pPg->pData;+ memcpy(pData, (u8*)aData, pPager->pageSize);+ pPager->xReiniter(pPg);+ if( isMainJrnl && (!isSavepnt || *pOffset<=pPager->journalHdr) ){+ /* If the contents of this page were just restored from the main + ** journal file, then its content must be as they were when the + ** transaction was first opened. In this case we can mark the page+ ** as clean, since there will be no need to write it out to the+ ** database.+ **+ ** There is one exception to this rule. If the page is being rolled+ ** back as part of a savepoint (or statement) rollback from an + ** unsynced portion of the main journal file, then it is not safe+ ** to mark the page as clean. This is because marking the page as+ ** clean will clear the PGHDR_NEED_SYNC flag. Since the page is+ ** already in the journal file (recorded in Pager.pInJournal) and+ ** the PGHDR_NEED_SYNC flag is cleared, if the page is written to+ ** again within this transaction, it will be marked as dirty but+ ** the PGHDR_NEED_SYNC flag will not be set. It could then potentially+ ** be written out into the database file before its journal file+ ** segment is synced. If a crash occurs during or following this,+ ** database corruption may ensue.+ */+ assert( !pagerUseWal(pPager) );+ sqlite3PcacheMakeClean(pPg);+ }+ pager_set_pagehash(pPg);++ /* If this was page 1, then restore the value of Pager.dbFileVers.+ ** Do this before any decoding. */+ if( pgno==1 ){+ memcpy(&pPager->dbFileVers, &((u8*)pData)[24],sizeof(pPager->dbFileVers));+ }++ /* Decode the page just read from disk */+ CODEC1(pPager, pData, pPg->pgno, 3, rc=SQLITE_NOMEM);+ sqlite3PcacheRelease(pPg);+ }+ return rc;+}++/*+** Parameter zMaster is the name of a master journal file. A single journal+** file that referred to the master journal file has just been rolled back.+** This routine checks if it is possible to delete the master journal file,+** and does so if it is.+**+** Argument zMaster may point to Pager.pTmpSpace. So that buffer is not +** available for use within this function.+**+** When a master journal file is created, it is populated with the names +** of all of its child journals, one after another, formatted as utf-8 +** encoded text. The end of each child journal file is marked with a +** nul-terminator byte (0x00). i.e. the entire contents of a master journal+** file for a transaction involving two databases might be:+**+** "/home/bill/a.db-journal\x00/home/bill/b.db-journal\x00"+**+** A master journal file may only be deleted once all of its child +** journals have been rolled back.+**+** This function reads the contents of the master-journal file into +** memory and loops through each of the child journal names. For+** each child journal, it checks if:+**+** * if the child journal exists, and if so+** * if the child journal contains a reference to master journal +** file zMaster+**+** If a child journal can be found that matches both of the criteria+** above, this function returns without doing anything. Otherwise, if+** no such child journal can be found, file zMaster is deleted from+** the file-system using sqlite3OsDelete().+**+** If an IO error within this function, an error code is returned. This+** function allocates memory by calling sqlite3Malloc(). If an allocation+** fails, SQLITE_NOMEM is returned. Otherwise, if no IO or malloc errors +** occur, SQLITE_OK is returned.+**+** TODO: This function allocates a single block of memory to load+** the entire contents of the master journal file. This could be+** a couple of kilobytes or so - potentially larger than the page +** size.+*/+static int pager_delmaster(Pager *pPager, const char *zMaster){+ sqlite3_vfs *pVfs = pPager->pVfs;+ int rc; /* Return code */+ sqlite3_file *pMaster; /* Malloc'd master-journal file descriptor */+ sqlite3_file *pJournal; /* Malloc'd child-journal file descriptor */+ char *zMasterJournal = 0; /* Contents of master journal file */+ i64 nMasterJournal; /* Size of master journal file */+ char *zJournal; /* Pointer to one journal within MJ file */+ char *zMasterPtr; /* Space to hold MJ filename from a journal file */+ int nMasterPtr; /* Amount of space allocated to zMasterPtr[] */++ /* Allocate space for both the pJournal and pMaster file descriptors.+ ** If successful, open the master journal file for reading.+ */+ pMaster = (sqlite3_file *)sqlite3MallocZero(pVfs->szOsFile * 2);+ pJournal = (sqlite3_file *)(((u8 *)pMaster) + pVfs->szOsFile);+ if( !pMaster ){+ rc = SQLITE_NOMEM;+ }else{+ const int flags = (SQLITE_OPEN_READONLY|SQLITE_OPEN_MASTER_JOURNAL);+ rc = sqlite3OsOpen(pVfs, zMaster, pMaster, flags, 0);+ }+ if( rc!=SQLITE_OK ) goto delmaster_out;++ /* Load the entire master journal file into space obtained from+ ** sqlite3_malloc() and pointed to by zMasterJournal. Also obtain+ ** sufficient space (in zMasterPtr) to hold the names of master+ ** journal files extracted from regular rollback-journals.+ */+ rc = sqlite3OsFileSize(pMaster, &nMasterJournal);+ if( rc!=SQLITE_OK ) goto delmaster_out;+ nMasterPtr = pVfs->mxPathname+1;+ zMasterJournal = sqlite3Malloc(nMasterJournal + nMasterPtr + 1);+ if( !zMasterJournal ){+ rc = SQLITE_NOMEM;+ goto delmaster_out;+ }+ zMasterPtr = &zMasterJournal[nMasterJournal+1];+ rc = sqlite3OsRead(pMaster, zMasterJournal, (int)nMasterJournal, 0);+ if( rc!=SQLITE_OK ) goto delmaster_out;+ zMasterJournal[nMasterJournal] = 0;++ zJournal = zMasterJournal;+ while( (zJournal-zMasterJournal)<nMasterJournal ){+ int exists;+ rc = sqlite3OsAccess(pVfs, zJournal, SQLITE_ACCESS_EXISTS, &exists);+ if( rc!=SQLITE_OK ){+ goto delmaster_out;+ }+ if( exists ){+ /* One of the journals pointed to by the master journal exists.+ ** Open it and check if it points at the master journal. If+ ** so, return without deleting the master journal file.+ */+ int c;+ int flags = (SQLITE_OPEN_READONLY|SQLITE_OPEN_MAIN_JOURNAL);+ rc = sqlite3OsOpen(pVfs, zJournal, pJournal, flags, 0);+ if( rc!=SQLITE_OK ){+ goto delmaster_out;+ }++ rc = readMasterJournal(pJournal, zMasterPtr, nMasterPtr);+ sqlite3OsClose(pJournal);+ if( rc!=SQLITE_OK ){+ goto delmaster_out;+ }++ c = zMasterPtr[0]!=0 && strcmp(zMasterPtr, zMaster)==0;+ if( c ){+ /* We have a match. Do not delete the master journal file. */+ goto delmaster_out;+ }+ }+ zJournal += (sqlite3Strlen30(zJournal)+1);+ }+ + sqlite3OsClose(pMaster);+ rc = sqlite3OsDelete(pVfs, zMaster, 0);++delmaster_out:+ sqlite3_free(zMasterJournal);+ if( pMaster ){+ sqlite3OsClose(pMaster);+ assert( !isOpen(pJournal) );+ sqlite3_free(pMaster);+ }+ return rc;+}+++/*+** This function is used to change the actual size of the database +** file in the file-system. This only happens when committing a transaction,+** or rolling back a transaction (including rolling back a hot-journal).+**+** If the main database file is not open, or the pager is not in either+** DBMOD or OPEN state, this function is a no-op. Otherwise, the size +** of the file is changed to nPage pages (nPage*pPager->pageSize bytes). +** If the file on disk is currently larger than nPage pages, then use the VFS+** xTruncate() method to truncate it.+**+** Or, it might be the case that the file on disk is smaller than +** nPage pages. Some operating system implementations can get confused if +** you try to truncate a file to some size that is larger than it +** currently is, so detect this case and write a single zero byte to +** the end of the new file instead.+**+** If successful, return SQLITE_OK. If an IO error occurs while modifying+** the database file, return the error code to the caller.+*/+static int pager_truncate(Pager *pPager, Pgno nPage){+ int rc = SQLITE_OK;+ assert( pPager->eState!=PAGER_ERROR );+ assert( pPager->eState!=PAGER_READER );+ + if( isOpen(pPager->fd) + && (pPager->eState>=PAGER_WRITER_DBMOD || pPager->eState==PAGER_OPEN) + ){+ i64 currentSize, newSize;+ int szPage = pPager->pageSize;+ assert( pPager->eLock==EXCLUSIVE_LOCK );+ /* TODO: Is it safe to use Pager.dbFileSize here? */+ rc = sqlite3OsFileSize(pPager->fd, ¤tSize);+ newSize = szPage*(i64)nPage;+ if( rc==SQLITE_OK && currentSize!=newSize ){+ if( currentSize>newSize ){+ rc = sqlite3OsTruncate(pPager->fd, newSize);+ }else if( (currentSize+szPage)<=newSize ){+ char *pTmp = pPager->pTmpSpace;+ memset(pTmp, 0, szPage);+ testcase( (newSize-szPage) == currentSize );+ testcase( (newSize-szPage) > currentSize );+ rc = sqlite3OsWrite(pPager->fd, pTmp, szPage, newSize-szPage);+ }+ if( rc==SQLITE_OK ){+ pPager->dbFileSize = nPage;+ }+ }+ }+ return rc;+}++/*+** Return a sanitized version of the sector-size of OS file pFile. The+** return value is guaranteed to lie between 32 and MAX_SECTOR_SIZE.+*/+SQLITE_PRIVATE int sqlite3SectorSize(sqlite3_file *pFile){+ int iRet = sqlite3OsSectorSize(pFile);+ if( iRet<32 ){+ iRet = 512;+ }else if( iRet>MAX_SECTOR_SIZE ){+ assert( MAX_SECTOR_SIZE>=512 );+ iRet = MAX_SECTOR_SIZE;+ }+ return iRet;+}++/*+** Set the value of the Pager.sectorSize variable for the given+** pager based on the value returned by the xSectorSize method+** of the open database file. The sector size will be used +** to determine the size and alignment of journal header and +** master journal pointers within created journal files.+**+** For temporary files the effective sector size is always 512 bytes.+**+** Otherwise, for non-temporary files, the effective sector size is+** the value returned by the xSectorSize() method rounded up to 32 if+** it is less than 32, or rounded down to MAX_SECTOR_SIZE if it+** is greater than MAX_SECTOR_SIZE.+**+** If the file has the SQLITE_IOCAP_POWERSAFE_OVERWRITE property, then set+** the effective sector size to its minimum value (512). The purpose of+** pPager->sectorSize is to define the "blast radius" of bytes that+** might change if a crash occurs while writing to a single byte in+** that range. But with POWERSAFE_OVERWRITE, the blast radius is zero+** (that is what POWERSAFE_OVERWRITE means), so we minimize the sector+** size. For backwards compatibility of the rollback journal file format,+** we cannot reduce the effective sector size below 512.+*/+static void setSectorSize(Pager *pPager){+ assert( isOpen(pPager->fd) || pPager->tempFile );++ if( pPager->tempFile+ || (sqlite3OsDeviceCharacteristics(pPager->fd) & + SQLITE_IOCAP_POWERSAFE_OVERWRITE)!=0+ ){+ /* Sector size doesn't matter for temporary files. Also, the file+ ** may not have been opened yet, in which case the OsSectorSize()+ ** call will segfault. */+ pPager->sectorSize = 512;+ }else{+ pPager->sectorSize = sqlite3SectorSize(pPager->fd);+ }+}++/*+** Playback the journal and thus restore the database file to+** the state it was in before we started making changes. +**+** The journal file format is as follows: +**+** (1) 8 byte prefix. A copy of aJournalMagic[].+** (2) 4 byte big-endian integer which is the number of valid page records+** in the journal. If this value is 0xffffffff, then compute the+** number of page records from the journal size.+** (3) 4 byte big-endian integer which is the initial value for the +** sanity checksum.+** (4) 4 byte integer which is the number of pages to truncate the+** database to during a rollback.+** (5) 4 byte big-endian integer which is the sector size. The header+** is this many bytes in size.+** (6) 4 byte big-endian integer which is the page size.+** (7) zero padding out to the next sector size.+** (8) Zero or more pages instances, each as follows:+** + 4 byte page number.+** + pPager->pageSize bytes of data.+** + 4 byte checksum+**+** When we speak of the journal header, we mean the first 7 items above.+** Each entry in the journal is an instance of the 8th item.+**+** Call the value from the second bullet "nRec". nRec is the number of+** valid page entries in the journal. In most cases, you can compute the+** value of nRec from the size of the journal file. But if a power+** failure occurred while the journal was being written, it could be the+** case that the size of the journal file had already been increased but+** the extra entries had not yet made it safely to disk. In such a case,+** the value of nRec computed from the file size would be too large. For+** that reason, we always use the nRec value in the header.+**+** If the nRec value is 0xffffffff it means that nRec should be computed+** from the file size. This value is used when the user selects the+** no-sync option for the journal. A power failure could lead to corruption+** in this case. But for things like temporary table (which will be+** deleted when the power is restored) we don't care. +**+** If the file opened as the journal file is not a well-formed+** journal file then all pages up to the first corrupted page are rolled+** back (or no pages if the journal header is corrupted). The journal file+** is then deleted and SQLITE_OK returned, just as if no corruption had+** been encountered.+**+** If an I/O or malloc() error occurs, the journal-file is not deleted+** and an error code is returned.+**+** The isHot parameter indicates that we are trying to rollback a journal+** that might be a hot journal. Or, it could be that the journal is +** preserved because of JOURNALMODE_PERSIST or JOURNALMODE_TRUNCATE.+** If the journal really is hot, reset the pager cache prior rolling+** back any content. If the journal is merely persistent, no reset is+** needed.+*/+static int pager_playback(Pager *pPager, int isHot){+ sqlite3_vfs *pVfs = pPager->pVfs;+ i64 szJ; /* Size of the journal file in bytes */+ u32 nRec; /* Number of Records in the journal */+ u32 u; /* Unsigned loop counter */+ Pgno mxPg = 0; /* Size of the original file in pages */+ int rc; /* Result code of a subroutine */+ int res = 1; /* Value returned by sqlite3OsAccess() */+ char *zMaster = 0; /* Name of master journal file if any */+ int needPagerReset; /* True to reset page prior to first page rollback */+ int nPlayback = 0; /* Total number of pages restored from journal */++ /* Figure out how many records are in the journal. Abort early if+ ** the journal is empty.+ */+ assert( isOpen(pPager->jfd) );+ rc = sqlite3OsFileSize(pPager->jfd, &szJ);+ if( rc!=SQLITE_OK ){+ goto end_playback;+ }++ /* Read the master journal name from the journal, if it is present.+ ** If a master journal file name is specified, but the file is not+ ** present on disk, then the journal is not hot and does not need to be+ ** played back.+ **+ ** TODO: Technically the following is an error because it assumes that+ ** buffer Pager.pTmpSpace is (mxPathname+1) bytes or larger. i.e. that+ ** (pPager->pageSize >= pPager->pVfs->mxPathname+1). Using os_unix.c,+ ** mxPathname is 512, which is the same as the minimum allowable value+ ** for pageSize.+ */+ zMaster = pPager->pTmpSpace;+ rc = readMasterJournal(pPager->jfd, zMaster, pPager->pVfs->mxPathname+1);+ if( rc==SQLITE_OK && zMaster[0] ){+ rc = sqlite3OsAccess(pVfs, zMaster, SQLITE_ACCESS_EXISTS, &res);+ }+ zMaster = 0;+ if( rc!=SQLITE_OK || !res ){+ goto end_playback;+ }+ pPager->journalOff = 0;+ needPagerReset = isHot;++ /* This loop terminates either when a readJournalHdr() or + ** pager_playback_one_page() call returns SQLITE_DONE or an IO error + ** occurs. + */+ while( 1 ){+ /* Read the next journal header from the journal file. If there are+ ** not enough bytes left in the journal file for a complete header, or+ ** it is corrupted, then a process must have failed while writing it.+ ** This indicates nothing more needs to be rolled back.+ */+ rc = readJournalHdr(pPager, isHot, szJ, &nRec, &mxPg);+ if( rc!=SQLITE_OK ){ + if( rc==SQLITE_DONE ){+ rc = SQLITE_OK;+ }+ goto end_playback;+ }++ /* If nRec is 0xffffffff, then this journal was created by a process+ ** working in no-sync mode. This means that the rest of the journal+ ** file consists of pages, there are no more journal headers. Compute+ ** the value of nRec based on this assumption.+ */+ if( nRec==0xffffffff ){+ assert( pPager->journalOff==JOURNAL_HDR_SZ(pPager) );+ nRec = (int)((szJ - JOURNAL_HDR_SZ(pPager))/JOURNAL_PG_SZ(pPager));+ }++ /* If nRec is 0 and this rollback is of a transaction created by this+ ** process and if this is the final header in the journal, then it means+ ** that this part of the journal was being filled but has not yet been+ ** synced to disk. Compute the number of pages based on the remaining+ ** size of the file.+ **+ ** The third term of the test was added to fix ticket #2565.+ ** When rolling back a hot journal, nRec==0 always means that the next+ ** chunk of the journal contains zero pages to be rolled back. But+ ** when doing a ROLLBACK and the nRec==0 chunk is the last chunk in+ ** the journal, it means that the journal might contain additional+ ** pages that need to be rolled back and that the number of pages + ** should be computed based on the journal file size.+ */+ if( nRec==0 && !isHot &&+ pPager->journalHdr+JOURNAL_HDR_SZ(pPager)==pPager->journalOff ){+ nRec = (int)((szJ - pPager->journalOff) / JOURNAL_PG_SZ(pPager));+ }++ /* If this is the first header read from the journal, truncate the+ ** database file back to its original size.+ */+ if( pPager->journalOff==JOURNAL_HDR_SZ(pPager) ){+ rc = pager_truncate(pPager, mxPg);+ if( rc!=SQLITE_OK ){+ goto end_playback;+ }+ pPager->dbSize = mxPg;+ }++ /* Copy original pages out of the journal and back into the + ** database file and/or page cache.+ */+ for(u=0; u<nRec; u++){+ if( needPagerReset ){+ pager_reset(pPager);+ needPagerReset = 0;+ }+ rc = pager_playback_one_page(pPager,&pPager->journalOff,0,1,0);+ if( rc==SQLITE_OK ){+ nPlayback++;+ }else{+ if( rc==SQLITE_DONE ){+ pPager->journalOff = szJ;+ break;+ }else if( rc==SQLITE_IOERR_SHORT_READ ){+ /* If the journal has been truncated, simply stop reading and+ ** processing the journal. This might happen if the journal was+ ** not completely written and synced prior to a crash. In that+ ** case, the database should have never been written in the+ ** first place so it is OK to simply abandon the rollback. */+ rc = SQLITE_OK;+ goto end_playback;+ }else{+ /* If we are unable to rollback, quit and return the error+ ** code. This will cause the pager to enter the error state+ ** so that no further harm will be done. Perhaps the next+ ** process to come along will be able to rollback the database.+ */+ goto end_playback;+ }+ }+ }+ }+ /*NOTREACHED*/+ assert( 0 );++end_playback:+ /* Following a rollback, the database file should be back in its original+ ** state prior to the start of the transaction, so invoke the+ ** SQLITE_FCNTL_DB_UNCHANGED file-control method to disable the+ ** assertion that the transaction counter was modified.+ */+#ifdef SQLITE_DEBUG+ if( pPager->fd->pMethods ){+ sqlite3OsFileControlHint(pPager->fd,SQLITE_FCNTL_DB_UNCHANGED,0);+ }+#endif++ /* If this playback is happening automatically as a result of an IO or + ** malloc error that occurred after the change-counter was updated but + ** before the transaction was committed, then the change-counter + ** modification may just have been reverted. If this happens in exclusive + ** mode, then subsequent transactions performed by the connection will not+ ** update the change-counter at all. This may lead to cache inconsistency+ ** problems for other processes at some point in the future. So, just+ ** in case this has happened, clear the changeCountDone flag now.+ */+ pPager->changeCountDone = pPager->tempFile;++ if( rc==SQLITE_OK ){+ zMaster = pPager->pTmpSpace;+ rc = readMasterJournal(pPager->jfd, zMaster, pPager->pVfs->mxPathname+1);+ testcase( rc!=SQLITE_OK );+ }+ if( rc==SQLITE_OK+ && (pPager->eState>=PAGER_WRITER_DBMOD || pPager->eState==PAGER_OPEN)+ ){+ rc = sqlite3PagerSync(pPager, 0);+ }+ if( rc==SQLITE_OK ){+ rc = pager_end_transaction(pPager, zMaster[0]!='\0', 0);+ testcase( rc!=SQLITE_OK );+ }+ if( rc==SQLITE_OK && zMaster[0] && res ){+ /* If there was a master journal and this routine will return success,+ ** see if it is possible to delete the master journal.+ */+ rc = pager_delmaster(pPager, zMaster);+ testcase( rc!=SQLITE_OK );+ }+ if( isHot && nPlayback ){+ sqlite3_log(SQLITE_NOTICE_RECOVER_ROLLBACK, "recovered %d pages from %s",+ nPlayback, pPager->zJournal);+ }++ /* The Pager.sectorSize variable may have been updated while rolling+ ** back a journal created by a process with a different sector size+ ** value. Reset it to the correct value for this process.+ */+ setSectorSize(pPager);+ return rc;+}+++/*+** Read the content for page pPg out of the database file and into +** pPg->pData. A shared lock or greater must be held on the database+** file before this function is called.+**+** If page 1 is read, then the value of Pager.dbFileVers[] is set to+** the value read from the database file.+**+** If an IO error occurs, then the IO error is returned to the caller.+** Otherwise, SQLITE_OK is returned.+*/+static int readDbPage(PgHdr *pPg, u32 iFrame){+ Pager *pPager = pPg->pPager; /* Pager object associated with page pPg */+ Pgno pgno = pPg->pgno; /* Page number to read */+ int rc = SQLITE_OK; /* Return code */+ int pgsz = pPager->pageSize; /* Number of bytes to read */++ assert( pPager->eState>=PAGER_READER );+ assert( isOpen(pPager->fd) );++#ifndef SQLITE_OMIT_WAL+ if( iFrame ){+ /* Try to pull the page from the write-ahead log. */+ rc = sqlite3WalReadFrame(pPager->pWal, iFrame, pgsz, pPg->pData);+ }else+#endif+ {+ i64 iOffset = (pgno-1)*(i64)pPager->pageSize;+ rc = sqlite3OsRead(pPager->fd, pPg->pData, pgsz, iOffset);+ if( rc==SQLITE_IOERR_SHORT_READ ){+ rc = SQLITE_OK;+ }+ }++ if( pgno==1 ){+ if( rc ){+ /* If the read is unsuccessful, set the dbFileVers[] to something+ ** that will never be a valid file version. dbFileVers[] is a copy+ ** of bytes 24..39 of the database. Bytes 28..31 should always be+ ** zero or the size of the database in page. Bytes 32..35 and 35..39+ ** should be page numbers which are never 0xffffffff. So filling+ ** pPager->dbFileVers[] with all 0xff bytes should suffice.+ **+ ** For an encrypted database, the situation is more complex: bytes+ ** 24..39 of the database are white noise. But the probability of+ ** white noise equaling 16 bytes of 0xff is vanishingly small so+ ** we should still be ok.+ */+ memset(pPager->dbFileVers, 0xff, sizeof(pPager->dbFileVers));+ }else{+ u8 *dbFileVers = &((u8*)pPg->pData)[24];+ memcpy(&pPager->dbFileVers, dbFileVers, sizeof(pPager->dbFileVers));+ }+ }+ CODEC1(pPager, pPg->pData, pgno, 3, rc = SQLITE_NOMEM);++ PAGER_INCR(sqlite3_pager_readdb_count);+ PAGER_INCR(pPager->nRead);+ IOTRACE(("PGIN %p %d\n", pPager, pgno));+ PAGERTRACE(("FETCH %d page %d hash(%08x)\n",+ PAGERID(pPager), pgno, pager_pagehash(pPg)));++ return rc;+}++/*+** Update the value of the change-counter at offsets 24 and 92 in+** the header and the sqlite version number at offset 96.+**+** This is an unconditional update. See also the pager_incr_changecounter()+** routine which only updates the change-counter if the update is actually+** needed, as determined by the pPager->changeCountDone state variable.+*/+static void pager_write_changecounter(PgHdr *pPg){+ u32 change_counter;++ /* Increment the value just read and write it back to byte 24. */+ change_counter = sqlite3Get4byte((u8*)pPg->pPager->dbFileVers)+1;+ put32bits(((char*)pPg->pData)+24, change_counter);++ /* Also store the SQLite version number in bytes 96..99 and in+ ** bytes 92..95 store the change counter for which the version number+ ** is valid. */+ put32bits(((char*)pPg->pData)+92, change_counter);+ put32bits(((char*)pPg->pData)+96, SQLITE_VERSION_NUMBER);+}++#ifndef SQLITE_OMIT_WAL+/*+** This function is invoked once for each page that has already been +** written into the log file when a WAL transaction is rolled back.+** Parameter iPg is the page number of said page. The pCtx argument +** is actually a pointer to the Pager structure.+**+** If page iPg is present in the cache, and has no outstanding references,+** it is discarded. Otherwise, if there are one or more outstanding+** references, the page content is reloaded from the database. If the+** attempt to reload content from the database is required and fails, +** return an SQLite error code. Otherwise, SQLITE_OK.+*/+static int pagerUndoCallback(void *pCtx, Pgno iPg){+ int rc = SQLITE_OK;+ Pager *pPager = (Pager *)pCtx;+ PgHdr *pPg;++ assert( pagerUseWal(pPager) );+ pPg = sqlite3PagerLookup(pPager, iPg);+ if( pPg ){+ if( sqlite3PcachePageRefcount(pPg)==1 ){+ sqlite3PcacheDrop(pPg);+ }else{+ u32 iFrame = 0;+ rc = sqlite3WalFindFrame(pPager->pWal, pPg->pgno, &iFrame);+ if( rc==SQLITE_OK ){+ rc = readDbPage(pPg, iFrame);+ }+ if( rc==SQLITE_OK ){+ pPager->xReiniter(pPg);+ }+ sqlite3PagerUnrefNotNull(pPg);+ }+ }++ /* Normally, if a transaction is rolled back, any backup processes are+ ** updated as data is copied out of the rollback journal and into the+ ** database. This is not generally possible with a WAL database, as+ ** rollback involves simply truncating the log file. Therefore, if one+ ** or more frames have already been written to the log (and therefore + ** also copied into the backup databases) as part of this transaction,+ ** the backups must be restarted.+ */+ sqlite3BackupRestart(pPager->pBackup);++ return rc;+}++/*+** This function is called to rollback a transaction on a WAL database.+*/+static int pagerRollbackWal(Pager *pPager){+ int rc; /* Return Code */+ PgHdr *pList; /* List of dirty pages to revert */++ /* For all pages in the cache that are currently dirty or have already+ ** been written (but not committed) to the log file, do one of the + ** following:+ **+ ** + Discard the cached page (if refcount==0), or+ ** + Reload page content from the database (if refcount>0).+ */+ pPager->dbSize = pPager->dbOrigSize;+ rc = sqlite3WalUndo(pPager->pWal, pagerUndoCallback, (void *)pPager);+ pList = sqlite3PcacheDirtyList(pPager->pPCache);+ while( pList && rc==SQLITE_OK ){+ PgHdr *pNext = pList->pDirty;+ rc = pagerUndoCallback((void *)pPager, pList->pgno);+ pList = pNext;+ }++ return rc;+}++/*+** This function is a wrapper around sqlite3WalFrames(). As well as logging+** the contents of the list of pages headed by pList (connected by pDirty),+** this function notifies any active backup processes that the pages have+** changed. +**+** The list of pages passed into this routine is always sorted by page number.+** Hence, if page 1 appears anywhere on the list, it will be the first page.+*/ +static int pagerWalFrames(+ Pager *pPager, /* Pager object */+ PgHdr *pList, /* List of frames to log */+ Pgno nTruncate, /* Database size after this commit */+ int isCommit /* True if this is a commit */+){+ int rc; /* Return code */+ int nList; /* Number of pages in pList */+ PgHdr *p; /* For looping over pages */++ assert( pPager->pWal );+ assert( pList );+#ifdef SQLITE_DEBUG+ /* Verify that the page list is in accending order */+ for(p=pList; p && p->pDirty; p=p->pDirty){+ assert( p->pgno < p->pDirty->pgno );+ }+#endif++ assert( pList->pDirty==0 || isCommit );+ if( isCommit ){+ /* If a WAL transaction is being committed, there is no point in writing+ ** any pages with page numbers greater than nTruncate into the WAL file.+ ** They will never be read by any client. So remove them from the pDirty+ ** list here. */+ PgHdr **ppNext = &pList;+ nList = 0;+ for(p=pList; (*ppNext = p)!=0; p=p->pDirty){+ if( p->pgno<=nTruncate ){+ ppNext = &p->pDirty;+ nList++;+ }+ }+ assert( pList );+ }else{+ nList = 1;+ }+ pPager->aStat[PAGER_STAT_WRITE] += nList;++ if( pList->pgno==1 ) pager_write_changecounter(pList);+ rc = sqlite3WalFrames(pPager->pWal, + pPager->pageSize, pList, nTruncate, isCommit, pPager->walSyncFlags+ );+ if( rc==SQLITE_OK && pPager->pBackup ){+ for(p=pList; p; p=p->pDirty){+ sqlite3BackupUpdate(pPager->pBackup, p->pgno, (u8 *)p->pData);+ }+ }++#ifdef SQLITE_CHECK_PAGES+ pList = sqlite3PcacheDirtyList(pPager->pPCache);+ for(p=pList; p; p=p->pDirty){+ pager_set_pagehash(p);+ }+#endif++ return rc;+}++/*+** Begin a read transaction on the WAL.+**+** This routine used to be called "pagerOpenSnapshot()" because it essentially+** makes a snapshot of the database at the current point in time and preserves+** that snapshot for use by the reader in spite of concurrently changes by+** other writers or checkpointers.+*/+static int pagerBeginReadTransaction(Pager *pPager){+ int rc; /* Return code */+ int changed = 0; /* True if cache must be reset */++ assert( pagerUseWal(pPager) );+ assert( pPager->eState==PAGER_OPEN || pPager->eState==PAGER_READER );++ /* sqlite3WalEndReadTransaction() was not called for the previous+ ** transaction in locking_mode=EXCLUSIVE. So call it now. If we+ ** are in locking_mode=NORMAL and EndRead() was previously called,+ ** the duplicate call is harmless.+ */+ sqlite3WalEndReadTransaction(pPager->pWal);++ rc = sqlite3WalBeginReadTransaction(pPager->pWal, &changed);+ if( rc!=SQLITE_OK || changed ){+ pager_reset(pPager);+ if( USEFETCH(pPager) ) sqlite3OsUnfetch(pPager->fd, 0, 0);+ }++ return rc;+}+#endif++/*+** This function is called as part of the transition from PAGER_OPEN+** to PAGER_READER state to determine the size of the database file+** in pages (assuming the page size currently stored in Pager.pageSize).+**+** If no error occurs, SQLITE_OK is returned and the size of the database+** in pages is stored in *pnPage. Otherwise, an error code (perhaps+** SQLITE_IOERR_FSTAT) is returned and *pnPage is left unmodified.+*/+static int pagerPagecount(Pager *pPager, Pgno *pnPage){+ Pgno nPage; /* Value to return via *pnPage */++ /* Query the WAL sub-system for the database size. The WalDbsize()+ ** function returns zero if the WAL is not open (i.e. Pager.pWal==0), or+ ** if the database size is not available. The database size is not+ ** available from the WAL sub-system if the log file is empty or+ ** contains no valid committed transactions.+ */+ assert( pPager->eState==PAGER_OPEN );+ assert( pPager->eLock>=SHARED_LOCK );+ nPage = sqlite3WalDbsize(pPager->pWal);++ /* If the number of pages in the database is not available from the+ ** WAL sub-system, determine the page counte based on the size of+ ** the database file. If the size of the database file is not an+ ** integer multiple of the page-size, round up the result.+ */+ if( nPage==0 ){+ i64 n = 0; /* Size of db file in bytes */+ assert( isOpen(pPager->fd) || pPager->tempFile );+ if( isOpen(pPager->fd) ){+ int rc = sqlite3OsFileSize(pPager->fd, &n);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ }+ nPage = (Pgno)((n+pPager->pageSize-1) / pPager->pageSize);+ }++ /* If the current number of pages in the file is greater than the+ ** configured maximum pager number, increase the allowed limit so+ ** that the file can be read.+ */+ if( nPage>pPager->mxPgno ){+ pPager->mxPgno = (Pgno)nPage;+ }++ *pnPage = nPage;+ return SQLITE_OK;+}++#ifndef SQLITE_OMIT_WAL+/*+** Check if the *-wal file that corresponds to the database opened by pPager+** exists if the database is not empy, or verify that the *-wal file does+** not exist (by deleting it) if the database file is empty.+**+** If the database is not empty and the *-wal file exists, open the pager+** in WAL mode. If the database is empty or if no *-wal file exists and+** if no error occurs, make sure Pager.journalMode is not set to+** PAGER_JOURNALMODE_WAL.+**+** Return SQLITE_OK or an error code.+**+** The caller must hold a SHARED lock on the database file to call this+** function. Because an EXCLUSIVE lock on the db file is required to delete +** a WAL on a none-empty database, this ensures there is no race condition +** between the xAccess() below and an xDelete() being executed by some +** other connection.+*/+static int pagerOpenWalIfPresent(Pager *pPager){+ int rc = SQLITE_OK;+ assert( pPager->eState==PAGER_OPEN );+ assert( pPager->eLock>=SHARED_LOCK );++ if( !pPager->tempFile ){+ int isWal; /* True if WAL file exists */+ Pgno nPage; /* Size of the database file */++ rc = pagerPagecount(pPager, &nPage);+ if( rc ) return rc;+ if( nPage==0 ){+ rc = sqlite3OsDelete(pPager->pVfs, pPager->zWal, 0);+ if( rc==SQLITE_IOERR_DELETE_NOENT ) rc = SQLITE_OK;+ isWal = 0;+ }else{+ rc = sqlite3OsAccess(+ pPager->pVfs, pPager->zWal, SQLITE_ACCESS_EXISTS, &isWal+ );+ }+ if( rc==SQLITE_OK ){+ if( isWal ){+ testcase( sqlite3PcachePagecount(pPager->pPCache)==0 );+ rc = sqlite3PagerOpenWal(pPager, 0);+ }else if( pPager->journalMode==PAGER_JOURNALMODE_WAL ){+ pPager->journalMode = PAGER_JOURNALMODE_DELETE;+ }+ }+ }+ return rc;+}+#endif++/*+** Playback savepoint pSavepoint. Or, if pSavepoint==NULL, then playback+** the entire master journal file. The case pSavepoint==NULL occurs when +** a ROLLBACK TO command is invoked on a SAVEPOINT that is a transaction +** savepoint.+**+** When pSavepoint is not NULL (meaning a non-transaction savepoint is +** being rolled back), then the rollback consists of up to three stages,+** performed in the order specified:+**+** * Pages are played back from the main journal starting at byte+** offset PagerSavepoint.iOffset and continuing to +** PagerSavepoint.iHdrOffset, or to the end of the main journal+** file if PagerSavepoint.iHdrOffset is zero.+**+** * If PagerSavepoint.iHdrOffset is not zero, then pages are played+** back starting from the journal header immediately following +** PagerSavepoint.iHdrOffset to the end of the main journal file.+**+** * Pages are then played back from the sub-journal file, starting+** with the PagerSavepoint.iSubRec and continuing to the end of+** the journal file.+**+** Throughout the rollback process, each time a page is rolled back, the+** corresponding bit is set in a bitvec structure (variable pDone in the+** implementation below). This is used to ensure that a page is only+** rolled back the first time it is encountered in either journal.+**+** If pSavepoint is NULL, then pages are only played back from the main+** journal file. There is no need for a bitvec in this case.+**+** In either case, before playback commences the Pager.dbSize variable+** is reset to the value that it held at the start of the savepoint +** (or transaction). No page with a page-number greater than this value+** is played back. If one is encountered it is simply skipped.+*/+static int pagerPlaybackSavepoint(Pager *pPager, PagerSavepoint *pSavepoint){+ i64 szJ; /* Effective size of the main journal */+ i64 iHdrOff; /* End of first segment of main-journal records */+ int rc = SQLITE_OK; /* Return code */+ Bitvec *pDone = 0; /* Bitvec to ensure pages played back only once */++ assert( pPager->eState!=PAGER_ERROR );+ assert( pPager->eState>=PAGER_WRITER_LOCKED );++ /* Allocate a bitvec to use to store the set of pages rolled back */+ if( pSavepoint ){+ pDone = sqlite3BitvecCreate(pSavepoint->nOrig);+ if( !pDone ){+ return SQLITE_NOMEM;+ }+ }++ /* Set the database size back to the value it was before the savepoint + ** being reverted was opened.+ */+ pPager->dbSize = pSavepoint ? pSavepoint->nOrig : pPager->dbOrigSize;+ pPager->changeCountDone = pPager->tempFile;++ if( !pSavepoint && pagerUseWal(pPager) ){+ return pagerRollbackWal(pPager);+ }++ /* Use pPager->journalOff as the effective size of the main rollback+ ** journal. The actual file might be larger than this in+ ** PAGER_JOURNALMODE_TRUNCATE or PAGER_JOURNALMODE_PERSIST. But anything+ ** past pPager->journalOff is off-limits to us.+ */+ szJ = pPager->journalOff;+ assert( pagerUseWal(pPager)==0 || szJ==0 );++ /* Begin by rolling back records from the main journal starting at+ ** PagerSavepoint.iOffset and continuing to the next journal header.+ ** There might be records in the main journal that have a page number+ ** greater than the current database size (pPager->dbSize) but those+ ** will be skipped automatically. Pages are added to pDone as they+ ** are played back.+ */+ if( pSavepoint && !pagerUseWal(pPager) ){+ iHdrOff = pSavepoint->iHdrOffset ? pSavepoint->iHdrOffset : szJ;+ pPager->journalOff = pSavepoint->iOffset;+ while( rc==SQLITE_OK && pPager->journalOff<iHdrOff ){+ rc = pager_playback_one_page(pPager, &pPager->journalOff, pDone, 1, 1);+ }+ assert( rc!=SQLITE_DONE );+ }else{+ pPager->journalOff = 0;+ }++ /* Continue rolling back records out of the main journal starting at+ ** the first journal header seen and continuing until the effective end+ ** of the main journal file. Continue to skip out-of-range pages and+ ** continue adding pages rolled back to pDone.+ */+ while( rc==SQLITE_OK && pPager->journalOff<szJ ){+ u32 ii; /* Loop counter */+ u32 nJRec = 0; /* Number of Journal Records */+ u32 dummy;+ rc = readJournalHdr(pPager, 0, szJ, &nJRec, &dummy);+ assert( rc!=SQLITE_DONE );++ /*+ ** The "pPager->journalHdr+JOURNAL_HDR_SZ(pPager)==pPager->journalOff"+ ** test is related to ticket #2565. See the discussion in the+ ** pager_playback() function for additional information.+ */+ if( nJRec==0 + && pPager->journalHdr+JOURNAL_HDR_SZ(pPager)==pPager->journalOff+ ){+ nJRec = (u32)((szJ - pPager->journalOff)/JOURNAL_PG_SZ(pPager));+ }+ for(ii=0; rc==SQLITE_OK && ii<nJRec && pPager->journalOff<szJ; ii++){+ rc = pager_playback_one_page(pPager, &pPager->journalOff, pDone, 1, 1);+ }+ assert( rc!=SQLITE_DONE );+ }+ assert( rc!=SQLITE_OK || pPager->journalOff>=szJ );++ /* Finally, rollback pages from the sub-journal. Page that were+ ** previously rolled back out of the main journal (and are hence in pDone)+ ** will be skipped. Out-of-range pages are also skipped.+ */+ if( pSavepoint ){+ u32 ii; /* Loop counter */+ i64 offset = (i64)pSavepoint->iSubRec*(4+pPager->pageSize);++ if( pagerUseWal(pPager) ){+ rc = sqlite3WalSavepointUndo(pPager->pWal, pSavepoint->aWalData);+ }+ for(ii=pSavepoint->iSubRec; rc==SQLITE_OK && ii<pPager->nSubRec; ii++){+ assert( offset==(i64)ii*(4+pPager->pageSize) );+ rc = pager_playback_one_page(pPager, &offset, pDone, 0, 1);+ }+ assert( rc!=SQLITE_DONE );+ }++ sqlite3BitvecDestroy(pDone);+ if( rc==SQLITE_OK ){+ pPager->journalOff = szJ;+ }++ return rc;+}++/*+** Change the maximum number of in-memory pages that are allowed.+*/+SQLITE_PRIVATE void sqlite3PagerSetCachesize(Pager *pPager, int mxPage){+ sqlite3PcacheSetCachesize(pPager->pPCache, mxPage);+}++/*+** Invoke SQLITE_FCNTL_MMAP_SIZE based on the current value of szMmap.+*/+static void pagerFixMaplimit(Pager *pPager){+#if SQLITE_MAX_MMAP_SIZE>0+ sqlite3_file *fd = pPager->fd;+ if( isOpen(fd) && fd->pMethods->iVersion>=3 ){+ sqlite3_int64 sz;+ sz = pPager->szMmap;+ pPager->bUseFetch = (sz>0);+ sqlite3OsFileControlHint(pPager->fd, SQLITE_FCNTL_MMAP_SIZE, &sz);+ }+#endif+}++/*+** Change the maximum size of any memory mapping made of the database file.+*/+SQLITE_PRIVATE void sqlite3PagerSetMmapLimit(Pager *pPager, sqlite3_int64 szMmap){+ pPager->szMmap = szMmap;+ pagerFixMaplimit(pPager);+}++/*+** Adjust settings of the pager to those specified in the pgFlags parameter.+**+** The "level" in pgFlags & PAGER_SYNCHRONOUS_MASK sets the robustness+** of the database to damage due to OS crashes or power failures by+** changing the number of syncs()s when writing the journals.+** There are three levels:+**+** OFF sqlite3OsSync() is never called. This is the default+** for temporary and transient files.+**+** NORMAL The journal is synced once before writes begin on the+** database. This is normally adequate protection, but+** it is theoretically possible, though very unlikely,+** that an inopertune power failure could leave the journal+** in a state which would cause damage to the database+** when it is rolled back.+**+** FULL The journal is synced twice before writes begin on the+** database (with some additional information - the nRec field+** of the journal header - being written in between the two+** syncs). If we assume that writing a+** single disk sector is atomic, then this mode provides+** assurance that the journal will not be corrupted to the+** point of causing damage to the database during rollback.+**+** The above is for a rollback-journal mode. For WAL mode, OFF continues+** to mean that no syncs ever occur. NORMAL means that the WAL is synced+** prior to the start of checkpoint and that the database file is synced+** at the conclusion of the checkpoint if the entire content of the WAL+** was written back into the database. But no sync operations occur for+** an ordinary commit in NORMAL mode with WAL. FULL means that the WAL+** file is synced following each commit operation, in addition to the+** syncs associated with NORMAL.+**+** Do not confuse synchronous=FULL with SQLITE_SYNC_FULL. The+** SQLITE_SYNC_FULL macro means to use the MacOSX-style full-fsync+** using fcntl(F_FULLFSYNC). SQLITE_SYNC_NORMAL means to do an+** ordinary fsync() call. There is no difference between SQLITE_SYNC_FULL+** and SQLITE_SYNC_NORMAL on platforms other than MacOSX. But the+** synchronous=FULL versus synchronous=NORMAL setting determines when+** the xSync primitive is called and is relevant to all platforms.+**+** Numeric values associated with these states are OFF==1, NORMAL=2,+** and FULL=3.+*/+#ifndef SQLITE_OMIT_PAGER_PRAGMAS+SQLITE_PRIVATE void sqlite3PagerSetFlags(+ Pager *pPager, /* The pager to set safety level for */+ unsigned pgFlags /* Various flags */+){+ unsigned level = pgFlags & PAGER_SYNCHRONOUS_MASK;+ assert( level>=1 && level<=3 );+ pPager->noSync = (level==1 || pPager->tempFile) ?1:0;+ pPager->fullSync = (level==3 && !pPager->tempFile) ?1:0;+ if( pPager->noSync ){+ pPager->syncFlags = 0;+ pPager->ckptSyncFlags = 0;+ }else if( pgFlags & PAGER_FULLFSYNC ){+ pPager->syncFlags = SQLITE_SYNC_FULL;+ pPager->ckptSyncFlags = SQLITE_SYNC_FULL;+ }else if( pgFlags & PAGER_CKPT_FULLFSYNC ){+ pPager->syncFlags = SQLITE_SYNC_NORMAL;+ pPager->ckptSyncFlags = SQLITE_SYNC_FULL;+ }else{+ pPager->syncFlags = SQLITE_SYNC_NORMAL;+ pPager->ckptSyncFlags = SQLITE_SYNC_NORMAL;+ }+ pPager->walSyncFlags = pPager->syncFlags;+ if( pPager->fullSync ){+ pPager->walSyncFlags |= WAL_SYNC_TRANSACTIONS;+ }+ if( pgFlags & PAGER_CACHESPILL ){+ pPager->doNotSpill &= ~SPILLFLAG_OFF;+ }else{+ pPager->doNotSpill |= SPILLFLAG_OFF;+ }+}+#endif++/*+** The following global variable is incremented whenever the library+** attempts to open a temporary file. This information is used for+** testing and analysis only. +*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_opentemp_count = 0;+#endif++/*+** Open a temporary file.+**+** Write the file descriptor into *pFile. Return SQLITE_OK on success +** or some other error code if we fail. The OS will automatically +** delete the temporary file when it is closed.+**+** The flags passed to the VFS layer xOpen() call are those specified+** by parameter vfsFlags ORed with the following:+**+** SQLITE_OPEN_READWRITE+** SQLITE_OPEN_CREATE+** SQLITE_OPEN_EXCLUSIVE+** SQLITE_OPEN_DELETEONCLOSE+*/+static int pagerOpentemp(+ Pager *pPager, /* The pager object */+ sqlite3_file *pFile, /* Write the file descriptor here */+ int vfsFlags /* Flags passed through to the VFS */+){+ int rc; /* Return code */++#ifdef SQLITE_TEST+ sqlite3_opentemp_count++; /* Used for testing and analysis only */+#endif++ vfsFlags |= SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE |+ SQLITE_OPEN_EXCLUSIVE | SQLITE_OPEN_DELETEONCLOSE;+ rc = sqlite3OsOpen(pPager->pVfs, 0, pFile, vfsFlags, 0);+ assert( rc!=SQLITE_OK || isOpen(pFile) );+ return rc;+}++/*+** Set the busy handler function.+**+** The pager invokes the busy-handler if sqlite3OsLock() returns +** SQLITE_BUSY when trying to upgrade from no-lock to a SHARED lock,+** or when trying to upgrade from a RESERVED lock to an EXCLUSIVE +** lock. It does *not* invoke the busy handler when upgrading from+** SHARED to RESERVED, or when upgrading from SHARED to EXCLUSIVE+** (which occurs during hot-journal rollback). Summary:+**+** Transition | Invokes xBusyHandler+** --------------------------------------------------------+** NO_LOCK -> SHARED_LOCK | Yes+** SHARED_LOCK -> RESERVED_LOCK | No+** SHARED_LOCK -> EXCLUSIVE_LOCK | No+** RESERVED_LOCK -> EXCLUSIVE_LOCK | Yes+**+** If the busy-handler callback returns non-zero, the lock is +** retried. If it returns zero, then the SQLITE_BUSY error is+** returned to the caller of the pager API function.+*/+SQLITE_PRIVATE void sqlite3PagerSetBusyhandler(+ Pager *pPager, /* Pager object */+ int (*xBusyHandler)(void *), /* Pointer to busy-handler function */+ void *pBusyHandlerArg /* Argument to pass to xBusyHandler */+){+ pPager->xBusyHandler = xBusyHandler;+ pPager->pBusyHandlerArg = pBusyHandlerArg;++ if( isOpen(pPager->fd) ){+ void **ap = (void **)&pPager->xBusyHandler;+ assert( ((int(*)(void *))(ap[0]))==xBusyHandler );+ assert( ap[1]==pBusyHandlerArg );+ sqlite3OsFileControlHint(pPager->fd, SQLITE_FCNTL_BUSYHANDLER, (void *)ap);+ }+}++/*+** Change the page size used by the Pager object. The new page size +** is passed in *pPageSize.+**+** If the pager is in the error state when this function is called, it+** is a no-op. The value returned is the error state error code (i.e. +** one of SQLITE_IOERR, an SQLITE_IOERR_xxx sub-code or SQLITE_FULL).+**+** Otherwise, if all of the following are true:+**+** * the new page size (value of *pPageSize) is valid (a power +** of two between 512 and SQLITE_MAX_PAGE_SIZE, inclusive), and+**+** * there are no outstanding page references, and+**+** * the database is either not an in-memory database or it is+** an in-memory database that currently consists of zero pages.+**+** then the pager object page size is set to *pPageSize.+**+** If the page size is changed, then this function uses sqlite3PagerMalloc() +** to obtain a new Pager.pTmpSpace buffer. If this allocation attempt +** fails, SQLITE_NOMEM is returned and the page size remains unchanged. +** In all other cases, SQLITE_OK is returned.+**+** If the page size is not changed, either because one of the enumerated+** conditions above is not true, the pager was in error state when this+** function was called, or because the memory allocation attempt failed, +** then *pPageSize is set to the old, retained page size before returning.+*/+SQLITE_PRIVATE int sqlite3PagerSetPagesize(Pager *pPager, u32 *pPageSize, int nReserve){+ int rc = SQLITE_OK;++ /* It is not possible to do a full assert_pager_state() here, as this+ ** function may be called from within PagerOpen(), before the state+ ** of the Pager object is internally consistent.+ **+ ** At one point this function returned an error if the pager was in + ** PAGER_ERROR state. But since PAGER_ERROR state guarantees that+ ** there is at least one outstanding page reference, this function+ ** is a no-op for that case anyhow.+ */++ u32 pageSize = *pPageSize;+ assert( pageSize==0 || (pageSize>=512 && pageSize<=SQLITE_MAX_PAGE_SIZE) );+ if( (pPager->memDb==0 || pPager->dbSize==0)+ && sqlite3PcacheRefCount(pPager->pPCache)==0 + && pageSize && pageSize!=(u32)pPager->pageSize + ){+ char *pNew = NULL; /* New temp space */+ i64 nByte = 0;++ if( pPager->eState>PAGER_OPEN && isOpen(pPager->fd) ){+ rc = sqlite3OsFileSize(pPager->fd, &nByte);+ }+ if( rc==SQLITE_OK ){+ pNew = (char *)sqlite3PageMalloc(pageSize);+ if( !pNew ) rc = SQLITE_NOMEM;+ }++ if( rc==SQLITE_OK ){+ pager_reset(pPager);+ rc = sqlite3PcacheSetPageSize(pPager->pPCache, pageSize);+ }+ if( rc==SQLITE_OK ){+ sqlite3PageFree(pPager->pTmpSpace);+ pPager->pTmpSpace = pNew;+ pPager->dbSize = (Pgno)((nByte+pageSize-1)/pageSize);+ pPager->pageSize = pageSize;+ }else{+ sqlite3PageFree(pNew);+ }+ }++ *pPageSize = pPager->pageSize;+ if( rc==SQLITE_OK ){+ if( nReserve<0 ) nReserve = pPager->nReserve;+ assert( nReserve>=0 && nReserve<1000 );+ pPager->nReserve = (i16)nReserve;+ pagerReportSize(pPager);+ pagerFixMaplimit(pPager);+ }+ return rc;+}++/*+** Return a pointer to the "temporary page" buffer held internally+** by the pager. This is a buffer that is big enough to hold the+** entire content of a database page. This buffer is used internally+** during rollback and will be overwritten whenever a rollback+** occurs. But other modules are free to use it too, as long as+** no rollbacks are happening.+*/+SQLITE_PRIVATE void *sqlite3PagerTempSpace(Pager *pPager){+ return pPager->pTmpSpace;+}++/*+** Attempt to set the maximum database page count if mxPage is positive. +** Make no changes if mxPage is zero or negative. And never reduce the+** maximum page count below the current size of the database.+**+** Regardless of mxPage, return the current maximum page count.+*/+SQLITE_PRIVATE int sqlite3PagerMaxPageCount(Pager *pPager, int mxPage){+ if( mxPage>0 ){+ pPager->mxPgno = mxPage;+ }+ assert( pPager->eState!=PAGER_OPEN ); /* Called only by OP_MaxPgcnt */+ assert( pPager->mxPgno>=pPager->dbSize ); /* OP_MaxPgcnt enforces this */+ return pPager->mxPgno;+}++/*+** The following set of routines are used to disable the simulated+** I/O error mechanism. These routines are used to avoid simulated+** errors in places where we do not care about errors.+**+** Unless -DSQLITE_TEST=1 is used, these routines are all no-ops+** and generate no code.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE int sqlite3_io_error_pending;+SQLITE_PRIVATE int sqlite3_io_error_hit;+static int saved_cnt;+void disable_simulated_io_errors(void){+ saved_cnt = sqlite3_io_error_pending;+ sqlite3_io_error_pending = -1;+}+void enable_simulated_io_errors(void){+ sqlite3_io_error_pending = saved_cnt;+}+#else+# define disable_simulated_io_errors()+# define enable_simulated_io_errors()+#endif++/*+** Read the first N bytes from the beginning of the file into memory+** that pDest points to. +**+** If the pager was opened on a transient file (zFilename==""), or+** opened on a file less than N bytes in size, the output buffer is+** zeroed and SQLITE_OK returned. The rationale for this is that this +** function is used to read database headers, and a new transient or+** zero sized database has a header than consists entirely of zeroes.+**+** If any IO error apart from SQLITE_IOERR_SHORT_READ is encountered,+** the error code is returned to the caller and the contents of the+** output buffer undefined.+*/+SQLITE_PRIVATE int sqlite3PagerReadFileheader(Pager *pPager, int N, unsigned char *pDest){+ int rc = SQLITE_OK;+ memset(pDest, 0, N);+ assert( isOpen(pPager->fd) || pPager->tempFile );++ /* This routine is only called by btree immediately after creating+ ** the Pager object. There has not been an opportunity to transition+ ** to WAL mode yet.+ */+ assert( !pagerUseWal(pPager) );++ if( isOpen(pPager->fd) ){+ IOTRACE(("DBHDR %p 0 %d\n", pPager, N))+ rc = sqlite3OsRead(pPager->fd, pDest, N, 0);+ if( rc==SQLITE_IOERR_SHORT_READ ){+ rc = SQLITE_OK;+ }+ }+ return rc;+}++/*+** This function may only be called when a read-transaction is open on+** the pager. It returns the total number of pages in the database.+**+** However, if the file is between 1 and <page-size> bytes in size, then +** this is considered a 1 page file.+*/+SQLITE_PRIVATE void sqlite3PagerPagecount(Pager *pPager, int *pnPage){+ assert( pPager->eState>=PAGER_READER );+ assert( pPager->eState!=PAGER_WRITER_FINISHED );+ *pnPage = (int)pPager->dbSize;+}+++/*+** Try to obtain a lock of type locktype on the database file. If+** a similar or greater lock is already held, this function is a no-op+** (returning SQLITE_OK immediately).+**+** Otherwise, attempt to obtain the lock using sqlite3OsLock(). Invoke +** the busy callback if the lock is currently not available. Repeat +** until the busy callback returns false or until the attempt to +** obtain the lock succeeds.+**+** Return SQLITE_OK on success and an error code if we cannot obtain+** the lock. If the lock is obtained successfully, set the Pager.state +** variable to locktype before returning.+*/+static int pager_wait_on_lock(Pager *pPager, int locktype){+ int rc; /* Return code */++ /* Check that this is either a no-op (because the requested lock is + ** already held), or one of the transitions that the busy-handler+ ** may be invoked during, according to the comment above+ ** sqlite3PagerSetBusyhandler().+ */+ assert( (pPager->eLock>=locktype)+ || (pPager->eLock==NO_LOCK && locktype==SHARED_LOCK)+ || (pPager->eLock==RESERVED_LOCK && locktype==EXCLUSIVE_LOCK)+ );++ do {+ rc = pagerLockDb(pPager, locktype);+ }while( rc==SQLITE_BUSY && pPager->xBusyHandler(pPager->pBusyHandlerArg) );+ return rc;+}++/*+** Function assertTruncateConstraint(pPager) checks that one of the +** following is true for all dirty pages currently in the page-cache:+**+** a) The page number is less than or equal to the size of the +** current database image, in pages, OR+**+** b) if the page content were written at this time, it would not+** be necessary to write the current content out to the sub-journal+** (as determined by function subjRequiresPage()).+**+** If the condition asserted by this function were not true, and the+** dirty page were to be discarded from the cache via the pagerStress()+** routine, pagerStress() would not write the current page content to+** the database file. If a savepoint transaction were rolled back after+** this happened, the correct behavior would be to restore the current+** content of the page. However, since this content is not present in either+** the database file or the portion of the rollback journal and +** sub-journal rolled back the content could not be restored and the+** database image would become corrupt. It is therefore fortunate that +** this circumstance cannot arise.+*/+#if defined(SQLITE_DEBUG)+static void assertTruncateConstraintCb(PgHdr *pPg){+ assert( pPg->flags&PGHDR_DIRTY );+ assert( !subjRequiresPage(pPg) || pPg->pgno<=pPg->pPager->dbSize );+}+static void assertTruncateConstraint(Pager *pPager){+ sqlite3PcacheIterateDirty(pPager->pPCache, assertTruncateConstraintCb);+}+#else+# define assertTruncateConstraint(pPager)+#endif++/*+** Truncate the in-memory database file image to nPage pages. This +** function does not actually modify the database file on disk. It +** just sets the internal state of the pager object so that the +** truncation will be done when the current transaction is committed.+**+** This function is only called right before committing a transaction.+** Once this function has been called, the transaction must either be+** rolled back or committed. It is not safe to call this function and+** then continue writing to the database.+*/+SQLITE_PRIVATE void sqlite3PagerTruncateImage(Pager *pPager, Pgno nPage){+ assert( pPager->dbSize>=nPage );+ assert( pPager->eState>=PAGER_WRITER_CACHEMOD );+ pPager->dbSize = nPage;++ /* At one point the code here called assertTruncateConstraint() to+ ** ensure that all pages being truncated away by this operation are,+ ** if one or more savepoints are open, present in the savepoint + ** journal so that they can be restored if the savepoint is rolled+ ** back. This is no longer necessary as this function is now only+ ** called right before committing a transaction. So although the + ** Pager object may still have open savepoints (Pager.nSavepoint!=0), + ** they cannot be rolled back. So the assertTruncateConstraint() call+ ** is no longer correct. */+}+++/*+** This function is called before attempting a hot-journal rollback. It+** syncs the journal file to disk, then sets pPager->journalHdr to the+** size of the journal file so that the pager_playback() routine knows+** that the entire journal file has been synced.+**+** Syncing a hot-journal to disk before attempting to roll it back ensures +** that if a power-failure occurs during the rollback, the process that+** attempts rollback following system recovery sees the same journal+** content as this process.+**+** If everything goes as planned, SQLITE_OK is returned. Otherwise, +** an SQLite error code.+*/+static int pagerSyncHotJournal(Pager *pPager){+ int rc = SQLITE_OK;+ if( !pPager->noSync ){+ rc = sqlite3OsSync(pPager->jfd, SQLITE_SYNC_NORMAL);+ }+ if( rc==SQLITE_OK ){+ rc = sqlite3OsFileSize(pPager->jfd, &pPager->journalHdr);+ }+ return rc;+}++/*+** Obtain a reference to a memory mapped page object for page number pgno. +** The new object will use the pointer pData, obtained from xFetch().+** If successful, set *ppPage to point to the new page reference+** and return SQLITE_OK. Otherwise, return an SQLite error code and set+** *ppPage to zero.+**+** Page references obtained by calling this function should be released+** by calling pagerReleaseMapPage().+*/+static int pagerAcquireMapPage(+ Pager *pPager, /* Pager object */+ Pgno pgno, /* Page number */+ void *pData, /* xFetch()'d data for this page */+ PgHdr **ppPage /* OUT: Acquired page object */+){+ PgHdr *p; /* Memory mapped page to return */+ + if( pPager->pMmapFreelist ){+ *ppPage = p = pPager->pMmapFreelist;+ pPager->pMmapFreelist = p->pDirty;+ p->pDirty = 0;+ memset(p->pExtra, 0, pPager->nExtra);+ }else{+ *ppPage = p = (PgHdr *)sqlite3MallocZero(sizeof(PgHdr) + pPager->nExtra);+ if( p==0 ){+ sqlite3OsUnfetch(pPager->fd, (i64)(pgno-1) * pPager->pageSize, pData);+ return SQLITE_NOMEM;+ }+ p->pExtra = (void *)&p[1];+ p->flags = PGHDR_MMAP;+ p->nRef = 1;+ p->pPager = pPager;+ }++ assert( p->pExtra==(void *)&p[1] );+ assert( p->pPage==0 );+ assert( p->flags==PGHDR_MMAP );+ assert( p->pPager==pPager );+ assert( p->nRef==1 );++ p->pgno = pgno;+ p->pData = pData;+ pPager->nMmapOut++;++ return SQLITE_OK;+}++/*+** Release a reference to page pPg. pPg must have been returned by an +** earlier call to pagerAcquireMapPage().+*/+static void pagerReleaseMapPage(PgHdr *pPg){+ Pager *pPager = pPg->pPager;+ pPager->nMmapOut--;+ pPg->pDirty = pPager->pMmapFreelist;+ pPager->pMmapFreelist = pPg;++ assert( pPager->fd->pMethods->iVersion>=3 );+ sqlite3OsUnfetch(pPager->fd, (i64)(pPg->pgno-1)*pPager->pageSize, pPg->pData);+}++/*+** Free all PgHdr objects stored in the Pager.pMmapFreelist list.+*/+static void pagerFreeMapHdrs(Pager *pPager){+ PgHdr *p;+ PgHdr *pNext;+ for(p=pPager->pMmapFreelist; p; p=pNext){+ pNext = p->pDirty;+ sqlite3_free(p);+ }+}+++/*+** Shutdown the page cache. Free all memory and close all files.+**+** If a transaction was in progress when this routine is called, that+** transaction is rolled back. All outstanding pages are invalidated+** and their memory is freed. Any attempt to use a page associated+** with this page cache after this function returns will likely+** result in a coredump.+**+** This function always succeeds. If a transaction is active an attempt+** is made to roll it back. If an error occurs during the rollback +** a hot journal may be left in the filesystem but no error is returned+** to the caller.+*/+SQLITE_PRIVATE int sqlite3PagerClose(Pager *pPager){+ u8 *pTmp = (u8 *)pPager->pTmpSpace;++ assert( assert_pager_state(pPager) );+ disable_simulated_io_errors();+ pagerFreeMapHdrs(pPager);+ /* pPager->errCode = 0; */+ pPager->exclusiveMode = 0;+#ifndef SQLITE_OMIT_WAL+ sqlite3WalClose(pPager->pWal, pPager->ckptSyncFlags, pPager->pageSize, pTmp);+ pPager->pWal = 0;+#endif+ pager_reset(pPager);++ /* If it is open, sync the journal file before calling UnlockAndRollback.+ ** If this is not done, then an unsynced portion of the open journal + ** file may be played back into the database. If a power failure occurs + ** while this is happening, the database could become corrupt.+ **+ ** If an error occurs while trying to sync the journal, shift the pager+ ** into the ERROR state. This causes UnlockAndRollback to unlock the+ ** database and close the journal file without attempting to roll it+ ** back or finalize it. The next database user will have to do hot-journal+ ** rollback before accessing the database file.+ */+ if( isOpen(pPager->jfd) ){+ pager_error(pPager, pagerSyncHotJournal(pPager));+ }+ pagerUnlockAndRollback(pPager);++ enable_simulated_io_errors();+ PAGERTRACE(("CLOSE %d\n", PAGERID(pPager)));+ IOTRACE(("CLOSE %p\n", pPager))+ sqlite3OsClose(pPager->jfd);+ sqlite3OsClose(pPager->fd);+ sqlite3PageFree(pTmp);+ sqlite3PcacheClose(pPager->pPCache);++#ifdef SQLITE_HAS_CODEC+ if( pPager->xCodecFree ) pPager->xCodecFree(pPager->pCodec);+#endif++ assert( !pPager->aSavepoint && !pPager->pInJournal );+ assert( !isOpen(pPager->jfd) && !isOpen(pPager->sjfd) );++ sqlite3_free(pPager);+ return SQLITE_OK;+}++#if !defined(NDEBUG) || defined(SQLITE_TEST)+/*+** Return the page number for page pPg.+*/+SQLITE_PRIVATE Pgno sqlite3PagerPagenumber(DbPage *pPg){+ return pPg->pgno;+}+#endif++/*+** Increment the reference count for page pPg.+*/+SQLITE_PRIVATE void sqlite3PagerRef(DbPage *pPg){+ sqlite3PcacheRef(pPg);+}++/*+** Sync the journal. In other words, make sure all the pages that have+** been written to the journal have actually reached the surface of the+** disk and can be restored in the event of a hot-journal rollback.+**+** If the Pager.noSync flag is set, then this function is a no-op.+** Otherwise, the actions required depend on the journal-mode and the +** device characteristics of the file-system, as follows:+**+** * If the journal file is an in-memory journal file, no action need+** be taken.+**+** * Otherwise, if the device does not support the SAFE_APPEND property,+** then the nRec field of the most recently written journal header+** is updated to contain the number of journal records that have+** been written following it. If the pager is operating in full-sync+** mode, then the journal file is synced before this field is updated.+**+** * If the device does not support the SEQUENTIAL property, then +** journal file is synced.+**+** Or, in pseudo-code:+**+** if( NOT <in-memory journal> ){+** if( NOT SAFE_APPEND ){+** if( <full-sync mode> ) xSync(<journal file>);+** <update nRec field>+** } +** if( NOT SEQUENTIAL ) xSync(<journal file>);+** }+**+** If successful, this routine clears the PGHDR_NEED_SYNC flag of every +** page currently held in memory before returning SQLITE_OK. If an IO+** error is encountered, then the IO error code is returned to the caller.+*/+static int syncJournal(Pager *pPager, int newHdr){+ int rc; /* Return code */++ assert( pPager->eState==PAGER_WRITER_CACHEMOD+ || pPager->eState==PAGER_WRITER_DBMOD+ );+ assert( assert_pager_state(pPager) );+ assert( !pagerUseWal(pPager) );++ rc = sqlite3PagerExclusiveLock(pPager);+ if( rc!=SQLITE_OK ) return rc;++ if( !pPager->noSync ){+ assert( !pPager->tempFile );+ if( isOpen(pPager->jfd) && pPager->journalMode!=PAGER_JOURNALMODE_MEMORY ){+ const int iDc = sqlite3OsDeviceCharacteristics(pPager->fd);+ assert( isOpen(pPager->jfd) );++ if( 0==(iDc&SQLITE_IOCAP_SAFE_APPEND) ){+ /* This block deals with an obscure problem. If the last connection+ ** that wrote to this database was operating in persistent-journal+ ** mode, then the journal file may at this point actually be larger+ ** than Pager.journalOff bytes. If the next thing in the journal+ ** file happens to be a journal-header (written as part of the+ ** previous connection's transaction), and a crash or power-failure + ** occurs after nRec is updated but before this connection writes + ** anything else to the journal file (or commits/rolls back its + ** transaction), then SQLite may become confused when doing the + ** hot-journal rollback following recovery. It may roll back all+ ** of this connections data, then proceed to rolling back the old,+ ** out-of-date data that follows it. Database corruption.+ **+ ** To work around this, if the journal file does appear to contain+ ** a valid header following Pager.journalOff, then write a 0x00+ ** byte to the start of it to prevent it from being recognized.+ **+ ** Variable iNextHdrOffset is set to the offset at which this+ ** problematic header will occur, if it exists. aMagic is used + ** as a temporary buffer to inspect the first couple of bytes of+ ** the potential journal header.+ */+ i64 iNextHdrOffset;+ u8 aMagic[8];+ u8 zHeader[sizeof(aJournalMagic)+4];++ memcpy(zHeader, aJournalMagic, sizeof(aJournalMagic));+ put32bits(&zHeader[sizeof(aJournalMagic)], pPager->nRec);++ iNextHdrOffset = journalHdrOffset(pPager);+ rc = sqlite3OsRead(pPager->jfd, aMagic, 8, iNextHdrOffset);+ if( rc==SQLITE_OK && 0==memcmp(aMagic, aJournalMagic, 8) ){+ static const u8 zerobyte = 0;+ rc = sqlite3OsWrite(pPager->jfd, &zerobyte, 1, iNextHdrOffset);+ }+ if( rc!=SQLITE_OK && rc!=SQLITE_IOERR_SHORT_READ ){+ return rc;+ }++ /* Write the nRec value into the journal file header. If in+ ** full-synchronous mode, sync the journal first. This ensures that+ ** all data has really hit the disk before nRec is updated to mark+ ** it as a candidate for rollback.+ **+ ** This is not required if the persistent media supports the+ ** SAFE_APPEND property. Because in this case it is not possible + ** for garbage data to be appended to the file, the nRec field+ ** is populated with 0xFFFFFFFF when the journal header is written+ ** and never needs to be updated.+ */+ if( pPager->fullSync && 0==(iDc&SQLITE_IOCAP_SEQUENTIAL) ){+ PAGERTRACE(("SYNC journal of %d\n", PAGERID(pPager)));+ IOTRACE(("JSYNC %p\n", pPager))+ rc = sqlite3OsSync(pPager->jfd, pPager->syncFlags);+ if( rc!=SQLITE_OK ) return rc;+ }+ IOTRACE(("JHDR %p %lld\n", pPager, pPager->journalHdr));+ rc = sqlite3OsWrite(+ pPager->jfd, zHeader, sizeof(zHeader), pPager->journalHdr+ );+ if( rc!=SQLITE_OK ) return rc;+ }+ if( 0==(iDc&SQLITE_IOCAP_SEQUENTIAL) ){+ PAGERTRACE(("SYNC journal of %d\n", PAGERID(pPager)));+ IOTRACE(("JSYNC %p\n", pPager))+ rc = sqlite3OsSync(pPager->jfd, pPager->syncFlags| + (pPager->syncFlags==SQLITE_SYNC_FULL?SQLITE_SYNC_DATAONLY:0)+ );+ if( rc!=SQLITE_OK ) return rc;+ }++ pPager->journalHdr = pPager->journalOff;+ if( newHdr && 0==(iDc&SQLITE_IOCAP_SAFE_APPEND) ){+ pPager->nRec = 0;+ rc = writeJournalHdr(pPager);+ if( rc!=SQLITE_OK ) return rc;+ }+ }else{+ pPager->journalHdr = pPager->journalOff;+ }+ }++ /* Unless the pager is in noSync mode, the journal file was just + ** successfully synced. Either way, clear the PGHDR_NEED_SYNC flag on + ** all pages.+ */+ sqlite3PcacheClearSyncFlags(pPager->pPCache);+ pPager->eState = PAGER_WRITER_DBMOD;+ assert( assert_pager_state(pPager) );+ return SQLITE_OK;+}++/*+** The argument is the first in a linked list of dirty pages connected+** by the PgHdr.pDirty pointer. This function writes each one of the+** in-memory pages in the list to the database file. The argument may+** be NULL, representing an empty list. In this case this function is+** a no-op.+**+** The pager must hold at least a RESERVED lock when this function+** is called. Before writing anything to the database file, this lock+** is upgraded to an EXCLUSIVE lock. If the lock cannot be obtained,+** SQLITE_BUSY is returned and no data is written to the database file.+** +** If the pager is a temp-file pager and the actual file-system file+** is not yet open, it is created and opened before any data is +** written out.+**+** Once the lock has been upgraded and, if necessary, the file opened,+** the pages are written out to the database file in list order. Writing+** a page is skipped if it meets either of the following criteria:+**+** * The page number is greater than Pager.dbSize, or+** * The PGHDR_DONT_WRITE flag is set on the page.+**+** If writing out a page causes the database file to grow, Pager.dbFileSize+** is updated accordingly. If page 1 is written out, then the value cached+** in Pager.dbFileVers[] is updated to match the new value stored in+** the database file.+**+** If everything is successful, SQLITE_OK is returned. If an IO error +** occurs, an IO error code is returned. Or, if the EXCLUSIVE lock cannot+** be obtained, SQLITE_BUSY is returned.+*/+static int pager_write_pagelist(Pager *pPager, PgHdr *pList){+ int rc = SQLITE_OK; /* Return code */++ /* This function is only called for rollback pagers in WRITER_DBMOD state. */+ assert( !pagerUseWal(pPager) );+ assert( pPager->eState==PAGER_WRITER_DBMOD );+ assert( pPager->eLock==EXCLUSIVE_LOCK );++ /* If the file is a temp-file has not yet been opened, open it now. It+ ** is not possible for rc to be other than SQLITE_OK if this branch+ ** is taken, as pager_wait_on_lock() is a no-op for temp-files.+ */+ if( !isOpen(pPager->fd) ){+ assert( pPager->tempFile && rc==SQLITE_OK );+ rc = pagerOpentemp(pPager, pPager->fd, pPager->vfsFlags);+ }++ /* Before the first write, give the VFS a hint of what the final+ ** file size will be.+ */+ assert( rc!=SQLITE_OK || isOpen(pPager->fd) );+ if( rc==SQLITE_OK + && pPager->dbHintSize<pPager->dbSize+ && (pList->pDirty || pList->pgno>pPager->dbHintSize)+ ){+ sqlite3_int64 szFile = pPager->pageSize * (sqlite3_int64)pPager->dbSize;+ sqlite3OsFileControlHint(pPager->fd, SQLITE_FCNTL_SIZE_HINT, &szFile);+ pPager->dbHintSize = pPager->dbSize;+ }++ while( rc==SQLITE_OK && pList ){+ Pgno pgno = pList->pgno;++ /* If there are dirty pages in the page cache with page numbers greater+ ** than Pager.dbSize, this means sqlite3PagerTruncateImage() was called to+ ** make the file smaller (presumably by auto-vacuum code). Do not write+ ** any such pages to the file.+ **+ ** Also, do not write out any page that has the PGHDR_DONT_WRITE flag+ ** set (set by sqlite3PagerDontWrite()).+ */+ if( pgno<=pPager->dbSize && 0==(pList->flags&PGHDR_DONT_WRITE) ){+ i64 offset = (pgno-1)*(i64)pPager->pageSize; /* Offset to write */+ char *pData; /* Data to write */ ++ assert( (pList->flags&PGHDR_NEED_SYNC)==0 );+ if( pList->pgno==1 ) pager_write_changecounter(pList);++ /* Encode the database */+ CODEC2(pPager, pList->pData, pgno, 6, return SQLITE_NOMEM, pData);++ /* Write out the page data. */+ rc = sqlite3OsWrite(pPager->fd, pData, pPager->pageSize, offset);++ /* If page 1 was just written, update Pager.dbFileVers to match+ ** the value now stored in the database file. If writing this + ** page caused the database file to grow, update dbFileSize. + */+ if( pgno==1 ){+ memcpy(&pPager->dbFileVers, &pData[24], sizeof(pPager->dbFileVers));+ }+ if( pgno>pPager->dbFileSize ){+ pPager->dbFileSize = pgno;+ }+ pPager->aStat[PAGER_STAT_WRITE]++;++ /* Update any backup objects copying the contents of this pager. */+ sqlite3BackupUpdate(pPager->pBackup, pgno, (u8*)pList->pData);++ PAGERTRACE(("STORE %d page %d hash(%08x)\n",+ PAGERID(pPager), pgno, pager_pagehash(pList)));+ IOTRACE(("PGOUT %p %d\n", pPager, pgno));+ PAGER_INCR(sqlite3_pager_writedb_count);+ }else{+ PAGERTRACE(("NOSTORE %d page %d\n", PAGERID(pPager), pgno));+ }+ pager_set_pagehash(pList);+ pList = pList->pDirty;+ }++ return rc;+}++/*+** Ensure that the sub-journal file is open. If it is already open, this +** function is a no-op.+**+** SQLITE_OK is returned if everything goes according to plan. An +** SQLITE_IOERR_XXX error code is returned if a call to sqlite3OsOpen() +** fails.+*/+static int openSubJournal(Pager *pPager){+ int rc = SQLITE_OK;+ if( !isOpen(pPager->sjfd) ){+ if( pPager->journalMode==PAGER_JOURNALMODE_MEMORY || pPager->subjInMemory ){+ sqlite3MemJournalOpen(pPager->sjfd);+ }else{+ rc = pagerOpentemp(pPager, pPager->sjfd, SQLITE_OPEN_SUBJOURNAL);+ }+ }+ return rc;+}++/*+** Append a record of the current state of page pPg to the sub-journal. +**+** If successful, set the bit corresponding to pPg->pgno in the bitvecs+** for all open savepoints before returning.+**+** This function returns SQLITE_OK if everything is successful, an IO+** error code if the attempt to write to the sub-journal fails, or +** SQLITE_NOMEM if a malloc fails while setting a bit in a savepoint+** bitvec.+*/+static int subjournalPage(PgHdr *pPg){+ int rc = SQLITE_OK;+ Pager *pPager = pPg->pPager;+ if( pPager->journalMode!=PAGER_JOURNALMODE_OFF ){++ /* Open the sub-journal, if it has not already been opened */+ assert( pPager->useJournal );+ assert( isOpen(pPager->jfd) || pagerUseWal(pPager) );+ assert( isOpen(pPager->sjfd) || pPager->nSubRec==0 );+ assert( pagerUseWal(pPager) + || pageInJournal(pPager, pPg) + || pPg->pgno>pPager->dbOrigSize + );+ rc = openSubJournal(pPager);++ /* If the sub-journal was opened successfully (or was already open),+ ** write the journal record into the file. */+ if( rc==SQLITE_OK ){+ void *pData = pPg->pData;+ i64 offset = (i64)pPager->nSubRec*(4+pPager->pageSize);+ char *pData2;+ + CODEC2(pPager, pData, pPg->pgno, 7, return SQLITE_NOMEM, pData2);+ PAGERTRACE(("STMT-JOURNAL %d page %d\n", PAGERID(pPager), pPg->pgno));+ rc = write32bits(pPager->sjfd, offset, pPg->pgno);+ if( rc==SQLITE_OK ){+ rc = sqlite3OsWrite(pPager->sjfd, pData2, pPager->pageSize, offset+4);+ }+ }+ }+ if( rc==SQLITE_OK ){+ pPager->nSubRec++;+ assert( pPager->nSavepoint>0 );+ rc = addToSavepointBitvecs(pPager, pPg->pgno);+ }+ return rc;+}+static int subjournalPageIfRequired(PgHdr *pPg){+ if( subjRequiresPage(pPg) ){+ return subjournalPage(pPg);+ }else{+ return SQLITE_OK;+ }+}++/*+** This function is called by the pcache layer when it has reached some+** soft memory limit. The first argument is a pointer to a Pager object+** (cast as a void*). The pager is always 'purgeable' (not an in-memory+** database). The second argument is a reference to a page that is +** currently dirty but has no outstanding references. The page+** is always associated with the Pager object passed as the first +** argument.+**+** The job of this function is to make pPg clean by writing its contents+** out to the database file, if possible. This may involve syncing the+** journal file. +**+** If successful, sqlite3PcacheMakeClean() is called on the page and+** SQLITE_OK returned. If an IO error occurs while trying to make the+** page clean, the IO error code is returned. If the page cannot be+** made clean for some other reason, but no error occurs, then SQLITE_OK+** is returned by sqlite3PcacheMakeClean() is not called.+*/+static int pagerStress(void *p, PgHdr *pPg){+ Pager *pPager = (Pager *)p;+ int rc = SQLITE_OK;++ assert( pPg->pPager==pPager );+ assert( pPg->flags&PGHDR_DIRTY );++ /* The doNotSpill NOSYNC bit is set during times when doing a sync of+ ** journal (and adding a new header) is not allowed. This occurs+ ** during calls to sqlite3PagerWrite() while trying to journal multiple+ ** pages belonging to the same sector.+ **+ ** The doNotSpill ROLLBACK and OFF bits inhibits all cache spilling+ ** regardless of whether or not a sync is required. This is set during+ ** a rollback or by user request, respectively.+ **+ ** Spilling is also prohibited when in an error state since that could+ ** lead to database corruption. In the current implementation it + ** is impossible for sqlite3PcacheFetch() to be called with createFlag==3+ ** while in the error state, hence it is impossible for this routine to+ ** be called in the error state. Nevertheless, we include a NEVER()+ ** test for the error state as a safeguard against future changes.+ */+ if( NEVER(pPager->errCode) ) return SQLITE_OK;+ testcase( pPager->doNotSpill & SPILLFLAG_ROLLBACK );+ testcase( pPager->doNotSpill & SPILLFLAG_OFF );+ testcase( pPager->doNotSpill & SPILLFLAG_NOSYNC );+ if( pPager->doNotSpill+ && ((pPager->doNotSpill & (SPILLFLAG_ROLLBACK|SPILLFLAG_OFF))!=0+ || (pPg->flags & PGHDR_NEED_SYNC)!=0)+ ){+ return SQLITE_OK;+ }++ pPg->pDirty = 0;+ if( pagerUseWal(pPager) ){+ /* Write a single frame for this page to the log. */+ rc = subjournalPageIfRequired(pPg); + if( rc==SQLITE_OK ){+ rc = pagerWalFrames(pPager, pPg, 0, 0);+ }+ }else{+ + /* Sync the journal file if required. */+ if( pPg->flags&PGHDR_NEED_SYNC + || pPager->eState==PAGER_WRITER_CACHEMOD+ ){+ rc = syncJournal(pPager, 1);+ }+ + /* Write the contents of the page out to the database file. */+ if( rc==SQLITE_OK ){+ assert( (pPg->flags&PGHDR_NEED_SYNC)==0 );+ rc = pager_write_pagelist(pPager, pPg);+ }+ }++ /* Mark the page as clean. */+ if( rc==SQLITE_OK ){+ PAGERTRACE(("STRESS %d page %d\n", PAGERID(pPager), pPg->pgno));+ sqlite3PcacheMakeClean(pPg);+ }++ return pager_error(pPager, rc); +}+++/*+** Allocate and initialize a new Pager object and put a pointer to it+** in *ppPager. The pager should eventually be freed by passing it+** to sqlite3PagerClose().+**+** The zFilename argument is the path to the database file to open.+** If zFilename is NULL then a randomly-named temporary file is created+** and used as the file to be cached. Temporary files are be deleted+** automatically when they are closed. If zFilename is ":memory:" then +** all information is held in cache. It is never written to disk. +** This can be used to implement an in-memory database.+**+** The nExtra parameter specifies the number of bytes of space allocated+** along with each page reference. This space is available to the user+** via the sqlite3PagerGetExtra() API.+**+** The flags argument is used to specify properties that affect the+** operation of the pager. It should be passed some bitwise combination+** of the PAGER_* flags.+**+** The vfsFlags parameter is a bitmask to pass to the flags parameter+** of the xOpen() method of the supplied VFS when opening files. +**+** If the pager object is allocated and the specified file opened +** successfully, SQLITE_OK is returned and *ppPager set to point to+** the new pager object. If an error occurs, *ppPager is set to NULL+** and error code returned. This function may return SQLITE_NOMEM+** (sqlite3Malloc() is used to allocate memory), SQLITE_CANTOPEN or +** various SQLITE_IO_XXX errors.+*/+SQLITE_PRIVATE int sqlite3PagerOpen(+ sqlite3_vfs *pVfs, /* The virtual file system to use */+ Pager **ppPager, /* OUT: Return the Pager structure here */+ const char *zFilename, /* Name of the database file to open */+ int nExtra, /* Extra bytes append to each in-memory page */+ int flags, /* flags controlling this file */+ int vfsFlags, /* flags passed through to sqlite3_vfs.xOpen() */+ void (*xReinit)(DbPage*) /* Function to reinitialize pages */+){+ u8 *pPtr;+ Pager *pPager = 0; /* Pager object to allocate and return */+ int rc = SQLITE_OK; /* Return code */+ int tempFile = 0; /* True for temp files (incl. in-memory files) */+ int memDb = 0; /* True if this is an in-memory file */+ int readOnly = 0; /* True if this is a read-only file */+ int journalFileSize; /* Bytes to allocate for each journal fd */+ char *zPathname = 0; /* Full path to database file */+ int nPathname = 0; /* Number of bytes in zPathname */+ int useJournal = (flags & PAGER_OMIT_JOURNAL)==0; /* False to omit journal */+ int pcacheSize = sqlite3PcacheSize(); /* Bytes to allocate for PCache */+ u32 szPageDflt = SQLITE_DEFAULT_PAGE_SIZE; /* Default page size */+ const char *zUri = 0; /* URI args to copy */+ int nUri = 0; /* Number of bytes of URI args at *zUri */++ /* Figure out how much space is required for each journal file-handle+ ** (there are two of them, the main journal and the sub-journal). This+ ** is the maximum space required for an in-memory journal file handle + ** and a regular journal file-handle. Note that a "regular journal-handle"+ ** may be a wrapper capable of caching the first portion of the journal+ ** file in memory to implement the atomic-write optimization (see + ** source file journal.c).+ */+ if( sqlite3JournalSize(pVfs)>sqlite3MemJournalSize() ){+ journalFileSize = ROUND8(sqlite3JournalSize(pVfs));+ }else{+ journalFileSize = ROUND8(sqlite3MemJournalSize());+ }++ /* Set the output variable to NULL in case an error occurs. */+ *ppPager = 0;++ /* Compute and store the full pathname in an allocated buffer pointed+ ** to by zPathname, length nPathname. Or, if this is a temporary file,+ ** leave both nPathname and zPathname set to 0.+ */+ if( zFilename && zFilename[0] ){+ const char *z;+ nPathname = pVfs->mxPathname+1;+ zPathname = sqlite3DbMallocRaw(0, nPathname*2);+ if( zPathname==0 ){+ return SQLITE_NOMEM;+ }+ zPathname[0] = 0; /* Make sure initialized even if FullPathname() fails */+ rc = sqlite3OsFullPathname(pVfs, zFilename, nPathname, zPathname);+ nPathname = sqlite3Strlen30(zPathname);+ z = zUri = &zFilename[sqlite3Strlen30(zFilename)+1];+ while( *z ){+ z += sqlite3Strlen30(z)+1;+ z += sqlite3Strlen30(z)+1;+ }+ nUri = (int)(&z[1] - zUri);+ assert( nUri>=0 );+ if( rc==SQLITE_OK && nPathname+8>pVfs->mxPathname ){+ /* This branch is taken when the journal path required by+ ** the database being opened will be more than pVfs->mxPathname+ ** bytes in length. This means the database cannot be opened,+ ** as it will not be possible to open the journal file or even+ ** check for a hot-journal before reading.+ */+ rc = SQLITE_CANTOPEN_BKPT;+ }+ if( rc!=SQLITE_OK ){+ sqlite3DbFree(0, zPathname);+ return rc;+ }+ }++ /* Allocate memory for the Pager structure, PCache object, the+ ** three file descriptors, the database file name and the journal + ** file name. The layout in memory is as follows:+ **+ ** Pager object (sizeof(Pager) bytes)+ ** PCache object (sqlite3PcacheSize() bytes)+ ** Database file handle (pVfs->szOsFile bytes)+ ** Sub-journal file handle (journalFileSize bytes)+ ** Main journal file handle (journalFileSize bytes)+ ** Database file name (nPathname+1 bytes)+ ** Journal file name (nPathname+8+1 bytes)+ */+ pPtr = (u8 *)sqlite3MallocZero(+ ROUND8(sizeof(*pPager)) + /* Pager structure */+ ROUND8(pcacheSize) + /* PCache object */+ ROUND8(pVfs->szOsFile) + /* The main db file */+ journalFileSize * 2 + /* The two journal files */ + nPathname + 1 + nUri + /* zFilename */+ nPathname + 8 + 2 /* zJournal */+#ifndef SQLITE_OMIT_WAL+ + nPathname + 4 + 2 /* zWal */+#endif+ );+ assert( EIGHT_BYTE_ALIGNMENT(SQLITE_INT_TO_PTR(journalFileSize)) );+ if( !pPtr ){+ sqlite3DbFree(0, zPathname);+ return SQLITE_NOMEM;+ }+ pPager = (Pager*)(pPtr);+ pPager->pPCache = (PCache*)(pPtr += ROUND8(sizeof(*pPager)));+ pPager->fd = (sqlite3_file*)(pPtr += ROUND8(pcacheSize));+ pPager->sjfd = (sqlite3_file*)(pPtr += ROUND8(pVfs->szOsFile));+ pPager->jfd = (sqlite3_file*)(pPtr += journalFileSize);+ pPager->zFilename = (char*)(pPtr += journalFileSize);+ assert( EIGHT_BYTE_ALIGNMENT(pPager->jfd) );++ /* Fill in the Pager.zFilename and Pager.zJournal buffers, if required. */+ if( zPathname ){+ assert( nPathname>0 );+ pPager->zJournal = (char*)(pPtr += nPathname + 1 + nUri);+ memcpy(pPager->zFilename, zPathname, nPathname);+ if( nUri ) memcpy(&pPager->zFilename[nPathname+1], zUri, nUri);+ memcpy(pPager->zJournal, zPathname, nPathname);+ memcpy(&pPager->zJournal[nPathname], "-journal\000", 8+2);+#ifndef SQLITE_OMIT_WAL+ pPager->zWal = &pPager->zJournal[nPathname+8+1];+ memcpy(pPager->zWal, zPathname, nPathname);+ memcpy(&pPager->zWal[nPathname], "-wal\000", 4+1);+#endif+ sqlite3DbFree(0, zPathname);+ }+ pPager->pVfs = pVfs;+ pPager->vfsFlags = vfsFlags;++ /* Open the pager file.+ */+ if( zFilename && zFilename[0] ){+ int fout = 0; /* VFS flags returned by xOpen() */+ rc = sqlite3OsOpen(pVfs, pPager->zFilename, pPager->fd, vfsFlags, &fout);+ assert( !memDb );+ readOnly = (fout&SQLITE_OPEN_READONLY);++ /* If the file was successfully opened for read/write access,+ ** choose a default page size in case we have to create the+ ** database file. The default page size is the maximum of:+ **+ ** + SQLITE_DEFAULT_PAGE_SIZE,+ ** + The value returned by sqlite3OsSectorSize()+ ** + The largest page size that can be written atomically.+ */+ if( rc==SQLITE_OK ){+ int iDc = sqlite3OsDeviceCharacteristics(pPager->fd);+ if( !readOnly ){+ setSectorSize(pPager);+ assert(SQLITE_DEFAULT_PAGE_SIZE<=SQLITE_MAX_DEFAULT_PAGE_SIZE);+ if( szPageDflt<pPager->sectorSize ){+ if( pPager->sectorSize>SQLITE_MAX_DEFAULT_PAGE_SIZE ){+ szPageDflt = SQLITE_MAX_DEFAULT_PAGE_SIZE;+ }else{+ szPageDflt = (u32)pPager->sectorSize;+ }+ }+#ifdef SQLITE_ENABLE_ATOMIC_WRITE+ {+ int ii;+ assert(SQLITE_IOCAP_ATOMIC512==(512>>8));+ assert(SQLITE_IOCAP_ATOMIC64K==(65536>>8));+ assert(SQLITE_MAX_DEFAULT_PAGE_SIZE<=65536);+ for(ii=szPageDflt; ii<=SQLITE_MAX_DEFAULT_PAGE_SIZE; ii=ii*2){+ if( iDc&(SQLITE_IOCAP_ATOMIC|(ii>>8)) ){+ szPageDflt = ii;+ }+ }+ }+#endif+ }+ pPager->noLock = 0;+ if( (iDc & SQLITE_IOCAP_IMMUTABLE)!=0 ){+ vfsFlags |= SQLITE_OPEN_READONLY;+ goto act_like_temp_file;+ }+ }+ }else{+ /* If a temporary file is requested, it is not opened immediately.+ ** In this case we accept the default page size and delay actually+ ** opening the file until the first call to OsWrite().+ **+ ** This branch is also run for an in-memory database. An in-memory+ ** database is the same as a temp-file that is never written out to+ ** disk and uses an in-memory rollback journal.+ **+ ** This branch also runs for files marked as immutable.+ */ +act_like_temp_file:+ tempFile = 1;+ pPager->eState = PAGER_READER; /* Pretend we already have a lock */+ pPager->eLock = EXCLUSIVE_LOCK; /* Pretend we are in EXCLUSIVE mode */+ pPager->noLock = 1; /* Do no locking */+ readOnly = (vfsFlags&SQLITE_OPEN_READONLY);+ }++ /* The following call to PagerSetPagesize() serves to set the value of + ** Pager.pageSize and to allocate the Pager.pTmpSpace buffer.+ */+ if( rc==SQLITE_OK ){+ assert( pPager->memDb==0 );+ rc = sqlite3PagerSetPagesize(pPager, &szPageDflt, -1);+ testcase( rc!=SQLITE_OK );+ }++ /* Initialize the PCache object. */+ if( rc==SQLITE_OK ){+ assert( nExtra<1000 );+ nExtra = ROUND8(nExtra);+ rc = sqlite3PcacheOpen(szPageDflt, nExtra, !memDb,+ !memDb?pagerStress:0, (void *)pPager, pPager->pPCache);+ }++ /* If an error occurred above, free the Pager structure and close the file.+ */+ if( rc!=SQLITE_OK ){+ sqlite3OsClose(pPager->fd);+ sqlite3PageFree(pPager->pTmpSpace);+ sqlite3_free(pPager);+ return rc;+ }++ PAGERTRACE(("OPEN %d %s\n", FILEHANDLEID(pPager->fd), pPager->zFilename));+ IOTRACE(("OPEN %p %s\n", pPager, pPager->zFilename))++ pPager->useJournal = (u8)useJournal;+ /* pPager->stmtOpen = 0; */+ /* pPager->stmtInUse = 0; */+ /* pPager->nRef = 0; */+ /* pPager->stmtSize = 0; */+ /* pPager->stmtJSize = 0; */+ /* pPager->nPage = 0; */+ pPager->mxPgno = SQLITE_MAX_PAGE_COUNT;+ /* pPager->state = PAGER_UNLOCK; */+ /* pPager->errMask = 0; */+ pPager->tempFile = (u8)tempFile;+ assert( tempFile==PAGER_LOCKINGMODE_NORMAL + || tempFile==PAGER_LOCKINGMODE_EXCLUSIVE );+ assert( PAGER_LOCKINGMODE_EXCLUSIVE==1 );+ pPager->exclusiveMode = (u8)tempFile; + pPager->changeCountDone = pPager->tempFile;+ pPager->memDb = (u8)memDb;+ pPager->readOnly = (u8)readOnly;+ assert( useJournal || pPager->tempFile );+ pPager->noSync = pPager->tempFile;+ if( pPager->noSync ){+ assert( pPager->fullSync==0 );+ assert( pPager->syncFlags==0 );+ assert( pPager->walSyncFlags==0 );+ assert( pPager->ckptSyncFlags==0 );+ }else{+ pPager->fullSync = 1;+ pPager->syncFlags = SQLITE_SYNC_NORMAL;+ pPager->walSyncFlags = SQLITE_SYNC_NORMAL | WAL_SYNC_TRANSACTIONS;+ pPager->ckptSyncFlags = SQLITE_SYNC_NORMAL;+ }+ /* pPager->pFirst = 0; */+ /* pPager->pFirstSynced = 0; */+ /* pPager->pLast = 0; */+ pPager->nExtra = (u16)nExtra;+ pPager->journalSizeLimit = SQLITE_DEFAULT_JOURNAL_SIZE_LIMIT;+ assert( isOpen(pPager->fd) || tempFile );+ setSectorSize(pPager);+ if( !useJournal ){+ pPager->journalMode = PAGER_JOURNALMODE_OFF;+ }else if( memDb ){+ pPager->journalMode = PAGER_JOURNALMODE_MEMORY;+ }+ /* pPager->xBusyHandler = 0; */+ /* pPager->pBusyHandlerArg = 0; */+ pPager->xReiniter = xReinit;+ /* memset(pPager->aHash, 0, sizeof(pPager->aHash)); */+ /* pPager->szMmap = SQLITE_DEFAULT_MMAP_SIZE // will be set by btree.c */++ *ppPager = pPager;+ return SQLITE_OK;+}+++/* Verify that the database file has not be deleted or renamed out from+** under the pager. Return SQLITE_OK if the database is still were it ought+** to be on disk. Return non-zero (SQLITE_READONLY_DBMOVED or some other error+** code from sqlite3OsAccess()) if the database has gone missing.+*/+static int databaseIsUnmoved(Pager *pPager){+ int bHasMoved = 0;+ int rc;++ if( pPager->tempFile ) return SQLITE_OK;+ if( pPager->dbSize==0 ) return SQLITE_OK;+ assert( pPager->zFilename && pPager->zFilename[0] );+ rc = sqlite3OsFileControl(pPager->fd, SQLITE_FCNTL_HAS_MOVED, &bHasMoved);+ if( rc==SQLITE_NOTFOUND ){+ /* If the HAS_MOVED file-control is unimplemented, assume that the file+ ** has not been moved. That is the historical behavior of SQLite: prior to+ ** version 3.8.3, it never checked */+ rc = SQLITE_OK;+ }else if( rc==SQLITE_OK && bHasMoved ){+ rc = SQLITE_READONLY_DBMOVED;+ }+ return rc;+}+++/*+** This function is called after transitioning from PAGER_UNLOCK to+** PAGER_SHARED state. It tests if there is a hot journal present in+** the file-system for the given pager. A hot journal is one that +** needs to be played back. According to this function, a hot-journal+** file exists if the following criteria are met:+**+** * The journal file exists in the file system, and+** * No process holds a RESERVED or greater lock on the database file, and+** * The database file itself is greater than 0 bytes in size, and+** * The first byte of the journal file exists and is not 0x00.+**+** If the current size of the database file is 0 but a journal file+** exists, that is probably an old journal left over from a prior+** database with the same name. In this case the journal file is+** just deleted using OsDelete, *pExists is set to 0 and SQLITE_OK+** is returned.+**+** This routine does not check if there is a master journal filename+** at the end of the file. If there is, and that master journal file+** does not exist, then the journal file is not really hot. In this+** case this routine will return a false-positive. The pager_playback()+** routine will discover that the journal file is not really hot and +** will not roll it back. +**+** If a hot-journal file is found to exist, *pExists is set to 1 and +** SQLITE_OK returned. If no hot-journal file is present, *pExists is+** set to 0 and SQLITE_OK returned. If an IO error occurs while trying+** to determine whether or not a hot-journal file exists, the IO error+** code is returned and the value of *pExists is undefined.+*/+static int hasHotJournal(Pager *pPager, int *pExists){+ sqlite3_vfs * const pVfs = pPager->pVfs;+ int rc = SQLITE_OK; /* Return code */+ int exists = 1; /* True if a journal file is present */+ int jrnlOpen = !!isOpen(pPager->jfd);++ assert( pPager->useJournal );+ assert( isOpen(pPager->fd) );+ assert( pPager->eState==PAGER_OPEN );++ assert( jrnlOpen==0 || ( sqlite3OsDeviceCharacteristics(pPager->jfd) &+ SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN+ ));++ *pExists = 0;+ if( !jrnlOpen ){+ rc = sqlite3OsAccess(pVfs, pPager->zJournal, SQLITE_ACCESS_EXISTS, &exists);+ }+ if( rc==SQLITE_OK && exists ){+ int locked = 0; /* True if some process holds a RESERVED lock */++ /* Race condition here: Another process might have been holding the+ ** the RESERVED lock and have a journal open at the sqlite3OsAccess() + ** call above, but then delete the journal and drop the lock before+ ** we get to the following sqlite3OsCheckReservedLock() call. If that+ ** is the case, this routine might think there is a hot journal when+ ** in fact there is none. This results in a false-positive which will+ ** be dealt with by the playback routine. Ticket #3883.+ */+ rc = sqlite3OsCheckReservedLock(pPager->fd, &locked);+ if( rc==SQLITE_OK && !locked ){+ Pgno nPage; /* Number of pages in database file */++ rc = pagerPagecount(pPager, &nPage);+ if( rc==SQLITE_OK ){+ /* If the database is zero pages in size, that means that either (1) the+ ** journal is a remnant from a prior database with the same name where+ ** the database file but not the journal was deleted, or (2) the initial+ ** transaction that populates a new database is being rolled back.+ ** In either case, the journal file can be deleted. However, take care+ ** not to delete the journal file if it is already open due to+ ** journal_mode=PERSIST.+ */+ if( nPage==0 && !jrnlOpen ){+ if( pagerLockDb(pPager, RESERVED_LOCK)==SQLITE_OK ){+ sqlite3OsDelete(pVfs, pPager->zJournal, 0);+ if( !pPager->exclusiveMode ) pagerUnlockDb(pPager, SHARED_LOCK);+ }+ }else{+ /* The journal file exists and no other connection has a reserved+ ** or greater lock on the database file. Now check that there is+ ** at least one non-zero bytes at the start of the journal file.+ ** If there is, then we consider this journal to be hot. If not, + ** it can be ignored.+ */+ if( !jrnlOpen ){+ int f = SQLITE_OPEN_READONLY|SQLITE_OPEN_MAIN_JOURNAL;+ rc = sqlite3OsOpen(pVfs, pPager->zJournal, pPager->jfd, f, &f);+ }+ if( rc==SQLITE_OK ){+ u8 first = 0;+ rc = sqlite3OsRead(pPager->jfd, (void *)&first, 1, 0);+ if( rc==SQLITE_IOERR_SHORT_READ ){+ rc = SQLITE_OK;+ }+ if( !jrnlOpen ){+ sqlite3OsClose(pPager->jfd);+ }+ *pExists = (first!=0);+ }else if( rc==SQLITE_CANTOPEN ){+ /* If we cannot open the rollback journal file in order to see if+ ** it has a zero header, that might be due to an I/O error, or+ ** it might be due to the race condition described above and in+ ** ticket #3883. Either way, assume that the journal is hot.+ ** This might be a false positive. But if it is, then the+ ** automatic journal playback and recovery mechanism will deal+ ** with it under an EXCLUSIVE lock where we do not need to+ ** worry so much with race conditions.+ */+ *pExists = 1;+ rc = SQLITE_OK;+ }+ }+ }+ }+ }++ return rc;+}++/*+** This function is called to obtain a shared lock on the database file.+** It is illegal to call sqlite3PagerAcquire() until after this function+** has been successfully called. If a shared-lock is already held when+** this function is called, it is a no-op.+**+** The following operations are also performed by this function.+**+** 1) If the pager is currently in PAGER_OPEN state (no lock held+** on the database file), then an attempt is made to obtain a+** SHARED lock on the database file. Immediately after obtaining+** the SHARED lock, the file-system is checked for a hot-journal,+** which is played back if present. Following any hot-journal +** rollback, the contents of the cache are validated by checking+** the 'change-counter' field of the database file header and+** discarded if they are found to be invalid.+**+** 2) If the pager is running in exclusive-mode, and there are currently+** no outstanding references to any pages, and is in the error state,+** then an attempt is made to clear the error state by discarding+** the contents of the page cache and rolling back any open journal+** file.+**+** If everything is successful, SQLITE_OK is returned. If an IO error +** occurs while locking the database, checking for a hot-journal file or +** rolling back a journal file, the IO error code is returned.+*/+SQLITE_PRIVATE int sqlite3PagerSharedLock(Pager *pPager){+ int rc = SQLITE_OK; /* Return code */++ /* This routine is only called from b-tree and only when there are no+ ** outstanding pages. This implies that the pager state should either+ ** be OPEN or READER. READER is only possible if the pager is or was in + ** exclusive access mode.+ */+ assert( sqlite3PcacheRefCount(pPager->pPCache)==0 );+ assert( assert_pager_state(pPager) );+ assert( pPager->eState==PAGER_OPEN || pPager->eState==PAGER_READER );++ if( !pagerUseWal(pPager) && pPager->eState==PAGER_OPEN ){+ int bHotJournal = 1; /* True if there exists a hot journal-file */++ rc = pager_wait_on_lock(pPager, SHARED_LOCK);+ if( rc!=SQLITE_OK ){+ assert( pPager->eLock==NO_LOCK || pPager->eLock==UNKNOWN_LOCK );+ goto failed;+ }++ /* If a journal file exists, and there is no RESERVED lock on the+ ** database file, then it either needs to be played back or deleted.+ */+ if( pPager->eLock<=SHARED_LOCK ){+ rc = hasHotJournal(pPager, &bHotJournal);+ }+ if( rc!=SQLITE_OK ){+ goto failed;+ }+ if( bHotJournal ){+ if( pPager->readOnly ){+ rc = SQLITE_READONLY_ROLLBACK;+ goto failed;+ }++ /* Get an EXCLUSIVE lock on the database file. At this point it is+ ** important that a RESERVED lock is not obtained on the way to the+ ** EXCLUSIVE lock. If it were, another process might open the+ ** database file, detect the RESERVED lock, and conclude that the+ ** database is safe to read while this process is still rolling the + ** hot-journal back.+ ** + ** Because the intermediate RESERVED lock is not requested, any+ ** other process attempting to access the database file will get to + ** this point in the code and fail to obtain its own EXCLUSIVE lock + ** on the database file.+ **+ ** Unless the pager is in locking_mode=exclusive mode, the lock is+ ** downgraded to SHARED_LOCK before this function returns.+ */+ rc = pagerLockDb(pPager, EXCLUSIVE_LOCK);+ if( rc!=SQLITE_OK ){+ goto failed;+ }+ + /* If it is not already open and the file exists on disk, open the + ** journal for read/write access. Write access is required because + ** in exclusive-access mode the file descriptor will be kept open + ** and possibly used for a transaction later on. Also, write-access + ** is usually required to finalize the journal in journal_mode=persist + ** mode (and also for journal_mode=truncate on some systems).+ **+ ** If the journal does not exist, it usually means that some + ** other connection managed to get in and roll it back before + ** this connection obtained the exclusive lock above. Or, it + ** may mean that the pager was in the error-state when this+ ** function was called and the journal file does not exist.+ */+ if( !isOpen(pPager->jfd) ){+ sqlite3_vfs * const pVfs = pPager->pVfs;+ int bExists; /* True if journal file exists */+ rc = sqlite3OsAccess(+ pVfs, pPager->zJournal, SQLITE_ACCESS_EXISTS, &bExists);+ if( rc==SQLITE_OK && bExists ){+ int fout = 0;+ int f = SQLITE_OPEN_READWRITE|SQLITE_OPEN_MAIN_JOURNAL;+ assert( !pPager->tempFile );+ rc = sqlite3OsOpen(pVfs, pPager->zJournal, pPager->jfd, f, &fout);+ assert( rc!=SQLITE_OK || isOpen(pPager->jfd) );+ if( rc==SQLITE_OK && fout&SQLITE_OPEN_READONLY ){+ rc = SQLITE_CANTOPEN_BKPT;+ sqlite3OsClose(pPager->jfd);+ }+ }+ }+ + /* Playback and delete the journal. Drop the database write+ ** lock and reacquire the read lock. Purge the cache before+ ** playing back the hot-journal so that we don't end up with+ ** an inconsistent cache. Sync the hot journal before playing+ ** it back since the process that crashed and left the hot journal+ ** probably did not sync it and we are required to always sync+ ** the journal before playing it back.+ */+ if( isOpen(pPager->jfd) ){+ assert( rc==SQLITE_OK );+ rc = pagerSyncHotJournal(pPager);+ if( rc==SQLITE_OK ){+ rc = pager_playback(pPager, 1);+ pPager->eState = PAGER_OPEN;+ }+ }else if( !pPager->exclusiveMode ){+ pagerUnlockDb(pPager, SHARED_LOCK);+ }++ if( rc!=SQLITE_OK ){+ /* This branch is taken if an error occurs while trying to open+ ** or roll back a hot-journal while holding an EXCLUSIVE lock. The+ ** pager_unlock() routine will be called before returning to unlock+ ** the file. If the unlock attempt fails, then Pager.eLock must be+ ** set to UNKNOWN_LOCK (see the comment above the #define for + ** UNKNOWN_LOCK above for an explanation). + **+ ** In order to get pager_unlock() to do this, set Pager.eState to+ ** PAGER_ERROR now. This is not actually counted as a transition+ ** to ERROR state in the state diagram at the top of this file,+ ** since we know that the same call to pager_unlock() will very+ ** shortly transition the pager object to the OPEN state. Calling+ ** assert_pager_state() would fail now, as it should not be possible+ ** to be in ERROR state when there are zero outstanding page + ** references.+ */+ pager_error(pPager, rc);+ goto failed;+ }++ assert( pPager->eState==PAGER_OPEN );+ assert( (pPager->eLock==SHARED_LOCK)+ || (pPager->exclusiveMode && pPager->eLock>SHARED_LOCK)+ );+ }++ if( !pPager->tempFile && pPager->hasHeldSharedLock ){+ /* The shared-lock has just been acquired then check to+ ** see if the database has been modified. If the database has changed,+ ** flush the cache. The hasHeldSharedLock flag prevents this from+ ** occurring on the very first access to a file, in order to save a+ ** single unnecessary sqlite3OsRead() call at the start-up.+ **+ ** Database changes are detected by looking at 15 bytes beginning+ ** at offset 24 into the file. The first 4 of these 16 bytes are+ ** a 32-bit counter that is incremented with each change. The+ ** other bytes change randomly with each file change when+ ** a codec is in use.+ ** + ** There is a vanishingly small chance that a change will not be + ** detected. The chance of an undetected change is so small that+ ** it can be neglected.+ */+ Pgno nPage = 0;+ char dbFileVers[sizeof(pPager->dbFileVers)];++ rc = pagerPagecount(pPager, &nPage);+ if( rc ) goto failed;++ if( nPage>0 ){+ IOTRACE(("CKVERS %p %d\n", pPager, sizeof(dbFileVers)));+ rc = sqlite3OsRead(pPager->fd, &dbFileVers, sizeof(dbFileVers), 24);+ if( rc!=SQLITE_OK && rc!=SQLITE_IOERR_SHORT_READ ){+ goto failed;+ }+ }else{+ memset(dbFileVers, 0, sizeof(dbFileVers));+ }++ if( memcmp(pPager->dbFileVers, dbFileVers, sizeof(dbFileVers))!=0 ){+ pager_reset(pPager);++ /* Unmap the database file. It is possible that external processes+ ** may have truncated the database file and then extended it back+ ** to its original size while this process was not holding a lock.+ ** In this case there may exist a Pager.pMap mapping that appears+ ** to be the right size but is not actually valid. Avoid this+ ** possibility by unmapping the db here. */+ if( USEFETCH(pPager) ){+ sqlite3OsUnfetch(pPager->fd, 0, 0);+ }+ }+ }++ /* If there is a WAL file in the file-system, open this database in WAL+ ** mode. Otherwise, the following function call is a no-op.+ */+ rc = pagerOpenWalIfPresent(pPager);+#ifndef SQLITE_OMIT_WAL+ assert( pPager->pWal==0 || rc==SQLITE_OK );+#endif+ }++ if( pagerUseWal(pPager) ){+ assert( rc==SQLITE_OK );+ rc = pagerBeginReadTransaction(pPager);+ }++ if( pPager->eState==PAGER_OPEN && rc==SQLITE_OK ){+ rc = pagerPagecount(pPager, &pPager->dbSize);+ }++ failed:+ if( rc!=SQLITE_OK ){+ pager_unlock(pPager);+ assert( pPager->eState==PAGER_OPEN );+ }else{+ pPager->eState = PAGER_READER;+ pPager->hasHeldSharedLock = 1;+ }+ return rc;+}++/*+** If the reference count has reached zero, rollback any active+** transaction and unlock the pager.+**+** Except, in locking_mode=EXCLUSIVE when there is nothing to in+** the rollback journal, the unlock is not performed and there is+** nothing to rollback, so this routine is a no-op.+*/ +static void pagerUnlockIfUnused(Pager *pPager){+ if( pPager->nMmapOut==0 && (sqlite3PcacheRefCount(pPager->pPCache)==0) ){+ pagerUnlockAndRollback(pPager);+ }+}++/*+** Acquire a reference to page number pgno in pager pPager (a page+** reference has type DbPage*). If the requested reference is +** successfully obtained, it is copied to *ppPage and SQLITE_OK returned.+**+** If the requested page is already in the cache, it is returned. +** Otherwise, a new page object is allocated and populated with data+** read from the database file. In some cases, the pcache module may+** choose not to allocate a new page object and may reuse an existing+** object with no outstanding references.+**+** The extra data appended to a page is always initialized to zeros the +** first time a page is loaded into memory. If the page requested is +** already in the cache when this function is called, then the extra+** data is left as it was when the page object was last used.+**+** If the database image is smaller than the requested page or if a +** non-zero value is passed as the noContent parameter and the +** requested page is not already stored in the cache, then no +** actual disk read occurs. In this case the memory image of the +** page is initialized to all zeros. +**+** If noContent is true, it means that we do not care about the contents+** of the page. This occurs in two scenarios:+**+** a) When reading a free-list leaf page from the database, and+**+** b) When a savepoint is being rolled back and we need to load+** a new page into the cache to be filled with the data read+** from the savepoint journal.+**+** If noContent is true, then the data returned is zeroed instead of+** being read from the database. Additionally, the bits corresponding+** to pgno in Pager.pInJournal (bitvec of pages already written to the+** journal file) and the PagerSavepoint.pInSavepoint bitvecs of any open+** savepoints are set. This means if the page is made writable at any+** point in the future, using a call to sqlite3PagerWrite(), its contents+** will not be journaled. This saves IO.+**+** The acquisition might fail for several reasons. In all cases,+** an appropriate error code is returned and *ppPage is set to NULL.+**+** See also sqlite3PagerLookup(). Both this routine and Lookup() attempt+** to find a page in the in-memory cache first. If the page is not already+** in memory, this routine goes to disk to read it in whereas Lookup()+** just returns 0. This routine acquires a read-lock the first time it+** has to go to disk, and could also playback an old journal if necessary.+** Since Lookup() never goes to disk, it never has to deal with locks+** or journal files.+*/+SQLITE_PRIVATE int sqlite3PagerAcquire(+ Pager *pPager, /* The pager open on the database file */+ Pgno pgno, /* Page number to fetch */+ DbPage **ppPage, /* Write a pointer to the page here */+ int flags /* PAGER_GET_XXX flags */+){+ int rc = SQLITE_OK;+ PgHdr *pPg = 0;+ u32 iFrame = 0; /* Frame to read from WAL file */+ const int noContent = (flags & PAGER_GET_NOCONTENT);++ /* It is acceptable to use a read-only (mmap) page for any page except+ ** page 1 if there is no write-transaction open or the ACQUIRE_READONLY+ ** flag was specified by the caller. And so long as the db is not a + ** temporary or in-memory database. */+ const int bMmapOk = (pgno>1 && USEFETCH(pPager)+ && (pPager->eState==PAGER_READER || (flags & PAGER_GET_READONLY))+#ifdef SQLITE_HAS_CODEC+ && pPager->xCodec==0+#endif+ );++ /* Optimization note: Adding the "pgno<=1" term before "pgno==0" here+ ** allows the compiler optimizer to reuse the results of the "pgno>1"+ ** test in the previous statement, and avoid testing pgno==0 in the+ ** common case where pgno is large. */+ if( pgno<=1 && pgno==0 ){+ return SQLITE_CORRUPT_BKPT;+ }+ assert( pPager->eState>=PAGER_READER );+ assert( assert_pager_state(pPager) );+ assert( noContent==0 || bMmapOk==0 );++ assert( pPager->hasHeldSharedLock==1 );++ /* If the pager is in the error state, return an error immediately. + ** Otherwise, request the page from the PCache layer. */+ if( pPager->errCode!=SQLITE_OK ){+ rc = pPager->errCode;+ }else{+ if( bMmapOk && pagerUseWal(pPager) ){+ rc = sqlite3WalFindFrame(pPager->pWal, pgno, &iFrame);+ if( rc!=SQLITE_OK ) goto pager_acquire_err;+ }++ if( bMmapOk && iFrame==0 ){+ void *pData = 0;++ rc = sqlite3OsFetch(pPager->fd, + (i64)(pgno-1) * pPager->pageSize, pPager->pageSize, &pData+ );++ if( rc==SQLITE_OK && pData ){+ if( pPager->eState>PAGER_READER ){+ pPg = sqlite3PagerLookup(pPager, pgno);+ }+ if( pPg==0 ){+ rc = pagerAcquireMapPage(pPager, pgno, pData, &pPg);+ }else{+ sqlite3OsUnfetch(pPager->fd, (i64)(pgno-1)*pPager->pageSize, pData);+ }+ if( pPg ){+ assert( rc==SQLITE_OK );+ *ppPage = pPg;+ return SQLITE_OK;+ }+ }+ if( rc!=SQLITE_OK ){+ goto pager_acquire_err;+ }+ }++ {+ sqlite3_pcache_page *pBase;+ pBase = sqlite3PcacheFetch(pPager->pPCache, pgno, 3);+ if( pBase==0 ){+ rc = sqlite3PcacheFetchStress(pPager->pPCache, pgno, &pBase);+ if( rc!=SQLITE_OK ) goto pager_acquire_err;+ if( pBase==0 ){+ pPg = *ppPage = 0;+ rc = SQLITE_NOMEM;+ goto pager_acquire_err;+ }+ }+ pPg = *ppPage = sqlite3PcacheFetchFinish(pPager->pPCache, pgno, pBase);+ assert( pPg!=0 );+ }+ }++ if( rc!=SQLITE_OK ){+ /* Either the call to sqlite3PcacheFetch() returned an error or the+ ** pager was already in the error-state when this function was called.+ ** Set pPg to 0 and jump to the exception handler. */+ pPg = 0;+ goto pager_acquire_err;+ }+ assert( pPg==(*ppPage) );+ assert( pPg->pgno==pgno );+ assert( pPg->pPager==pPager || pPg->pPager==0 );++ if( pPg->pPager && !noContent ){+ /* In this case the pcache already contains an initialized copy of+ ** the page. Return without further ado. */+ assert( pgno<=PAGER_MAX_PGNO && pgno!=PAGER_MJ_PGNO(pPager) );+ pPager->aStat[PAGER_STAT_HIT]++;+ return SQLITE_OK;++ }else{+ /* The pager cache has created a new page. Its content needs to + ** be initialized. */++ pPg->pPager = pPager;++ /* The maximum page number is 2^31. Return SQLITE_CORRUPT if a page+ ** number greater than this, or the unused locking-page, is requested. */+ if( pgno>PAGER_MAX_PGNO || pgno==PAGER_MJ_PGNO(pPager) ){+ rc = SQLITE_CORRUPT_BKPT;+ goto pager_acquire_err;+ }++ if( pPager->dbSize<pgno || noContent || !isOpen(pPager->fd) ){+ if( pgno>pPager->mxPgno ){+ rc = SQLITE_FULL;+ goto pager_acquire_err;+ }+ if( noContent ){+ /* Failure to set the bits in the InJournal bit-vectors is benign.+ ** It merely means that we might do some extra work to journal a + ** page that does not need to be journaled. Nevertheless, be sure + ** to test the case where a malloc error occurs while trying to set + ** a bit in a bit vector.+ */+ if( pgno<=pPager->dbOrigSize ){+ TESTONLY( rc = ) sqlite3BitvecSet(pPager->pInJournal, pgno);+ testcase( rc==SQLITE_NOMEM );+ }+ TESTONLY( rc = ) addToSavepointBitvecs(pPager, pgno);+ testcase( rc==SQLITE_NOMEM );+ }+ memset(pPg->pData, 0, pPager->pageSize);+ IOTRACE(("ZERO %p %d\n", pPager, pgno));+ }else{+ if( pagerUseWal(pPager) && bMmapOk==0 ){+ rc = sqlite3WalFindFrame(pPager->pWal, pgno, &iFrame);+ if( rc!=SQLITE_OK ) goto pager_acquire_err;+ }+ assert( pPg->pPager==pPager );+ pPager->aStat[PAGER_STAT_MISS]++;+ rc = readDbPage(pPg, iFrame);+ if( rc!=SQLITE_OK ){+ goto pager_acquire_err;+ }+ }+ pager_set_pagehash(pPg);+ }++ return SQLITE_OK;++pager_acquire_err:+ assert( rc!=SQLITE_OK );+ if( pPg ){+ sqlite3PcacheDrop(pPg);+ }+ pagerUnlockIfUnused(pPager);++ *ppPage = 0;+ return rc;+}++/*+** Acquire a page if it is already in the in-memory cache. Do+** not read the page from disk. Return a pointer to the page,+** or 0 if the page is not in cache. +**+** See also sqlite3PagerGet(). The difference between this routine+** and sqlite3PagerGet() is that _get() will go to the disk and read+** in the page if the page is not already in cache. This routine+** returns NULL if the page is not in cache or if a disk I/O error +** has ever happened.+*/+SQLITE_PRIVATE DbPage *sqlite3PagerLookup(Pager *pPager, Pgno pgno){+ sqlite3_pcache_page *pPage;+ assert( pPager!=0 );+ assert( pgno!=0 );+ assert( pPager->pPCache!=0 );+ pPage = sqlite3PcacheFetch(pPager->pPCache, pgno, 0);+ assert( pPage==0 || pPager->hasHeldSharedLock );+ if( pPage==0 ) return 0;+ return sqlite3PcacheFetchFinish(pPager->pPCache, pgno, pPage);+}++/*+** Release a page reference.+**+** If the number of references to the page drop to zero, then the+** page is added to the LRU list. When all references to all pages+** are released, a rollback occurs and the lock on the database is+** removed.+*/+SQLITE_PRIVATE void sqlite3PagerUnrefNotNull(DbPage *pPg){+ Pager *pPager;+ assert( pPg!=0 );+ pPager = pPg->pPager;+ if( pPg->flags & PGHDR_MMAP ){+ pagerReleaseMapPage(pPg);+ }else{+ sqlite3PcacheRelease(pPg);+ }+ pagerUnlockIfUnused(pPager);+}+SQLITE_PRIVATE void sqlite3PagerUnref(DbPage *pPg){+ if( pPg ) sqlite3PagerUnrefNotNull(pPg);+}++/*+** This function is called at the start of every write transaction.+** There must already be a RESERVED or EXCLUSIVE lock on the database +** file when this routine is called.+**+** Open the journal file for pager pPager and write a journal header+** to the start of it. If there are active savepoints, open the sub-journal+** as well. This function is only used when the journal file is being +** opened to write a rollback log for a transaction. It is not used +** when opening a hot journal file to roll it back.+**+** If the journal file is already open (as it may be in exclusive mode),+** then this function just writes a journal header to the start of the+** already open file. +**+** Whether or not the journal file is opened by this function, the+** Pager.pInJournal bitvec structure is allocated.+**+** Return SQLITE_OK if everything is successful. Otherwise, return +** SQLITE_NOMEM if the attempt to allocate Pager.pInJournal fails, or +** an IO error code if opening or writing the journal file fails.+*/+static int pager_open_journal(Pager *pPager){+ int rc = SQLITE_OK; /* Return code */+ sqlite3_vfs * const pVfs = pPager->pVfs; /* Local cache of vfs pointer */++ assert( pPager->eState==PAGER_WRITER_LOCKED );+ assert( assert_pager_state(pPager) );+ assert( pPager->pInJournal==0 );+ + /* If already in the error state, this function is a no-op. But on+ ** the other hand, this routine is never called if we are already in+ ** an error state. */+ if( NEVER(pPager->errCode) ) return pPager->errCode;++ if( !pagerUseWal(pPager) && pPager->journalMode!=PAGER_JOURNALMODE_OFF ){+ pPager->pInJournal = sqlite3BitvecCreate(pPager->dbSize);+ if( pPager->pInJournal==0 ){+ return SQLITE_NOMEM;+ }+ + /* Open the journal file if it is not already open. */+ if( !isOpen(pPager->jfd) ){+ if( pPager->journalMode==PAGER_JOURNALMODE_MEMORY ){+ sqlite3MemJournalOpen(pPager->jfd);+ }else{+ const int flags = /* VFS flags to open journal file */+ SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE|+ (pPager->tempFile ? + (SQLITE_OPEN_DELETEONCLOSE|SQLITE_OPEN_TEMP_JOURNAL):+ (SQLITE_OPEN_MAIN_JOURNAL)+ );++ /* Verify that the database still has the same name as it did when+ ** it was originally opened. */+ rc = databaseIsUnmoved(pPager);+ if( rc==SQLITE_OK ){+#ifdef SQLITE_ENABLE_ATOMIC_WRITE+ rc = sqlite3JournalOpen(+ pVfs, pPager->zJournal, pPager->jfd, flags, jrnlBufferSize(pPager)+ );+#else+ rc = sqlite3OsOpen(pVfs, pPager->zJournal, pPager->jfd, flags, 0);+#endif+ }+ }+ assert( rc!=SQLITE_OK || isOpen(pPager->jfd) );+ }+ + + /* Write the first journal header to the journal file and open + ** the sub-journal if necessary.+ */+ if( rc==SQLITE_OK ){+ /* TODO: Check if all of these are really required. */+ pPager->nRec = 0;+ pPager->journalOff = 0;+ pPager->setMaster = 0;+ pPager->journalHdr = 0;+ rc = writeJournalHdr(pPager);+ }+ }++ if( rc!=SQLITE_OK ){+ sqlite3BitvecDestroy(pPager->pInJournal);+ pPager->pInJournal = 0;+ }else{+ assert( pPager->eState==PAGER_WRITER_LOCKED );+ pPager->eState = PAGER_WRITER_CACHEMOD;+ }++ return rc;+}++/*+** Begin a write-transaction on the specified pager object. If a +** write-transaction has already been opened, this function is a no-op.+**+** If the exFlag argument is false, then acquire at least a RESERVED+** lock on the database file. If exFlag is true, then acquire at least+** an EXCLUSIVE lock. If such a lock is already held, no locking +** functions need be called.+**+** If the subjInMemory argument is non-zero, then any sub-journal opened+** within this transaction will be opened as an in-memory file. This+** has no effect if the sub-journal is already opened (as it may be when+** running in exclusive mode) or if the transaction does not require a+** sub-journal. If the subjInMemory argument is zero, then any required+** sub-journal is implemented in-memory if pPager is an in-memory database, +** or using a temporary file otherwise.+*/+SQLITE_PRIVATE int sqlite3PagerBegin(Pager *pPager, int exFlag, int subjInMemory){+ int rc = SQLITE_OK;++ if( pPager->errCode ) return pPager->errCode;+ assert( pPager->eState>=PAGER_READER && pPager->eState<PAGER_ERROR );+ pPager->subjInMemory = (u8)subjInMemory;++ if( ALWAYS(pPager->eState==PAGER_READER) ){+ assert( pPager->pInJournal==0 );++ if( pagerUseWal(pPager) ){+ /* If the pager is configured to use locking_mode=exclusive, and an+ ** exclusive lock on the database is not already held, obtain it now.+ */+ if( pPager->exclusiveMode && sqlite3WalExclusiveMode(pPager->pWal, -1) ){+ rc = pagerLockDb(pPager, EXCLUSIVE_LOCK);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ sqlite3WalExclusiveMode(pPager->pWal, 1);+ }++ /* Grab the write lock on the log file. If successful, upgrade to+ ** PAGER_RESERVED state. Otherwise, return an error code to the caller.+ ** The busy-handler is not invoked if another connection already+ ** holds the write-lock. If possible, the upper layer will call it.+ */+ rc = sqlite3WalBeginWriteTransaction(pPager->pWal);+ }else{+ /* Obtain a RESERVED lock on the database file. If the exFlag parameter+ ** is true, then immediately upgrade this to an EXCLUSIVE lock. The+ ** busy-handler callback can be used when upgrading to the EXCLUSIVE+ ** lock, but not when obtaining the RESERVED lock.+ */+ rc = pagerLockDb(pPager, RESERVED_LOCK);+ if( rc==SQLITE_OK && exFlag ){+ rc = pager_wait_on_lock(pPager, EXCLUSIVE_LOCK);+ }+ }++ if( rc==SQLITE_OK ){+ /* Change to WRITER_LOCKED state.+ **+ ** WAL mode sets Pager.eState to PAGER_WRITER_LOCKED or CACHEMOD+ ** when it has an open transaction, but never to DBMOD or FINISHED.+ ** This is because in those states the code to roll back savepoint + ** transactions may copy data from the sub-journal into the database + ** file as well as into the page cache. Which would be incorrect in + ** WAL mode.+ */+ pPager->eState = PAGER_WRITER_LOCKED;+ pPager->dbHintSize = pPager->dbSize;+ pPager->dbFileSize = pPager->dbSize;+ pPager->dbOrigSize = pPager->dbSize;+ pPager->journalOff = 0;+ }++ assert( rc==SQLITE_OK || pPager->eState==PAGER_READER );+ assert( rc!=SQLITE_OK || pPager->eState==PAGER_WRITER_LOCKED );+ assert( assert_pager_state(pPager) );+ }++ PAGERTRACE(("TRANSACTION %d\n", PAGERID(pPager)));+ return rc;+}++/*+** Write page pPg onto the end of the rollback journal.+*/+static SQLITE_NOINLINE int pagerAddPageToRollbackJournal(PgHdr *pPg){+ Pager *pPager = pPg->pPager;+ int rc;+ u32 cksum;+ char *pData2;+ i64 iOff = pPager->journalOff;++ /* We should never write to the journal file the page that+ ** contains the database locks. The following assert verifies+ ** that we do not. */+ assert( pPg->pgno!=PAGER_MJ_PGNO(pPager) );++ assert( pPager->journalHdr<=pPager->journalOff );+ CODEC2(pPager, pPg->pData, pPg->pgno, 7, return SQLITE_NOMEM, pData2);+ cksum = pager_cksum(pPager, (u8*)pData2);++ /* Even if an IO or diskfull error occurs while journalling the+ ** page in the block above, set the need-sync flag for the page.+ ** Otherwise, when the transaction is rolled back, the logic in+ ** playback_one_page() will think that the page needs to be restored+ ** in the database file. And if an IO error occurs while doing so,+ ** then corruption may follow.+ */+ pPg->flags |= PGHDR_NEED_SYNC;++ rc = write32bits(pPager->jfd, iOff, pPg->pgno);+ if( rc!=SQLITE_OK ) return rc;+ rc = sqlite3OsWrite(pPager->jfd, pData2, pPager->pageSize, iOff+4);+ if( rc!=SQLITE_OK ) return rc;+ rc = write32bits(pPager->jfd, iOff+pPager->pageSize+4, cksum);+ if( rc!=SQLITE_OK ) return rc;++ IOTRACE(("JOUT %p %d %lld %d\n", pPager, pPg->pgno, + pPager->journalOff, pPager->pageSize));+ PAGER_INCR(sqlite3_pager_writej_count);+ PAGERTRACE(("JOURNAL %d page %d needSync=%d hash(%08x)\n",+ PAGERID(pPager), pPg->pgno, + ((pPg->flags&PGHDR_NEED_SYNC)?1:0), pager_pagehash(pPg)));++ pPager->journalOff += 8 + pPager->pageSize;+ pPager->nRec++;+ assert( pPager->pInJournal!=0 );+ rc = sqlite3BitvecSet(pPager->pInJournal, pPg->pgno);+ testcase( rc==SQLITE_NOMEM );+ assert( rc==SQLITE_OK || rc==SQLITE_NOMEM );+ rc |= addToSavepointBitvecs(pPager, pPg->pgno);+ assert( rc==SQLITE_OK || rc==SQLITE_NOMEM );+ return rc;+}++/*+** Mark a single data page as writeable. The page is written into the +** main journal or sub-journal as required. If the page is written into+** one of the journals, the corresponding bit is set in the +** Pager.pInJournal bitvec and the PagerSavepoint.pInSavepoint bitvecs+** of any open savepoints as appropriate.+*/+static int pager_write(PgHdr *pPg){+ Pager *pPager = pPg->pPager;+ int rc = SQLITE_OK;++ /* This routine is not called unless a write-transaction has already + ** been started. The journal file may or may not be open at this point.+ ** It is never called in the ERROR state.+ */+ assert( pPager->eState==PAGER_WRITER_LOCKED+ || pPager->eState==PAGER_WRITER_CACHEMOD+ || pPager->eState==PAGER_WRITER_DBMOD+ );+ assert( assert_pager_state(pPager) );+ assert( pPager->errCode==0 );+ assert( pPager->readOnly==0 );+ CHECK_PAGE(pPg);++ /* The journal file needs to be opened. Higher level routines have already+ ** obtained the necessary locks to begin the write-transaction, but the+ ** rollback journal might not yet be open. Open it now if this is the case.+ **+ ** This is done before calling sqlite3PcacheMakeDirty() on the page. + ** Otherwise, if it were done after calling sqlite3PcacheMakeDirty(), then+ ** an error might occur and the pager would end up in WRITER_LOCKED state+ ** with pages marked as dirty in the cache.+ */+ if( pPager->eState==PAGER_WRITER_LOCKED ){+ rc = pager_open_journal(pPager);+ if( rc!=SQLITE_OK ) return rc;+ }+ assert( pPager->eState>=PAGER_WRITER_CACHEMOD );+ assert( assert_pager_state(pPager) );++ /* Mark the page that is about to be modified as dirty. */+ sqlite3PcacheMakeDirty(pPg);++ /* If a rollback journal is in use, them make sure the page that is about+ ** to change is in the rollback journal, or if the page is a new page off+ ** then end of the file, make sure it is marked as PGHDR_NEED_SYNC.+ */+ assert( (pPager->pInJournal!=0) == isOpen(pPager->jfd) );+ if( pPager->pInJournal!=0+ && sqlite3BitvecTestNotNull(pPager->pInJournal, pPg->pgno)==0+ ){+ assert( pagerUseWal(pPager)==0 );+ if( pPg->pgno<=pPager->dbOrigSize ){+ rc = pagerAddPageToRollbackJournal(pPg);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ }else{+ if( pPager->eState!=PAGER_WRITER_DBMOD ){+ pPg->flags |= PGHDR_NEED_SYNC;+ }+ PAGERTRACE(("APPEND %d page %d needSync=%d\n",+ PAGERID(pPager), pPg->pgno,+ ((pPg->flags&PGHDR_NEED_SYNC)?1:0)));+ }+ }++ /* The PGHDR_DIRTY bit is set above when the page was added to the dirty-list+ ** and before writing the page into the rollback journal. Wait until now,+ ** after the page has been successfully journalled, before setting the+ ** PGHDR_WRITEABLE bit that indicates that the page can be safely modified.+ */+ pPg->flags |= PGHDR_WRITEABLE;+ + /* If the statement journal is open and the page is not in it,+ ** then write the page into the statement journal.+ */+ if( pPager->nSavepoint>0 ){+ rc = subjournalPageIfRequired(pPg);+ }++ /* Update the database size and return. */+ if( pPager->dbSize<pPg->pgno ){+ pPager->dbSize = pPg->pgno;+ }+ return rc;+}++/*+** This is a variant of sqlite3PagerWrite() that runs when the sector size+** is larger than the page size. SQLite makes the (reasonable) assumption that+** all bytes of a sector are written together by hardware. Hence, all bytes of+** a sector need to be journalled in case of a power loss in the middle of+** a write.+**+** Usually, the sector size is less than or equal to the page size, in which+** case pages can be individually written. This routine only runs in the+** exceptional case where the page size is smaller than the sector size.+*/+static SQLITE_NOINLINE int pagerWriteLargeSector(PgHdr *pPg){+ int rc = SQLITE_OK; /* Return code */+ Pgno nPageCount; /* Total number of pages in database file */+ Pgno pg1; /* First page of the sector pPg is located on. */+ int nPage = 0; /* Number of pages starting at pg1 to journal */+ int ii; /* Loop counter */+ int needSync = 0; /* True if any page has PGHDR_NEED_SYNC */+ Pager *pPager = pPg->pPager; /* The pager that owns pPg */+ Pgno nPagePerSector = (pPager->sectorSize/pPager->pageSize);++ /* Set the doNotSpill NOSYNC bit to 1. This is because we cannot allow+ ** a journal header to be written between the pages journaled by+ ** this function.+ */+ assert( (pPager->doNotSpill & SPILLFLAG_NOSYNC)==0 );+ pPager->doNotSpill |= SPILLFLAG_NOSYNC;++ /* This trick assumes that both the page-size and sector-size are+ ** an integer power of 2. It sets variable pg1 to the identifier+ ** of the first page of the sector pPg is located on.+ */+ pg1 = ((pPg->pgno-1) & ~(nPagePerSector-1)) + 1;++ nPageCount = pPager->dbSize;+ if( pPg->pgno>nPageCount ){+ nPage = (pPg->pgno - pg1)+1;+ }else if( (pg1+nPagePerSector-1)>nPageCount ){+ nPage = nPageCount+1-pg1;+ }else{+ nPage = nPagePerSector;+ }+ assert(nPage>0);+ assert(pg1<=pPg->pgno);+ assert((pg1+nPage)>pPg->pgno);++ for(ii=0; ii<nPage && rc==SQLITE_OK; ii++){+ Pgno pg = pg1+ii;+ PgHdr *pPage;+ if( pg==pPg->pgno || !sqlite3BitvecTest(pPager->pInJournal, pg) ){+ if( pg!=PAGER_MJ_PGNO(pPager) ){+ rc = sqlite3PagerGet(pPager, pg, &pPage);+ if( rc==SQLITE_OK ){+ rc = pager_write(pPage);+ if( pPage->flags&PGHDR_NEED_SYNC ){+ needSync = 1;+ }+ sqlite3PagerUnrefNotNull(pPage);+ }+ }+ }else if( (pPage = sqlite3PagerLookup(pPager, pg))!=0 ){+ if( pPage->flags&PGHDR_NEED_SYNC ){+ needSync = 1;+ }+ sqlite3PagerUnrefNotNull(pPage);+ }+ }++ /* If the PGHDR_NEED_SYNC flag is set for any of the nPage pages + ** starting at pg1, then it needs to be set for all of them. Because+ ** writing to any of these nPage pages may damage the others, the+ ** journal file must contain sync()ed copies of all of them+ ** before any of them can be written out to the database file.+ */+ if( rc==SQLITE_OK && needSync ){+ for(ii=0; ii<nPage; ii++){+ PgHdr *pPage = sqlite3PagerLookup(pPager, pg1+ii);+ if( pPage ){+ pPage->flags |= PGHDR_NEED_SYNC;+ sqlite3PagerUnrefNotNull(pPage);+ }+ }+ }++ assert( (pPager->doNotSpill & SPILLFLAG_NOSYNC)!=0 );+ pPager->doNotSpill &= ~SPILLFLAG_NOSYNC;+ return rc;+}++/*+** Mark a data page as writeable. This routine must be called before +** making changes to a page. The caller must check the return value +** of this function and be careful not to change any page data unless +** this routine returns SQLITE_OK.+**+** The difference between this function and pager_write() is that this+** function also deals with the special case where 2 or more pages+** fit on a single disk sector. In this case all co-resident pages+** must have been written to the journal file before returning.+**+** If an error occurs, SQLITE_NOMEM or an IO error code is returned+** as appropriate. Otherwise, SQLITE_OK.+*/+SQLITE_PRIVATE int sqlite3PagerWrite(PgHdr *pPg){+ Pager *pPager = pPg->pPager;+ assert( (pPg->flags & PGHDR_MMAP)==0 );+ assert( pPager->eState>=PAGER_WRITER_LOCKED );+ assert( pPager->eState!=PAGER_ERROR );+ assert( assert_pager_state(pPager) );+ if( (pPg->flags & PGHDR_WRITEABLE)!=0 && pPager->dbSize>=pPg->pgno ){+ if( pPager->nSavepoint ) return subjournalPageIfRequired(pPg);+ return SQLITE_OK;+ }else if( pPager->sectorSize > (u32)pPager->pageSize ){+ return pagerWriteLargeSector(pPg);+ }else{+ return pager_write(pPg);+ }+}++/*+** Return TRUE if the page given in the argument was previously passed+** to sqlite3PagerWrite(). In other words, return TRUE if it is ok+** to change the content of the page.+*/+#ifndef NDEBUG+SQLITE_PRIVATE int sqlite3PagerIswriteable(DbPage *pPg){+ return pPg->flags & PGHDR_WRITEABLE;+}+#endif++/*+** A call to this routine tells the pager that it is not necessary to+** write the information on page pPg back to the disk, even though+** that page might be marked as dirty. This happens, for example, when+** the page has been added as a leaf of the freelist and so its+** content no longer matters.+**+** The overlying software layer calls this routine when all of the data+** on the given page is unused. The pager marks the page as clean so+** that it does not get written to disk.+**+** Tests show that this optimization can quadruple the speed of large +** DELETE operations.+*/+SQLITE_PRIVATE void sqlite3PagerDontWrite(PgHdr *pPg){+ Pager *pPager = pPg->pPager;+ if( (pPg->flags&PGHDR_DIRTY) && pPager->nSavepoint==0 ){+ PAGERTRACE(("DONT_WRITE page %d of %d\n", pPg->pgno, PAGERID(pPager)));+ IOTRACE(("CLEAN %p %d\n", pPager, pPg->pgno))+ pPg->flags |= PGHDR_DONT_WRITE;+ pPg->flags &= ~PGHDR_WRITEABLE;+ pager_set_pagehash(pPg);+ }+}++/*+** This routine is called to increment the value of the database file +** change-counter, stored as a 4-byte big-endian integer starting at +** byte offset 24 of the pager file. The secondary change counter at+** 92 is also updated, as is the SQLite version number at offset 96.+**+** But this only happens if the pPager->changeCountDone flag is false.+** To avoid excess churning of page 1, the update only happens once.+** See also the pager_write_changecounter() routine that does an +** unconditional update of the change counters.+**+** If the isDirectMode flag is zero, then this is done by calling +** sqlite3PagerWrite() on page 1, then modifying the contents of the+** page data. In this case the file will be updated when the current+** transaction is committed.+**+** The isDirectMode flag may only be non-zero if the library was compiled+** with the SQLITE_ENABLE_ATOMIC_WRITE macro defined. In this case,+** if isDirect is non-zero, then the database file is updated directly+** by writing an updated version of page 1 using a call to the +** sqlite3OsWrite() function.+*/+static int pager_incr_changecounter(Pager *pPager, int isDirectMode){+ int rc = SQLITE_OK;++ assert( pPager->eState==PAGER_WRITER_CACHEMOD+ || pPager->eState==PAGER_WRITER_DBMOD+ );+ assert( assert_pager_state(pPager) );++ /* Declare and initialize constant integer 'isDirect'. If the+ ** atomic-write optimization is enabled in this build, then isDirect+ ** is initialized to the value passed as the isDirectMode parameter+ ** to this function. Otherwise, it is always set to zero.+ **+ ** The idea is that if the atomic-write optimization is not+ ** enabled at compile time, the compiler can omit the tests of+ ** 'isDirect' below, as well as the block enclosed in the+ ** "if( isDirect )" condition.+ */+#ifndef SQLITE_ENABLE_ATOMIC_WRITE+# define DIRECT_MODE 0+ assert( isDirectMode==0 );+ UNUSED_PARAMETER(isDirectMode);+#else+# define DIRECT_MODE isDirectMode+#endif++ if( !pPager->changeCountDone && ALWAYS(pPager->dbSize>0) ){+ PgHdr *pPgHdr; /* Reference to page 1 */++ assert( !pPager->tempFile && isOpen(pPager->fd) );++ /* Open page 1 of the file for writing. */+ rc = sqlite3PagerGet(pPager, 1, &pPgHdr);+ assert( pPgHdr==0 || rc==SQLITE_OK );++ /* If page one was fetched successfully, and this function is not+ ** operating in direct-mode, make page 1 writable. When not in + ** direct mode, page 1 is always held in cache and hence the PagerGet()+ ** above is always successful - hence the ALWAYS on rc==SQLITE_OK.+ */+ if( !DIRECT_MODE && ALWAYS(rc==SQLITE_OK) ){+ rc = sqlite3PagerWrite(pPgHdr);+ }++ if( rc==SQLITE_OK ){+ /* Actually do the update of the change counter */+ pager_write_changecounter(pPgHdr);++ /* If running in direct mode, write the contents of page 1 to the file. */+ if( DIRECT_MODE ){+ const void *zBuf;+ assert( pPager->dbFileSize>0 );+ CODEC2(pPager, pPgHdr->pData, 1, 6, rc=SQLITE_NOMEM, zBuf);+ if( rc==SQLITE_OK ){+ rc = sqlite3OsWrite(pPager->fd, zBuf, pPager->pageSize, 0);+ pPager->aStat[PAGER_STAT_WRITE]++;+ }+ if( rc==SQLITE_OK ){+ /* Update the pager's copy of the change-counter. Otherwise, the+ ** next time a read transaction is opened the cache will be+ ** flushed (as the change-counter values will not match). */+ const void *pCopy = (const void *)&((const char *)zBuf)[24];+ memcpy(&pPager->dbFileVers, pCopy, sizeof(pPager->dbFileVers));+ pPager->changeCountDone = 1;+ }+ }else{+ pPager->changeCountDone = 1;+ }+ }++ /* Release the page reference. */+ sqlite3PagerUnref(pPgHdr);+ }+ return rc;+}++/*+** Sync the database file to disk. This is a no-op for in-memory databases+** or pages with the Pager.noSync flag set.+**+** If successful, or if called on a pager for which it is a no-op, this+** function returns SQLITE_OK. Otherwise, an IO error code is returned.+*/+SQLITE_PRIVATE int sqlite3PagerSync(Pager *pPager, const char *zMaster){+ int rc = SQLITE_OK;++ if( isOpen(pPager->fd) ){+ void *pArg = (void*)zMaster;+ rc = sqlite3OsFileControl(pPager->fd, SQLITE_FCNTL_SYNC, pArg);+ if( rc==SQLITE_NOTFOUND ) rc = SQLITE_OK;+ }+ if( rc==SQLITE_OK && !pPager->noSync ){+ rc = sqlite3OsSync(pPager->fd, pPager->syncFlags);+ }+ return rc;+}++/*+** This function may only be called while a write-transaction is active in+** rollback. If the connection is in WAL mode, this call is a no-op. +** Otherwise, if the connection does not already have an EXCLUSIVE lock on +** the database file, an attempt is made to obtain one.+**+** If the EXCLUSIVE lock is already held or the attempt to obtain it is+** successful, or the connection is in WAL mode, SQLITE_OK is returned.+** Otherwise, either SQLITE_BUSY or an SQLITE_IOERR_XXX error code is +** returned.+*/+SQLITE_PRIVATE int sqlite3PagerExclusiveLock(Pager *pPager){+ int rc = SQLITE_OK;+ assert( pPager->eState==PAGER_WRITER_CACHEMOD + || pPager->eState==PAGER_WRITER_DBMOD + || pPager->eState==PAGER_WRITER_LOCKED + );+ assert( assert_pager_state(pPager) );+ if( 0==pagerUseWal(pPager) ){+ rc = pager_wait_on_lock(pPager, EXCLUSIVE_LOCK);+ }+ return rc;+}++/*+** Sync the database file for the pager pPager. zMaster points to the name+** of a master journal file that should be written into the individual+** journal file. zMaster may be NULL, which is interpreted as no master+** journal (a single database transaction).+**+** This routine ensures that:+**+** * The database file change-counter is updated,+** * the journal is synced (unless the atomic-write optimization is used),+** * all dirty pages are written to the database file, +** * the database file is truncated (if required), and+** * the database file synced. +**+** The only thing that remains to commit the transaction is to finalize +** (delete, truncate or zero the first part of) the journal file (or +** delete the master journal file if specified).+**+** Note that if zMaster==NULL, this does not overwrite a previous value+** passed to an sqlite3PagerCommitPhaseOne() call.+**+** If the final parameter - noSync - is true, then the database file itself+** is not synced. The caller must call sqlite3PagerSync() directly to+** sync the database file before calling CommitPhaseTwo() to delete the+** journal file in this case.+*/+SQLITE_PRIVATE int sqlite3PagerCommitPhaseOne(+ Pager *pPager, /* Pager object */+ const char *zMaster, /* If not NULL, the master journal name */+ int noSync /* True to omit the xSync on the db file */+){+ int rc = SQLITE_OK; /* Return code */++ assert( pPager->eState==PAGER_WRITER_LOCKED+ || pPager->eState==PAGER_WRITER_CACHEMOD+ || pPager->eState==PAGER_WRITER_DBMOD+ || pPager->eState==PAGER_ERROR+ );+ assert( assert_pager_state(pPager) );++ /* If a prior error occurred, report that error again. */+ if( NEVER(pPager->errCode) ) return pPager->errCode;++ PAGERTRACE(("DATABASE SYNC: File=%s zMaster=%s nSize=%d\n", + pPager->zFilename, zMaster, pPager->dbSize));++ /* If no database changes have been made, return early. */+ if( pPager->eState<PAGER_WRITER_CACHEMOD ) return SQLITE_OK;++ {+ if( pagerUseWal(pPager) ){+ PgHdr *pList = sqlite3PcacheDirtyList(pPager->pPCache);+ PgHdr *pPageOne = 0;+ if( pList==0 ){+ /* Must have at least one page for the WAL commit flag.+ ** Ticket [2d1a5c67dfc2363e44f29d9bbd57f] 2011-05-18 */+ rc = sqlite3PagerGet(pPager, 1, &pPageOne);+ pList = pPageOne;+ pList->pDirty = 0;+ }+ assert( rc==SQLITE_OK );+ if( ALWAYS(pList) ){+ rc = pagerWalFrames(pPager, pList, pPager->dbSize, 1);+ }+ sqlite3PagerUnref(pPageOne);+ if( rc==SQLITE_OK ){+ sqlite3PcacheCleanAll(pPager->pPCache);+ }+ }else{+ /* The following block updates the change-counter. Exactly how it+ ** does this depends on whether or not the atomic-update optimization+ ** was enabled at compile time, and if this transaction meets the + ** runtime criteria to use the operation: + **+ ** * The file-system supports the atomic-write property for+ ** blocks of size page-size, and + ** * This commit is not part of a multi-file transaction, and+ ** * Exactly one page has been modified and store in the journal file.+ **+ ** If the optimization was not enabled at compile time, then the+ ** pager_incr_changecounter() function is called to update the change+ ** counter in 'indirect-mode'. If the optimization is compiled in but+ ** is not applicable to this transaction, call sqlite3JournalCreate()+ ** to make sure the journal file has actually been created, then call+ ** pager_incr_changecounter() to update the change-counter in indirect+ ** mode. + **+ ** Otherwise, if the optimization is both enabled and applicable,+ ** then call pager_incr_changecounter() to update the change-counter+ ** in 'direct' mode. In this case the journal file will never be+ ** created for this transaction.+ */+ #ifdef SQLITE_ENABLE_ATOMIC_WRITE+ PgHdr *pPg;+ assert( isOpen(pPager->jfd) + || pPager->journalMode==PAGER_JOURNALMODE_OFF + || pPager->journalMode==PAGER_JOURNALMODE_WAL + );+ if( !zMaster && isOpen(pPager->jfd) + && pPager->journalOff==jrnlBufferSize(pPager) + && pPager->dbSize>=pPager->dbOrigSize+ && (0==(pPg = sqlite3PcacheDirtyList(pPager->pPCache)) || 0==pPg->pDirty)+ ){+ /* Update the db file change counter via the direct-write method. The + ** following call will modify the in-memory representation of page 1 + ** to include the updated change counter and then write page 1 + ** directly to the database file. Because of the atomic-write + ** property of the host file-system, this is safe.+ */+ rc = pager_incr_changecounter(pPager, 1);+ }else{+ rc = sqlite3JournalCreate(pPager->jfd);+ if( rc==SQLITE_OK ){+ rc = pager_incr_changecounter(pPager, 0);+ }+ }+ #else+ rc = pager_incr_changecounter(pPager, 0);+ #endif+ if( rc!=SQLITE_OK ) goto commit_phase_one_exit;+ + /* Write the master journal name into the journal file. If a master + ** journal file name has already been written to the journal file, + ** or if zMaster is NULL (no master journal), then this call is a no-op.+ */+ rc = writeMasterJournal(pPager, zMaster);+ if( rc!=SQLITE_OK ) goto commit_phase_one_exit;+ + /* Sync the journal file and write all dirty pages to the database.+ ** If the atomic-update optimization is being used, this sync will not + ** create the journal file or perform any real IO.+ **+ ** Because the change-counter page was just modified, unless the+ ** atomic-update optimization is used it is almost certain that the+ ** journal requires a sync here. However, in locking_mode=exclusive+ ** on a system under memory pressure it is just possible that this is + ** not the case. In this case it is likely enough that the redundant+ ** xSync() call will be changed to a no-op by the OS anyhow. + */+ rc = syncJournal(pPager, 0);+ if( rc!=SQLITE_OK ) goto commit_phase_one_exit;+ + rc = pager_write_pagelist(pPager,sqlite3PcacheDirtyList(pPager->pPCache));+ if( rc!=SQLITE_OK ){+ assert( rc!=SQLITE_IOERR_BLOCKED );+ goto commit_phase_one_exit;+ }+ sqlite3PcacheCleanAll(pPager->pPCache);++ /* If the file on disk is smaller than the database image, use + ** pager_truncate to grow the file here. This can happen if the database+ ** image was extended as part of the current transaction and then the+ ** last page in the db image moved to the free-list. In this case the+ ** last page is never written out to disk, leaving the database file+ ** undersized. Fix this now if it is the case. */+ if( pPager->dbSize>pPager->dbFileSize ){+ Pgno nNew = pPager->dbSize - (pPager->dbSize==PAGER_MJ_PGNO(pPager));+ assert( pPager->eState==PAGER_WRITER_DBMOD );+ rc = pager_truncate(pPager, nNew);+ if( rc!=SQLITE_OK ) goto commit_phase_one_exit;+ }+ + /* Finally, sync the database file. */+ if( !noSync ){+ rc = sqlite3PagerSync(pPager, zMaster);+ }+ IOTRACE(("DBSYNC %p\n", pPager))+ }+ }++commit_phase_one_exit:+ if( rc==SQLITE_OK && !pagerUseWal(pPager) ){+ pPager->eState = PAGER_WRITER_FINISHED;+ }+ return rc;+}+++/*+** When this function is called, the database file has been completely+** updated to reflect the changes made by the current transaction and+** synced to disk. The journal file still exists in the file-system +** though, and if a failure occurs at this point it will eventually+** be used as a hot-journal and the current transaction rolled back.+**+** This function finalizes the journal file, either by deleting, +** truncating or partially zeroing it, so that it cannot be used +** for hot-journal rollback. Once this is done the transaction is+** irrevocably committed.+**+** If an error occurs, an IO error code is returned and the pager+** moves into the error state. Otherwise, SQLITE_OK is returned.+*/+SQLITE_PRIVATE int sqlite3PagerCommitPhaseTwo(Pager *pPager){+ int rc = SQLITE_OK; /* Return code */++ /* This routine should not be called if a prior error has occurred.+ ** But if (due to a coding error elsewhere in the system) it does get+ ** called, just return the same error code without doing anything. */+ if( NEVER(pPager->errCode) ) return pPager->errCode;++ assert( pPager->eState==PAGER_WRITER_LOCKED+ || pPager->eState==PAGER_WRITER_FINISHED+ || (pagerUseWal(pPager) && pPager->eState==PAGER_WRITER_CACHEMOD)+ );+ assert( assert_pager_state(pPager) );++ /* An optimization. If the database was not actually modified during+ ** this transaction, the pager is running in exclusive-mode and is+ ** using persistent journals, then this function is a no-op.+ **+ ** The start of the journal file currently contains a single journal + ** header with the nRec field set to 0. If such a journal is used as+ ** a hot-journal during hot-journal rollback, 0 changes will be made+ ** to the database file. So there is no need to zero the journal + ** header. Since the pager is in exclusive mode, there is no need+ ** to drop any locks either.+ */+ if( pPager->eState==PAGER_WRITER_LOCKED + && pPager->exclusiveMode + && pPager->journalMode==PAGER_JOURNALMODE_PERSIST+ ){+ assert( pPager->journalOff==JOURNAL_HDR_SZ(pPager) || !pPager->journalOff );+ pPager->eState = PAGER_READER;+ return SQLITE_OK;+ }++ PAGERTRACE(("COMMIT %d\n", PAGERID(pPager)));+ pPager->iDataVersion++;+ rc = pager_end_transaction(pPager, pPager->setMaster, 1);+ return pager_error(pPager, rc);+}++/*+** If a write transaction is open, then all changes made within the +** transaction are reverted and the current write-transaction is closed.+** The pager falls back to PAGER_READER state if successful, or PAGER_ERROR+** state if an error occurs.+**+** If the pager is already in PAGER_ERROR state when this function is called,+** it returns Pager.errCode immediately. No work is performed in this case.+**+** Otherwise, in rollback mode, this function performs two functions:+**+** 1) It rolls back the journal file, restoring all database file and +** in-memory cache pages to the state they were in when the transaction+** was opened, and+**+** 2) It finalizes the journal file, so that it is not used for hot+** rollback at any point in the future.+**+** Finalization of the journal file (task 2) is only performed if the +** rollback is successful.+**+** In WAL mode, all cache-entries containing data modified within the+** current transaction are either expelled from the cache or reverted to+** their pre-transaction state by re-reading data from the database or+** WAL files. The WAL transaction is then closed.+*/+SQLITE_PRIVATE int sqlite3PagerRollback(Pager *pPager){+ int rc = SQLITE_OK; /* Return code */+ PAGERTRACE(("ROLLBACK %d\n", PAGERID(pPager)));++ /* PagerRollback() is a no-op if called in READER or OPEN state. If+ ** the pager is already in the ERROR state, the rollback is not + ** attempted here. Instead, the error code is returned to the caller.+ */+ assert( assert_pager_state(pPager) );+ if( pPager->eState==PAGER_ERROR ) return pPager->errCode;+ if( pPager->eState<=PAGER_READER ) return SQLITE_OK;++ if( pagerUseWal(pPager) ){+ int rc2;+ rc = sqlite3PagerSavepoint(pPager, SAVEPOINT_ROLLBACK, -1);+ rc2 = pager_end_transaction(pPager, pPager->setMaster, 0);+ if( rc==SQLITE_OK ) rc = rc2;+ }else if( !isOpen(pPager->jfd) || pPager->eState==PAGER_WRITER_LOCKED ){+ int eState = pPager->eState;+ rc = pager_end_transaction(pPager, 0, 0);+ if( eState>PAGER_WRITER_LOCKED ){+ /* This can happen using journal_mode=off. Move the pager to the error + ** state to indicate that the contents of the cache may not be trusted.+ ** Any active readers will get SQLITE_ABORT.+ */+ pPager->errCode = SQLITE_ABORT;+ pPager->eState = PAGER_ERROR;+ return rc;+ }+ }else{+ rc = pager_playback(pPager, 0);+ }++ assert( pPager->eState==PAGER_READER || rc!=SQLITE_OK );+ assert( rc==SQLITE_OK || rc==SQLITE_FULL || rc==SQLITE_CORRUPT+ || rc==SQLITE_NOMEM || (rc&0xFF)==SQLITE_IOERR + || rc==SQLITE_CANTOPEN+ );++ /* If an error occurs during a ROLLBACK, we can no longer trust the pager+ ** cache. So call pager_error() on the way out to make any error persistent.+ */+ return pager_error(pPager, rc);+}++/*+** Return TRUE if the database file is opened read-only. Return FALSE+** if the database is (in theory) writable.+*/+SQLITE_PRIVATE u8 sqlite3PagerIsreadonly(Pager *pPager){+ return pPager->readOnly;+}++#ifdef SQLITE_DEBUG+/*+** Return the sum of the reference counts for all pages held by pPager.+*/+SQLITE_PRIVATE int sqlite3PagerRefcount(Pager *pPager){+ return sqlite3PcacheRefCount(pPager->pPCache);+}+#endif++#if 0+/*+** Return the approximate number of bytes of memory currently+** used by the pager and its associated cache.+*/+SQLITE_PRIVATE int sqlite3PagerMemUsed(Pager *pPager){+ int perPageSize = pPager->pageSize + pPager->nExtra + sizeof(PgHdr)+ + 5*sizeof(void*);+ return perPageSize*sqlite3PcachePagecount(pPager->pPCache)+ + sqlite3MallocSize(pPager)+ + pPager->pageSize;+}+#endif++/*+** Return the number of references to the specified page.+*/+SQLITE_PRIVATE int sqlite3PagerPageRefcount(DbPage *pPage){+ return sqlite3PcachePageRefcount(pPage);+}++#ifdef SQLITE_TEST+/*+** This routine is used for testing and analysis only.+*/+SQLITE_PRIVATE int *sqlite3PagerStats(Pager *pPager){+ static int a[11];+ a[0] = sqlite3PcacheRefCount(pPager->pPCache);+ a[1] = sqlite3PcachePagecount(pPager->pPCache);+ a[2] = sqlite3PcacheGetCachesize(pPager->pPCache);+ a[3] = pPager->eState==PAGER_OPEN ? -1 : (int) pPager->dbSize;+ a[4] = pPager->eState;+ a[5] = pPager->errCode;+ a[6] = pPager->aStat[PAGER_STAT_HIT];+ a[7] = pPager->aStat[PAGER_STAT_MISS];+ a[8] = 0; /* Used to be pPager->nOvfl */+ a[9] = pPager->nRead;+ a[10] = pPager->aStat[PAGER_STAT_WRITE];+ return a;+}+#endif++#if 0+/*+** Parameter eStat must be either SQLITE_DBSTATUS_CACHE_HIT or+** SQLITE_DBSTATUS_CACHE_MISS. Before returning, *pnVal is incremented by the+** current cache hit or miss count, according to the value of eStat. If the +** reset parameter is non-zero, the cache hit or miss count is zeroed before +** returning.+*/+SQLITE_PRIVATE void sqlite3PagerCacheStat(Pager *pPager, int eStat, int reset, int *pnVal){++ assert( eStat==SQLITE_DBSTATUS_CACHE_HIT+ || eStat==SQLITE_DBSTATUS_CACHE_MISS+ || eStat==SQLITE_DBSTATUS_CACHE_WRITE+ );++ assert( SQLITE_DBSTATUS_CACHE_HIT+1==SQLITE_DBSTATUS_CACHE_MISS );+ assert( SQLITE_DBSTATUS_CACHE_HIT+2==SQLITE_DBSTATUS_CACHE_WRITE );+ assert( PAGER_STAT_HIT==0 && PAGER_STAT_MISS==1 && PAGER_STAT_WRITE==2 );++ *pnVal += pPager->aStat[eStat - SQLITE_DBSTATUS_CACHE_HIT];+ if( reset ){+ pPager->aStat[eStat - SQLITE_DBSTATUS_CACHE_HIT] = 0;+ }+}+#endif++/*+** Check that there are at least nSavepoint savepoints open. If there are+** currently less than nSavepoints open, then open one or more savepoints+** to make up the difference. If the number of savepoints is already+** equal to nSavepoint, then this function is a no-op.+**+** If a memory allocation fails, SQLITE_NOMEM is returned. If an error +** occurs while opening the sub-journal file, then an IO error code is+** returned. Otherwise, SQLITE_OK.+*/+static SQLITE_NOINLINE int pagerOpenSavepoint(Pager *pPager, int nSavepoint){+ int rc = SQLITE_OK; /* Return code */+ int nCurrent = pPager->nSavepoint; /* Current number of savepoints */+ int ii; /* Iterator variable */+ PagerSavepoint *aNew; /* New Pager.aSavepoint array */++ assert( pPager->eState>=PAGER_WRITER_LOCKED );+ assert( assert_pager_state(pPager) );+ assert( nSavepoint>nCurrent && pPager->useJournal );++ /* Grow the Pager.aSavepoint array using realloc(). Return SQLITE_NOMEM+ ** if the allocation fails. Otherwise, zero the new portion in case a + ** malloc failure occurs while populating it in the for(...) loop below.+ */+ aNew = (PagerSavepoint *)sqlite3Realloc(+ pPager->aSavepoint, sizeof(PagerSavepoint)*nSavepoint+ );+ if( !aNew ){+ return SQLITE_NOMEM;+ }+ memset(&aNew[nCurrent], 0, (nSavepoint-nCurrent) * sizeof(PagerSavepoint));+ pPager->aSavepoint = aNew;++ /* Populate the PagerSavepoint structures just allocated. */+ for(ii=nCurrent; ii<nSavepoint; ii++){+ aNew[ii].nOrig = pPager->dbSize;+ if( isOpen(pPager->jfd) && pPager->journalOff>0 ){+ aNew[ii].iOffset = pPager->journalOff;+ }else{+ aNew[ii].iOffset = JOURNAL_HDR_SZ(pPager);+ }+ aNew[ii].iSubRec = pPager->nSubRec;+ aNew[ii].pInSavepoint = sqlite3BitvecCreate(pPager->dbSize);+ if( !aNew[ii].pInSavepoint ){+ return SQLITE_NOMEM;+ }+ if( pagerUseWal(pPager) ){+ sqlite3WalSavepoint(pPager->pWal, aNew[ii].aWalData);+ }+ pPager->nSavepoint = ii+1;+ }+ assert( pPager->nSavepoint==nSavepoint );+ assertTruncateConstraint(pPager);+ return rc;+}+SQLITE_PRIVATE int sqlite3PagerOpenSavepoint(Pager *pPager, int nSavepoint){+ assert( pPager->eState>=PAGER_WRITER_LOCKED );+ assert( assert_pager_state(pPager) );++ if( nSavepoint>pPager->nSavepoint && pPager->useJournal ){+ return pagerOpenSavepoint(pPager, nSavepoint);+ }else{+ return SQLITE_OK;+ }+}+++/*+** This function is called to rollback or release (commit) a savepoint.+** The savepoint to release or rollback need not be the most recently +** created savepoint.+**+** Parameter op is always either SAVEPOINT_ROLLBACK or SAVEPOINT_RELEASE.+** If it is SAVEPOINT_RELEASE, then release and destroy the savepoint with+** index iSavepoint. If it is SAVEPOINT_ROLLBACK, then rollback all changes+** that have occurred since the specified savepoint was created.+**+** The savepoint to rollback or release is identified by parameter +** iSavepoint. A value of 0 means to operate on the outermost savepoint+** (the first created). A value of (Pager.nSavepoint-1) means operate+** on the most recently created savepoint. If iSavepoint is greater than+** (Pager.nSavepoint-1), then this function is a no-op.+**+** If a negative value is passed to this function, then the current+** transaction is rolled back. This is different to calling +** sqlite3PagerRollback() because this function does not terminate+** the transaction or unlock the database, it just restores the +** contents of the database to its original state. +**+** In any case, all savepoints with an index greater than iSavepoint +** are destroyed. If this is a release operation (op==SAVEPOINT_RELEASE),+** then savepoint iSavepoint is also destroyed.+**+** This function may return SQLITE_NOMEM if a memory allocation fails,+** or an IO error code if an IO error occurs while rolling back a +** savepoint. If no errors occur, SQLITE_OK is returned.+*/ +SQLITE_PRIVATE int sqlite3PagerSavepoint(Pager *pPager, int op, int iSavepoint){+ int rc = pPager->errCode; /* Return code */++ assert( op==SAVEPOINT_RELEASE || op==SAVEPOINT_ROLLBACK );+ assert( iSavepoint>=0 || op==SAVEPOINT_ROLLBACK );++ if( rc==SQLITE_OK && iSavepoint<pPager->nSavepoint ){+ int ii; /* Iterator variable */+ int nNew; /* Number of remaining savepoints after this op. */++ /* Figure out how many savepoints will still be active after this+ ** operation. Store this value in nNew. Then free resources associated + ** with any savepoints that are destroyed by this operation.+ */+ nNew = iSavepoint + (( op==SAVEPOINT_RELEASE ) ? 0 : 1);+ for(ii=nNew; ii<pPager->nSavepoint; ii++){+ sqlite3BitvecDestroy(pPager->aSavepoint[ii].pInSavepoint);+ }+ pPager->nSavepoint = nNew;++ /* If this is a release of the outermost savepoint, truncate + ** the sub-journal to zero bytes in size. */+ if( op==SAVEPOINT_RELEASE ){+ if( nNew==0 && isOpen(pPager->sjfd) ){+ /* Only truncate if it is an in-memory sub-journal. */+ if( sqlite3IsMemJournal(pPager->sjfd) ){+ rc = sqlite3OsTruncate(pPager->sjfd, 0);+ assert( rc==SQLITE_OK );+ }+ pPager->nSubRec = 0;+ }+ }+ /* Else this is a rollback operation, playback the specified savepoint.+ ** If this is a temp-file, it is possible that the journal file has+ ** not yet been opened. In this case there have been no changes to+ ** the database file, so the playback operation can be skipped.+ */+ else if( pagerUseWal(pPager) || isOpen(pPager->jfd) ){+ PagerSavepoint *pSavepoint = (nNew==0)?0:&pPager->aSavepoint[nNew-1];+ rc = pagerPlaybackSavepoint(pPager, pSavepoint);+ assert(rc!=SQLITE_DONE);+ }+ }++ return rc;+}++/*+** Return the full pathname of the database file.+**+** Except, if the pager is in-memory only, then return an empty string if+** nullIfMemDb is true. This routine is called with nullIfMemDb==1 when+** used to report the filename to the user, for compatibility with legacy+** behavior. But when the Btree needs to know the filename for matching to+** shared cache, it uses nullIfMemDb==0 so that in-memory databases can+** participate in shared-cache.+*/+SQLITE_PRIVATE const char *sqlite3PagerFilename(Pager *pPager, int nullIfMemDb){+ return (nullIfMemDb && pPager->memDb) ? "" : pPager->zFilename;+}++/*+** Return the VFS structure for the pager.+*/+SQLITE_PRIVATE const sqlite3_vfs *sqlite3PagerVfs(Pager *pPager){+ return pPager->pVfs;+}++#ifdef SQLITE_DIRECT_OVERFLOW_READ+/*+** Return the file handle for the database file associated+** with the pager. This might return NULL if the file has+** not yet been opened.+*/+SQLITE_PRIVATE sqlite3_file *sqlite3PagerFile(Pager *pPager){+ return pPager->fd;+}+#endif++/*+** Return the full pathname of the journal file.+*/+SQLITE_PRIVATE const char *sqlite3PagerJournalname(Pager *pPager){+ return pPager->zJournal;+}++/*+** Return true if fsync() calls are disabled for this pager. Return FALSE+** if fsync()s are executed normally.+*/+SQLITE_PRIVATE int sqlite3PagerNosync(Pager *pPager){+ return pPager->noSync;+}++#ifdef SQLITE_HAS_CODEC+/*+** Set or retrieve the codec for this pager+*/+SQLITE_PRIVATE void sqlite3PagerSetCodec(+ Pager *pPager,+ void *(*xCodec)(void*,void*,Pgno,int),+ void (*xCodecSizeChng)(void*,int,int),+ void (*xCodecFree)(void*),+ void *pCodec+){+ if( pPager->xCodecFree ) pPager->xCodecFree(pPager->pCodec);+ pPager->xCodec = pPager->memDb ? 0 : xCodec;+ pPager->xCodecSizeChng = xCodecSizeChng;+ pPager->xCodecFree = xCodecFree;+ pPager->pCodec = pCodec;+ pagerReportSize(pPager);+}+SQLITE_PRIVATE void *sqlite3PagerGetCodec(Pager *pPager){+ return pPager->pCodec;+}++/*+** This function is called by the wal module when writing page content+** into the log file.+**+** This function returns a pointer to a buffer containing the encrypted+** page content. If a malloc fails, this function may return NULL.+*/+SQLITE_PRIVATE void *sqlite3PagerCodec(PgHdr *pPg){+ void *aData = 0;+ CODEC2(pPg->pPager, pPg->pData, pPg->pgno, 6, return 0, aData);+ return aData;+}++/*+** Return the current pager state+*/+SQLITE_PRIVATE int sqlite3PagerState(Pager *pPager){+ return pPager->eState;+}+#endif /* SQLITE_HAS_CODEC */++#ifndef SQLITE_OMIT_AUTOVACUUM+/*+** Move the page pPg to location pgno in the file.+**+** There must be no references to the page previously located at+** pgno (which we call pPgOld) though that page is allowed to be+** in cache. If the page previously located at pgno is not already+** in the rollback journal, it is not put there by by this routine.+**+** References to the page pPg remain valid. Updating any+** meta-data associated with pPg (i.e. data stored in the nExtra bytes+** allocated along with the page) is the responsibility of the caller.+**+** A transaction must be active when this routine is called. It used to be+** required that a statement transaction was not active, but this restriction+** has been removed (CREATE INDEX needs to move a page when a statement+** transaction is active).+**+** If the fourth argument, isCommit, is non-zero, then this page is being+** moved as part of a database reorganization just before the transaction +** is being committed. In this case, it is guaranteed that the database page +** pPg refers to will not be written to again within this transaction.+**+** This function may return SQLITE_NOMEM or an IO error code if an error+** occurs. Otherwise, it returns SQLITE_OK.+*/+SQLITE_PRIVATE int sqlite3PagerMovepage(Pager *pPager, DbPage *pPg, Pgno pgno, int isCommit){+ PgHdr *pPgOld; /* The page being overwritten. */+ Pgno needSyncPgno = 0; /* Old value of pPg->pgno, if sync is required */+ int rc; /* Return code */++ assert( pPg->nRef>0 );+ assert( pPager->eState==PAGER_WRITER_CACHEMOD+ || pPager->eState==PAGER_WRITER_DBMOD+ );+ assert( assert_pager_state(pPager) );++ /* If the page being moved is dirty and has not been saved by the latest+ ** savepoint, then save the current contents of the page into the + ** sub-journal now. This is required to handle the following scenario:+ **+ ** BEGIN;+ ** <journal page X, then modify it in memory>+ ** SAVEPOINT one;+ ** <Move page X to location Y>+ ** ROLLBACK TO one;+ **+ ** If page X were not written to the sub-journal here, it would not+ ** be possible to restore its contents when the "ROLLBACK TO one"+ ** statement were is processed.+ **+ ** subjournalPage() may need to allocate space to store pPg->pgno into+ ** one or more savepoint bitvecs. This is the reason this function+ ** may return SQLITE_NOMEM.+ */+ if( (pPg->flags & PGHDR_DIRTY)!=0+ && SQLITE_OK!=(rc = subjournalPageIfRequired(pPg))+ ){+ return rc;+ }++ PAGERTRACE(("MOVE %d page %d (needSync=%d) moves to %d\n", + PAGERID(pPager), pPg->pgno, (pPg->flags&PGHDR_NEED_SYNC)?1:0, pgno));+ IOTRACE(("MOVE %p %d %d\n", pPager, pPg->pgno, pgno))++ /* If the journal needs to be sync()ed before page pPg->pgno can+ ** be written to, store pPg->pgno in local variable needSyncPgno.+ **+ ** If the isCommit flag is set, there is no need to remember that+ ** the journal needs to be sync()ed before database page pPg->pgno + ** can be written to. The caller has already promised not to write to it.+ */+ if( (pPg->flags&PGHDR_NEED_SYNC) && !isCommit ){+ needSyncPgno = pPg->pgno;+ assert( pPager->journalMode==PAGER_JOURNALMODE_OFF ||+ pageInJournal(pPager, pPg) || pPg->pgno>pPager->dbOrigSize );+ assert( pPg->flags&PGHDR_DIRTY );+ }++ /* If the cache contains a page with page-number pgno, remove it+ ** from its hash chain. Also, if the PGHDR_NEED_SYNC flag was set for + ** page pgno before the 'move' operation, it needs to be retained + ** for the page moved there.+ */+ pPg->flags &= ~PGHDR_NEED_SYNC;+ pPgOld = sqlite3PagerLookup(pPager, pgno);+ assert( !pPgOld || pPgOld->nRef==1 );+ if( pPgOld ){+ pPg->flags |= (pPgOld->flags&PGHDR_NEED_SYNC);+ sqlite3PcacheDrop(pPgOld);+ }++ sqlite3PcacheMove(pPg, pgno);+ sqlite3PcacheMakeDirty(pPg);++ if( needSyncPgno ){+ /* If needSyncPgno is non-zero, then the journal file needs to be + ** sync()ed before any data is written to database file page needSyncPgno.+ ** Currently, no such page exists in the page-cache and the + ** "is journaled" bitvec flag has been set. This needs to be remedied by+ ** loading the page into the pager-cache and setting the PGHDR_NEED_SYNC+ ** flag.+ **+ ** If the attempt to load the page into the page-cache fails, (due+ ** to a malloc() or IO failure), clear the bit in the pInJournal[]+ ** array. Otherwise, if the page is loaded and written again in+ ** this transaction, it may be written to the database file before+ ** it is synced into the journal file. This way, it may end up in+ ** the journal file twice, but that is not a problem.+ */+ PgHdr *pPgHdr;+ rc = sqlite3PagerGet(pPager, needSyncPgno, &pPgHdr);+ if( rc!=SQLITE_OK ){+ if( needSyncPgno<=pPager->dbOrigSize ){+ assert( pPager->pTmpSpace!=0 );+ sqlite3BitvecClear(pPager->pInJournal, needSyncPgno, pPager->pTmpSpace);+ }+ return rc;+ }+ pPgHdr->flags |= PGHDR_NEED_SYNC;+ sqlite3PcacheMakeDirty(pPgHdr);+ sqlite3PagerUnrefNotNull(pPgHdr);+ }++ return SQLITE_OK;+}+#endif++/*+** The page handle passed as the first argument refers to a dirty page +** with a page number other than iNew. This function changes the page's +** page number to iNew and sets the value of the PgHdr.flags field to +** the value passed as the third parameter.+*/+SQLITE_PRIVATE void sqlite3PagerRekey(DbPage *pPg, Pgno iNew, u16 flags){+ assert( pPg->pgno!=iNew );+ pPg->flags = flags;+ sqlite3PcacheMove(pPg, iNew);+}++/*+** Return a pointer to the data for the specified page.+*/+SQLITE_PRIVATE void *sqlite3PagerGetData(DbPage *pPg){+ assert( pPg->nRef>0 || pPg->pPager->memDb );+ return pPg->pData;+}++/*+** Return a pointer to the Pager.nExtra bytes of "extra" space +** allocated along with the specified page.+*/+SQLITE_PRIVATE void *sqlite3PagerGetExtra(DbPage *pPg){+ return pPg->pExtra;+}++#if 0+/*+** Get/set the locking-mode for this pager. Parameter eMode must be one+** of PAGER_LOCKINGMODE_QUERY, PAGER_LOCKINGMODE_NORMAL or +** PAGER_LOCKINGMODE_EXCLUSIVE. If the parameter is not _QUERY, then+** the locking-mode is set to the value specified.+**+** The returned value is either PAGER_LOCKINGMODE_NORMAL or+** PAGER_LOCKINGMODE_EXCLUSIVE, indicating the current (possibly updated)+** locking-mode.+*/+SQLITE_PRIVATE int sqlite3PagerLockingMode(Pager *pPager, int eMode){+ assert( eMode==PAGER_LOCKINGMODE_QUERY+ || eMode==PAGER_LOCKINGMODE_NORMAL+ || eMode==PAGER_LOCKINGMODE_EXCLUSIVE );+ assert( PAGER_LOCKINGMODE_QUERY<0 );+ assert( PAGER_LOCKINGMODE_NORMAL>=0 && PAGER_LOCKINGMODE_EXCLUSIVE>=0 );+ assert( pPager->exclusiveMode || 0==sqlite3WalHeapMemory(pPager->pWal) );+ if( eMode>=0 && !pPager->tempFile && !sqlite3WalHeapMemory(pPager->pWal) ){+ pPager->exclusiveMode = (u8)eMode;+ }+ return (int)pPager->exclusiveMode;+}++/*+** Set the journal-mode for this pager. Parameter eMode must be one of:+**+** PAGER_JOURNALMODE_DELETE+** PAGER_JOURNALMODE_TRUNCATE+** PAGER_JOURNALMODE_PERSIST+** PAGER_JOURNALMODE_OFF+** PAGER_JOURNALMODE_MEMORY+** PAGER_JOURNALMODE_WAL+**+** The journalmode is set to the value specified if the change is allowed.+** The change may be disallowed for the following reasons:+**+** * An in-memory database can only have its journal_mode set to _OFF+** or _MEMORY.+**+** * Temporary databases cannot have _WAL journalmode.+**+** The returned indicate the current (possibly updated) journal-mode.+*/+SQLITE_PRIVATE int sqlite3PagerSetJournalMode(Pager *pPager, int eMode){+ u8 eOld = pPager->journalMode; /* Prior journalmode */++#ifdef SQLITE_DEBUG+ /* The print_pager_state() routine is intended to be used by the debugger+ ** only. We invoke it once here to suppress a compiler warning. */+ print_pager_state(pPager);+#endif+++ /* The eMode parameter is always valid */+ assert( eMode==PAGER_JOURNALMODE_DELETE+ || eMode==PAGER_JOURNALMODE_TRUNCATE+ || eMode==PAGER_JOURNALMODE_PERSIST+ || eMode==PAGER_JOURNALMODE_OFF + || eMode==PAGER_JOURNALMODE_WAL + || eMode==PAGER_JOURNALMODE_MEMORY );++ /* This routine is only called from the OP_JournalMode opcode, and+ ** the logic there will never allow a temporary file to be changed+ ** to WAL mode.+ */+ assert( pPager->tempFile==0 || eMode!=PAGER_JOURNALMODE_WAL );++ if( eMode!=eOld ){++ /* Change the journal mode. */+ assert( pPager->eState!=PAGER_ERROR );+ pPager->journalMode = (u8)eMode;++ /* When transistioning from TRUNCATE or PERSIST to any other journal+ ** mode except WAL, unless the pager is in locking_mode=exclusive mode,+ ** delete the journal file.+ */+ assert( (PAGER_JOURNALMODE_TRUNCATE & 5)==1 );+ assert( (PAGER_JOURNALMODE_PERSIST & 5)==1 );+ assert( (PAGER_JOURNALMODE_DELETE & 5)==0 );+ assert( (PAGER_JOURNALMODE_MEMORY & 5)==4 );+ assert( (PAGER_JOURNALMODE_OFF & 5)==0 );+ assert( (PAGER_JOURNALMODE_WAL & 5)==5 );++ assert( isOpen(pPager->fd) || pPager->exclusiveMode );+ if( !pPager->exclusiveMode && (eOld & 5)==1 && (eMode & 1)==0 ){++ /* In this case we would like to delete the journal file. If it is+ ** not possible, then that is not a problem. Deleting the journal file+ ** here is an optimization only.+ **+ ** Before deleting the journal file, obtain a RESERVED lock on the+ ** database file. This ensures that the journal file is not deleted+ ** while it is in use by some other client.+ */+ sqlite3OsClose(pPager->jfd);+ if( pPager->eLock>=RESERVED_LOCK ){+ sqlite3OsDelete(pPager->pVfs, pPager->zJournal, 0);+ }else{+ int rc = SQLITE_OK;+ int state = pPager->eState;+ assert( state==PAGER_OPEN || state==PAGER_READER );+ if( state==PAGER_OPEN ){+ rc = sqlite3PagerSharedLock(pPager);+ }+ if( pPager->eState==PAGER_READER ){+ assert( rc==SQLITE_OK );+ rc = pagerLockDb(pPager, RESERVED_LOCK);+ }+ if( rc==SQLITE_OK ){+ sqlite3OsDelete(pPager->pVfs, pPager->zJournal, 0);+ }+ if( rc==SQLITE_OK && state==PAGER_READER ){+ pagerUnlockDb(pPager, SHARED_LOCK);+ }else if( state==PAGER_OPEN ){+ pager_unlock(pPager);+ }+ assert( state==pPager->eState );+ }+ }else if( eMode==PAGER_JOURNALMODE_OFF ){+ sqlite3OsClose(pPager->jfd);+ }+ }++ /* Return the new journal mode */+ return (int)pPager->journalMode;+}++/*+** Return the current journal mode.+*/+SQLITE_PRIVATE int sqlite3PagerGetJournalMode(Pager *pPager){+ return (int)pPager->journalMode;+}++/*+** Return TRUE if the pager is in a state where it is OK to change the+** journalmode. Journalmode changes can only happen when the database+** is unmodified.+*/+SQLITE_PRIVATE int sqlite3PagerOkToChangeJournalMode(Pager *pPager){+ assert( assert_pager_state(pPager) );+ if( pPager->eState>=PAGER_WRITER_CACHEMOD ) return 0;+ if( NEVER(isOpen(pPager->jfd) && pPager->journalOff>0) ) return 0;+ return 1;+}++/*+** Get/set the size-limit used for persistent journal files.+**+** Setting the size limit to -1 means no limit is enforced.+** An attempt to set a limit smaller than -1 is a no-op.+*/+SQLITE_PRIVATE i64 sqlite3PagerJournalSizeLimit(Pager *pPager, i64 iLimit){+ if( iLimit>=-1 ){+ pPager->journalSizeLimit = iLimit;+ sqlite3WalLimit(pPager->pWal, iLimit);+ }+ return pPager->journalSizeLimit;+}+#endif++#ifndef SQLITE_OMIT_VACUUM+#if 0+/*+** Clear the pager cache.+*/+SQLITE_PRIVATE void sqlite3PagerClearCache(Pager *pPager){+ if( pPager->tempFile==0 ) pager_reset(pPager);+}+#endif+#endif++#ifndef SQLITE_OMIT_WAL+/*+** This function is called when the user invokes "PRAGMA wal_checkpoint",+** "PRAGMA wal_blocking_checkpoint" or calls the sqlite3_wal_checkpoint()+** or wal_blocking_checkpoint() API functions.+**+** Parameter eMode is one of SQLITE_CHECKPOINT_PASSIVE, FULL or RESTART.+*/+SQLITE_PRIVATE int sqlite3PagerCheckpoint(Pager *pPager, int eMode, int *pnLog, int *pnCkpt){+ int rc = SQLITE_OK;+ if( pPager->pWal ){+ rc = sqlite3WalCheckpoint(pPager->pWal, eMode,+ (eMode==SQLITE_CHECKPOINT_PASSIVE ? 0 : pPager->xBusyHandler),+ pPager->pBusyHandlerArg,+ pPager->ckptSyncFlags, pPager->pageSize, (u8 *)pPager->pTmpSpace,+ pnLog, pnCkpt+ );+ }+ return rc;+}++#if 0+SQLITE_PRIVATE int sqlite3PagerWalCallback(Pager *pPager){+ return sqlite3WalCallback(pPager->pWal);+}+#endif++/*+** Return true if the underlying VFS for the given pager supports the+** primitives necessary for write-ahead logging.+*/+SQLITE_PRIVATE int sqlite3PagerWalSupported(Pager *pPager){+ const sqlite3_io_methods *pMethods = pPager->fd->pMethods;+ return pPager->exclusiveMode || (pMethods->iVersion>=2 && pMethods->xShmMap);+}++/*+** Attempt to take an exclusive lock on the database file. If a PENDING lock+** is obtained instead, immediately release it.+*/+static int pagerExclusiveLock(Pager *pPager){+ int rc; /* Return code */++ assert( pPager->eLock==SHARED_LOCK || pPager->eLock==EXCLUSIVE_LOCK );+ rc = pagerLockDb(pPager, EXCLUSIVE_LOCK);+ if( rc!=SQLITE_OK ){+ /* If the attempt to grab the exclusive lock failed, release the + ** pending lock that may have been obtained instead. */+ pagerUnlockDb(pPager, SHARED_LOCK);+ }++ return rc;+}++/*+** Call sqlite3WalOpen() to open the WAL handle. If the pager is in +** exclusive-locking mode when this function is called, take an EXCLUSIVE+** lock on the database file and use heap-memory to store the wal-index+** in. Otherwise, use the normal shared-memory.+*/+static int pagerOpenWal(Pager *pPager){+ int rc = SQLITE_OK;++ assert( pPager->pWal==0 && pPager->tempFile==0 );+ assert( pPager->eLock==SHARED_LOCK || pPager->eLock==EXCLUSIVE_LOCK );++ /* If the pager is already in exclusive-mode, the WAL module will use + ** heap-memory for the wal-index instead of the VFS shared-memory + ** implementation. Take the exclusive lock now, before opening the WAL+ ** file, to make sure this is safe.+ */+ if( pPager->exclusiveMode ){+ rc = pagerExclusiveLock(pPager);+ }++ /* Open the connection to the log file. If this operation fails, + ** (e.g. due to malloc() failure), return an error code.+ */+ if( rc==SQLITE_OK ){+ rc = sqlite3WalOpen(pPager->pVfs,+ pPager->fd, pPager->zWal, pPager->exclusiveMode,+ pPager->journalSizeLimit, &pPager->pWal+ );+ }+ pagerFixMaplimit(pPager);++ return rc;+}+++/*+** The caller must be holding a SHARED lock on the database file to call+** this function.+**+** If the pager passed as the first argument is open on a real database+** file (not a temp file or an in-memory database), and the WAL file+** is not already open, make an attempt to open it now. If successful,+** return SQLITE_OK. If an error occurs or the VFS used by the pager does +** not support the xShmXXX() methods, return an error code. *pbOpen is+** not modified in either case.+**+** If the pager is open on a temp-file (or in-memory database), or if+** the WAL file is already open, set *pbOpen to 1 and return SQLITE_OK+** without doing anything.+*/+SQLITE_PRIVATE int sqlite3PagerOpenWal(+ Pager *pPager, /* Pager object */+ int *pbOpen /* OUT: Set to true if call is a no-op */+){+ int rc = SQLITE_OK; /* Return code */++ assert( assert_pager_state(pPager) );+ assert( pPager->eState==PAGER_OPEN || pbOpen );+ assert( pPager->eState==PAGER_READER || !pbOpen );+ assert( pbOpen==0 || *pbOpen==0 );+ assert( pbOpen!=0 || (!pPager->tempFile && !pPager->pWal) );++ if( !pPager->tempFile && !pPager->pWal ){+ if( !sqlite3PagerWalSupported(pPager) ) return SQLITE_CANTOPEN;++ /* Close any rollback journal previously open */+ sqlite3OsClose(pPager->jfd);++ rc = pagerOpenWal(pPager);+ if( rc==SQLITE_OK ){+ pPager->journalMode = PAGER_JOURNALMODE_WAL;+ pPager->eState = PAGER_OPEN;+ }+ }else{+ *pbOpen = 1;+ }++ return rc;+}++/*+** This function is called to close the connection to the log file prior+** to switching from WAL to rollback mode.+**+** Before closing the log file, this function attempts to take an +** EXCLUSIVE lock on the database file. If this cannot be obtained, an+** error (SQLITE_BUSY) is returned and the log connection is not closed.+** If successful, the EXCLUSIVE lock is not released before returning.+*/+#if 0+SQLITE_PRIVATE int sqlite3PagerCloseWal(Pager *pPager){+ int rc = SQLITE_OK;++ assert( pPager->journalMode==PAGER_JOURNALMODE_WAL );++ /* If the log file is not already open, but does exist in the file-system,+ ** it may need to be checkpointed before the connection can switch to+ ** rollback mode. Open it now so this can happen.+ */+ if( !pPager->pWal ){+ int logexists = 0;+ rc = pagerLockDb(pPager, SHARED_LOCK);+ if( rc==SQLITE_OK ){+ rc = sqlite3OsAccess(+ pPager->pVfs, pPager->zWal, SQLITE_ACCESS_EXISTS, &logexists+ );+ }+ if( rc==SQLITE_OK && logexists ){+ rc = pagerOpenWal(pPager);+ }+ }+ + /* Checkpoint and close the log. Because an EXCLUSIVE lock is held on+ ** the database file, the log and log-summary files will be deleted.+ */+ if( rc==SQLITE_OK && pPager->pWal ){+ rc = pagerExclusiveLock(pPager);+ if( rc==SQLITE_OK ){+ rc = sqlite3WalClose(pPager->pWal, pPager->ckptSyncFlags,+ pPager->pageSize, (u8*)pPager->pTmpSpace);+ pPager->pWal = 0;+ pagerFixMaplimit(pPager);+ }+ }+ return rc;+}+#endif+#endif /* !SQLITE_OMIT_WAL */++#ifdef SQLITE_ENABLE_ZIPVFS+/*+** A read-lock must be held on the pager when this function is called. If+** the pager is in WAL mode and the WAL file currently contains one or more+** frames, return the size in bytes of the page images stored within the+** WAL frames. Otherwise, if this is not a WAL database or the WAL file+** is empty, return 0.+*/+SQLITE_PRIVATE int sqlite3PagerWalFramesize(Pager *pPager){+ assert( pPager->eState>=PAGER_READER );+ return sqlite3WalFramesize(pPager->pWal);+}+#endif+++#endif /* SQLITE_OMIT_DISKIO */++/************** End of pager.c ***********************************************/+/************** Begin file wal.c *********************************************/+/*+** 2010 February 1+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file contains the implementation of a write-ahead log (WAL) used in +** "journal_mode=WAL" mode.+**+** WRITE-AHEAD LOG (WAL) FILE FORMAT+**+** A WAL file consists of a header followed by zero or more "frames".+** Each frame records the revised content of a single page from the+** database file. All changes to the database are recorded by writing+** frames into the WAL. Transactions commit when a frame is written that+** contains a commit marker. A single WAL can and usually does record +** multiple transactions. Periodically, the content of the WAL is+** transferred back into the database file in an operation called a+** "checkpoint".+**+** A single WAL file can be used multiple times. In other words, the+** WAL can fill up with frames and then be checkpointed and then new+** frames can overwrite the old ones. A WAL always grows from beginning+** toward the end. Checksums and counters attached to each frame are+** used to determine which frames within the WAL are valid and which+** are leftovers from prior checkpoints.+**+** The WAL header is 32 bytes in size and consists of the following eight+** big-endian 32-bit unsigned integer values:+**+** 0: Magic number. 0x377f0682 or 0x377f0683+** 4: File format version. Currently 3007000+** 8: Database page size. Example: 1024+** 12: Checkpoint sequence number+** 16: Salt-1, random integer incremented with each checkpoint+** 20: Salt-2, a different random integer changing with each ckpt+** 24: Checksum-1 (first part of checksum for first 24 bytes of header).+** 28: Checksum-2 (second part of checksum for first 24 bytes of header).+**+** Immediately following the wal-header are zero or more frames. Each+** frame consists of a 24-byte frame-header followed by a <page-size> bytes+** of page data. The frame-header is six big-endian 32-bit unsigned +** integer values, as follows:+**+** 0: Page number.+** 4: For commit records, the size of the database image in pages +** after the commit. For all other records, zero.+** 8: Salt-1 (copied from the header)+** 12: Salt-2 (copied from the header)+** 16: Checksum-1.+** 20: Checksum-2.+**+** A frame is considered valid if and only if the following conditions are+** true:+**+** (1) The salt-1 and salt-2 values in the frame-header match+** salt values in the wal-header+**+** (2) The checksum values in the final 8 bytes of the frame-header+** exactly match the checksum computed consecutively on the+** WAL header and the first 8 bytes and the content of all frames+** up to and including the current frame.+**+** The checksum is computed using 32-bit big-endian integers if the+** magic number in the first 4 bytes of the WAL is 0x377f0683 and it+** is computed using little-endian if the magic number is 0x377f0682.+** The checksum values are always stored in the frame header in a+** big-endian format regardless of which byte order is used to compute+** the checksum. The checksum is computed by interpreting the input as+** an even number of unsigned 32-bit integers: x[0] through x[N]. The+** algorithm used for the checksum is as follows:+** +** for i from 0 to n-1 step 2:+** s0 += x[i] + s1;+** s1 += x[i+1] + s0;+** endfor+**+** Note that s0 and s1 are both weighted checksums using fibonacci weights+** in reverse order (the largest fibonacci weight occurs on the first element+** of the sequence being summed.) The s1 value spans all 32-bit +** terms of the sequence whereas s0 omits the final term.+**+** On a checkpoint, the WAL is first VFS.xSync-ed, then valid content of the+** WAL is transferred into the database, then the database is VFS.xSync-ed.+** The VFS.xSync operations serve as write barriers - all writes launched+** before the xSync must complete before any write that launches after the+** xSync begins.+**+** After each checkpoint, the salt-1 value is incremented and the salt-2+** value is randomized. This prevents old and new frames in the WAL from+** being considered valid at the same time and being checkpointing together+** following a crash.+**+** READER ALGORITHM+**+** To read a page from the database (call it page number P), a reader+** first checks the WAL to see if it contains page P. If so, then the+** last valid instance of page P that is a followed by a commit frame+** or is a commit frame itself becomes the value read. If the WAL+** contains no copies of page P that are valid and which are a commit+** frame or are followed by a commit frame, then page P is read from+** the database file.+**+** To start a read transaction, the reader records the index of the last+** valid frame in the WAL. The reader uses this recorded "mxFrame" value+** for all subsequent read operations. New transactions can be appended+** to the WAL, but as long as the reader uses its original mxFrame value+** and ignores the newly appended content, it will see a consistent snapshot+** of the database from a single point in time. This technique allows+** multiple concurrent readers to view different versions of the database+** content simultaneously.+**+** The reader algorithm in the previous paragraphs works correctly, but +** because frames for page P can appear anywhere within the WAL, the+** reader has to scan the entire WAL looking for page P frames. If the+** WAL is large (multiple megabytes is typical) that scan can be slow,+** and read performance suffers. To overcome this problem, a separate+** data structure called the wal-index is maintained to expedite the+** search for frames of a particular page.+** +** WAL-INDEX FORMAT+**+** Conceptually, the wal-index is shared memory, though VFS implementations+** might choose to implement the wal-index using a mmapped file. Because+** the wal-index is shared memory, SQLite does not support journal_mode=WAL +** on a network filesystem. All users of the database must be able to+** share memory.+**+** The wal-index is transient. After a crash, the wal-index can (and should+** be) reconstructed from the original WAL file. In fact, the VFS is required+** to either truncate or zero the header of the wal-index when the last+** connection to it closes. Because the wal-index is transient, it can+** use an architecture-specific format; it does not have to be cross-platform.+** Hence, unlike the database and WAL file formats which store all values+** as big endian, the wal-index can store multi-byte values in the native+** byte order of the host computer.+**+** The purpose of the wal-index is to answer this question quickly: Given+** a page number P and a maximum frame index M, return the index of the +** last frame in the wal before frame M for page P in the WAL, or return+** NULL if there are no frames for page P in the WAL prior to M.+**+** The wal-index consists of a header region, followed by an one or+** more index blocks. +**+** The wal-index header contains the total number of frames within the WAL+** in the mxFrame field.+**+** Each index block except for the first contains information on +** HASHTABLE_NPAGE frames. The first index block contains information on+** HASHTABLE_NPAGE_ONE frames. The values of HASHTABLE_NPAGE_ONE and +** HASHTABLE_NPAGE are selected so that together the wal-index header and+** first index block are the same size as all other index blocks in the+** wal-index.+**+** Each index block contains two sections, a page-mapping that contains the+** database page number associated with each wal frame, and a hash-table +** that allows readers to query an index block for a specific page number.+** The page-mapping is an array of HASHTABLE_NPAGE (or HASHTABLE_NPAGE_ONE+** for the first index block) 32-bit page numbers. The first entry in the +** first index-block contains the database page number corresponding to the+** first frame in the WAL file. The first entry in the second index block+** in the WAL file corresponds to the (HASHTABLE_NPAGE_ONE+1)th frame in+** the log, and so on.+**+** The last index block in a wal-index usually contains less than the full+** complement of HASHTABLE_NPAGE (or HASHTABLE_NPAGE_ONE) page-numbers,+** depending on the contents of the WAL file. This does not change the+** allocated size of the page-mapping array - the page-mapping array merely+** contains unused entries.+**+** Even without using the hash table, the last frame for page P+** can be found by scanning the page-mapping sections of each index block+** starting with the last index block and moving toward the first, and+** within each index block, starting at the end and moving toward the+** beginning. The first entry that equals P corresponds to the frame+** holding the content for that page.+**+** The hash table consists of HASHTABLE_NSLOT 16-bit unsigned integers.+** HASHTABLE_NSLOT = 2*HASHTABLE_NPAGE, and there is one entry in the+** hash table for each page number in the mapping section, so the hash +** table is never more than half full. The expected number of collisions +** prior to finding a match is 1. Each entry of the hash table is an+** 1-based index of an entry in the mapping section of the same+** index block. Let K be the 1-based index of the largest entry in+** the mapping section. (For index blocks other than the last, K will+** always be exactly HASHTABLE_NPAGE (4096) and for the last index block+** K will be (mxFrame%HASHTABLE_NPAGE).) Unused slots of the hash table+** contain a value of 0.+**+** To look for page P in the hash table, first compute a hash iKey on+** P as follows:+**+** iKey = (P * 383) % HASHTABLE_NSLOT+**+** Then start scanning entries of the hash table, starting with iKey+** (wrapping around to the beginning when the end of the hash table is+** reached) until an unused hash slot is found. Let the first unused slot+** be at index iUnused. (iUnused might be less than iKey if there was+** wrap-around.) Because the hash table is never more than half full,+** the search is guaranteed to eventually hit an unused entry. Let +** iMax be the value between iKey and iUnused, closest to iUnused,+** where aHash[iMax]==P. If there is no iMax entry (if there exists+** no hash slot such that aHash[i]==p) then page P is not in the+** current index block. Otherwise the iMax-th mapping entry of the+** current index block corresponds to the last entry that references +** page P.+**+** A hash search begins with the last index block and moves toward the+** first index block, looking for entries corresponding to page P. On+** average, only two or three slots in each index block need to be+** examined in order to either find the last entry for page P, or to+** establish that no such entry exists in the block. Each index block+** holds over 4000 entries. So two or three index blocks are sufficient+** to cover a typical 10 megabyte WAL file, assuming 1K pages. 8 or 10+** comparisons (on average) suffice to either locate a frame in the+** WAL or to establish that the frame does not exist in the WAL. This+** is much faster than scanning the entire 10MB WAL.+**+** Note that entries are added in order of increasing K. Hence, one+** reader might be using some value K0 and a second reader that started+** at a later time (after additional transactions were added to the WAL+** and to the wal-index) might be using a different value K1, where K1>K0.+** Both readers can use the same hash table and mapping section to get+** the correct result. There may be entries in the hash table with+** K>K0 but to the first reader, those entries will appear to be unused+** slots in the hash table and so the first reader will get an answer as+** if no values greater than K0 had ever been inserted into the hash table+** in the first place - which is what reader one wants. Meanwhile, the+** second reader using K1 will see additional values that were inserted+** later, which is exactly what reader two wants. +**+** When a rollback occurs, the value of K is decreased. Hash table entries+** that correspond to frames greater than the new K value are removed+** from the hash table at this point.+*/+#ifndef SQLITE_OMIT_WAL++/* #include "wal.h" */++/*+** Trace output macros+*/+#if defined(SQLITE_TEST) && defined(SQLITE_DEBUG)+SQLITE_PRIVATE int sqlite3WalTrace = 0;+# define WALTRACE(X) if(sqlite3WalTrace) sqlite3DebugPrintf X+#else+# define WALTRACE(X)+#endif++/*+** The maximum (and only) versions of the wal and wal-index formats+** that may be interpreted by this version of SQLite.+**+** If a client begins recovering a WAL file and finds that (a) the checksum+** values in the wal-header are correct and (b) the version field is not+** WAL_MAX_VERSION, recovery fails and SQLite returns SQLITE_CANTOPEN.+**+** Similarly, if a client successfully reads a wal-index header (i.e. the +** checksum test is successful) and finds that the version field is not+** WALINDEX_MAX_VERSION, then no read-transaction is opened and SQLite+** returns SQLITE_CANTOPEN.+*/+#define WAL_MAX_VERSION 3007000+#define WALINDEX_MAX_VERSION 3007000++/*+** Indices of various locking bytes. WAL_NREADER is the number+** of available reader locks and should be at least 3.+*/+#define WAL_WRITE_LOCK 0+#define WAL_ALL_BUT_WRITE 1+#define WAL_CKPT_LOCK 1+#define WAL_RECOVER_LOCK 2+#define WAL_READ_LOCK(I) (3+(I))+#define WAL_NREADER (SQLITE_SHM_NLOCK-3)+++/* Object declarations */+typedef struct WalIndexHdr WalIndexHdr;+typedef struct WalIterator WalIterator;+typedef struct WalCkptInfo WalCkptInfo;+++/*+** The following object holds a copy of the wal-index header content.+**+** The actual header in the wal-index consists of two copies of this+** object.+**+** The szPage value can be any power of 2 between 512 and 32768, inclusive.+** Or it can be 1 to represent a 65536-byte page. The latter case was+** added in 3.7.1 when support for 64K pages was added. +*/+struct WalIndexHdr {+ u32 iVersion; /* Wal-index version */+ u32 unused; /* Unused (padding) field */+ u32 iChange; /* Counter incremented each transaction */+ u8 isInit; /* 1 when initialized */+ u8 bigEndCksum; /* True if checksums in WAL are big-endian */+ u16 szPage; /* Database page size in bytes. 1==64K */+ u32 mxFrame; /* Index of last valid frame in the WAL */+ u32 nPage; /* Size of database in pages */+ u32 aFrameCksum[2]; /* Checksum of last frame in log */+ u32 aSalt[2]; /* Two salt values copied from WAL header */+ u32 aCksum[2]; /* Checksum over all prior fields */+};++/*+** A copy of the following object occurs in the wal-index immediately+** following the second copy of the WalIndexHdr. This object stores+** information used by checkpoint.+**+** nBackfill is the number of frames in the WAL that have been written+** back into the database. (We call the act of moving content from WAL to+** database "backfilling".) The nBackfill number is never greater than+** WalIndexHdr.mxFrame. nBackfill can only be increased by threads+** holding the WAL_CKPT_LOCK lock (which includes a recovery thread).+** However, a WAL_WRITE_LOCK thread can move the value of nBackfill from+** mxFrame back to zero when the WAL is reset.+**+** There is one entry in aReadMark[] for each reader lock. If a reader+** holds read-lock K, then the value in aReadMark[K] is no greater than+** the mxFrame for that reader. The value READMARK_NOT_USED (0xffffffff)+** for any aReadMark[] means that entry is unused. aReadMark[0] is +** a special case; its value is never used and it exists as a place-holder+** to avoid having to offset aReadMark[] indexs by one. Readers holding+** WAL_READ_LOCK(0) always ignore the entire WAL and read all content+** directly from the database.+**+** The value of aReadMark[K] may only be changed by a thread that+** is holding an exclusive lock on WAL_READ_LOCK(K). Thus, the value of+** aReadMark[K] cannot changed while there is a reader is using that mark+** since the reader will be holding a shared lock on WAL_READ_LOCK(K).+**+** The checkpointer may only transfer frames from WAL to database where+** the frame numbers are less than or equal to every aReadMark[] that is+** in use (that is, every aReadMark[j] for which there is a corresponding+** WAL_READ_LOCK(j)). New readers (usually) pick the aReadMark[] with the+** largest value and will increase an unused aReadMark[] to mxFrame if there+** is not already an aReadMark[] equal to mxFrame. The exception to the+** previous sentence is when nBackfill equals mxFrame (meaning that everything+** in the WAL has been backfilled into the database) then new readers+** will choose aReadMark[0] which has value 0 and hence such reader will+** get all their all content directly from the database file and ignore +** the WAL.+**+** Writers normally append new frames to the end of the WAL. However,+** if nBackfill equals mxFrame (meaning that all WAL content has been+** written back into the database) and if no readers are using the WAL+** (in other words, if there are no WAL_READ_LOCK(i) where i>0) then+** the writer will first "reset" the WAL back to the beginning and start+** writing new content beginning at frame 1.+**+** We assume that 32-bit loads are atomic and so no locks are needed in+** order to read from any aReadMark[] entries.+*/+struct WalCkptInfo {+ u32 nBackfill; /* Number of WAL frames backfilled into DB */+ u32 aReadMark[WAL_NREADER]; /* Reader marks */+};+#define READMARK_NOT_USED 0xffffffff+++/* A block of WALINDEX_LOCK_RESERVED bytes beginning at+** WALINDEX_LOCK_OFFSET is reserved for locks. Since some systems+** only support mandatory file-locks, we do not read or write data+** from the region of the file on which locks are applied.+*/+#define WALINDEX_LOCK_OFFSET (sizeof(WalIndexHdr)*2 + sizeof(WalCkptInfo))+#define WALINDEX_LOCK_RESERVED 16+#define WALINDEX_HDR_SIZE (WALINDEX_LOCK_OFFSET+WALINDEX_LOCK_RESERVED)++/* Size of header before each frame in wal */+#define WAL_FRAME_HDRSIZE 24++/* Size of write ahead log header, including checksum. */+/* #define WAL_HDRSIZE 24 */+#define WAL_HDRSIZE 32++/* WAL magic value. Either this value, or the same value with the least+** significant bit also set (WAL_MAGIC | 0x00000001) is stored in 32-bit+** big-endian format in the first 4 bytes of a WAL file.+**+** If the LSB is set, then the checksums for each frame within the WAL+** file are calculated by treating all data as an array of 32-bit +** big-endian words. Otherwise, they are calculated by interpreting +** all data as 32-bit little-endian words.+*/+#define WAL_MAGIC 0x377f0682++/*+** Return the offset of frame iFrame in the write-ahead log file, +** assuming a database page size of szPage bytes. The offset returned+** is to the start of the write-ahead log frame-header.+*/+#define walFrameOffset(iFrame, szPage) ( \+ WAL_HDRSIZE + ((iFrame)-1)*(i64)((szPage)+WAL_FRAME_HDRSIZE) \+)++/*+** An open write-ahead log file is represented by an instance of the+** following object.+*/+struct Wal {+ sqlite3_vfs *pVfs; /* The VFS used to create pDbFd */+ sqlite3_file *pDbFd; /* File handle for the database file */+ sqlite3_file *pWalFd; /* File handle for WAL file */+ u32 iCallback; /* Value to pass to log callback (or 0) */+ i64 mxWalSize; /* Truncate WAL to this size upon reset */+ int nWiData; /* Size of array apWiData */+ int szFirstBlock; /* Size of first block written to WAL file */+ volatile u32 **apWiData; /* Pointer to wal-index content in memory */+ u32 szPage; /* Database page size */+ i16 readLock; /* Which read lock is being held. -1 for none */+ u8 syncFlags; /* Flags to use to sync header writes */+ u8 exclusiveMode; /* Non-zero if connection is in exclusive mode */+ u8 writeLock; /* True if in a write transaction */+ u8 ckptLock; /* True if holding a checkpoint lock */+ u8 readOnly; /* WAL_RDWR, WAL_RDONLY, or WAL_SHM_RDONLY */+ u8 truncateOnCommit; /* True to truncate WAL file on commit */+ u8 syncHeader; /* Fsync the WAL header if true */+ u8 padToSectorBoundary; /* Pad transactions out to the next sector */+ WalIndexHdr hdr; /* Wal-index header for current transaction */+ u32 minFrame; /* Ignore wal frames before this one */+ const char *zWalName; /* Name of WAL file */+ u32 nCkpt; /* Checkpoint sequence counter in the wal-header */+#ifdef SQLITE_DEBUG+ u8 lockError; /* True if a locking error has occurred */+#endif+};++/*+** Candidate values for Wal.exclusiveMode.+*/+#define WAL_NORMAL_MODE 0+#define WAL_EXCLUSIVE_MODE 1 +#define WAL_HEAPMEMORY_MODE 2++/*+** Possible values for WAL.readOnly+*/+#define WAL_RDWR 0 /* Normal read/write connection */+#define WAL_RDONLY 1 /* The WAL file is readonly */+#define WAL_SHM_RDONLY 2 /* The SHM file is readonly */++/*+** Each page of the wal-index mapping contains a hash-table made up of+** an array of HASHTABLE_NSLOT elements of the following type.+*/+typedef u16 ht_slot;++/*+** This structure is used to implement an iterator that loops through+** all frames in the WAL in database page order. Where two or more frames+** correspond to the same database page, the iterator visits only the +** frame most recently written to the WAL (in other words, the frame with+** the largest index).+**+** The internals of this structure are only accessed by:+**+** walIteratorInit() - Create a new iterator,+** walIteratorNext() - Step an iterator,+** walIteratorFree() - Free an iterator.+**+** This functionality is used by the checkpoint code (see walCheckpoint()).+*/+struct WalIterator {+ int iPrior; /* Last result returned from the iterator */+ int nSegment; /* Number of entries in aSegment[] */+ struct WalSegment {+ int iNext; /* Next slot in aIndex[] not yet returned */+ ht_slot *aIndex; /* i0, i1, i2... such that aPgno[iN] ascend */+ u32 *aPgno; /* Array of page numbers. */+ int nEntry; /* Nr. of entries in aPgno[] and aIndex[] */+ int iZero; /* Frame number associated with aPgno[0] */+ } aSegment[1]; /* One for every 32KB page in the wal-index */+};++/*+** Define the parameters of the hash tables in the wal-index file. There+** is a hash-table following every HASHTABLE_NPAGE page numbers in the+** wal-index.+**+** Changing any of these constants will alter the wal-index format and+** create incompatibilities.+*/+#define HASHTABLE_NPAGE 4096 /* Must be power of 2 */+#define HASHTABLE_HASH_1 383 /* Should be prime */+#define HASHTABLE_NSLOT (HASHTABLE_NPAGE*2) /* Must be a power of 2 */++/* +** The block of page numbers associated with the first hash-table in a+** wal-index is smaller than usual. This is so that there is a complete+** hash-table on each aligned 32KB page of the wal-index.+*/+#define HASHTABLE_NPAGE_ONE (HASHTABLE_NPAGE - (WALINDEX_HDR_SIZE/sizeof(u32)))++/* The wal-index is divided into pages of WALINDEX_PGSZ bytes each. */+#define WALINDEX_PGSZ ( \+ sizeof(ht_slot)*HASHTABLE_NSLOT + HASHTABLE_NPAGE*sizeof(u32) \+)++/*+** Obtain a pointer to the iPage'th page of the wal-index. The wal-index+** is broken into pages of WALINDEX_PGSZ bytes. Wal-index pages are+** numbered from zero.+**+** If this call is successful, *ppPage is set to point to the wal-index+** page and SQLITE_OK is returned. If an error (an OOM or VFS error) occurs,+** then an SQLite error code is returned and *ppPage is set to 0.+*/+static int walIndexPage(Wal *pWal, int iPage, volatile u32 **ppPage){+ int rc = SQLITE_OK;++ /* Enlarge the pWal->apWiData[] array if required */+ if( pWal->nWiData<=iPage ){+ int nByte = sizeof(u32*)*(iPage+1);+ volatile u32 **apNew;+ apNew = (volatile u32 **)sqlite3_realloc64((void *)pWal->apWiData, nByte);+ if( !apNew ){+ *ppPage = 0;+ return SQLITE_NOMEM;+ }+ memset((void*)&apNew[pWal->nWiData], 0,+ sizeof(u32*)*(iPage+1-pWal->nWiData));+ pWal->apWiData = apNew;+ pWal->nWiData = iPage+1;+ }++ /* Request a pointer to the required page from the VFS */+ if( pWal->apWiData[iPage]==0 ){+ if( pWal->exclusiveMode==WAL_HEAPMEMORY_MODE ){+ pWal->apWiData[iPage] = (u32 volatile *)sqlite3MallocZero(WALINDEX_PGSZ);+ if( !pWal->apWiData[iPage] ) rc = SQLITE_NOMEM;+ }else{+ rc = sqlite3OsShmMap(pWal->pDbFd, iPage, WALINDEX_PGSZ, + pWal->writeLock, (void volatile **)&pWal->apWiData[iPage]+ );+ if( rc==SQLITE_READONLY ){+ pWal->readOnly |= WAL_SHM_RDONLY;+ rc = SQLITE_OK;+ }+ }+ }++ *ppPage = pWal->apWiData[iPage];+ assert( iPage==0 || *ppPage || rc!=SQLITE_OK );+ return rc;+}++/*+** Return a pointer to the WalCkptInfo structure in the wal-index.+*/+static volatile WalCkptInfo *walCkptInfo(Wal *pWal){+ assert( pWal->nWiData>0 && pWal->apWiData[0] );+ return (volatile WalCkptInfo*)&(pWal->apWiData[0][sizeof(WalIndexHdr)/2]);+}++/*+** Return a pointer to the WalIndexHdr structure in the wal-index.+*/+static volatile WalIndexHdr *walIndexHdr(Wal *pWal){+ assert( pWal->nWiData>0 && pWal->apWiData[0] );+ return (volatile WalIndexHdr*)pWal->apWiData[0];+}++/*+** The argument to this macro must be of type u32. On a little-endian+** architecture, it returns the u32 value that results from interpreting+** the 4 bytes as a big-endian value. On a big-endian architecture, it+** returns the value that would be produced by interpreting the 4 bytes+** of the input value as a little-endian integer.+*/+#define BYTESWAP32(x) ( \+ (((x)&0x000000FF)<<24) + (((x)&0x0000FF00)<<8) \+ + (((x)&0x00FF0000)>>8) + (((x)&0xFF000000)>>24) \+)++/*+** Generate or extend an 8 byte checksum based on the data in +** array aByte[] and the initial values of aIn[0] and aIn[1] (or+** initial values of 0 and 0 if aIn==NULL).+**+** The checksum is written back into aOut[] before returning.+**+** nByte must be a positive multiple of 8.+*/+static void walChecksumBytes(+ int nativeCksum, /* True for native byte-order, false for non-native */+ u8 *a, /* Content to be checksummed */+ int nByte, /* Bytes of content in a[]. Must be a multiple of 8. */+ const u32 *aIn, /* Initial checksum value input */+ u32 *aOut /* OUT: Final checksum value output */+){+ u32 s1, s2;+ u32 *aData = (u32 *)a;+ u32 *aEnd = (u32 *)&a[nByte];++ if( aIn ){+ s1 = aIn[0];+ s2 = aIn[1];+ }else{+ s1 = s2 = 0;+ }++ assert( nByte>=8 );+ assert( (nByte&0x00000007)==0 );++ if( nativeCksum ){+ do {+ s1 += *aData++ + s2;+ s2 += *aData++ + s1;+ }while( aData<aEnd );+ }else{+ do {+ s1 += BYTESWAP32(aData[0]) + s2;+ s2 += BYTESWAP32(aData[1]) + s1;+ aData += 2;+ }while( aData<aEnd );+ }++ aOut[0] = s1;+ aOut[1] = s2;+}++static void walShmBarrier(Wal *pWal){+ if( pWal->exclusiveMode!=WAL_HEAPMEMORY_MODE ){+ sqlite3OsShmBarrier(pWal->pDbFd);+ }+}++/*+** Write the header information in pWal->hdr into the wal-index.+**+** The checksum on pWal->hdr is updated before it is written.+*/+static void walIndexWriteHdr(Wal *pWal){+ volatile WalIndexHdr *aHdr = walIndexHdr(pWal);+ const int nCksum = offsetof(WalIndexHdr, aCksum);++ assert( pWal->writeLock );+ pWal->hdr.isInit = 1;+ pWal->hdr.iVersion = WALINDEX_MAX_VERSION;+ walChecksumBytes(1, (u8*)&pWal->hdr, nCksum, 0, pWal->hdr.aCksum);+ memcpy((void*)&aHdr[1], (const void*)&pWal->hdr, sizeof(WalIndexHdr));+ walShmBarrier(pWal);+ memcpy((void*)&aHdr[0], (const void*)&pWal->hdr, sizeof(WalIndexHdr));+}++/*+** This function encodes a single frame header and writes it to a buffer+** supplied by the caller. A frame-header is made up of a series of +** 4-byte big-endian integers, as follows:+**+** 0: Page number.+** 4: For commit records, the size of the database image in pages +** after the commit. For all other records, zero.+** 8: Salt-1 (copied from the wal-header)+** 12: Salt-2 (copied from the wal-header)+** 16: Checksum-1.+** 20: Checksum-2.+*/+static void walEncodeFrame(+ Wal *pWal, /* The write-ahead log */+ u32 iPage, /* Database page number for frame */+ u32 nTruncate, /* New db size (or 0 for non-commit frames) */+ u8 *aData, /* Pointer to page data */+ u8 *aFrame /* OUT: Write encoded frame here */+){+ int nativeCksum; /* True for native byte-order checksums */+ u32 *aCksum = pWal->hdr.aFrameCksum;+ assert( WAL_FRAME_HDRSIZE==24 );+ sqlite3Put4byte(&aFrame[0], iPage);+ sqlite3Put4byte(&aFrame[4], nTruncate);+ memcpy(&aFrame[8], pWal->hdr.aSalt, 8);++ nativeCksum = (pWal->hdr.bigEndCksum==SQLITE_BIGENDIAN);+ walChecksumBytes(nativeCksum, aFrame, 8, aCksum, aCksum);+ walChecksumBytes(nativeCksum, aData, pWal->szPage, aCksum, aCksum);++ sqlite3Put4byte(&aFrame[16], aCksum[0]);+ sqlite3Put4byte(&aFrame[20], aCksum[1]);+}++/*+** Check to see if the frame with header in aFrame[] and content+** in aData[] is valid. If it is a valid frame, fill *piPage and+** *pnTruncate and return true. Return if the frame is not valid.+*/+static int walDecodeFrame(+ Wal *pWal, /* The write-ahead log */+ u32 *piPage, /* OUT: Database page number for frame */+ u32 *pnTruncate, /* OUT: New db size (or 0 if not commit) */+ u8 *aData, /* Pointer to page data (for checksum) */+ u8 *aFrame /* Frame data */+){+ int nativeCksum; /* True for native byte-order checksums */+ u32 *aCksum = pWal->hdr.aFrameCksum;+ u32 pgno; /* Page number of the frame */+ assert( WAL_FRAME_HDRSIZE==24 );++ /* A frame is only valid if the salt values in the frame-header+ ** match the salt values in the wal-header. + */+ if( memcmp(&pWal->hdr.aSalt, &aFrame[8], 8)!=0 ){+ return 0;+ }++ /* A frame is only valid if the page number is creater than zero.+ */+ pgno = sqlite3Get4byte(&aFrame[0]);+ if( pgno==0 ){+ return 0;+ }++ /* A frame is only valid if a checksum of the WAL header,+ ** all prior frams, the first 16 bytes of this frame-header, + ** and the frame-data matches the checksum in the last 8 + ** bytes of this frame-header.+ */+ nativeCksum = (pWal->hdr.bigEndCksum==SQLITE_BIGENDIAN);+ walChecksumBytes(nativeCksum, aFrame, 8, aCksum, aCksum);+ walChecksumBytes(nativeCksum, aData, pWal->szPage, aCksum, aCksum);+ if( aCksum[0]!=sqlite3Get4byte(&aFrame[16]) + || aCksum[1]!=sqlite3Get4byte(&aFrame[20]) + ){+ /* Checksum failed. */+ return 0;+ }++ /* If we reach this point, the frame is valid. Return the page number+ ** and the new database size.+ */+ *piPage = pgno;+ *pnTruncate = sqlite3Get4byte(&aFrame[4]);+ return 1;+}+++#if defined(SQLITE_TEST) && defined(SQLITE_DEBUG)+/*+** Names of locks. This routine is used to provide debugging output and is not+** a part of an ordinary build.+*/+static const char *walLockName(int lockIdx){+ if( lockIdx==WAL_WRITE_LOCK ){+ return "WRITE-LOCK";+ }else if( lockIdx==WAL_CKPT_LOCK ){+ return "CKPT-LOCK";+ }else if( lockIdx==WAL_RECOVER_LOCK ){+ return "RECOVER-LOCK";+ }else{+ static char zName[15];+ sqlite3_snprintf(sizeof(zName), zName, "READ-LOCK[%d]",+ lockIdx-WAL_READ_LOCK(0));+ return zName;+ }+}+#endif /*defined(SQLITE_TEST) || defined(SQLITE_DEBUG) */+ ++/*+** Set or release locks on the WAL. Locks are either shared or exclusive.+** A lock cannot be moved directly between shared and exclusive - it must go+** through the unlocked state first.+**+** In locking_mode=EXCLUSIVE, all of these routines become no-ops.+*/+static int walLockShared(Wal *pWal, int lockIdx){+ int rc;+ if( pWal->exclusiveMode ) return SQLITE_OK;+ rc = sqlite3OsShmLock(pWal->pDbFd, lockIdx, 1,+ SQLITE_SHM_LOCK | SQLITE_SHM_SHARED);+ WALTRACE(("WAL%p: acquire SHARED-%s %s\n", pWal,+ walLockName(lockIdx), rc ? "failed" : "ok"));+ VVA_ONLY( pWal->lockError = (u8)(rc!=SQLITE_OK && rc!=SQLITE_BUSY); )+ return rc;+}+static void walUnlockShared(Wal *pWal, int lockIdx){+ if( pWal->exclusiveMode ) return;+ (void)sqlite3OsShmLock(pWal->pDbFd, lockIdx, 1,+ SQLITE_SHM_UNLOCK | SQLITE_SHM_SHARED);+ WALTRACE(("WAL%p: release SHARED-%s\n", pWal, walLockName(lockIdx)));+}+static int walLockExclusive(Wal *pWal, int lockIdx, int n, int fBlock){+ int rc;+ if( pWal->exclusiveMode ) return SQLITE_OK;+ if( fBlock ) sqlite3OsFileControl(pWal->pDbFd, SQLITE_FCNTL_WAL_BLOCK, 0);+ rc = sqlite3OsShmLock(pWal->pDbFd, lockIdx, n,+ SQLITE_SHM_LOCK | SQLITE_SHM_EXCLUSIVE);+ WALTRACE(("WAL%p: acquire EXCLUSIVE-%s cnt=%d %s\n", pWal,+ walLockName(lockIdx), n, rc ? "failed" : "ok"));+ VVA_ONLY( pWal->lockError = (u8)(rc!=SQLITE_OK && rc!=SQLITE_BUSY); )+ return rc;+}+static void walUnlockExclusive(Wal *pWal, int lockIdx, int n){+ if( pWal->exclusiveMode ) return;+ (void)sqlite3OsShmLock(pWal->pDbFd, lockIdx, n,+ SQLITE_SHM_UNLOCK | SQLITE_SHM_EXCLUSIVE);+ WALTRACE(("WAL%p: release EXCLUSIVE-%s cnt=%d\n", pWal,+ walLockName(lockIdx), n));+}++/*+** Compute a hash on a page number. The resulting hash value must land+** between 0 and (HASHTABLE_NSLOT-1). The walHashNext() function advances+** the hash to the next value in the event of a collision.+*/+static int walHash(u32 iPage){+ assert( iPage>0 );+ assert( (HASHTABLE_NSLOT & (HASHTABLE_NSLOT-1))==0 );+ return (iPage*HASHTABLE_HASH_1) & (HASHTABLE_NSLOT-1);+}+static int walNextHash(int iPriorHash){+ return (iPriorHash+1)&(HASHTABLE_NSLOT-1);+}++/* +** Return pointers to the hash table and page number array stored on+** page iHash of the wal-index. The wal-index is broken into 32KB pages+** numbered starting from 0.+**+** Set output variable *paHash to point to the start of the hash table+** in the wal-index file. Set *piZero to one less than the frame +** number of the first frame indexed by this hash table. If a+** slot in the hash table is set to N, it refers to frame number +** (*piZero+N) in the log.+**+** Finally, set *paPgno so that *paPgno[1] is the page number of the+** first frame indexed by the hash table, frame (*piZero+1).+*/+static int walHashGet(+ Wal *pWal, /* WAL handle */+ int iHash, /* Find the iHash'th table */+ volatile ht_slot **paHash, /* OUT: Pointer to hash index */+ volatile u32 **paPgno, /* OUT: Pointer to page number array */+ u32 *piZero /* OUT: Frame associated with *paPgno[0] */+){+ int rc; /* Return code */+ volatile u32 *aPgno;++ rc = walIndexPage(pWal, iHash, &aPgno);+ assert( rc==SQLITE_OK || iHash>0 );++ if( rc==SQLITE_OK ){+ u32 iZero;+ volatile ht_slot *aHash;++ aHash = (volatile ht_slot *)&aPgno[HASHTABLE_NPAGE];+ if( iHash==0 ){+ aPgno = &aPgno[WALINDEX_HDR_SIZE/sizeof(u32)];+ iZero = 0;+ }else{+ iZero = HASHTABLE_NPAGE_ONE + (iHash-1)*HASHTABLE_NPAGE;+ }+ + *paPgno = &aPgno[-1];+ *paHash = aHash;+ *piZero = iZero;+ }+ return rc;+}++/*+** Return the number of the wal-index page that contains the hash-table+** and page-number array that contain entries corresponding to WAL frame+** iFrame. The wal-index is broken up into 32KB pages. Wal-index pages +** are numbered starting from 0.+*/+static int walFramePage(u32 iFrame){+ int iHash = (iFrame+HASHTABLE_NPAGE-HASHTABLE_NPAGE_ONE-1) / HASHTABLE_NPAGE;+ assert( (iHash==0 || iFrame>HASHTABLE_NPAGE_ONE)+ && (iHash>=1 || iFrame<=HASHTABLE_NPAGE_ONE)+ && (iHash<=1 || iFrame>(HASHTABLE_NPAGE_ONE+HASHTABLE_NPAGE))+ && (iHash>=2 || iFrame<=HASHTABLE_NPAGE_ONE+HASHTABLE_NPAGE)+ && (iHash<=2 || iFrame>(HASHTABLE_NPAGE_ONE+2*HASHTABLE_NPAGE))+ );+ return iHash;+}++/*+** Return the page number associated with frame iFrame in this WAL.+*/+static u32 walFramePgno(Wal *pWal, u32 iFrame){+ int iHash = walFramePage(iFrame);+ if( iHash==0 ){+ return pWal->apWiData[0][WALINDEX_HDR_SIZE/sizeof(u32) + iFrame - 1];+ }+ return pWal->apWiData[iHash][(iFrame-1-HASHTABLE_NPAGE_ONE)%HASHTABLE_NPAGE];+}++/*+** Remove entries from the hash table that point to WAL slots greater+** than pWal->hdr.mxFrame.+**+** This function is called whenever pWal->hdr.mxFrame is decreased due+** to a rollback or savepoint.+**+** At most only the hash table containing pWal->hdr.mxFrame needs to be+** updated. Any later hash tables will be automatically cleared when+** pWal->hdr.mxFrame advances to the point where those hash tables are+** actually needed.+*/+static void walCleanupHash(Wal *pWal){+ volatile ht_slot *aHash = 0; /* Pointer to hash table to clear */+ volatile u32 *aPgno = 0; /* Page number array for hash table */+ u32 iZero = 0; /* frame == (aHash[x]+iZero) */+ int iLimit = 0; /* Zero values greater than this */+ int nByte; /* Number of bytes to zero in aPgno[] */+ int i; /* Used to iterate through aHash[] */++ assert( pWal->writeLock );+ testcase( pWal->hdr.mxFrame==HASHTABLE_NPAGE_ONE-1 );+ testcase( pWal->hdr.mxFrame==HASHTABLE_NPAGE_ONE );+ testcase( pWal->hdr.mxFrame==HASHTABLE_NPAGE_ONE+1 );++ if( pWal->hdr.mxFrame==0 ) return;++ /* Obtain pointers to the hash-table and page-number array containing + ** the entry that corresponds to frame pWal->hdr.mxFrame. It is guaranteed+ ** that the page said hash-table and array reside on is already mapped.+ */+ assert( pWal->nWiData>walFramePage(pWal->hdr.mxFrame) );+ assert( pWal->apWiData[walFramePage(pWal->hdr.mxFrame)] );+ walHashGet(pWal, walFramePage(pWal->hdr.mxFrame), &aHash, &aPgno, &iZero);++ /* Zero all hash-table entries that correspond to frame numbers greater+ ** than pWal->hdr.mxFrame.+ */+ iLimit = pWal->hdr.mxFrame - iZero;+ assert( iLimit>0 );+ for(i=0; i<HASHTABLE_NSLOT; i++){+ if( aHash[i]>iLimit ){+ aHash[i] = 0;+ }+ }+ + /* Zero the entries in the aPgno array that correspond to frames with+ ** frame numbers greater than pWal->hdr.mxFrame. + */+ nByte = (int)((char *)aHash - (char *)&aPgno[iLimit+1]);+ memset((void *)&aPgno[iLimit+1], 0, nByte);++#ifdef SQLITE_ENABLE_EXPENSIVE_ASSERT+ /* Verify that the every entry in the mapping region is still reachable+ ** via the hash table even after the cleanup.+ */+ if( iLimit ){+ int j; /* Loop counter */+ int iKey; /* Hash key */+ for(j=1; j<=iLimit; j++){+ for(iKey=walHash(aPgno[j]); aHash[iKey]; iKey=walNextHash(iKey)){+ if( aHash[iKey]==j ) break;+ }+ assert( aHash[iKey]==j );+ }+ }+#endif /* SQLITE_ENABLE_EXPENSIVE_ASSERT */+}+++/*+** Set an entry in the wal-index that will map database page number+** pPage into WAL frame iFrame.+*/+static int walIndexAppend(Wal *pWal, u32 iFrame, u32 iPage){+ int rc; /* Return code */+ u32 iZero = 0; /* One less than frame number of aPgno[1] */+ volatile u32 *aPgno = 0; /* Page number array */+ volatile ht_slot *aHash = 0; /* Hash table */++ rc = walHashGet(pWal, walFramePage(iFrame), &aHash, &aPgno, &iZero);++ /* Assuming the wal-index file was successfully mapped, populate the+ ** page number array and hash table entry.+ */+ if( rc==SQLITE_OK ){+ int iKey; /* Hash table key */+ int idx; /* Value to write to hash-table slot */+ int nCollide; /* Number of hash collisions */++ idx = iFrame - iZero;+ assert( idx <= HASHTABLE_NSLOT/2 + 1 );+ + /* If this is the first entry to be added to this hash-table, zero the+ ** entire hash table and aPgno[] array before proceeding. + */+ if( idx==1 ){+ int nByte = (int)((u8 *)&aHash[HASHTABLE_NSLOT] - (u8 *)&aPgno[1]);+ memset((void*)&aPgno[1], 0, nByte);+ }++ /* If the entry in aPgno[] is already set, then the previous writer+ ** must have exited unexpectedly in the middle of a transaction (after+ ** writing one or more dirty pages to the WAL to free up memory). + ** Remove the remnants of that writers uncommitted transaction from + ** the hash-table before writing any new entries.+ */+ if( aPgno[idx] ){+ walCleanupHash(pWal);+ assert( !aPgno[idx] );+ }++ /* Write the aPgno[] array entry and the hash-table slot. */+ nCollide = idx;+ for(iKey=walHash(iPage); aHash[iKey]; iKey=walNextHash(iKey)){+ if( (nCollide--)==0 ) return SQLITE_CORRUPT_BKPT;+ }+ aPgno[idx] = iPage;+ aHash[iKey] = (ht_slot)idx;++#ifdef SQLITE_ENABLE_EXPENSIVE_ASSERT+ /* Verify that the number of entries in the hash table exactly equals+ ** the number of entries in the mapping region.+ */+ {+ int i; /* Loop counter */+ int nEntry = 0; /* Number of entries in the hash table */+ for(i=0; i<HASHTABLE_NSLOT; i++){ if( aHash[i] ) nEntry++; }+ assert( nEntry==idx );+ }++ /* Verify that the every entry in the mapping region is reachable+ ** via the hash table. This turns out to be a really, really expensive+ ** thing to check, so only do this occasionally - not on every+ ** iteration.+ */+ if( (idx&0x3ff)==0 ){+ int i; /* Loop counter */+ for(i=1; i<=idx; i++){+ for(iKey=walHash(aPgno[i]); aHash[iKey]; iKey=walNextHash(iKey)){+ if( aHash[iKey]==i ) break;+ }+ assert( aHash[iKey]==i );+ }+ }+#endif /* SQLITE_ENABLE_EXPENSIVE_ASSERT */+ }+++ return rc;+}+++/*+** Recover the wal-index by reading the write-ahead log file. +**+** This routine first tries to establish an exclusive lock on the+** wal-index to prevent other threads/processes from doing anything+** with the WAL or wal-index while recovery is running. The+** WAL_RECOVER_LOCK is also held so that other threads will know+** that this thread is running recovery. If unable to establish+** the necessary locks, this routine returns SQLITE_BUSY.+*/+static int walIndexRecover(Wal *pWal){+ int rc; /* Return Code */+ i64 nSize; /* Size of log file */+ u32 aFrameCksum[2] = {0, 0};+ int iLock; /* Lock offset to lock for checkpoint */+ int nLock; /* Number of locks to hold */++ /* Obtain an exclusive lock on all byte in the locking range not already+ ** locked by the caller. The caller is guaranteed to have locked the+ ** WAL_WRITE_LOCK byte, and may have also locked the WAL_CKPT_LOCK byte.+ ** If successful, the same bytes that are locked here are unlocked before+ ** this function returns.+ */+ assert( pWal->ckptLock==1 || pWal->ckptLock==0 );+ assert( WAL_ALL_BUT_WRITE==WAL_WRITE_LOCK+1 );+ assert( WAL_CKPT_LOCK==WAL_ALL_BUT_WRITE );+ assert( pWal->writeLock );+ iLock = WAL_ALL_BUT_WRITE + pWal->ckptLock;+ nLock = SQLITE_SHM_NLOCK - iLock;+ rc = walLockExclusive(pWal, iLock, nLock, 0);+ if( rc ){+ return rc;+ }+ WALTRACE(("WAL%p: recovery begin...\n", pWal));++ memset(&pWal->hdr, 0, sizeof(WalIndexHdr));++ rc = sqlite3OsFileSize(pWal->pWalFd, &nSize);+ if( rc!=SQLITE_OK ){+ goto recovery_error;+ }++ if( nSize>WAL_HDRSIZE ){+ u8 aBuf[WAL_HDRSIZE]; /* Buffer to load WAL header into */+ u8 *aFrame = 0; /* Malloc'd buffer to load entire frame */+ int szFrame; /* Number of bytes in buffer aFrame[] */+ u8 *aData; /* Pointer to data part of aFrame buffer */+ int iFrame; /* Index of last frame read */+ i64 iOffset; /* Next offset to read from log file */+ int szPage; /* Page size according to the log */+ u32 magic; /* Magic value read from WAL header */+ u32 version; /* Magic value read from WAL header */+ int isValid; /* True if this frame is valid */++ /* Read in the WAL header. */+ rc = sqlite3OsRead(pWal->pWalFd, aBuf, WAL_HDRSIZE, 0);+ if( rc!=SQLITE_OK ){+ goto recovery_error;+ }++ /* If the database page size is not a power of two, or is greater than+ ** SQLITE_MAX_PAGE_SIZE, conclude that the WAL file contains no valid + ** data. Similarly, if the 'magic' value is invalid, ignore the whole+ ** WAL file.+ */+ magic = sqlite3Get4byte(&aBuf[0]);+ szPage = sqlite3Get4byte(&aBuf[8]);+ if( (magic&0xFFFFFFFE)!=WAL_MAGIC + || szPage&(szPage-1) + || szPage>SQLITE_MAX_PAGE_SIZE + || szPage<512 + ){+ goto finished;+ }+ pWal->hdr.bigEndCksum = (u8)(magic&0x00000001);+ pWal->szPage = szPage;+ pWal->nCkpt = sqlite3Get4byte(&aBuf[12]);+ memcpy(&pWal->hdr.aSalt, &aBuf[16], 8);++ /* Verify that the WAL header checksum is correct */+ walChecksumBytes(pWal->hdr.bigEndCksum==SQLITE_BIGENDIAN, + aBuf, WAL_HDRSIZE-2*4, 0, pWal->hdr.aFrameCksum+ );+ if( pWal->hdr.aFrameCksum[0]!=sqlite3Get4byte(&aBuf[24])+ || pWal->hdr.aFrameCksum[1]!=sqlite3Get4byte(&aBuf[28])+ ){+ goto finished;+ }++ /* Verify that the version number on the WAL format is one that+ ** are able to understand */+ version = sqlite3Get4byte(&aBuf[4]);+ if( version!=WAL_MAX_VERSION ){+ rc = SQLITE_CANTOPEN_BKPT;+ goto finished;+ }++ /* Malloc a buffer to read frames into. */+ szFrame = szPage + WAL_FRAME_HDRSIZE;+ aFrame = (u8 *)sqlite3_malloc64(szFrame);+ if( !aFrame ){+ rc = SQLITE_NOMEM;+ goto recovery_error;+ }+ aData = &aFrame[WAL_FRAME_HDRSIZE];++ /* Read all frames from the log file. */+ iFrame = 0;+ for(iOffset=WAL_HDRSIZE; (iOffset+szFrame)<=nSize; iOffset+=szFrame){+ u32 pgno; /* Database page number for frame */+ u32 nTruncate; /* dbsize field from frame header */++ /* Read and decode the next log frame. */+ iFrame++;+ rc = sqlite3OsRead(pWal->pWalFd, aFrame, szFrame, iOffset);+ if( rc!=SQLITE_OK ) break;+ isValid = walDecodeFrame(pWal, &pgno, &nTruncate, aData, aFrame);+ if( !isValid ) break;+ rc = walIndexAppend(pWal, iFrame, pgno);+ if( rc!=SQLITE_OK ) break;++ /* If nTruncate is non-zero, this is a commit record. */+ if( nTruncate ){+ pWal->hdr.mxFrame = iFrame;+ pWal->hdr.nPage = nTruncate;+ pWal->hdr.szPage = (u16)((szPage&0xff00) | (szPage>>16));+ testcase( szPage<=32768 );+ testcase( szPage>=65536 );+ aFrameCksum[0] = pWal->hdr.aFrameCksum[0];+ aFrameCksum[1] = pWal->hdr.aFrameCksum[1];+ }+ }++ sqlite3_free(aFrame);+ }++finished:+ if( rc==SQLITE_OK ){+ volatile WalCkptInfo *pInfo;+ int i;+ pWal->hdr.aFrameCksum[0] = aFrameCksum[0];+ pWal->hdr.aFrameCksum[1] = aFrameCksum[1];+ walIndexWriteHdr(pWal);++ /* Reset the checkpoint-header. This is safe because this thread is + ** currently holding locks that exclude all other readers, writers and+ ** checkpointers.+ */+ pInfo = walCkptInfo(pWal);+ pInfo->nBackfill = 0;+ pInfo->aReadMark[0] = 0;+ for(i=1; i<WAL_NREADER; i++) pInfo->aReadMark[i] = READMARK_NOT_USED;+ if( pWal->hdr.mxFrame ) pInfo->aReadMark[1] = pWal->hdr.mxFrame;++ /* If more than one frame was recovered from the log file, report an+ ** event via sqlite3_log(). This is to help with identifying performance+ ** problems caused by applications routinely shutting down without+ ** checkpointing the log file.+ */+ if( pWal->hdr.nPage ){+ sqlite3_log(SQLITE_NOTICE_RECOVER_WAL,+ "recovered %d frames from WAL file %s",+ pWal->hdr.mxFrame, pWal->zWalName+ );+ }+ }++recovery_error:+ WALTRACE(("WAL%p: recovery %s\n", pWal, rc ? "failed" : "ok"));+ walUnlockExclusive(pWal, iLock, nLock);+ return rc;+}++/*+** Close an open wal-index.+*/+static void walIndexClose(Wal *pWal, int isDelete){+ if( pWal->exclusiveMode==WAL_HEAPMEMORY_MODE ){+ int i;+ for(i=0; i<pWal->nWiData; i++){+ sqlite3_free((void *)pWal->apWiData[i]);+ pWal->apWiData[i] = 0;+ }+ }else{+ sqlite3OsShmUnmap(pWal->pDbFd, isDelete);+ }+}++/* +** Open a connection to the WAL file zWalName. The database file must +** already be opened on connection pDbFd. The buffer that zWalName points+** to must remain valid for the lifetime of the returned Wal* handle.+**+** A SHARED lock should be held on the database file when this function+** is called. The purpose of this SHARED lock is to prevent any other+** client from unlinking the WAL or wal-index file. If another process+** were to do this just after this client opened one of these files, the+** system would be badly broken.+**+** If the log file is successfully opened, SQLITE_OK is returned and +** *ppWal is set to point to a new WAL handle. If an error occurs,+** an SQLite error code is returned and *ppWal is left unmodified.+*/+SQLITE_PRIVATE int sqlite3WalOpen(+ sqlite3_vfs *pVfs, /* vfs module to open wal and wal-index */+ sqlite3_file *pDbFd, /* The open database file */+ const char *zWalName, /* Name of the WAL file */+ int bNoShm, /* True to run in heap-memory mode */+ i64 mxWalSize, /* Truncate WAL to this size on reset */+ Wal **ppWal /* OUT: Allocated Wal handle */+){+ int rc; /* Return Code */+ Wal *pRet; /* Object to allocate and return */+ int flags; /* Flags passed to OsOpen() */++ assert( zWalName && zWalName[0] );+ assert( pDbFd );++ /* In the amalgamation, the os_unix.c and os_win.c source files come before+ ** this source file. Verify that the #defines of the locking byte offsets+ ** in os_unix.c and os_win.c agree with the WALINDEX_LOCK_OFFSET value.+ */+#ifdef WIN_SHM_BASE+ assert( WIN_SHM_BASE==WALINDEX_LOCK_OFFSET );+#endif+#ifdef UNIX_SHM_BASE+ assert( UNIX_SHM_BASE==WALINDEX_LOCK_OFFSET );+#endif+++ /* Allocate an instance of struct Wal to return. */+ *ppWal = 0;+ pRet = (Wal*)sqlite3MallocZero(sizeof(Wal) + pVfs->szOsFile);+ if( !pRet ){+ return SQLITE_NOMEM;+ }++ pRet->pVfs = pVfs;+ pRet->pWalFd = (sqlite3_file *)&pRet[1];+ pRet->pDbFd = pDbFd;+ pRet->readLock = -1;+ pRet->mxWalSize = mxWalSize;+ pRet->zWalName = zWalName;+ pRet->syncHeader = 1;+ pRet->padToSectorBoundary = 1;+ pRet->exclusiveMode = (bNoShm ? WAL_HEAPMEMORY_MODE: WAL_NORMAL_MODE);++ /* Open file handle on the write-ahead log file. */+ flags = (SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE|SQLITE_OPEN_WAL);+ rc = sqlite3OsOpen(pVfs, zWalName, pRet->pWalFd, flags, &flags);+ if( rc==SQLITE_OK && flags&SQLITE_OPEN_READONLY ){+ pRet->readOnly = WAL_RDONLY;+ }++ if( rc!=SQLITE_OK ){+ walIndexClose(pRet, 0);+ sqlite3OsClose(pRet->pWalFd);+ sqlite3_free(pRet);+ }else{+ int iDC = sqlite3OsDeviceCharacteristics(pDbFd);+ if( iDC & SQLITE_IOCAP_SEQUENTIAL ){ pRet->syncHeader = 0; }+ if( iDC & SQLITE_IOCAP_POWERSAFE_OVERWRITE ){+ pRet->padToSectorBoundary = 0;+ }+ *ppWal = pRet;+ WALTRACE(("WAL%d: opened\n", pRet));+ }+ return rc;+}++#if 0+/*+** Change the size to which the WAL file is trucated on each reset.+*/+SQLITE_PRIVATE void sqlite3WalLimit(Wal *pWal, i64 iLimit){+ if( pWal ) pWal->mxWalSize = iLimit;+}+#endif++/*+** Find the smallest page number out of all pages held in the WAL that+** has not been returned by any prior invocation of this method on the+** same WalIterator object. Write into *piFrame the frame index where+** that page was last written into the WAL. Write into *piPage the page+** number.+**+** Return 0 on success. If there are no pages in the WAL with a page+** number larger than *piPage, then return 1.+*/+static int walIteratorNext(+ WalIterator *p, /* Iterator */+ u32 *piPage, /* OUT: The page number of the next page */+ u32 *piFrame /* OUT: Wal frame index of next page */+){+ u32 iMin; /* Result pgno must be greater than iMin */+ u32 iRet = 0xFFFFFFFF; /* 0xffffffff is never a valid page number */+ int i; /* For looping through segments */++ iMin = p->iPrior;+ assert( iMin<0xffffffff );+ for(i=p->nSegment-1; i>=0; i--){+ struct WalSegment *pSegment = &p->aSegment[i];+ while( pSegment->iNext<pSegment->nEntry ){+ u32 iPg = pSegment->aPgno[pSegment->aIndex[pSegment->iNext]];+ if( iPg>iMin ){+ if( iPg<iRet ){+ iRet = iPg;+ *piFrame = pSegment->iZero + pSegment->aIndex[pSegment->iNext];+ }+ break;+ }+ pSegment->iNext++;+ }+ }++ *piPage = p->iPrior = iRet;+ return (iRet==0xFFFFFFFF);+}++/*+** This function merges two sorted lists into a single sorted list.+**+** aLeft[] and aRight[] are arrays of indices. The sort key is+** aContent[aLeft[]] and aContent[aRight[]]. Upon entry, the following+** is guaranteed for all J<K:+**+** aContent[aLeft[J]] < aContent[aLeft[K]]+** aContent[aRight[J]] < aContent[aRight[K]]+**+** This routine overwrites aRight[] with a new (probably longer) sequence+** of indices such that the aRight[] contains every index that appears in+** either aLeft[] or the old aRight[] and such that the second condition+** above is still met.+**+** The aContent[aLeft[X]] values will be unique for all X. And the+** aContent[aRight[X]] values will be unique too. But there might be+** one or more combinations of X and Y such that+**+** aLeft[X]!=aRight[Y] && aContent[aLeft[X]] == aContent[aRight[Y]]+**+** When that happens, omit the aLeft[X] and use the aRight[Y] index.+*/+static void walMerge(+ const u32 *aContent, /* Pages in wal - keys for the sort */+ ht_slot *aLeft, /* IN: Left hand input list */+ int nLeft, /* IN: Elements in array *paLeft */+ ht_slot **paRight, /* IN/OUT: Right hand input list */+ int *pnRight, /* IN/OUT: Elements in *paRight */+ ht_slot *aTmp /* Temporary buffer */+){+ int iLeft = 0; /* Current index in aLeft */+ int iRight = 0; /* Current index in aRight */+ int iOut = 0; /* Current index in output buffer */+ int nRight = *pnRight;+ ht_slot *aRight = *paRight;++ assert( nLeft>0 && nRight>0 );+ while( iRight<nRight || iLeft<nLeft ){+ ht_slot logpage;+ Pgno dbpage;++ if( (iLeft<nLeft) + && (iRight>=nRight || aContent[aLeft[iLeft]]<aContent[aRight[iRight]])+ ){+ logpage = aLeft[iLeft++];+ }else{+ logpage = aRight[iRight++];+ }+ dbpage = aContent[logpage];++ aTmp[iOut++] = logpage;+ if( iLeft<nLeft && aContent[aLeft[iLeft]]==dbpage ) iLeft++;++ assert( iLeft>=nLeft || aContent[aLeft[iLeft]]>dbpage );+ assert( iRight>=nRight || aContent[aRight[iRight]]>dbpage );+ }++ *paRight = aLeft;+ *pnRight = iOut;+ memcpy(aLeft, aTmp, sizeof(aTmp[0])*iOut);+}++/*+** Sort the elements in list aList using aContent[] as the sort key.+** Remove elements with duplicate keys, preferring to keep the+** larger aList[] values.+**+** The aList[] entries are indices into aContent[]. The values in+** aList[] are to be sorted so that for all J<K:+**+** aContent[aList[J]] < aContent[aList[K]]+**+** For any X and Y such that+**+** aContent[aList[X]] == aContent[aList[Y]]+**+** Keep the larger of the two values aList[X] and aList[Y] and discard+** the smaller.+*/+static void walMergesort(+ const u32 *aContent, /* Pages in wal */+ ht_slot *aBuffer, /* Buffer of at least *pnList items to use */+ ht_slot *aList, /* IN/OUT: List to sort */+ int *pnList /* IN/OUT: Number of elements in aList[] */+){+ struct Sublist {+ int nList; /* Number of elements in aList */+ ht_slot *aList; /* Pointer to sub-list content */+ };++ const int nList = *pnList; /* Size of input list */+ int nMerge = 0; /* Number of elements in list aMerge */+ ht_slot *aMerge = 0; /* List to be merged */+ int iList; /* Index into input list */+ u32 iSub = 0; /* Index into aSub array */+ struct Sublist aSub[13]; /* Array of sub-lists */++ memset(aSub, 0, sizeof(aSub));+ assert( nList<=HASHTABLE_NPAGE && nList>0 );+ assert( HASHTABLE_NPAGE==(1<<(ArraySize(aSub)-1)) );++ for(iList=0; iList<nList; iList++){+ nMerge = 1;+ aMerge = &aList[iList];+ for(iSub=0; iList & (1<<iSub); iSub++){+ struct Sublist *p;+ assert( iSub<ArraySize(aSub) );+ p = &aSub[iSub];+ assert( p->aList && p->nList<=(1<<iSub) );+ assert( p->aList==&aList[iList&~((2<<iSub)-1)] );+ walMerge(aContent, p->aList, p->nList, &aMerge, &nMerge, aBuffer);+ }+ aSub[iSub].aList = aMerge;+ aSub[iSub].nList = nMerge;+ }++ for(iSub++; iSub<ArraySize(aSub); iSub++){+ if( nList & (1<<iSub) ){+ struct Sublist *p;+ assert( iSub<ArraySize(aSub) );+ p = &aSub[iSub];+ assert( p->nList<=(1<<iSub) );+ assert( p->aList==&aList[nList&~((2<<iSub)-1)] );+ walMerge(aContent, p->aList, p->nList, &aMerge, &nMerge, aBuffer);+ }+ }+ assert( aMerge==aList );+ *pnList = nMerge;++#ifdef SQLITE_DEBUG+ {+ int i;+ for(i=1; i<*pnList; i++){+ assert( aContent[aList[i]] > aContent[aList[i-1]] );+ }+ }+#endif+}++/* +** Free an iterator allocated by walIteratorInit().+*/+static void walIteratorFree(WalIterator *p){+ sqlite3_free(p);+}++/*+** Construct a WalInterator object that can be used to loop over all +** pages in the WAL in ascending order. The caller must hold the checkpoint+** lock.+**+** On success, make *pp point to the newly allocated WalInterator object+** return SQLITE_OK. Otherwise, return an error code. If this routine+** returns an error, the value of *pp is undefined.+**+** The calling routine should invoke walIteratorFree() to destroy the+** WalIterator object when it has finished with it.+*/+static int walIteratorInit(Wal *pWal, WalIterator **pp){+ WalIterator *p; /* Return value */+ int nSegment; /* Number of segments to merge */+ u32 iLast; /* Last frame in log */+ int nByte; /* Number of bytes to allocate */+ int i; /* Iterator variable */+ ht_slot *aTmp; /* Temp space used by merge-sort */+ int rc = SQLITE_OK; /* Return Code */++ /* This routine only runs while holding the checkpoint lock. And+ ** it only runs if there is actually content in the log (mxFrame>0).+ */+ assert( pWal->ckptLock && pWal->hdr.mxFrame>0 );+ iLast = pWal->hdr.mxFrame;++ /* Allocate space for the WalIterator object. */+ nSegment = walFramePage(iLast) + 1;+ nByte = sizeof(WalIterator) + + (nSegment-1)*sizeof(struct WalSegment)+ + iLast*sizeof(ht_slot);+ p = (WalIterator *)sqlite3_malloc64(nByte);+ if( !p ){+ return SQLITE_NOMEM;+ }+ memset(p, 0, nByte);+ p->nSegment = nSegment;++ /* Allocate temporary space used by the merge-sort routine. This block+ ** of memory will be freed before this function returns.+ */+ aTmp = (ht_slot *)sqlite3_malloc64(+ sizeof(ht_slot) * (iLast>HASHTABLE_NPAGE?HASHTABLE_NPAGE:iLast)+ );+ if( !aTmp ){+ rc = SQLITE_NOMEM;+ }++ for(i=0; rc==SQLITE_OK && i<nSegment; i++){+ volatile ht_slot *aHash;+ u32 iZero;+ volatile u32 *aPgno;++ rc = walHashGet(pWal, i, &aHash, &aPgno, &iZero);+ if( rc==SQLITE_OK ){+ int j; /* Counter variable */+ int nEntry; /* Number of entries in this segment */+ ht_slot *aIndex; /* Sorted index for this segment */++ aPgno++;+ if( (i+1)==nSegment ){+ nEntry = (int)(iLast - iZero);+ }else{+ nEntry = (int)((u32*)aHash - (u32*)aPgno);+ }+ aIndex = &((ht_slot *)&p->aSegment[p->nSegment])[iZero];+ iZero++;+ + for(j=0; j<nEntry; j++){+ aIndex[j] = (ht_slot)j;+ }+ walMergesort((u32 *)aPgno, aTmp, aIndex, &nEntry);+ p->aSegment[i].iZero = iZero;+ p->aSegment[i].nEntry = nEntry;+ p->aSegment[i].aIndex = aIndex;+ p->aSegment[i].aPgno = (u32 *)aPgno;+ }+ }+ sqlite3_free(aTmp);++ if( rc!=SQLITE_OK ){+ walIteratorFree(p);+ }+ *pp = p;+ return rc;+}++/*+** Attempt to obtain the exclusive WAL lock defined by parameters lockIdx and+** n. If the attempt fails and parameter xBusy is not NULL, then it is a+** busy-handler function. Invoke it and retry the lock until either the+** lock is successfully obtained or the busy-handler returns 0.+*/+static int walBusyLock(+ Wal *pWal, /* WAL connection */+ int (*xBusy)(void*), /* Function to call when busy */+ void *pBusyArg, /* Context argument for xBusyHandler */+ int lockIdx, /* Offset of first byte to lock */+ int n /* Number of bytes to lock */+){+ int rc;+ do {+ rc = walLockExclusive(pWal, lockIdx, n, 0);+ }while( xBusy && rc==SQLITE_BUSY && xBusy(pBusyArg) );+ return rc;+}++/*+** The cache of the wal-index header must be valid to call this function.+** Return the page-size in bytes used by the database.+*/+static int walPagesize(Wal *pWal){+ return (pWal->hdr.szPage&0xfe00) + ((pWal->hdr.szPage&0x0001)<<16);+}++/*+** The following is guaranteed when this function is called:+**+** a) the WRITER lock is held,+** b) the entire log file has been checkpointed, and+** c) any existing readers are reading exclusively from the database+** file - there are no readers that may attempt to read a frame from+** the log file.+**+** This function updates the shared-memory structures so that the next+** client to write to the database (which may be this one) does so by+** writing frames into the start of the log file.+**+** The value of parameter salt1 is used as the aSalt[1] value in the +** new wal-index header. It should be passed a pseudo-random value (i.e. +** one obtained from sqlite3_randomness()).+*/+static void walRestartHdr(Wal *pWal, u32 salt1){+ volatile WalCkptInfo *pInfo = walCkptInfo(pWal);+ int i; /* Loop counter */+ u32 *aSalt = pWal->hdr.aSalt; /* Big-endian salt values */+ pWal->nCkpt++;+ pWal->hdr.mxFrame = 0;+ sqlite3Put4byte((u8*)&aSalt[0], 1 + sqlite3Get4byte((u8*)&aSalt[0]));+ memcpy(&pWal->hdr.aSalt[1], &salt1, 4);+ walIndexWriteHdr(pWal);+ pInfo->nBackfill = 0;+ pInfo->aReadMark[1] = 0;+ for(i=2; i<WAL_NREADER; i++) pInfo->aReadMark[i] = READMARK_NOT_USED;+ assert( pInfo->aReadMark[0]==0 );+}++/*+** Copy as much content as we can from the WAL back into the database file+** in response to an sqlite3_wal_checkpoint() request or the equivalent.+**+** The amount of information copies from WAL to database might be limited+** by active readers. This routine will never overwrite a database page+** that a concurrent reader might be using.+**+** All I/O barrier operations (a.k.a fsyncs) occur in this routine when+** SQLite is in WAL-mode in synchronous=NORMAL. That means that if +** checkpoints are always run by a background thread or background +** process, foreground threads will never block on a lengthy fsync call.+**+** Fsync is called on the WAL before writing content out of the WAL and+** into the database. This ensures that if the new content is persistent+** in the WAL and can be recovered following a power-loss or hard reset.+**+** Fsync is also called on the database file if (and only if) the entire+** WAL content is copied into the database file. This second fsync makes+** it safe to delete the WAL since the new content will persist in the+** database file.+**+** This routine uses and updates the nBackfill field of the wal-index header.+** This is the only routine that will increase the value of nBackfill. +** (A WAL reset or recovery will revert nBackfill to zero, but not increase+** its value.)+**+** The caller must be holding sufficient locks to ensure that no other+** checkpoint is running (in any other thread or process) at the same+** time.+*/+static int walCheckpoint(+ Wal *pWal, /* Wal connection */+ int eMode, /* One of PASSIVE, FULL or RESTART */+ int (*xBusy)(void*), /* Function to call when busy */+ void *pBusyArg, /* Context argument for xBusyHandler */+ int sync_flags, /* Flags for OsSync() (or 0) */+ u8 *zBuf /* Temporary buffer to use */+){+ int rc = SQLITE_OK; /* Return code */+ int szPage; /* Database page-size */+ WalIterator *pIter = 0; /* Wal iterator context */+ u32 iDbpage = 0; /* Next database page to write */+ u32 iFrame = 0; /* Wal frame containing data for iDbpage */+ u32 mxSafeFrame; /* Max frame that can be backfilled */+ u32 mxPage; /* Max database page to write */+ int i; /* Loop counter */+ volatile WalCkptInfo *pInfo; /* The checkpoint status information */++ szPage = walPagesize(pWal);+ testcase( szPage<=32768 );+ testcase( szPage>=65536 );+ pInfo = walCkptInfo(pWal);+ if( pInfo->nBackfill<pWal->hdr.mxFrame ){++ /* Allocate the iterator */+ rc = walIteratorInit(pWal, &pIter);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ assert( pIter );++ /* EVIDENCE-OF: R-62920-47450 The busy-handler callback is never invoked+ ** in the SQLITE_CHECKPOINT_PASSIVE mode. */+ assert( eMode!=SQLITE_CHECKPOINT_PASSIVE || xBusy==0 );++ /* Compute in mxSafeFrame the index of the last frame of the WAL that is+ ** safe to write into the database. Frames beyond mxSafeFrame might+ ** overwrite database pages that are in use by active readers and thus+ ** cannot be backfilled from the WAL.+ */+ mxSafeFrame = pWal->hdr.mxFrame;+ mxPage = pWal->hdr.nPage;+ for(i=1; i<WAL_NREADER; i++){+ /* Thread-sanitizer reports that the following is an unsafe read,+ ** as some other thread may be in the process of updating the value+ ** of the aReadMark[] slot. The assumption here is that if that is+ ** happening, the other client may only be increasing the value,+ ** not decreasing it. So assuming either that either the "old" or+ ** "new" version of the value is read, and not some arbitrary value+ ** that would never be written by a real client, things are still + ** safe. */+ u32 y = pInfo->aReadMark[i];+ if( mxSafeFrame>y ){+ assert( y<=pWal->hdr.mxFrame );+ rc = walBusyLock(pWal, xBusy, pBusyArg, WAL_READ_LOCK(i), 1);+ if( rc==SQLITE_OK ){+ pInfo->aReadMark[i] = (i==1 ? mxSafeFrame : READMARK_NOT_USED);+ walUnlockExclusive(pWal, WAL_READ_LOCK(i), 1);+ }else if( rc==SQLITE_BUSY ){+ mxSafeFrame = y;+ xBusy = 0;+ }else{+ goto walcheckpoint_out;+ }+ }+ }++ if( pInfo->nBackfill<mxSafeFrame+ && (rc = walBusyLock(pWal, xBusy, pBusyArg, WAL_READ_LOCK(0),1))==SQLITE_OK+ ){+ i64 nSize; /* Current size of database file */+ u32 nBackfill = pInfo->nBackfill;++ /* Sync the WAL to disk */+ if( sync_flags ){+ rc = sqlite3OsSync(pWal->pWalFd, sync_flags);+ }++ /* If the database may grow as a result of this checkpoint, hint+ ** about the eventual size of the db file to the VFS layer.+ */+ if( rc==SQLITE_OK ){+ i64 nReq = ((i64)mxPage * szPage);+ rc = sqlite3OsFileSize(pWal->pDbFd, &nSize);+ if( rc==SQLITE_OK && nSize<nReq ){+ sqlite3OsFileControlHint(pWal->pDbFd, SQLITE_FCNTL_SIZE_HINT, &nReq);+ }+ }+++ /* Iterate through the contents of the WAL, copying data to the db file */+ while( rc==SQLITE_OK && 0==walIteratorNext(pIter, &iDbpage, &iFrame) ){+ i64 iOffset;+ assert( walFramePgno(pWal, iFrame)==iDbpage );+ if( iFrame<=nBackfill || iFrame>mxSafeFrame || iDbpage>mxPage ){+ continue;+ }+ iOffset = walFrameOffset(iFrame, szPage) + WAL_FRAME_HDRSIZE;+ /* testcase( IS_BIG_INT(iOffset) ); // requires a 4GiB WAL file */+ rc = sqlite3OsRead(pWal->pWalFd, zBuf, szPage, iOffset);+ if( rc!=SQLITE_OK ) break;+ iOffset = (iDbpage-1)*(i64)szPage;+ testcase( IS_BIG_INT(iOffset) );+ rc = sqlite3OsWrite(pWal->pDbFd, zBuf, szPage, iOffset);+ if( rc!=SQLITE_OK ) break;+ }++ /* If work was actually accomplished... */+ if( rc==SQLITE_OK ){+ if( mxSafeFrame==walIndexHdr(pWal)->mxFrame ){+ i64 szDb = pWal->hdr.nPage*(i64)szPage;+ testcase( IS_BIG_INT(szDb) );+ rc = sqlite3OsTruncate(pWal->pDbFd, szDb);+ if( rc==SQLITE_OK && sync_flags ){+ rc = sqlite3OsSync(pWal->pDbFd, sync_flags);+ }+ }+ if( rc==SQLITE_OK ){+ pInfo->nBackfill = mxSafeFrame;+ }+ }++ /* Release the reader lock held while backfilling */+ walUnlockExclusive(pWal, WAL_READ_LOCK(0), 1);+ }++ if( rc==SQLITE_BUSY ){+ /* Reset the return code so as not to report a checkpoint failure+ ** just because there are active readers. */+ rc = SQLITE_OK;+ }+ }++ /* If this is an SQLITE_CHECKPOINT_RESTART or TRUNCATE operation, and the+ ** entire wal file has been copied into the database file, then block + ** until all readers have finished using the wal file. This ensures that + ** the next process to write to the database restarts the wal file.+ */+ if( rc==SQLITE_OK && eMode!=SQLITE_CHECKPOINT_PASSIVE ){+ assert( pWal->writeLock );+ if( pInfo->nBackfill<pWal->hdr.mxFrame ){+ rc = SQLITE_BUSY;+ }else if( eMode>=SQLITE_CHECKPOINT_RESTART ){+ u32 salt1;+ sqlite3_randomness(4, &salt1);+ assert( pInfo->nBackfill==pWal->hdr.mxFrame );+ rc = walBusyLock(pWal, xBusy, pBusyArg, WAL_READ_LOCK(1), WAL_NREADER-1);+ if( rc==SQLITE_OK ){+ if( eMode==SQLITE_CHECKPOINT_TRUNCATE ){+ /* IMPLEMENTATION-OF: R-44699-57140 This mode works the same way as+ ** SQLITE_CHECKPOINT_RESTART with the addition that it also+ ** truncates the log file to zero bytes just prior to a+ ** successful return.+ **+ ** In theory, it might be safe to do this without updating the+ ** wal-index header in shared memory, as all subsequent reader or+ ** writer clients should see that the entire log file has been+ ** checkpointed and behave accordingly. This seems unsafe though,+ ** as it would leave the system in a state where the contents of+ ** the wal-index header do not match the contents of the + ** file-system. To avoid this, update the wal-index header to+ ** indicate that the log file contains zero valid frames. */+ walRestartHdr(pWal, salt1);+ rc = sqlite3OsTruncate(pWal->pWalFd, 0);+ }+ walUnlockExclusive(pWal, WAL_READ_LOCK(1), WAL_NREADER-1);+ }+ }+ }++ walcheckpoint_out:+ walIteratorFree(pIter);+ return rc;+}++/*+** If the WAL file is currently larger than nMax bytes in size, truncate+** it to exactly nMax bytes. If an error occurs while doing so, ignore it.+*/+static void walLimitSize(Wal *pWal, i64 nMax){+ i64 sz;+ int rx;+ rx = sqlite3OsFileSize(pWal->pWalFd, &sz);+ if( rx==SQLITE_OK && (sz > nMax ) ){+ rx = sqlite3OsTruncate(pWal->pWalFd, nMax);+ }+ if( rx ){+ sqlite3_log(rx, "cannot limit WAL size: %s", pWal->zWalName);+ }+}++/*+** Close a connection to a log file.+*/+SQLITE_PRIVATE int sqlite3WalClose(+ Wal *pWal, /* Wal to close */+ int sync_flags, /* Flags to pass to OsSync() (or 0) */+ int nBuf,+ u8 *zBuf /* Buffer of at least nBuf bytes */+){+ int rc = SQLITE_OK;+ if( pWal ){+ int isDelete = 0; /* True to unlink wal and wal-index files */++ /* If an EXCLUSIVE lock can be obtained on the database file (using the+ ** ordinary, rollback-mode locking methods, this guarantees that the+ ** connection associated with this log file is the only connection to+ ** the database. In this case checkpoint the database and unlink both+ ** the wal and wal-index files.+ **+ ** The EXCLUSIVE lock is not released before returning.+ */+ rc = sqlite3OsLock(pWal->pDbFd, SQLITE_LOCK_EXCLUSIVE);+ if( rc==SQLITE_OK ){+ if( pWal->exclusiveMode==WAL_NORMAL_MODE ){+ pWal->exclusiveMode = WAL_EXCLUSIVE_MODE;+ }+ rc = sqlite3WalCheckpoint(+ pWal, SQLITE_CHECKPOINT_PASSIVE, 0, 0, sync_flags, nBuf, zBuf, 0, 0+ );+ if( rc==SQLITE_OK ){+ int bPersist = -1;+ sqlite3OsFileControlHint(+ pWal->pDbFd, SQLITE_FCNTL_PERSIST_WAL, &bPersist+ );+ if( bPersist!=1 ){+ /* Try to delete the WAL file if the checkpoint completed and+ ** fsyned (rc==SQLITE_OK) and if we are not in persistent-wal+ ** mode (!bPersist) */+ isDelete = 1;+ }else if( pWal->mxWalSize>=0 ){+ /* Try to truncate the WAL file to zero bytes if the checkpoint+ ** completed and fsynced (rc==SQLITE_OK) and we are in persistent+ ** WAL mode (bPersist) and if the PRAGMA journal_size_limit is a+ ** non-negative value (pWal->mxWalSize>=0). Note that we truncate+ ** to zero bytes as truncating to the journal_size_limit might+ ** leave a corrupt WAL file on disk. */+ walLimitSize(pWal, 0);+ }+ }+ }++ walIndexClose(pWal, isDelete);+ sqlite3OsClose(pWal->pWalFd);+ if( isDelete ){+ sqlite3OsDelete(pWal->pVfs, pWal->zWalName, 0);+ }+ WALTRACE(("WAL%p: closed\n", pWal));+ sqlite3_free((void *)pWal->apWiData);+ sqlite3_free(pWal);+ }+ return rc;+}++/*+** Try to read the wal-index header. Return 0 on success and 1 if+** there is a problem.+**+** The wal-index is in shared memory. Another thread or process might+** be writing the header at the same time this procedure is trying to+** read it, which might result in inconsistency. A dirty read is detected+** by verifying that both copies of the header are the same and also by+** a checksum on the header.+**+** If and only if the read is consistent and the header is different from+** pWal->hdr, then pWal->hdr is updated to the content of the new header+** and *pChanged is set to 1.+**+** If the checksum cannot be verified return non-zero. If the header+** is read successfully and the checksum verified, return zero.+*/+static int walIndexTryHdr(Wal *pWal, int *pChanged){+ u32 aCksum[2]; /* Checksum on the header content */+ WalIndexHdr h1, h2; /* Two copies of the header content */+ WalIndexHdr volatile *aHdr; /* Header in shared memory */++ /* The first page of the wal-index must be mapped at this point. */+ assert( pWal->nWiData>0 && pWal->apWiData[0] );++ /* Read the header. This might happen concurrently with a write to the+ ** same area of shared memory on a different CPU in a SMP,+ ** meaning it is possible that an inconsistent snapshot is read+ ** from the file. If this happens, return non-zero.+ **+ ** There are two copies of the header at the beginning of the wal-index.+ ** When reading, read [0] first then [1]. Writes are in the reverse order.+ ** Memory barriers are used to prevent the compiler or the hardware from+ ** reordering the reads and writes.+ */+ aHdr = walIndexHdr(pWal);+ memcpy(&h1, (void *)&aHdr[0], sizeof(h1));+ walShmBarrier(pWal);+ memcpy(&h2, (void *)&aHdr[1], sizeof(h2));++ if( memcmp(&h1, &h2, sizeof(h1))!=0 ){+ return 1; /* Dirty read */+ } + if( h1.isInit==0 ){+ return 1; /* Malformed header - probably all zeros */+ }+ walChecksumBytes(1, (u8*)&h1, sizeof(h1)-sizeof(h1.aCksum), 0, aCksum);+ if( aCksum[0]!=h1.aCksum[0] || aCksum[1]!=h1.aCksum[1] ){+ return 1; /* Checksum does not match */+ }++ if( memcmp(&pWal->hdr, &h1, sizeof(WalIndexHdr)) ){+ *pChanged = 1;+ memcpy(&pWal->hdr, &h1, sizeof(WalIndexHdr));+ pWal->szPage = (pWal->hdr.szPage&0xfe00) + ((pWal->hdr.szPage&0x0001)<<16);+ testcase( pWal->szPage<=32768 );+ testcase( pWal->szPage>=65536 );+ }++ /* The header was successfully read. Return zero. */+ return 0;+}++/*+** Read the wal-index header from the wal-index and into pWal->hdr.+** If the wal-header appears to be corrupt, try to reconstruct the+** wal-index from the WAL before returning.+**+** Set *pChanged to 1 if the wal-index header value in pWal->hdr is+** changed by this operation. If pWal->hdr is unchanged, set *pChanged+** to 0.+**+** If the wal-index header is successfully read, return SQLITE_OK. +** Otherwise an SQLite error code.+*/+static int walIndexReadHdr(Wal *pWal, int *pChanged){+ int rc; /* Return code */+ int badHdr; /* True if a header read failed */+ volatile u32 *page0; /* Chunk of wal-index containing header */++ /* Ensure that page 0 of the wal-index (the page that contains the + ** wal-index header) is mapped. Return early if an error occurs here.+ */+ assert( pChanged );+ rc = walIndexPage(pWal, 0, &page0);+ if( rc!=SQLITE_OK ){+ return rc;+ };+ assert( page0 || pWal->writeLock==0 );++ /* If the first page of the wal-index has been mapped, try to read the+ ** wal-index header immediately, without holding any lock. This usually+ ** works, but may fail if the wal-index header is corrupt or currently + ** being modified by another thread or process.+ */+ badHdr = (page0 ? walIndexTryHdr(pWal, pChanged) : 1);++ /* If the first attempt failed, it might have been due to a race+ ** with a writer. So get a WRITE lock and try again.+ */+ assert( badHdr==0 || pWal->writeLock==0 );+ if( badHdr ){+ if( pWal->readOnly & WAL_SHM_RDONLY ){+ if( SQLITE_OK==(rc = walLockShared(pWal, WAL_WRITE_LOCK)) ){+ walUnlockShared(pWal, WAL_WRITE_LOCK);+ rc = SQLITE_READONLY_RECOVERY;+ }+ }else if( SQLITE_OK==(rc = walLockExclusive(pWal, WAL_WRITE_LOCK, 1, 1)) ){+ pWal->writeLock = 1;+ if( SQLITE_OK==(rc = walIndexPage(pWal, 0, &page0)) ){+ badHdr = walIndexTryHdr(pWal, pChanged);+ if( badHdr ){+ /* If the wal-index header is still malformed even while holding+ ** a WRITE lock, it can only mean that the header is corrupted and+ ** needs to be reconstructed. So run recovery to do exactly that.+ */+ rc = walIndexRecover(pWal);+ *pChanged = 1;+ }+ }+ pWal->writeLock = 0;+ walUnlockExclusive(pWal, WAL_WRITE_LOCK, 1);+ }+ }++ /* If the header is read successfully, check the version number to make+ ** sure the wal-index was not constructed with some future format that+ ** this version of SQLite cannot understand.+ */+ if( badHdr==0 && pWal->hdr.iVersion!=WALINDEX_MAX_VERSION ){+ rc = SQLITE_CANTOPEN_BKPT;+ }++ return rc;+}++/*+** This is the value that walTryBeginRead returns when it needs to+** be retried.+*/+#define WAL_RETRY (-1)++/*+** Attempt to start a read transaction. This might fail due to a race or+** other transient condition. When that happens, it returns WAL_RETRY to+** indicate to the caller that it is safe to retry immediately.+**+** On success return SQLITE_OK. On a permanent failure (such an+** I/O error or an SQLITE_BUSY because another process is running+** recovery) return a positive error code.+**+** The useWal parameter is true to force the use of the WAL and disable+** the case where the WAL is bypassed because it has been completely+** checkpointed. If useWal==0 then this routine calls walIndexReadHdr() +** to make a copy of the wal-index header into pWal->hdr. If the +** wal-index header has changed, *pChanged is set to 1 (as an indication +** to the caller that the local paget cache is obsolete and needs to be +** flushed.) When useWal==1, the wal-index header is assumed to already+** be loaded and the pChanged parameter is unused.+**+** The caller must set the cnt parameter to the number of prior calls to+** this routine during the current read attempt that returned WAL_RETRY.+** This routine will start taking more aggressive measures to clear the+** race conditions after multiple WAL_RETRY returns, and after an excessive+** number of errors will ultimately return SQLITE_PROTOCOL. The+** SQLITE_PROTOCOL return indicates that some other process has gone rogue+** and is not honoring the locking protocol. There is a vanishingly small+** chance that SQLITE_PROTOCOL could be returned because of a run of really+** bad luck when there is lots of contention for the wal-index, but that+** possibility is so small that it can be safely neglected, we believe.+**+** On success, this routine obtains a read lock on +** WAL_READ_LOCK(pWal->readLock). The pWal->readLock integer is+** in the range 0 <= pWal->readLock < WAL_NREADER. If pWal->readLock==(-1)+** that means the Wal does not hold any read lock. The reader must not+** access any database page that is modified by a WAL frame up to and+** including frame number aReadMark[pWal->readLock]. The reader will+** use WAL frames up to and including pWal->hdr.mxFrame if pWal->readLock>0+** Or if pWal->readLock==0, then the reader will ignore the WAL+** completely and get all content directly from the database file.+** If the useWal parameter is 1 then the WAL will never be ignored and+** this routine will always set pWal->readLock>0 on success.+** When the read transaction is completed, the caller must release the+** lock on WAL_READ_LOCK(pWal->readLock) and set pWal->readLock to -1.+**+** This routine uses the nBackfill and aReadMark[] fields of the header+** to select a particular WAL_READ_LOCK() that strives to let the+** checkpoint process do as much work as possible. This routine might+** update values of the aReadMark[] array in the header, but if it does+** so it takes care to hold an exclusive lock on the corresponding+** WAL_READ_LOCK() while changing values.+*/+static int walTryBeginRead(Wal *pWal, int *pChanged, int useWal, int cnt){+ volatile WalCkptInfo *pInfo; /* Checkpoint information in wal-index */+ u32 mxReadMark; /* Largest aReadMark[] value */+ int mxI; /* Index of largest aReadMark[] value */+ int i; /* Loop counter */+ int rc = SQLITE_OK; /* Return code */++ assert( pWal->readLock<0 ); /* Not currently locked */++ /* Take steps to avoid spinning forever if there is a protocol error.+ **+ ** Circumstances that cause a RETRY should only last for the briefest+ ** instances of time. No I/O or other system calls are done while the+ ** locks are held, so the locks should not be held for very long. But + ** if we are unlucky, another process that is holding a lock might get+ ** paged out or take a page-fault that is time-consuming to resolve, + ** during the few nanoseconds that it is holding the lock. In that case,+ ** it might take longer than normal for the lock to free.+ **+ ** After 5 RETRYs, we begin calling sqlite3OsSleep(). The first few+ ** calls to sqlite3OsSleep() have a delay of 1 microsecond. Really this+ ** is more of a scheduler yield than an actual delay. But on the 10th+ ** an subsequent retries, the delays start becoming longer and longer, + ** so that on the 100th (and last) RETRY we delay for 323 milliseconds.+ ** The total delay time before giving up is less than 10 seconds.+ */+ if( cnt>5 ){+ int nDelay = 1; /* Pause time in microseconds */+ if( cnt>100 ){+ VVA_ONLY( pWal->lockError = 1; )+ return SQLITE_PROTOCOL;+ }+ if( cnt>=10 ) nDelay = (cnt-9)*(cnt-9)*39;+ sqlite3OsSleep(pWal->pVfs, nDelay);+ }++ if( !useWal ){+ rc = walIndexReadHdr(pWal, pChanged);+ if( rc==SQLITE_BUSY ){+ /* If there is not a recovery running in another thread or process+ ** then convert BUSY errors to WAL_RETRY. If recovery is known to+ ** be running, convert BUSY to BUSY_RECOVERY. There is a race here+ ** which might cause WAL_RETRY to be returned even if BUSY_RECOVERY+ ** would be technically correct. But the race is benign since with+ ** WAL_RETRY this routine will be called again and will probably be+ ** right on the second iteration.+ */+ if( pWal->apWiData[0]==0 ){+ /* This branch is taken when the xShmMap() method returns SQLITE_BUSY.+ ** We assume this is a transient condition, so return WAL_RETRY. The+ ** xShmMap() implementation used by the default unix and win32 VFS + ** modules may return SQLITE_BUSY due to a race condition in the + ** code that determines whether or not the shared-memory region + ** must be zeroed before the requested page is returned.+ */+ rc = WAL_RETRY;+ }else if( SQLITE_OK==(rc = walLockShared(pWal, WAL_RECOVER_LOCK)) ){+ walUnlockShared(pWal, WAL_RECOVER_LOCK);+ rc = WAL_RETRY;+ }else if( rc==SQLITE_BUSY ){+ rc = SQLITE_BUSY_RECOVERY;+ }+ }+ if( rc!=SQLITE_OK ){+ return rc;+ }+ }++ pInfo = walCkptInfo(pWal);+ if( !useWal && pInfo->nBackfill==pWal->hdr.mxFrame ){+ /* The WAL has been completely backfilled (or it is empty).+ ** and can be safely ignored.+ */+ rc = walLockShared(pWal, WAL_READ_LOCK(0));+ walShmBarrier(pWal);+ if( rc==SQLITE_OK ){+ if( memcmp((void *)walIndexHdr(pWal), &pWal->hdr, sizeof(WalIndexHdr)) ){+ /* It is not safe to allow the reader to continue here if frames+ ** may have been appended to the log before READ_LOCK(0) was obtained.+ ** When holding READ_LOCK(0), the reader ignores the entire log file,+ ** which implies that the database file contains a trustworthy+ ** snapshot. Since holding READ_LOCK(0) prevents a checkpoint from+ ** happening, this is usually correct.+ **+ ** However, if frames have been appended to the log (or if the log + ** is wrapped and written for that matter) before the READ_LOCK(0)+ ** is obtained, that is not necessarily true. A checkpointer may+ ** have started to backfill the appended frames but crashed before+ ** it finished. Leaving a corrupt image in the database file.+ */+ walUnlockShared(pWal, WAL_READ_LOCK(0));+ return WAL_RETRY;+ }+ pWal->readLock = 0;+ return SQLITE_OK;+ }else if( rc!=SQLITE_BUSY ){+ return rc;+ }+ }++ /* If we get this far, it means that the reader will want to use+ ** the WAL to get at content from recent commits. The job now is+ ** to select one of the aReadMark[] entries that is closest to+ ** but not exceeding pWal->hdr.mxFrame and lock that entry.+ */+ mxReadMark = 0;+ mxI = 0;+ for(i=1; i<WAL_NREADER; i++){+ u32 thisMark = pInfo->aReadMark[i];+ if( mxReadMark<=thisMark && thisMark<=pWal->hdr.mxFrame ){+ assert( thisMark!=READMARK_NOT_USED );+ mxReadMark = thisMark;+ mxI = i;+ }+ }+ /* There was once an "if" here. The extra "{" is to preserve indentation. */+ {+ if( (pWal->readOnly & WAL_SHM_RDONLY)==0+ && (mxReadMark<pWal->hdr.mxFrame || mxI==0)+ ){+ for(i=1; i<WAL_NREADER; i++){+ rc = walLockExclusive(pWal, WAL_READ_LOCK(i), 1, 0);+ if( rc==SQLITE_OK ){+ mxReadMark = pInfo->aReadMark[i] = pWal->hdr.mxFrame;+ mxI = i;+ walUnlockExclusive(pWal, WAL_READ_LOCK(i), 1);+ break;+ }else if( rc!=SQLITE_BUSY ){+ return rc;+ }+ }+ }+ if( mxI==0 ){+ assert( rc==SQLITE_BUSY || (pWal->readOnly & WAL_SHM_RDONLY)!=0 );+ return rc==SQLITE_BUSY ? WAL_RETRY : SQLITE_READONLY_CANTLOCK;+ }++ rc = walLockShared(pWal, WAL_READ_LOCK(mxI));+ if( rc ){+ return rc==SQLITE_BUSY ? WAL_RETRY : rc;+ }+ /* Now that the read-lock has been obtained, check that neither the+ ** value in the aReadMark[] array or the contents of the wal-index+ ** header have changed.+ **+ ** It is necessary to check that the wal-index header did not change+ ** between the time it was read and when the shared-lock was obtained+ ** on WAL_READ_LOCK(mxI) was obtained to account for the possibility+ ** that the log file may have been wrapped by a writer, or that frames+ ** that occur later in the log than pWal->hdr.mxFrame may have been+ ** copied into the database by a checkpointer. If either of these things+ ** happened, then reading the database with the current value of+ ** pWal->hdr.mxFrame risks reading a corrupted snapshot. So, retry+ ** instead.+ **+ ** Before checking that the live wal-index header has not changed+ ** since it was read, set Wal.minFrame to the first frame in the wal+ ** file that has not yet been checkpointed. This client will not need+ ** to read any frames earlier than minFrame from the wal file - they+ ** can be safely read directly from the database file.+ **+ ** Because a ShmBarrier() call is made between taking the copy of + ** nBackfill and checking that the wal-header in shared-memory still+ ** matches the one cached in pWal->hdr, it is guaranteed that the + ** checkpointer that set nBackfill was not working with a wal-index+ ** header newer than that cached in pWal->hdr. If it were, that could+ ** cause a problem. The checkpointer could omit to checkpoint+ ** a version of page X that lies before pWal->minFrame (call that version+ ** A) on the basis that there is a newer version (version B) of the same+ ** page later in the wal file. But if version B happens to like past+ ** frame pWal->hdr.mxFrame - then the client would incorrectly assume+ ** that it can read version A from the database file. However, since+ ** we can guarantee that the checkpointer that set nBackfill could not+ ** see any pages past pWal->hdr.mxFrame, this problem does not come up.+ */+ pWal->minFrame = pInfo->nBackfill+1;+ walShmBarrier(pWal);+ if( pInfo->aReadMark[mxI]!=mxReadMark+ || memcmp((void *)walIndexHdr(pWal), &pWal->hdr, sizeof(WalIndexHdr))+ ){+ walUnlockShared(pWal, WAL_READ_LOCK(mxI));+ return WAL_RETRY;+ }else{+ assert( mxReadMark<=pWal->hdr.mxFrame );+ pWal->readLock = (i16)mxI;+ }+ }+ return rc;+}++/*+** Begin a read transaction on the database.+**+** This routine used to be called sqlite3OpenSnapshot() and with good reason:+** it takes a snapshot of the state of the WAL and wal-index for the current+** instant in time. The current thread will continue to use this snapshot.+** Other threads might append new content to the WAL and wal-index but+** that extra content is ignored by the current thread.+**+** If the database contents have changes since the previous read+** transaction, then *pChanged is set to 1 before returning. The+** Pager layer will use this to know that is cache is stale and+** needs to be flushed.+*/+SQLITE_PRIVATE int sqlite3WalBeginReadTransaction(Wal *pWal, int *pChanged){+ int rc; /* Return code */+ int cnt = 0; /* Number of TryBeginRead attempts */++ do{+ rc = walTryBeginRead(pWal, pChanged, 0, ++cnt);+ }while( rc==WAL_RETRY );+ testcase( (rc&0xff)==SQLITE_BUSY );+ testcase( (rc&0xff)==SQLITE_IOERR );+ testcase( rc==SQLITE_PROTOCOL );+ testcase( rc==SQLITE_OK );+ return rc;+}++/*+** Finish with a read transaction. All this does is release the+** read-lock.+*/+SQLITE_PRIVATE void sqlite3WalEndReadTransaction(Wal *pWal){+ sqlite3WalEndWriteTransaction(pWal);+ if( pWal->readLock>=0 ){+ walUnlockShared(pWal, WAL_READ_LOCK(pWal->readLock));+ pWal->readLock = -1;+ }+}++/*+** Search the wal file for page pgno. If found, set *piRead to the frame that+** contains the page. Otherwise, if pgno is not in the wal file, set *piRead+** to zero.+**+** Return SQLITE_OK if successful, or an error code if an error occurs. If an+** error does occur, the final value of *piRead is undefined.+*/+SQLITE_PRIVATE int sqlite3WalFindFrame(+ Wal *pWal, /* WAL handle */+ Pgno pgno, /* Database page number to read data for */+ u32 *piRead /* OUT: Frame number (or zero) */+){+ u32 iRead = 0; /* If !=0, WAL frame to return data from */+ u32 iLast = pWal->hdr.mxFrame; /* Last page in WAL for this reader */+ int iHash; /* Used to loop through N hash tables */+ int iMinHash;++ /* This routine is only be called from within a read transaction. */+ assert( pWal->readLock>=0 || pWal->lockError );++ /* If the "last page" field of the wal-index header snapshot is 0, then+ ** no data will be read from the wal under any circumstances. Return early+ ** in this case as an optimization. Likewise, if pWal->readLock==0, + ** then the WAL is ignored by the reader so return early, as if the + ** WAL were empty.+ */+ if( iLast==0 || pWal->readLock==0 ){+ *piRead = 0;+ return SQLITE_OK;+ }++ /* Search the hash table or tables for an entry matching page number+ ** pgno. Each iteration of the following for() loop searches one+ ** hash table (each hash table indexes up to HASHTABLE_NPAGE frames).+ **+ ** This code might run concurrently to the code in walIndexAppend()+ ** that adds entries to the wal-index (and possibly to this hash + ** table). This means the value just read from the hash + ** slot (aHash[iKey]) may have been added before or after the + ** current read transaction was opened. Values added after the+ ** read transaction was opened may have been written incorrectly -+ ** i.e. these slots may contain garbage data. However, we assume+ ** that any slots written before the current read transaction was+ ** opened remain unmodified.+ **+ ** For the reasons above, the if(...) condition featured in the inner+ ** loop of the following block is more stringent that would be required + ** if we had exclusive access to the hash-table:+ **+ ** (aPgno[iFrame]==pgno): + ** This condition filters out normal hash-table collisions.+ **+ ** (iFrame<=iLast): + ** This condition filters out entries that were added to the hash+ ** table after the current read-transaction had started.+ */+ iMinHash = walFramePage(pWal->minFrame);+ for(iHash=walFramePage(iLast); iHash>=iMinHash && iRead==0; iHash--){+ volatile ht_slot *aHash; /* Pointer to hash table */+ volatile u32 *aPgno; /* Pointer to array of page numbers */+ u32 iZero; /* Frame number corresponding to aPgno[0] */+ int iKey; /* Hash slot index */+ int nCollide; /* Number of hash collisions remaining */+ int rc; /* Error code */++ rc = walHashGet(pWal, iHash, &aHash, &aPgno, &iZero);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ nCollide = HASHTABLE_NSLOT;+ for(iKey=walHash(pgno); aHash[iKey]; iKey=walNextHash(iKey)){+ u32 iFrame = aHash[iKey] + iZero;+ if( iFrame<=iLast && iFrame>=pWal->minFrame && aPgno[aHash[iKey]]==pgno ){+ assert( iFrame>iRead || CORRUPT_DB );+ iRead = iFrame;+ }+ if( (nCollide--)==0 ){+ return SQLITE_CORRUPT_BKPT;+ }+ }+ }++#ifdef SQLITE_ENABLE_EXPENSIVE_ASSERT+ /* If expensive assert() statements are available, do a linear search+ ** of the wal-index file content. Make sure the results agree with the+ ** result obtained using the hash indexes above. */+ {+ u32 iRead2 = 0;+ u32 iTest;+ assert( pWal->minFrame>0 );+ for(iTest=iLast; iTest>=pWal->minFrame; iTest--){+ if( walFramePgno(pWal, iTest)==pgno ){+ iRead2 = iTest;+ break;+ }+ }+ assert( iRead==iRead2 );+ }+#endif++ *piRead = iRead;+ return SQLITE_OK;+}++/*+** Read the contents of frame iRead from the wal file into buffer pOut+** (which is nOut bytes in size). Return SQLITE_OK if successful, or an+** error code otherwise.+*/+SQLITE_PRIVATE int sqlite3WalReadFrame(+ Wal *pWal, /* WAL handle */+ u32 iRead, /* Frame to read */+ int nOut, /* Size of buffer pOut in bytes */+ u8 *pOut /* Buffer to write page data to */+){+ int sz;+ i64 iOffset;+ sz = pWal->hdr.szPage;+ sz = (sz&0xfe00) + ((sz&0x0001)<<16);+ testcase( sz<=32768 );+ testcase( sz>=65536 );+ iOffset = walFrameOffset(iRead, sz) + WAL_FRAME_HDRSIZE;+ /* testcase( IS_BIG_INT(iOffset) ); // requires a 4GiB WAL */+ return sqlite3OsRead(pWal->pWalFd, pOut, (nOut>sz ? sz : nOut), iOffset);+}++/* +** Return the size of the database in pages (or zero, if unknown).+*/+SQLITE_PRIVATE Pgno sqlite3WalDbsize(Wal *pWal){+ if( pWal && ALWAYS(pWal->readLock>=0) ){+ return pWal->hdr.nPage;+ }+ return 0;+}+++/* +** This function starts a write transaction on the WAL.+**+** A read transaction must have already been started by a prior call+** to sqlite3WalBeginReadTransaction().+**+** If another thread or process has written into the database since+** the read transaction was started, then it is not possible for this+** thread to write as doing so would cause a fork. So this routine+** returns SQLITE_BUSY in that case and no write transaction is started.+**+** There can only be a single writer active at a time.+*/+SQLITE_PRIVATE int sqlite3WalBeginWriteTransaction(Wal *pWal){+ int rc;++ /* Cannot start a write transaction without first holding a read+ ** transaction. */+ assert( pWal->readLock>=0 );++ if( pWal->readOnly ){+ return SQLITE_READONLY;+ }++ /* Only one writer allowed at a time. Get the write lock. Return+ ** SQLITE_BUSY if unable.+ */+ rc = walLockExclusive(pWal, WAL_WRITE_LOCK, 1, 0);+ if( rc ){+ return rc;+ }+ pWal->writeLock = 1;++ /* If another connection has written to the database file since the+ ** time the read transaction on this connection was started, then+ ** the write is disallowed.+ */+ if( memcmp(&pWal->hdr, (void *)walIndexHdr(pWal), sizeof(WalIndexHdr))!=0 ){+ walUnlockExclusive(pWal, WAL_WRITE_LOCK, 1);+ pWal->writeLock = 0;+ rc = SQLITE_BUSY_SNAPSHOT;+ }++ return rc;+}++/*+** End a write transaction. The commit has already been done. This+** routine merely releases the lock.+*/+SQLITE_PRIVATE int sqlite3WalEndWriteTransaction(Wal *pWal){+ if( pWal->writeLock ){+ walUnlockExclusive(pWal, WAL_WRITE_LOCK, 1);+ pWal->writeLock = 0;+ pWal->truncateOnCommit = 0;+ }+ return SQLITE_OK;+}++/*+** If any data has been written (but not committed) to the log file, this+** function moves the write-pointer back to the start of the transaction.+**+** Additionally, the callback function is invoked for each frame written+** to the WAL since the start of the transaction. If the callback returns+** other than SQLITE_OK, it is not invoked again and the error code is+** returned to the caller.+**+** Otherwise, if the callback function does not return an error, this+** function returns SQLITE_OK.+*/+SQLITE_PRIVATE int sqlite3WalUndo(Wal *pWal, int (*xUndo)(void *, Pgno), void *pUndoCtx){+ int rc = SQLITE_OK;+ if( ALWAYS(pWal->writeLock) ){+ Pgno iMax = pWal->hdr.mxFrame;+ Pgno iFrame;+ + /* Restore the clients cache of the wal-index header to the state it+ ** was in before the client began writing to the database. + */+ memcpy(&pWal->hdr, (void *)walIndexHdr(pWal), sizeof(WalIndexHdr));++ for(iFrame=pWal->hdr.mxFrame+1; + ALWAYS(rc==SQLITE_OK) && iFrame<=iMax; + iFrame+++ ){+ /* This call cannot fail. Unless the page for which the page number+ ** is passed as the second argument is (a) in the cache and + ** (b) has an outstanding reference, then xUndo is either a no-op+ ** (if (a) is false) or simply expels the page from the cache (if (b)+ ** is false).+ **+ ** If the upper layer is doing a rollback, it is guaranteed that there+ ** are no outstanding references to any page other than page 1. And+ ** page 1 is never written to the log until the transaction is+ ** committed. As a result, the call to xUndo may not fail.+ */+ assert( walFramePgno(pWal, iFrame)!=1 );+ rc = xUndo(pUndoCtx, walFramePgno(pWal, iFrame));+ }+ if( iMax!=pWal->hdr.mxFrame ) walCleanupHash(pWal);+ }+ return rc;+}++/* +** Argument aWalData must point to an array of WAL_SAVEPOINT_NDATA u32 +** values. This function populates the array with values required to +** "rollback" the write position of the WAL handle back to the current +** point in the event of a savepoint rollback (via WalSavepointUndo()).+*/+SQLITE_PRIVATE void sqlite3WalSavepoint(Wal *pWal, u32 *aWalData){+ assert( pWal->writeLock );+ aWalData[0] = pWal->hdr.mxFrame;+ aWalData[1] = pWal->hdr.aFrameCksum[0];+ aWalData[2] = pWal->hdr.aFrameCksum[1];+ aWalData[3] = pWal->nCkpt;+}++/* +** Move the write position of the WAL back to the point identified by+** the values in the aWalData[] array. aWalData must point to an array+** of WAL_SAVEPOINT_NDATA u32 values that has been previously populated+** by a call to WalSavepoint().+*/+SQLITE_PRIVATE int sqlite3WalSavepointUndo(Wal *pWal, u32 *aWalData){+ int rc = SQLITE_OK;++ assert( pWal->writeLock );+ assert( aWalData[3]!=pWal->nCkpt || aWalData[0]<=pWal->hdr.mxFrame );++ if( aWalData[3]!=pWal->nCkpt ){+ /* This savepoint was opened immediately after the write-transaction+ ** was started. Right after that, the writer decided to wrap around+ ** to the start of the log. Update the savepoint values to match.+ */+ aWalData[0] = 0;+ aWalData[3] = pWal->nCkpt;+ }++ if( aWalData[0]<pWal->hdr.mxFrame ){+ pWal->hdr.mxFrame = aWalData[0];+ pWal->hdr.aFrameCksum[0] = aWalData[1];+ pWal->hdr.aFrameCksum[1] = aWalData[2];+ walCleanupHash(pWal);+ }++ return rc;+}++/*+** This function is called just before writing a set of frames to the log+** file (see sqlite3WalFrames()). It checks to see if, instead of appending+** to the current log file, it is possible to overwrite the start of the+** existing log file with the new frames (i.e. "reset" the log). If so,+** it sets pWal->hdr.mxFrame to 0. Otherwise, pWal->hdr.mxFrame is left+** unchanged.+**+** SQLITE_OK is returned if no error is encountered (regardless of whether+** or not pWal->hdr.mxFrame is modified). An SQLite error code is returned+** if an error occurs.+*/+static int walRestartLog(Wal *pWal){+ int rc = SQLITE_OK;+ int cnt;++ if( pWal->readLock==0 ){+ volatile WalCkptInfo *pInfo = walCkptInfo(pWal);+ assert( pInfo->nBackfill==pWal->hdr.mxFrame );+ if( pInfo->nBackfill>0 ){+ u32 salt1;+ sqlite3_randomness(4, &salt1);+ rc = walLockExclusive(pWal, WAL_READ_LOCK(1), WAL_NREADER-1, 0);+ if( rc==SQLITE_OK ){+ /* If all readers are using WAL_READ_LOCK(0) (in other words if no+ ** readers are currently using the WAL), then the transactions+ ** frames will overwrite the start of the existing log. Update the+ ** wal-index header to reflect this.+ **+ ** In theory it would be Ok to update the cache of the header only+ ** at this point. But updating the actual wal-index header is also+ ** safe and means there is no special case for sqlite3WalUndo()+ ** to handle if this transaction is rolled back. */+ walRestartHdr(pWal, salt1);+ walUnlockExclusive(pWal, WAL_READ_LOCK(1), WAL_NREADER-1);+ }else if( rc!=SQLITE_BUSY ){+ return rc;+ }+ }+ walUnlockShared(pWal, WAL_READ_LOCK(0));+ pWal->readLock = -1;+ cnt = 0;+ do{+ int notUsed;+ rc = walTryBeginRead(pWal, ¬Used, 1, ++cnt);+ }while( rc==WAL_RETRY );+ assert( (rc&0xff)!=SQLITE_BUSY ); /* BUSY not possible when useWal==1 */+ testcase( (rc&0xff)==SQLITE_IOERR );+ testcase( rc==SQLITE_PROTOCOL );+ testcase( rc==SQLITE_OK );+ }+ return rc;+}++/*+** Information about the current state of the WAL file and where+** the next fsync should occur - passed from sqlite3WalFrames() into+** walWriteToLog().+*/+typedef struct WalWriter {+ Wal *pWal; /* The complete WAL information */+ sqlite3_file *pFd; /* The WAL file to which we write */+ sqlite3_int64 iSyncPoint; /* Fsync at this offset */+ int syncFlags; /* Flags for the fsync */+ int szPage; /* Size of one page */+} WalWriter;++/*+** Write iAmt bytes of content into the WAL file beginning at iOffset.+** Do a sync when crossing the p->iSyncPoint boundary.+**+** In other words, if iSyncPoint is in between iOffset and iOffset+iAmt,+** first write the part before iSyncPoint, then sync, then write the+** rest.+*/+static int walWriteToLog(+ WalWriter *p, /* WAL to write to */+ void *pContent, /* Content to be written */+ int iAmt, /* Number of bytes to write */+ sqlite3_int64 iOffset /* Start writing at this offset */+){+ int rc;+ if( iOffset<p->iSyncPoint && iOffset+iAmt>=p->iSyncPoint ){+ int iFirstAmt = (int)(p->iSyncPoint - iOffset);+ rc = sqlite3OsWrite(p->pFd, pContent, iFirstAmt, iOffset);+ if( rc ) return rc;+ iOffset += iFirstAmt;+ iAmt -= iFirstAmt;+ pContent = (void*)(iFirstAmt + (char*)pContent);+ assert( p->syncFlags & (SQLITE_SYNC_NORMAL|SQLITE_SYNC_FULL) );+ rc = sqlite3OsSync(p->pFd, p->syncFlags & SQLITE_SYNC_MASK);+ if( iAmt==0 || rc ) return rc;+ }+ rc = sqlite3OsWrite(p->pFd, pContent, iAmt, iOffset);+ return rc;+}++/*+** Write out a single frame of the WAL+*/+static int walWriteOneFrame(+ WalWriter *p, /* Where to write the frame */+ PgHdr *pPage, /* The page of the frame to be written */+ int nTruncate, /* The commit flag. Usually 0. >0 for commit */+ sqlite3_int64 iOffset /* Byte offset at which to write */+){+ int rc; /* Result code from subfunctions */+ void *pData; /* Data actually written */+ u8 aFrame[WAL_FRAME_HDRSIZE]; /* Buffer to assemble frame-header in */+#if defined(SQLITE_HAS_CODEC)+ if( (pData = sqlite3PagerCodec(pPage))==0 ) return SQLITE_NOMEM;+#else+ pData = pPage->pData;+#endif+ walEncodeFrame(p->pWal, pPage->pgno, nTruncate, pData, aFrame);+ rc = walWriteToLog(p, aFrame, sizeof(aFrame), iOffset);+ if( rc ) return rc;+ /* Write the page data */+ rc = walWriteToLog(p, pData, p->szPage, iOffset+sizeof(aFrame));+ return rc;+}++/* +** Write a set of frames to the log. The caller must hold the write-lock+** on the log file (obtained using sqlite3WalBeginWriteTransaction()).+*/+SQLITE_PRIVATE int sqlite3WalFrames(+ Wal *pWal, /* Wal handle to write to */+ int szPage, /* Database page-size in bytes */+ PgHdr *pList, /* List of dirty pages to write */+ Pgno nTruncate, /* Database size after this commit */+ int isCommit, /* True if this is a commit */+ int sync_flags /* Flags to pass to OsSync() (or 0) */+){+ int rc; /* Used to catch return codes */+ u32 iFrame; /* Next frame address */+ PgHdr *p; /* Iterator to run through pList with. */+ PgHdr *pLast = 0; /* Last frame in list */+ int nExtra = 0; /* Number of extra copies of last page */+ int szFrame; /* The size of a single frame */+ i64 iOffset; /* Next byte to write in WAL file */+ WalWriter w; /* The writer */++ assert( pList );+ assert( pWal->writeLock );++ /* If this frame set completes a transaction, then nTruncate>0. If+ ** nTruncate==0 then this frame set does not complete the transaction. */+ assert( (isCommit!=0)==(nTruncate!=0) );++#if defined(SQLITE_TEST) && defined(SQLITE_DEBUG)+ { int cnt; for(cnt=0, p=pList; p; p=p->pDirty, cnt++){}+ WALTRACE(("WAL%p: frame write begin. %d frames. mxFrame=%d. %s\n",+ pWal, cnt, pWal->hdr.mxFrame, isCommit ? "Commit" : "Spill"));+ }+#endif++ /* See if it is possible to write these frames into the start of the+ ** log file, instead of appending to it at pWal->hdr.mxFrame.+ */+ if( SQLITE_OK!=(rc = walRestartLog(pWal)) ){+ return rc;+ }++ /* If this is the first frame written into the log, write the WAL+ ** header to the start of the WAL file. See comments at the top of+ ** this source file for a description of the WAL header format.+ */+ iFrame = pWal->hdr.mxFrame;+ if( iFrame==0 ){+ u8 aWalHdr[WAL_HDRSIZE]; /* Buffer to assemble wal-header in */+ u32 aCksum[2]; /* Checksum for wal-header */++ sqlite3Put4byte(&aWalHdr[0], (WAL_MAGIC | SQLITE_BIGENDIAN));+ sqlite3Put4byte(&aWalHdr[4], WAL_MAX_VERSION);+ sqlite3Put4byte(&aWalHdr[8], szPage);+ sqlite3Put4byte(&aWalHdr[12], pWal->nCkpt);+ if( pWal->nCkpt==0 ) sqlite3_randomness(8, pWal->hdr.aSalt);+ memcpy(&aWalHdr[16], pWal->hdr.aSalt, 8);+ walChecksumBytes(1, aWalHdr, WAL_HDRSIZE-2*4, 0, aCksum);+ sqlite3Put4byte(&aWalHdr[24], aCksum[0]);+ sqlite3Put4byte(&aWalHdr[28], aCksum[1]);+ + pWal->szPage = szPage;+ pWal->hdr.bigEndCksum = SQLITE_BIGENDIAN;+ pWal->hdr.aFrameCksum[0] = aCksum[0];+ pWal->hdr.aFrameCksum[1] = aCksum[1];+ pWal->truncateOnCommit = 1;++ rc = sqlite3OsWrite(pWal->pWalFd, aWalHdr, sizeof(aWalHdr), 0);+ WALTRACE(("WAL%p: wal-header write %s\n", pWal, rc ? "failed" : "ok"));+ if( rc!=SQLITE_OK ){+ return rc;+ }++ /* Sync the header (unless SQLITE_IOCAP_SEQUENTIAL is true or unless+ ** all syncing is turned off by PRAGMA synchronous=OFF). Otherwise+ ** an out-of-order write following a WAL restart could result in+ ** database corruption. See the ticket:+ **+ ** http://localhost:591/sqlite/info/ff5be73dee+ */+ if( pWal->syncHeader && sync_flags ){+ rc = sqlite3OsSync(pWal->pWalFd, sync_flags & SQLITE_SYNC_MASK);+ if( rc ) return rc;+ }+ }+ assert( (int)pWal->szPage==szPage );++ /* Setup information needed to write frames into the WAL */+ w.pWal = pWal;+ w.pFd = pWal->pWalFd;+ w.iSyncPoint = 0;+ w.syncFlags = sync_flags;+ w.szPage = szPage;+ iOffset = walFrameOffset(iFrame+1, szPage);+ szFrame = szPage + WAL_FRAME_HDRSIZE;++ /* Write all frames into the log file exactly once */+ for(p=pList; p; p=p->pDirty){+ int nDbSize; /* 0 normally. Positive == commit flag */+ iFrame++;+ assert( iOffset==walFrameOffset(iFrame, szPage) );+ nDbSize = (isCommit && p->pDirty==0) ? nTruncate : 0;+ rc = walWriteOneFrame(&w, p, nDbSize, iOffset);+ if( rc ) return rc;+ pLast = p;+ iOffset += szFrame;+ }++ /* If this is the end of a transaction, then we might need to pad+ ** the transaction and/or sync the WAL file.+ **+ ** Padding and syncing only occur if this set of frames complete a+ ** transaction and if PRAGMA synchronous=FULL. If synchronous==NORMAL+ ** or synchronous==OFF, then no padding or syncing are needed.+ **+ ** If SQLITE_IOCAP_POWERSAFE_OVERWRITE is defined, then padding is not+ ** needed and only the sync is done. If padding is needed, then the+ ** final frame is repeated (with its commit mark) until the next sector+ ** boundary is crossed. Only the part of the WAL prior to the last+ ** sector boundary is synced; the part of the last frame that extends+ ** past the sector boundary is written after the sync.+ */+ if( isCommit && (sync_flags & WAL_SYNC_TRANSACTIONS)!=0 ){+ if( pWal->padToSectorBoundary ){+ int sectorSize = sqlite3SectorSize(pWal->pWalFd);+ w.iSyncPoint = ((iOffset+sectorSize-1)/sectorSize)*sectorSize;+ while( iOffset<w.iSyncPoint ){+ rc = walWriteOneFrame(&w, pLast, nTruncate, iOffset);+ if( rc ) return rc;+ iOffset += szFrame;+ nExtra++;+ }+ }else{+ rc = sqlite3OsSync(w.pFd, sync_flags & SQLITE_SYNC_MASK);+ }+ }++ /* If this frame set completes the first transaction in the WAL and+ ** if PRAGMA journal_size_limit is set, then truncate the WAL to the+ ** journal size limit, if possible.+ */+ if( isCommit && pWal->truncateOnCommit && pWal->mxWalSize>=0 ){+ i64 sz = pWal->mxWalSize;+ if( walFrameOffset(iFrame+nExtra+1, szPage)>pWal->mxWalSize ){+ sz = walFrameOffset(iFrame+nExtra+1, szPage);+ }+ walLimitSize(pWal, sz);+ pWal->truncateOnCommit = 0;+ }++ /* Append data to the wal-index. It is not necessary to lock the + ** wal-index to do this as the SQLITE_SHM_WRITE lock held on the wal-index+ ** guarantees that there are no other writers, and no data that may+ ** be in use by existing readers is being overwritten.+ */+ iFrame = pWal->hdr.mxFrame;+ for(p=pList; p && rc==SQLITE_OK; p=p->pDirty){+ iFrame++;+ rc = walIndexAppend(pWal, iFrame, p->pgno);+ }+ while( rc==SQLITE_OK && nExtra>0 ){+ iFrame++;+ nExtra--;+ rc = walIndexAppend(pWal, iFrame, pLast->pgno);+ }++ if( rc==SQLITE_OK ){+ /* Update the private copy of the header. */+ pWal->hdr.szPage = (u16)((szPage&0xff00) | (szPage>>16));+ testcase( szPage<=32768 );+ testcase( szPage>=65536 );+ pWal->hdr.mxFrame = iFrame;+ if( isCommit ){+ pWal->hdr.iChange++;+ pWal->hdr.nPage = nTruncate;+ }+ /* If this is a commit, update the wal-index header too. */+ if( isCommit ){+ walIndexWriteHdr(pWal);+ pWal->iCallback = iFrame;+ }+ }++ WALTRACE(("WAL%p: frame write %s\n", pWal, rc ? "failed" : "ok"));+ return rc;+}++/* +** This routine is called to implement sqlite3_wal_checkpoint() and+** related interfaces.+**+** Obtain a CHECKPOINT lock and then backfill as much information as+** we can from WAL into the database.+**+** If parameter xBusy is not NULL, it is a pointer to a busy-handler+** callback. In this case this function runs a blocking checkpoint.+*/+SQLITE_PRIVATE int sqlite3WalCheckpoint(+ Wal *pWal, /* Wal connection */+ int eMode, /* PASSIVE, FULL, RESTART, or TRUNCATE */+ int (*xBusy)(void*), /* Function to call when busy */+ void *pBusyArg, /* Context argument for xBusyHandler */+ int sync_flags, /* Flags to sync db file with (or 0) */+ int nBuf, /* Size of temporary buffer */+ u8 *zBuf, /* Temporary buffer to use */+ int *pnLog, /* OUT: Number of frames in WAL */+ int *pnCkpt /* OUT: Number of backfilled frames in WAL */+){+ int rc; /* Return code */+ int isChanged = 0; /* True if a new wal-index header is loaded */+ int eMode2 = eMode; /* Mode to pass to walCheckpoint() */+ int (*xBusy2)(void*) = xBusy; /* Busy handler for eMode2 */++ assert( pWal->ckptLock==0 );+ assert( pWal->writeLock==0 );++ /* EVIDENCE-OF: R-62920-47450 The busy-handler callback is never invoked+ ** in the SQLITE_CHECKPOINT_PASSIVE mode. */+ assert( eMode!=SQLITE_CHECKPOINT_PASSIVE || xBusy==0 );++ if( pWal->readOnly ) return SQLITE_READONLY;+ WALTRACE(("WAL%p: checkpoint begins\n", pWal));++ /* IMPLEMENTATION-OF: R-62028-47212 All calls obtain an exclusive + ** "checkpoint" lock on the database file. */+ rc = walLockExclusive(pWal, WAL_CKPT_LOCK, 1, 0);+ if( rc ){+ /* EVIDENCE-OF: R-10421-19736 If any other process is running a+ ** checkpoint operation at the same time, the lock cannot be obtained and+ ** SQLITE_BUSY is returned.+ ** EVIDENCE-OF: R-53820-33897 Even if there is a busy-handler configured,+ ** it will not be invoked in this case.+ */+ testcase( rc==SQLITE_BUSY );+ testcase( xBusy!=0 );+ return rc;+ }+ pWal->ckptLock = 1;++ /* IMPLEMENTATION-OF: R-59782-36818 The SQLITE_CHECKPOINT_FULL, RESTART and+ ** TRUNCATE modes also obtain the exclusive "writer" lock on the database+ ** file.+ **+ ** EVIDENCE-OF: R-60642-04082 If the writer lock cannot be obtained+ ** immediately, and a busy-handler is configured, it is invoked and the+ ** writer lock retried until either the busy-handler returns 0 or the+ ** lock is successfully obtained.+ */+ if( eMode!=SQLITE_CHECKPOINT_PASSIVE ){+ rc = walBusyLock(pWal, xBusy, pBusyArg, WAL_WRITE_LOCK, 1);+ if( rc==SQLITE_OK ){+ pWal->writeLock = 1;+ }else if( rc==SQLITE_BUSY ){+ eMode2 = SQLITE_CHECKPOINT_PASSIVE;+ xBusy2 = 0;+ rc = SQLITE_OK;+ }+ }++ /* Read the wal-index header. */+ if( rc==SQLITE_OK ){+ rc = walIndexReadHdr(pWal, &isChanged);+ if( isChanged && pWal->pDbFd->pMethods->iVersion>=3 ){+ sqlite3OsUnfetch(pWal->pDbFd, 0, 0);+ }+ }++ /* Copy data from the log to the database file. */+ if( rc==SQLITE_OK ){+ if( pWal->hdr.mxFrame && walPagesize(pWal)!=nBuf ){+ rc = SQLITE_CORRUPT_BKPT;+ }else{+ rc = walCheckpoint(pWal, eMode2, xBusy2, pBusyArg, sync_flags, zBuf);+ }++ /* If no error occurred, set the output variables. */+ if( rc==SQLITE_OK || rc==SQLITE_BUSY ){+ if( pnLog ) *pnLog = (int)pWal->hdr.mxFrame;+ if( pnCkpt ) *pnCkpt = (int)(walCkptInfo(pWal)->nBackfill);+ }+ }++ if( isChanged ){+ /* If a new wal-index header was loaded before the checkpoint was + ** performed, then the pager-cache associated with pWal is now+ ** out of date. So zero the cached wal-index header to ensure that+ ** next time the pager opens a snapshot on this database it knows that+ ** the cache needs to be reset.+ */+ memset(&pWal->hdr, 0, sizeof(WalIndexHdr));+ }++ /* Release the locks. */+ sqlite3WalEndWriteTransaction(pWal);+ walUnlockExclusive(pWal, WAL_CKPT_LOCK, 1);+ pWal->ckptLock = 0;+ WALTRACE(("WAL%p: checkpoint %s\n", pWal, rc ? "failed" : "ok"));+ return (rc==SQLITE_OK && eMode!=eMode2 ? SQLITE_BUSY : rc);+}++#if 0+/* Return the value to pass to a sqlite3_wal_hook callback, the+** number of frames in the WAL at the point of the last commit since+** sqlite3WalCallback() was called. If no commits have occurred since+** the last call, then return 0.+*/+SQLITE_PRIVATE int sqlite3WalCallback(Wal *pWal){+ u32 ret = 0;+ if( pWal ){+ ret = pWal->iCallback;+ pWal->iCallback = 0;+ }+ return (int)ret;+}+#endif++/*+** This function is called to change the WAL subsystem into or out+** of locking_mode=EXCLUSIVE.+**+** If op is zero, then attempt to change from locking_mode=EXCLUSIVE+** into locking_mode=NORMAL. This means that we must acquire a lock+** on the pWal->readLock byte. If the WAL is already in locking_mode=NORMAL+** or if the acquisition of the lock fails, then return 0. If the+** transition out of exclusive-mode is successful, return 1. This+** operation must occur while the pager is still holding the exclusive+** lock on the main database file.+**+** If op is one, then change from locking_mode=NORMAL into +** locking_mode=EXCLUSIVE. This means that the pWal->readLock must+** be released. Return 1 if the transition is made and 0 if the+** WAL is already in exclusive-locking mode - meaning that this+** routine is a no-op. The pager must already hold the exclusive lock+** on the main database file before invoking this operation.+**+** If op is negative, then do a dry-run of the op==1 case but do+** not actually change anything. The pager uses this to see if it+** should acquire the database exclusive lock prior to invoking+** the op==1 case.+*/+SQLITE_PRIVATE int sqlite3WalExclusiveMode(Wal *pWal, int op){+ int rc;+ assert( pWal->writeLock==0 );+ assert( pWal->exclusiveMode!=WAL_HEAPMEMORY_MODE || op==-1 );++ /* pWal->readLock is usually set, but might be -1 if there was a + ** prior error while attempting to acquire are read-lock. This cannot + ** happen if the connection is actually in exclusive mode (as no xShmLock+ ** locks are taken in this case). Nor should the pager attempt to+ ** upgrade to exclusive-mode following such an error.+ */+ assert( pWal->readLock>=0 || pWal->lockError );+ assert( pWal->readLock>=0 || (op<=0 && pWal->exclusiveMode==0) );++ if( op==0 ){+ if( pWal->exclusiveMode ){+ pWal->exclusiveMode = 0;+ if( walLockShared(pWal, WAL_READ_LOCK(pWal->readLock))!=SQLITE_OK ){+ pWal->exclusiveMode = 1;+ }+ rc = pWal->exclusiveMode==0;+ }else{+ /* Already in locking_mode=NORMAL */+ rc = 0;+ }+ }else if( op>0 ){+ assert( pWal->exclusiveMode==0 );+ assert( pWal->readLock>=0 );+ walUnlockShared(pWal, WAL_READ_LOCK(pWal->readLock));+ pWal->exclusiveMode = 1;+ rc = 1;+ }else{+ rc = pWal->exclusiveMode==0;+ }+ return rc;+}++#if 0+/* +** Return true if the argument is non-NULL and the WAL module is using+** heap-memory for the wal-index. Otherwise, if the argument is NULL or the+** WAL module is using shared-memory, return false. +*/+SQLITE_PRIVATE int sqlite3WalHeapMemory(Wal *pWal){+ return (pWal && pWal->exclusiveMode==WAL_HEAPMEMORY_MODE );+}+#endif++#ifdef SQLITE_ENABLE_ZIPVFS+/*+** If the argument is not NULL, it points to a Wal object that holds a+** read-lock. This function returns the database page-size if it is known,+** or zero if it is not (or if pWal is NULL).+*/+SQLITE_PRIVATE int sqlite3WalFramesize(Wal *pWal){+ assert( pWal==0 || pWal->readLock>=0 );+ return (pWal ? pWal->szPage : 0);+}+#endif++#endif /* #ifndef SQLITE_OMIT_WAL */++/************** End of wal.c *************************************************/+/************** Begin file btmutex.c *****************************************/+/*+** 2007 August 27+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file contains code used to implement mutexes on Btree objects.+** This code really belongs in btree.c. But btree.c is getting too+** big and we want to break it down some. This packaged seemed like+** a good breakout.+*/+/* #include "btreeInt.h" */+#ifndef SQLITE_OMIT_SHARED_CACHE+#if SQLITE_THREADSAFE++/*+** Obtain the BtShared mutex associated with B-Tree handle p. Also,+** set BtShared.db to the database handle associated with p and the+** p->locked boolean to true.+*/+static void lockBtreeMutex(Btree *p){+ assert( p->locked==0 );+ assert( sqlite3_mutex_notheld(p->pBt->mutex) );+ assert( sqlite3_mutex_held(p->mutex) );++ sqlite3_mutex_enter(p->pBt->mutex);+ p->pBt->pBt = p;+ p->locked = 1;+}++/*+** Release the BtShared mutex associated with B-Tree handle p and+** clear the p->locked boolean.+*/+static void SQLITE_NOINLINE unlockBtreeMutex(Btree *p){+ BtShared *pBt = p->pBt;+ assert( p->locked==1 );+ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( sqlite3_mutex_held(p->db->mutex) );+ assert( p->db==pBt->db );++ sqlite3_mutex_leave(pBt->mutex);+ p->locked = 0;+}++/* Forward reference */+static void SQLITE_NOINLINE btreeLockCarefully(Btree *p);++/*+** Enter a mutex on the given BTree object.+**+** If the object is not sharable, then no mutex is ever required+** and this routine is a no-op. The underlying mutex is non-recursive.+** But we keep a reference count in Btree.wantToLock so the behavior+** of this interface is recursive.+**+** To avoid deadlocks, multiple Btrees are locked in the same order+** by all database connections. The p->pNext is a list of other+** Btrees belonging to the same database connection as the p Btree+** which need to be locked after p. If we cannot get a lock on+** p, then first unlock all of the others on p->pNext, then wait+** for the lock to become available on p, then relock all of the+** subsequent Btrees that desire a lock.+*/+SQLITE_API void SQLITE_STDCALL sqlite3BtreeEnter(Btree *p){+ /* Some basic sanity checking on the Btree. The list of Btrees+ ** connected by pNext and pPrev should be in sorted order by+ ** Btree.pBt value. All elements of the list should belong to+ ** the same connection. Only shared Btrees are on the list. */+ assert( p->pNext==0 || p->pNext->pBt>p->pBt );+ assert( p->pPrev==0 || p->pPrev->pBt<p->pBt );+ assert( p->pNext==0 || p->pNext->db==p->db );+ assert( p->pPrev==0 || p->pPrev->db==p->db );+ assert( p->sharable || (p->pNext==0 && p->pPrev==0) );++ /* Check for locking consistency */+ assert( !p->locked || p->wantToLock>0 );+ assert( p->sharable || p->wantToLock==0 );++ /* We should already hold a lock on the database connection */+ assert( sqlite3_mutex_held(p->db->mutex) );++ /* Unless the database is sharable and unlocked, then BtShared.db+ ** should already be set correctly. */+ assert( (p->locked==0 && p->sharable) || p->pBt->db==p->db );++ if( !p->sharable ) return;+ p->wantToLock++;+ if( p->locked ) return;+ btreeLockCarefully(p);+}++/* This is a helper function for sqlite3BtreeLock(). By moving+** complex, but seldom used logic, out of sqlite3BtreeLock() and+** into this routine, we avoid unnecessary stack pointer changes+** and thus help the sqlite3BtreeLock() routine to run much faster+** in the common case.+*/+static void SQLITE_NOINLINE btreeLockCarefully(Btree *p){+ Btree *pLater;++ /* In most cases, we should be able to acquire the lock we+ ** want without having to go through the ascending lock+ ** procedure that follows. Just be sure not to block.+ */+ if( sqlite3_mutex_try(p->pBt->mutex)==SQLITE_OK ){+ p->pBt->pBt = p;+ p->locked = 1;+ return;+ }++ /* To avoid deadlock, first release all locks with a larger+ ** BtShared address. Then acquire our lock. Then reacquire+ ** the other BtShared locks that we used to hold in ascending+ ** order.+ */+ for(pLater=p->pNext; pLater; pLater=pLater->pNext){+ assert( pLater->sharable );+ assert( pLater->pNext==0 || pLater->pNext->pBt>pLater->pBt );+ assert( !pLater->locked || pLater->wantToLock>0 );+ if( pLater->locked ){+ unlockBtreeMutex(pLater);+ }+ }+ lockBtreeMutex(p);+ for(pLater=p->pNext; pLater; pLater=pLater->pNext){+ if( pLater->wantToLock ){+ lockBtreeMutex(pLater);+ }+ }+}+++/*+** Exit the recursive mutex on a Btree.+*/+SQLITE_API void SQLITE_STDCALL sqlite3BtreeLeave(Btree *p){+ assert( sqlite3_mutex_held(p->db->mutex) );+ if( p->sharable ){+ assert( p->wantToLock>0 );+ p->wantToLock--;+ if( p->wantToLock==0 ){+ unlockBtreeMutex(p);+ }+ }+}++#ifndef NDEBUG+/*+** Return true if the BtShared mutex is held on the btree, or if the+** B-Tree is not marked as sharable.+**+** This routine is used only from within assert() statements.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeHoldsMutex(Btree *p){+ assert( p->sharable==0 || p->locked==0 || p->wantToLock>0 );+ assert( p->sharable==0 || p->locked==0 || p->db==p->pBt->db );+ assert( p->sharable==0 || p->locked==0 || sqlite3_mutex_held(p->pBt->mutex) );+ assert( p->sharable==0 || p->locked==0 || sqlite3_mutex_held(p->db->mutex) );++ return (p->sharable==0 || p->locked);+}+#endif+++#ifndef SQLITE_OMIT_INCRBLOB+/*+** Enter and leave a mutex on a Btree given a cursor owned by that+** Btree. These entry points are used by incremental I/O and can be+** omitted if that module is not used.+*/+SQLITE_API void SQLITE_STDCALL sqlite3BtreeEnterCursor(BtCursor *pCur){+ sqlite3BtreeEnter(pCur->pBtree);+}+SQLITE_API void SQLITE_STDCALL sqlite3BtreeLeaveCursor(BtCursor *pCur){+ sqlite3BtreeLeave(pCur->pBtree);+}+#endif /* SQLITE_OMIT_INCRBLOB */++/*+** Return true if a particular Btree requires a lock. Return FALSE if+** no lock is ever required since it is not sharable.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSharable(Btree *p){+ return p->sharable;+}++#else /* SQLITE_THREADSAFE>0 above. SQLITE_THREADSAFE==0 below */+/*+** The following are special cases for mutex enter routines for use+** in single threaded applications that use shared cache. Except for+** these two routines, all mutex operations are no-ops in that case and+** are null #defines in btree.h.+**+** If shared cache is disabled, then all btree mutex routines, including+** the ones below, are no-ops and are null #defines in btree.h.+*/++SQLITE_API void SQLITE_STDCALL sqlite3BtreeEnter(Btree *p){+ p->pBt->db = p->db;+}+#endif /* if SQLITE_THREADSAFE */+#endif /* ifndef SQLITE_OMIT_SHARED_CACHE */++/************** End of btmutex.c *********************************************/+/************** Begin file btree.c *******************************************/+/*+** 2004 April 6+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file implements an external (disk-based) database using BTrees.+** See the header comment on "btreeInt.h" for additional information.+** Including a description of file format and an overview of operation.+*/+/* #include "btreeInt.h" */++/*+** The header string that appears at the beginning of every+** SQLite database.+*/+static const char zMagicHeader[] = SQLITE_FILE_HEADER;++/*+** Set this global variable to 1 to enable tracing using the TRACE+** macro.+*/+#if 0+int sqlite3BtreeTrace=1; /* True to enable tracing */+# define TRACE(X) if(sqlite3BtreeTrace){printf X;fflush(stdout);}+#else+# define TRACE(X)+#endif++/*+** Extract a 2-byte big-endian integer from an array of unsigned bytes.+** But if the value is zero, make it 65536.+**+** This routine is used to extract the "offset to cell content area" value+** from the header of a btree page. If the page size is 65536 and the page+** is empty, the offset should be 65536, but the 2-byte value stores zero.+** This routine makes the necessary adjustment to 65536.+*/+#define get2byteNotZero(X) (((((int)get2byte(X))-1)&0xffff)+1)++/*+** Values passed as the 5th argument to allocateBtreePage()+*/+#define BTALLOC_ANY 0 /* Allocate any page */+#define BTALLOC_EXACT 1 /* Allocate exact page if possible */+#define BTALLOC_LE 2 /* Allocate any page <= the parameter */++/*+** Macro IfNotOmitAV(x) returns (x) if SQLITE_OMIT_AUTOVACUUM is not +** defined, or 0 if it is. For example:+**+** bIncrVacuum = IfNotOmitAV(pBtShared->incrVacuum);+*/+#ifndef SQLITE_OMIT_AUTOVACUUM+#define IfNotOmitAV(expr) (expr)+#else+#define IfNotOmitAV(expr) 0+#endif++#ifndef SQLITE_OMIT_SHARED_CACHE+/*+** A list of BtShared objects that are eligible for participation+** in shared cache. This variable has file scope during normal builds,+** but the test harness needs to access it so we make it global for +** test builds.+**+** Access to this variable is protected by SQLITE_MUTEX_STATIC_MASTER.+*/+#ifdef SQLITE_TEST+SQLITE_PRIVATE BtShared *SQLITE_WSD sqlite3SharedCacheList = 0;+#else+static BtShared *SQLITE_WSD sqlite3SharedCacheList = 0;+#endif+#endif /* SQLITE_OMIT_SHARED_CACHE */++#ifdef SQLITE_OMIT_SHARED_CACHE+ /*+ ** The functions querySharedCacheTableLock(), setSharedCacheTableLock(),+ ** and clearAllSharedCacheTableLocks()+ ** manipulate entries in the BtShared.pLock linked list used to store+ ** shared-cache table level locks. If the library is compiled with the+ ** shared-cache feature disabled, then there is only ever one user+ ** of each BtShared structure and so this locking is not necessary. + ** So define the lock related functions as no-ops.+ */+ #define querySharedCacheTableLock(a,b,c) SQLITE_OK+ #define setSharedCacheTableLock(a,b,c) SQLITE_OK+ #define clearAllSharedCacheTableLocks(a)+ #define downgradeAllSharedCacheTableLocks(a)+ #define hasSharedCacheTableLock(a,b,c,d) 1+ #define hasReadConflicts(a, b) 0+#endif++#ifndef SQLITE_OMIT_SHARED_CACHE++#ifdef SQLITE_DEBUG+/*+**** This function is only used as part of an assert() statement. ***+**+** Check to see if pBtree holds the required locks to read or write to the +** table with root page iRoot. Return 1 if it does and 0 if not.+**+** For example, when writing to a table with root-page iRoot via +** Btree connection pBtree:+**+** assert( hasSharedCacheTableLock(pBtree, iRoot, 0, WRITE_LOCK) );+**+** When writing to an index that resides in a sharable database, the +** caller should have first obtained a lock specifying the root page of+** the corresponding table. This makes things a bit more complicated,+** as this module treats each table as a separate structure. To determine+** the table corresponding to the index being written, this+** function has to search through the database schema.+**+** Instead of a lock on the table/index rooted at page iRoot, the caller may+** hold a write-lock on the schema table (root page 1). This is also+** acceptable.+*/+static int hasSharedCacheTableLock(+ Btree *pBtree, /* Handle that must hold lock */+ Pgno iRoot, /* Root page of b-tree */+ int isIndex, /* True if iRoot is the root of an index b-tree */+ int eLockType /* Required lock type (READ_LOCK or WRITE_LOCK) */+){+ Schema *pSchema = (Schema *)pBtree->pBt->pSchema;+ Pgno iTab = 0;+ BtLock *pLock;++ /* If this database is not shareable, or if the client is reading+ ** and has the read-uncommitted flag set, then no lock is required. + ** Return true immediately.+ */+ if( (pBtree->sharable==0)+ || (eLockType==READ_LOCK && (pBtree->flags & SQLITE_ReadUncommitted))+ ){+ return 1;+ }++ /* If the client is reading or writing an index and the schema is+ ** not loaded, then it is too difficult to actually check to see if+ ** the correct locks are held. So do not bother - just return true.+ ** This case does not come up very often anyhow.+ */+ if( isIndex && (!pSchema || (pSchema->schemaFlags&DB_SchemaLoaded)==0) ){+ return 1;+ }++ /* Figure out the root-page that the lock should be held on. For table+ ** b-trees, this is just the root page of the b-tree being read or+ ** written. For index b-trees, it is the root page of the associated+ ** table. */+ if( isIndex ){+ HashElem *p;+ for(p=sqliteHashFirst(&pSchema->idxHash); p; p=sqliteHashNext(p)){+ Index *pIdx = (Index *)sqliteHashData(p);+ if( pIdx->tnum==(int)iRoot ){+ if( iTab ){+ /* Two or more indexes share the same root page. There must+ ** be imposter tables. So just return true. The assert is not+ ** useful in that case. */+ return 1;+ }+ iTab = pIdx->pTable->tnum;+ }+ }+ }else{+ iTab = iRoot;+ }++ /* Search for the required lock. Either a write-lock on root-page iTab, a + ** write-lock on the schema table, or (if the client is reading) a+ ** read-lock on iTab will suffice. Return 1 if any of these are found. */+ for(pLock=pBtree->pBt->pLock; pLock; pLock=pLock->pNext){+ if( pLock->pBtree==pBtree + && (pLock->iTable==iTab || (pLock->eLock==WRITE_LOCK && pLock->iTable==1))+ && pLock->eLock>=eLockType + ){+ return 1;+ }+ }++ /* Failed to find the required lock. */+ return 0;+}+#endif /* SQLITE_DEBUG */++#ifdef SQLITE_DEBUG+/*+**** This function may be used as part of assert() statements only. ****+**+** Return true if it would be illegal for pBtree to write into the+** table or index rooted at iRoot because other shared connections are+** simultaneously reading that same table or index.+**+** It is illegal for pBtree to write if some other Btree object that+** shares the same BtShared object is currently reading or writing+** the iRoot table. Except, if the other Btree object has the+** read-uncommitted flag set, then it is OK for the other object to+** have a read cursor.+**+** For example, before writing to any part of the table or index+** rooted at page iRoot, one should call:+**+** assert( !hasReadConflicts(pBtree, iRoot) );+*/+static int hasReadConflicts(Btree *pBtree, Pgno iRoot){+ BtCursor *p;+ for(p=pBtree->pBt->pCursor; p; p=p->pNext){+ if( p->pgnoRoot==iRoot + && p->pBtree!=pBtree+ && 0==(p->pBtree->flags & SQLITE_ReadUncommitted)+ ){+ return 1;+ }+ }+ return 0;+}+#endif /* #ifdef SQLITE_DEBUG */++/*+** Query to see if Btree handle p may obtain a lock of type eLock +** (READ_LOCK or WRITE_LOCK) on the table with root-page iTab. Return+** SQLITE_OK if the lock may be obtained (by calling+** setSharedCacheTableLock()), or SQLITE_LOCKED if not.+*/+static int querySharedCacheTableLock(Btree *p, Pgno iTab, u8 eLock){+ BtShared *pBt = p->pBt;+ BtLock *pIter;++ assert( sqlite3BtreeHoldsMutex(p) );+ assert( eLock==READ_LOCK || eLock==WRITE_LOCK );+ assert( !(p->flags&SQLITE_ReadUncommitted)||eLock==WRITE_LOCK||iTab==1 );+ + /* If requesting a write-lock, then the Btree must have an open write+ ** transaction on this file. And, obviously, for this to be so there + ** must be an open write transaction on the file itself.+ */+ assert( eLock==READ_LOCK || (p==pBt->pWriter && p->inTrans==TRANS_WRITE) );+ assert( eLock==READ_LOCK || pBt->inTransaction==TRANS_WRITE );+ + /* This routine is a no-op if the shared-cache is not enabled */+ if( !p->sharable ){+ return SQLITE_OK;+ }++ /* If some other connection is holding an exclusive lock, the+ ** requested lock may not be obtained.+ */+ if( pBt->pWriter!=p && (pBt->btsFlags & BTS_EXCLUSIVE)!=0 ){+ sqlite3ConnectionBlocked(p->db, pBt->pWriter->db);+ return SQLITE_LOCKED_SHAREDCACHE;+ }++ for(pIter=pBt->pLock; pIter; pIter=pIter->pNext){+ /* The condition (pIter->eLock!=eLock) in the following if(...) + ** statement is a simplification of:+ **+ ** (eLock==WRITE_LOCK || pIter->eLock==WRITE_LOCK)+ **+ ** since we know that if eLock==WRITE_LOCK, then no other connection+ ** may hold a WRITE_LOCK on any table in this file (since there can+ ** only be a single writer).+ */+ assert( pIter->eLock==READ_LOCK || pIter->eLock==WRITE_LOCK );+ assert( eLock==READ_LOCK || pIter->pBtree==p || pIter->eLock==READ_LOCK);+ if( pIter->pBtree!=p && pIter->iTable==iTab && pIter->eLock!=eLock ){+ sqlite3ConnectionBlocked(p->db, pIter->pBtree->db);+ if( eLock==WRITE_LOCK ){+ assert( p==pBt->pWriter );+ pBt->btsFlags |= BTS_PENDING;+ }+ return SQLITE_LOCKED_SHAREDCACHE;+ }+ }+ return SQLITE_OK;+}+#endif /* !SQLITE_OMIT_SHARED_CACHE */++#ifndef SQLITE_OMIT_SHARED_CACHE+/*+** Add a lock on the table with root-page iTable to the shared-btree used+** by Btree handle p. Parameter eLock must be either READ_LOCK or +** WRITE_LOCK.+**+** This function assumes the following:+**+** (a) The specified Btree object p is connected to a sharable+** database (one with the BtShared.sharable flag set), and+**+** (b) No other Btree objects hold a lock that conflicts+** with the requested lock (i.e. querySharedCacheTableLock() has+** already been called and returned SQLITE_OK).+**+** SQLITE_OK is returned if the lock is added successfully. SQLITE_NOMEM +** is returned if a malloc attempt fails.+*/+static int setSharedCacheTableLock(Btree *p, Pgno iTable, u8 eLock){+ BtShared *pBt = p->pBt;+ BtLock *pLock = 0;+ BtLock *pIter;++ assert( sqlite3BtreeHoldsMutex(p) );+ assert( eLock==READ_LOCK || eLock==WRITE_LOCK );+ assert( p->db!=0 );++ /* A connection with the read-uncommitted flag set will never try to+ ** obtain a read-lock using this function. The only read-lock obtained+ ** by a connection in read-uncommitted mode is on the sqlite_master + ** table, and that lock is obtained in BtreeBeginTrans(). */+ assert( 0==(p->db->flags&SQLITE_ReadUncommitted) || eLock==WRITE_LOCK );++ /* This function should only be called on a sharable b-tree after it + ** has been determined that no other b-tree holds a conflicting lock. */+ assert( p->sharable );+ assert( SQLITE_OK==querySharedCacheTableLock(p, iTable, eLock) );++ /* First search the list for an existing lock on this table. */+ for(pIter=pBt->pLock; pIter; pIter=pIter->pNext){+ if( pIter->iTable==iTable && pIter->pBtree==p ){+ pLock = pIter;+ break;+ }+ }++ /* If the above search did not find a BtLock struct associating Btree p+ ** with table iTable, allocate one and link it into the list.+ */+ if( !pLock ){+ pLock = (BtLock *)sqlite3MallocZero(sizeof(BtLock));+ if( !pLock ){+ return SQLITE_NOMEM;+ }+ pLock->iTable = iTable;+ pLock->pBtree = p;+ pLock->pNext = pBt->pLock;+ pBt->pLock = pLock;+ }++ /* Set the BtLock.eLock variable to the maximum of the current lock+ ** and the requested lock. This means if a write-lock was already held+ ** and a read-lock requested, we don't incorrectly downgrade the lock.+ */+ assert( WRITE_LOCK>READ_LOCK );+ if( eLock>pLock->eLock ){+ pLock->eLock = eLock;+ }++ return SQLITE_OK;+}+#endif /* !SQLITE_OMIT_SHARED_CACHE */++#ifndef SQLITE_OMIT_SHARED_CACHE+/*+** Release all the table locks (locks obtained via calls to+** the setSharedCacheTableLock() procedure) held by Btree object p.+**+** This function assumes that Btree p has an open read or write +** transaction. If it does not, then the BTS_PENDING flag+** may be incorrectly cleared.+*/+static void clearAllSharedCacheTableLocks(Btree *p){+ BtShared *pBt = p->pBt;+ BtLock **ppIter = &pBt->pLock;++ assert( sqlite3BtreeHoldsMutex(p) );+ assert( p->sharable || 0==*ppIter );+ assert( p->inTrans>0 );++ while( *ppIter ){+ BtLock *pLock = *ppIter;+ assert( (pBt->btsFlags & BTS_EXCLUSIVE)==0 || pBt->pWriter==pLock->pBtree );+ assert( pLock->pBtree->inTrans>=pLock->eLock );+ if( pLock->pBtree==p ){+ *ppIter = pLock->pNext;+ assert( pLock->iTable!=1 || pLock==&p->lock );+ if( pLock->iTable!=1 ){+ sqlite3_free(pLock);+ }+ }else{+ ppIter = &pLock->pNext;+ }+ }++ assert( (pBt->btsFlags & BTS_PENDING)==0 || pBt->pWriter );+ if( pBt->pWriter==p ){+ pBt->pWriter = 0;+ pBt->btsFlags &= ~(BTS_EXCLUSIVE|BTS_PENDING);+ }else if( pBt->nTransaction==2 ){+ /* This function is called when Btree p is concluding its + ** transaction. If there currently exists a writer, and p is not+ ** that writer, then the number of locks held by connections other+ ** than the writer must be about to drop to zero. In this case+ ** set the BTS_PENDING flag to 0.+ **+ ** If there is not currently a writer, then BTS_PENDING must+ ** be zero already. So this next line is harmless in that case.+ */+ pBt->btsFlags &= ~BTS_PENDING;+ }+}++/*+** This function changes all write-locks held by Btree p into read-locks.+*/+static void downgradeAllSharedCacheTableLocks(Btree *p){+ BtShared *pBt = p->pBt;+ if( pBt->pWriter==p ){+ BtLock *pLock;+ pBt->pWriter = 0;+ pBt->btsFlags &= ~(BTS_EXCLUSIVE|BTS_PENDING);+ for(pLock=pBt->pLock; pLock; pLock=pLock->pNext){+ assert( pLock->eLock==READ_LOCK || pLock->pBtree==p );+ pLock->eLock = READ_LOCK;+ }+ }+}++#endif /* SQLITE_OMIT_SHARED_CACHE */++static void releasePage(MemPage *pPage); /* Forward reference */++/*+***** This routine is used inside of assert() only ****+**+** Verify that the cursor holds the mutex on its BtShared+*/+#ifdef SQLITE_DEBUG+static int cursorHoldsMutex(BtCursor *p){+ return sqlite3_mutex_held(p->pBt->mutex);+}+#endif++/*+** Invalidate the overflow cache of the cursor passed as the first argument.+** on the shared btree structure pBt.+*/+#define invalidateOverflowCache(pCur) (pCur->curFlags &= ~BTCF_ValidOvfl)++/*+** Invalidate the overflow page-list cache for all cursors opened+** on the shared btree structure pBt.+*/+static void invalidateAllOverflowCache(BtShared *pBt){+ BtCursor *p;+ assert( sqlite3_mutex_held(pBt->mutex) );+ for(p=pBt->pCursor; p; p=p->pNext){+ invalidateOverflowCache(p);+ }+}++#ifndef SQLITE_OMIT_INCRBLOB+/*+** This function is called before modifying the contents of a table+** to invalidate any incrblob cursors that are open on the+** row or one of the rows being modified.+**+** If argument isClearTable is true, then the entire contents of the+** table is about to be deleted. In this case invalidate all incrblob+** cursors open on any row within the table with root-page pgnoRoot.+**+** Otherwise, if argument isClearTable is false, then the row with+** rowid iRow is being replaced or deleted. In this case invalidate+** only those incrblob cursors open on that specific row.+*/+static void invalidateIncrblobCursors(+ Btree *pBtree, /* The database file to check */+ i64 iRow, /* The rowid that might be changing */+ int isClearTable /* True if all rows are being deleted */+){+ BtCursor *p;+ if( pBtree->hasIncrblobCur==0 ) return;+ assert( sqlite3BtreeHoldsMutex(pBtree) );+ pBtree->hasIncrblobCur = 0;+ for(p=pBtree->pBt->pCursor; p; p=p->pNext){+ if( (p->curFlags & BTCF_Incrblob)!=0 ){+ pBtree->hasIncrblobCur = 1;+ if( isClearTable || p->info.nKey==iRow ){+ p->eState = CURSOR_INVALID;+ }+ }+ }+}++#else+ /* Stub function when INCRBLOB is omitted */+ #define invalidateIncrblobCursors(x,y,z)+#endif /* SQLITE_OMIT_INCRBLOB */++/*+** Set bit pgno of the BtShared.pHasContent bitvec. This is called +** when a page that previously contained data becomes a free-list leaf +** page.+**+** The BtShared.pHasContent bitvec exists to work around an obscure+** bug caused by the interaction of two useful IO optimizations surrounding+** free-list leaf pages:+**+** 1) When all data is deleted from a page and the page becomes+** a free-list leaf page, the page is not written to the database+** (as free-list leaf pages contain no meaningful data). Sometimes+** such a page is not even journalled (as it will not be modified,+** why bother journalling it?).+**+** 2) When a free-list leaf page is reused, its content is not read+** from the database or written to the journal file (why should it+** be, if it is not at all meaningful?).+**+** By themselves, these optimizations work fine and provide a handy+** performance boost to bulk delete or insert operations. However, if+** a page is moved to the free-list and then reused within the same+** transaction, a problem comes up. If the page is not journalled when+** it is moved to the free-list and it is also not journalled when it+** is extracted from the free-list and reused, then the original data+** may be lost. In the event of a rollback, it may not be possible+** to restore the database to its original configuration.+**+** The solution is the BtShared.pHasContent bitvec. Whenever a page is +** moved to become a free-list leaf page, the corresponding bit is+** set in the bitvec. Whenever a leaf page is extracted from the free-list,+** optimization 2 above is omitted if the corresponding bit is already+** set in BtShared.pHasContent. The contents of the bitvec are cleared+** at the end of every transaction.+*/+static int btreeSetHasContent(BtShared *pBt, Pgno pgno){+ int rc = SQLITE_OK;+ if( !pBt->pHasContent ){+ assert( pgno<=pBt->nPage );+ pBt->pHasContent = sqlite3BitvecCreate(pBt->nPage);+ if( !pBt->pHasContent ){+ rc = SQLITE_NOMEM;+ }+ }+ if( rc==SQLITE_OK && pgno<=sqlite3BitvecSize(pBt->pHasContent) ){+ rc = sqlite3BitvecSet(pBt->pHasContent, pgno);+ }+ return rc;+}++/*+** Query the BtShared.pHasContent vector.+**+** This function is called when a free-list leaf page is removed from the+** free-list for reuse. It returns false if it is safe to retrieve the+** page from the pager layer with the 'no-content' flag set. True otherwise.+*/+static int btreeGetHasContent(BtShared *pBt, Pgno pgno){+ Bitvec *p = pBt->pHasContent;+ return (p && (pgno>sqlite3BitvecSize(p) || sqlite3BitvecTest(p, pgno)));+}++/*+** Clear (destroy) the BtShared.pHasContent bitvec. This should be+** invoked at the conclusion of each write-transaction.+*/+static void btreeClearHasContent(BtShared *pBt){+ sqlite3BitvecDestroy(pBt->pHasContent);+ pBt->pHasContent = 0;+}++/*+** Release all of the apPage[] pages for a cursor.+*/+static void btreeReleaseAllCursorPages(BtCursor *pCur){+ int i;+ for(i=0; i<=pCur->iPage; i++){+ releasePage(pCur->apPage[i]);+ pCur->apPage[i] = 0;+ }+ pCur->iPage = -1;+}++/*+** The cursor passed as the only argument must point to a valid entry+** when this function is called (i.e. have eState==CURSOR_VALID). This+** function saves the current cursor key in variables pCur->nKey and+** pCur->pKey. SQLITE_OK is returned if successful or an SQLite error +** code otherwise.+**+** If the cursor is open on an intkey table, then the integer key+** (the rowid) is stored in pCur->nKey and pCur->pKey is left set to+** NULL. If the cursor is open on a non-intkey table, then pCur->pKey is +** set to point to a malloced buffer pCur->nKey bytes in size containing +** the key.+*/+static int saveCursorKey(BtCursor *pCur){+ int rc;+ assert( CURSOR_VALID==pCur->eState );+ assert( 0==pCur->pKey );+ assert( cursorHoldsMutex(pCur) );++ rc = sqlite3BtreeKeySize(pCur, &pCur->nKey);+ assert( rc==SQLITE_OK ); /* KeySize() cannot fail */++ /* If this is an intKey table, then the above call to BtreeKeySize()+ ** stores the integer key in pCur->nKey. In this case this value is+ ** all that is required. Otherwise, if pCur is not open on an intKey+ ** table, then malloc space for and store the pCur->nKey bytes of key + ** data. */+ if( 0==pCur->curIntKey ){+ void *pKey = sqlite3Malloc( pCur->nKey );+ if( pKey ){+ rc = sqlite3BtreeKey(pCur, 0, (int)pCur->nKey, pKey);+ if( rc==SQLITE_OK ){+ pCur->pKey = pKey;+ }else{+ sqlite3_free(pKey);+ }+ }else{+ rc = SQLITE_NOMEM;+ }+ }+ assert( !pCur->curIntKey || !pCur->pKey );+ return rc;+}++/*+** Save the current cursor position in the variables BtCursor.nKey +** and BtCursor.pKey. The cursor's state is set to CURSOR_REQUIRESEEK.+**+** The caller must ensure that the cursor is valid (has eState==CURSOR_VALID)+** prior to calling this routine. +*/+static int saveCursorPosition(BtCursor *pCur){+ int rc;++ assert( CURSOR_VALID==pCur->eState || CURSOR_SKIPNEXT==pCur->eState );+ assert( 0==pCur->pKey );+ assert( cursorHoldsMutex(pCur) );++ if( pCur->eState==CURSOR_SKIPNEXT ){+ pCur->eState = CURSOR_VALID;+ }else{+ pCur->skipNext = 0;+ }++ rc = saveCursorKey(pCur);+ if( rc==SQLITE_OK ){+ btreeReleaseAllCursorPages(pCur);+ pCur->eState = CURSOR_REQUIRESEEK;+ }++ pCur->curFlags &= ~(BTCF_ValidNKey|BTCF_ValidOvfl|BTCF_AtLast);+ return rc;+}++/* Forward reference */+static int SQLITE_NOINLINE saveCursorsOnList(BtCursor*,Pgno,BtCursor*);++/*+** Save the positions of all cursors (except pExcept) that are open on+** the table with root-page iRoot. "Saving the cursor position" means that+** the location in the btree is remembered in such a way that it can be+** moved back to the same spot after the btree has been modified. This+** routine is called just before cursor pExcept is used to modify the+** table, for example in BtreeDelete() or BtreeInsert().+**+** If there are two or more cursors on the same btree, then all such +** cursors should have their BTCF_Multiple flag set. The btreeCursor()+** routine enforces that rule. This routine only needs to be called in+** the uncommon case when pExpect has the BTCF_Multiple flag set.+**+** If pExpect!=NULL and if no other cursors are found on the same root-page,+** then the BTCF_Multiple flag on pExpect is cleared, to avoid another+** pointless call to this routine.+**+** Implementation note: This routine merely checks to see if any cursors+** need to be saved. It calls out to saveCursorsOnList() in the (unusual)+** event that cursors are in need to being saved.+*/+static int saveAllCursors(BtShared *pBt, Pgno iRoot, BtCursor *pExcept){+ BtCursor *p;+ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( pExcept==0 || pExcept->pBt==pBt );+ for(p=pBt->pCursor; p; p=p->pNext){+ if( p!=pExcept && (0==iRoot || p->pgnoRoot==iRoot) ) break;+ }+ if( p ) return saveCursorsOnList(p, iRoot, pExcept);+ if( pExcept ) pExcept->curFlags &= ~BTCF_Multiple;+ return SQLITE_OK;+}++/* This helper routine to saveAllCursors does the actual work of saving+** the cursors if and when a cursor is found that actually requires saving.+** The common case is that no cursors need to be saved, so this routine is+** broken out from its caller to avoid unnecessary stack pointer movement.+*/+static int SQLITE_NOINLINE saveCursorsOnList(+ BtCursor *p, /* The first cursor that needs saving */+ Pgno iRoot, /* Only save cursor with this iRoot. Save all if zero */+ BtCursor *pExcept /* Do not save this cursor */+){+ do{+ if( p!=pExcept && (0==iRoot || p->pgnoRoot==iRoot) ){+ if( p->eState==CURSOR_VALID || p->eState==CURSOR_SKIPNEXT ){+ int rc = saveCursorPosition(p);+ if( SQLITE_OK!=rc ){+ return rc;+ }+ }else{+ testcase( p->iPage>0 );+ btreeReleaseAllCursorPages(p);+ }+ }+ p = p->pNext;+ }while( p );+ return SQLITE_OK;+}++/*+** Clear the current cursor position.+*/+SQLITE_API void SQLITE_STDCALL sqlite3BtreeClearCursor(BtCursor *pCur){+ assert( cursorHoldsMutex(pCur) );+ sqlite3_free(pCur->pKey);+ pCur->pKey = 0;+ pCur->eState = CURSOR_INVALID;+}++/*+** In this version of BtreeMoveto, pKey is a packed index record+** such as is generated by the OP_MakeRecord opcode. Unpack the+** record and then call BtreeMovetoUnpacked() to do the work.+*/+static int btreeMoveto(+ BtCursor *pCur, /* Cursor open on the btree to be searched */+ const void *pKey, /* Packed key if the btree is an index */+ i64 nKey, /* Integer key for tables. Size of pKey for indices */+ int bias, /* Bias search to the high end */+ int *pRes /* Write search results here */+){+ int rc; /* Status code */+ UnpackedRecord *pIdxKey; /* Unpacked index key */+ char aSpace[200]; /* Temp space for pIdxKey - to avoid a malloc */+ char *pFree = 0;++ if( pKey ){+ assert( nKey==(i64)(int)nKey );+ pIdxKey = sqlite3VdbeAllocUnpackedRecord(+ pCur->pKeyInfo, aSpace, sizeof(aSpace), &pFree+ );+ if( pIdxKey==0 ) return SQLITE_NOMEM;+ sqlite3VdbeRecordUnpack(pCur->pKeyInfo, (int)nKey, pKey, pIdxKey);+ if( pIdxKey->nField==0 ){+ sqlite3DbFree(pCur->pKeyInfo->pBtree, pFree);+ return SQLITE_CORRUPT_BKPT;+ }+ }else{+ pIdxKey = 0;+ }+ rc = sqlite3BtreeMovetoUnpacked(pCur, pIdxKey, nKey, bias, pRes);+ if( pFree ){+ sqlite3DbFree(pCur->pKeyInfo->pBtree, pFree);+ }+ return rc;+}++/*+** Restore the cursor to the position it was in (or as close to as possible)+** when saveCursorPosition() was called. Note that this call deletes the +** saved position info stored by saveCursorPosition(), so there can be+** at most one effective restoreCursorPosition() call after each +** saveCursorPosition().+*/+static int btreeRestoreCursorPosition(BtCursor *pCur){+ int rc;+ int skipNext;+ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState>=CURSOR_REQUIRESEEK );+ if( pCur->eState==CURSOR_FAULT ){+ return pCur->skipNext;+ }+ pCur->eState = CURSOR_INVALID;+ rc = btreeMoveto(pCur, pCur->pKey, pCur->nKey, 0, &skipNext);+ if( rc==SQLITE_OK ){+ sqlite3_free(pCur->pKey);+ pCur->pKey = 0;+ assert( pCur->eState==CURSOR_VALID || pCur->eState==CURSOR_INVALID );+ pCur->skipNext |= skipNext;+ if( pCur->skipNext && pCur->eState==CURSOR_VALID ){+ pCur->eState = CURSOR_SKIPNEXT;+ }+ }+ return rc;+}++#define restoreCursorPosition(p) \+ (p->eState>=CURSOR_REQUIRESEEK ? \+ btreeRestoreCursorPosition(p) : \+ SQLITE_OK)++/*+** Determine whether or not a cursor has moved from the position where+** it was last placed, or has been invalidated for any other reason.+** Cursors can move when the row they are pointing at is deleted out+** from under them, for example. Cursor might also move if a btree+** is rebalanced.+**+** Calling this routine with a NULL cursor pointer returns false.+**+** Use the separate sqlite3BtreeCursorRestore() routine to restore a cursor+** back to where it ought to be if this routine returns true.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCursorHasMoved(BtCursor *pCur){+ return pCur->eState!=CURSOR_VALID;+}++/*+** This routine restores a cursor back to its original position after it+** has been moved by some outside activity (such as a btree rebalance or+** a row having been deleted out from under the cursor). +**+** On success, the *pDifferentRow parameter is false if the cursor is left+** pointing at exactly the same row. *pDifferntRow is the row the cursor+** was pointing to has been deleted, forcing the cursor to point to some+** nearby row.+**+** This routine should only be called for a cursor that just returned+** TRUE from sqlite3BtreeCursorHasMoved().+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCursorRestore(BtCursor *pCur, int *pDifferentRow){+ int rc;++ assert( pCur!=0 );+ assert( pCur->eState!=CURSOR_VALID );+ rc = restoreCursorPosition(pCur);+ if( rc ){+ *pDifferentRow = 1;+ return rc;+ }+ if( pCur->eState!=CURSOR_VALID ){+ *pDifferentRow = 1;+ }else{+ assert( pCur->skipNext==0 );+ *pDifferentRow = 0;+ }+ return SQLITE_OK;+}++#ifndef SQLITE_OMIT_AUTOVACUUM+/*+** Given a page number of a regular database page, return the page+** number for the pointer-map page that contains the entry for the+** input page number.+**+** Return 0 (not a valid page) for pgno==1 since there is+** no pointer map associated with page 1. The integrity_check logic+** requires that ptrmapPageno(*,1)!=1.+*/+static Pgno ptrmapPageno(BtShared *pBt, Pgno pgno){+ int nPagesPerMapPage;+ Pgno iPtrMap, ret;+ assert( sqlite3_mutex_held(pBt->mutex) );+ if( pgno<2 ) return 0;+ nPagesPerMapPage = (pBt->usableSize/5)+1;+ iPtrMap = (pgno-2)/nPagesPerMapPage;+ ret = (iPtrMap*nPagesPerMapPage) + 2; + if( ret==PENDING_BYTE_PAGE(pBt) ){+ ret++;+ }+ return ret;+}++/*+** Write an entry into the pointer map.+**+** This routine updates the pointer map entry for page number 'key'+** so that it maps to type 'eType' and parent page number 'pgno'.+**+** If *pRC is initially non-zero (non-SQLITE_OK) then this routine is+** a no-op. If an error occurs, the appropriate error code is written+** into *pRC.+*/+static void ptrmapPut(BtShared *pBt, Pgno key, u8 eType, Pgno parent, int *pRC){+ DbPage *pDbPage; /* The pointer map page */+ u8 *pPtrmap; /* The pointer map data */+ Pgno iPtrmap; /* The pointer map page number */+ int offset; /* Offset in pointer map page */+ int rc; /* Return code from subfunctions */++ if( *pRC ) return;++ assert( sqlite3_mutex_held(pBt->mutex) );+ /* The master-journal page number must never be used as a pointer map page */+ assert( 0==PTRMAP_ISPAGE(pBt, PENDING_BYTE_PAGE(pBt)) );++ assert( pBt->autoVacuum );+ if( key==0 ){+ *pRC = SQLITE_CORRUPT_BKPT;+ return;+ }+ iPtrmap = PTRMAP_PAGENO(pBt, key);+ rc = sqlite3PagerGet(pBt->pPager, iPtrmap, &pDbPage);+ if( rc!=SQLITE_OK ){+ *pRC = rc;+ return;+ }+ offset = PTRMAP_PTROFFSET(iPtrmap, key);+ if( offset<0 ){+ *pRC = SQLITE_CORRUPT_BKPT;+ goto ptrmap_exit;+ }+ assert( offset <= (int)pBt->usableSize-5 );+ pPtrmap = (u8 *)sqlite3PagerGetData(pDbPage);++ if( eType!=pPtrmap[offset] || get4byte(&pPtrmap[offset+1])!=parent ){+ TRACE(("PTRMAP_UPDATE: %d->(%d,%d)\n", key, eType, parent));+ *pRC= rc = sqlite3PagerWrite(pDbPage);+ if( rc==SQLITE_OK ){+ pPtrmap[offset] = eType;+ put4byte(&pPtrmap[offset+1], parent);+ }+ }++ptrmap_exit:+ sqlite3PagerUnref(pDbPage);+}++/*+** Read an entry from the pointer map.+**+** This routine retrieves the pointer map entry for page 'key', writing+** the type and parent page number to *pEType and *pPgno respectively.+** An error code is returned if something goes wrong, otherwise SQLITE_OK.+*/+static int ptrmapGet(BtShared *pBt, Pgno key, u8 *pEType, Pgno *pPgno){+ DbPage *pDbPage; /* The pointer map page */+ int iPtrmap; /* Pointer map page index */+ u8 *pPtrmap; /* Pointer map page data */+ int offset; /* Offset of entry in pointer map */+ int rc;++ assert( sqlite3_mutex_held(pBt->mutex) );++ iPtrmap = PTRMAP_PAGENO(pBt, key);+ rc = sqlite3PagerGet(pBt->pPager, iPtrmap, &pDbPage);+ if( rc!=0 ){+ return rc;+ }+ pPtrmap = (u8 *)sqlite3PagerGetData(pDbPage);++ offset = PTRMAP_PTROFFSET(iPtrmap, key);+ if( offset<0 ){+ sqlite3PagerUnref(pDbPage);+ return SQLITE_CORRUPT_BKPT;+ }+ assert( offset <= (int)pBt->usableSize-5 );+ assert( pEType!=0 );+ *pEType = pPtrmap[offset];+ if( pPgno ) *pPgno = get4byte(&pPtrmap[offset+1]);++ sqlite3PagerUnref(pDbPage);+ if( *pEType<1 || *pEType>5 ) return SQLITE_CORRUPT_BKPT;+ return SQLITE_OK;+}++#else /* if defined SQLITE_OMIT_AUTOVACUUM */+ #define ptrmapPut(w,x,y,z,rc)+ #define ptrmapGet(w,x,y,z) SQLITE_OK+ #define ptrmapPutOvflPtr(x, y, rc)+#endif++/*+** Given a btree page and a cell index (0 means the first cell on+** the page, 1 means the second cell, and so forth) return a pointer+** to the cell content.+**+** findCellPastPtr() does the same except it skips past the initial+** 4-byte child pointer found on interior pages, if there is one.+**+** This routine works only for pages that do not contain overflow cells.+*/+#define findCell(P,I) \+ ((P)->aData + ((P)->maskPage & get2byteAligned(&(P)->aCellIdx[2*(I)])))+#define findCellPastPtr(P,I) \+ ((P)->aDataOfst + ((P)->maskPage & get2byteAligned(&(P)->aCellIdx[2*(I)])))+++/*+** This is common tail processing for btreeParseCellPtr() and+** btreeParseCellPtrIndex() for the case when the cell does not fit entirely+** on a single B-tree page. Make necessary adjustments to the CellInfo+** structure.+*/+static SQLITE_NOINLINE void btreeParseCellAdjustSizeForOverflow(+ MemPage *pPage, /* Page containing the cell */+ u8 *pCell, /* Pointer to the cell text. */+ CellInfo *pInfo /* Fill in this structure */+){+ /* If the payload will not fit completely on the local page, we have+ ** to decide how much to store locally and how much to spill onto+ ** overflow pages. The strategy is to minimize the amount of unused+ ** space on overflow pages while keeping the amount of local storage+ ** in between minLocal and maxLocal.+ **+ ** Warning: changing the way overflow payload is distributed in any+ ** way will result in an incompatible file format.+ */+ int minLocal; /* Minimum amount of payload held locally */+ int maxLocal; /* Maximum amount of payload held locally */+ int surplus; /* Overflow payload available for local storage */++ minLocal = pPage->minLocal;+ maxLocal = pPage->maxLocal;+ surplus = minLocal + (pInfo->nPayload - minLocal)%(pPage->pBt->usableSize-4);+ testcase( surplus==maxLocal );+ testcase( surplus==maxLocal+1 );+ if( surplus <= maxLocal ){+ pInfo->nLocal = (u16)surplus;+ }else{+ pInfo->nLocal = (u16)minLocal;+ }+ pInfo->iOverflow = (u16)(&pInfo->pPayload[pInfo->nLocal] - pCell);+ pInfo->nSize = pInfo->iOverflow + 4;+}++/*+** The following routines are implementations of the MemPage.xParseCell()+** method.+**+** Parse a cell content block and fill in the CellInfo structure.+**+** btreeParseCellPtr() => table btree leaf nodes+** btreeParseCellNoPayload() => table btree internal nodes+** btreeParseCellPtrIndex() => index btree nodes+**+** There is also a wrapper function btreeParseCell() that works for+** all MemPage types and that references the cell by index rather than+** by pointer.+*/+static void btreeParseCellPtrNoPayload(+ MemPage *pPage, /* Page containing the cell */+ u8 *pCell, /* Pointer to the cell text. */+ CellInfo *pInfo /* Fill in this structure */+){+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( pPage->leaf==0 );+ assert( pPage->noPayload );+ assert( pPage->childPtrSize==4 );+#ifndef SQLITE_DEBUG+ UNUSED_PARAMETER(pPage);+#endif+ pInfo->nSize = 4 + getVarint(&pCell[4], (u64*)&pInfo->nKey);+ pInfo->nPayload = 0;+ pInfo->nLocal = 0;+ pInfo->iOverflow = 0;+ pInfo->pPayload = 0;+ return;+}+static void btreeParseCellPtr(+ MemPage *pPage, /* Page containing the cell */+ u8 *pCell, /* Pointer to the cell text. */+ CellInfo *pInfo /* Fill in this structure */+){+ u8 *pIter; /* For scanning through pCell */+ u32 nPayload; /* Number of bytes of cell payload */+ u64 iKey; /* Extracted Key value */++ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( pPage->leaf==0 || pPage->leaf==1 );+ assert( pPage->intKeyLeaf || pPage->noPayload );+ assert( pPage->noPayload==0 );+ assert( pPage->intKeyLeaf );+ assert( pPage->childPtrSize==0 );+ pIter = pCell;++ /* The next block of code is equivalent to:+ **+ ** pIter += getVarint32(pIter, nPayload);+ **+ ** The code is inlined to avoid a function call.+ */+ nPayload = *pIter;+ if( nPayload>=0x80 ){+ u8 *pEnd = &pIter[8];+ nPayload &= 0x7f;+ do{+ nPayload = (nPayload<<7) | (*++pIter & 0x7f);+ }while( (*pIter)>=0x80 && pIter<pEnd );+ }+ pIter++;++ /* The next block of code is equivalent to:+ **+ ** pIter += getVarint(pIter, (u64*)&pInfo->nKey);+ **+ ** The code is inlined to avoid a function call.+ */+ iKey = *pIter;+ if( iKey>=0x80 ){+ u8 *pEnd = &pIter[7];+ iKey &= 0x7f;+ while(1){+ iKey = (iKey<<7) | (*++pIter & 0x7f);+ if( (*pIter)<0x80 ) break;+ if( pIter>=pEnd ){+ iKey = (iKey<<8) | *++pIter;+ break;+ }+ }+ }+ pIter++;++ pInfo->nKey = *(i64*)&iKey;+ pInfo->nPayload = nPayload;+ pInfo->pPayload = pIter;+ testcase( nPayload==pPage->maxLocal );+ testcase( nPayload==pPage->maxLocal+1 );+ if( nPayload<=pPage->maxLocal ){+ /* This is the (easy) common case where the entire payload fits+ ** on the local page. No overflow is required.+ */+ pInfo->nSize = nPayload + (u16)(pIter - pCell);+ if( pInfo->nSize<4 ) pInfo->nSize = 4;+ pInfo->nLocal = (u16)nPayload;+ pInfo->iOverflow = 0;+ }else{+ btreeParseCellAdjustSizeForOverflow(pPage, pCell, pInfo);+ }+}+static void btreeParseCellPtrIndex(+ MemPage *pPage, /* Page containing the cell */+ u8 *pCell, /* Pointer to the cell text. */+ CellInfo *pInfo /* Fill in this structure */+){+ u8 *pIter; /* For scanning through pCell */+ u32 nPayload; /* Number of bytes of cell payload */++ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( pPage->leaf==0 || pPage->leaf==1 );+ assert( pPage->intKeyLeaf==0 );+ assert( pPage->noPayload==0 );+ pIter = pCell + pPage->childPtrSize;+ nPayload = *pIter;+ if( nPayload>=0x80 ){+ u8 *pEnd = &pIter[8];+ nPayload &= 0x7f;+ do{+ nPayload = (nPayload<<7) | (*++pIter & 0x7f);+ }while( *(pIter)>=0x80 && pIter<pEnd );+ }+ pIter++;+ pInfo->nKey = nPayload;+ pInfo->nPayload = nPayload;+ pInfo->pPayload = pIter;+ testcase( nPayload==pPage->maxLocal );+ testcase( nPayload==pPage->maxLocal+1 );+ if( nPayload<=pPage->maxLocal ){+ /* This is the (easy) common case where the entire payload fits+ ** on the local page. No overflow is required.+ */+ pInfo->nSize = nPayload + (u16)(pIter - pCell);+ if( pInfo->nSize<4 ) pInfo->nSize = 4;+ pInfo->nLocal = (u16)nPayload;+ pInfo->iOverflow = 0;+ }else{+ btreeParseCellAdjustSizeForOverflow(pPage, pCell, pInfo);+ }+}+static void btreeParseCell(+ MemPage *pPage, /* Page containing the cell */+ int iCell, /* The cell index. First cell is 0 */+ CellInfo *pInfo /* Fill in this structure */+){+ pPage->xParseCell(pPage, findCell(pPage, iCell), pInfo);+}++/*+** The following routines are implementations of the MemPage.xCellSize+** method.+**+** Compute the total number of bytes that a Cell needs in the cell+** data area of the btree-page. The return number includes the cell+** data header and the local payload, but not any overflow page or+** the space used by the cell pointer.+**+** cellSizePtrNoPayload() => table internal nodes+** cellSizePtr() => all index nodes & table leaf nodes+*/+static u16 cellSizePtr(MemPage *pPage, u8 *pCell){+ u8 *pIter = pCell + pPage->childPtrSize; /* For looping over bytes of pCell */+ u8 *pEnd; /* End mark for a varint */+ u32 nSize; /* Size value to return */++#ifdef SQLITE_DEBUG+ /* The value returned by this function should always be the same as+ ** the (CellInfo.nSize) value found by doing a full parse of the+ ** cell. If SQLITE_DEBUG is defined, an assert() at the bottom of+ ** this function verifies that this invariant is not violated. */+ CellInfo debuginfo;+ pPage->xParseCell(pPage, pCell, &debuginfo);+#endif++ assert( pPage->noPayload==0 );+ nSize = *pIter;+ if( nSize>=0x80 ){+ pEnd = &pIter[8];+ nSize &= 0x7f;+ do{+ nSize = (nSize<<7) | (*++pIter & 0x7f);+ }while( *(pIter)>=0x80 && pIter<pEnd );+ }+ pIter++;+ if( pPage->intKey ){+ /* pIter now points at the 64-bit integer key value, a variable length + ** integer. The following block moves pIter to point at the first byte+ ** past the end of the key value. */+ pEnd = &pIter[9];+ while( (*pIter++)&0x80 && pIter<pEnd );+ }+ testcase( nSize==pPage->maxLocal );+ testcase( nSize==pPage->maxLocal+1 );+ if( nSize<=pPage->maxLocal ){+ nSize += (u32)(pIter - pCell);+ if( nSize<4 ) nSize = 4;+ }else{+ int minLocal = pPage->minLocal;+ nSize = minLocal + (nSize - minLocal) % (pPage->pBt->usableSize - 4);+ testcase( nSize==pPage->maxLocal );+ testcase( nSize==pPage->maxLocal+1 );+ if( nSize>pPage->maxLocal ){+ nSize = minLocal;+ }+ nSize += 4 + (u16)(pIter - pCell);+ }+ assert( nSize==debuginfo.nSize || CORRUPT_DB );+ return (u16)nSize;+}+static u16 cellSizePtrNoPayload(MemPage *pPage, u8 *pCell){+ u8 *pIter = pCell + 4; /* For looping over bytes of pCell */+ u8 *pEnd; /* End mark for a varint */++#ifdef SQLITE_DEBUG+ /* The value returned by this function should always be the same as+ ** the (CellInfo.nSize) value found by doing a full parse of the+ ** cell. If SQLITE_DEBUG is defined, an assert() at the bottom of+ ** this function verifies that this invariant is not violated. */+ CellInfo debuginfo;+ pPage->xParseCell(pPage, pCell, &debuginfo);+#else+ UNUSED_PARAMETER(pPage);+#endif++ assert( pPage->childPtrSize==4 );+ pEnd = pIter + 9;+ while( (*pIter++)&0x80 && pIter<pEnd );+ assert( debuginfo.nSize==(u16)(pIter - pCell) || CORRUPT_DB );+ return (u16)(pIter - pCell);+}+++#ifdef SQLITE_DEBUG+/* This variation on cellSizePtr() is used inside of assert() statements+** only. */+static u16 cellSize(MemPage *pPage, int iCell){+ return pPage->xCellSize(pPage, findCell(pPage, iCell));+}+#endif++#ifndef SQLITE_OMIT_AUTOVACUUM+/*+** If the cell pCell, part of page pPage contains a pointer+** to an overflow page, insert an entry into the pointer-map+** for the overflow page.+*/+static void ptrmapPutOvflPtr(MemPage *pPage, u8 *pCell, int *pRC){+ CellInfo info;+ if( *pRC ) return;+ assert( pCell!=0 );+ pPage->xParseCell(pPage, pCell, &info);+ if( info.iOverflow ){+ Pgno ovfl = get4byte(&pCell[info.iOverflow]);+ ptrmapPut(pPage->pBt, ovfl, PTRMAP_OVERFLOW1, pPage->pgno, pRC);+ }+}+#endif+++/*+** Defragment the page given. All Cells are moved to the+** end of the page and all free space is collected into one+** big FreeBlk that occurs in between the header and cell+** pointer array and the cell content area.+**+** EVIDENCE-OF: R-44582-60138 SQLite may from time to time reorganize a+** b-tree page so that there are no freeblocks or fragment bytes, all+** unused bytes are contained in the unallocated space region, and all+** cells are packed tightly at the end of the page.+*/+static int defragmentPage(MemPage *pPage){+ int i; /* Loop counter */+ int pc; /* Address of the i-th cell */+ int hdr; /* Offset to the page header */+ int size; /* Size of a cell */+ int usableSize; /* Number of usable bytes on a page */+ int cellOffset; /* Offset to the cell pointer array */+ int cbrk; /* Offset to the cell content area */+ int nCell; /* Number of cells on the page */+ unsigned char *data; /* The page data */+ unsigned char *temp; /* Temp area for cell content */+ unsigned char *src; /* Source of content */+ int iCellFirst; /* First allowable cell index */+ int iCellLast; /* Last possible cell index */+++ assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ assert( pPage->pBt!=0 );+ assert( pPage->pBt->usableSize <= SQLITE_MAX_PAGE_SIZE );+ assert( pPage->nOverflow==0 );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ temp = 0;+ src = data = pPage->aData;+ hdr = pPage->hdrOffset;+ cellOffset = pPage->cellOffset;+ nCell = pPage->nCell;+ assert( nCell==get2byte(&data[hdr+3]) );+ usableSize = pPage->pBt->usableSize;+ cbrk = usableSize;+ iCellFirst = cellOffset + 2*nCell;+ iCellLast = usableSize - 4;+ for(i=0; i<nCell; i++){+ u8 *pAddr; /* The i-th cell pointer */+ pAddr = &data[cellOffset + i*2];+ pc = get2byte(pAddr);+ testcase( pc==iCellFirst );+ testcase( pc==iCellLast );+ /* These conditions have already been verified in btreeInitPage()+ ** if PRAGMA cell_size_check=ON.+ */+ if( pc<iCellFirst || pc>iCellLast ){+ return SQLITE_CORRUPT_BKPT;+ }+ assert( pc>=iCellFirst && pc<=iCellLast );+ size = pPage->xCellSize(pPage, &src[pc]);+ cbrk -= size;+ if( cbrk<iCellFirst || pc+size>usableSize ){+ return SQLITE_CORRUPT_BKPT;+ }+ assert( cbrk+size<=usableSize && cbrk>=iCellFirst );+ testcase( cbrk+size==usableSize );+ testcase( pc+size==usableSize );+ put2byte(pAddr, cbrk);+ if( temp==0 ){+ int x;+ if( cbrk==pc ) continue;+ temp = sqlite3PagerTempSpace(pPage->pBt->pPager);+ x = get2byte(&data[hdr+5]);+ memcpy(&temp[x], &data[x], (cbrk+size) - x);+ src = temp;+ }+ memcpy(&data[cbrk], &src[pc], size);+ }+ assert( cbrk>=iCellFirst );+ put2byte(&data[hdr+5], cbrk);+ data[hdr+1] = 0;+ data[hdr+2] = 0;+ data[hdr+7] = 0;+ memset(&data[iCellFirst], 0, cbrk-iCellFirst);+ assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ if( cbrk-iCellFirst!=pPage->nFree ){+ return SQLITE_CORRUPT_BKPT;+ }+ return SQLITE_OK;+}++/*+** Search the free-list on page pPg for space to store a cell nByte bytes in+** size. If one can be found, return a pointer to the space and remove it+** from the free-list.+**+** If no suitable space can be found on the free-list, return NULL.+**+** This function may detect corruption within pPg. If corruption is+** detected then *pRc is set to SQLITE_CORRUPT and NULL is returned.+**+** Slots on the free list that are between 1 and 3 bytes larger than nByte+** will be ignored if adding the extra space to the fragmentation count+** causes the fragmentation count to exceed 60.+*/+static u8 *pageFindSlot(MemPage *pPg, int nByte, int *pRc){+ const int hdr = pPg->hdrOffset;+ u8 * const aData = pPg->aData;+ int iAddr = hdr + 1;+ int pc = get2byte(&aData[iAddr]);+ int x;+ int usableSize = pPg->pBt->usableSize;++ assert( pc>0 );+ do{+ int size; /* Size of the free slot */+ /* EVIDENCE-OF: R-06866-39125 Freeblocks are always connected in order of+ ** increasing offset. */+ if( pc>usableSize-4 || pc<iAddr+4 ){+ *pRc = SQLITE_CORRUPT_BKPT;+ return 0;+ }+ /* EVIDENCE-OF: R-22710-53328 The third and fourth bytes of each+ ** freeblock form a big-endian integer which is the size of the freeblock+ ** in bytes, including the 4-byte header. */+ size = get2byte(&aData[pc+2]);+ if( (x = size - nByte)>=0 ){+ testcase( x==4 );+ testcase( x==3 );+ if( pc < pPg->cellOffset+2*pPg->nCell || size+pc > usableSize ){+ *pRc = SQLITE_CORRUPT_BKPT;+ return 0;+ }else if( x<4 ){+ /* EVIDENCE-OF: R-11498-58022 In a well-formed b-tree page, the total+ ** number of bytes in fragments may not exceed 60. */+ if( aData[hdr+7]>57 ) return 0;++ /* Remove the slot from the free-list. Update the number of+ ** fragmented bytes within the page. */+ memcpy(&aData[iAddr], &aData[pc], 2);+ aData[hdr+7] += (u8)x;+ }else{+ /* The slot remains on the free-list. Reduce its size to account+ ** for the portion used by the new allocation. */+ put2byte(&aData[pc+2], x);+ }+ return &aData[pc + x];+ }+ iAddr = pc;+ pc = get2byte(&aData[pc]);+ }while( pc );++ return 0;+}++/*+** Allocate nByte bytes of space from within the B-Tree page passed+** as the first argument. Write into *pIdx the index into pPage->aData[]+** of the first byte of allocated space. Return either SQLITE_OK or+** an error code (usually SQLITE_CORRUPT).+**+** The caller guarantees that there is sufficient space to make the+** allocation. This routine might need to defragment in order to bring+** all the space together, however. This routine will avoid using+** the first two bytes past the cell pointer area since presumably this+** allocation is being made in order to insert a new cell, so we will+** also end up needing a new cell pointer.+*/+static int allocateSpace(MemPage *pPage, int nByte, int *pIdx){+ const int hdr = pPage->hdrOffset; /* Local cache of pPage->hdrOffset */+ u8 * const data = pPage->aData; /* Local cache of pPage->aData */+ int top; /* First byte of cell content area */+ int rc = SQLITE_OK; /* Integer return code */+ int gap; /* First byte of gap between cell pointers and cell content */+ + assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ assert( pPage->pBt );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( nByte>=0 ); /* Minimum cell size is 4 */+ assert( pPage->nFree>=nByte );+ assert( pPage->nOverflow==0 );+ assert( nByte < (int)(pPage->pBt->usableSize-8) );++ assert( pPage->cellOffset == hdr + 12 - 4*pPage->leaf );+ gap = pPage->cellOffset + 2*pPage->nCell;+ assert( gap<=65536 );+ /* EVIDENCE-OF: R-29356-02391 If the database uses a 65536-byte page size+ ** and the reserved space is zero (the usual value for reserved space)+ ** then the cell content offset of an empty page wants to be 65536.+ ** However, that integer is too large to be stored in a 2-byte unsigned+ ** integer, so a value of 0 is used in its place. */+ top = get2byte(&data[hdr+5]);+ assert( top<=(int)pPage->pBt->usableSize ); /* Prevent by getAndInitPage() */+ if( gap>top ){+ if( top==0 && pPage->pBt->usableSize==65536 ){+ top = 65536;+ }else{+ return SQLITE_CORRUPT_BKPT;+ }+ }++ /* If there is enough space between gap and top for one more cell pointer+ ** array entry offset, and if the freelist is not empty, then search the+ ** freelist looking for a free slot big enough to satisfy the request.+ */+ testcase( gap+2==top );+ testcase( gap+1==top );+ testcase( gap==top );+ if( (data[hdr+2] || data[hdr+1]) && gap+2<=top ){+ u8 *pSpace = pageFindSlot(pPage, nByte, &rc);+ if( pSpace ){+ assert( pSpace>=data && (pSpace - data)<65536 );+ *pIdx = (int)(pSpace - data);+ return SQLITE_OK;+ }else if( rc ){+ return rc;+ }+ }++ /* The request could not be fulfilled using a freelist slot. Check+ ** to see if defragmentation is necessary.+ */+ testcase( gap+2+nByte==top );+ if( gap+2+nByte>top ){+ assert( pPage->nCell>0 || CORRUPT_DB );+ rc = defragmentPage(pPage);+ if( rc ) return rc;+ top = get2byteNotZero(&data[hdr+5]);+ assert( gap+nByte<=top );+ }+++ /* Allocate memory from the gap in between the cell pointer array+ ** and the cell content area. The btreeInitPage() call has already+ ** validated the freelist. Given that the freelist is valid, there+ ** is no way that the allocation can extend off the end of the page.+ ** The assert() below verifies the previous sentence.+ */+ top -= nByte;+ put2byte(&data[hdr+5], top);+ assert( top+nByte <= (int)pPage->pBt->usableSize );+ *pIdx = top;+ return SQLITE_OK;+}++/*+** Return a section of the pPage->aData to the freelist.+** The first byte of the new free block is pPage->aData[iStart]+** and the size of the block is iSize bytes.+**+** Adjacent freeblocks are coalesced.+**+** Note that even though the freeblock list was checked by btreeInitPage(),+** that routine will not detect overlap between cells or freeblocks. Nor+** does it detect cells or freeblocks that encrouch into the reserved bytes+** at the end of the page. So do additional corruption checks inside this+** routine and return SQLITE_CORRUPT if any problems are found.+*/+static int freeSpace(MemPage *pPage, u16 iStart, u16 iSize){+ u16 iPtr; /* Address of ptr to next freeblock */+ u16 iFreeBlk; /* Address of the next freeblock */+ u8 hdr; /* Page header size. 0 or 100 */+ u8 nFrag = 0; /* Reduction in fragmentation */+ u16 iOrigSize = iSize; /* Original value of iSize */+ u32 iLast = pPage->pBt->usableSize-4; /* Largest possible freeblock offset */+ u32 iEnd = iStart + iSize; /* First byte past the iStart buffer */+ unsigned char *data = pPage->aData; /* Page content */++ assert( pPage->pBt!=0 );+ assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ assert( CORRUPT_DB || iStart>=pPage->hdrOffset+6+pPage->childPtrSize );+ assert( CORRUPT_DB || iEnd <= pPage->pBt->usableSize );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( iSize>=4 ); /* Minimum cell size is 4 */+ assert( iStart<=iLast );++ /* Overwrite deleted information with zeros when the secure_delete+ ** option is enabled */+ if( pPage->pBt->btsFlags & BTS_SECURE_DELETE ){+ memset(&data[iStart], 0, iSize);+ }++ /* The list of freeblocks must be in ascending order. Find the + ** spot on the list where iStart should be inserted.+ */+ hdr = pPage->hdrOffset;+ iPtr = hdr + 1;+ if( data[iPtr+1]==0 && data[iPtr]==0 ){+ iFreeBlk = 0; /* Shortcut for the case when the freelist is empty */+ }else{+ while( (iFreeBlk = get2byte(&data[iPtr]))>0 && iFreeBlk<iStart ){+ if( iFreeBlk<iPtr+4 ) return SQLITE_CORRUPT_BKPT;+ iPtr = iFreeBlk;+ }+ if( iFreeBlk>iLast ) return SQLITE_CORRUPT_BKPT;+ assert( iFreeBlk>iPtr || iFreeBlk==0 );+ + /* At this point:+ ** iFreeBlk: First freeblock after iStart, or zero if none+ ** iPtr: The address of a pointer to iFreeBlk+ **+ ** Check to see if iFreeBlk should be coalesced onto the end of iStart.+ */+ if( iFreeBlk && iEnd+3>=iFreeBlk ){+ nFrag = iFreeBlk - iEnd;+ if( iEnd>iFreeBlk ) return SQLITE_CORRUPT_BKPT;+ iEnd = iFreeBlk + get2byte(&data[iFreeBlk+2]);+ if( iEnd > pPage->pBt->usableSize ) return SQLITE_CORRUPT_BKPT;+ iSize = iEnd - iStart;+ iFreeBlk = get2byte(&data[iFreeBlk]);+ }+ + /* If iPtr is another freeblock (that is, if iPtr is not the freelist+ ** pointer in the page header) then check to see if iStart should be+ ** coalesced onto the end of iPtr.+ */+ if( iPtr>hdr+1 ){+ int iPtrEnd = iPtr + get2byte(&data[iPtr+2]);+ if( iPtrEnd+3>=iStart ){+ if( iPtrEnd>iStart ) return SQLITE_CORRUPT_BKPT;+ nFrag += iStart - iPtrEnd;+ iSize = iEnd - iPtr;+ iStart = iPtr;+ }+ }+ if( nFrag>data[hdr+7] ) return SQLITE_CORRUPT_BKPT;+ data[hdr+7] -= nFrag;+ }+ if( iStart==get2byte(&data[hdr+5]) ){+ /* The new freeblock is at the beginning of the cell content area,+ ** so just extend the cell content area rather than create another+ ** freelist entry */+ if( iPtr!=hdr+1 ) return SQLITE_CORRUPT_BKPT;+ put2byte(&data[hdr+1], iFreeBlk);+ put2byte(&data[hdr+5], iEnd);+ }else{+ /* Insert the new freeblock into the freelist */+ put2byte(&data[iPtr], iStart);+ put2byte(&data[iStart], iFreeBlk);+ put2byte(&data[iStart+2], iSize);+ }+ pPage->nFree += iOrigSize;+ return SQLITE_OK;+}++/*+** Decode the flags byte (the first byte of the header) for a page+** and initialize fields of the MemPage structure accordingly.+**+** Only the following combinations are supported. Anything different+** indicates a corrupt database files:+**+** PTF_ZERODATA+** PTF_ZERODATA | PTF_LEAF+** PTF_LEAFDATA | PTF_INTKEY+** PTF_LEAFDATA | PTF_INTKEY | PTF_LEAF+*/+static int decodeFlags(MemPage *pPage, int flagByte){+ BtShared *pBt; /* A copy of pPage->pBt */++ assert( pPage->hdrOffset==(pPage->pgno==1 ? 100 : 0) );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ pPage->leaf = (u8)(flagByte>>3); assert( PTF_LEAF == 1<<3 );+ flagByte &= ~PTF_LEAF;+ pPage->childPtrSize = 4-4*pPage->leaf;+ pPage->xCellSize = cellSizePtr;+ pBt = pPage->pBt;+ if( flagByte==(PTF_LEAFDATA | PTF_INTKEY) ){+ /* EVIDENCE-OF: R-03640-13415 A value of 5 means the page is an interior+ ** table b-tree page. */+ assert( (PTF_LEAFDATA|PTF_INTKEY)==5 );+ /* EVIDENCE-OF: R-20501-61796 A value of 13 means the page is a leaf+ ** table b-tree page. */+ assert( (PTF_LEAFDATA|PTF_INTKEY|PTF_LEAF)==13 );+ pPage->intKey = 1;+ if( pPage->leaf ){+ pPage->intKeyLeaf = 1;+ pPage->noPayload = 0;+ pPage->xParseCell = btreeParseCellPtr;+ }else{+ pPage->intKeyLeaf = 0;+ pPage->noPayload = 1;+ pPage->xCellSize = cellSizePtrNoPayload;+ pPage->xParseCell = btreeParseCellPtrNoPayload;+ }+ pPage->maxLocal = pBt->maxLeaf;+ pPage->minLocal = pBt->minLeaf;+ }else if( flagByte==PTF_ZERODATA ){+ /* EVIDENCE-OF: R-27225-53936 A value of 2 means the page is an interior+ ** index b-tree page. */+ assert( (PTF_ZERODATA)==2 );+ /* EVIDENCE-OF: R-16571-11615 A value of 10 means the page is a leaf+ ** index b-tree page. */+ assert( (PTF_ZERODATA|PTF_LEAF)==10 );+ pPage->intKey = 0;+ pPage->intKeyLeaf = 0;+ pPage->noPayload = 0;+ pPage->xParseCell = btreeParseCellPtrIndex;+ pPage->maxLocal = pBt->maxLocal;+ pPage->minLocal = pBt->minLocal;+ }else{+ /* EVIDENCE-OF: R-47608-56469 Any other value for the b-tree page type is+ ** an error. */+ return SQLITE_CORRUPT_BKPT;+ }+ pPage->max1bytePayload = pBt->max1bytePayload;+ return SQLITE_OK;+}++/*+** Initialize the auxiliary information for a disk block.+**+** Return SQLITE_OK on success. If we see that the page does+** not contain a well-formed database page, then return +** SQLITE_CORRUPT. Note that a return of SQLITE_OK does not+** guarantee that the page is well-formed. It only shows that+** we failed to detect any corruption.+*/+static int btreeInitPage(MemPage *pPage){++ assert( pPage->pBt!=0 );+ assert( pPage->pBt->db!=0 );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( pPage->pgno==sqlite3PagerPagenumber(pPage->pDbPage) );+ assert( pPage == sqlite3PagerGetExtra(pPage->pDbPage) );+ assert( pPage->aData == sqlite3PagerGetData(pPage->pDbPage) );++ if( !pPage->isInit ){+ u16 pc; /* Address of a freeblock within pPage->aData[] */+ u8 hdr; /* Offset to beginning of page header */+ u8 *data; /* Equal to pPage->aData */+ BtShared *pBt; /* The main btree structure */+ int usableSize; /* Amount of usable space on each page */+ u16 cellOffset; /* Offset from start of page to first cell pointer */+ int nFree; /* Number of unused bytes on the page */+ int top; /* First byte of the cell content area */+ int iCellFirst; /* First allowable cell or freeblock offset */+ int iCellLast; /* Last possible cell or freeblock offset */++ pBt = pPage->pBt;++ hdr = pPage->hdrOffset;+ data = pPage->aData;+ /* EVIDENCE-OF: R-28594-02890 The one-byte flag at offset 0 indicating+ ** the b-tree page type. */+ if( decodeFlags(pPage, data[hdr]) ) return SQLITE_CORRUPT_BKPT;+ assert( pBt->pageSize>=512 && pBt->pageSize<=65536 );+ pPage->maskPage = (u16)(pBt->pageSize - 1);+ pPage->nOverflow = 0;+ usableSize = pBt->usableSize;+ pPage->cellOffset = cellOffset = hdr + 8 + pPage->childPtrSize;+ pPage->aDataEnd = &data[usableSize];+ pPage->aCellIdx = &data[cellOffset];+ pPage->aDataOfst = &data[pPage->childPtrSize];+ /* EVIDENCE-OF: R-58015-48175 The two-byte integer at offset 5 designates+ ** the start of the cell content area. A zero value for this integer is+ ** interpreted as 65536. */+ top = get2byteNotZero(&data[hdr+5]);+ /* EVIDENCE-OF: R-37002-32774 The two-byte integer at offset 3 gives the+ ** number of cells on the page. */+ pPage->nCell = get2byte(&data[hdr+3]);+ if( pPage->nCell>MX_CELL(pBt) ){+ /* To many cells for a single page. The page must be corrupt */+ return SQLITE_CORRUPT_BKPT;+ }+ testcase( pPage->nCell==MX_CELL(pBt) );+ /* EVIDENCE-OF: R-24089-57979 If a page contains no cells (which is only+ ** possible for a root page of a table that contains no rows) then the+ ** offset to the cell content area will equal the page size minus the+ ** bytes of reserved space. */+ assert( pPage->nCell>0 || top==usableSize || CORRUPT_DB );++ /* A malformed database page might cause us to read past the end+ ** of page when parsing a cell. + **+ ** The following block of code checks early to see if a cell extends+ ** past the end of a page boundary and causes SQLITE_CORRUPT to be + ** returned if it does.+ */+ iCellFirst = cellOffset + 2*pPage->nCell;+ iCellLast = usableSize - 4;+ if( pBt->pBt->flags & SQLITE_CellSizeCk ){+ int i; /* Index into the cell pointer array */+ int sz; /* Size of a cell */++ if( !pPage->leaf ) iCellLast--;+ for(i=0; i<pPage->nCell; i++){+ pc = get2byteAligned(&data[cellOffset+i*2]);+ testcase( pc==iCellFirst );+ testcase( pc==iCellLast );+ if( pc<iCellFirst || pc>iCellLast ){+ return SQLITE_CORRUPT_BKPT;+ }+ sz = pPage->xCellSize(pPage, &data[pc]);+ testcase( pc+sz==usableSize );+ if( pc+sz>usableSize ){+ return SQLITE_CORRUPT_BKPT;+ }+ }+ if( !pPage->leaf ) iCellLast++;+ } ++ /* Compute the total free space on the page+ ** EVIDENCE-OF: R-23588-34450 The two-byte integer at offset 1 gives the+ ** start of the first freeblock on the page, or is zero if there are no+ ** freeblocks. */+ pc = get2byte(&data[hdr+1]);+ nFree = data[hdr+7] + top; /* Init nFree to non-freeblock free space */+ while( pc>0 ){+ u16 next, size;+ if( pc<iCellFirst || pc>iCellLast ){+ /* EVIDENCE-OF: R-55530-52930 In a well-formed b-tree page, there will+ ** always be at least one cell before the first freeblock.+ **+ ** Or, the freeblock is off the end of the page+ */+ return SQLITE_CORRUPT_BKPT; + }+ next = get2byte(&data[pc]);+ size = get2byte(&data[pc+2]);+ if( (next>0 && next<=pc+size+3) || pc+size>usableSize ){+ /* Free blocks must be in ascending order. And the last byte of+ ** the free-block must lie on the database page. */+ return SQLITE_CORRUPT_BKPT; + }+ nFree = nFree + size;+ pc = next;+ }++ /* At this point, nFree contains the sum of the offset to the start+ ** of the cell-content area plus the number of free bytes within+ ** the cell-content area. If this is greater than the usable-size+ ** of the page, then the page must be corrupted. This check also+ ** serves to verify that the offset to the start of the cell-content+ ** area, according to the page header, lies within the page.+ */+ if( nFree>usableSize ){+ return SQLITE_CORRUPT_BKPT; + }+ pPage->nFree = (u16)(nFree - iCellFirst);+ pPage->isInit = 1;+ }+ return SQLITE_OK;+}++/*+** Set up a raw page so that it looks like a database page holding+** no entries.+*/+static void zeroPage(MemPage *pPage, int flags){+ unsigned char *data = pPage->aData;+ BtShared *pBt = pPage->pBt;+ u8 hdr = pPage->hdrOffset;+ u16 first;++ assert( sqlite3PagerPagenumber(pPage->pDbPage)==pPage->pgno );+ assert( sqlite3PagerGetExtra(pPage->pDbPage) == (void*)pPage );+ assert( sqlite3PagerGetData(pPage->pDbPage) == data );+ assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ assert( sqlite3_mutex_held(pBt->mutex) );+ if( pBt->btsFlags & BTS_SECURE_DELETE ){+ memset(&data[hdr], 0, pBt->usableSize - hdr);+ }+ data[hdr] = (char)flags;+ first = hdr + ((flags&PTF_LEAF)==0 ? 12 : 8);+ memset(&data[hdr+1], 0, 4);+ data[hdr+7] = 0;+ put2byte(&data[hdr+5], pBt->usableSize);+ pPage->nFree = (u16)(pBt->usableSize - first);+ decodeFlags(pPage, flags);+ pPage->cellOffset = first;+ pPage->aDataEnd = &data[pBt->usableSize];+ pPage->aCellIdx = &data[first];+ pPage->aDataOfst = &data[pPage->childPtrSize];+ pPage->nOverflow = 0;+ assert( pBt->pageSize>=512 && pBt->pageSize<=65536 );+ pPage->maskPage = (u16)(pBt->pageSize - 1);+ pPage->nCell = 0;+ pPage->isInit = 1;+}+++/*+** Convert a DbPage obtained from the pager into a MemPage used by+** the btree layer.+*/+static MemPage *btreePageFromDbPage(DbPage *pDbPage, Pgno pgno, BtShared *pBt){+ MemPage *pPage = (MemPage*)sqlite3PagerGetExtra(pDbPage);+ pPage->aData = sqlite3PagerGetData(pDbPage);+ pPage->pDbPage = pDbPage;+ pPage->pBt = pBt;+ pPage->pgno = pgno;+ pPage->hdrOffset = pgno==1 ? 100 : 0;+ return pPage; +}++/*+** Get a page from the pager. Initialize the MemPage.pBt and+** MemPage.aData elements if needed. See also: btreeGetUnusedPage().+**+** If the PAGER_GET_NOCONTENT flag is set, it means that we do not care+** about the content of the page at this time. So do not go to the disk+** to fetch the content. Just fill in the content with zeros for now.+** If in the future we call sqlite3PagerWrite() on this page, that+** means we have started to be concerned about content and the disk+** read should occur at that point.+*/+static int btreeGetPage(+ BtShared *pBt, /* The btree */+ Pgno pgno, /* Number of the page to fetch */+ MemPage **ppPage, /* Return the page in this parameter */+ int flags /* PAGER_GET_NOCONTENT or PAGER_GET_READONLY */+){+ int rc;+ DbPage *pDbPage;++ assert( flags==0 || flags==PAGER_GET_NOCONTENT || flags==PAGER_GET_READONLY );+ assert( sqlite3_mutex_held(pBt->mutex) );+ rc = sqlite3PagerAcquire(pBt->pPager, pgno, (DbPage**)&pDbPage, flags);+ if( rc ) return rc;+ *ppPage = btreePageFromDbPage(pDbPage, pgno, pBt);+ return SQLITE_OK;+}++/*+** Retrieve a page from the pager cache. If the requested page is not+** already in the pager cache return NULL. Initialize the MemPage.pBt and+** MemPage.aData elements if needed.+*/+static MemPage *btreePageLookup(BtShared *pBt, Pgno pgno){+ DbPage *pDbPage;+ assert( sqlite3_mutex_held(pBt->mutex) );+ pDbPage = sqlite3PagerLookup(pBt->pPager, pgno);+ if( pDbPage ){+ return btreePageFromDbPage(pDbPage, pgno, pBt);+ }+ return 0;+}++/*+** Return the size of the database file in pages. If there is any kind of+** error, return ((unsigned int)-1).+*/+static Pgno btreePagecount(BtShared *pBt){+ return pBt->nPage;+}+SQLITE_API u32 SQLITE_STDCALL sqlite3BtreeLastPage(Btree *p){+ assert( sqlite3BtreeHoldsMutex(p) );+ assert( ((p->pBt->nPage)&0x8000000)==0 );+ return btreePagecount(p->pBt);+}++/*+** Get a page from the pager and initialize it.+**+** If pCur!=0 then the page is being fetched as part of a moveToChild()+** call. Do additional sanity checking on the page in this case.+** And if the fetch fails, this routine must decrement pCur->iPage.+**+** The page is fetched as read-write unless pCur is not NULL and is+** a read-only cursor.+**+** If an error occurs, then *ppPage is undefined. It+** may remain unchanged, or it may be set to an invalid value.+*/+static int getAndInitPage(+ BtShared *pBt, /* The database file */+ Pgno pgno, /* Number of the page to get */+ MemPage **ppPage, /* Write the page pointer here */+ BtCursor *pCur, /* Cursor to receive the page, or NULL */+ int bReadOnly /* True for a read-only page */+){+ int rc;+ DbPage *pDbPage;+ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( pCur==0 || ppPage==&pCur->apPage[pCur->iPage] );+ assert( pCur==0 || bReadOnly==pCur->curPagerFlags );+ assert( pCur==0 || pCur->iPage>0 );++ if( pgno>btreePagecount(pBt) ){+ rc = SQLITE_CORRUPT_BKPT;+ goto getAndInitPage_error;+ }+ rc = sqlite3PagerAcquire(pBt->pPager, pgno, (DbPage**)&pDbPage, bReadOnly);+ if( rc ){+ goto getAndInitPage_error;+ }+ *ppPage = btreePageFromDbPage(pDbPage, pgno, pBt);+ if( (*ppPage)->isInit==0 ){+ rc = btreeInitPage(*ppPage);+ if( rc!=SQLITE_OK ){+ releasePage(*ppPage);+ goto getAndInitPage_error;+ }+ }++ /* If obtaining a child page for a cursor, we must verify that the page is+ ** compatible with the root page. */+ if( pCur+ && ((*ppPage)->nCell<1 || (*ppPage)->intKey!=pCur->curIntKey)+ ){+ rc = SQLITE_CORRUPT_BKPT;+ releasePage(*ppPage);+ goto getAndInitPage_error;+ }+ return SQLITE_OK;++getAndInitPage_error:+ if( pCur ) pCur->iPage--;+ testcase( pgno==0 );+ assert( pgno!=0 || rc==SQLITE_CORRUPT );+ return rc;+}++/*+** Release a MemPage. This should be called once for each prior+** call to btreeGetPage.+*/+static void releasePageNotNull(MemPage *pPage){+ assert( pPage->aData );+ assert( pPage->pBt );+ assert( pPage->pDbPage!=0 );+ assert( sqlite3PagerGetExtra(pPage->pDbPage) == (void*)pPage );+ assert( sqlite3PagerGetData(pPage->pDbPage)==pPage->aData );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ sqlite3PagerUnrefNotNull(pPage->pDbPage);+}+static void releasePage(MemPage *pPage){+ if( pPage ) releasePageNotNull(pPage);+}++/*+** Get an unused page.+**+** This works just like btreeGetPage() with the addition:+**+** * If the page is already in use for some other purpose, immediately+** release it and return an SQLITE_CURRUPT error.+** * Make sure the isInit flag is clear+*/+static int btreeGetUnusedPage(+ BtShared *pBt, /* The btree */+ Pgno pgno, /* Number of the page to fetch */+ MemPage **ppPage, /* Return the page in this parameter */+ int flags /* PAGER_GET_NOCONTENT or PAGER_GET_READONLY */+){+ int rc = btreeGetPage(pBt, pgno, ppPage, flags);+ if( rc==SQLITE_OK ){+ if( sqlite3PagerPageRefcount((*ppPage)->pDbPage)>1 ){+ releasePage(*ppPage);+ *ppPage = 0;+ return SQLITE_CORRUPT_BKPT;+ }+ (*ppPage)->isInit = 0;+ }else{+ *ppPage = 0;+ }+ return rc;+}+++/*+** During a rollback, when the pager reloads information into the cache+** so that the cache is restored to its original state at the start of+** the transaction, for each page restored this routine is called.+**+** This routine needs to reset the extra data section at the end of the+** page to agree with the restored data.+*/+static void pageReinit(DbPage *pData){+ MemPage *pPage;+ pPage = (MemPage *)sqlite3PagerGetExtra(pData);+ assert( sqlite3PagerPageRefcount(pData)>0 );+ if( pPage->isInit ){+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ pPage->isInit = 0;+ if( sqlite3PagerPageRefcount(pData)>1 ){+ /* pPage might not be a btree page; it might be an overflow page+ ** or ptrmap page or a free page. In those cases, the following+ ** call to btreeInitPage() will likely return SQLITE_CORRUPT.+ ** But no harm is done by this. And it is very important that+ ** btreeInitPage() be called on every btree page so we make+ ** the call for every page that comes in for re-initing. */+ btreeInitPage(pPage);+ }+ }+}++/*+** Invoke the busy handler for a btree.+*/+static int btreeInvokeBusyHandler(void *pArg){+ BtShared *pBt = (BtShared*)pArg;+ assert( pBt->pBt );+ assert( sqlite3_mutex_held(pBt->pBt->mutex) );+ return sqlite3InvokeBusyHandler(&pBt->pBt->busyHandler);+}++/*+** Open a database file.+** +** zFilename is the name of the database file. If zFilename is NULL+** then an ephemeral database is created. The ephemeral database might+** be exclusively in memory, or it might use a disk-based memory cache.+** Either way, the ephemeral database will be automatically deleted +** when sqlite3BtreeClose() is called.+**+** If zFilename is ":memory:" then an in-memory database is created+** that is automatically destroyed when it is closed.+**+** The "flags" parameter is a bitmask that might contain bits like+** BTREE_OMIT_JOURNAL and/or BTREE_MEMORY.+**+** If the database is already opened in the same database connection+** and we are in shared cache mode, then the open will fail with an+** SQLITE_CONSTRAINT error. We cannot allow two or more BtShared+** objects in the same database connection since doing so will lead+** to problems with locking.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeOpen(+ const char *zVfs, /* VFS to use for this b-tree */+ const char *zFilename, /* Name of the file containing the BTree database */+ Btree **ppBtree, /* Pointer to new Btree object written here */+ int flags, /* Options */+ int vfsFlags /* Flags passed through to sqlite3_vfs.xOpen() */+){+ BtShared *pBt = 0; /* Shared part of btree structure */+ Btree *p; /* Handle to return */+ sqlite3_mutex *mutexOpen = 0; /* Prevents a race condition. Ticket #3537 */+ int rc = SQLITE_OK; /* Result code from this function */+ u8 nReserve; /* Byte of unused space on each page */+ unsigned char zDbHeader[100]; /* Database header content */+ int isThreadsafe; /* True for threadsafe connections */++#ifdef SQLITE_ENABLE_API_ARMOR+ if( ppBtree==0 ) return SQLITE_MISUSE_BKPT;+#endif+ *ppBtree = 0;+#ifndef SQLITE_OMIT_AUTOINIT+ rc = sqlite3BtreeInitialize();+ if( rc ) return rc;+#endif++ /* Only allow sensible combinations of bits in the vfsFlags argument. + ** Throw an error if any non-sense combination is used. If we+ ** do not block illegal combinations here, it could trigger+ ** assert() statements in deeper layers. Sensible combinations+ ** are:+ **+ ** 1: SQLITE_OPEN_READONLY+ ** 2: SQLITE_OPEN_READWRITE+ ** 6: SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE+ */+ assert( SQLITE_OPEN_READONLY == 0x01 );+ assert( SQLITE_OPEN_READWRITE == 0x02 );+ assert( SQLITE_OPEN_CREATE == 0x04 );+ testcase( (1<<(vfsFlags&7))==0x02 ); /* READONLY */+ testcase( (1<<(vfsFlags&7))==0x04 ); /* READWRITE */+ testcase( (1<<(vfsFlags&7))==0x40 ); /* READWRITE | CREATE */+ if( ((1<<(vfsFlags&7)) & 0x46)==0 ){+ return SQLITE_MISUSE_BKPT; /* IMP: R-65497-44594 */+ }++ if( sqlite3GlobalConfig.bCoreMutex==0 ){+ isThreadsafe = 0;+ }else if( vfsFlags & SQLITE_OPEN_NOMUTEX ){+ isThreadsafe = 0;+ }else if( vfsFlags & SQLITE_OPEN_FULLMUTEX ){+ isThreadsafe = 1;+ }else{+ isThreadsafe = sqlite3GlobalConfig.bFullMutex;+ }+ if( vfsFlags & SQLITE_OPEN_PRIVATECACHE ){+ vfsFlags &= ~SQLITE_OPEN_SHAREDCACHE;+ }else if( sqlite3GlobalConfig.sharedCacheEnabled ){+ vfsFlags |= SQLITE_OPEN_SHAREDCACHE;+ }++ /* Remove harmful bits from the vfsFlags parameter+ **+ ** The SQLITE_OPEN_NOMUTEX and SQLITE_OPEN_FULLMUTEX vfsFlags were+ ** dealt with in the previous code block. Besides these, the only+ ** valid input vfsFlags for sqlite3_open_v2() are SQLITE_OPEN_READONLY,+ ** SQLITE_OPEN_READWRITE, SQLITE_OPEN_CREATE, SQLITE_OPEN_SHAREDCACHE,+ ** SQLITE_OPEN_PRIVATECACHE, and some reserved bits. Silently mask+ ** off all other vfsFlags.+ */+ vfsFlags &= ~( SQLITE_OPEN_DELETEONCLOSE |+ SQLITE_OPEN_EXCLUSIVE |+ SQLITE_OPEN_MAIN_DB |+ SQLITE_OPEN_TEMP_DB | + SQLITE_OPEN_TRANSIENT_DB | + SQLITE_OPEN_MAIN_JOURNAL | + SQLITE_OPEN_TEMP_JOURNAL | + SQLITE_OPEN_SUBJOURNAL | + SQLITE_OPEN_MASTER_JOURNAL |+ SQLITE_OPEN_NOMUTEX |+ SQLITE_OPEN_FULLMUTEX |+ SQLITE_OPEN_WAL+ );++ assert( (vfsFlags&0xff)==vfsFlags ); /* flags fit in 8 bits */++ /* Only a BTREE_SINGLE database can be BTREE_UNORDERED */+ assert( (vfsFlags & BTREE_UNORDERED)==0 || (vfsFlags & BTREE_SINGLE)!=0 );++ sqlite3_vfs *pVfs =+ sqlite3_vfs_find(zVfs);+ if( pVfs==0 ){+ return SQLITE_ERROR;+ }++ p = sqlite3MallocZero(sizeof(Btree));+ if( !p ){+ return SQLITE_NOMEM;+ }+ p->inTrans = TRANS_NONE;+#ifndef SQLITE_OMIT_SHARED_CACHE+ p->lock.pBtree = p;+ p->lock.iTable = 1;+#endif+ p->magic = SQLITE_MAGIC_BUSY;++ if( isThreadsafe ){+ p->mutex = sqlite3MutexAlloc(SQLITE_MUTEX_RECURSIVE);+ if( p->mutex==0 ){+ sqlite3_free(p);+ p = 0;+ goto btree_open_out;+ }+ }+ sqlite3_mutex_enter(p->mutex);++ p->enc = SQLITE_UTF8;+ p->szMmap = sqlite3GlobalConfig.szMmap;+ p->flags |= 0+#if SQLITE_DEFAULT_CKPTFULLFSYNC+ | SQLITE_CkptFullFSync+#endif+#if defined(SQLITE_ENABLE_OVERSIZE_CELL_CHECK)+ | SQLITE_CellSizeCk+#endif+;++#if !defined(SQLITE_OMIT_SHARED_CACHE) && !defined(SQLITE_OMIT_DISKIO)+ /*+ ** If this Btree is a candidate for shared cache, try to find an+ ** existing BtShared object that we can share with+ */+ if( (vfsFlags&SQLITE_OPEN_URI)!=0 ){+ if( vfsFlags & SQLITE_OPEN_SHAREDCACHE ){+ int nFilename = sqlite3Strlen30(zFilename)+1;+ int nFullPathname = pVfs->mxPathname+1;+ char *zFullPathname = sqlite3Malloc(MAX(nFullPathname,nFilename));+ MUTEX_LOGIC( sqlite3_mutex *mutexShared; )++ p->sharable = 1;+ if( !zFullPathname ){+ sqlite3_free(p);+ return SQLITE_NOMEM;+ }+ rc = sqlite3OsFullPathname(pVfs, zFilename,+ nFullPathname, zFullPathname);+ if( rc ){+ sqlite3_free(zFullPathname);+ sqlite3_free(p);+ return rc;+ }+#if SQLITE_THREADSAFE+ mutexOpen = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_OPEN);+ sqlite3_mutex_enter(mutexOpen);+ mutexShared = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MASTER);+ sqlite3_mutex_enter(mutexShared);+#endif+ for(pBt=GLOBAL(BtShared*,sqlite3SharedCacheList); pBt; pBt=pBt->pNext){+ assert( pBt->nRef>0 );+ if( 0==strcmp(zFullPathname, sqlite3PagerFilename(pBt->pPager, 0))+ && sqlite3PagerVfs(pBt->pPager)==pVfs ){+ p->pBt = pBt;+ pBt->nRef++;+ break;+ }+ }+ sqlite3_mutex_leave(mutexShared);+ sqlite3_free(zFullPathname);+ }+#ifdef SQLITE_DEBUG+ else{+ /* In debug mode, we mark all persistent databases as sharable+ ** even when they are not. This exercises the locking code and+ ** gives more opportunity for asserts(sqlite3_mutex_held())+ ** statements to find locking problems.+ */+ p->sharable = 1;+ }+#endif+ }+#endif+ if( pBt==0 ){+ /*+ ** The following asserts make sure that structures used by the btree are+ ** the right size. This is to guard against size changes that result+ ** when compiling on a different architecture.+ */+ assert( sizeof(i64)==8 );+ assert( sizeof(u64)==8 );+ assert( sizeof(u32)==4 );+ assert( sizeof(u16)==2 );+ assert( sizeof(Pgno)==4 );+ + pBt = sqlite3MallocZero( sizeof(*pBt) );+ if( pBt==0 ){+ rc = SQLITE_NOMEM;+ goto btree_open_out;+ }+ rc = sqlite3PagerOpen(pVfs, &pBt->pPager, zFilename,+ EXTRA_SIZE, flags, vfsFlags, pageReinit);+ if( rc==SQLITE_OK ){+ sqlite3PagerSetMmapLimit(pBt->pPager, p->szMmap);+ rc = sqlite3PagerReadFileheader(pBt->pPager,sizeof(zDbHeader),zDbHeader);+ }+ if( rc!=SQLITE_OK ){+ goto btree_open_out;+ }+ pBt->openFlags = (u8)flags;+ pBt->pBt = p;+ sqlite3PagerSetBusyhandler(pBt->pPager, btreeInvokeBusyHandler, pBt);+ p->pBt = pBt;++ pBt->pCursor = 0;+ pBt->pPage1 = 0;+ if( sqlite3PagerIsreadonly(pBt->pPager) ) pBt->btsFlags |= BTS_READ_ONLY;+#ifdef SQLITE_SECURE_DELETE+ pBt->btsFlags |= BTS_SECURE_DELETE;+#endif+ /* EVIDENCE-OF: R-51873-39618 The page size for a database file is+ ** determined by the 2-byte integer located at an offset of 16 bytes from+ ** the beginning of the database file. */+ pBt->pageSize = (zDbHeader[16]<<8) | (zDbHeader[17]<<16);+ if( pBt->pageSize<512 || pBt->pageSize>SQLITE_MAX_PAGE_SIZE+ || ((pBt->pageSize-1)&pBt->pageSize)!=0 ){+ pBt->pageSize = 0;+#ifndef SQLITE_OMIT_AUTOVACUUM+ /* If the magic name ":memory:" will create an in-memory database, then+ ** leave the autoVacuum mode at 0 (do not auto-vacuum), even if+ ** SQLITE_DEFAULT_AUTOVACUUM is true.+ */+ if( zFilename ){+ pBt->autoVacuum = (SQLITE_DEFAULT_AUTOVACUUM ? 1 : 0);+ pBt->incrVacuum = (SQLITE_DEFAULT_AUTOVACUUM==2 ? 1 : 0);+ }+#endif+ nReserve = 0;+ }else{+ /* EVIDENCE-OF: R-37497-42412 The size of the reserved region is+ ** determined by the one-byte unsigned integer found at an offset of 20+ ** into the database file header. */+ nReserve = zDbHeader[20];+ pBt->btsFlags |= BTS_PAGESIZE_FIXED;+#ifndef SQLITE_OMIT_AUTOVACUUM+ pBt->autoVacuum = (get4byte(&zDbHeader[36 + 4*4])?1:0);+ pBt->incrVacuum = (get4byte(&zDbHeader[36 + 7*4])?1:0);+#endif+ }+ rc = sqlite3PagerSetPagesize(pBt->pPager, &pBt->pageSize, nReserve);+ if( rc ) goto btree_open_out;+ pBt->usableSize = pBt->pageSize - nReserve;+ assert( (pBt->pageSize & 7)==0 ); /* 8-byte alignment of pageSize */++ /*+ ** file_format==1 Version 3.0.0.+ ** file_format==2 Version 3.1.3. // ALTER TABLE ADD COLUMN+ ** file_format==3 Version 3.1.4. // ditto but with non-NULL defaults+ ** file_format==4 Version 3.3.0. // DESC indices. Boolean constants+ */+ pBt->file_format = zDbHeader[18];+ if( pBt->file_format==0 ){+ pBt->file_format = 1;+ }+ if( pBt->file_format>SQLITE_MAX_FILE_FORMAT ){+ rc = SQLITE_ERROR;+ goto btree_open_out;+ }+ +#if !defined(SQLITE_OMIT_SHARED_CACHE) && !defined(SQLITE_OMIT_DISKIO)+ /* Add the new BtShared object to the linked list sharable BtShareds.+ */+ if( p->sharable ){+ MUTEX_LOGIC( sqlite3_mutex *mutexShared; )+ pBt->nRef = 1;+ MUTEX_LOGIC( mutexShared = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MASTER);)+ if( SQLITE_THREADSAFE && sqlite3GlobalConfig.bCoreMutex ){+ pBt->mutex = sqlite3MutexAlloc(SQLITE_MUTEX_FAST);+ if( pBt->mutex==0 ){+ rc = SQLITE_NOMEM;+ p->mallocFailed = 0;+ goto btree_open_out;+ }+ }+ sqlite3_mutex_enter(mutexShared);+ pBt->pNext = GLOBAL(BtShared*,sqlite3SharedCacheList);+ GLOBAL(BtShared*,sqlite3SharedCacheList) = pBt;+ sqlite3_mutex_leave(mutexShared);+ }+#endif+ }++ sqlite3PagerSetCachesize(pBt->pPager, SQLITE_DEFAULT_CACHE_SIZE);++ p->magic = SQLITE_MAGIC_OPEN;++ /* -DSQLITE_DEFAULT_LOCKING_MODE=1 makes EXCLUSIVE the default locking+ ** mode. -DSQLITE_DEFAULT_LOCKING_MODE=0 make NORMAL the default locking+ ** mode. Doing nothing at all also makes NORMAL the default.+ */+#ifdef SQLITE_DEFAULT_LOCKING_MODE+ sqlite3PagerLockingMode(sqlite3BtreePager(db->aDb[0].pBt),+ SQLITE_DEFAULT_LOCKING_MODE);+#endif++ *ppBtree = p;++btree_open_out:+ if( rc!=SQLITE_OK ){+ if( pBt && pBt->pPager ){+ sqlite3PagerClose(pBt->pPager);+ }+ sqlite3_free(pBt);+ sqlite3_free(p);+ *ppBtree = 0;+ }else{+ if (p) {+ assert( p->mutex!=0 || isThreadsafe==0+ || sqlite3GlobalConfig.bFullMutex==0 );+ sqlite3_mutex_leave(p->mutex);+ }++ /* If the B-Tree was successfully opened, set the pager-cache size to the+ ** default value. Except, when opening on an existing shared pager-cache,+ ** do not change the pager-cache size.+ */+ if( sqlite3BtreeSchema(p, 0, 0)==0 ){+ sqlite3PagerSetCachesize(pBt->pPager, SQLITE_DEFAULT_CACHE_SIZE);+ }+ }+ if( mutexOpen ){+ assert( sqlite3_mutex_held(mutexOpen) );+ sqlite3_mutex_leave(mutexOpen);+ }+ return rc;+}++/*+** Decrement the BtShared.nRef counter. When it reaches zero,+** remove the BtShared structure from the sharing list. Return+** true if the BtShared.nRef counter reaches zero and return+** false if it is still positive.+*/+static int removeFromSharingList(BtShared *pBt){+#ifndef SQLITE_OMIT_SHARED_CACHE+ MUTEX_LOGIC( sqlite3_mutex *pMaster; )+ BtShared *pList;+ int removed = 0;++ assert( sqlite3_mutex_notheld(pBt->mutex) );+ MUTEX_LOGIC( pMaster = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MASTER); )+ sqlite3_mutex_enter(pMaster);+ pBt->nRef--;+ if( pBt->nRef<=0 ){+ if( GLOBAL(BtShared*,sqlite3SharedCacheList)==pBt ){+ GLOBAL(BtShared*,sqlite3SharedCacheList) = pBt->pNext;+ }else{+ pList = GLOBAL(BtShared*,sqlite3SharedCacheList);+ while( ALWAYS(pList) && pList->pNext!=pBt ){+ pList=pList->pNext;+ }+ if( ALWAYS(pList) ){+ pList->pNext = pBt->pNext;+ }+ }+ if( SQLITE_THREADSAFE ){+ sqlite3_mutex_free(pBt->mutex);+ }+ removed = 1;+ }+ sqlite3_mutex_leave(pMaster);+ return removed;+#else+ return 1;+#endif+}++/*+** Make sure pBt->pTmpSpace points to an allocation of +** MX_CELL_SIZE(pBt) bytes with a 4-byte prefix for a left-child+** pointer.+*/+static void allocateTempSpace(BtShared *pBt){+ if( !pBt->pTmpSpace ){+ pBt->pTmpSpace = sqlite3PageMalloc( pBt->pageSize );++ /* One of the uses of pBt->pTmpSpace is to format cells before+ ** inserting them into a leaf page (function fillInCell()). If+ ** a cell is less than 4 bytes in size, it is rounded up to 4 bytes+ ** by the various routines that manipulate binary cells. Which+ ** can mean that fillInCell() only initializes the first 2 or 3+ ** bytes of pTmpSpace, but that the first 4 bytes are copied from+ ** it into a database page. This is not actually a problem, but it+ ** does cause a valgrind error when the 1 or 2 bytes of unitialized + ** data is passed to system call write(). So to avoid this error,+ ** zero the first 4 bytes of temp space here.+ **+ ** Also: Provide four bytes of initialized space before the+ ** beginning of pTmpSpace as an area available to prepend the+ ** left-child pointer to the beginning of a cell.+ */+ if( pBt->pTmpSpace ){+ memset(pBt->pTmpSpace, 0, 8);+ pBt->pTmpSpace += 4;+ }+ }+}++/*+** Free the pBt->pTmpSpace allocation+*/+static void freeTempSpace(BtShared *pBt){+ if( pBt->pTmpSpace ){+ pBt->pTmpSpace -= 4;+ sqlite3PageFree(pBt->pTmpSpace);+ pBt->pTmpSpace = 0;+ }+}++/*+** Close an open database and invalidate all cursors.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeClose(Btree *p){+ if( !p ){+ /* EVIDENCE-OF: R-63257-11740 Calling sqlite3BtreeClose()+ ** with a NULL pointer argument is a harmless no-op. */+ return SQLITE_OK;+ }++ if( !sqlite3SafetyCheckSickOrOk(p) ){+ return SQLITE_MISUSE_BKPT;+ }++ sqlite3_mutex_enter(p->mutex);++ p->magic = SQLITE_MAGIC_ZOMBIE;++ BtShared *pBt = p->pBt;+ BtCursor *pCur;++ /* Close all cursors opened via this handle. */+ sqlite3BtreeEnter(p);+ pCur = pBt->pCursor;+ while( pCur ){+ BtCursor *pTmp = pCur;+ pCur = pCur->pNext;+ if( pTmp->pBtree==p ){+ sqlite3BtreeCloseCursor(pTmp);+ }+ }++ /* Rollback any active transaction and free the handle structure.+ ** The call to sqlite3BtreeRollback() drops any table-locks held by+ ** this handle.+ */+ sqlite3BtreeRollback(p, SQLITE_OK, 0);+ sqlite3BtreeLeave(p);++ /* If there are still other outstanding references to the shared-btree+ ** structure, return now. The remainder of this procedure cleans + ** up the shared-btree.+ */+ assert( p->wantToLock==0 && p->locked==0 );+ if( !p->sharable || removeFromSharingList(pBt) ){+ /* The pBt is no longer on the sharing list, so we can access+ ** it without having to hold the mutex.+ **+ ** Clean out and delete the BtShared object.+ */+ assert( !pBt->pCursor );+ sqlite3PagerClose(pBt->pPager);+ if( pBt->xFreeSchema && pBt->pSchema ){+ pBt->xFreeSchema(pBt->pSchema);+ }+ sqlite3DbFree(0, pBt->pSchema);+ freeTempSpace(pBt);+ sqlite3_free(pBt);+ }++#ifndef SQLITE_OMIT_SHARED_CACHE+ assert( p->wantToLock==0 );+ assert( p->locked==0 );+ if( p->pPrev ) p->pPrev->pNext = p->pNext;+ if( p->pNext ) p->pNext->pPrev = p->pPrev;+#endif++ sqlite3_mutex_leave(p->mutex);+ sqlite3_mutex_free(p->mutex);++ p->magic = SQLITE_MAGIC_CLOSED;++ sqlite3_free(p);+ return SQLITE_OK;+}++/*+** Change the limit on the number of pages allowed in the cache.+**+** The maximum number of cache pages is set to the absolute+** value of mxPage. If mxPage is negative, the pager will+** operate asynchronously - it will not stop to do fsync()s+** to insure data is written to the disk surface before+** continuing. Transactions still work if synchronous is off,+** and the database cannot be corrupted if this program+** crashes. But if the operating system crashes or there is+** an abrupt power failure when synchronous is off, the database+** could be left in an inconsistent and unrecoverable state.+** Synchronous is on by default so database corruption is not+** normally a worry.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSetCacheSize(Btree *p, int mxPage){+ BtShared *pBt = p->pBt;+ assert( sqlite3_mutex_held(p->db->mutex) );+ sqlite3BtreeEnter(p);+ sqlite3PagerSetCachesize(pBt->pPager, mxPage);+ sqlite3BtreeLeave(p);+ return SQLITE_OK;+}++#if SQLITE_MAX_MMAP_SIZE>0+/*+** Change the limit on the amount of the database file that may be+** memory mapped.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSetMmapLimit(Btree *p, sqlite3_int64 szMmap){+ BtShared *pBt = p->pBt;+ assert( sqlite3_mutex_held(p->db->mutex) );+ sqlite3BtreeEnter(p);+ sqlite3PagerSetMmapLimit(pBt->pPager, szMmap);+ sqlite3BtreeLeave(p);+ return SQLITE_OK;+}+#endif /* SQLITE_MAX_MMAP_SIZE>0 */++/*+** Change the way data is synced to disk in order to increase or decrease+** how well the database resists damage due to OS crashes and power+** failures. Level 1 is the same as asynchronous (no syncs() occur and+** there is a high probability of damage) Level 2 is the default. There+** is a very low but non-zero probability of damage. Level 3 reduces the+** probability of damage to near zero but with a write performance reduction.+*/+#ifndef SQLITE_OMIT_PAGER_PRAGMAS+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSetPagerFlags(+ Btree *p, /* The btree to set the safety level on */+ unsigned pgFlags /* Various PAGER_* flags */+){+ BtShared *pBt = p->pBt;+ assert( sqlite3_mutex_held(p->db->mutex) );+ sqlite3BtreeEnter(p);+ sqlite3PagerSetFlags(pBt->pPager, pgFlags);+ sqlite3BtreeLeave(p);+ return SQLITE_OK;+}+#endif++/*+** Return TRUE if the given btree is set to safety level 1. In other+** words, return TRUE if no sync() occurs on the disk files.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSyncDisabled(Btree *p){+ BtShared *pBt = p->pBt;+ int rc;+ assert( sqlite3_mutex_held(p->db->mutex) ); + sqlite3BtreeEnter(p);+ assert( pBt && pBt->pPager );+ rc = sqlite3PagerNosync(pBt->pPager);+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** Change the default pages size and the number of reserved bytes per page.+** Or, if the page size has already been fixed, return SQLITE_READONLY +** without changing anything.+**+** The page size must be a power of 2 between 512 and 65536. If the page+** size supplied does not meet this constraint then the page size is not+** changed.+**+** Page sizes are constrained to be a power of two so that the region+** of the database file used for locking (beginning at PENDING_BYTE,+** the first byte past the 1GB boundary, 0x40000000) needs to occur+** at the beginning of a page.+**+** If parameter nReserve is less than zero, then the number of reserved+** bytes per page is left unchanged.+**+** If the iFix!=0 then the BTS_PAGESIZE_FIXED flag is set so that the page size+** and autovacuum mode can no longer be changed.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSetPageSize(Btree *p, int pageSize, int nReserve, int iFix){+ int rc = SQLITE_OK;+ BtShared *pBt = p->pBt;+ assert( nReserve>=-1 && nReserve<=255 );+ sqlite3BtreeEnter(p);+#if SQLITE_HAS_CODEC+ if( nReserve>pBt->optimalReserve ) pBt->optimalReserve = (u8)nReserve;+#endif+ if( pBt->btsFlags & BTS_PAGESIZE_FIXED ){+ sqlite3BtreeLeave(p);+ return SQLITE_READONLY;+ }+ if( nReserve<0 ){+ nReserve = pBt->pageSize - pBt->usableSize;+ }+ assert( nReserve>=0 && nReserve<=255 );+ if( pageSize>=512 && pageSize<=SQLITE_MAX_PAGE_SIZE &&+ ((pageSize-1)&pageSize)==0 ){+ assert( (pageSize & 7)==0 );+ assert( !pBt->pCursor );+ pBt->pageSize = (u32)pageSize;+ freeTempSpace(pBt);+ }+ rc = sqlite3PagerSetPagesize(pBt->pPager, &pBt->pageSize, nReserve);+ pBt->usableSize = pBt->pageSize - (u16)nReserve;+ if( iFix ) pBt->btsFlags |= BTS_PAGESIZE_FIXED;+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** Return the currently defined page size+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeGetPageSize(Btree *p){+ return p->pBt->pageSize;+}++/*+** This function is similar to sqlite3BtreeGetReserve(), except that it+** may only be called if it is guaranteed that the b-tree mutex is already+** held.+**+** This is useful in one special case in the backup API code where it is+** known that the shared b-tree mutex is held, but the mutex on the +** database handle that owns *p is not. In this case if sqlite3BtreeEnter()+** were to be called, it might collide with some other operation on the+** database handle that owns *p, causing undefined behavior.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeGetReserveNoMutex(Btree *p){+ int n;+ assert( sqlite3_mutex_held(p->pBt->mutex) );+ n = p->pBt->pageSize - p->pBt->usableSize;+ return n;+}++/*+** Return the number of bytes of space at the end of every page that+** are intentually left unused. This is the "reserved" space that is+** sometimes used by extensions.+**+** If SQLITE_HAS_MUTEX is defined then the number returned is the+** greater of the current reserved space and the maximum requested+** reserve space.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeGetOptimalReserve(Btree *p){+ int n;+ sqlite3BtreeEnter(p);+ n = sqlite3BtreeGetReserveNoMutex(p);+#ifdef SQLITE_HAS_CODEC+ if( n<p->pBt->optimalReserve ) n = p->pBt->optimalReserve;+#endif+ sqlite3BtreeLeave(p);+ return n;+}+++/*+** Set the maximum page count for a database if mxPage is positive.+** No changes are made if mxPage is 0 or negative.+** Regardless of the value of mxPage, return the maximum page count.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeMaxPageCount(Btree *p, int mxPage){+ int n;+ sqlite3BtreeEnter(p);+ n = sqlite3PagerMaxPageCount(p->pBt->pPager, mxPage);+ sqlite3BtreeLeave(p);+ return n;+}++/*+** Set the BTS_SECURE_DELETE flag if newFlag is 0 or 1. If newFlag is -1,+** then make no changes. Always return the value of the BTS_SECURE_DELETE+** setting after the change.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSecureDelete(Btree *p, int newFlag){+ int b;+ if( p==0 ) return 0;+ sqlite3BtreeEnter(p);+ if( newFlag>=0 ){+ p->pBt->btsFlags &= ~BTS_SECURE_DELETE;+ if( newFlag ) p->pBt->btsFlags |= BTS_SECURE_DELETE;+ } + b = (p->pBt->btsFlags & BTS_SECURE_DELETE)!=0;+ sqlite3BtreeLeave(p);+ return b;+}++/*+** Change the 'auto-vacuum' property of the database. If the 'autoVacuum'+** parameter is non-zero, then auto-vacuum mode is enabled. If zero, it+** is disabled. The default value for the auto-vacuum property is +** determined by the SQLITE_DEFAULT_AUTOVACUUM macro.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSetAutoVacuum(Btree *p, int autoVacuum){+#ifdef SQLITE_OMIT_AUTOVACUUM+ return SQLITE_READONLY;+#else+ BtShared *pBt = p->pBt;+ int rc = SQLITE_OK;+ u8 av = (u8)autoVacuum;++ sqlite3BtreeEnter(p);+ if( (pBt->btsFlags & BTS_PAGESIZE_FIXED)!=0 && (av ?1:0)!=pBt->autoVacuum ){+ rc = SQLITE_READONLY;+ }else{+ pBt->autoVacuum = av ?1:0;+ pBt->incrVacuum = av==2 ?1:0;+ }+ sqlite3BtreeLeave(p);+ return rc;+#endif+}++/*+** Return the value of the 'auto-vacuum' property. If auto-vacuum is +** enabled 1 is returned. Otherwise 0.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeGetAutoVacuum(Btree *p){+#ifdef SQLITE_OMIT_AUTOVACUUM+ return BTREE_AUTOVACUUM_NONE;+#else+ int rc;+ sqlite3BtreeEnter(p);+ rc = (+ (!p->pBt->autoVacuum)?BTREE_AUTOVACUUM_NONE:+ (!p->pBt->incrVacuum)?BTREE_AUTOVACUUM_FULL:+ BTREE_AUTOVACUUM_INCR+ );+ sqlite3BtreeLeave(p);+ return rc;+#endif+}+++/*+** Get a reference to pPage1 of the database file. This will+** also acquire a readlock on that file.+**+** SQLITE_OK is returned on success. If the file is not a+** well-formed database file, then SQLITE_CORRUPT is returned.+** SQLITE_BUSY is returned if the database is locked. SQLITE_NOMEM+** is returned if we run out of memory. +*/+static int lockBtree(BtShared *pBt){+ int rc; /* Result code from subfunctions */+ MemPage *pPage1; /* Page 1 of the database file */+ int nPage; /* Number of pages in the database */+ int nPageFile = 0; /* Number of pages in the database file */+ int nPageHeader; /* Number of pages in the database according to hdr */++ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( pBt->pPage1==0 );+ rc = sqlite3PagerSharedLock(pBt->pPager);+ if( rc!=SQLITE_OK ) return rc;+ rc = btreeGetPage(pBt, 1, &pPage1, 0);+ if( rc!=SQLITE_OK ) return rc;++ /* Do some checking to help insure the file we opened really is+ ** a valid database file. + */+ nPage = nPageHeader = get4byte(28+(u8*)pPage1->aData);+ sqlite3PagerPagecount(pBt->pPager, &nPageFile);+ if( nPage==0 || memcmp(24+(u8*)pPage1->aData, 92+(u8*)pPage1->aData,4)!=0 ){+ nPage = nPageFile;+ }+ if( nPage>0 ){+ u32 pageSize;+ u32 usableSize;+ u8 *page1 = pPage1->aData;+ rc = SQLITE_NOTADB;+ /* EVIDENCE-OF: R-43737-39999 Every valid SQLite database file begins+ ** with the following 16 bytes (in hex): 53 51 4c 69 74 65 20 66 6f 72 6d+ ** 61 74 20 33 00. */+ if( memcmp(page1, zMagicHeader, 16)!=0 ){+ goto page1_init_failed;+ }++#ifdef SQLITE_OMIT_WAL+ if( page1[18]>1 ){+ pBt->btsFlags |= BTS_READ_ONLY;+ }+ if( page1[19]>1 ){+ goto page1_init_failed;+ }+#else+ if( page1[18]>2 ){+ pBt->btsFlags |= BTS_READ_ONLY;+ }+ if( page1[19]>2 ){+ goto page1_init_failed;+ }++ /* If the write version is set to 2, this database should be accessed+ ** in WAL mode. If the log is not already open, open it now. Then + ** return SQLITE_OK and return without populating BtShared.pPage1.+ ** The caller detects this and calls this function again. This is+ ** required as the version of page 1 currently in the page1 buffer+ ** may not be the latest version - there may be a newer one in the log+ ** file.+ */+ if( page1[19]==2 && (pBt->btsFlags & BTS_NO_WAL)==0 ){+ int isOpen = 0;+ rc = sqlite3PagerOpenWal(pBt->pPager, &isOpen);+ if( rc!=SQLITE_OK ){+ goto page1_init_failed;+ }else if( isOpen==0 ){+ releasePage(pPage1);+ return SQLITE_OK;+ }+ rc = SQLITE_NOTADB;+ }+#endif++ /* EVIDENCE-OF: R-15465-20813 The maximum and minimum embedded payload+ ** fractions and the leaf payload fraction values must be 64, 32, and 32.+ **+ ** The original design allowed these amounts to vary, but as of+ ** version 3.6.0, we require them to be fixed.+ */+ if( memcmp(&page1[21], "\100\040\040",3)!=0 ){+ goto page1_init_failed;+ }+ /* EVIDENCE-OF: R-51873-39618 The page size for a database file is+ ** determined by the 2-byte integer located at an offset of 16 bytes from+ ** the beginning of the database file. */+ pageSize = (page1[16]<<8) | (page1[17]<<16);+ /* EVIDENCE-OF: R-25008-21688 The size of a page is a power of two+ ** between 512 and 65536 inclusive. */+ if( ((pageSize-1)&pageSize)!=0+ || pageSize>SQLITE_MAX_PAGE_SIZE + || pageSize<=256 + ){+ goto page1_init_failed;+ }+ assert( (pageSize & 7)==0 );+ /* EVIDENCE-OF: R-59310-51205 The "reserved space" size in the 1-byte+ ** integer at offset 20 is the number of bytes of space at the end of+ ** each page to reserve for extensions. + **+ ** EVIDENCE-OF: R-37497-42412 The size of the reserved region is+ ** determined by the one-byte unsigned integer found at an offset of 20+ ** into the database file header. */+ usableSize = pageSize - page1[20];+ if( (u32)pageSize!=pBt->pageSize ){+ /* After reading the first page of the database assuming a page size+ ** of BtShared.pageSize, we have discovered that the page-size is+ ** actually pageSize. Unlock the database, leave pBt->pPage1 at+ ** zero and return SQLITE_OK. The caller will call this function+ ** again with the correct page-size.+ */+ releasePage(pPage1);+ pBt->usableSize = usableSize;+ pBt->pageSize = pageSize;+ freeTempSpace(pBt);+ rc = sqlite3PagerSetPagesize(pBt->pPager, &pBt->pageSize,+ pageSize-usableSize);+ return rc;+ }+ if( (pBt->pBt->flags & SQLITE_RecoveryMode)==0 && nPage>nPageFile ){+ rc = SQLITE_CORRUPT_BKPT;+ goto page1_init_failed;+ }+ /* EVIDENCE-OF: R-28312-64704 However, the usable size is not allowed to+ ** be less than 480. In other words, if the page size is 512, then the+ ** reserved space size cannot exceed 32. */+ if( usableSize<480 ){+ goto page1_init_failed;+ }+ pBt->pageSize = pageSize;+ pBt->usableSize = usableSize;+#ifndef SQLITE_OMIT_AUTOVACUUM+ pBt->autoVacuum = (get4byte(&page1[36 + 4*4])?1:0);+ pBt->incrVacuum = (get4byte(&page1[36 + 7*4])?1:0);+#endif+ }++ /* maxLocal is the maximum amount of payload to store locally for+ ** a cell. Make sure it is small enough so that at least minFanout+ ** cells can will fit on one page. We assume a 10-byte page header.+ ** Besides the payload, the cell must store:+ ** 2-byte pointer to the cell+ ** 4-byte child pointer+ ** 9-byte nKey value+ ** 4-byte nData value+ ** 4-byte overflow page pointer+ ** So a cell consists of a 2-byte pointer, a header which is as much as+ ** 17 bytes long, 0 to N bytes of payload, and an optional 4 byte overflow+ ** page pointer.+ */+ pBt->maxLocal = (u16)((pBt->usableSize-12)*64/255 - 23);+ pBt->minLocal = (u16)((pBt->usableSize-12)*32/255 - 23);+ pBt->maxLeaf = (u16)(pBt->usableSize - 35);+ pBt->minLeaf = (u16)((pBt->usableSize-12)*32/255 - 23);+ if( pBt->maxLocal>127 ){+ pBt->max1bytePayload = 127;+ }else{+ pBt->max1bytePayload = (u8)pBt->maxLocal;+ }+ assert( pBt->maxLeaf + 23 <= MX_CELL_SIZE(pBt) );+ pBt->pPage1 = pPage1;+ pBt->nPage = nPage;+ return SQLITE_OK;++page1_init_failed:+ releasePage(pPage1);+ pBt->pPage1 = 0;+ return rc;+}++#ifndef NDEBUG+/*+** Return the number of cursors open on pBt. This is for use+** in assert() expressions, so it is only compiled if NDEBUG is not+** defined.+**+** Only write cursors are counted if wrOnly is true. If wrOnly is+** false then all cursors are counted.+**+** For the purposes of this routine, a cursor is any cursor that+** is capable of reading or writing to the database. Cursors that+** have been tripped into the CURSOR_FAULT state are not counted.+*/+static int countValidCursors(BtShared *pBt, int wrOnly){+ BtCursor *pCur;+ int r = 0;+ for(pCur=pBt->pCursor; pCur; pCur=pCur->pNext){+ if( (wrOnly==0 || (pCur->curFlags & BTCF_WriteFlag)!=0)+ && pCur->eState!=CURSOR_FAULT ) r++; + }+ return r;+}+#endif++/*+** If there are no outstanding cursors and we are not in the middle+** of a transaction but there is a read lock on the database, then+** this routine unrefs the first page of the database file which +** has the effect of releasing the read lock.+**+** If there is a transaction in progress, this routine is a no-op.+*/+static void unlockBtreeIfUnused(BtShared *pBt){+ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( countValidCursors(pBt,0)==0 || pBt->inTransaction>TRANS_NONE );+ if( pBt->inTransaction==TRANS_NONE && pBt->pPage1!=0 ){+ MemPage *pPage1 = pBt->pPage1;+ assert( pPage1->aData );+ assert( sqlite3PagerRefcount(pBt->pPager)==1 );+ pBt->pPage1 = 0;+ releasePageNotNull(pPage1);+ }+}++/*+** If pBt points to an empty file then convert that empty file+** into a new empty database by initializing the first page of+** the database.+*/+static int newDatabase(BtShared *pBt){+ MemPage *pP1;+ unsigned char *data;+ int rc;++ assert( sqlite3_mutex_held(pBt->mutex) );+ if( pBt->nPage>0 ){+ return SQLITE_OK;+ }+ pP1 = pBt->pPage1;+ assert( pP1!=0 );+ data = pP1->aData;+ rc = sqlite3PagerWrite(pP1->pDbPage);+ if( rc ) return rc;+ memcpy(data, zMagicHeader, sizeof(zMagicHeader));+ assert( sizeof(zMagicHeader)==16 );+ data[16] = (u8)((pBt->pageSize>>8)&0xff);+ data[17] = (u8)((pBt->pageSize>>16)&0xff);+ data[18] = 1;+ data[19] = 1;+ assert( pBt->usableSize<=pBt->pageSize && pBt->usableSize+255>=pBt->pageSize);+ data[20] = (u8)(pBt->pageSize - pBt->usableSize);+ data[21] = 64;+ data[22] = 32;+ data[23] = 32;+ memset(&data[24], 0, 100-24);+ zeroPage(pP1, PTF_INTKEY|PTF_LEAF|PTF_LEAFDATA );+ pBt->btsFlags |= BTS_PAGESIZE_FIXED;+#ifndef SQLITE_OMIT_AUTOVACUUM+ assert( pBt->autoVacuum==1 || pBt->autoVacuum==0 );+ assert( pBt->incrVacuum==1 || pBt->incrVacuum==0 );+ put4byte(&data[36 + 4*4], pBt->autoVacuum);+ put4byte(&data[36 + 7*4], pBt->incrVacuum);+#endif+ pBt->nPage = 1;+ data[31] = 1;+ return SQLITE_OK;+}++/*+** Initialize the first page of the database file (creating a database+** consisting of a single page and no schema objects). Return SQLITE_OK+** if successful, or an SQLite error code otherwise.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeNewDb(Btree *p){+ int rc;+ sqlite3BtreeEnter(p);+ p->pBt->nPage = 0;+ rc = newDatabase(p->pBt);+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** Attempt to start a new transaction. A write-transaction+** is started if the second argument is nonzero, otherwise a read-+** transaction. If the second argument is 2 or more and exclusive+** transaction is started, meaning that no other process is allowed+** to access the database. A preexisting transaction may not be+** upgraded to exclusive by calling this routine a second time - the+** exclusivity flag only works for a new transaction.+**+** A write-transaction must be started before attempting any +** changes to the database. None of the following routines +** will work unless a transaction is started first:+**+** sqlite3BtreeCreateTable()+** sqlite3BtreeCreateIndex()+** sqlite3BtreeClearTable()+** sqlite3BtreeDropTable()+** sqlite3BtreeInsert()+** sqlite3BtreeDelete()+** sqlite3BtreeUpdateMeta()+**+** If an initial attempt to acquire the lock fails because of lock contention+** and the database was previously unlocked, then invoke the busy handler+** if there is one. But if there was previously a read-lock, do not+** invoke the busy handler - just return SQLITE_BUSY. SQLITE_BUSY is +** returned when there is already a read-lock in order to avoid a deadlock.+**+** Suppose there are two processes A and B. A has a read lock and B has+** a reserved lock. B tries to promote to exclusive but is blocked because+** of A's read lock. A tries to promote to reserved but is blocked by B.+** One or the other of the two processes must give way or there can be+** no progress. By returning SQLITE_BUSY and not invoking the busy callback+** when A already has a read lock, we encourage A to give up and let B+** proceed.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeBeginTrans(Btree *p, int wrflag){+ Btree *pBlock = 0;+ BtShared *pBt = p->pBt;+ int rc = SQLITE_OK;++ sqlite3BtreeEnter(p);+ btreeIntegrity(p);++ /* If the btree is already in a write-transaction, or it+ ** is already in a read-transaction and a read-transaction+ ** is requested, this is a no-op.+ */+ if( p->inTrans==TRANS_WRITE || (p->inTrans==TRANS_READ && !wrflag) ){+ goto trans_begun;+ }+ assert( pBt->inTransaction==TRANS_WRITE || IfNotOmitAV(pBt->bDoTruncate)==0 );++ /* Write transactions are not possible on a read-only database */+ if( (pBt->btsFlags & BTS_READ_ONLY)!=0 && wrflag ){+ rc = SQLITE_READONLY;+ goto trans_begun;+ }++#ifndef SQLITE_OMIT_SHARED_CACHE+ /* If another database handle has already opened a write transaction + ** on this shared-btree structure and a second write transaction is+ ** requested, return SQLITE_LOCKED.+ */+ if( (wrflag && pBt->inTransaction==TRANS_WRITE)+ || (pBt->btsFlags & BTS_PENDING)!=0+ ){+ pBlock = pBt->pWriter;+ }else if( wrflag>1 ){+ BtLock *pIter;+ for(pIter=pBt->pLock; pIter; pIter=pIter->pNext){+ if( pIter->pBtree!=p ){+ pBlock = pIter->pBtree;+ break;+ }+ }+ }+ if( pBlock ){+ sqlite3ConnectionBlocked(p, pBlock);+ rc = SQLITE_LOCKED_SHAREDCACHE;+ goto trans_begun;+ }+#endif++ /* Any read-only or read-write transaction implies a read-lock on + ** page 1. So if some other shared-cache client already has a write-lock + ** on page 1, the transaction cannot be opened. */+ rc = querySharedCacheTableLock(p, MASTER_ROOT, READ_LOCK);+ if( SQLITE_OK!=rc ) goto trans_begun;++ pBt->btsFlags &= ~BTS_INITIALLY_EMPTY;+ if( pBt->nPage==0 ) pBt->btsFlags |= BTS_INITIALLY_EMPTY;+ do {+ /* Call lockBtree() until either pBt->pPage1 is populated or+ ** lockBtree() returns something other than SQLITE_OK. lockBtree()+ ** may return SQLITE_OK but leave pBt->pPage1 set to 0 if after+ ** reading page 1 it discovers that the page-size of the database + ** file is not pBt->pageSize. In this case lockBtree() will update+ ** pBt->pageSize to the page-size of the file on disk.+ */+ while( pBt->pPage1==0 && SQLITE_OK==(rc = lockBtree(pBt)) );++ if( rc==SQLITE_OK && wrflag ){+ if( (pBt->btsFlags & BTS_READ_ONLY)!=0 ){+ rc = SQLITE_READONLY;+ }else{+ rc = sqlite3PagerBegin(pBt->pPager,wrflag>1,0);+ if( rc==SQLITE_OK ){+ rc = newDatabase(pBt);+ }+ }+ }+ + if( rc!=SQLITE_OK ){+ unlockBtreeIfUnused(pBt);+ }+ }while( (rc&0xFF)==SQLITE_BUSY && pBt->inTransaction==TRANS_NONE &&+ btreeInvokeBusyHandler(pBt) );++ if( rc==SQLITE_OK ){+ if( p->inTrans==TRANS_NONE ){+ pBt->nTransaction++;+#ifndef SQLITE_OMIT_SHARED_CACHE+ if( p->sharable ){+ assert( p->lock.pBtree==p && p->lock.iTable==1 );+ p->lock.eLock = READ_LOCK;+ p->lock.pNext = pBt->pLock;+ pBt->pLock = &p->lock;+ }+#endif+ }+ p->inTrans = (wrflag?TRANS_WRITE:TRANS_READ);+ if( p->inTrans>pBt->inTransaction ){+ pBt->inTransaction = p->inTrans;+ }+ if( wrflag ){+ MemPage *pPage1 = pBt->pPage1;+#ifndef SQLITE_OMIT_SHARED_CACHE+ assert( !pBt->pWriter );+ pBt->pWriter = p;+ pBt->btsFlags &= ~BTS_EXCLUSIVE;+ if( wrflag>1 ) pBt->btsFlags |= BTS_EXCLUSIVE;+#endif++ /* If the db-size header field is incorrect (as it may be if an old+ ** client has been writing the database file), update it now. Doing+ ** this sooner rather than later means the database size can safely + ** re-read the database size from page 1 if a savepoint or transaction+ ** rollback occurs within the transaction.+ */+ if( pBt->nPage!=get4byte(&pPage1->aData[28]) ){+ rc = sqlite3PagerWrite(pPage1->pDbPage);+ if( rc==SQLITE_OK ){+ put4byte(&pPage1->aData[28], pBt->nPage);+ }+ }+ }+ }+++trans_begun:+ if( rc==SQLITE_OK && wrflag ){+ /* This call makes sure that the pager has the correct number of+ ** open savepoints. If the second parameter is greater than 0 and+ ** the sub-journal is not already open, then it will be opened here.+ */+ rc = sqlite3PagerOpenSavepoint(pBt->pPager, p->nSavepoint);+ }++ btreeIntegrity(p);+ sqlite3BtreeLeave(p);+ return rc;+}++#ifndef SQLITE_OMIT_AUTOVACUUM++/*+** Set the pointer-map entries for all children of page pPage. Also, if+** pPage contains cells that point to overflow pages, set the pointer+** map entries for the overflow pages as well.+*/+static int setChildPtrmaps(MemPage *pPage){+ int i; /* Counter variable */+ int nCell; /* Number of cells in page pPage */+ int rc; /* Return code */+ BtShared *pBt = pPage->pBt;+ u8 isInitOrig = pPage->isInit;+ Pgno pgno = pPage->pgno;++ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ rc = btreeInitPage(pPage);+ if( rc!=SQLITE_OK ){+ goto set_child_ptrmaps_out;+ }+ nCell = pPage->nCell;++ for(i=0; i<nCell; i++){+ u8 *pCell = findCell(pPage, i);++ ptrmapPutOvflPtr(pPage, pCell, &rc);++ if( !pPage->leaf ){+ Pgno childPgno = get4byte(pCell);+ ptrmapPut(pBt, childPgno, PTRMAP_BTREE, pgno, &rc);+ }+ }++ if( !pPage->leaf ){+ Pgno childPgno = get4byte(&pPage->aData[pPage->hdrOffset+8]);+ ptrmapPut(pBt, childPgno, PTRMAP_BTREE, pgno, &rc);+ }++set_child_ptrmaps_out:+ pPage->isInit = isInitOrig;+ return rc;+}++/*+** Somewhere on pPage is a pointer to page iFrom. Modify this pointer so+** that it points to iTo. Parameter eType describes the type of pointer to+** be modified, as follows:+**+** PTRMAP_BTREE: pPage is a btree-page. The pointer points at a child +** page of pPage.+**+** PTRMAP_OVERFLOW1: pPage is a btree-page. The pointer points at an overflow+** page pointed to by one of the cells on pPage.+**+** PTRMAP_OVERFLOW2: pPage is an overflow-page. The pointer points at the next+** overflow page in the list.+*/+static int modifyPagePointer(MemPage *pPage, Pgno iFrom, Pgno iTo, u8 eType){+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ if( eType==PTRMAP_OVERFLOW2 ){+ /* The pointer is always the first 4 bytes of the page in this case. */+ if( get4byte(pPage->aData)!=iFrom ){+ return SQLITE_CORRUPT_BKPT;+ }+ put4byte(pPage->aData, iTo);+ }else{+ u8 isInitOrig = pPage->isInit;+ int i;+ int nCell;+ int rc;++ rc = btreeInitPage(pPage);+ if( rc ) return rc;+ nCell = pPage->nCell;++ for(i=0; i<nCell; i++){+ u8 *pCell = findCell(pPage, i);+ if( eType==PTRMAP_OVERFLOW1 ){+ CellInfo info;+ pPage->xParseCell(pPage, pCell, &info);+ if( info.iOverflow+ && pCell+info.iOverflow+3<=pPage->aData+pPage->maskPage+ && iFrom==get4byte(&pCell[info.iOverflow])+ ){+ put4byte(&pCell[info.iOverflow], iTo);+ break;+ }+ }else{+ if( get4byte(pCell)==iFrom ){+ put4byte(pCell, iTo);+ break;+ }+ }+ }+ + if( i==nCell ){+ if( eType!=PTRMAP_BTREE || + get4byte(&pPage->aData[pPage->hdrOffset+8])!=iFrom ){+ return SQLITE_CORRUPT_BKPT;+ }+ put4byte(&pPage->aData[pPage->hdrOffset+8], iTo);+ }++ pPage->isInit = isInitOrig;+ }+ return SQLITE_OK;+}+++/*+** Move the open database page pDbPage to location iFreePage in the +** database. The pDbPage reference remains valid.+**+** The isCommit flag indicates that there is no need to remember that+** the journal needs to be sync()ed before database page pDbPage->pgno +** can be written to. The caller has already promised not to write to that+** page.+*/+static int relocatePage(+ BtShared *pBt, /* Btree */+ MemPage *pDbPage, /* Open page to move */+ u8 eType, /* Pointer map 'type' entry for pDbPage */+ Pgno iPtrPage, /* Pointer map 'page-no' entry for pDbPage */+ Pgno iFreePage, /* The location to move pDbPage to */+ int isCommit /* isCommit flag passed to sqlite3PagerMovepage */+){+ MemPage *pPtrPage; /* The page that contains a pointer to pDbPage */+ Pgno iDbPage = pDbPage->pgno;+ Pager *pPager = pBt->pPager;+ int rc;++ assert( eType==PTRMAP_OVERFLOW2 || eType==PTRMAP_OVERFLOW1 || + eType==PTRMAP_BTREE || eType==PTRMAP_ROOTPAGE );+ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( pDbPage->pBt==pBt );++ /* Move page iDbPage from its current location to page number iFreePage */+ TRACE(("AUTOVACUUM: Moving %d to free page %d (ptr page %d type %d)\n", + iDbPage, iFreePage, iPtrPage, eType));+ rc = sqlite3PagerMovepage(pPager, pDbPage->pDbPage, iFreePage, isCommit);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ pDbPage->pgno = iFreePage;++ /* If pDbPage was a btree-page, then it may have child pages and/or cells+ ** that point to overflow pages. The pointer map entries for all these+ ** pages need to be changed.+ **+ ** If pDbPage is an overflow page, then the first 4 bytes may store a+ ** pointer to a subsequent overflow page. If this is the case, then+ ** the pointer map needs to be updated for the subsequent overflow page.+ */+ if( eType==PTRMAP_BTREE || eType==PTRMAP_ROOTPAGE ){+ rc = setChildPtrmaps(pDbPage);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ }else{+ Pgno nextOvfl = get4byte(pDbPage->aData);+ if( nextOvfl!=0 ){+ ptrmapPut(pBt, nextOvfl, PTRMAP_OVERFLOW2, iFreePage, &rc);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ }+ }++ /* Fix the database pointer on page iPtrPage that pointed at iDbPage so+ ** that it points at iFreePage. Also fix the pointer map entry for+ ** iPtrPage.+ */+ if( eType!=PTRMAP_ROOTPAGE ){+ rc = btreeGetPage(pBt, iPtrPage, &pPtrPage, 0);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ rc = sqlite3PagerWrite(pPtrPage->pDbPage);+ if( rc!=SQLITE_OK ){+ releasePage(pPtrPage);+ return rc;+ }+ rc = modifyPagePointer(pPtrPage, iDbPage, iFreePage, eType);+ releasePage(pPtrPage);+ if( rc==SQLITE_OK ){+ ptrmapPut(pBt, iFreePage, eType, iPtrPage, &rc);+ }+ }+ return rc;+}++/* Forward declaration required by incrVacuumStep(). */+static int allocateBtreePage(BtShared *, MemPage **, Pgno *, Pgno, u8);++/*+** Perform a single step of an incremental-vacuum. If successful, return+** SQLITE_OK. If there is no work to do (and therefore no point in +** calling this function again), return SQLITE_DONE. Or, if an error +** occurs, return some other error code.+**+** More specifically, this function attempts to re-organize the database so +** that the last page of the file currently in use is no longer in use.+**+** Parameter nFin is the number of pages that this database would contain+** were this function called until it returns SQLITE_DONE.+**+** If the bCommit parameter is non-zero, this function assumes that the +** caller will keep calling incrVacuumStep() until it returns SQLITE_DONE +** or an error. bCommit is passed true for an auto-vacuum-on-commit +** operation, or false for an incremental vacuum.+*/+static int incrVacuumStep(BtShared *pBt, Pgno nFin, Pgno iLastPg, int bCommit){+ Pgno nFreeList; /* Number of pages still on the free-list */+ int rc;++ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( iLastPg>nFin );++ if( !PTRMAP_ISPAGE(pBt, iLastPg) && iLastPg!=PENDING_BYTE_PAGE(pBt) ){+ u8 eType;+ Pgno iPtrPage;++ nFreeList = get4byte(&pBt->pPage1->aData[36]);+ if( nFreeList==0 ){+ return SQLITE_DONE;+ }++ rc = ptrmapGet(pBt, iLastPg, &eType, &iPtrPage);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ if( eType==PTRMAP_ROOTPAGE ){+ return SQLITE_CORRUPT_BKPT;+ }++ if( eType==PTRMAP_FREEPAGE ){+ if( bCommit==0 ){+ /* Remove the page from the files free-list. This is not required+ ** if bCommit is non-zero. In that case, the free-list will be+ ** truncated to zero after this function returns, so it doesn't + ** matter if it still contains some garbage entries.+ */+ Pgno iFreePg;+ MemPage *pFreePg;+ rc = allocateBtreePage(pBt, &pFreePg, &iFreePg, iLastPg, BTALLOC_EXACT);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ assert( iFreePg==iLastPg );+ releasePage(pFreePg);+ }+ } else {+ Pgno iFreePg; /* Index of free page to move pLastPg to */+ MemPage *pLastPg;+ u8 eMode = BTALLOC_ANY; /* Mode parameter for allocateBtreePage() */+ Pgno iNear = 0; /* nearby parameter for allocateBtreePage() */++ rc = btreeGetPage(pBt, iLastPg, &pLastPg, 0);+ if( rc!=SQLITE_OK ){+ return rc;+ }++ /* If bCommit is zero, this loop runs exactly once and page pLastPg+ ** is swapped with the first free page pulled off the free list.+ **+ ** On the other hand, if bCommit is greater than zero, then keep+ ** looping until a free-page located within the first nFin pages+ ** of the file is found.+ */+ if( bCommit==0 ){+ eMode = BTALLOC_LE;+ iNear = nFin;+ }+ do {+ MemPage *pFreePg;+ rc = allocateBtreePage(pBt, &pFreePg, &iFreePg, iNear, eMode);+ if( rc!=SQLITE_OK ){+ releasePage(pLastPg);+ return rc;+ }+ releasePage(pFreePg);+ }while( bCommit && iFreePg>nFin );+ assert( iFreePg<iLastPg );+ + rc = relocatePage(pBt, pLastPg, eType, iPtrPage, iFreePg, bCommit);+ releasePage(pLastPg);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ }+ }++ if( bCommit==0 ){+ do {+ iLastPg--;+ }while( iLastPg==PENDING_BYTE_PAGE(pBt) || PTRMAP_ISPAGE(pBt, iLastPg) );+ pBt->bDoTruncate = 1;+ pBt->nPage = iLastPg;+ }+ return SQLITE_OK;+}++/*+** The database opened by the first argument is an auto-vacuum database+** nOrig pages in size containing nFree free pages. Return the expected +** size of the database in pages following an auto-vacuum operation.+*/+static Pgno finalDbSize(BtShared *pBt, Pgno nOrig, Pgno nFree){+ int nEntry; /* Number of entries on one ptrmap page */+ Pgno nPtrmap; /* Number of PtrMap pages to be freed */+ Pgno nFin; /* Return value */++ nEntry = pBt->usableSize/5;+ nPtrmap = (nFree-nOrig+PTRMAP_PAGENO(pBt, nOrig)+nEntry)/nEntry;+ nFin = nOrig - nFree - nPtrmap;+ if( nOrig>PENDING_BYTE_PAGE(pBt) && nFin<PENDING_BYTE_PAGE(pBt) ){+ nFin--;+ }+ while( PTRMAP_ISPAGE(pBt, nFin) || nFin==PENDING_BYTE_PAGE(pBt) ){+ nFin--;+ }++ return nFin;+}++/*+** A write-transaction must be opened before calling this function.+** It performs a single unit of work towards an incremental vacuum.+**+** If the incremental vacuum is finished after this function has run,+** SQLITE_DONE is returned. If it is not finished, but no error occurred,+** SQLITE_OK is returned. Otherwise an SQLite error code. +*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeIncrVacuum(Btree *p){+ int rc;+ BtShared *pBt = p->pBt;++ sqlite3BtreeEnter(p);+ assert( pBt->inTransaction==TRANS_WRITE && p->inTrans==TRANS_WRITE );+ if( !pBt->autoVacuum ){+ rc = SQLITE_DONE;+ }else{+ Pgno nOrig = btreePagecount(pBt);+ Pgno nFree = get4byte(&pBt->pPage1->aData[36]);+ Pgno nFin = finalDbSize(pBt, nOrig, nFree);++ if( nOrig<nFin ){+ rc = SQLITE_CORRUPT_BKPT;+ }else if( nFree>0 ){+ rc = saveAllCursors(pBt, 0, 0);+ if( rc==SQLITE_OK ){+ invalidateAllOverflowCache(pBt);+ rc = incrVacuumStep(pBt, nFin, nOrig, 0);+ }+ if( rc==SQLITE_OK ){+ rc = sqlite3PagerWrite(pBt->pPage1->pDbPage);+ put4byte(&pBt->pPage1->aData[28], pBt->nPage);+ }+ }else{+ rc = SQLITE_DONE;+ }+ }+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** This routine is called prior to sqlite3PagerCommit when a transaction+** is committed for an auto-vacuum database.+**+** If SQLITE_OK is returned, then *pnTrunc is set to the number of pages+** the database file should be truncated to during the commit process. +** i.e. the database has been reorganized so that only the first *pnTrunc+** pages are in use.+*/+static int autoVacuumCommit(BtShared *pBt){+ int rc = SQLITE_OK;+ Pager *pPager = pBt->pPager;+ VVA_ONLY( int nRef = sqlite3PagerRefcount(pPager); )++ assert( sqlite3_mutex_held(pBt->mutex) );+ invalidateAllOverflowCache(pBt);+ assert(pBt->autoVacuum);+ if( !pBt->incrVacuum ){+ Pgno nFin; /* Number of pages in database after autovacuuming */+ Pgno nFree; /* Number of pages on the freelist initially */+ Pgno iFree; /* The next page to be freed */+ Pgno nOrig; /* Database size before freeing */++ nOrig = btreePagecount(pBt);+ if( PTRMAP_ISPAGE(pBt, nOrig) || nOrig==PENDING_BYTE_PAGE(pBt) ){+ /* It is not possible to create a database for which the final page+ ** is either a pointer-map page or the pending-byte page. If one+ ** is encountered, this indicates corruption.+ */+ return SQLITE_CORRUPT_BKPT;+ }++ nFree = get4byte(&pBt->pPage1->aData[36]);+ nFin = finalDbSize(pBt, nOrig, nFree);+ if( nFin>nOrig ) return SQLITE_CORRUPT_BKPT;+ if( nFin<nOrig ){+ rc = saveAllCursors(pBt, 0, 0);+ }+ for(iFree=nOrig; iFree>nFin && rc==SQLITE_OK; iFree--){+ rc = incrVacuumStep(pBt, nFin, iFree, 1);+ }+ if( (rc==SQLITE_DONE || rc==SQLITE_OK) && nFree>0 ){+ rc = sqlite3PagerWrite(pBt->pPage1->pDbPage);+ put4byte(&pBt->pPage1->aData[32], 0);+ put4byte(&pBt->pPage1->aData[36], 0);+ put4byte(&pBt->pPage1->aData[28], nFin);+ pBt->bDoTruncate = 1;+ pBt->nPage = nFin;+ }+ if( rc!=SQLITE_OK ){+ sqlite3PagerRollback(pPager);+ }+ }++ assert( nRef>=sqlite3PagerRefcount(pPager) );+ return rc;+}++#else /* ifndef SQLITE_OMIT_AUTOVACUUM */+# define setChildPtrmaps(x) SQLITE_OK+#endif++/*+** This routine does the first phase of a two-phase commit. This routine+** causes a rollback journal to be created (if it does not already exist)+** and populated with enough information so that if a power loss occurs+** the database can be restored to its original state by playing back+** the journal. Then the contents of the journal are flushed out to+** the disk. After the journal is safely on oxide, the changes to the+** database are written into the database file and flushed to oxide.+** At the end of this call, the rollback journal still exists on the+** disk and we are still holding all locks, so the transaction has not+** committed. See sqlite3BtreeCommitPhaseTwo() for the second phase of the+** commit process.+**+** This call is a no-op if no write-transaction is currently active on pBt.+**+** Otherwise, sync the database file for the btree pBt. zMaster points to+** the name of a master journal file that should be written into the+** individual journal file, or is NULL, indicating no master journal file +** (single database transaction).+**+** When this is called, the master journal should already have been+** created, populated with this journal pointer and synced to disk.+**+** Once this is routine has returned, the only thing required to commit+** the write-transaction for this database file is to delete the journal.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCommitPhaseOne(Btree *p, const char *zMaster){+ int rc = SQLITE_OK;+ if( p->inTrans==TRANS_WRITE ){+ BtShared *pBt = p->pBt;+ sqlite3BtreeEnter(p);+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pBt->autoVacuum ){+ rc = autoVacuumCommit(pBt);+ if( rc!=SQLITE_OK ){+ sqlite3BtreeLeave(p);+ return rc;+ }+ }+ if( pBt->bDoTruncate ){+ sqlite3PagerTruncateImage(pBt->pPager, pBt->nPage);+ }+#endif+ rc = sqlite3PagerCommitPhaseOne(pBt->pPager, zMaster, 0);+ sqlite3BtreeLeave(p);+ }+ return rc;+}++/*+** This function is called from both BtreeCommitPhaseTwo() and BtreeRollback()+** at the conclusion of a transaction.+*/+static void btreeEndTransaction(Btree *p){+ BtShared *pBt = p->pBt;+ assert( sqlite3BtreeHoldsMutex(p) );++#ifndef SQLITE_OMIT_AUTOVACUUM+ pBt->bDoTruncate = 0;+#endif+ if( p->inTrans>TRANS_NONE && p->nVdbeRead>1 ){+ /* If there are other active statements that belong to this database+ ** handle, downgrade to a read-only transaction. The other statements+ ** may still be reading from the database. */+ downgradeAllSharedCacheTableLocks(p);+ p->inTrans = TRANS_READ;+ }else{+ /* If the handle had any kind of transaction open, decrement the + ** transaction count of the shared btree. If the transaction count + ** reaches 0, set the shared state to TRANS_NONE. The unlockBtreeIfUnused()+ ** call below will unlock the pager. */+ if( p->inTrans!=TRANS_NONE ){+ clearAllSharedCacheTableLocks(p);+ pBt->nTransaction--;+ if( 0==pBt->nTransaction ){+ pBt->inTransaction = TRANS_NONE;+ }+ }++ /* Set the current transaction state to TRANS_NONE and unlock the + ** pager if this call closed the only read or write transaction. */+ p->inTrans = TRANS_NONE;+ unlockBtreeIfUnused(pBt);+ }++ btreeIntegrity(p);+}++/*+** Commit the transaction currently in progress.+**+** This routine implements the second phase of a 2-phase commit. The+** sqlite3BtreeCommitPhaseOne() routine does the first phase and should+** be invoked prior to calling this routine. The sqlite3BtreeCommitPhaseOne()+** routine did all the work of writing information out to disk and flushing the+** contents so that they are written onto the disk platter. All this+** routine has to do is delete or truncate or zero the header in the+** the rollback journal (which causes the transaction to commit) and+** drop locks.+**+** Normally, if an error occurs while the pager layer is attempting to +** finalize the underlying journal file, this function returns an error and+** the upper layer will attempt a rollback. However, if the second argument+** is non-zero then this b-tree transaction is part of a multi-file +** transaction. In this case, the transaction has already been committed +** (by deleting a master journal file) and the caller will ignore this +** functions return code. So, even if an error occurs in the pager layer,+** reset the b-tree objects internal state to indicate that the write+** transaction has been closed. This is quite safe, as the pager will have+** transitioned to the error state.+**+** This will release the write lock on the database file. If there+** are no active cursors, it also releases the read lock.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCommitPhaseTwo(Btree *p, int bCleanup){++ if( p->inTrans==TRANS_NONE ) return SQLITE_OK;+ sqlite3BtreeEnter(p);+ btreeIntegrity(p);++ /* If the handle has a write-transaction open, commit the shared-btrees + ** transaction and set the shared state to TRANS_READ.+ */+ if( p->inTrans==TRANS_WRITE ){+ int rc;+ BtShared *pBt = p->pBt;+ assert( pBt->inTransaction==TRANS_WRITE );+ assert( pBt->nTransaction>0 );+ rc = sqlite3PagerCommitPhaseTwo(pBt->pPager);+ if( rc!=SQLITE_OK && bCleanup==0 ){+ sqlite3BtreeLeave(p);+ return rc;+ }+ p->iDataVersion--; /* Compensate for pPager->iDataVersion++; */+ pBt->inTransaction = TRANS_READ;+ btreeClearHasContent(pBt);+ }++ btreeEndTransaction(p);+ sqlite3BtreeLeave(p);+ return SQLITE_OK;+}++/*+** Do both phases of a commit.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCommit(Btree *p){+ int rc;+ sqlite3BtreeEnter(p);+ rc = sqlite3BtreeCommitPhaseOne(p, 0);+ if( rc==SQLITE_OK ){+ rc = sqlite3BtreeCommitPhaseTwo(p, 0);+ }+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** This routine sets the state to CURSOR_FAULT and the error+** code to errCode for every cursor on any BtShared that pBtree+** references. Or if the writeOnly flag is set to 1, then only+** trip write cursors and leave read cursors unchanged.+**+** Every cursor is a candidate to be tripped, including cursors+** that belong to other database connections that happen to be+** sharing the cache with pBtree.+**+** This routine gets called when a rollback occurs. If the writeOnly+** flag is true, then only write-cursors need be tripped - read-only+** cursors save their current positions so that they may continue +** following the rollback. Or, if writeOnly is false, all cursors are +** tripped. In general, writeOnly is false if the transaction being+** rolled back modified the database schema. In this case b-tree root+** pages may be moved or deleted from the database altogether, making+** it unsafe for read cursors to continue.+**+** If the writeOnly flag is true and an error is encountered while +** saving the current position of a read-only cursor, all cursors, +** including all read-cursors are tripped.+**+** SQLITE_OK is returned if successful, or if an error occurs while+** saving a cursor position, an SQLite error code.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeTripAllCursors(Btree *pBtree, int errCode, int writeOnly){+ BtCursor *p;+ int rc = SQLITE_OK;++ assert( (writeOnly==0 || writeOnly==1) && BTCF_WriteFlag==1 );+ if( pBtree ){+ sqlite3BtreeEnter(pBtree);+ for(p=pBtree->pBt->pCursor; p; p=p->pNext){+ int i;+ if( writeOnly && (p->curFlags & BTCF_WriteFlag)==0 ){+ if( p->eState==CURSOR_VALID || p->eState==CURSOR_SKIPNEXT ){+ rc = saveCursorPosition(p);+ if( rc!=SQLITE_OK ){+ (void)sqlite3BtreeTripAllCursors(pBtree, rc, 0);+ break;+ }+ }+ }else{+ sqlite3BtreeClearCursor(p);+ p->eState = CURSOR_FAULT;+ p->skipNext = errCode;+ }+ for(i=0; i<=p->iPage; i++){+ releasePage(p->apPage[i]);+ p->apPage[i] = 0;+ }+ }+ sqlite3BtreeLeave(pBtree);+ }+ return rc;+}++/*+** Rollback the transaction in progress.+**+** If tripCode is not SQLITE_OK then cursors will be invalidated (tripped).+** Only write cursors are tripped if writeOnly is true but all cursors are+** tripped if writeOnly is false. Any attempt to use+** a tripped cursor will result in an error.+**+** This will release the write lock on the database file. If there+** are no active cursors, it also releases the read lock.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeRollback(Btree *p, int tripCode, int writeOnly){+ int rc;+ BtShared *pBt = p->pBt;+ MemPage *pPage1;++ assert( writeOnly==1 || writeOnly==0 );+ assert( tripCode==SQLITE_ABORT_ROLLBACK || tripCode==SQLITE_OK );+ sqlite3BtreeEnter(p);+ if( tripCode==SQLITE_OK ){+ rc = tripCode = saveAllCursors(pBt, 0, 0);+ if( rc ) writeOnly = 0;+ }else{+ rc = SQLITE_OK;+ }+ if( tripCode ){+ int rc2 = sqlite3BtreeTripAllCursors(p, tripCode, writeOnly);+ assert( rc==SQLITE_OK || (writeOnly==0 && rc2==SQLITE_OK) );+ if( rc2!=SQLITE_OK ) rc = rc2;+ }+ btreeIntegrity(p);++ if( p->inTrans==TRANS_WRITE ){+ int rc2;++ assert( TRANS_WRITE==pBt->inTransaction );+ rc2 = sqlite3PagerRollback(pBt->pPager);+ if( rc2!=SQLITE_OK ){+ rc = rc2;+ }++ /* The rollback may have destroyed the pPage1->aData value. So+ ** call btreeGetPage() on page 1 again to make+ ** sure pPage1->aData is set correctly. */+ if( btreeGetPage(pBt, 1, &pPage1, 0)==SQLITE_OK ){+ int nPage = get4byte(28+(u8*)pPage1->aData);+ testcase( nPage==0 );+ if( nPage==0 ) sqlite3PagerPagecount(pBt->pPager, &nPage);+ testcase( pBt->nPage!=nPage );+ pBt->nPage = nPage;+ releasePage(pPage1);+ }+ assert( countValidCursors(pBt, 1)==0 );+ pBt->inTransaction = TRANS_READ;+ btreeClearHasContent(pBt);+ }++ btreeEndTransaction(p);+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** Start a statement subtransaction. The subtransaction can be rolled+** back independently of the main transaction. You must start a transaction +** before starting a subtransaction. The subtransaction is ended automatically +** if the main transaction commits or rolls back.+**+** Statement subtransactions are used around individual SQL statements+** that are contained within a BEGIN...COMMIT block. If a constraint+** error occurs within the statement, the effect of that one statement+** can be rolled back without having to rollback the entire transaction.+**+** A statement sub-transaction is implemented as an anonymous savepoint. The+** value passed as the second parameter is the total number of savepoints,+** including the new anonymous savepoint, open on the B-Tree. i.e. if there+** are no active savepoints and no other statement-transactions open,+** iStatement is 1. This anonymous savepoint can be released or rolled back+** using the sqlite3BtreeSavepoint() function.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeBeginStmt(Btree *p, int iStatement){+ int rc;+ BtShared *pBt = p->pBt;+ sqlite3BtreeEnter(p);+ assert( p->inTrans==TRANS_WRITE );+ assert( (pBt->btsFlags & BTS_READ_ONLY)==0 );+ assert( iStatement>0 );+ assert( iStatement>p->nSavepoint );+ assert( pBt->inTransaction==TRANS_WRITE );+ /* At the pager level, a statement transaction is a savepoint with+ ** an index greater than all savepoints created explicitly using+ ** SQL statements. It is illegal to open, release or rollback any+ ** such savepoints while the statement transaction savepoint is active.+ */+ rc = sqlite3PagerOpenSavepoint(pBt->pPager, iStatement);+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** The second argument to this function, op, is always SAVEPOINT_ROLLBACK+** or SAVEPOINT_RELEASE. This function either releases or rolls back the+** savepoint identified by parameter iSavepoint, depending on the value +** of op.+**+** Normally, iSavepoint is greater than or equal to zero. However, if op is+** SAVEPOINT_ROLLBACK, then iSavepoint may also be -1. In this case the +** contents of the entire transaction are rolled back. This is different+** from a normal transaction rollback, as no locks are released and the+** transaction remains open.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSavepoint(Btree *p, int op, int iSavepoint){+ int rc = SQLITE_OK;+ if( p && p->inTrans==TRANS_WRITE ){+ BtShared *pBt = p->pBt;+ assert( op==SAVEPOINT_RELEASE || op==SAVEPOINT_ROLLBACK );+ assert( iSavepoint>=0 || (iSavepoint==-1 && op==SAVEPOINT_ROLLBACK) );+ sqlite3BtreeEnter(p);+ rc = sqlite3PagerSavepoint(pBt->pPager, op, iSavepoint);+ if( rc==SQLITE_OK ){+ if( iSavepoint<0 && (pBt->btsFlags & BTS_INITIALLY_EMPTY)!=0 ){+ pBt->nPage = 0;+ }+ rc = newDatabase(pBt);+ pBt->nPage = get4byte(28 + pBt->pPage1->aData);++ /* The database size was written into the offset 28 of the header+ ** when the transaction started, so we know that the value at offset+ ** 28 is nonzero. */+ assert( pBt->nPage>0 );+ }+ sqlite3BtreeLeave(p);+ }+ return rc;+}++/*+** Create a new cursor for the BTree whose root is on the page+** iTable. If a read-only cursor is requested, it is assumed that+** the caller already has at least a read-only transaction open+** on the database already. If a write-cursor is requested, then+** the caller is assumed to have an open write transaction.+**+** If wrFlag==0, then the cursor can only be used for reading.+** If wrFlag==1, then the cursor can be used for reading or for+** writing if other conditions for writing are also met. These+** are the conditions that must be met in order for writing to+** be allowed:+**+** 1: The cursor must have been opened with wrFlag==1+**+** 2: Other database connections that share the same pager cache+** but which are not in the READ_UNCOMMITTED state may not have+** cursors open with wrFlag==0 on the same table. Otherwise+** the changes made by this write cursor would be visible to+** the read cursors in the other database connection.+**+** 3: The database must be writable (not on read-only media)+**+** 4: There must be an active transaction.+**+** No checking is done to make sure that page iTable really is the+** root page of a b-tree. If it is not, then the cursor acquired+** will not work correctly.+*/+static int btreeCursor(+ Btree *p, /* The btree */+ int iTable, /* Root page of table to open */+ int wrFlag, /* 1 to write. 0 read-only */+ struct KeyInfo *pKeyInfo, /* First arg to comparison function */+ BtCursor *pCur /* Space for new cursor */+){+ BtShared *pBt = p->pBt; /* Shared b-tree handle */+ BtCursor *pX; /* Looping over other all cursors */++ assert( sqlite3BtreeHoldsMutex(p) );+ assert( wrFlag==0 || wrFlag==1 );++ /* The following assert statements verify that if this is a sharable + ** b-tree database, the connection is holding the required table locks, + ** and that no other connection has any open cursor that conflicts with + ** this lock. */+ assert( hasSharedCacheTableLock(p, iTable, pKeyInfo!=0, wrFlag+1) );+ assert( wrFlag==0 || !hasReadConflicts(p, iTable) );++ /* Assert that the caller has opened the required transaction. */+ assert( p->inTrans>TRANS_NONE );+ assert( wrFlag==0 || p->inTrans==TRANS_WRITE );+ assert( pBt->pPage1 && pBt->pPage1->aData );+ assert( wrFlag==0 || (pBt->btsFlags & BTS_READ_ONLY)==0 );++ if( wrFlag ){+ allocateTempSpace(pBt);+ if( pBt->pTmpSpace==0 ) return SQLITE_NOMEM;+ }+ if( iTable==1 && btreePagecount(pBt)==0 ){+ assert( wrFlag==0 );+ iTable = 0;+ }++ /* Now that no other errors can occur, finish filling in the BtCursor+ ** variables and link the cursor into the BtShared list. */+ pCur->pgnoRoot = (Pgno)iTable;+ pCur->iPage = -1;+ pCur->pKeyInfo = pKeyInfo;+ pCur->pBtree = p;+ pCur->pBt = pBt;+ assert( wrFlag==0 || wrFlag==BTCF_WriteFlag );+ pCur->curFlags = wrFlag;+ pCur->curPagerFlags = wrFlag ? 0 : PAGER_GET_READONLY;+ /* If there are two or more cursors on the same btree, then all such+ ** cursors *must* have the BTCF_Multiple flag set. */+ for(pX=pBt->pCursor; pX; pX=pX->pNext){+ if( pX->pgnoRoot==(Pgno)iTable ){+ pX->curFlags |= BTCF_Multiple;+ pCur->curFlags |= BTCF_Multiple;+ }+ }+ pCur->pNext = pBt->pCursor;+ pBt->pCursor = pCur;+ pCur->eState = CURSOR_INVALID;+ return SQLITE_OK;+}+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCursor(+ Btree *p, /* The btree */+ int iTable, /* Root page of table to open */+ int wrFlag, /* 1 to write. 0 read-only */+ int N, int X, /* index of N key columns and X extra columns */+ BtCursor **ppCur /* Write new cursor here */+){+ int rc;+ + *ppCur = 0;+ if( iTable<1 ){+ rc = SQLITE_CORRUPT_BKPT;+ }else{+ KeyInfo *pKeyInfo = NULL;+ if (N > 0 || X > 0) {+ pKeyInfo = sqlite3DbMallocZero(0, + sizeof(KeyInfo) + (N+X)*(sizeof(CollSeq*)+1));+ if( pKeyInfo ){+ pKeyInfo->aSortOrder = (u8*)&pKeyInfo->aColl[N+X];+ pKeyInfo->nField = (u16)N;+ pKeyInfo->nXField = (u16)X;+ pKeyInfo->enc = p->enc;+ pKeyInfo->pBtree = p;+ pKeyInfo->nRef = 1;+ }else{+ p->mallocFailed = 1;+ return SQLITE_NOMEM;+ }+ }++ BtCursor *pCur = sqlite3MallocZero(sizeof(BtCursor));+ if (!pCur) {+ p->mallocFailed = 1;+ sqlite3_free(pKeyInfo);+ return SQLITE_NOMEM;+ }++ sqlite3BtreeEnter(p);+ rc = btreeCursor(p, iTable, wrFlag, pKeyInfo, pCur);+ sqlite3BtreeLeave(p);+ + if (rc != SQLITE_OK) {+ sqlite3_free(pKeyInfo);+ sqlite3_free(pCur);+ return rc;+ }++ *ppCur = pCur;+ }+ return rc;+}++/*+** Return the size of a BtCursor object in bytes.+**+** This interfaces is needed so that users of cursors can preallocate+** sufficient storage to hold a cursor. The BtCursor object is opaque+** to users so they cannot do the sizeof() themselves - they must call+** this routine.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCursorSize(void){+ return ROUND8(sizeof(BtCursor));+}++/*+** Close a cursor. The read lock on the database file is released+** when the last cursor is closed.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCloseCursor(BtCursor *pCur){+ Btree *pBtree = pCur->pBtree;+ if( pBtree ){+ int i;+ BtShared *pBt = pCur->pBt;+ sqlite3BtreeEnter(pBtree);+ sqlite3BtreeClearCursor(pCur);+ assert( pBt->pCursor!=0 );+ if( pBt->pCursor==pCur ){+ pBt->pCursor = pCur->pNext;+ }else{+ BtCursor *pPrev = pBt->pCursor;+ do{+ if( pPrev->pNext==pCur ){+ pPrev->pNext = pCur->pNext;+ break;+ }+ pPrev = pPrev->pNext;+ }while( ALWAYS(pPrev) );+ }+ for(i=0; i<=pCur->iPage; i++){+ releasePage(pCur->apPage[i]);+ }+ unlockBtreeIfUnused(pBt);+ sqlite3_free(pCur->aOverflow);+ /* sqlite3_free(pCur); */+ sqlite3BtreeLeave(pBtree);+ }+ + if( pCur->pKeyInfo ) {+ assert( pCur->pKeyInfo->nRef>0 );+ pCur->pKeyInfo->nRef--;+ if( pCur->pKeyInfo->nRef==0 ) sqlite3DbFree(0, pCur->pKeyInfo);+ }++ sqlite3_free(pCur);+ return SQLITE_OK;+}++/*+** Make sure the BtCursor* given in the argument has a valid+** BtCursor.info structure. If it is not already valid, call+** btreeParseCell() to fill it in.+**+** BtCursor.info is a cache of the information in the current cell.+** Using this cache reduces the number of calls to btreeParseCell().+*/+#ifndef NDEBUG+ static void assertCellInfo(BtCursor *pCur){+ CellInfo info;+ int iPage = pCur->iPage;+ memset(&info, 0, sizeof(info));+ btreeParseCell(pCur->apPage[iPage], pCur->aiIdx[iPage], &info);+ assert( CORRUPT_DB || memcmp(&info, &pCur->info, sizeof(info))==0 );+ }+#else+ #define assertCellInfo(x)+#endif+static SQLITE_NOINLINE void getCellInfo(BtCursor *pCur){+ if( pCur->info.nSize==0 ){+ int iPage = pCur->iPage;+ pCur->curFlags |= BTCF_ValidNKey;+ btreeParseCell(pCur->apPage[iPage],pCur->aiIdx[iPage],&pCur->info);+ }else{+ assertCellInfo(pCur);+ }+}++#ifndef NDEBUG /* The next routine used only within assert() statements */+/*+** Return true if the given BtCursor is valid. A valid cursor is one+** that is currently pointing to a row in a (non-empty) table.+** This is a verification routine is used only within assert() statements.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCursorIsValid(BtCursor *pCur){+ return pCur && pCur->eState==CURSOR_VALID;+}+#endif /* NDEBUG */++/*+** Set *pSize to the size of the buffer needed to hold the value of+** the key for the current entry. If the cursor is not pointing+** to a valid entry, *pSize is set to 0. +**+** For a table with the INTKEY flag set, this routine returns the key+** itself, not the number of bytes in the key.+**+** The caller must position the cursor prior to invoking this routine.+** +** This routine cannot fail. It always returns SQLITE_OK. +*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeKeySize(BtCursor *pCur, i64 *pSize){+ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState==CURSOR_VALID );+ getCellInfo(pCur);+ *pSize = pCur->info.nKey;+ return SQLITE_OK;+}++/*+** Set *pSize to the number of bytes of data in the entry the+** cursor currently points to.+**+** The caller must guarantee that the cursor is pointing to a non-NULL+** valid entry. In other words, the calling procedure must guarantee+** that the cursor has Cursor.eState==CURSOR_VALID.+**+** Failure is not possible. This function always returns SQLITE_OK.+** It might just as well be a procedure (returning void) but we continue+** to return an integer result code for historical reasons.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeDataSize(BtCursor *pCur, u32 *pSize){+ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState==CURSOR_VALID );+ assert( pCur->iPage>=0 );+ assert( pCur->iPage<BTCURSOR_MAX_DEPTH );+ assert( pCur->apPage[pCur->iPage]->intKeyLeaf==1 );+ getCellInfo(pCur);+ *pSize = pCur->info.nPayload;+ return SQLITE_OK;+}++/*+** Given the page number of an overflow page in the database (parameter+** ovfl), this function finds the page number of the next page in the +** linked list of overflow pages. If possible, it uses the auto-vacuum+** pointer-map data instead of reading the content of page ovfl to do so. +**+** If an error occurs an SQLite error code is returned. Otherwise:+**+** The page number of the next overflow page in the linked list is +** written to *pPgnoNext. If page ovfl is the last page in its linked +** list, *pPgnoNext is set to zero. +**+** If ppPage is not NULL, and a reference to the MemPage object corresponding+** to page number pOvfl was obtained, then *ppPage is set to point to that+** reference. It is the responsibility of the caller to call releasePage()+** on *ppPage to free the reference. In no reference was obtained (because+** the pointer-map was used to obtain the value for *pPgnoNext), then+** *ppPage is set to zero.+*/+static int getOverflowPage(+ BtShared *pBt, /* The database file */+ Pgno ovfl, /* Current overflow page number */+ MemPage **ppPage, /* OUT: MemPage handle (may be NULL) */+ Pgno *pPgnoNext /* OUT: Next overflow page number */+){+ Pgno next = 0;+ MemPage *pPage = 0;+ int rc = SQLITE_OK;++ assert( sqlite3_mutex_held(pBt->mutex) );+ assert(pPgnoNext);++#ifndef SQLITE_OMIT_AUTOVACUUM+ /* Try to find the next page in the overflow list using the+ ** autovacuum pointer-map pages. Guess that the next page in + ** the overflow list is page number (ovfl+1). If that guess turns + ** out to be wrong, fall back to loading the data of page + ** number ovfl to determine the next page number.+ */+ if( pBt->autoVacuum ){+ Pgno pgno;+ Pgno iGuess = ovfl+1;+ u8 eType;++ while( PTRMAP_ISPAGE(pBt, iGuess) || iGuess==PENDING_BYTE_PAGE(pBt) ){+ iGuess++;+ }++ if( iGuess<=btreePagecount(pBt) ){+ rc = ptrmapGet(pBt, iGuess, &eType, &pgno);+ if( rc==SQLITE_OK && eType==PTRMAP_OVERFLOW2 && pgno==ovfl ){+ next = iGuess;+ rc = SQLITE_DONE;+ }+ }+ }+#endif++ assert( next==0 || rc==SQLITE_DONE );+ if( rc==SQLITE_OK ){+ rc = btreeGetPage(pBt, ovfl, &pPage, (ppPage==0) ? PAGER_GET_READONLY : 0);+ assert( rc==SQLITE_OK || pPage==0 );+ if( rc==SQLITE_OK ){+ next = get4byte(pPage->aData);+ }+ }++ *pPgnoNext = next;+ if( ppPage ){+ *ppPage = pPage;+ }else{+ releasePage(pPage);+ }+ return (rc==SQLITE_DONE ? SQLITE_OK : rc);+}++/*+** Copy data from a buffer to a page, or from a page to a buffer.+**+** pPayload is a pointer to data stored on database page pDbPage.+** If argument eOp is false, then nByte bytes of data are copied+** from pPayload to the buffer pointed at by pBuf. If eOp is true,+** then sqlite3PagerWrite() is called on pDbPage and nByte bytes+** of data are copied from the buffer pBuf to pPayload.+**+** SQLITE_OK is returned on success, otherwise an error code.+*/+static int copyPayload(+ void *pPayload, /* Pointer to page data */+ void *pBuf, /* Pointer to buffer */+ int nByte, /* Number of bytes to copy */+ int eOp, /* 0 -> copy from page, 1 -> copy to page */+ DbPage *pDbPage /* Page containing pPayload */+){+ if( eOp ){+ /* Copy data from buffer to page (a write operation) */+ int rc = sqlite3PagerWrite(pDbPage);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ memcpy(pPayload, pBuf, nByte);+ }else{+ /* Copy data from page to buffer (a read operation) */+ memcpy(pBuf, pPayload, nByte);+ }+ return SQLITE_OK;+}++/*+** This function is used to read or overwrite payload information+** for the entry that the pCur cursor is pointing to. The eOp+** argument is interpreted as follows:+**+** 0: The operation is a read. Populate the overflow cache.+** 1: The operation is a write. Populate the overflow cache.+** 2: The operation is a read. Do not populate the overflow cache.+**+** A total of "amt" bytes are read or written beginning at "offset".+** Data is read to or from the buffer pBuf.+**+** The content being read or written might appear on the main page+** or be scattered out on multiple overflow pages.+**+** If the current cursor entry uses one or more overflow pages and the+** eOp argument is not 2, this function may allocate space for and lazily +** populates the overflow page-list cache array (BtCursor.aOverflow). +** Subsequent calls use this cache to make seeking to the supplied offset +** more efficient.+**+** Once an overflow page-list cache has been allocated, it may be+** invalidated if some other cursor writes to the same table, or if+** the cursor is moved to a different row. Additionally, in auto-vacuum+** mode, the following events may invalidate an overflow page-list cache.+**+** * An incremental vacuum,+** * A commit in auto_vacuum="full" mode,+** * Creating a table (may require moving an overflow page).+*/+static int accessPayload(+ BtCursor *pCur, /* Cursor pointing to entry to read from */+ u32 offset, /* Begin reading this far into payload */+ u32 amt, /* Read this many bytes */+ unsigned char *pBuf, /* Write the bytes into this buffer */ + int eOp /* zero to read. non-zero to write. */+){+ unsigned char *aPayload;+ int rc = SQLITE_OK;+ int iIdx = 0;+ MemPage *pPage = pCur->apPage[pCur->iPage]; /* Btree page of current entry */+ BtShared *pBt = pCur->pBt; /* Btree this cursor belongs to */+#ifdef SQLITE_DIRECT_OVERFLOW_READ+ unsigned char * const pBufStart = pBuf;+ int bEnd; /* True if reading to end of data */+#endif++ assert( pPage );+ assert( pCur->eState==CURSOR_VALID );+ assert( pCur->aiIdx[pCur->iPage]<pPage->nCell );+ assert( cursorHoldsMutex(pCur) );+ assert( eOp!=2 || offset==0 ); /* Always start from beginning for eOp==2 */++ getCellInfo(pCur);+ aPayload = pCur->info.pPayload;+#ifdef SQLITE_DIRECT_OVERFLOW_READ+ bEnd = offset+amt==pCur->info.nPayload;+#endif+ assert( offset+amt <= pCur->info.nPayload );++ if( &aPayload[pCur->info.nLocal] > &pPage->aData[pBt->usableSize] ){+ /* Trying to read or write past the end of the data is an error */+ return SQLITE_CORRUPT_BKPT;+ }++ /* Check if data must be read/written to/from the btree page itself. */+ if( offset<pCur->info.nLocal ){+ int a = amt;+ if( a+offset>pCur->info.nLocal ){+ a = pCur->info.nLocal - offset;+ }+ rc = copyPayload(&aPayload[offset], pBuf, a, (eOp & 0x01), pPage->pDbPage);+ offset = 0;+ pBuf += a;+ amt -= a;+ }else{+ offset -= pCur->info.nLocal;+ }+++ if( rc==SQLITE_OK && amt>0 ){+ const u32 ovflSize = pBt->usableSize - 4; /* Bytes content per ovfl page */+ Pgno nextPage;++ nextPage = get4byte(&aPayload[pCur->info.nLocal]);++ /* If the BtCursor.aOverflow[] has not been allocated, allocate it now.+ ** Except, do not allocate aOverflow[] for eOp==2.+ **+ ** The aOverflow[] array is sized at one entry for each overflow page+ ** in the overflow chain. The page number of the first overflow page is+ ** stored in aOverflow[0], etc. A value of 0 in the aOverflow[] array+ ** means "not yet known" (the cache is lazily populated).+ */+ if( eOp!=2 && (pCur->curFlags & BTCF_ValidOvfl)==0 ){+ int nOvfl = (pCur->info.nPayload-pCur->info.nLocal+ovflSize-1)/ovflSize;+ if( nOvfl>pCur->nOvflAlloc ){+ Pgno *aNew = (Pgno*)sqlite3Realloc(+ pCur->aOverflow, nOvfl*2*sizeof(Pgno)+ );+ if( aNew==0 ){+ rc = SQLITE_NOMEM;+ }else{+ pCur->nOvflAlloc = nOvfl*2;+ pCur->aOverflow = aNew;+ }+ }+ if( rc==SQLITE_OK ){+ memset(pCur->aOverflow, 0, nOvfl*sizeof(Pgno));+ pCur->curFlags |= BTCF_ValidOvfl;+ }+ }++ /* If the overflow page-list cache has been allocated and the+ ** entry for the first required overflow page is valid, skip+ ** directly to it.+ */+ if( (pCur->curFlags & BTCF_ValidOvfl)!=0+ && pCur->aOverflow[offset/ovflSize]+ ){+ iIdx = (offset/ovflSize);+ nextPage = pCur->aOverflow[iIdx];+ offset = (offset%ovflSize);+ }++ for( ; rc==SQLITE_OK && amt>0 && nextPage; iIdx++){++ /* If required, populate the overflow page-list cache. */+ if( (pCur->curFlags & BTCF_ValidOvfl)!=0 ){+ assert(!pCur->aOverflow[iIdx] || pCur->aOverflow[iIdx]==nextPage);+ pCur->aOverflow[iIdx] = nextPage;+ }++ if( offset>=ovflSize ){+ /* The only reason to read this page is to obtain the page+ ** number for the next page in the overflow chain. The page+ ** data is not required. So first try to lookup the overflow+ ** page-list cache, if any, then fall back to the getOverflowPage()+ ** function.+ **+ ** Note that the aOverflow[] array must be allocated because eOp!=2+ ** here. If eOp==2, then offset==0 and this branch is never taken.+ */+ assert( eOp!=2 );+ assert( pCur->curFlags & BTCF_ValidOvfl );+ assert( pCur->pBtree->db==pBt->db );+ if( pCur->aOverflow[iIdx+1] ){+ nextPage = pCur->aOverflow[iIdx+1];+ }else{+ rc = getOverflowPage(pBt, nextPage, 0, &nextPage);+ }+ offset -= ovflSize;+ }else{+ /* Need to read this page properly. It contains some of the+ ** range of data that is being read (eOp==0) or written (eOp!=0).+ */+#ifdef SQLITE_DIRECT_OVERFLOW_READ+ sqlite3_file *fd;+#endif+ int a = amt;+ if( a + offset > ovflSize ){+ a = ovflSize - offset;+ }++#ifdef SQLITE_DIRECT_OVERFLOW_READ+ /* If all the following are true:+ **+ ** 1) this is a read operation, and + ** 2) data is required from the start of this overflow page, and+ ** 3) the database is file-backed, and+ ** 4) there is no open write-transaction, and+ ** 5) the database is not a WAL database,+ ** 6) all data from the page is being read.+ ** 7) at least 4 bytes have already been read into the output buffer + **+ ** then data can be read directly from the database file into the+ ** output buffer, bypassing the page-cache altogether. This speeds+ ** up loading large records that span many overflow pages.+ */+ if( (eOp&0x01)==0 /* (1) */+ && offset==0 /* (2) */+ && (bEnd || a==ovflSize) /* (6) */+ && pBt->inTransaction==TRANS_READ /* (4) */+ && (fd = sqlite3PagerFile(pBt->pPager))->pMethods /* (3) */+ && pBt->pPage1->aData[19]==0x01 /* (5) */+ && &pBuf[-4]>=pBufStart /* (7) */+ ){+ u8 aSave[4];+ u8 *aWrite = &pBuf[-4];+ assert( aWrite>=pBufStart ); /* hence (7) */+ memcpy(aSave, aWrite, 4);+ rc = sqlite3OsRead(fd, aWrite, a+4, (i64)pBt->pageSize*(nextPage-1));+ nextPage = get4byte(aWrite);+ memcpy(aWrite, aSave, 4);+ }else+#endif++ {+ DbPage *pDbPage;+ rc = sqlite3PagerAcquire(pBt->pPager, nextPage, &pDbPage,+ ((eOp&0x01)==0 ? PAGER_GET_READONLY : 0)+ );+ if( rc==SQLITE_OK ){+ aPayload = sqlite3PagerGetData(pDbPage);+ nextPage = get4byte(aPayload);+ rc = copyPayload(&aPayload[offset+4], pBuf, a, (eOp&0x01), pDbPage);+ sqlite3PagerUnref(pDbPage);+ offset = 0;+ }+ }+ amt -= a;+ pBuf += a;+ }+ }+ }++ if( rc==SQLITE_OK && amt>0 ){+ return SQLITE_CORRUPT_BKPT;+ }+ return rc;+}++/*+** Read part of the key associated with cursor pCur. Exactly+** "amt" bytes will be transferred into pBuf[]. The transfer+** begins at "offset".+**+** The caller must ensure that pCur is pointing to a valid row+** in the table.+**+** Return SQLITE_OK on success or an error code if anything goes+** wrong. An error is returned if "offset+amt" is larger than+** the available payload.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeKey(BtCursor *pCur, u32 offset, u32 amt, void *pBuf){+ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState==CURSOR_VALID );+ assert( pCur->iPage>=0 && pCur->apPage[pCur->iPage] );+ assert( pCur->aiIdx[pCur->iPage]<pCur->apPage[pCur->iPage]->nCell );+ return accessPayload(pCur, offset, amt, (unsigned char*)pBuf, 0);+}++/*+** Read part of the data associated with cursor pCur. Exactly+** "amt" bytes will be transfered into pBuf[]. The transfer+** begins at "offset".+**+** Return SQLITE_OK on success or an error code if anything goes+** wrong. An error is returned if "offset+amt" is larger than+** the available payload.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeData(BtCursor *pCur, u32 offset, u32 amt, void *pBuf){+ int rc;++#ifndef SQLITE_OMIT_INCRBLOB+ if ( pCur->eState==CURSOR_INVALID ){+ return SQLITE_ABORT;+ }+#endif++ assert( cursorHoldsMutex(pCur) );+ rc = restoreCursorPosition(pCur);+ if( rc==SQLITE_OK ){+ assert( pCur->eState==CURSOR_VALID );+ assert( pCur->iPage>=0 && pCur->apPage[pCur->iPage] );+ assert( pCur->aiIdx[pCur->iPage]<pCur->apPage[pCur->iPage]->nCell );+ rc = accessPayload(pCur, offset, amt, pBuf, 0);+ }+ return rc;+}++/*+** Return a pointer to payload information from the entry that the +** pCur cursor is pointing to. The pointer is to the beginning of+** the key if index btrees (pPage->intKey==0) and is the data for+** table btrees (pPage->intKey==1). The number of bytes of available+** key/data is written into *pAmt. If *pAmt==0, then the value+** returned will not be a valid pointer.+**+** This routine is an optimization. It is common for the entire key+** and data to fit on the local page and for there to be no overflow+** pages. When that is so, this routine can be used to access the+** key and data without making a copy. If the key and/or data spills+** onto overflow pages, then accessPayload() must be used to reassemble+** the key/data and copy it into a preallocated buffer.+**+** The pointer returned by this routine looks directly into the cached+** page of the database. The data might change or move the next time+** any btree routine is called.+*/+static const void *fetchPayload(+ BtCursor *pCur, /* Cursor pointing to entry to read from */+ u32 *pAmt /* Write the number of available bytes here */+){+ u32 amt;+ assert( pCur!=0 && pCur->iPage>=0 && pCur->apPage[pCur->iPage]);+ assert( pCur->eState==CURSOR_VALID );+ assert( sqlite3_mutex_held(pCur->pBtree->db->mutex) );+ assert( cursorHoldsMutex(pCur) );+ assert( pCur->aiIdx[pCur->iPage]<pCur->apPage[pCur->iPage]->nCell );+ assert( pCur->info.nSize>0 );+ assert( pCur->info.pPayload>pCur->apPage[pCur->iPage]->aData || CORRUPT_DB );+ assert( pCur->info.pPayload<pCur->apPage[pCur->iPage]->aDataEnd ||CORRUPT_DB);+ amt = (int)(pCur->apPage[pCur->iPage]->aDataEnd - pCur->info.pPayload);+ if( pCur->info.nLocal<amt ) amt = pCur->info.nLocal;+ *pAmt = amt;+ return (void*)pCur->info.pPayload;+}+++/*+** For the entry that cursor pCur is point to, return as+** many bytes of the key or data as are available on the local+** b-tree page. Write the number of available bytes into *pAmt.+**+** The pointer returned is ephemeral. The key/data may move+** or be destroyed on the next call to any Btree routine,+** including calls from other threads against the same cache.+** Hence, a mutex on the BtShared should be held prior to calling+** this routine.+**+** These routines is used to get quick access to key and data+** in the common case where no overflow pages are used.+*/+SQLITE_API const void *SQLITE_STDCALL sqlite3BtreeKeyFetch(BtCursor *pCur, u32 *pAmt){+ return fetchPayload(pCur, pAmt);+}+SQLITE_API const void *SQLITE_STDCALL sqlite3BtreeDataFetch(BtCursor *pCur, u32 *pAmt){+ return fetchPayload(pCur, pAmt);+}+++/*+** Move the cursor down to a new child page. The newPgno argument is the+** page number of the child page to move to.+**+** This function returns SQLITE_CORRUPT if the page-header flags field of+** the new child page does not match the flags field of the parent (i.e.+** if an intkey page appears to be the parent of a non-intkey page, or+** vice-versa).+*/+static int moveToChild(BtCursor *pCur, u32 newPgno){+ BtShared *pBt = pCur->pBt;++ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState==CURSOR_VALID );+ assert( pCur->iPage<BTCURSOR_MAX_DEPTH );+ assert( pCur->iPage>=0 );+ if( pCur->iPage>=(BTCURSOR_MAX_DEPTH-1) ){+ return SQLITE_CORRUPT_BKPT;+ }+ pCur->info.nSize = 0;+ pCur->curFlags &= ~(BTCF_ValidNKey|BTCF_ValidOvfl);+ pCur->iPage++;+ pCur->aiIdx[pCur->iPage] = 0;+ return getAndInitPage(pBt, newPgno, &pCur->apPage[pCur->iPage],+ pCur, pCur->curPagerFlags);+}++#if SQLITE_DEBUG+/*+** Page pParent is an internal (non-leaf) tree page. This function +** asserts that page number iChild is the left-child if the iIdx'th+** cell in page pParent. Or, if iIdx is equal to the total number of+** cells in pParent, that page number iChild is the right-child of+** the page.+*/+static void assertParentIndex(MemPage *pParent, int iIdx, Pgno iChild){+ if( CORRUPT_DB ) return; /* The conditions tested below might not be true+ ** in a corrupt database */+ assert( iIdx<=pParent->nCell );+ if( iIdx==pParent->nCell ){+ assert( get4byte(&pParent->aData[pParent->hdrOffset+8])==iChild );+ }else{+ assert( get4byte(findCell(pParent, iIdx))==iChild );+ }+}+#else+# define assertParentIndex(x,y,z) +#endif++/*+** Move the cursor up to the parent page.+**+** pCur->idx is set to the cell index that contains the pointer+** to the page we are coming from. If we are coming from the+** right-most child page then pCur->idx is set to one more than+** the largest cell index.+*/+static void moveToParent(BtCursor *pCur){+ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState==CURSOR_VALID );+ assert( pCur->iPage>0 );+ assert( pCur->apPage[pCur->iPage] );+ assertParentIndex(+ pCur->apPage[pCur->iPage-1], + pCur->aiIdx[pCur->iPage-1], + pCur->apPage[pCur->iPage]->pgno+ );+ testcase( pCur->aiIdx[pCur->iPage-1] > pCur->apPage[pCur->iPage-1]->nCell );+ pCur->info.nSize = 0;+ pCur->curFlags &= ~(BTCF_ValidNKey|BTCF_ValidOvfl);+ releasePageNotNull(pCur->apPage[pCur->iPage--]);+}++/*+** Move the cursor to point to the root page of its b-tree structure.+**+** If the table has a virtual root page, then the cursor is moved to point+** to the virtual root page instead of the actual root page. A table has a+** virtual root page when the actual root page contains no cells and a +** single child page. This can only happen with the table rooted at page 1.+**+** If the b-tree structure is empty, the cursor state is set to +** CURSOR_INVALID. Otherwise, the cursor is set to point to the first+** cell located on the root (or virtual root) page and the cursor state+** is set to CURSOR_VALID.+**+** If this function returns successfully, it may be assumed that the+** page-header flags indicate that the [virtual] root-page is the expected +** kind of b-tree page (i.e. if when opening the cursor the caller did not+** specify a KeyInfo structure the flags byte is set to 0x05 or 0x0D,+** indicating a table b-tree, or if the caller did specify a KeyInfo +** structure the flags byte is set to 0x02 or 0x0A, indicating an index+** b-tree).+*/+static int moveToRoot(BtCursor *pCur){+ MemPage *pRoot;+ int rc = SQLITE_OK;++ assert( cursorHoldsMutex(pCur) );+ assert( CURSOR_INVALID < CURSOR_REQUIRESEEK );+ assert( CURSOR_VALID < CURSOR_REQUIRESEEK );+ assert( CURSOR_FAULT > CURSOR_REQUIRESEEK );+ if( pCur->eState>=CURSOR_REQUIRESEEK ){+ if( pCur->eState==CURSOR_FAULT ){+ assert( pCur->skipNext!=SQLITE_OK );+ return pCur->skipNext;+ }+ sqlite3BtreeClearCursor(pCur);+ }++ if( pCur->iPage>=0 ){+ while( pCur->iPage ){+ assert( pCur->apPage[pCur->iPage]!=0 );+ releasePageNotNull(pCur->apPage[pCur->iPage--]);+ }+ }else if( pCur->pgnoRoot==0 ){+ pCur->eState = CURSOR_INVALID;+ return SQLITE_OK;+ }else{+ assert( pCur->iPage==(-1) );+ rc = getAndInitPage(pCur->pBtree->pBt, pCur->pgnoRoot, &pCur->apPage[0],+ 0, pCur->curPagerFlags);+ if( rc!=SQLITE_OK ){+ pCur->eState = CURSOR_INVALID;+ return rc;+ }+ pCur->iPage = 0;+ pCur->curIntKey = pCur->apPage[0]->intKey;+ }+ pRoot = pCur->apPage[0];+ assert( pRoot->pgno==pCur->pgnoRoot );++ /* If pCur->pKeyInfo is not NULL, then the caller that opened this cursor+ ** expected to open it on an index b-tree. Otherwise, if pKeyInfo is+ ** NULL, the caller expects a table b-tree. If this is not the case,+ ** return an SQLITE_CORRUPT error. + **+ ** Earlier versions of SQLite assumed that this test could not fail+ ** if the root page was already loaded when this function was called (i.e.+ ** if pCur->iPage>=0). But this is not so if the database is corrupted + ** in such a way that page pRoot is linked into a second b-tree table + ** (or the freelist). */+ assert( pRoot->intKey==1 || pRoot->intKey==0 );+ if( pRoot->isInit==0 || (pCur->pKeyInfo==0)!=pRoot->intKey ){+ return SQLITE_CORRUPT_BKPT;+ }++ pCur->aiIdx[0] = 0;+ pCur->info.nSize = 0;+ pCur->curFlags &= ~(BTCF_AtLast|BTCF_ValidNKey|BTCF_ValidOvfl);++ if( pRoot->nCell>0 ){+ pCur->eState = CURSOR_VALID;+ }else if( !pRoot->leaf ){+ Pgno subpage;+ if( pRoot->pgno!=1 ) return SQLITE_CORRUPT_BKPT;+ subpage = get4byte(&pRoot->aData[pRoot->hdrOffset+8]);+ pCur->eState = CURSOR_VALID;+ rc = moveToChild(pCur, subpage);+ }else{+ pCur->eState = CURSOR_INVALID;+ }+ return rc;+}++/*+** Move the cursor down to the left-most leaf entry beneath the+** entry to which it is currently pointing.+**+** The left-most leaf is the one with the smallest key - the first+** in ascending order.+*/+static int moveToLeftmost(BtCursor *pCur){+ Pgno pgno;+ int rc = SQLITE_OK;+ MemPage *pPage;++ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState==CURSOR_VALID );+ while( rc==SQLITE_OK && !(pPage = pCur->apPage[pCur->iPage])->leaf ){+ assert( pCur->aiIdx[pCur->iPage]<pPage->nCell );+ pgno = get4byte(findCell(pPage, pCur->aiIdx[pCur->iPage]));+ rc = moveToChild(pCur, pgno);+ }+ return rc;+}++/*+** Move the cursor down to the right-most leaf entry beneath the+** page to which it is currently pointing. Notice the difference+** between moveToLeftmost() and moveToRightmost(). moveToLeftmost()+** finds the left-most entry beneath the *entry* whereas moveToRightmost()+** finds the right-most entry beneath the *page*.+**+** The right-most entry is the one with the largest key - the last+** key in ascending order.+*/+static int moveToRightmost(BtCursor *pCur){+ Pgno pgno;+ int rc = SQLITE_OK;+ MemPage *pPage = 0;++ assert( cursorHoldsMutex(pCur) );+ assert( pCur->eState==CURSOR_VALID );+ while( !(pPage = pCur->apPage[pCur->iPage])->leaf ){+ pgno = get4byte(&pPage->aData[pPage->hdrOffset+8]);+ pCur->aiIdx[pCur->iPage] = pPage->nCell;+ rc = moveToChild(pCur, pgno);+ if( rc ) return rc;+ }+ pCur->aiIdx[pCur->iPage] = pPage->nCell-1;+ assert( pCur->info.nSize==0 );+ assert( (pCur->curFlags & BTCF_ValidNKey)==0 );+ return SQLITE_OK;+}++/* Move the cursor to the first entry in the table. Return SQLITE_OK+** on success. Set *pRes to 0 if the cursor actually points to something+** or set *pRes to 1 if the table is empty.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeFirst(BtCursor *pCur, int *pRes){+ int rc;++ assert( cursorHoldsMutex(pCur) );+ assert( sqlite3_mutex_held(pCur->pBtree->db->mutex) );+ rc = moveToRoot(pCur);+ if( rc==SQLITE_OK ){+ if( pCur->eState==CURSOR_INVALID ){+ assert( pCur->pgnoRoot==0 || pCur->apPage[pCur->iPage]->nCell==0 );+ *pRes = 1;+ }else{+ assert( pCur->apPage[pCur->iPage]->nCell>0 );+ *pRes = 0;+ rc = moveToLeftmost(pCur);+ }+ }+ return rc;+}++/* Move the cursor to the last entry in the table. Return SQLITE_OK+** on success. Set *pRes to 0 if the cursor actually points to something+** or set *pRes to 1 if the table is empty.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeLast(BtCursor *pCur, int *pRes){+ int rc;+ + assert( cursorHoldsMutex(pCur) );+ assert( sqlite3_mutex_held(pCur->pBtree->db->mutex) );++ /* If the cursor already points to the last entry, this is a no-op. */+ if( CURSOR_VALID==pCur->eState && (pCur->curFlags & BTCF_AtLast)!=0 ){+#ifdef SQLITE_DEBUG+ /* This block serves to assert() that the cursor really does point + ** to the last entry in the b-tree. */+ int ii;+ for(ii=0; ii<pCur->iPage; ii++){+ assert( pCur->aiIdx[ii]==pCur->apPage[ii]->nCell );+ }+ assert( pCur->aiIdx[pCur->iPage]==pCur->apPage[pCur->iPage]->nCell-1 );+ assert( pCur->apPage[pCur->iPage]->leaf );+#endif+ return SQLITE_OK;+ }++ rc = moveToRoot(pCur);+ if( rc==SQLITE_OK ){+ if( CURSOR_INVALID==pCur->eState ){+ assert( pCur->pgnoRoot==0 || pCur->apPage[pCur->iPage]->nCell==0 );+ *pRes = 1;+ }else{+ assert( pCur->eState==CURSOR_VALID );+ *pRes = 0;+ rc = moveToRightmost(pCur);+ if( rc==SQLITE_OK ){+ pCur->curFlags |= BTCF_AtLast;+ }else{+ pCur->curFlags &= ~BTCF_AtLast;+ }+ + }+ }+ return rc;+}++SQLITE_API void SQLITE_STDCALL sqlite3BtreeInitUnpackedRecord(+ UnpackedRecord *pUnKey,+ BtCursor* pCur,+ int nField,+ int default_rc,+ Mem* pMem)+{+ pUnKey->pKeyInfo = pCur->pKeyInfo;+ pUnKey->nField = nField;+ pUnKey->default_rc = default_rc;+ pUnKey->aMem = pMem;+}++/* Move the cursor so that it points to an entry near the key +** specified by pIdxKey or intKey. Return a success code.+**+** For INTKEY tables, the intKey parameter is used. pIdxKey +** must be NULL. For index tables, pIdxKey is used and intKey+** is ignored.+**+** If an exact match is not found, then the cursor is always+** left pointing at a leaf page which would hold the entry if it+** were present. The cursor might point to an entry that comes+** before or after the key.+**+** An integer is written into *pRes which is the result of+** comparing the key with the entry to which the cursor is +** pointing. The meaning of the integer written into+** *pRes is as follows:+**+** *pRes<0 The cursor is left pointing at an entry that+** is smaller than intKey/pIdxKey or if the table is empty+** and the cursor is therefore left point to nothing.+**+** *pRes==0 The cursor is left pointing at an entry that+** exactly matches intKey/pIdxKey.+**+** *pRes>0 The cursor is left pointing at an entry that+** is larger than intKey/pIdxKey.+**+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeMovetoUnpacked(+ BtCursor *pCur, /* The cursor to be moved */+ UnpackedRecord *pIdxKey, /* Unpacked index key */+ i64 intKey, /* The table key */+ int biasRight, /* If true, bias the search to the high end */+ int *pRes /* Write search results here */+){+ int rc;+ RecordCompare xRecordCompare;++ assert( cursorHoldsMutex(pCur) );+ assert( sqlite3_mutex_held(pCur->pBtree->db->mutex) );+ assert( pRes );+ assert( (pIdxKey==0)==(pCur->pKeyInfo==0) );++ /* If the cursor is already positioned at the point we are trying+ ** to move to, then just return without doing any work */+ if( pCur->eState==CURSOR_VALID && (pCur->curFlags & BTCF_ValidNKey)!=0+ && pCur->curIntKey + ){+ if( pCur->info.nKey==intKey ){+ *pRes = 0;+ return SQLITE_OK;+ }+ if( (pCur->curFlags & BTCF_AtLast)!=0 && pCur->info.nKey<intKey ){+ *pRes = -1;+ return SQLITE_OK;+ }+ }++ if( pIdxKey ){+ xRecordCompare = sqlite3VdbeFindCompare(pIdxKey);+ pIdxKey->errCode = 0;+ assert( pIdxKey->default_rc==1 + || pIdxKey->default_rc==0 + || pIdxKey->default_rc==-1+ );+ }else{+ xRecordCompare = 0; /* All keys are integers */+ }++ rc = moveToRoot(pCur);+ if( rc ){+ return rc;+ }+ assert( pCur->pgnoRoot==0 || pCur->apPage[pCur->iPage] );+ assert( pCur->pgnoRoot==0 || pCur->apPage[pCur->iPage]->isInit );+ assert( pCur->eState==CURSOR_INVALID || pCur->apPage[pCur->iPage]->nCell>0 );+ if( pCur->eState==CURSOR_INVALID ){+ *pRes = -1;+ assert( pCur->pgnoRoot==0 || pCur->apPage[pCur->iPage]->nCell==0 );+ return SQLITE_OK;+ }+ assert( pCur->apPage[0]->intKey==pCur->curIntKey );+ assert( pCur->curIntKey || pIdxKey );+ for(;;){+ int lwr, upr, idx, c;+ Pgno chldPg;+ MemPage *pPage = pCur->apPage[pCur->iPage];+ u8 *pCell; /* Pointer to current cell in pPage */++ /* pPage->nCell must be greater than zero. If this is the root-page+ ** the cursor would have been INVALID above and this for(;;) loop+ ** not run. If this is not the root-page, then the moveToChild() routine+ ** would have already detected db corruption. Similarly, pPage must+ ** be the right kind (index or table) of b-tree page. Otherwise+ ** a moveToChild() or moveToRoot() call would have detected corruption. */+ assert( pPage->nCell>0 );+ assert( pPage->intKey==(pIdxKey==0) );+ lwr = 0;+ upr = pPage->nCell-1;+ assert( biasRight==0 || biasRight==1 );+ idx = upr>>(1-biasRight); /* idx = biasRight ? upr : (lwr+upr)/2; */+ pCur->aiIdx[pCur->iPage] = (u16)idx;+ if( xRecordCompare==0 ){+ for(;;){+ i64 nCellKey;+ pCell = findCellPastPtr(pPage, idx);+ if( pPage->intKeyLeaf ){+ while( 0x80 <= *(pCell++) ){+ if( pCell>=pPage->aDataEnd ) return SQLITE_CORRUPT_BKPT;+ }+ }+ getVarint(pCell, (u64*)&nCellKey);+ if( nCellKey<intKey ){+ lwr = idx+1;+ if( lwr>upr ){ c = -1; break; }+ }else if( nCellKey>intKey ){+ upr = idx-1;+ if( lwr>upr ){ c = +1; break; }+ }else{+ assert( nCellKey==intKey );+ pCur->curFlags |= BTCF_ValidNKey;+ pCur->info.nKey = nCellKey;+ pCur->aiIdx[pCur->iPage] = (u16)idx;+ if( !pPage->leaf ){+ lwr = idx;+ goto moveto_next_layer;+ }else{+ *pRes = 0;+ rc = SQLITE_OK;+ goto moveto_finish;+ }+ }+ assert( lwr+upr>=0 );+ idx = (lwr+upr)>>1; /* idx = (lwr+upr)/2; */+ }+ }else{+ for(;;){+ int nCell; /* Size of the pCell cell in bytes */+ pCell = findCellPastPtr(pPage, idx);++ /* The maximum supported page-size is 65536 bytes. This means that+ ** the maximum number of record bytes stored on an index B-Tree+ ** page is less than 16384 bytes and may be stored as a 2-byte+ ** varint. This information is used to attempt to avoid parsing + ** the entire cell by checking for the cases where the record is + ** stored entirely within the b-tree page by inspecting the first + ** 2 bytes of the cell.+ */+ nCell = pCell[0];+ if( nCell<=pPage->max1bytePayload ){+ /* This branch runs if the record-size field of the cell is a+ ** single byte varint and the record fits entirely on the main+ ** b-tree page. */+ testcase( pCell+nCell+1==pPage->aDataEnd );+ c = xRecordCompare(nCell, (void*)&pCell[1], pIdxKey);+ }else if( !(pCell[1] & 0x80) + && (nCell = ((nCell&0x7f)<<7) + pCell[1])<=pPage->maxLocal+ ){+ /* The record-size field is a 2 byte varint and the record + ** fits entirely on the main b-tree page. */+ testcase( pCell+nCell+2==pPage->aDataEnd );+ c = xRecordCompare(nCell, (void*)&pCell[2], pIdxKey);+ }else{+ /* The record flows over onto one or more overflow pages. In+ ** this case the whole cell needs to be parsed, a buffer allocated+ ** and accessPayload() used to retrieve the record into the+ ** buffer before VdbeRecordCompare() can be called. + **+ ** If the record is corrupt, the xRecordCompare routine may read+ ** up to two varints past the end of the buffer. An extra 18 + ** bytes of padding is allocated at the end of the buffer in+ ** case this happens. */+ void *pCellKey;+ u8 * const pCellBody = pCell - pPage->childPtrSize;+ pPage->xParseCell(pPage, pCellBody, &pCur->info);+ nCell = (int)pCur->info.nKey;+ testcase( nCell<0 ); /* True if key size is 2^32 or more */+ testcase( nCell==0 ); /* Invalid key size: 0x80 0x80 0x00 */+ testcase( nCell==1 ); /* Invalid key size: 0x80 0x80 0x01 */+ testcase( nCell==2 ); /* Minimum legal index key size */+ if( nCell<2 ){+ rc = SQLITE_CORRUPT_BKPT;+ goto moveto_finish;+ }+ pCellKey = sqlite3Malloc( nCell+18 );+ if( pCellKey==0 ){+ rc = SQLITE_NOMEM;+ goto moveto_finish;+ }+ pCur->aiIdx[pCur->iPage] = (u16)idx;+ rc = accessPayload(pCur, 0, nCell, (unsigned char*)pCellKey, 2);+ if( rc ){+ sqlite3_free(pCellKey);+ goto moveto_finish;+ }+ c = xRecordCompare(nCell, pCellKey, pIdxKey);+ sqlite3_free(pCellKey);+ }+ assert( + (pIdxKey->errCode!=SQLITE_CORRUPT || c==0)+ && (pIdxKey->errCode!=SQLITE_NOMEM || pCur->pBtree->mallocFailed)+ );+ if( c<0 ){+ lwr = idx+1;+ }else if( c>0 ){+ upr = idx-1;+ }else{+ assert( c==0 );+ *pRes = 0;+ rc = SQLITE_OK;+ pCur->aiIdx[pCur->iPage] = (u16)idx;+ if( pIdxKey->errCode ) rc = SQLITE_CORRUPT;+ goto moveto_finish;+ }+ if( lwr>upr ) break;+ assert( lwr+upr>=0 );+ idx = (lwr+upr)>>1; /* idx = (lwr+upr)/2 */+ }+ }+ assert( lwr==upr+1 || (pPage->intKey && !pPage->leaf) );+ assert( pPage->isInit );+ if( pPage->leaf ){+ assert( pCur->aiIdx[pCur->iPage]<pCur->apPage[pCur->iPage]->nCell );+ pCur->aiIdx[pCur->iPage] = (u16)idx;+ *pRes = c;+ rc = SQLITE_OK;+ goto moveto_finish;+ }+moveto_next_layer:+ if( lwr>=pPage->nCell ){+ chldPg = get4byte(&pPage->aData[pPage->hdrOffset+8]);+ }else{+ chldPg = get4byte(findCell(pPage, lwr));+ }+ pCur->aiIdx[pCur->iPage] = (u16)lwr;+ rc = moveToChild(pCur, chldPg);+ if( rc ) break;+ }+moveto_finish:+ pCur->info.nSize = 0;+ pCur->curFlags &= ~(BTCF_ValidNKey|BTCF_ValidOvfl);+ return rc;+}+++/*+** Return TRUE if the cursor is not pointing at an entry of the table.+**+** TRUE will be returned after a call to sqlite3BtreeNext() moves+** past the last entry in the table or sqlite3BtreePrev() moves past+** the first entry. TRUE is also returned if the table is empty.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeEof(BtCursor *pCur){+ /* TODO: What if the cursor is in CURSOR_REQUIRESEEK but all table entries+ ** have been deleted? This API will need to change to return an error code+ ** as well as the boolean result value.+ */+ return (CURSOR_VALID!=pCur->eState);+}++/*+** Advance the cursor to the next entry in the database. If+** successful then set *pRes=0. If the cursor+** was already pointing to the last entry in the database before+** this routine was called, then set *pRes=1.+**+** The main entry point is sqlite3BtreeNext(). That routine is optimized+** for the common case of merely incrementing the cell counter BtCursor.aiIdx+** to the next cell on the current page. The (slower) btreeNext() helper+** routine is called when it is necessary to move to a different page or+** to restore the cursor.+**+** The calling function will set *pRes to 0 or 1. The initial *pRes value+** will be 1 if the cursor being stepped corresponds to an SQL index and+** if this routine could have been skipped if that SQL index had been+** a unique index. Otherwise the caller will have set *pRes to zero.+** Zero is the common case. The btree implementation is free to use the+** initial *pRes value as a hint to improve performance, but the current+** SQLite btree implementation does not. (Note that the comdb2 btree+** implementation does use this hint, however.)+*/+static SQLITE_NOINLINE int btreeNext(BtCursor *pCur, int *pRes){+ int rc;+ int idx;+ MemPage *pPage;++ assert( cursorHoldsMutex(pCur) );+ assert( pCur->skipNext==0 || pCur->eState!=CURSOR_VALID );+ assert( *pRes==0 );+ if( pCur->eState!=CURSOR_VALID ){+ assert( (pCur->curFlags & BTCF_ValidOvfl)==0 );+ rc = restoreCursorPosition(pCur);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ if( CURSOR_INVALID==pCur->eState ){+ *pRes = 1;+ return SQLITE_OK;+ }+ if( pCur->skipNext ){+ assert( pCur->eState==CURSOR_VALID || pCur->eState==CURSOR_SKIPNEXT );+ pCur->eState = CURSOR_VALID;+ if( pCur->skipNext>0 ){+ pCur->skipNext = 0;+ return SQLITE_OK;+ }+ pCur->skipNext = 0;+ }+ }++ pPage = pCur->apPage[pCur->iPage];+ idx = ++pCur->aiIdx[pCur->iPage];+ assert( pPage->isInit );++ /* If the database file is corrupt, it is possible for the value of idx + ** to be invalid here. This can only occur if a second cursor modifies+ ** the page while cursor pCur is holding a reference to it. Which can+ ** only happen if the database is corrupt in such a way as to link the+ ** page into more than one b-tree structure. */+ testcase( idx>pPage->nCell );++ if( idx>=pPage->nCell ){+ if( !pPage->leaf ){+ rc = moveToChild(pCur, get4byte(&pPage->aData[pPage->hdrOffset+8]));+ if( rc ) return rc;+ return moveToLeftmost(pCur);+ }+ do{+ if( pCur->iPage==0 ){+ *pRes = 1;+ pCur->eState = CURSOR_INVALID;+ return SQLITE_OK;+ }+ moveToParent(pCur);+ pPage = pCur->apPage[pCur->iPage];+ }while( pCur->aiIdx[pCur->iPage]>=pPage->nCell );+ if( pPage->intKey ){+ return sqlite3BtreeNext(pCur, pRes);+ }else{+ return SQLITE_OK;+ }+ }+ if( pPage->leaf ){+ return SQLITE_OK;+ }else{+ return moveToLeftmost(pCur);+ }+}+SQLITE_API int SQLITE_STDCALL sqlite3BtreeNext(BtCursor *pCur, int *pRes){+ MemPage *pPage;+ assert( cursorHoldsMutex(pCur) );+ assert( pRes!=0 );+ assert( *pRes==0 || *pRes==1 );+ assert( pCur->skipNext==0 || pCur->eState!=CURSOR_VALID );+ pCur->info.nSize = 0;+ pCur->curFlags &= ~(BTCF_ValidNKey|BTCF_ValidOvfl);+ *pRes = 0;+ if( pCur->eState!=CURSOR_VALID ) return btreeNext(pCur, pRes);+ pPage = pCur->apPage[pCur->iPage];+ if( (++pCur->aiIdx[pCur->iPage])>=pPage->nCell ){+ pCur->aiIdx[pCur->iPage]--;+ return btreeNext(pCur, pRes);+ }+ if( pPage->leaf ){+ return SQLITE_OK;+ }else{+ return moveToLeftmost(pCur);+ }+}++/*+** Step the cursor to the back to the previous entry in the database. If+** successful then set *pRes=0. If the cursor+** was already pointing to the first entry in the database before+** this routine was called, then set *pRes=1.+**+** The main entry point is sqlite3BtreePrevious(). That routine is optimized+** for the common case of merely decrementing the cell counter BtCursor.aiIdx+** to the previous cell on the current page. The (slower) btreePrevious()+** helper routine is called when it is necessary to move to a different page+** or to restore the cursor.+**+** The calling function will set *pRes to 0 or 1. The initial *pRes value+** will be 1 if the cursor being stepped corresponds to an SQL index and+** if this routine could have been skipped if that SQL index had been+** a unique index. Otherwise the caller will have set *pRes to zero.+** Zero is the common case. The btree implementation is free to use the+** initial *pRes value as a hint to improve performance, but the current+** SQLite btree implementation does not. (Note that the comdb2 btree+** implementation does use this hint, however.)+*/+static SQLITE_NOINLINE int btreePrevious(BtCursor *pCur, int *pRes){+ int rc;+ MemPage *pPage;++ assert( cursorHoldsMutex(pCur) );+ assert( pRes!=0 );+ assert( *pRes==0 );+ assert( pCur->skipNext==0 || pCur->eState!=CURSOR_VALID );+ assert( (pCur->curFlags & (BTCF_AtLast|BTCF_ValidOvfl|BTCF_ValidNKey))==0 );+ assert( pCur->info.nSize==0 );+ if( pCur->eState!=CURSOR_VALID ){+ rc = restoreCursorPosition(pCur);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ if( CURSOR_INVALID==pCur->eState ){+ *pRes = 1;+ return SQLITE_OK;+ }+ if( pCur->skipNext ){+ assert( pCur->eState==CURSOR_VALID || pCur->eState==CURSOR_SKIPNEXT );+ pCur->eState = CURSOR_VALID;+ if( pCur->skipNext<0 ){+ pCur->skipNext = 0;+ return SQLITE_OK;+ }+ pCur->skipNext = 0;+ }+ }++ pPage = pCur->apPage[pCur->iPage];+ assert( pPage->isInit );+ if( !pPage->leaf ){+ int idx = pCur->aiIdx[pCur->iPage];+ rc = moveToChild(pCur, get4byte(findCell(pPage, idx)));+ if( rc ) return rc;+ rc = moveToRightmost(pCur);+ }else{+ while( pCur->aiIdx[pCur->iPage]==0 ){+ if( pCur->iPage==0 ){+ pCur->eState = CURSOR_INVALID;+ *pRes = 1;+ return SQLITE_OK;+ }+ moveToParent(pCur);+ }+ assert( pCur->info.nSize==0 );+ assert( (pCur->curFlags & (BTCF_ValidNKey|BTCF_ValidOvfl))==0 );++ pCur->aiIdx[pCur->iPage]--;+ pPage = pCur->apPage[pCur->iPage];+ if( pPage->intKey && !pPage->leaf ){+ rc = sqlite3BtreePrevious(pCur, pRes);+ }else{+ rc = SQLITE_OK;+ }+ }+ return rc;+}+SQLITE_API int SQLITE_STDCALL sqlite3BtreePrevious(BtCursor *pCur, int *pRes){+ assert( cursorHoldsMutex(pCur) );+ assert( pRes!=0 );+ assert( *pRes==0 || *pRes==1 );+ assert( pCur->skipNext==0 || pCur->eState!=CURSOR_VALID );+ *pRes = 0;+ pCur->curFlags &= ~(BTCF_AtLast|BTCF_ValidOvfl|BTCF_ValidNKey);+ pCur->info.nSize = 0;+ if( pCur->eState!=CURSOR_VALID+ || pCur->aiIdx[pCur->iPage]==0+ || pCur->apPage[pCur->iPage]->leaf==0+ ){+ return btreePrevious(pCur, pRes);+ }+ pCur->aiIdx[pCur->iPage]--;+ return SQLITE_OK;+}++/*+** Allocate a new page from the database file.+**+** The new page is marked as dirty. (In other words, sqlite3PagerWrite()+** has already been called on the new page.) The new page has also+** been referenced and the calling routine is responsible for calling+** sqlite3PagerUnref() on the new page when it is done.+**+** SQLITE_OK is returned on success. Any other return value indicates+** an error. *ppPage is set to NULL in the event of an error.+**+** If the "nearby" parameter is not 0, then an effort is made to +** locate a page close to the page number "nearby". This can be used in an+** attempt to keep related pages close to each other in the database file,+** which in turn can make database access faster.+**+** If the eMode parameter is BTALLOC_EXACT and the nearby page exists+** anywhere on the free-list, then it is guaranteed to be returned. If+** eMode is BTALLOC_LT then the page returned will be less than or equal+** to nearby if any such page exists. If eMode is BTALLOC_ANY then there+** are no restrictions on which page is returned.+*/+static int allocateBtreePage(+ BtShared *pBt, /* The btree */+ MemPage **ppPage, /* Store pointer to the allocated page here */+ Pgno *pPgno, /* Store the page number here */+ Pgno nearby, /* Search for a page near this one */+ u8 eMode /* BTALLOC_EXACT, BTALLOC_LT, or BTALLOC_ANY */+){+ MemPage *pPage1;+ int rc;+ u32 n; /* Number of pages on the freelist */+ u32 k; /* Number of leaves on the trunk of the freelist */+ MemPage *pTrunk = 0;+ MemPage *pPrevTrunk = 0;+ Pgno mxPage; /* Total size of the database file */++ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( eMode==BTALLOC_ANY || (nearby>0 && IfNotOmitAV(pBt->autoVacuum)) );+ pPage1 = pBt->pPage1;+ mxPage = btreePagecount(pBt);+ /* EVIDENCE-OF: R-05119-02637 The 4-byte big-endian integer at offset 36+ ** stores stores the total number of pages on the freelist. */+ n = get4byte(&pPage1->aData[36]);+ testcase( n==mxPage-1 );+ if( n>=mxPage ){+ return SQLITE_CORRUPT_BKPT;+ }+ if( n>0 ){+ /* There are pages on the freelist. Reuse one of those pages. */+ Pgno iTrunk;+ u8 searchList = 0; /* If the free-list must be searched for 'nearby' */+ u32 nSearch = 0; /* Count of the number of search attempts */+ + /* If eMode==BTALLOC_EXACT and a query of the pointer-map+ ** shows that the page 'nearby' is somewhere on the free-list, then+ ** the entire-list will be searched for that page.+ */+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( eMode==BTALLOC_EXACT ){+ if( nearby<=mxPage ){+ u8 eType;+ assert( nearby>0 );+ assert( pBt->autoVacuum );+ rc = ptrmapGet(pBt, nearby, &eType, 0);+ if( rc ) return rc;+ if( eType==PTRMAP_FREEPAGE ){+ searchList = 1;+ }+ }+ }else if( eMode==BTALLOC_LE ){+ searchList = 1;+ }+#endif++ /* Decrement the free-list count by 1. Set iTrunk to the index of the+ ** first free-list trunk page. iPrevTrunk is initially 1.+ */+ rc = sqlite3PagerWrite(pPage1->pDbPage);+ if( rc ) return rc;+ put4byte(&pPage1->aData[36], n-1);++ /* The code within this loop is run only once if the 'searchList' variable+ ** is not true. Otherwise, it runs once for each trunk-page on the+ ** free-list until the page 'nearby' is located (eMode==BTALLOC_EXACT)+ ** or until a page less than 'nearby' is located (eMode==BTALLOC_LT)+ */+ do {+ pPrevTrunk = pTrunk;+ if( pPrevTrunk ){+ /* EVIDENCE-OF: R-01506-11053 The first integer on a freelist trunk page+ ** is the page number of the next freelist trunk page in the list or+ ** zero if this is the last freelist trunk page. */+ iTrunk = get4byte(&pPrevTrunk->aData[0]);+ }else{+ /* EVIDENCE-OF: R-59841-13798 The 4-byte big-endian integer at offset 32+ ** stores the page number of the first page of the freelist, or zero if+ ** the freelist is empty. */+ iTrunk = get4byte(&pPage1->aData[32]);+ }+ testcase( iTrunk==mxPage );+ if( iTrunk>mxPage || nSearch++ > n ){+ rc = SQLITE_CORRUPT_BKPT;+ }else{+ rc = btreeGetUnusedPage(pBt, iTrunk, &pTrunk, 0);+ }+ if( rc ){+ pTrunk = 0;+ goto end_allocate_page;+ }+ assert( pTrunk!=0 );+ assert( pTrunk->aData!=0 );+ /* EVIDENCE-OF: R-13523-04394 The second integer on a freelist trunk page+ ** is the number of leaf page pointers to follow. */+ k = get4byte(&pTrunk->aData[4]);+ if( k==0 && !searchList ){+ /* The trunk has no leaves and the list is not being searched. + ** So extract the trunk page itself and use it as the newly + ** allocated page */+ assert( pPrevTrunk==0 );+ rc = sqlite3PagerWrite(pTrunk->pDbPage);+ if( rc ){+ goto end_allocate_page;+ }+ *pPgno = iTrunk;+ memcpy(&pPage1->aData[32], &pTrunk->aData[0], 4);+ *ppPage = pTrunk;+ pTrunk = 0;+ TRACE(("ALLOCATE: %d trunk - %d free pages left\n", *pPgno, n-1));+ }else if( k>(u32)(pBt->usableSize/4 - 2) ){+ /* Value of k is out of range. Database corruption */+ rc = SQLITE_CORRUPT_BKPT;+ goto end_allocate_page;+#ifndef SQLITE_OMIT_AUTOVACUUM+ }else if( searchList + && (nearby==iTrunk || (iTrunk<nearby && eMode==BTALLOC_LE)) + ){+ /* The list is being searched and this trunk page is the page+ ** to allocate, regardless of whether it has leaves.+ */+ *pPgno = iTrunk;+ *ppPage = pTrunk;+ searchList = 0;+ rc = sqlite3PagerWrite(pTrunk->pDbPage);+ if( rc ){+ goto end_allocate_page;+ }+ if( k==0 ){+ if( !pPrevTrunk ){+ memcpy(&pPage1->aData[32], &pTrunk->aData[0], 4);+ }else{+ rc = sqlite3PagerWrite(pPrevTrunk->pDbPage);+ if( rc!=SQLITE_OK ){+ goto end_allocate_page;+ }+ memcpy(&pPrevTrunk->aData[0], &pTrunk->aData[0], 4);+ }+ }else{+ /* The trunk page is required by the caller but it contains + ** pointers to free-list leaves. The first leaf becomes a trunk+ ** page in this case.+ */+ MemPage *pNewTrunk;+ Pgno iNewTrunk = get4byte(&pTrunk->aData[8]);+ if( iNewTrunk>mxPage ){ + rc = SQLITE_CORRUPT_BKPT;+ goto end_allocate_page;+ }+ testcase( iNewTrunk==mxPage );+ rc = btreeGetUnusedPage(pBt, iNewTrunk, &pNewTrunk, 0);+ if( rc!=SQLITE_OK ){+ goto end_allocate_page;+ }+ rc = sqlite3PagerWrite(pNewTrunk->pDbPage);+ if( rc!=SQLITE_OK ){+ releasePage(pNewTrunk);+ goto end_allocate_page;+ }+ memcpy(&pNewTrunk->aData[0], &pTrunk->aData[0], 4);+ put4byte(&pNewTrunk->aData[4], k-1);+ memcpy(&pNewTrunk->aData[8], &pTrunk->aData[12], (k-1)*4);+ releasePage(pNewTrunk);+ if( !pPrevTrunk ){+ assert( sqlite3PagerIswriteable(pPage1->pDbPage) );+ put4byte(&pPage1->aData[32], iNewTrunk);+ }else{+ rc = sqlite3PagerWrite(pPrevTrunk->pDbPage);+ if( rc ){+ goto end_allocate_page;+ }+ put4byte(&pPrevTrunk->aData[0], iNewTrunk);+ }+ }+ pTrunk = 0;+ TRACE(("ALLOCATE: %d trunk - %d free pages left\n", *pPgno, n-1));+#endif+ }else if( k>0 ){+ /* Extract a leaf from the trunk */+ u32 closest;+ Pgno iPage;+ unsigned char *aData = pTrunk->aData;+ if( nearby>0 ){+ u32 i;+ closest = 0;+ if( eMode==BTALLOC_LE ){+ for(i=0; i<k; i++){+ iPage = get4byte(&aData[8+i*4]);+ if( iPage<=nearby ){+ closest = i;+ break;+ }+ }+ }else{+ int dist;+ dist = sqlite3AbsInt32(get4byte(&aData[8]) - nearby);+ for(i=1; i<k; i++){+ int d2 = sqlite3AbsInt32(get4byte(&aData[8+i*4]) - nearby);+ if( d2<dist ){+ closest = i;+ dist = d2;+ }+ }+ }+ }else{+ closest = 0;+ }++ iPage = get4byte(&aData[8+closest*4]);+ testcase( iPage==mxPage );+ if( iPage>mxPage ){+ rc = SQLITE_CORRUPT_BKPT;+ goto end_allocate_page;+ }+ testcase( iPage==mxPage );+ if( !searchList + || (iPage==nearby || (iPage<nearby && eMode==BTALLOC_LE)) + ){+ int noContent;+ *pPgno = iPage;+ TRACE(("ALLOCATE: %d was leaf %d of %d on trunk %d"+ ": %d more free pages\n",+ *pPgno, closest+1, k, pTrunk->pgno, n-1));+ rc = sqlite3PagerWrite(pTrunk->pDbPage);+ if( rc ) goto end_allocate_page;+ if( closest<k-1 ){+ memcpy(&aData[8+closest*4], &aData[4+k*4], 4);+ }+ put4byte(&aData[4], k-1);+ noContent = !btreeGetHasContent(pBt, *pPgno)? PAGER_GET_NOCONTENT : 0;+ rc = btreeGetUnusedPage(pBt, *pPgno, ppPage, noContent);+ if( rc==SQLITE_OK ){+ rc = sqlite3PagerWrite((*ppPage)->pDbPage);+ if( rc!=SQLITE_OK ){+ releasePage(*ppPage);+ *ppPage = 0;+ }+ }+ searchList = 0;+ }+ }+ releasePage(pPrevTrunk);+ pPrevTrunk = 0;+ }while( searchList );+ }else{+ /* There are no pages on the freelist, so append a new page to the+ ** database image.+ **+ ** Normally, new pages allocated by this block can be requested from the+ ** pager layer with the 'no-content' flag set. This prevents the pager+ ** from trying to read the pages content from disk. However, if the+ ** current transaction has already run one or more incremental-vacuum+ ** steps, then the page we are about to allocate may contain content+ ** that is required in the event of a rollback. In this case, do+ ** not set the no-content flag. This causes the pager to load and journal+ ** the current page content before overwriting it.+ **+ ** Note that the pager will not actually attempt to load or journal + ** content for any page that really does lie past the end of the database+ ** file on disk. So the effects of disabling the no-content optimization+ ** here are confined to those pages that lie between the end of the+ ** database image and the end of the database file.+ */+ int bNoContent = (0==IfNotOmitAV(pBt->bDoTruncate))? PAGER_GET_NOCONTENT:0;++ rc = sqlite3PagerWrite(pBt->pPage1->pDbPage);+ if( rc ) return rc;+ pBt->nPage++;+ if( pBt->nPage==PENDING_BYTE_PAGE(pBt) ) pBt->nPage++;++#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pBt->autoVacuum && PTRMAP_ISPAGE(pBt, pBt->nPage) ){+ /* If *pPgno refers to a pointer-map page, allocate two new pages+ ** at the end of the file instead of one. The first allocated page+ ** becomes a new pointer-map page, the second is used by the caller.+ */+ MemPage *pPg = 0;+ TRACE(("ALLOCATE: %d from end of file (pointer-map page)\n", pBt->nPage));+ assert( pBt->nPage!=PENDING_BYTE_PAGE(pBt) );+ rc = btreeGetUnusedPage(pBt, pBt->nPage, &pPg, bNoContent);+ if( rc==SQLITE_OK ){+ rc = sqlite3PagerWrite(pPg->pDbPage);+ releasePage(pPg);+ }+ if( rc ) return rc;+ pBt->nPage++;+ if( pBt->nPage==PENDING_BYTE_PAGE(pBt) ){ pBt->nPage++; }+ }+#endif+ put4byte(28 + (u8*)pBt->pPage1->aData, pBt->nPage);+ *pPgno = pBt->nPage;++ assert( *pPgno!=PENDING_BYTE_PAGE(pBt) );+ rc = btreeGetUnusedPage(pBt, *pPgno, ppPage, bNoContent);+ if( rc ) return rc;+ rc = sqlite3PagerWrite((*ppPage)->pDbPage);+ if( rc!=SQLITE_OK ){+ releasePage(*ppPage);+ *ppPage = 0;+ }+ TRACE(("ALLOCATE: %d from end of file\n", *pPgno));+ }++ assert( *pPgno!=PENDING_BYTE_PAGE(pBt) );++end_allocate_page:+ releasePage(pTrunk);+ releasePage(pPrevTrunk);+ assert( rc!=SQLITE_OK || sqlite3PagerPageRefcount((*ppPage)->pDbPage)<=1 );+ assert( rc!=SQLITE_OK || (*ppPage)->isInit==0 );+ return rc;+}++/*+** This function is used to add page iPage to the database file free-list. +** It is assumed that the page is not already a part of the free-list.+**+** The value passed as the second argument to this function is optional.+** If the caller happens to have a pointer to the MemPage object +** corresponding to page iPage handy, it may pass it as the second value. +** Otherwise, it may pass NULL.+**+** If a pointer to a MemPage object is passed as the second argument,+** its reference count is not altered by this function.+*/+static int freePage2(BtShared *pBt, MemPage *pMemPage, Pgno iPage){+ MemPage *pTrunk = 0; /* Free-list trunk page */+ Pgno iTrunk = 0; /* Page number of free-list trunk page */ + MemPage *pPage1 = pBt->pPage1; /* Local reference to page 1 */+ MemPage *pPage; /* Page being freed. May be NULL. */+ int rc; /* Return Code */+ int nFree; /* Initial number of pages on free-list */++ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( CORRUPT_DB || iPage>1 );+ assert( !pMemPage || pMemPage->pgno==iPage );++ if( iPage<2 ) return SQLITE_CORRUPT_BKPT;+ if( pMemPage ){+ pPage = pMemPage;+ sqlite3PagerRef(pPage->pDbPage);+ }else{+ pPage = btreePageLookup(pBt, iPage);+ }++ /* Increment the free page count on pPage1 */+ rc = sqlite3PagerWrite(pPage1->pDbPage);+ if( rc ) goto freepage_out;+ nFree = get4byte(&pPage1->aData[36]);+ put4byte(&pPage1->aData[36], nFree+1);++ if( pBt->btsFlags & BTS_SECURE_DELETE ){+ /* If the secure_delete option is enabled, then+ ** always fully overwrite deleted information with zeros.+ */+ if( (!pPage && ((rc = btreeGetPage(pBt, iPage, &pPage, 0))!=0) )+ || ((rc = sqlite3PagerWrite(pPage->pDbPage))!=0)+ ){+ goto freepage_out;+ }+ memset(pPage->aData, 0, pPage->pBt->pageSize);+ }++ /* If the database supports auto-vacuum, write an entry in the pointer-map+ ** to indicate that the page is free.+ */+ if( ISAUTOVACUUM ){+ ptrmapPut(pBt, iPage, PTRMAP_FREEPAGE, 0, &rc);+ if( rc ) goto freepage_out;+ }++ /* Now manipulate the actual database free-list structure. There are two+ ** possibilities. If the free-list is currently empty, or if the first+ ** trunk page in the free-list is full, then this page will become a+ ** new free-list trunk page. Otherwise, it will become a leaf of the+ ** first trunk page in the current free-list. This block tests if it+ ** is possible to add the page as a new free-list leaf.+ */+ if( nFree!=0 ){+ u32 nLeaf; /* Initial number of leaf cells on trunk page */++ iTrunk = get4byte(&pPage1->aData[32]);+ rc = btreeGetPage(pBt, iTrunk, &pTrunk, 0);+ if( rc!=SQLITE_OK ){+ goto freepage_out;+ }++ nLeaf = get4byte(&pTrunk->aData[4]);+ assert( pBt->usableSize>32 );+ if( nLeaf > (u32)pBt->usableSize/4 - 2 ){+ rc = SQLITE_CORRUPT_BKPT;+ goto freepage_out;+ }+ if( nLeaf < (u32)pBt->usableSize/4 - 8 ){+ /* In this case there is room on the trunk page to insert the page+ ** being freed as a new leaf.+ **+ ** Note that the trunk page is not really full until it contains+ ** usableSize/4 - 2 entries, not usableSize/4 - 8 entries as we have+ ** coded. But due to a coding error in versions of SQLite prior to+ ** 3.6.0, databases with freelist trunk pages holding more than+ ** usableSize/4 - 8 entries will be reported as corrupt. In order+ ** to maintain backwards compatibility with older versions of SQLite,+ ** we will continue to restrict the number of entries to usableSize/4 - 8+ ** for now. At some point in the future (once everyone has upgraded+ ** to 3.6.0 or later) we should consider fixing the conditional above+ ** to read "usableSize/4-2" instead of "usableSize/4-8".+ **+ ** EVIDENCE-OF: R-19920-11576 However, newer versions of SQLite still+ ** avoid using the last six entries in the freelist trunk page array in+ ** order that database files created by newer versions of SQLite can be+ ** read by older versions of SQLite.+ */+ rc = sqlite3PagerWrite(pTrunk->pDbPage);+ if( rc==SQLITE_OK ){+ put4byte(&pTrunk->aData[4], nLeaf+1);+ put4byte(&pTrunk->aData[8+nLeaf*4], iPage);+ if( pPage && (pBt->btsFlags & BTS_SECURE_DELETE)==0 ){+ sqlite3PagerDontWrite(pPage->pDbPage);+ }+ rc = btreeSetHasContent(pBt, iPage);+ }+ TRACE(("FREE-PAGE: %d leaf on trunk page %d\n",pPage->pgno,pTrunk->pgno));+ goto freepage_out;+ }+ }++ /* If control flows to this point, then it was not possible to add the+ ** the page being freed as a leaf page of the first trunk in the free-list.+ ** Possibly because the free-list is empty, or possibly because the + ** first trunk in the free-list is full. Either way, the page being freed+ ** will become the new first trunk page in the free-list.+ */+ if( pPage==0 && SQLITE_OK!=(rc = btreeGetPage(pBt, iPage, &pPage, 0)) ){+ goto freepage_out;+ }+ rc = sqlite3PagerWrite(pPage->pDbPage);+ if( rc!=SQLITE_OK ){+ goto freepage_out;+ }+ put4byte(pPage->aData, iTrunk);+ put4byte(&pPage->aData[4], 0);+ put4byte(&pPage1->aData[32], iPage);+ TRACE(("FREE-PAGE: %d new trunk page replacing %d\n", pPage->pgno, iTrunk));++freepage_out:+ if( pPage ){+ pPage->isInit = 0;+ }+ releasePage(pPage);+ releasePage(pTrunk);+ return rc;+}+static void freePage(MemPage *pPage, int *pRC){+ if( (*pRC)==SQLITE_OK ){+ *pRC = freePage2(pPage->pBt, pPage, pPage->pgno);+ }+}++/*+** Free any overflow pages associated with the given Cell. Write the+** local Cell size (the number of bytes on the original page, omitting+** overflow) into *pnSize.+*/+static int clearCell(+ MemPage *pPage, /* The page that contains the Cell */+ unsigned char *pCell, /* First byte of the Cell */+ u16 *pnSize /* Write the size of the Cell here */+){+ BtShared *pBt = pPage->pBt;+ CellInfo info;+ Pgno ovflPgno;+ int rc;+ int nOvfl;+ u32 ovflPageSize;++ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ pPage->xParseCell(pPage, pCell, &info);+ *pnSize = info.nSize;+ if( info.iOverflow==0 ){+ return SQLITE_OK; /* No overflow pages. Return without doing anything */+ }+ if( pCell+info.iOverflow+3 > pPage->aData+pPage->maskPage ){+ return SQLITE_CORRUPT_BKPT; /* Cell extends past end of page */+ }+ ovflPgno = get4byte(&pCell[info.iOverflow]);+ assert( pBt->usableSize > 4 );+ ovflPageSize = pBt->usableSize - 4;+ nOvfl = (info.nPayload - info.nLocal + ovflPageSize - 1)/ovflPageSize;+ assert( nOvfl>0 || + (CORRUPT_DB && (info.nPayload + ovflPageSize)<ovflPageSize)+ );+ while( nOvfl-- ){+ Pgno iNext = 0;+ MemPage *pOvfl = 0;+ if( ovflPgno<2 || ovflPgno>btreePagecount(pBt) ){+ /* 0 is not a legal page number and page 1 cannot be an + ** overflow page. Therefore if ovflPgno<2 or past the end of the + ** file the database must be corrupt. */+ return SQLITE_CORRUPT_BKPT;+ }+ if( nOvfl ){+ rc = getOverflowPage(pBt, ovflPgno, &pOvfl, &iNext);+ if( rc ) return rc;+ }++ if( ( pOvfl || ((pOvfl = btreePageLookup(pBt, ovflPgno))!=0) )+ && sqlite3PagerPageRefcount(pOvfl->pDbPage)!=1+ ){+ /* There is no reason any cursor should have an outstanding reference + ** to an overflow page belonging to a cell that is being deleted/updated.+ ** So if there exists more than one reference to this page, then it + ** must not really be an overflow page and the database must be corrupt. + ** It is helpful to detect this before calling freePage2(), as + ** freePage2() may zero the page contents if secure-delete mode is+ ** enabled. If this 'overflow' page happens to be a page that the+ ** caller is iterating through or using in some other way, this+ ** can be problematic.+ */+ rc = SQLITE_CORRUPT_BKPT;+ }else{+ rc = freePage2(pBt, pOvfl, ovflPgno);+ }++ if( pOvfl ){+ sqlite3PagerUnref(pOvfl->pDbPage);+ }+ if( rc ) return rc;+ ovflPgno = iNext;+ }+ return SQLITE_OK;+}++/*+** Create the byte sequence used to represent a cell on page pPage+** and write that byte sequence into pCell[]. Overflow pages are+** allocated and filled in as necessary. The calling procedure+** is responsible for making sure sufficient space has been allocated+** for pCell[].+**+** Note that pCell does not necessary need to point to the pPage->aData+** area. pCell might point to some temporary storage. The cell will+** be constructed in this temporary area then copied into pPage->aData+** later.+*/+static int fillInCell(+ MemPage *pPage, /* The page that contains the cell */+ unsigned char *pCell, /* Complete text of the cell */+ const void *pKey, i64 nKey, /* The key */+ const void *pData,int nData, /* The data */+ int nZero, /* Extra zero bytes to append to pData */+ int *pnSize /* Write cell size here */+){+ int nPayload;+ const u8 *pSrc;+ int nSrc, n, rc;+ int spaceLeft;+ MemPage *pOvfl = 0;+ MemPage *pToRelease = 0;+ unsigned char *pPrior;+ unsigned char *pPayload;+ BtShared *pBt = pPage->pBt;+ Pgno pgnoOvfl = 0;+ int nHeader;++ assert( sqlite3_mutex_held(pPage->pBt->mutex) );++ /* pPage is not necessarily writeable since pCell might be auxiliary+ ** buffer space that is separate from the pPage buffer area */+ assert( pCell<pPage->aData || pCell>=&pPage->aData[pBt->pageSize]+ || sqlite3PagerIswriteable(pPage->pDbPage) );++ /* Fill in the header. */+ nHeader = pPage->childPtrSize;+ nPayload = nData + nZero;+ if( pPage->intKeyLeaf ){+ nHeader += putVarint32(&pCell[nHeader], nPayload);+ }else{+ assert( nData==0 );+ assert( nZero==0 );+ }+ nHeader += putVarint(&pCell[nHeader], *(u64*)&nKey);+ + /* Fill in the payload size */+ if( pPage->intKey ){+ pSrc = pData;+ nSrc = nData;+ nData = 0;+ }else{ + assert( nKey<=0x7fffffff && pKey!=0 );+ nPayload = (int)nKey;+ pSrc = pKey;+ nSrc = (int)nKey;+ }+ if( nPayload<=pPage->maxLocal ){+ n = nHeader + nPayload;+ testcase( n==3 );+ testcase( n==4 );+ if( n<4 ) n = 4;+ *pnSize = n;+ spaceLeft = nPayload;+ pPrior = pCell;+ }else{+ int mn = pPage->minLocal;+ n = mn + (nPayload - mn) % (pPage->pBt->usableSize - 4);+ testcase( n==pPage->maxLocal );+ testcase( n==pPage->maxLocal+1 );+ if( n > pPage->maxLocal ) n = mn;+ spaceLeft = n;+ *pnSize = n + nHeader + 4;+ pPrior = &pCell[nHeader+n];+ }+ pPayload = &pCell[nHeader];++ /* At this point variables should be set as follows:+ **+ ** nPayload Total payload size in bytes+ ** pPayload Begin writing payload here+ ** spaceLeft Space available at pPayload. If nPayload>spaceLeft,+ ** that means content must spill into overflow pages.+ ** *pnSize Size of the local cell (not counting overflow pages)+ ** pPrior Where to write the pgno of the first overflow page+ **+ ** Use a call to btreeParseCellPtr() to verify that the values above+ ** were computed correctly.+ */+#if SQLITE_DEBUG+ {+ CellInfo info;+ pPage->xParseCell(pPage, pCell, &info);+ assert( nHeader=(int)(info.pPayload - pCell) );+ assert( info.nKey==nKey );+ assert( *pnSize == info.nSize );+ assert( spaceLeft == info.nLocal );+ assert( pPrior == &pCell[info.iOverflow] );+ }+#endif++ /* Write the payload into the local Cell and any extra into overflow pages */+ while( nPayload>0 ){+ if( spaceLeft==0 ){+#ifndef SQLITE_OMIT_AUTOVACUUM+ Pgno pgnoPtrmap = pgnoOvfl; /* Overflow page pointer-map entry page */+ if( pBt->autoVacuum ){+ do{+ pgnoOvfl++;+ } while( + PTRMAP_ISPAGE(pBt, pgnoOvfl) || pgnoOvfl==PENDING_BYTE_PAGE(pBt) + );+ }+#endif+ rc = allocateBtreePage(pBt, &pOvfl, &pgnoOvfl, pgnoOvfl, 0);+#ifndef SQLITE_OMIT_AUTOVACUUM+ /* If the database supports auto-vacuum, and the second or subsequent+ ** overflow page is being allocated, add an entry to the pointer-map+ ** for that page now. + **+ ** If this is the first overflow page, then write a partial entry + ** to the pointer-map. If we write nothing to this pointer-map slot,+ ** then the optimistic overflow chain processing in clearCell()+ ** may misinterpret the uninitialized values and delete the+ ** wrong pages from the database.+ */+ if( pBt->autoVacuum && rc==SQLITE_OK ){+ u8 eType = (pgnoPtrmap?PTRMAP_OVERFLOW2:PTRMAP_OVERFLOW1);+ ptrmapPut(pBt, pgnoOvfl, eType, pgnoPtrmap, &rc);+ if( rc ){+ releasePage(pOvfl);+ }+ }+#endif+ if( rc ){+ releasePage(pToRelease);+ return rc;+ }++ /* If pToRelease is not zero than pPrior points into the data area+ ** of pToRelease. Make sure pToRelease is still writeable. */+ assert( pToRelease==0 || sqlite3PagerIswriteable(pToRelease->pDbPage) );++ /* If pPrior is part of the data area of pPage, then make sure pPage+ ** is still writeable */+ assert( pPrior<pPage->aData || pPrior>=&pPage->aData[pBt->pageSize]+ || sqlite3PagerIswriteable(pPage->pDbPage) );++ put4byte(pPrior, pgnoOvfl);+ releasePage(pToRelease);+ pToRelease = pOvfl;+ pPrior = pOvfl->aData;+ put4byte(pPrior, 0);+ pPayload = &pOvfl->aData[4];+ spaceLeft = pBt->usableSize - 4;+ }+ n = nPayload;+ if( n>spaceLeft ) n = spaceLeft;++ /* If pToRelease is not zero than pPayload points into the data area+ ** of pToRelease. Make sure pToRelease is still writeable. */+ assert( pToRelease==0 || sqlite3PagerIswriteable(pToRelease->pDbPage) );++ /* If pPayload is part of the data area of pPage, then make sure pPage+ ** is still writeable */+ assert( pPayload<pPage->aData || pPayload>=&pPage->aData[pBt->pageSize]+ || sqlite3PagerIswriteable(pPage->pDbPage) );++ if( nSrc>0 ){+ if( n>nSrc ) n = nSrc;+ assert( pSrc );+ memcpy(pPayload, pSrc, n);+ }else{+ memset(pPayload, 0, n);+ }+ nPayload -= n;+ pPayload += n;+ pSrc += n;+ nSrc -= n;+ spaceLeft -= n;+ if( nSrc==0 ){+ nSrc = nData;+ pSrc = pData;+ }+ }+ releasePage(pToRelease);+ return SQLITE_OK;+}++/*+** Remove the i-th cell from pPage. This routine effects pPage only.+** The cell content is not freed or deallocated. It is assumed that+** the cell content has been copied someplace else. This routine just+** removes the reference to the cell from pPage.+**+** "sz" must be the number of bytes in the cell.+*/+static void dropCell(MemPage *pPage, int idx, int sz, int *pRC){+ u32 pc; /* Offset to cell content of cell being deleted */+ u8 *data; /* pPage->aData */+ u8 *ptr; /* Used to move bytes around within data[] */+ int rc; /* The return code */+ int hdr; /* Beginning of the header. 0 most pages. 100 page 1 */++ if( *pRC ) return;++ assert( idx>=0 && idx<pPage->nCell );+ assert( CORRUPT_DB || sz==cellSize(pPage, idx) );+ assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ data = pPage->aData;+ ptr = &pPage->aCellIdx[2*idx];+ pc = get2byte(ptr);+ hdr = pPage->hdrOffset;+ testcase( pc==get2byte(&data[hdr+5]) );+ testcase( pc+sz==pPage->pBt->usableSize );+ if( pc < (u32)get2byte(&data[hdr+5]) || pc+sz > pPage->pBt->usableSize ){+ *pRC = SQLITE_CORRUPT_BKPT;+ return;+ }+ rc = freeSpace(pPage, pc, sz);+ if( rc ){+ *pRC = rc;+ return;+ }+ pPage->nCell--;+ if( pPage->nCell==0 ){+ memset(&data[hdr+1], 0, 4);+ data[hdr+7] = 0;+ put2byte(&data[hdr+5], pPage->pBt->usableSize);+ pPage->nFree = pPage->pBt->usableSize - pPage->hdrOffset+ - pPage->childPtrSize - 8;+ }else{+ memmove(ptr, ptr+2, 2*(pPage->nCell - idx));+ put2byte(&data[hdr+3], pPage->nCell);+ pPage->nFree += 2;+ }+}++/*+** Insert a new cell on pPage at cell index "i". pCell points to the+** content of the cell.+**+** If the cell content will fit on the page, then put it there. If it+** will not fit, then make a copy of the cell content into pTemp if+** pTemp is not null. Regardless of pTemp, allocate a new entry+** in pPage->apOvfl[] and make it point to the cell content (either+** in pTemp or the original pCell) and also record its index. +** Allocating a new entry in pPage->aCell[] implies that +** pPage->nOverflow is incremented.+*/+static void insertCell(+ MemPage *pPage, /* Page into which we are copying */+ int i, /* New cell becomes the i-th cell of the page */+ u8 *pCell, /* Content of the new cell */+ int sz, /* Bytes of content in pCell */+ u8 *pTemp, /* Temp storage space for pCell, if needed */+ Pgno iChild, /* If non-zero, replace first 4 bytes with this value */+ int *pRC /* Read and write return code from here */+){+ int idx = 0; /* Where to write new cell content in data[] */+ int j; /* Loop counter */+ u8 *data; /* The content of the whole page */+ u8 *pIns; /* The point in pPage->aCellIdx[] where no cell inserted */++ if( *pRC ) return;++ assert( i>=0 && i<=pPage->nCell+pPage->nOverflow );+ assert( MX_CELL(pPage->pBt)<=10921 );+ assert( pPage->nCell<=MX_CELL(pPage->pBt) || CORRUPT_DB );+ assert( pPage->nOverflow<=ArraySize(pPage->apOvfl) );+ assert( ArraySize(pPage->apOvfl)==ArraySize(pPage->aiOvfl) );+ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ /* The cell should normally be sized correctly. However, when moving a+ ** malformed cell from a leaf page to an interior page, if the cell size+ ** wanted to be less than 4 but got rounded up to 4 on the leaf, then size+ ** might be less than 8 (leaf-size + pointer) on the interior node. Hence+ ** the term after the || in the following assert(). */+ assert( sz==pPage->xCellSize(pPage, pCell) || (sz==8 && iChild>0) );+ if( pPage->nOverflow || sz+2>pPage->nFree ){+ if( pTemp ){+ memcpy(pTemp, pCell, sz);+ pCell = pTemp;+ }+ if( iChild ){+ put4byte(pCell, iChild);+ }+ j = pPage->nOverflow++;+ assert( j<(int)(sizeof(pPage->apOvfl)/sizeof(pPage->apOvfl[0])) );+ pPage->apOvfl[j] = pCell;+ pPage->aiOvfl[j] = (u16)i;++ /* When multiple overflows occur, they are always sequential and in+ ** sorted order. This invariants arise because multiple overflows can+ ** only occur when inserting divider cells into the parent page during+ ** balancing, and the dividers are adjacent and sorted.+ */+ assert( j==0 || pPage->aiOvfl[j-1]<(u16)i ); /* Overflows in sorted order */+ assert( j==0 || i==pPage->aiOvfl[j-1]+1 ); /* Overflows are sequential */+ }else{+ int rc = sqlite3PagerWrite(pPage->pDbPage);+ if( rc!=SQLITE_OK ){+ *pRC = rc;+ return;+ }+ assert( sqlite3PagerIswriteable(pPage->pDbPage) );+ data = pPage->aData;+ assert( &data[pPage->cellOffset]==pPage->aCellIdx );+ rc = allocateSpace(pPage, sz, &idx);+ if( rc ){ *pRC = rc; return; }+ /* The allocateSpace() routine guarantees the following properties+ ** if it returns successfully */+ assert( idx >= 0 );+ assert( idx >= pPage->cellOffset+2*pPage->nCell+2 || CORRUPT_DB );+ assert( idx+sz <= (int)pPage->pBt->usableSize );+ pPage->nFree -= (u16)(2 + sz);+ memcpy(&data[idx], pCell, sz);+ if( iChild ){+ put4byte(&data[idx], iChild);+ }+ pIns = pPage->aCellIdx + i*2;+ memmove(pIns+2, pIns, 2*(pPage->nCell - i));+ put2byte(pIns, idx);+ pPage->nCell++;+ /* increment the cell count */+ if( (++data[pPage->hdrOffset+4])==0 ) data[pPage->hdrOffset+3]++;+ assert( get2byte(&data[pPage->hdrOffset+3])==pPage->nCell );+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pPage->pBt->autoVacuum ){+ /* The cell may contain a pointer to an overflow page. If so, write+ ** the entry for the overflow page into the pointer map.+ */+ ptrmapPutOvflPtr(pPage, pCell, pRC);+ }+#endif+ }+}++/*+** A CellArray object contains a cache of pointers and sizes for a+** consecutive sequence of cells that might be held multiple pages.+*/+typedef struct CellArray CellArray;+struct CellArray {+ int nCell; /* Number of cells in apCell[] */+ MemPage *pRef; /* Reference page */+ u8 **apCell; /* All cells begin balanced */+ u16 *szCell; /* Local size of all cells in apCell[] */+};++/*+** Make sure the cell sizes at idx, idx+1, ..., idx+N-1 have been+** computed.+*/+static void populateCellCache(CellArray *p, int idx, int N){+ assert( idx>=0 && idx+N<=p->nCell );+ while( N>0 ){+ assert( p->apCell[idx]!=0 );+ if( p->szCell[idx]==0 ){+ p->szCell[idx] = p->pRef->xCellSize(p->pRef, p->apCell[idx]);+ }else{+ assert( CORRUPT_DB ||+ p->szCell[idx]==p->pRef->xCellSize(p->pRef, p->apCell[idx]) );+ }+ idx++;+ N--;+ }+}++/*+** Return the size of the Nth element of the cell array+*/+static SQLITE_NOINLINE u16 computeCellSize(CellArray *p, int N){+ assert( N>=0 && N<p->nCell );+ assert( p->szCell[N]==0 );+ p->szCell[N] = p->pRef->xCellSize(p->pRef, p->apCell[N]);+ return p->szCell[N];+}+static u16 cachedCellSize(CellArray *p, int N){+ assert( N>=0 && N<p->nCell );+ if( p->szCell[N] ) return p->szCell[N];+ return computeCellSize(p, N);+}++/*+** Array apCell[] contains pointers to nCell b-tree page cells. The +** szCell[] array contains the size in bytes of each cell. This function+** replaces the current contents of page pPg with the contents of the cell+** array.+**+** Some of the cells in apCell[] may currently be stored in pPg. This+** function works around problems caused by this by making a copy of any +** such cells before overwriting the page data.+**+** The MemPage.nFree field is invalidated by this function. It is the +** responsibility of the caller to set it correctly.+*/+static int rebuildPage(+ MemPage *pPg, /* Edit this page */+ int nCell, /* Final number of cells on page */+ u8 **apCell, /* Array of cells */+ u16 *szCell /* Array of cell sizes */+){+ const int hdr = pPg->hdrOffset; /* Offset of header on pPg */+ u8 * const aData = pPg->aData; /* Pointer to data for pPg */+ const int usableSize = pPg->pBt->usableSize;+ u8 * const pEnd = &aData[usableSize];+ int i;+ u8 *pCellptr = pPg->aCellIdx;+ u8 *pTmp = sqlite3PagerTempSpace(pPg->pBt->pPager);+ u8 *pData;++ i = get2byte(&aData[hdr+5]);+ memcpy(&pTmp[i], &aData[i], usableSize - i);++ pData = pEnd;+ for(i=0; i<nCell; i++){+ u8 *pCell = apCell[i];+ if( pCell>aData && pCell<pEnd ){+ pCell = &pTmp[pCell - aData];+ }+ pData -= szCell[i];+ put2byte(pCellptr, (pData - aData));+ pCellptr += 2;+ if( pData < pCellptr ) return SQLITE_CORRUPT_BKPT;+ memcpy(pData, pCell, szCell[i]);+ assert( szCell[i]==pPg->xCellSize(pPg, pCell) || CORRUPT_DB );+ testcase( szCell[i]!=pPg->xCellSize(pPg,pCell) );+ }++ /* The pPg->nFree field is now set incorrectly. The caller will fix it. */+ pPg->nCell = nCell;+ pPg->nOverflow = 0;++ put2byte(&aData[hdr+1], 0);+ put2byte(&aData[hdr+3], pPg->nCell);+ put2byte(&aData[hdr+5], pData - aData);+ aData[hdr+7] = 0x00;+ return SQLITE_OK;+}++/*+** Array apCell[] contains nCell pointers to b-tree cells. Array szCell+** contains the size in bytes of each such cell. This function attempts to +** add the cells stored in the array to page pPg. If it cannot (because +** the page needs to be defragmented before the cells will fit), non-zero+** is returned. Otherwise, if the cells are added successfully, zero is+** returned.+**+** Argument pCellptr points to the first entry in the cell-pointer array+** (part of page pPg) to populate. After cell apCell[0] is written to the+** page body, a 16-bit offset is written to pCellptr. And so on, for each+** cell in the array. It is the responsibility of the caller to ensure+** that it is safe to overwrite this part of the cell-pointer array.+**+** When this function is called, *ppData points to the start of the +** content area on page pPg. If the size of the content area is extended,+** *ppData is updated to point to the new start of the content area+** before returning.+**+** Finally, argument pBegin points to the byte immediately following the+** end of the space required by this page for the cell-pointer area (for+** all cells - not just those inserted by the current call). If the content+** area must be extended to before this point in order to accomodate all+** cells in apCell[], then the cells do not fit and non-zero is returned.+*/+static int pageInsertArray(+ MemPage *pPg, /* Page to add cells to */+ u8 *pBegin, /* End of cell-pointer array */+ u8 **ppData, /* IN/OUT: Page content -area pointer */+ u8 *pCellptr, /* Pointer to cell-pointer area */+ int iFirst, /* Index of first cell to add */+ int nCell, /* Number of cells to add to pPg */+ CellArray *pCArray /* Array of cells */+){+ int i;+ u8 *aData = pPg->aData;+ u8 *pData = *ppData;+ int iEnd = iFirst + nCell;+ assert( CORRUPT_DB || pPg->hdrOffset==0 ); /* Never called on page 1 */+ for(i=iFirst; i<iEnd; i++){+ int sz, rc;+ u8 *pSlot;+ sz = cachedCellSize(pCArray, i);+ if( (aData[1]==0 && aData[2]==0) || (pSlot = pageFindSlot(pPg,sz,&rc))==0 ){+ pData -= sz;+ if( pData<pBegin ) return 1;+ pSlot = pData;+ }+ /* pSlot and pCArray->apCell[i] will never overlap on a well-formed+ ** database. But they might for a corrupt database. Hence use memmove()+ ** since memcpy() sends SIGABORT with overlapping buffers on OpenBSD */+ assert( (pSlot+sz)<=pCArray->apCell[i]+ || pSlot>=(pCArray->apCell[i]+sz)+ || CORRUPT_DB );+ memmove(pSlot, pCArray->apCell[i], sz);+ put2byte(pCellptr, (pSlot - aData));+ pCellptr += 2;+ }+ *ppData = pData;+ return 0;+}++/*+** Array apCell[] contains nCell pointers to b-tree cells. Array szCell +** contains the size in bytes of each such cell. This function adds the+** space associated with each cell in the array that is currently stored +** within the body of pPg to the pPg free-list. The cell-pointers and other+** fields of the page are not updated.+**+** This function returns the total number of cells added to the free-list.+*/+static int pageFreeArray(+ MemPage *pPg, /* Page to edit */+ int iFirst, /* First cell to delete */+ int nCell, /* Cells to delete */+ CellArray *pCArray /* Array of cells */+){+ u8 * const aData = pPg->aData;+ u8 * const pEnd = &aData[pPg->pBt->usableSize];+ u8 * const pStart = &aData[pPg->hdrOffset + 8 + pPg->childPtrSize];+ int nRet = 0;+ int i;+ int iEnd = iFirst + nCell;+ u8 *pFree = 0;+ int szFree = 0;++ for(i=iFirst; i<iEnd; i++){+ u8 *pCell = pCArray->apCell[i];+ if( pCell>=pStart && pCell<pEnd ){+ int sz;+ /* No need to use cachedCellSize() here. The sizes of all cells that+ ** are to be freed have already been computing while deciding which+ ** cells need freeing */+ sz = pCArray->szCell[i]; assert( sz>0 );+ if( pFree!=(pCell + sz) ){+ if( pFree ){+ assert( pFree>aData && (pFree - aData)<65536 );+ freeSpace(pPg, (u16)(pFree - aData), szFree);+ }+ pFree = pCell;+ szFree = sz;+ if( pFree+sz>pEnd ) return 0;+ }else{+ pFree = pCell;+ szFree += sz;+ }+ nRet++;+ }+ }+ if( pFree ){+ assert( pFree>aData && (pFree - aData)<65536 );+ freeSpace(pPg, (u16)(pFree - aData), szFree);+ }+ return nRet;+}++/*+** apCell[] and szCell[] contains pointers to and sizes of all cells in the+** pages being balanced. The current page, pPg, has pPg->nCell cells starting+** with apCell[iOld]. After balancing, this page should hold nNew cells+** starting at apCell[iNew].+**+** This routine makes the necessary adjustments to pPg so that it contains+** the correct cells after being balanced.+**+** The pPg->nFree field is invalid when this function returns. It is the+** responsibility of the caller to set it correctly.+*/+static int editPage(+ MemPage *pPg, /* Edit this page */+ int iOld, /* Index of first cell currently on page */+ int iNew, /* Index of new first cell on page */+ int nNew, /* Final number of cells on page */+ CellArray *pCArray /* Array of cells and sizes */+){+ u8 * const aData = pPg->aData;+ const int hdr = pPg->hdrOffset;+ u8 *pBegin = &pPg->aCellIdx[nNew * 2];+ int nCell = pPg->nCell; /* Cells stored on pPg */+ u8 *pData;+ u8 *pCellptr;+ int i;+ int iOldEnd = iOld + pPg->nCell + pPg->nOverflow;+ int iNewEnd = iNew + nNew;++#ifdef SQLITE_DEBUG+ u8 *pTmp = sqlite3PagerTempSpace(pPg->pBt->pPager);+ memcpy(pTmp, aData, pPg->pBt->usableSize);+#endif++ /* Remove cells from the start and end of the page */+ if( iOld<iNew ){+ int nShift = pageFreeArray(pPg, iOld, iNew-iOld, pCArray);+ memmove(pPg->aCellIdx, &pPg->aCellIdx[nShift*2], nCell*2);+ nCell -= nShift;+ }+ if( iNewEnd < iOldEnd ){+ nCell -= pageFreeArray(pPg, iNewEnd, iOldEnd - iNewEnd, pCArray);+ }++ pData = &aData[get2byteNotZero(&aData[hdr+5])];+ if( pData<pBegin ) goto editpage_fail;++ /* Add cells to the start of the page */+ if( iNew<iOld ){+ int nAdd = MIN(nNew,iOld-iNew);+ assert( (iOld-iNew)<nNew || nCell==0 || CORRUPT_DB );+ pCellptr = pPg->aCellIdx;+ memmove(&pCellptr[nAdd*2], pCellptr, nCell*2);+ if( pageInsertArray(+ pPg, pBegin, &pData, pCellptr,+ iNew, nAdd, pCArray+ ) ) goto editpage_fail;+ nCell += nAdd;+ }++ /* Add any overflow cells */+ for(i=0; i<pPg->nOverflow; i++){+ int iCell = (iOld + pPg->aiOvfl[i]) - iNew;+ if( iCell>=0 && iCell<nNew ){+ pCellptr = &pPg->aCellIdx[iCell * 2];+ memmove(&pCellptr[2], pCellptr, (nCell - iCell) * 2);+ nCell++;+ if( pageInsertArray(+ pPg, pBegin, &pData, pCellptr,+ iCell+iNew, 1, pCArray+ ) ) goto editpage_fail;+ }+ }++ /* Append cells to the end of the page */+ pCellptr = &pPg->aCellIdx[nCell*2];+ if( pageInsertArray(+ pPg, pBegin, &pData, pCellptr,+ iNew+nCell, nNew-nCell, pCArray+ ) ) goto editpage_fail;++ pPg->nCell = nNew;+ pPg->nOverflow = 0;++ put2byte(&aData[hdr+3], pPg->nCell);+ put2byte(&aData[hdr+5], pData - aData);++#ifdef SQLITE_DEBUG+ for(i=0; i<nNew && !CORRUPT_DB; i++){+ u8 *pCell = pCArray->apCell[i+iNew];+ int iOff = get2byteAligned(&pPg->aCellIdx[i*2]);+ if( pCell>=aData && pCell<&aData[pPg->pBt->usableSize] ){+ pCell = &pTmp[pCell - aData];+ }+ assert( 0==memcmp(pCell, &aData[iOff],+ pCArray->pRef->xCellSize(pCArray->pRef, pCArray->apCell[i+iNew])) );+ }+#endif++ return SQLITE_OK;+ editpage_fail:+ /* Unable to edit this page. Rebuild it from scratch instead. */+ populateCellCache(pCArray, iNew, nNew);+ return rebuildPage(pPg, nNew, &pCArray->apCell[iNew], &pCArray->szCell[iNew]);+}++/*+** The following parameters determine how many adjacent pages get involved+** in a balancing operation. NN is the number of neighbors on either side+** of the page that participate in the balancing operation. NB is the+** total number of pages that participate, including the target page and+** NN neighbors on either side.+**+** The minimum value of NN is 1 (of course). Increasing NN above 1+** (to 2 or 3) gives a modest improvement in SELECT and DELETE performance+** in exchange for a larger degradation in INSERT and UPDATE performance.+** The value of NN appears to give the best results overall.+*/+#define NN 1 /* Number of neighbors on either side of pPage */+#define NB (NN*2+1) /* Total pages involved in the balance */+++#ifndef SQLITE_OMIT_QUICKBALANCE+/*+** This version of balance() handles the common special case where+** a new entry is being inserted on the extreme right-end of the+** tree, in other words, when the new entry will become the largest+** entry in the tree.+**+** Instead of trying to balance the 3 right-most leaf pages, just add+** a new page to the right-hand side and put the one new entry in+** that page. This leaves the right side of the tree somewhat+** unbalanced. But odds are that we will be inserting new entries+** at the end soon afterwards so the nearly empty page will quickly+** fill up. On average.+**+** pPage is the leaf page which is the right-most page in the tree.+** pParent is its parent. pPage must have a single overflow entry+** which is also the right-most entry on the page.+**+** The pSpace buffer is used to store a temporary copy of the divider+** cell that will be inserted into pParent. Such a cell consists of a 4+** byte page number followed by a variable length integer. In other+** words, at most 13 bytes. Hence the pSpace buffer must be at+** least 13 bytes in size.+*/+static int balance_quick(MemPage *pParent, MemPage *pPage, u8 *pSpace){+ BtShared *const pBt = pPage->pBt; /* B-Tree Database */+ MemPage *pNew; /* Newly allocated page */+ int rc; /* Return Code */+ Pgno pgnoNew; /* Page number of pNew */++ assert( sqlite3_mutex_held(pPage->pBt->mutex) );+ assert( sqlite3PagerIswriteable(pParent->pDbPage) );+ assert( pPage->nOverflow==1 );++ /* This error condition is now caught prior to reaching this function */+ if( NEVER(pPage->nCell==0) ) return SQLITE_CORRUPT_BKPT;++ /* Allocate a new page. This page will become the right-sibling of + ** pPage. Make the parent page writable, so that the new divider cell+ ** may be inserted. If both these operations are successful, proceed.+ */+ rc = allocateBtreePage(pBt, &pNew, &pgnoNew, 0, 0);++ if( rc==SQLITE_OK ){++ u8 *pOut = &pSpace[4];+ u8 *pCell = pPage->apOvfl[0];+ u16 szCell = pPage->xCellSize(pPage, pCell);+ u8 *pStop;++ assert( sqlite3PagerIswriteable(pNew->pDbPage) );+ assert( pPage->aData[0]==(PTF_INTKEY|PTF_LEAFDATA|PTF_LEAF) );+ zeroPage(pNew, PTF_INTKEY|PTF_LEAFDATA|PTF_LEAF);+ rc = rebuildPage(pNew, 1, &pCell, &szCell);+ if( NEVER(rc) ) return rc;+ pNew->nFree = pBt->usableSize - pNew->cellOffset - 2 - szCell;++ /* If this is an auto-vacuum database, update the pointer map+ ** with entries for the new page, and any pointer from the + ** cell on the page to an overflow page. If either of these+ ** operations fails, the return code is set, but the contents+ ** of the parent page are still manipulated by thh code below.+ ** That is Ok, at this point the parent page is guaranteed to+ ** be marked as dirty. Returning an error code will cause a+ ** rollback, undoing any changes made to the parent page.+ */+ if( ISAUTOVACUUM ){+ ptrmapPut(pBt, pgnoNew, PTRMAP_BTREE, pParent->pgno, &rc);+ if( szCell>pNew->minLocal ){+ ptrmapPutOvflPtr(pNew, pCell, &rc);+ }+ }+ + /* Create a divider cell to insert into pParent. The divider cell+ ** consists of a 4-byte page number (the page number of pPage) and+ ** a variable length key value (which must be the same value as the+ ** largest key on pPage).+ **+ ** To find the largest key value on pPage, first find the right-most + ** cell on pPage. The first two fields of this cell are the + ** record-length (a variable length integer at most 32-bits in size)+ ** and the key value (a variable length integer, may have any value).+ ** The first of the while(...) loops below skips over the record-length+ ** field. The second while(...) loop copies the key value from the+ ** cell on pPage into the pSpace buffer.+ */+ pCell = findCell(pPage, pPage->nCell-1);+ pStop = &pCell[9];+ while( (*(pCell++)&0x80) && pCell<pStop );+ pStop = &pCell[9];+ while( ((*(pOut++) = *(pCell++))&0x80) && pCell<pStop );++ /* Insert the new divider cell into pParent. */+ insertCell(pParent, pParent->nCell, pSpace, (int)(pOut-pSpace),+ 0, pPage->pgno, &rc);++ /* Set the right-child pointer of pParent to point to the new page. */+ put4byte(&pParent->aData[pParent->hdrOffset+8], pgnoNew);+ + /* Release the reference to the new page. */+ releasePage(pNew);+ }++ return rc;+}+#endif /* SQLITE_OMIT_QUICKBALANCE */++#if 0+/*+** This function does not contribute anything to the operation of SQLite.+** it is sometimes activated temporarily while debugging code responsible +** for setting pointer-map entries.+*/+static int ptrmapCheckPages(MemPage **apPage, int nPage){+ int i, j;+ for(i=0; i<nPage; i++){+ Pgno n;+ u8 e;+ MemPage *pPage = apPage[i];+ BtShared *pBt = pPage->pBt;+ assert( pPage->isInit );++ for(j=0; j<pPage->nCell; j++){+ CellInfo info;+ u8 *z;+ + z = findCell(pPage, j);+ pPage->xParseCell(pPage, z, &info);+ if( info.iOverflow ){+ Pgno ovfl = get4byte(&z[info.iOverflow]);+ ptrmapGet(pBt, ovfl, &e, &n);+ assert( n==pPage->pgno && e==PTRMAP_OVERFLOW1 );+ }+ if( !pPage->leaf ){+ Pgno child = get4byte(z);+ ptrmapGet(pBt, child, &e, &n);+ assert( n==pPage->pgno && e==PTRMAP_BTREE );+ }+ }+ if( !pPage->leaf ){+ Pgno child = get4byte(&pPage->aData[pPage->hdrOffset+8]);+ ptrmapGet(pBt, child, &e, &n);+ assert( n==pPage->pgno && e==PTRMAP_BTREE );+ }+ }+ return 1;+}+#endif++/*+** This function is used to copy the contents of the b-tree node stored +** on page pFrom to page pTo. If page pFrom was not a leaf page, then+** the pointer-map entries for each child page are updated so that the+** parent page stored in the pointer map is page pTo. If pFrom contained+** any cells with overflow page pointers, then the corresponding pointer+** map entries are also updated so that the parent page is page pTo.+**+** If pFrom is currently carrying any overflow cells (entries in the+** MemPage.apOvfl[] array), they are not copied to pTo. +**+** Before returning, page pTo is reinitialized using btreeInitPage().+**+** The performance of this function is not critical. It is only used by +** the balance_shallower() and balance_deeper() procedures, neither of+** which are called often under normal circumstances.+*/+static void copyNodeContent(MemPage *pFrom, MemPage *pTo, int *pRC){+ if( (*pRC)==SQLITE_OK ){+ BtShared * const pBt = pFrom->pBt;+ u8 * const aFrom = pFrom->aData;+ u8 * const aTo = pTo->aData;+ int const iFromHdr = pFrom->hdrOffset;+ int const iToHdr = ((pTo->pgno==1) ? 100 : 0);+ int rc;+ int iData;+ + + assert( pFrom->isInit );+ assert( pFrom->nFree>=iToHdr );+ assert( get2byte(&aFrom[iFromHdr+5]) <= (int)pBt->usableSize );+ + /* Copy the b-tree node content from page pFrom to page pTo. */+ iData = get2byte(&aFrom[iFromHdr+5]);+ memcpy(&aTo[iData], &aFrom[iData], pBt->usableSize-iData);+ memcpy(&aTo[iToHdr], &aFrom[iFromHdr], pFrom->cellOffset + 2*pFrom->nCell);+ + /* Reinitialize page pTo so that the contents of the MemPage structure+ ** match the new data. The initialization of pTo can actually fail under+ ** fairly obscure circumstances, even though it is a copy of initialized + ** page pFrom.+ */+ pTo->isInit = 0;+ rc = btreeInitPage(pTo);+ if( rc!=SQLITE_OK ){+ *pRC = rc;+ return;+ }+ + /* If this is an auto-vacuum database, update the pointer-map entries+ ** for any b-tree or overflow pages that pTo now contains the pointers to.+ */+ if( ISAUTOVACUUM ){+ *pRC = setChildPtrmaps(pTo);+ }+ }+}++/*+** This routine redistributes cells on the iParentIdx'th child of pParent+** (hereafter "the page") and up to 2 siblings so that all pages have about the+** same amount of free space. Usually a single sibling on either side of the+** page are used in the balancing, though both siblings might come from one+** side if the page is the first or last child of its parent. If the page +** has fewer than 2 siblings (something which can only happen if the page+** is a root page or a child of a root page) then all available siblings+** participate in the balancing.+**+** The number of siblings of the page might be increased or decreased by +** one or two in an effort to keep pages nearly full but not over full. +**+** Note that when this routine is called, some of the cells on the page+** might not actually be stored in MemPage.aData[]. This can happen+** if the page is overfull. This routine ensures that all cells allocated+** to the page and its siblings fit into MemPage.aData[] before returning.+**+** In the course of balancing the page and its siblings, cells may be+** inserted into or removed from the parent page (pParent). Doing so+** may cause the parent page to become overfull or underfull. If this+** happens, it is the responsibility of the caller to invoke the correct+** balancing routine to fix this problem (see the balance() routine). +**+** If this routine fails for any reason, it might leave the database+** in a corrupted state. So if this routine fails, the database should+** be rolled back.+**+** The third argument to this function, aOvflSpace, is a pointer to a+** buffer big enough to hold one page. If while inserting cells into the parent+** page (pParent) the parent page becomes overfull, this buffer is+** used to store the parent's overflow cells. Because this function inserts+** a maximum of four divider cells into the parent page, and the maximum+** size of a cell stored within an internal node is always less than 1/4+** of the page-size, the aOvflSpace[] buffer is guaranteed to be large+** enough for all overflow cells.+**+** If aOvflSpace is set to a null pointer, this function returns +** SQLITE_NOMEM.+*/+#if defined(_MSC_VER) && _MSC_VER >= 1700 && defined(_M_ARM)+#pragma optimize("", off)+#endif+static int balance_nonroot(+ MemPage *pParent, /* Parent page of siblings being balanced */+ int iParentIdx, /* Index of "the page" in pParent */+ u8 *aOvflSpace, /* page-size bytes of space for parent ovfl */+ int isRoot, /* True if pParent is a root-page */+ int bBulk /* True if this call is part of a bulk load */+){+ BtShared *pBt; /* The whole database */+ int nMaxCells = 0; /* Allocated size of apCell, szCell, aFrom. */+ int nNew = 0; /* Number of pages in apNew[] */+ int nOld; /* Number of pages in apOld[] */+ int i, j, k; /* Loop counters */+ int nxDiv; /* Next divider slot in pParent->aCell[] */+ int rc = SQLITE_OK; /* The return code */+ u16 leafCorrection; /* 4 if pPage is a leaf. 0 if not */+ int leafData; /* True if pPage is a leaf of a LEAFDATA tree */+ int usableSpace; /* Bytes in pPage beyond the header */+ int pageFlags; /* Value of pPage->aData[0] */+ int iSpace1 = 0; /* First unused byte of aSpace1[] */+ int iOvflSpace = 0; /* First unused byte of aOvflSpace[] */+ int szScratch; /* Size of scratch memory requested */+ MemPage *apOld[NB]; /* pPage and up to two siblings */+ MemPage *apNew[NB+2]; /* pPage and up to NB siblings after balancing */+ u8 *pRight; /* Location in parent of right-sibling pointer */+ u8 *apDiv[NB-1]; /* Divider cells in pParent */+ int cntNew[NB+2]; /* Index in b.paCell[] of cell after i-th page */+ int cntOld[NB+2]; /* Old index in b.apCell[] */+ int szNew[NB+2]; /* Combined size of cells placed on i-th page */+ u8 *aSpace1; /* Space for copies of dividers cells */+ Pgno pgno; /* Temp var to store a page number in */+ u8 abDone[NB+2]; /* True after i'th new page is populated */+ Pgno aPgno[NB+2]; /* Page numbers of new pages before shuffling */+ Pgno aPgOrder[NB+2]; /* Copy of aPgno[] used for sorting pages */+ u16 aPgFlags[NB+2]; /* flags field of new pages before shuffling */+ CellArray b; /* Parsed information on cells being balanced */++ memset(abDone, 0, sizeof(abDone));+ b.nCell = 0;+ b.apCell = 0;+ pBt = pParent->pBt;+ assert( sqlite3_mutex_held(pBt->mutex) );+ assert( sqlite3PagerIswriteable(pParent->pDbPage) );++#if 0+ TRACE(("BALANCE: begin page %d child of %d\n", pPage->pgno, pParent->pgno));+#endif++ /* At this point pParent may have at most one overflow cell. And if+ ** this overflow cell is present, it must be the cell with + ** index iParentIdx. This scenario comes about when this function+ ** is called (indirectly) from sqlite3BtreeDelete().+ */+ assert( pParent->nOverflow==0 || pParent->nOverflow==1 );+ assert( pParent->nOverflow==0 || pParent->aiOvfl[0]==iParentIdx );++ if( !aOvflSpace ){+ return SQLITE_NOMEM;+ }++ /* Find the sibling pages to balance. Also locate the cells in pParent + ** that divide the siblings. An attempt is made to find NN siblings on + ** either side of pPage. More siblings are taken from one side, however, + ** if there are fewer than NN siblings on the other side. If pParent+ ** has NB or fewer children then all children of pParent are taken. + **+ ** This loop also drops the divider cells from the parent page. This+ ** way, the remainder of the function does not have to deal with any+ ** overflow cells in the parent page, since if any existed they will+ ** have already been removed.+ */+ i = pParent->nOverflow + pParent->nCell;+ if( i<2 ){+ nxDiv = 0;+ }else{+ assert( bBulk==0 || bBulk==1 );+ if( iParentIdx==0 ){ + nxDiv = 0;+ }else if( iParentIdx==i ){+ nxDiv = i-2+bBulk;+ }else{+ nxDiv = iParentIdx-1;+ }+ i = 2-bBulk;+ }+ nOld = i+1;+ if( (i+nxDiv-pParent->nOverflow)==pParent->nCell ){+ pRight = &pParent->aData[pParent->hdrOffset+8];+ }else{+ pRight = findCell(pParent, i+nxDiv-pParent->nOverflow);+ }+ pgno = get4byte(pRight);+ while( 1 ){+ rc = getAndInitPage(pBt, pgno, &apOld[i], 0, 0);+ if( rc ){+ memset(apOld, 0, (i+1)*sizeof(MemPage*));+ goto balance_cleanup;+ }+ nMaxCells += 1+apOld[i]->nCell+apOld[i]->nOverflow;+ if( (i--)==0 ) break;++ if( i+nxDiv==pParent->aiOvfl[0] && pParent->nOverflow ){+ apDiv[i] = pParent->apOvfl[0];+ pgno = get4byte(apDiv[i]);+ szNew[i] = pParent->xCellSize(pParent, apDiv[i]);+ pParent->nOverflow = 0;+ }else{+ apDiv[i] = findCell(pParent, i+nxDiv-pParent->nOverflow);+ pgno = get4byte(apDiv[i]);+ szNew[i] = pParent->xCellSize(pParent, apDiv[i]);++ /* Drop the cell from the parent page. apDiv[i] still points to+ ** the cell within the parent, even though it has been dropped.+ ** This is safe because dropping a cell only overwrites the first+ ** four bytes of it, and this function does not need the first+ ** four bytes of the divider cell. So the pointer is safe to use+ ** later on. + **+ ** But not if we are in secure-delete mode. In secure-delete mode,+ ** the dropCell() routine will overwrite the entire cell with zeroes.+ ** In this case, temporarily copy the cell into the aOvflSpace[]+ ** buffer. It will be copied out again as soon as the aSpace[] buffer+ ** is allocated. */+ if( pBt->btsFlags & BTS_SECURE_DELETE ){+ int iOff;++ iOff = SQLITE_PTR_TO_INT(apDiv[i]) - SQLITE_PTR_TO_INT(pParent->aData);+ if( (iOff+szNew[i])>(int)pBt->usableSize ){+ rc = SQLITE_CORRUPT_BKPT;+ memset(apOld, 0, (i+1)*sizeof(MemPage*));+ goto balance_cleanup;+ }else{+ memcpy(&aOvflSpace[iOff], apDiv[i], szNew[i]);+ apDiv[i] = &aOvflSpace[apDiv[i]-pParent->aData];+ }+ }+ dropCell(pParent, i+nxDiv-pParent->nOverflow, szNew[i], &rc);+ }+ }++ /* Make nMaxCells a multiple of 4 in order to preserve 8-byte+ ** alignment */+ nMaxCells = (nMaxCells + 3)&~3;++ /*+ ** Allocate space for memory structures+ */+ szScratch =+ nMaxCells*sizeof(u8*) /* b.apCell */+ + nMaxCells*sizeof(u16) /* b.szCell */+ + pBt->pageSize; /* aSpace1 */++ /* EVIDENCE-OF: R-28375-38319 SQLite will never request a scratch buffer+ ** that is more than 6 times the database page size. */+ assert( szScratch<=6*(int)pBt->pageSize );+ b.apCell = sqlite3ScratchMalloc( szScratch ); + if( b.apCell==0 ){+ rc = SQLITE_NOMEM;+ goto balance_cleanup;+ }+ b.szCell = (u16*)&b.apCell[nMaxCells];+ aSpace1 = (u8*)&b.szCell[nMaxCells];+ assert( EIGHT_BYTE_ALIGNMENT(aSpace1) );++ /*+ ** Load pointers to all cells on sibling pages and the divider cells+ ** into the local b.apCell[] array. Make copies of the divider cells+ ** into space obtained from aSpace1[]. The divider cells have already+ ** been removed from pParent.+ **+ ** If the siblings are on leaf pages, then the child pointers of the+ ** divider cells are stripped from the cells before they are copied+ ** into aSpace1[]. In this way, all cells in b.apCell[] are without+ ** child pointers. If siblings are not leaves, then all cell in+ ** b.apCell[] include child pointers. Either way, all cells in b.apCell[]+ ** are alike.+ **+ ** leafCorrection: 4 if pPage is a leaf. 0 if pPage is not a leaf.+ ** leafData: 1 if pPage holds key+data and pParent holds only keys.+ */+ b.pRef = apOld[0];+ leafCorrection = b.pRef->leaf*4;+ leafData = b.pRef->intKeyLeaf;+ for(i=0; i<nOld; i++){+ MemPage *pOld = apOld[i];+ int limit = pOld->nCell;+ u8 *aData = pOld->aData;+ u16 maskPage = pOld->maskPage;+ u8 *piCell = aData + pOld->cellOffset;+ u8 *piEnd;++ /* Verify that all sibling pages are of the same "type" (table-leaf,+ ** table-interior, index-leaf, or index-interior).+ */+ if( pOld->aData[0]!=apOld[0]->aData[0] ){+ rc = SQLITE_CORRUPT_BKPT;+ goto balance_cleanup;+ }++ /* Load b.apCell[] with pointers to all cells in pOld. If pOld+ ** constains overflow cells, include them in the b.apCell[] array+ ** in the correct spot.+ **+ ** Note that when there are multiple overflow cells, it is always the+ ** case that they are sequential and adjacent. This invariant arises+ ** because multiple overflows can only occurs when inserting divider+ ** cells into a parent on a prior balance, and divider cells are always+ ** adjacent and are inserted in order. There is an assert() tagged+ ** with "NOTE 1" in the overflow cell insertion loop to prove this+ ** invariant.+ **+ ** This must be done in advance. Once the balance starts, the cell+ ** offset section of the btree page will be overwritten and we will no+ ** long be able to find the cells if a pointer to each cell is not saved+ ** first.+ */+ memset(&b.szCell[b.nCell], 0, sizeof(b.szCell[0])*limit);+ if( pOld->nOverflow>0 ){+ memset(&b.szCell[b.nCell+limit], 0, sizeof(b.szCell[0])*pOld->nOverflow);+ limit = pOld->aiOvfl[0];+ for(j=0; j<limit; j++){+ b.apCell[b.nCell] = aData + (maskPage & get2byteAligned(piCell));+ piCell += 2;+ b.nCell++;+ }+ for(k=0; k<pOld->nOverflow; k++){+ assert( k==0 || pOld->aiOvfl[k-1]+1==pOld->aiOvfl[k] );/* NOTE 1 */+ b.apCell[b.nCell] = pOld->apOvfl[k];+ b.nCell++;+ }+ }+ piEnd = aData + pOld->cellOffset + 2*pOld->nCell;+ while( piCell<piEnd ){+ assert( b.nCell<nMaxCells );+ b.apCell[b.nCell] = aData + (maskPage & get2byteAligned(piCell));+ piCell += 2;+ b.nCell++;+ }++ cntOld[i] = b.nCell;+ if( i<nOld-1 && !leafData){+ u16 sz = (u16)szNew[i];+ u8 *pTemp;+ assert( b.nCell<nMaxCells );+ b.szCell[b.nCell] = sz;+ pTemp = &aSpace1[iSpace1];+ iSpace1 += sz;+ assert( sz<=pBt->maxLocal+23 );+ assert( iSpace1 <= (int)pBt->pageSize );+ memcpy(pTemp, apDiv[i], sz);+ b.apCell[b.nCell] = pTemp+leafCorrection;+ assert( leafCorrection==0 || leafCorrection==4 );+ b.szCell[b.nCell] = b.szCell[b.nCell] - leafCorrection;+ if( !pOld->leaf ){+ assert( leafCorrection==0 );+ assert( pOld->hdrOffset==0 );+ /* The right pointer of the child page pOld becomes the left+ ** pointer of the divider cell */+ memcpy(b.apCell[b.nCell], &pOld->aData[8], 4);+ }else{+ assert( leafCorrection==4 );+ while( b.szCell[b.nCell]<4 ){+ /* Do not allow any cells smaller than 4 bytes. If a smaller cell+ ** does exist, pad it with 0x00 bytes. */+ assert( b.szCell[b.nCell]==3 || CORRUPT_DB );+ assert( b.apCell[b.nCell]==&aSpace1[iSpace1-3] || CORRUPT_DB );+ aSpace1[iSpace1++] = 0x00;+ b.szCell[b.nCell]++;+ }+ }+ b.nCell++;+ }+ }++ /*+ ** Figure out the number of pages needed to hold all b.nCell cells.+ ** Store this number in "k". Also compute szNew[] which is the total+ ** size of all cells on the i-th page and cntNew[] which is the index+ ** in b.apCell[] of the cell that divides page i from page i+1. + ** cntNew[k] should equal b.nCell.+ **+ ** Values computed by this block:+ **+ ** k: The total number of sibling pages+ ** szNew[i]: Spaced used on the i-th sibling page.+ ** cntNew[i]: Index in b.apCell[] and b.szCell[] for the first cell to+ ** the right of the i-th sibling page.+ ** usableSpace: Number of bytes of space available on each sibling.+ ** + */+ usableSpace = pBt->usableSize - 12 + leafCorrection;+ for(i=0; i<nOld; i++){+ MemPage *p = apOld[i];+ szNew[i] = usableSpace - p->nFree;+ if( szNew[i]<0 ){ rc = SQLITE_CORRUPT_BKPT; goto balance_cleanup; }+ for(j=0; j<p->nOverflow; j++){+ szNew[i] += 2 + p->xCellSize(p, p->apOvfl[j]);+ }+ cntNew[i] = cntOld[i];+ }+ k = nOld;+ for(i=0; i<k; i++){+ int sz;+ while( szNew[i]>usableSpace ){+ if( i+1>=k ){+ k = i+2;+ if( k>NB+2 ){ rc = SQLITE_CORRUPT_BKPT; goto balance_cleanup; }+ szNew[k-1] = 0;+ cntNew[k-1] = b.nCell;+ }+ sz = 2 + cachedCellSize(&b, cntNew[i]-1);+ szNew[i] -= sz;+ if( !leafData ){+ if( cntNew[i]<b.nCell ){+ sz = 2 + cachedCellSize(&b, cntNew[i]);+ }else{+ sz = 0;+ }+ }+ szNew[i+1] += sz;+ cntNew[i]--;+ }+ while( cntNew[i]<b.nCell ){+ sz = 2 + cachedCellSize(&b, cntNew[i]);+ if( szNew[i]+sz>usableSpace ) break;+ szNew[i] += sz;+ cntNew[i]++;+ if( !leafData ){+ if( cntNew[i]<b.nCell ){+ sz = 2 + cachedCellSize(&b, cntNew[i]);+ }else{+ sz = 0;+ }+ }+ szNew[i+1] -= sz;+ }+ if( cntNew[i]>=b.nCell ){+ k = i+1;+ }else if( cntNew[i] <= (i>0 ? cntNew[i-1] : 0) ){+ rc = SQLITE_CORRUPT_BKPT;+ goto balance_cleanup;+ }+ }++ /*+ ** The packing computed by the previous block is biased toward the siblings+ ** on the left side (siblings with smaller keys). The left siblings are+ ** always nearly full, while the right-most sibling might be nearly empty.+ ** The next block of code attempts to adjust the packing of siblings to+ ** get a better balance.+ **+ ** This adjustment is more than an optimization. The packing above might+ ** be so out of balance as to be illegal. For example, the right-most+ ** sibling might be completely empty. This adjustment is not optional.+ */+ for(i=k-1; i>0; i--){+ int szRight = szNew[i]; /* Size of sibling on the right */+ int szLeft = szNew[i-1]; /* Size of sibling on the left */+ int r; /* Index of right-most cell in left sibling */+ int d; /* Index of first cell to the left of right sibling */++ r = cntNew[i-1] - 1;+ d = r + 1 - leafData;+ (void)cachedCellSize(&b, d);+ do{+ assert( d<nMaxCells );+ assert( r<nMaxCells );+ (void)cachedCellSize(&b, r);+ if( szRight!=0+ && (bBulk || szRight+b.szCell[d]+2 > szLeft-(b.szCell[r]+2)) ){+ break;+ }+ szRight += b.szCell[d] + 2;+ szLeft -= b.szCell[r] + 2;+ cntNew[i-1] = r;+ r--;+ d--;+ }while( r>=0 );+ szNew[i] = szRight;+ szNew[i-1] = szLeft;+ if( cntNew[i-1] <= (i>1 ? cntNew[i-2] : 0) ){+ rc = SQLITE_CORRUPT_BKPT;+ goto balance_cleanup;+ }+ }++ /* Sanity check: For a non-corrupt database file one of the follwing+ ** must be true:+ ** (1) We found one or more cells (cntNew[0])>0), or+ ** (2) pPage is a virtual root page. A virtual root page is when+ ** the real root page is page 1 and we are the only child of+ ** that page.+ */+ assert( cntNew[0]>0 || (pParent->pgno==1 && pParent->nCell==0) || CORRUPT_DB);+ TRACE(("BALANCE: old: %d(nc=%d) %d(nc=%d) %d(nc=%d)\n",+ apOld[0]->pgno, apOld[0]->nCell,+ nOld>=2 ? apOld[1]->pgno : 0, nOld>=2 ? apOld[1]->nCell : 0,+ nOld>=3 ? apOld[2]->pgno : 0, nOld>=3 ? apOld[2]->nCell : 0+ ));++ /*+ ** Allocate k new pages. Reuse old pages where possible.+ */+ pageFlags = apOld[0]->aData[0];+ for(i=0; i<k; i++){+ MemPage *pNew;+ if( i<nOld ){+ pNew = apNew[i] = apOld[i];+ apOld[i] = 0;+ rc = sqlite3PagerWrite(pNew->pDbPage);+ nNew++;+ if( rc ) goto balance_cleanup;+ }else{+ assert( i>0 );+ rc = allocateBtreePage(pBt, &pNew, &pgno, (bBulk ? 1 : pgno), 0);+ if( rc ) goto balance_cleanup;+ zeroPage(pNew, pageFlags);+ apNew[i] = pNew;+ nNew++;+ cntOld[i] = b.nCell;++ /* Set the pointer-map entry for the new sibling page. */+ if( ISAUTOVACUUM ){+ ptrmapPut(pBt, pNew->pgno, PTRMAP_BTREE, pParent->pgno, &rc);+ if( rc!=SQLITE_OK ){+ goto balance_cleanup;+ }+ }+ }+ }++ /*+ ** Reassign page numbers so that the new pages are in ascending order. + ** This helps to keep entries in the disk file in order so that a scan+ ** of the table is closer to a linear scan through the file. That in turn + ** helps the operating system to deliver pages from the disk more rapidly.+ **+ ** An O(n^2) insertion sort algorithm is used, but since n is never more + ** than (NB+2) (a small constant), that should not be a problem.+ **+ ** When NB==3, this one optimization makes the database about 25% faster + ** for large insertions and deletions.+ */+ for(i=0; i<nNew; i++){+ aPgOrder[i] = aPgno[i] = apNew[i]->pgno;+ aPgFlags[i] = apNew[i]->pDbPage->flags;+ for(j=0; j<i; j++){+ if( aPgno[j]==aPgno[i] ){+ /* This branch is taken if the set of sibling pages somehow contains+ ** duplicate entries. This can happen if the database is corrupt. + ** It would be simpler to detect this as part of the loop below, but+ ** we do the detection here in order to avoid populating the pager+ ** cache with two separate objects associated with the same+ ** page number. */+ assert( CORRUPT_DB );+ rc = SQLITE_CORRUPT_BKPT;+ goto balance_cleanup;+ }+ }+ }+ for(i=0; i<nNew; i++){+ int iBest = 0; /* aPgno[] index of page number to use */+ for(j=1; j<nNew; j++){+ if( aPgOrder[j]<aPgOrder[iBest] ) iBest = j;+ }+ pgno = aPgOrder[iBest];+ aPgOrder[iBest] = 0xffffffff;+ if( iBest!=i ){+ if( iBest>i ){+ sqlite3PagerRekey(apNew[iBest]->pDbPage, pBt->nPage+iBest+1, 0);+ }+ sqlite3PagerRekey(apNew[i]->pDbPage, pgno, aPgFlags[iBest]);+ apNew[i]->pgno = pgno;+ }+ }++ TRACE(("BALANCE: new: %d(%d nc=%d) %d(%d nc=%d) %d(%d nc=%d) "+ "%d(%d nc=%d) %d(%d nc=%d)\n",+ apNew[0]->pgno, szNew[0], cntNew[0],+ nNew>=2 ? apNew[1]->pgno : 0, nNew>=2 ? szNew[1] : 0,+ nNew>=2 ? cntNew[1] - cntNew[0] - !leafData : 0,+ nNew>=3 ? apNew[2]->pgno : 0, nNew>=3 ? szNew[2] : 0,+ nNew>=3 ? cntNew[2] - cntNew[1] - !leafData : 0,+ nNew>=4 ? apNew[3]->pgno : 0, nNew>=4 ? szNew[3] : 0,+ nNew>=4 ? cntNew[3] - cntNew[2] - !leafData : 0,+ nNew>=5 ? apNew[4]->pgno : 0, nNew>=5 ? szNew[4] : 0,+ nNew>=5 ? cntNew[4] - cntNew[3] - !leafData : 0+ ));++ assert( sqlite3PagerIswriteable(pParent->pDbPage) );+ put4byte(pRight, apNew[nNew-1]->pgno);++ /* If the sibling pages are not leaves, ensure that the right-child pointer+ ** of the right-most new sibling page is set to the value that was + ** originally in the same field of the right-most old sibling page. */+ if( (pageFlags & PTF_LEAF)==0 && nOld!=nNew ){+ MemPage *pOld = (nNew>nOld ? apNew : apOld)[nOld-1];+ memcpy(&apNew[nNew-1]->aData[8], &pOld->aData[8], 4);+ }++ /* Make any required updates to pointer map entries associated with + ** cells stored on sibling pages following the balance operation. Pointer+ ** map entries associated with divider cells are set by the insertCell()+ ** routine. The associated pointer map entries are:+ **+ ** a) if the cell contains a reference to an overflow chain, the+ ** entry associated with the first page in the overflow chain, and+ **+ ** b) if the sibling pages are not leaves, the child page associated+ ** with the cell.+ **+ ** If the sibling pages are not leaves, then the pointer map entry + ** associated with the right-child of each sibling may also need to be + ** updated. This happens below, after the sibling pages have been + ** populated, not here.+ */+ if( ISAUTOVACUUM ){+ MemPage *pNew = apNew[0];+ u8 *aOld = pNew->aData;+ int cntOldNext = pNew->nCell + pNew->nOverflow;+ int usableSize = pBt->usableSize;+ int iNew = 0;+ int iOld = 0;++ for(i=0; i<b.nCell; i++){+ u8 *pCell = b.apCell[i];+ if( i==cntOldNext ){+ MemPage *pOld = (++iOld)<nNew ? apNew[iOld] : apOld[iOld];+ cntOldNext += pOld->nCell + pOld->nOverflow + !leafData;+ aOld = pOld->aData;+ }+ if( i==cntNew[iNew] ){+ pNew = apNew[++iNew];+ if( !leafData ) continue;+ }++ /* Cell pCell is destined for new sibling page pNew. Originally, it+ ** was either part of sibling page iOld (possibly an overflow cell), + ** or else the divider cell to the left of sibling page iOld. So,+ ** if sibling page iOld had the same page number as pNew, and if+ ** pCell really was a part of sibling page iOld (not a divider or+ ** overflow cell), we can skip updating the pointer map entries. */+ if( iOld>=nNew+ || pNew->pgno!=aPgno[iOld]+ || pCell<aOld+ || pCell>=&aOld[usableSize]+ ){+ if( !leafCorrection ){+ ptrmapPut(pBt, get4byte(pCell), PTRMAP_BTREE, pNew->pgno, &rc);+ }+ if( cachedCellSize(&b,i)>pNew->minLocal ){+ ptrmapPutOvflPtr(pNew, pCell, &rc);+ }+ if( rc ) goto balance_cleanup;+ }+ }+ }++ /* Insert new divider cells into pParent. */+ for(i=0; i<nNew-1; i++){+ u8 *pCell;+ u8 *pTemp;+ int sz;+ MemPage *pNew = apNew[i];+ j = cntNew[i];++ assert( j<nMaxCells );+ assert( b.apCell[j]!=0 );+ pCell = b.apCell[j];+ sz = b.szCell[j] + leafCorrection;+ pTemp = &aOvflSpace[iOvflSpace];+ if( !pNew->leaf ){+ memcpy(&pNew->aData[8], pCell, 4);+ }else if( leafData ){+ /* If the tree is a leaf-data tree, and the siblings are leaves, + ** then there is no divider cell in b.apCell[]. Instead, the divider + ** cell consists of the integer key for the right-most cell of + ** the sibling-page assembled above only.+ */+ CellInfo info;+ j--;+ pNew->xParseCell(pNew, b.apCell[j], &info);+ pCell = pTemp;+ sz = 4 + putVarint(&pCell[4], info.nKey);+ pTemp = 0;+ }else{+ pCell -= 4;+ /* Obscure case for non-leaf-data trees: If the cell at pCell was+ ** previously stored on a leaf node, and its reported size was 4+ ** bytes, then it may actually be smaller than this + ** (see btreeParseCellPtr(), 4 bytes is the minimum size of+ ** any cell). But it is important to pass the correct size to + ** insertCell(), so reparse the cell now.+ **+ ** Note that this can never happen in an SQLite data file, as all+ ** cells are at least 4 bytes. It only happens in b-trees used+ ** to evaluate "IN (SELECT ...)" and similar clauses.+ */+ if( b.szCell[j]==4 ){+ assert(leafCorrection==4);+ sz = pParent->xCellSize(pParent, pCell);+ }+ }+ iOvflSpace += sz;+ assert( sz<=pBt->maxLocal+23 );+ assert( iOvflSpace <= (int)pBt->pageSize );+ insertCell(pParent, nxDiv+i, pCell, sz, pTemp, pNew->pgno, &rc);+ if( rc!=SQLITE_OK ) goto balance_cleanup;+ assert( sqlite3PagerIswriteable(pParent->pDbPage) );+ }++ /* Now update the actual sibling pages. The order in which they are updated+ ** is important, as this code needs to avoid disrupting any page from which+ ** cells may still to be read. In practice, this means:+ **+ ** (1) If cells are moving left (from apNew[iPg] to apNew[iPg-1])+ ** then it is not safe to update page apNew[iPg] until after+ ** the left-hand sibling apNew[iPg-1] has been updated.+ **+ ** (2) If cells are moving right (from apNew[iPg] to apNew[iPg+1])+ ** then it is not safe to update page apNew[iPg] until after+ ** the right-hand sibling apNew[iPg+1] has been updated.+ **+ ** If neither of the above apply, the page is safe to update.+ **+ ** The iPg value in the following loop starts at nNew-1 goes down+ ** to 0, then back up to nNew-1 again, thus making two passes over+ ** the pages. On the initial downward pass, only condition (1) above+ ** needs to be tested because (2) will always be true from the previous+ ** step. On the upward pass, both conditions are always true, so the+ ** upwards pass simply processes pages that were missed on the downward+ ** pass.+ */+ for(i=1-nNew; i<nNew; i++){+ int iPg = i<0 ? -i : i;+ assert( iPg>=0 && iPg<nNew );+ if( abDone[iPg] ) continue; /* Skip pages already processed */+ if( i>=0 /* On the upwards pass, or... */+ || cntOld[iPg-1]>=cntNew[iPg-1] /* Condition (1) is true */+ ){+ int iNew;+ int iOld;+ int nNewCell;++ /* Verify condition (1): If cells are moving left, update iPg+ ** only after iPg-1 has already been updated. */+ assert( iPg==0 || cntOld[iPg-1]>=cntNew[iPg-1] || abDone[iPg-1] );++ /* Verify condition (2): If cells are moving right, update iPg+ ** only after iPg+1 has already been updated. */+ assert( cntNew[iPg]>=cntOld[iPg] || abDone[iPg+1] );++ if( iPg==0 ){+ iNew = iOld = 0;+ nNewCell = cntNew[0];+ }else{+ iOld = iPg<nOld ? (cntOld[iPg-1] + !leafData) : b.nCell;+ iNew = cntNew[iPg-1] + !leafData;+ nNewCell = cntNew[iPg] - iNew;+ }++ rc = editPage(apNew[iPg], iOld, iNew, nNewCell, &b);+ if( rc ) goto balance_cleanup;+ abDone[iPg]++;+ apNew[iPg]->nFree = usableSpace-szNew[iPg];+ assert( apNew[iPg]->nOverflow==0 );+ assert( apNew[iPg]->nCell==nNewCell );+ }+ }++ /* All pages have been processed exactly once */+ assert( memcmp(abDone, "\01\01\01\01\01", nNew)==0 );++ assert( nOld>0 );+ assert( nNew>0 );++ if( isRoot && pParent->nCell==0 && pParent->hdrOffset<=apNew[0]->nFree ){+ /* The root page of the b-tree now contains no cells. The only sibling+ ** page is the right-child of the parent. Copy the contents of the+ ** child page into the parent, decreasing the overall height of the+ ** b-tree structure by one. This is described as the "balance-shallower"+ ** sub-algorithm in some documentation.+ **+ ** If this is an auto-vacuum database, the call to copyNodeContent() + ** sets all pointer-map entries corresponding to database image pages + ** for which the pointer is stored within the content being copied.+ **+ ** It is critical that the child page be defragmented before being+ ** copied into the parent, because if the parent is page 1 then it will+ ** by smaller than the child due to the database header, and so all the+ ** free space needs to be up front.+ */+ assert( nNew==1 || CORRUPT_DB );+ rc = defragmentPage(apNew[0]);+ testcase( rc!=SQLITE_OK );+ assert( apNew[0]->nFree == + (get2byte(&apNew[0]->aData[5])-apNew[0]->cellOffset-apNew[0]->nCell*2)+ || rc!=SQLITE_OK+ );+ copyNodeContent(apNew[0], pParent, &rc);+ freePage(apNew[0], &rc);+ }else if( ISAUTOVACUUM && !leafCorrection ){+ /* Fix the pointer map entries associated with the right-child of each+ ** sibling page. All other pointer map entries have already been taken+ ** care of. */+ for(i=0; i<nNew; i++){+ u32 key = get4byte(&apNew[i]->aData[8]);+ ptrmapPut(pBt, key, PTRMAP_BTREE, apNew[i]->pgno, &rc);+ }+ }++ assert( pParent->isInit );+ TRACE(("BALANCE: finished: old=%d new=%d cells=%d\n",+ nOld, nNew, b.nCell));++ /* Free any old pages that were not reused as new pages.+ */+ for(i=nNew; i<nOld; i++){+ freePage(apOld[i], &rc);+ }++#if 0+ if( ISAUTOVACUUM && rc==SQLITE_OK && apNew[0]->isInit ){+ /* The ptrmapCheckPages() contains assert() statements that verify that+ ** all pointer map pages are set correctly. This is helpful while + ** debugging. This is usually disabled because a corrupt database may+ ** cause an assert() statement to fail. */+ ptrmapCheckPages(apNew, nNew);+ ptrmapCheckPages(&pParent, 1);+ }+#endif++ /*+ ** Cleanup before returning.+ */+balance_cleanup:+ sqlite3ScratchFree(b.apCell);+ for(i=0; i<nOld; i++){+ releasePage(apOld[i]);+ }+ for(i=0; i<nNew; i++){+ releasePage(apNew[i]);+ }++ return rc;+}+#if defined(_MSC_VER) && _MSC_VER >= 1700 && defined(_M_ARM)+#pragma optimize("", on)+#endif+++/*+** This function is called when the root page of a b-tree structure is+** overfull (has one or more overflow pages).+**+** A new child page is allocated and the contents of the current root+** page, including overflow cells, are copied into the child. The root+** page is then overwritten to make it an empty page with the right-child +** pointer pointing to the new page.+**+** Before returning, all pointer-map entries corresponding to pages +** that the new child-page now contains pointers to are updated. The+** entry corresponding to the new right-child pointer of the root+** page is also updated.+**+** If successful, *ppChild is set to contain a reference to the child +** page and SQLITE_OK is returned. In this case the caller is required+** to call releasePage() on *ppChild exactly once. If an error occurs,+** an error code is returned and *ppChild is set to 0.+*/+static int balance_deeper(MemPage *pRoot, MemPage **ppChild){+ int rc; /* Return value from subprocedures */+ MemPage *pChild = 0; /* Pointer to a new child page */+ Pgno pgnoChild = 0; /* Page number of the new child page */+ BtShared *pBt = pRoot->pBt; /* The BTree */++ assert( pRoot->nOverflow>0 );+ assert( sqlite3_mutex_held(pBt->mutex) );++ /* Make pRoot, the root page of the b-tree, writable. Allocate a new + ** page that will become the new right-child of pPage. Copy the contents+ ** of the node stored on pRoot into the new child page.+ */+ rc = sqlite3PagerWrite(pRoot->pDbPage);+ if( rc==SQLITE_OK ){+ rc = allocateBtreePage(pBt,&pChild,&pgnoChild,pRoot->pgno,0);+ copyNodeContent(pRoot, pChild, &rc);+ if( ISAUTOVACUUM ){+ ptrmapPut(pBt, pgnoChild, PTRMAP_BTREE, pRoot->pgno, &rc);+ }+ }+ if( rc ){+ *ppChild = 0;+ releasePage(pChild);+ return rc;+ }+ assert( sqlite3PagerIswriteable(pChild->pDbPage) );+ assert( sqlite3PagerIswriteable(pRoot->pDbPage) );+ assert( pChild->nCell==pRoot->nCell );++ TRACE(("BALANCE: copy root %d into %d\n", pRoot->pgno, pChild->pgno));++ /* Copy the overflow cells from pRoot to pChild */+ memcpy(pChild->aiOvfl, pRoot->aiOvfl,+ pRoot->nOverflow*sizeof(pRoot->aiOvfl[0]));+ memcpy(pChild->apOvfl, pRoot->apOvfl,+ pRoot->nOverflow*sizeof(pRoot->apOvfl[0]));+ pChild->nOverflow = pRoot->nOverflow;++ /* Zero the contents of pRoot. Then install pChild as the right-child. */+ zeroPage(pRoot, pChild->aData[0] & ~PTF_LEAF);+ put4byte(&pRoot->aData[pRoot->hdrOffset+8], pgnoChild);++ *ppChild = pChild;+ return SQLITE_OK;+}++/*+** The page that pCur currently points to has just been modified in+** some way. This function figures out if this modification means the+** tree needs to be balanced, and if so calls the appropriate balancing +** routine. Balancing routines are:+**+** balance_quick()+** balance_deeper()+** balance_nonroot()+*/+static int balance(BtCursor *pCur){+ int rc = SQLITE_OK;+ const int nMin = pCur->pBt->usableSize * 2 / 3;+ u8 aBalanceQuickSpace[13];+ u8 *pFree = 0;++ TESTONLY( int balance_quick_called = 0 );+ TESTONLY( int balance_deeper_called = 0 );++ do {+ int iPage = pCur->iPage;+ MemPage *pPage = pCur->apPage[iPage];++ if( iPage==0 ){+ if( pPage->nOverflow ){+ /* The root page of the b-tree is overfull. In this case call the+ ** balance_deeper() function to create a new child for the root-page+ ** and copy the current contents of the root-page to it. The+ ** next iteration of the do-loop will balance the child page.+ */ + assert( (balance_deeper_called++)==0 );+ rc = balance_deeper(pPage, &pCur->apPage[1]);+ if( rc==SQLITE_OK ){+ pCur->iPage = 1;+ pCur->aiIdx[0] = 0;+ pCur->aiIdx[1] = 0;+ assert( pCur->apPage[1]->nOverflow );+ }+ }else{+ break;+ }+ }else if( pPage->nOverflow==0 && pPage->nFree<=nMin ){+ break;+ }else{+ MemPage * const pParent = pCur->apPage[iPage-1];+ int const iIdx = pCur->aiIdx[iPage-1];++ rc = sqlite3PagerWrite(pParent->pDbPage);+ if( rc==SQLITE_OK ){+#ifndef SQLITE_OMIT_QUICKBALANCE+ if( pPage->intKeyLeaf+ && pPage->nOverflow==1+ && pPage->aiOvfl[0]==pPage->nCell+ && pParent->pgno!=1+ && pParent->nCell==iIdx+ ){+ /* Call balance_quick() to create a new sibling of pPage on which+ ** to store the overflow cell. balance_quick() inserts a new cell+ ** into pParent, which may cause pParent overflow. If this+ ** happens, the next iteration of the do-loop will balance pParent + ** use either balance_nonroot() or balance_deeper(). Until this+ ** happens, the overflow cell is stored in the aBalanceQuickSpace[]+ ** buffer. + **+ ** The purpose of the following assert() is to check that only a+ ** single call to balance_quick() is made for each call to this+ ** function. If this were not verified, a subtle bug involving reuse+ ** of the aBalanceQuickSpace[] might sneak in.+ */+ assert( (balance_quick_called++)==0 );+ rc = balance_quick(pParent, pPage, aBalanceQuickSpace);+ }else+#endif+ {+ /* In this case, call balance_nonroot() to redistribute cells+ ** between pPage and up to 2 of its sibling pages. This involves+ ** modifying the contents of pParent, which may cause pParent to+ ** become overfull or underfull. The next iteration of the do-loop+ ** will balance the parent page to correct this.+ ** + ** If the parent page becomes overfull, the overflow cell or cells+ ** are stored in the pSpace buffer allocated immediately below. + ** A subsequent iteration of the do-loop will deal with this by+ ** calling balance_nonroot() (balance_deeper() may be called first,+ ** but it doesn't deal with overflow cells - just moves them to a+ ** different page). Once this subsequent call to balance_nonroot() + ** has completed, it is safe to release the pSpace buffer used by+ ** the previous call, as the overflow cell data will have been + ** copied either into the body of a database page or into the new+ ** pSpace buffer passed to the latter call to balance_nonroot().+ */+ u8 *pSpace = sqlite3PageMalloc(pCur->pBt->pageSize);+ rc = balance_nonroot(pParent, iIdx, pSpace, iPage==1,+ pCur->hints&BTREE_BULKLOAD);+ if( pFree ){+ /* If pFree is not NULL, it points to the pSpace buffer used + ** by a previous call to balance_nonroot(). Its contents are+ ** now stored either on real database pages or within the + ** new pSpace buffer, so it may be safely freed here. */+ sqlite3PageFree(pFree);+ }++ /* The pSpace buffer will be freed after the next call to+ ** balance_nonroot(), or just before this function returns, whichever+ ** comes first. */+ pFree = pSpace;+ }+ }++ pPage->nOverflow = 0;++ /* The next iteration of the do-loop balances the parent page. */+ releasePage(pPage);+ pCur->iPage--;+ assert( pCur->iPage>=0 );+ }+ }while( rc==SQLITE_OK );++ if( pFree ){+ sqlite3PageFree(pFree);+ }+ return rc;+}+++/*+** Insert a new record into the BTree. The key is given by (pKey,nKey)+** and the data is given by (pData,nData). The cursor is used only to+** define what table the record should be inserted into. The cursor+** is left pointing at a random location.+**+** For an INTKEY table, only the nKey value of the key is used. pKey is+** ignored. For a ZERODATA table, the pData and nData are both ignored.+**+** If the seekResult parameter is non-zero, then a successful call to+** MovetoUnpacked() to seek cursor pCur to (pKey, nKey) has already+** been performed. seekResult is the search result returned (a negative+** number if pCur points at an entry that is smaller than (pKey, nKey), or+** a positive value if pCur points at an entry that is larger than +** (pKey, nKey)). +**+** If the seekResult parameter is non-zero, then the caller guarantees that+** cursor pCur is pointing at the existing copy of a row that is to be+** overwritten. If the seekResult parameter is 0, then cursor pCur may+** point to any entry or to no entry at all and so this function has to seek+** the cursor before the new key can be inserted.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeInsert(+ BtCursor *pCur, /* Insert data into the table of this cursor */+ const void *pKey, i64 nKey, /* The key of the new record */+ const void *pData, int nData, /* The data of the new record */+ int nZero, /* Number of extra 0 bytes to append to data */+ int appendBias, /* True if this is likely an append */+ int seekResult /* Result of prior MovetoUnpacked() call */+){+ int rc;+ int loc = seekResult; /* -1: before desired location +1: after */+ int szNew = 0;+ int idx;+ MemPage *pPage;+ Btree *p = pCur->pBtree;+ BtShared *pBt = p->pBt;+ unsigned char *oldCell;+ unsigned char *newCell = 0;++ if( pCur->eState==CURSOR_FAULT ){+ assert( pCur->skipNext!=SQLITE_OK );+ return pCur->skipNext;+ }++ assert( cursorHoldsMutex(pCur) );+ assert( (pCur->curFlags & BTCF_WriteFlag)!=0+ && pBt->inTransaction==TRANS_WRITE+ && (pBt->btsFlags & BTS_READ_ONLY)==0 );+ assert( hasSharedCacheTableLock(p, pCur->pgnoRoot, pCur->pKeyInfo!=0, 2) );++ /* Assert that the caller has been consistent. If this cursor was opened+ ** expecting an index b-tree, then the caller should be inserting blob+ ** keys with no associated data. If the cursor was opened expecting an+ ** intkey table, the caller should be inserting integer keys with a+ ** blob of associated data. */+ assert( (pKey==0)==(pCur->pKeyInfo==0) );++ /* Save the positions of any other cursors open on this table.+ **+ ** In some cases, the call to btreeMoveto() below is a no-op. For+ ** example, when inserting data into a table with auto-generated integer+ ** keys, the VDBE layer invokes sqlite3BtreeLast() to figure out the + ** integer key to use. It then calls this function to actually insert the + ** data into the intkey B-Tree. In this case btreeMoveto() recognizes+ ** that the cursor is already where it needs to be and returns without+ ** doing any work. To avoid thwarting these optimizations, it is important+ ** not to clear the cursor here.+ */+ if( pCur->curFlags & BTCF_Multiple ){+ rc = saveAllCursors(pBt, pCur->pgnoRoot, pCur);+ if( rc ) return rc;+ }++ if( pCur->pKeyInfo==0 ){+ assert( pKey==0 );+ /* If this is an insert into a table b-tree, invalidate any incrblob + ** cursors open on the row being replaced */+ invalidateIncrblobCursors(p, nKey, 0);++ /* If the cursor is currently on the last row and we are appending a+ ** new row onto the end, set the "loc" to avoid an unnecessary+ ** btreeMoveto() call */+ if( (pCur->curFlags&BTCF_ValidNKey)!=0 && nKey>0+ && pCur->info.nKey==nKey-1 ){+ loc = -1;+ }else if( loc==0 ){+ rc = sqlite3BtreeMovetoUnpacked(pCur, 0, nKey, appendBias, &loc);+ if( rc ) return rc;+ }+ }else if( loc==0 ){+ rc = btreeMoveto(pCur, pKey, nKey, appendBias, &loc);+ if( rc ) return rc;+ }+ assert( pCur->eState==CURSOR_VALID || (pCur->eState==CURSOR_INVALID && loc) );++ pPage = pCur->apPage[pCur->iPage];+ assert( pPage->intKey || nKey>=0 );+ assert( pPage->leaf || !pPage->intKey );++ TRACE(("INSERT: table=%d nkey=%lld ndata=%d page=%d %s\n",+ pCur->pgnoRoot, nKey, nData, pPage->pgno,+ loc==0 ? "overwrite" : "new entry"));+ assert( pPage->isInit );+ newCell = pBt->pTmpSpace;+ assert( newCell!=0 );+ rc = fillInCell(pPage, newCell, pKey, nKey, pData, nData, nZero, &szNew);+ if( rc ) goto end_insert;+ assert( szNew==pPage->xCellSize(pPage, newCell) );+ assert( szNew <= MX_CELL_SIZE(pBt) );+ idx = pCur->aiIdx[pCur->iPage];+ if( loc==0 ){+ u16 szOld;+ assert( idx<pPage->nCell );+ rc = sqlite3PagerWrite(pPage->pDbPage);+ if( rc ){+ goto end_insert;+ }+ oldCell = findCell(pPage, idx);+ if( !pPage->leaf ){+ memcpy(newCell, oldCell, 4);+ }+ rc = clearCell(pPage, oldCell, &szOld);+ dropCell(pPage, idx, szOld, &rc);+ if( rc ) goto end_insert;+ }else if( loc<0 && pPage->nCell>0 ){+ assert( pPage->leaf );+ idx = ++pCur->aiIdx[pCur->iPage];+ }else{+ assert( pPage->leaf );+ }+ insertCell(pPage, idx, newCell, szNew, 0, 0, &rc);+ assert( rc!=SQLITE_OK || pPage->nCell>0 || pPage->nOverflow>0 );++ /* If no error has occurred and pPage has an overflow cell, call balance() + ** to redistribute the cells within the tree. Since balance() may move+ ** the cursor, zero the BtCursor.info.nSize and BTCF_ValidNKey+ ** variables.+ **+ ** Previous versions of SQLite called moveToRoot() to move the cursor+ ** back to the root page as balance() used to invalidate the contents+ ** of BtCursor.apPage[] and BtCursor.aiIdx[]. Instead of doing that,+ ** set the cursor state to "invalid". This makes common insert operations+ ** slightly faster.+ **+ ** There is a subtle but important optimization here too. When inserting+ ** multiple records into an intkey b-tree using a single cursor (as can+ ** happen while processing an "INSERT INTO ... SELECT" statement), it+ ** is advantageous to leave the cursor pointing to the last entry in+ ** the b-tree if possible. If the cursor is left pointing to the last+ ** entry in the table, and the next row inserted has an integer key+ ** larger than the largest existing key, it is possible to insert the+ ** row without seeking the cursor. This can be a big performance boost.+ */+ pCur->info.nSize = 0;+ if( rc==SQLITE_OK && pPage->nOverflow ){+ pCur->curFlags &= ~(BTCF_ValidNKey);+ rc = balance(pCur);++ /* Must make sure nOverflow is reset to zero even if the balance()+ ** fails. Internal data structure corruption will result otherwise. + ** Also, set the cursor state to invalid. This stops saveCursorPosition()+ ** from trying to save the current position of the cursor. */+ pCur->apPage[pCur->iPage]->nOverflow = 0;+ pCur->eState = CURSOR_INVALID;+ }+ assert( pCur->apPage[pCur->iPage]->nOverflow==0 );++end_insert:+ return rc;+}++/*+** Delete the entry that the cursor is pointing to. +**+** If the second parameter is zero, then the cursor is left pointing at an+** arbitrary location after the delete. If it is non-zero, then the cursor +** is left in a state such that the next call to BtreeNext() or BtreePrev()+** moves it to the same row as it would if the call to BtreeDelete() had+** been omitted.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeDelete(BtCursor *pCur, int bPreserve){+ Btree *p = pCur->pBtree;+ BtShared *pBt = p->pBt; + int rc; /* Return code */+ MemPage *pPage; /* Page to delete cell from */+ unsigned char *pCell; /* Pointer to cell to delete */+ int iCellIdx; /* Index of cell to delete */+ int iCellDepth; /* Depth of node containing pCell */ + u16 szCell; /* Size of the cell being deleted */+ int bSkipnext = 0; /* Leaf cursor in SKIPNEXT state */++ assert( cursorHoldsMutex(pCur) );+ assert( pBt->inTransaction==TRANS_WRITE );+ assert( (pBt->btsFlags & BTS_READ_ONLY)==0 );+ assert( pCur->curFlags & BTCF_WriteFlag );+ assert( hasSharedCacheTableLock(p, pCur->pgnoRoot, pCur->pKeyInfo!=0, 2) );+ assert( !hasReadConflicts(p, pCur->pgnoRoot) );+ assert( pCur->aiIdx[pCur->iPage]<pCur->apPage[pCur->iPage]->nCell );+ assert( pCur->eState==CURSOR_VALID );++ iCellDepth = pCur->iPage;+ iCellIdx = pCur->aiIdx[iCellDepth];+ pPage = pCur->apPage[iCellDepth];+ pCell = findCell(pPage, iCellIdx);++ /* If the page containing the entry to delete is not a leaf page, move+ ** the cursor to the largest entry in the tree that is smaller than+ ** the entry being deleted. This cell will replace the cell being deleted+ ** from the internal node. The 'previous' entry is used for this instead+ ** of the 'next' entry, as the previous entry is always a part of the+ ** sub-tree headed by the child page of the cell being deleted. This makes+ ** balancing the tree following the delete operation easier. */+ if( !pPage->leaf ){+ int notUsed = 0;+ rc = sqlite3BtreePrevious(pCur, ¬Used);+ if( rc ) return rc;+ }++ /* Save the positions of any other cursors open on this table before+ ** making any modifications. */+ if( pCur->curFlags & BTCF_Multiple ){+ rc = saveAllCursors(pBt, pCur->pgnoRoot, pCur);+ if( rc ) return rc;+ }++ /* If this is a delete operation to remove a row from a table b-tree,+ ** invalidate any incrblob cursors open on the row being deleted. */+ if( pCur->pKeyInfo==0 ){+ invalidateIncrblobCursors(p, pCur->info.nKey, 0);+ }++ /* If the bPreserve flag is set to true, then the cursor position must+ ** be preserved following this delete operation. If the current delete+ ** will cause a b-tree rebalance, then this is done by saving the cursor+ ** key and leaving the cursor in CURSOR_REQUIRESEEK state before + ** returning. + **+ ** Or, if the current delete will not cause a rebalance, then the cursor+ ** will be left in CURSOR_SKIPNEXT state pointing to the entry immediately+ ** before or after the deleted entry. In this case set bSkipnext to true. */+ if( bPreserve ){+ if( !pPage->leaf + || (pPage->nFree+cellSizePtr(pPage,pCell)+2)>(int)(pBt->usableSize*2/3)+ ){+ /* A b-tree rebalance will be required after deleting this entry.+ ** Save the cursor key. */+ rc = saveCursorKey(pCur);+ if( rc ) return rc;+ }else{+ bSkipnext = 1;+ }+ }++ /* Make the page containing the entry to be deleted writable. Then free any+ ** overflow pages associated with the entry and finally remove the cell+ ** itself from within the page. */+ rc = sqlite3PagerWrite(pPage->pDbPage);+ if( rc ) return rc;+ rc = clearCell(pPage, pCell, &szCell);+ dropCell(pPage, iCellIdx, szCell, &rc);+ if( rc ) return rc;++ /* If the cell deleted was not located on a leaf page, then the cursor+ ** is currently pointing to the largest entry in the sub-tree headed+ ** by the child-page of the cell that was just deleted from an internal+ ** node. The cell from the leaf node needs to be moved to the internal+ ** node to replace the deleted cell. */+ if( !pPage->leaf ){+ MemPage *pLeaf = pCur->apPage[pCur->iPage];+ int nCell;+ Pgno n = pCur->apPage[iCellDepth+1]->pgno;+ unsigned char *pTmp;++ pCell = findCell(pLeaf, pLeaf->nCell-1);+ if( pCell<&pLeaf->aData[4] ) return SQLITE_CORRUPT_BKPT;+ nCell = pLeaf->xCellSize(pLeaf, pCell);+ assert( MX_CELL_SIZE(pBt) >= nCell );+ pTmp = pBt->pTmpSpace;+ assert( pTmp!=0 );+ rc = sqlite3PagerWrite(pLeaf->pDbPage);+ insertCell(pPage, iCellIdx, pCell-4, nCell+4, pTmp, n, &rc);+ dropCell(pLeaf, pLeaf->nCell-1, nCell, &rc);+ if( rc ) return rc;+ }++ /* Balance the tree. If the entry deleted was located on a leaf page,+ ** then the cursor still points to that page. In this case the first+ ** call to balance() repairs the tree, and the if(...) condition is+ ** never true.+ **+ ** Otherwise, if the entry deleted was on an internal node page, then+ ** pCur is pointing to the leaf page from which a cell was removed to+ ** replace the cell deleted from the internal node. This is slightly+ ** tricky as the leaf node may be underfull, and the internal node may+ ** be either under or overfull. In this case run the balancing algorithm+ ** on the leaf node first. If the balance proceeds far enough up the+ ** tree that we can be sure that any problem in the internal node has+ ** been corrected, so be it. Otherwise, after balancing the leaf node,+ ** walk the cursor up the tree to the internal node and balance it as + ** well. */+ rc = balance(pCur);+ if( rc==SQLITE_OK && pCur->iPage>iCellDepth ){+ while( pCur->iPage>iCellDepth ){+ releasePage(pCur->apPage[pCur->iPage--]);+ }+ rc = balance(pCur);+ }++ if( rc==SQLITE_OK ){+ if( bSkipnext ){+ assert( bPreserve && pCur->iPage==iCellDepth );+ assert( pPage==pCur->apPage[pCur->iPage] );+ assert( (pPage->nCell>0 || CORRUPT_DB) && iCellIdx<=pPage->nCell );+ pCur->eState = CURSOR_SKIPNEXT;+ if( iCellIdx>=pPage->nCell ){+ pCur->skipNext = -1;+ pCur->aiIdx[iCellDepth] = pPage->nCell-1;+ }else{+ pCur->skipNext = 1;+ }+ }else{+ rc = moveToRoot(pCur);+ if( bPreserve ){+ pCur->eState = CURSOR_REQUIRESEEK;+ }+ }+ }+ return rc;+}++/*+** Create a new BTree table. Write into *piTable the page+** number for the root page of the new table.+**+** The type of type is determined by the flags parameter. Only the+** following values of flags are currently in use. Other values for+** flags might not work:+**+** BTREE_INTKEY|BTREE_LEAFDATA Used for SQL tables with rowid keys+** BTREE_ZERODATA Used for SQL indices+*/+static int btreeCreateTable(Btree *p, int *piTable, int createTabFlags){+ BtShared *pBt = p->pBt;+ MemPage *pRoot;+ Pgno pgnoRoot;+ int rc;+ int ptfFlags; /* Page-type flage for the root page of new table */++ assert( sqlite3BtreeHoldsMutex(p) );+ assert( pBt->inTransaction==TRANS_WRITE );+ assert( (pBt->btsFlags & BTS_READ_ONLY)==0 );++#ifdef SQLITE_OMIT_AUTOVACUUM+ rc = allocateBtreePage(pBt, &pRoot, &pgnoRoot, 1, 0);+ if( rc ){+ return rc;+ }+#else+ if( pBt->autoVacuum ){+ Pgno pgnoMove; /* Move a page here to make room for the root-page */+ MemPage *pPageMove; /* The page to move to. */++ /* Creating a new table may probably require moving an existing database+ ** to make room for the new tables root page. In case this page turns+ ** out to be an overflow page, delete all overflow page-map caches+ ** held by open cursors.+ */+ invalidateAllOverflowCache(pBt);++ /* Read the value of meta[3] from the database to determine where the+ ** root page of the new table should go. meta[3] is the largest root-page+ ** created so far, so the new root-page is (meta[3]+1).+ */+ sqlite3BtreeGetMeta(p, BTREE_LARGEST_ROOT_PAGE, &pgnoRoot);+ pgnoRoot++;++ /* The new root-page may not be allocated on a pointer-map page, or the+ ** PENDING_BYTE page.+ */+ while( pgnoRoot==PTRMAP_PAGENO(pBt, pgnoRoot) ||+ pgnoRoot==PENDING_BYTE_PAGE(pBt) ){+ pgnoRoot++;+ }+ assert( pgnoRoot>=3 || CORRUPT_DB );+ testcase( pgnoRoot<3 );++ /* Allocate a page. The page that currently resides at pgnoRoot will+ ** be moved to the allocated page (unless the allocated page happens+ ** to reside at pgnoRoot).+ */+ rc = allocateBtreePage(pBt, &pPageMove, &pgnoMove, pgnoRoot, BTALLOC_EXACT);+ if( rc!=SQLITE_OK ){+ return rc;+ }++ if( pgnoMove!=pgnoRoot ){+ /* pgnoRoot is the page that will be used for the root-page of+ ** the new table (assuming an error did not occur). But we were+ ** allocated pgnoMove. If required (i.e. if it was not allocated+ ** by extending the file), the current page at position pgnoMove+ ** is already journaled.+ */+ u8 eType = 0;+ Pgno iPtrPage = 0;++ /* Save the positions of any open cursors. This is required in+ ** case they are holding a reference to an xFetch reference+ ** corresponding to page pgnoRoot. */+ rc = saveAllCursors(pBt, 0, 0);+ releasePage(pPageMove);+ if( rc!=SQLITE_OK ){+ return rc;+ }++ /* Move the page currently at pgnoRoot to pgnoMove. */+ rc = btreeGetPage(pBt, pgnoRoot, &pRoot, 0);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ rc = ptrmapGet(pBt, pgnoRoot, &eType, &iPtrPage);+ if( eType==PTRMAP_ROOTPAGE || eType==PTRMAP_FREEPAGE ){+ rc = SQLITE_CORRUPT_BKPT;+ }+ if( rc!=SQLITE_OK ){+ releasePage(pRoot);+ return rc;+ }+ assert( eType!=PTRMAP_ROOTPAGE );+ assert( eType!=PTRMAP_FREEPAGE );+ rc = relocatePage(pBt, pRoot, eType, iPtrPage, pgnoMove, 0);+ releasePage(pRoot);++ /* Obtain the page at pgnoRoot */+ if( rc!=SQLITE_OK ){+ return rc;+ }+ rc = btreeGetPage(pBt, pgnoRoot, &pRoot, 0);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ rc = sqlite3PagerWrite(pRoot->pDbPage);+ if( rc!=SQLITE_OK ){+ releasePage(pRoot);+ return rc;+ }+ }else{+ pRoot = pPageMove;+ } ++ /* Update the pointer-map and meta-data with the new root-page number. */+ ptrmapPut(pBt, pgnoRoot, PTRMAP_ROOTPAGE, 0, &rc);+ if( rc ){+ releasePage(pRoot);+ return rc;+ }++ /* When the new root page was allocated, page 1 was made writable in+ ** order either to increase the database filesize, or to decrement the+ ** freelist count. Hence, the sqlite3BtreeUpdateMeta() call cannot fail.+ */+ assert( sqlite3PagerIswriteable(pBt->pPage1->pDbPage) );+ rc = sqlite3BtreeUpdateMeta(p, 4, pgnoRoot);+ if( NEVER(rc) ){+ releasePage(pRoot);+ return rc;+ }++ }else{+ rc = allocateBtreePage(pBt, &pRoot, &pgnoRoot, 1, 0);+ if( rc ) return rc;+ }+#endif+ assert( sqlite3PagerIswriteable(pRoot->pDbPage) );+ if( createTabFlags & BTREE_INTKEY ){+ ptfFlags = PTF_INTKEY | PTF_LEAFDATA | PTF_LEAF;+ }else{+ ptfFlags = PTF_ZERODATA | PTF_LEAF;+ }+ zeroPage(pRoot, ptfFlags);+ sqlite3PagerUnref(pRoot->pDbPage);+ assert( (pBt->openFlags & BTREE_SINGLE)==0 || pgnoRoot==2 );+ *piTable = (int)pgnoRoot;+ return SQLITE_OK;+}+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCreateTable(Btree *p, int *piTable, int flags){+ int rc;+ sqlite3BtreeEnter(p);+ rc = btreeCreateTable(p, piTable, flags);+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** Erase the given database page and all its children. Return+** the page to the freelist.+*/+static int clearDatabasePage(+ BtShared *pBt, /* The BTree that contains the table */+ Pgno pgno, /* Page number to clear */+ int freePageFlag, /* Deallocate page if true */+ int *pnChange /* Add number of Cells freed to this counter */+){+ MemPage *pPage;+ int rc;+ unsigned char *pCell;+ int i;+ int hdr;+ u16 szCell;++ assert( sqlite3_mutex_held(pBt->mutex) );+ if( pgno>btreePagecount(pBt) ){+ return SQLITE_CORRUPT_BKPT;+ }+ rc = getAndInitPage(pBt, pgno, &pPage, 0, 0);+ if( rc ) return rc;+ if( pPage->bBusy ){+ rc = SQLITE_CORRUPT_BKPT;+ goto cleardatabasepage_out;+ }+ pPage->bBusy = 1;+ hdr = pPage->hdrOffset;+ for(i=0; i<pPage->nCell; i++){+ pCell = findCell(pPage, i);+ if( !pPage->leaf ){+ rc = clearDatabasePage(pBt, get4byte(pCell), 1, pnChange);+ if( rc ) goto cleardatabasepage_out;+ }+ rc = clearCell(pPage, pCell, &szCell);+ if( rc ) goto cleardatabasepage_out;+ }+ if( !pPage->leaf ){+ rc = clearDatabasePage(pBt, get4byte(&pPage->aData[hdr+8]), 1, pnChange);+ if( rc ) goto cleardatabasepage_out;+ }else if( pnChange ){+ assert( pPage->intKey || CORRUPT_DB );+ testcase( !pPage->intKey );+ *pnChange += pPage->nCell;+ }+ if( freePageFlag ){+ freePage(pPage, &rc);+ }else if( (rc = sqlite3PagerWrite(pPage->pDbPage))==0 ){+ zeroPage(pPage, pPage->aData[hdr] | PTF_LEAF);+ }++cleardatabasepage_out:+ pPage->bBusy = 0;+ releasePage(pPage);+ return rc;+}++/*+** Delete all information from a single table in the database. iTable is+** the page number of the root of the table. After this routine returns,+** the root page is empty, but still exists.+**+** This routine will fail with SQLITE_LOCKED if there are any open+** read cursors on the table. Open write cursors are moved to the+** root of the table.+**+** If pnChange is not NULL, then table iTable must be an intkey table. The+** integer value pointed to by pnChange is incremented by the number of+** entries in the table.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeClearTable(Btree *p, int iTable, int *pnChange){+ int rc;+ BtShared *pBt = p->pBt;+ sqlite3BtreeEnter(p);+ assert( p->inTrans==TRANS_WRITE );++ rc = saveAllCursors(pBt, (Pgno)iTable, 0);++ if( SQLITE_OK==rc ){+ /* Invalidate all incrblob cursors open on table iTable (assuming iTable+ ** is the root of a table b-tree - if it is not, the following call is+ ** a no-op). */+ invalidateIncrblobCursors(p, 0, 1);+ rc = clearDatabasePage(pBt, (Pgno)iTable, 0, pnChange);+ }+ sqlite3BtreeLeave(p);+ return rc;+}++/*+** Delete all information from the single table that pCur is open on.+**+** This routine only work for pCur on an ephemeral table.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeClearTableOfCursor(BtCursor *pCur){+ return sqlite3BtreeClearTable(pCur->pBtree, pCur->pgnoRoot, 0);+}++/*+** Erase all information in a table and add the root of the table to+** the freelist. Except, the root of the principle table (the one on+** page 1) is never added to the freelist.+**+** This routine will fail with SQLITE_LOCKED if there are any open+** cursors on the table.+**+** If AUTOVACUUM is enabled and the page at iTable is not the last+** root page in the database file, then the last root page +** in the database file is moved into the slot formerly occupied by+** iTable and that last slot formerly occupied by the last root page+** is added to the freelist instead of iTable. In this say, all+** root pages are kept at the beginning of the database file, which+** is necessary for AUTOVACUUM to work right. *piMoved is set to the +** page number that used to be the last root page in the file before+** the move. If no page gets moved, *piMoved is set to 0.+** The last root page is recorded in meta[3] and the value of+** meta[3] is updated by this procedure.+*/+static int btreeDropTable(Btree *p, Pgno iTable, int *piMoved){+ int rc;+ MemPage *pPage = 0;+ BtShared *pBt = p->pBt;++ assert( sqlite3BtreeHoldsMutex(p) );+ assert( p->inTrans==TRANS_WRITE );++ /* It is illegal to drop a table if any cursors are open on the+ ** database. This is because in auto-vacuum mode the backend may+ ** need to move another root-page to fill a gap left by the deleted+ ** root page. If an open cursor was using this page a problem would + ** occur.+ **+ ** This error is caught long before control reaches this point.+ */+ if( NEVER(pBt->pCursor) ){+ sqlite3ConnectionBlocked(p->db, pBt->pCursor->pBtree->db);+ return SQLITE_LOCKED_SHAREDCACHE;+ }++ rc = btreeGetPage(pBt, (Pgno)iTable, &pPage, 0);+ if( rc ) return rc;+ rc = sqlite3BtreeClearTable(p, iTable, 0);+ if( rc ){+ releasePage(pPage);+ return rc;+ }++ *piMoved = 0;++ if( iTable>1 ){+#ifdef SQLITE_OMIT_AUTOVACUUM+ freePage(pPage, &rc);+ releasePage(pPage);+#else+ if( pBt->autoVacuum ){+ Pgno maxRootPgno;+ sqlite3BtreeGetMeta(p, BTREE_LARGEST_ROOT_PAGE, &maxRootPgno);++ if( iTable==maxRootPgno ){+ /* If the table being dropped is the table with the largest root-page+ ** number in the database, put the root page on the free list. + */+ freePage(pPage, &rc);+ releasePage(pPage);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ }else{+ /* The table being dropped does not have the largest root-page+ ** number in the database. So move the page that does into the + ** gap left by the deleted root-page.+ */+ MemPage *pMove;+ releasePage(pPage);+ rc = btreeGetPage(pBt, maxRootPgno, &pMove, 0);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ rc = relocatePage(pBt, pMove, PTRMAP_ROOTPAGE, 0, iTable, 0);+ releasePage(pMove);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ pMove = 0;+ rc = btreeGetPage(pBt, maxRootPgno, &pMove, 0);+ freePage(pMove, &rc);+ releasePage(pMove);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ *piMoved = maxRootPgno;+ }++ /* Set the new 'max-root-page' value in the database header. This+ ** is the old value less one, less one more if that happens to+ ** be a root-page number, less one again if that is the+ ** PENDING_BYTE_PAGE.+ */+ maxRootPgno--;+ while( maxRootPgno==PENDING_BYTE_PAGE(pBt)+ || PTRMAP_ISPAGE(pBt, maxRootPgno) ){+ maxRootPgno--;+ }+ assert( maxRootPgno!=PENDING_BYTE_PAGE(pBt) );++ rc = sqlite3BtreeUpdateMeta(p, 4, maxRootPgno);+ }else{+ freePage(pPage, &rc);+ releasePage(pPage);+ }+#endif+ }else{+ /* If sqlite3BtreeDropTable was called on page 1.+ ** This really never should happen except in a corrupt+ ** database. + */+ zeroPage(pPage, PTF_INTKEY|PTF_LEAF );+ releasePage(pPage);+ }+ return rc; +}+SQLITE_API int SQLITE_STDCALL sqlite3BtreeDropTable(Btree *p, int iTable, int *piMoved){+ int rc;+ sqlite3BtreeEnter(p);+ rc = btreeDropTable(p, iTable, piMoved);+ sqlite3BtreeLeave(p);+ return rc;+}+++/*+** This function may only be called if the b-tree connection already+** has a read or write transaction open on the database.+**+** Read the meta-information out of a database file. Meta[0]+** is the number of free pages currently in the database. Meta[1]+** through meta[15] are available for use by higher layers. Meta[0]+** is read-only, the others are read/write.+** +** The schema layer numbers meta values differently. At the schema+** layer (and the SetCookie and ReadCookie opcodes) the number of+** free pages is not visible. So Cookie[0] is the same as Meta[1].+**+** This routine treats Meta[BTREE_DATA_VERSION] as a special case. Instead+** of reading the value out of the header, it instead loads the "DataVersion"+** from the pager. The BTREE_DATA_VERSION value is not actually stored in the+** database file. It is a number computed by the pager. But its access+** pattern is the same as header meta values, and so it is convenient to+** read it from this routine.+*/+SQLITE_API void SQLITE_STDCALL sqlite3BtreeGetMeta(Btree *p, int idx, u32 *pMeta){+ BtShared *pBt = p->pBt;++ sqlite3BtreeEnter(p);+ assert( p->inTrans>TRANS_NONE );+ assert( SQLITE_OK==querySharedCacheTableLock(p, MASTER_ROOT, READ_LOCK) );+ assert( pBt->pPage1 );+ assert( idx>=0 && idx<=15 );++ if( idx==BTREE_DATA_VERSION ){+ *pMeta = sqlite3PagerDataVersion(pBt->pPager) + p->iDataVersion;+ }else{+ *pMeta = get4byte(&pBt->pPage1->aData[36 + idx*4]);+ }++ /* If auto-vacuum is disabled in this build and this is an auto-vacuum+ ** database, mark the database as read-only. */+#ifdef SQLITE_OMIT_AUTOVACUUM+ if( idx==BTREE_LARGEST_ROOT_PAGE && *pMeta>0 ){+ pBt->btsFlags |= BTS_READ_ONLY;+ }+#endif++ sqlite3BtreeLeave(p);+}++/*+** Write meta-information back into the database. Meta[0] is+** read-only and may not be written.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeUpdateMeta(Btree *p, int idx, u32 iMeta){+ BtShared *pBt = p->pBt;+ unsigned char *pP1;+ int rc;+ assert( idx>=1 && idx<=15 );+ sqlite3BtreeEnter(p);+ assert( p->inTrans==TRANS_WRITE );+ assert( pBt->pPage1!=0 );+ pP1 = pBt->pPage1->aData;+ rc = sqlite3PagerWrite(pBt->pPage1->pDbPage);+ if( rc==SQLITE_OK ){+ put4byte(&pP1[36 + idx*4], iMeta);+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( idx==BTREE_INCR_VACUUM ){+ assert( pBt->autoVacuum || iMeta==0 );+ assert( iMeta==0 || iMeta==1 );+ pBt->incrVacuum = (u8)iMeta;+ }+#endif+ }+ sqlite3BtreeLeave(p);+ return rc;+}++#ifndef SQLITE_OMIT_BTREECOUNT+/*+** The first argument, pCur, is a cursor opened on some b-tree. Count the+** number of entries in the b-tree and write the result to *pnEntry.+**+** SQLITE_OK is returned if the operation is successfully executed. +** Otherwise, if an error is encountered (i.e. an IO error or database+** corruption) an SQLite error code is returned.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCount(BtCursor *pCur, i64 *pnEntry){+ i64 nEntry = 0; /* Value to return in *pnEntry */+ int rc; /* Return code */++ if( pCur->pgnoRoot==0 ){+ *pnEntry = 0;+ return SQLITE_OK;+ }+ rc = moveToRoot(pCur);++ /* Unless an error occurs, the following loop runs one iteration for each+ ** page in the B-Tree structure (not including overflow pages). + */+ while( rc==SQLITE_OK ){+ int iIdx; /* Index of child node in parent */+ MemPage *pPage; /* Current page of the b-tree */++ /* If this is a leaf page or the tree is not an int-key tree, then + ** this page contains countable entries. Increment the entry counter+ ** accordingly.+ */+ pPage = pCur->apPage[pCur->iPage];+ if( pPage->leaf || !pPage->intKey ){+ nEntry += pPage->nCell;+ }++ /* pPage is a leaf node. This loop navigates the cursor so that it + ** points to the first interior cell that it points to the parent of+ ** the next page in the tree that has not yet been visited. The+ ** pCur->aiIdx[pCur->iPage] value is set to the index of the parent cell+ ** of the page, or to the number of cells in the page if the next page+ ** to visit is the right-child of its parent.+ **+ ** If all pages in the tree have been visited, return SQLITE_OK to the+ ** caller.+ */+ if( pPage->leaf ){+ do {+ if( pCur->iPage==0 ){+ /* All pages of the b-tree have been visited. Return successfully. */+ *pnEntry = nEntry;+ return moveToRoot(pCur);+ }+ moveToParent(pCur);+ }while ( pCur->aiIdx[pCur->iPage]>=pCur->apPage[pCur->iPage]->nCell );++ pCur->aiIdx[pCur->iPage]++;+ pPage = pCur->apPage[pCur->iPage];+ }++ /* Descend to the child node of the cell that the cursor currently + ** points at. This is the right-child if (iIdx==pPage->nCell).+ */+ iIdx = pCur->aiIdx[pCur->iPage];+ if( iIdx==pPage->nCell ){+ rc = moveToChild(pCur, get4byte(&pPage->aData[pPage->hdrOffset+8]));+ }else{+ rc = moveToChild(pCur, get4byte(findCell(pPage, iIdx)));+ }+ }++ /* An error has occurred. Return an error code. */+ return rc;+}+#endif++/*+** Return the pager associated with a BTree. This routine is used for+** testing and debugging only.+*/+SQLITE_API Pager *SQLITE_STDCALL sqlite3BtreePager(Btree *p){+ return p->pBt->pPager;+}++#ifndef SQLITE_OMIT_INTEGRITY_CHECK+/*+** Append a message to the error message string.+*/+static void checkAppendMsg(+ IntegrityCk *pCheck,+ const char *zFormat,+ ...+){+ va_list ap;+ if( !pCheck->mxErr ) return;+ pCheck->mxErr--;+ pCheck->nErr++;+ va_start(ap, zFormat);+ if( pCheck->errMsg.nChar ){+ sqlite3StrAccumAppend(&pCheck->errMsg, "\n", 1);+ }+ if( pCheck->zPfx ){+ sqlite3XPrintf(&pCheck->errMsg, 0, pCheck->zPfx, pCheck->v1, pCheck->v2);+ }+ sqlite3VXPrintf(&pCheck->errMsg, 1, zFormat, ap);+ va_end(ap);+ if( pCheck->errMsg.accError==STRACCUM_NOMEM ){+ pCheck->mallocFailed = 1;+ }+}+#endif /* SQLITE_OMIT_INTEGRITY_CHECK */++#ifndef SQLITE_OMIT_INTEGRITY_CHECK++/*+** Return non-zero if the bit in the IntegrityCk.aPgRef[] array that+** corresponds to page iPg is already set.+*/+static int getPageReferenced(IntegrityCk *pCheck, Pgno iPg){+ assert( iPg<=pCheck->nPage && sizeof(pCheck->aPgRef[0])==1 );+ return (pCheck->aPgRef[iPg/8] & (1 << (iPg & 0x07)));+}++/*+** Set the bit in the IntegrityCk.aPgRef[] array that corresponds to page iPg.+*/+static void setPageReferenced(IntegrityCk *pCheck, Pgno iPg){+ assert( iPg<=pCheck->nPage && sizeof(pCheck->aPgRef[0])==1 );+ pCheck->aPgRef[iPg/8] |= (1 << (iPg & 0x07));+}+++/*+** Add 1 to the reference count for page iPage. If this is the second+** reference to the page, add an error message to pCheck->zErrMsg.+** Return 1 if there are 2 or more references to the page and 0 if+** if this is the first reference to the page.+**+** Also check that the page number is in bounds.+*/+static int checkRef(IntegrityCk *pCheck, Pgno iPage){+ if( iPage==0 ) return 1;+ if( iPage>pCheck->nPage ){+ checkAppendMsg(pCheck, "invalid page number %d", iPage);+ return 1;+ }+ if( getPageReferenced(pCheck, iPage) ){+ checkAppendMsg(pCheck, "2nd reference to page %d", iPage);+ return 1;+ }+ setPageReferenced(pCheck, iPage);+ return 0;+}++#ifndef SQLITE_OMIT_AUTOVACUUM+/*+** Check that the entry in the pointer-map for page iChild maps to +** page iParent, pointer type ptrType. If not, append an error message+** to pCheck.+*/+static void checkPtrmap(+ IntegrityCk *pCheck, /* Integrity check context */+ Pgno iChild, /* Child page number */+ u8 eType, /* Expected pointer map type */+ Pgno iParent /* Expected pointer map parent page number */+){+ int rc;+ u8 ePtrmapType;+ Pgno iPtrmapParent;++ rc = ptrmapGet(pCheck->pBt, iChild, &ePtrmapType, &iPtrmapParent);+ if( rc!=SQLITE_OK ){+ if( rc==SQLITE_NOMEM || rc==SQLITE_IOERR_NOMEM ) pCheck->mallocFailed = 1;+ checkAppendMsg(pCheck, "Failed to read ptrmap key=%d", iChild);+ return;+ }++ if( ePtrmapType!=eType || iPtrmapParent!=iParent ){+ checkAppendMsg(pCheck,+ "Bad ptr map entry key=%d expected=(%d,%d) got=(%d,%d)", + iChild, eType, iParent, ePtrmapType, iPtrmapParent);+ }+}+#endif++/*+** Check the integrity of the freelist or of an overflow page list.+** Verify that the number of pages on the list is N.+*/+static void checkList(+ IntegrityCk *pCheck, /* Integrity checking context */+ int isFreeList, /* True for a freelist. False for overflow page list */+ int iPage, /* Page number for first page in the list */+ int N /* Expected number of pages in the list */+){+ int i;+ int expected = N;+ int iFirst = iPage;+ while( N-- > 0 && pCheck->mxErr ){+ DbPage *pOvflPage;+ unsigned char *pOvflData;+ if( iPage<1 ){+ checkAppendMsg(pCheck,+ "%d of %d pages missing from overflow list starting at %d",+ N+1, expected, iFirst);+ break;+ }+ if( checkRef(pCheck, iPage) ) break;+ if( sqlite3PagerGet(pCheck->pPager, (Pgno)iPage, &pOvflPage) ){+ checkAppendMsg(pCheck, "failed to get page %d", iPage);+ break;+ }+ pOvflData = (unsigned char *)sqlite3PagerGetData(pOvflPage);+ if( isFreeList ){+ int n = get4byte(&pOvflData[4]);+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pCheck->pBt->autoVacuum ){+ checkPtrmap(pCheck, iPage, PTRMAP_FREEPAGE, 0);+ }+#endif+ if( n>(int)pCheck->pBt->usableSize/4-2 ){+ checkAppendMsg(pCheck,+ "freelist leaf count too big on page %d", iPage);+ N--;+ }else{+ for(i=0; i<n; i++){+ Pgno iFreePage = get4byte(&pOvflData[8+i*4]);+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pCheck->pBt->autoVacuum ){+ checkPtrmap(pCheck, iFreePage, PTRMAP_FREEPAGE, 0);+ }+#endif+ checkRef(pCheck, iFreePage);+ }+ N -= n;+ }+ }+#ifndef SQLITE_OMIT_AUTOVACUUM+ else{+ /* If this database supports auto-vacuum and iPage is not the last+ ** page in this overflow list, check that the pointer-map entry for+ ** the following page matches iPage.+ */+ if( pCheck->pBt->autoVacuum && N>0 ){+ i = get4byte(pOvflData);+ checkPtrmap(pCheck, i, PTRMAP_OVERFLOW2, iPage);+ }+ }+#endif+ iPage = get4byte(pOvflData);+ sqlite3PagerUnref(pOvflPage);++ if( isFreeList && N<(iPage!=0) ){+ checkAppendMsg(pCheck, "free-page count in header is too small");+ }+ }+}+#endif /* SQLITE_OMIT_INTEGRITY_CHECK */++/*+** An implementation of a min-heap.+**+** aHeap[0] is the number of elements on the heap. aHeap[1] is the+** root element. The daughter nodes of aHeap[N] are aHeap[N*2]+** and aHeap[N*2+1].+**+** The heap property is this: Every node is less than or equal to both+** of its daughter nodes. A consequence of the heap property is that the+** root node aHeap[1] is always the minimum value currently in the heap.+**+** The btreeHeapInsert() routine inserts an unsigned 32-bit number onto+** the heap, preserving the heap property. The btreeHeapPull() routine+** removes the root element from the heap (the minimum value in the heap)+** and then moves other nodes around as necessary to preserve the heap+** property.+**+** This heap is used for cell overlap and coverage testing. Each u32+** entry represents the span of a cell or freeblock on a btree page. +** The upper 16 bits are the index of the first byte of a range and the+** lower 16 bits are the index of the last byte of that range.+*/+static void btreeHeapInsert(u32 *aHeap, u32 x){+ u32 j, i = ++aHeap[0];+ aHeap[i] = x;+ while( (j = i/2)>0 && aHeap[j]>aHeap[i] ){+ x = aHeap[j];+ aHeap[j] = aHeap[i];+ aHeap[i] = x;+ i = j;+ }+}+static int btreeHeapPull(u32 *aHeap, u32 *pOut){+ u32 j, i, x;+ if( (x = aHeap[0])==0 ) return 0;+ *pOut = aHeap[1];+ aHeap[1] = aHeap[x];+ aHeap[x] = 0xffffffff;+ aHeap[0]--;+ i = 1;+ while( (j = i*2)<=aHeap[0] ){+ if( aHeap[j]>aHeap[j+1] ) j++;+ if( aHeap[i]<aHeap[j] ) break;+ x = aHeap[i];+ aHeap[i] = aHeap[j];+ aHeap[j] = x;+ i = j;+ }+ return 1; +}++#ifndef SQLITE_OMIT_INTEGRITY_CHECK+/*+** Do various sanity checks on a single page of a tree. Return+** the tree depth. Root pages return 0. Parents of root pages+** return 1, and so forth.+** +** These checks are done:+**+** 1. Make sure that cells and freeblocks do not overlap+** but combine to completely cover the page.+** 2. Make sure integer cell keys are in order.+** 3. Check the integrity of overflow pages.+** 4. Recursively call checkTreePage on all children.+** 5. Verify that the depth of all children is the same.+*/+static int checkTreePage(+ IntegrityCk *pCheck, /* Context for the sanity check */+ int iPage, /* Page number of the page to check */+ i64 *piMinKey, /* Write minimum integer primary key here */+ i64 maxKey /* Error if integer primary key greater than this */+){+ MemPage *pPage = 0; /* The page being analyzed */+ int i; /* Loop counter */+ int rc; /* Result code from subroutine call */+ int depth = -1, d2; /* Depth of a subtree */+ int pgno; /* Page number */+ int nFrag; /* Number of fragmented bytes on the page */+ int hdr; /* Offset to the page header */+ int cellStart; /* Offset to the start of the cell pointer array */+ int nCell; /* Number of cells */+ int doCoverageCheck = 1; /* True if cell coverage checking should be done */+ int keyCanBeEqual = 1; /* True if IPK can be equal to maxKey+ ** False if IPK must be strictly less than maxKey */+ u8 *data; /* Page content */+ u8 *pCell; /* Cell content */+ u8 *pCellIdx; /* Next element of the cell pointer array */+ BtShared *pBt; /* The BtShared object that owns pPage */+ u32 pc; /* Address of a cell */+ u32 usableSize; /* Usable size of the page */+ u32 contentOffset; /* Offset to the start of the cell content area */+ u32 *heap = 0; /* Min-heap used for checking cell coverage */+ u32 x, prev = 0; /* Next and previous entry on the min-heap */+ const char *saved_zPfx = pCheck->zPfx;+ int saved_v1 = pCheck->v1;+ int saved_v2 = pCheck->v2;+ u8 savedIsInit = 0;++ /* Check that the page exists+ */+ pBt = pCheck->pBt;+ usableSize = pBt->usableSize;+ if( iPage==0 ) return 0;+ if( checkRef(pCheck, iPage) ) return 0;+ pCheck->zPfx = "Page %d: ";+ pCheck->v1 = iPage;+ if( (rc = btreeGetPage(pBt, (Pgno)iPage, &pPage, 0))!=0 ){+ checkAppendMsg(pCheck,+ "unable to get the page. error code=%d", rc);+ goto end_of_check;+ }++ /* Clear MemPage.isInit to make sure the corruption detection code in+ ** btreeInitPage() is executed. */+ savedIsInit = pPage->isInit;+ pPage->isInit = 0;+ if( (rc = btreeInitPage(pPage))!=0 ){+ assert( rc==SQLITE_CORRUPT ); /* The only possible error from InitPage */+ checkAppendMsg(pCheck,+ "btreeInitPage() returns error code %d", rc);+ goto end_of_check;+ }+ data = pPage->aData;+ hdr = pPage->hdrOffset;++ /* Set up for cell analysis */+ pCheck->zPfx = "On tree page %d cell %d: ";+ contentOffset = get2byteNotZero(&data[hdr+5]);+ assert( contentOffset<=usableSize ); /* Enforced by btreeInitPage() */++ /* EVIDENCE-OF: R-37002-32774 The two-byte integer at offset 3 gives the+ ** number of cells on the page. */+ nCell = get2byte(&data[hdr+3]);+ assert( pPage->nCell==nCell );++ /* EVIDENCE-OF: R-23882-45353 The cell pointer array of a b-tree page+ ** immediately follows the b-tree page header. */+ cellStart = hdr + 12 - 4*pPage->leaf;+ assert( pPage->aCellIdx==&data[cellStart] );+ pCellIdx = &data[cellStart + 2*(nCell-1)];++ if( !pPage->leaf ){+ /* Analyze the right-child page of internal pages */+ pgno = get4byte(&data[hdr+8]);+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pBt->autoVacuum ){+ pCheck->zPfx = "On page %d at right child: ";+ checkPtrmap(pCheck, pgno, PTRMAP_BTREE, iPage);+ }+#endif+ depth = checkTreePage(pCheck, pgno, &maxKey, maxKey);+ keyCanBeEqual = 0;+ }else{+ /* For leaf pages, the coverage check will occur in the same loop+ ** as the other cell checks, so initialize the heap. */+ heap = pCheck->heap;+ heap[0] = 0;+ }++ /* EVIDENCE-OF: R-02776-14802 The cell pointer array consists of K 2-byte+ ** integer offsets to the cell contents. */+ for(i=nCell-1; i>=0 && pCheck->mxErr; i--){+ CellInfo info;++ /* Check cell size */+ pCheck->v2 = i;+ assert( pCellIdx==&data[cellStart + i*2] );+ pc = get2byteAligned(pCellIdx);+ pCellIdx -= 2;+ if( pc<contentOffset || pc>usableSize-4 ){+ checkAppendMsg(pCheck, "Offset %d out of range %d..%d",+ pc, contentOffset, usableSize-4);+ doCoverageCheck = 0;+ continue;+ }+ pCell = &data[pc];+ pPage->xParseCell(pPage, pCell, &info);+ if( pc+info.nSize>usableSize ){+ checkAppendMsg(pCheck, "Extends off end of page");+ doCoverageCheck = 0;+ continue;+ }++ /* Check for integer primary key out of range */+ if( pPage->intKey ){+ if( keyCanBeEqual ? (info.nKey > maxKey) : (info.nKey >= maxKey) ){+ checkAppendMsg(pCheck, "Rowid %lld out of order", info.nKey);+ }+ maxKey = info.nKey;+ }++ /* Check the content overflow list */+ if( info.nPayload>info.nLocal ){+ int nPage; /* Number of pages on the overflow chain */+ Pgno pgnoOvfl; /* First page of the overflow chain */+ assert( pc + info.iOverflow <= usableSize );+ nPage = (info.nPayload - info.nLocal + usableSize - 5)/(usableSize - 4);+ pgnoOvfl = get4byte(&pCell[info.iOverflow]);+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pBt->autoVacuum ){+ checkPtrmap(pCheck, pgnoOvfl, PTRMAP_OVERFLOW1, iPage);+ }+#endif+ checkList(pCheck, 0, pgnoOvfl, nPage);+ }++ if( !pPage->leaf ){+ /* Check sanity of left child page for internal pages */+ pgno = get4byte(pCell);+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pBt->autoVacuum ){+ checkPtrmap(pCheck, pgno, PTRMAP_BTREE, iPage);+ }+#endif+ d2 = checkTreePage(pCheck, pgno, &maxKey, maxKey);+ keyCanBeEqual = 0;+ if( d2!=depth ){+ checkAppendMsg(pCheck, "Child page depth differs");+ depth = d2;+ }+ }else{+ /* Populate the coverage-checking heap for leaf pages */+ btreeHeapInsert(heap, (pc<<16)|(pc+info.nSize-1));+ }+ }+ *piMinKey = maxKey;++ /* Check for complete coverage of the page+ */+ pCheck->zPfx = 0;+ if( doCoverageCheck && pCheck->mxErr>0 ){+ /* For leaf pages, the min-heap has already been initialized and the+ ** cells have already been inserted. But for internal pages, that has+ ** not yet been done, so do it now */+ if( !pPage->leaf ){+ heap = pCheck->heap;+ heap[0] = 0;+ for(i=nCell-1; i>=0; i--){+ u32 size;+ pc = get2byteAligned(&data[cellStart+i*2]);+ size = pPage->xCellSize(pPage, &data[pc]);+ btreeHeapInsert(heap, (pc<<16)|(pc+size-1));+ }+ }+ /* Add the freeblocks to the min-heap+ **+ ** EVIDENCE-OF: R-20690-50594 The second field of the b-tree page header+ ** is the offset of the first freeblock, or zero if there are no+ ** freeblocks on the page. + */+ i = get2byte(&data[hdr+1]);+ while( i>0 ){+ int size, j;+ assert( (u32)i<=usableSize-4 ); /* Enforced by btreeInitPage() */+ size = get2byte(&data[i+2]);+ assert( (u32)(i+size)<=usableSize ); /* Enforced by btreeInitPage() */+ btreeHeapInsert(heap, (((u32)i)<<16)|(i+size-1));+ /* EVIDENCE-OF: R-58208-19414 The first 2 bytes of a freeblock are a+ ** big-endian integer which is the offset in the b-tree page of the next+ ** freeblock in the chain, or zero if the freeblock is the last on the+ ** chain. */+ j = get2byte(&data[i]);+ /* EVIDENCE-OF: R-06866-39125 Freeblocks are always connected in order of+ ** increasing offset. */+ assert( j==0 || j>i+size ); /* Enforced by btreeInitPage() */+ assert( (u32)j<=usableSize-4 ); /* Enforced by btreeInitPage() */+ i = j;+ }+ /* Analyze the min-heap looking for overlap between cells and/or + ** freeblocks, and counting the number of untracked bytes in nFrag.+ ** + ** Each min-heap entry is of the form: (start_address<<16)|end_address.+ ** There is an implied first entry the covers the page header, the cell+ ** pointer index, and the gap between the cell pointer index and the start+ ** of cell content. + **+ ** The loop below pulls entries from the min-heap in order and compares+ ** the start_address against the previous end_address. If there is an+ ** overlap, that means bytes are used multiple times. If there is a gap,+ ** that gap is added to the fragmentation count.+ */+ nFrag = 0;+ prev = contentOffset - 1; /* Implied first min-heap entry */+ while( btreeHeapPull(heap,&x) ){+ if( (prev&0xffff)>=(x>>16) ){+ checkAppendMsg(pCheck,+ "Multiple uses for byte %u of page %d", x>>16, iPage);+ break;+ }else{+ nFrag += (x>>16) - (prev&0xffff) - 1;+ prev = x;+ }+ }+ nFrag += usableSize - (prev&0xffff) - 1;+ /* EVIDENCE-OF: R-43263-13491 The total number of bytes in all fragments+ ** is stored in the fifth field of the b-tree page header.+ ** EVIDENCE-OF: R-07161-27322 The one-byte integer at offset 7 gives the+ ** number of fragmented free bytes within the cell content area.+ */+ if( heap[0]==0 && nFrag!=data[hdr+7] ){+ checkAppendMsg(pCheck,+ "Fragmentation of %d bytes reported as %d on page %d",+ nFrag, data[hdr+7], iPage);+ }+ }++end_of_check:+ if( !doCoverageCheck ) pPage->isInit = savedIsInit;+ releasePage(pPage);+ pCheck->zPfx = saved_zPfx;+ pCheck->v1 = saved_v1;+ pCheck->v2 = saved_v2;+ return depth+1;+}+#endif /* SQLITE_OMIT_INTEGRITY_CHECK */++#ifndef SQLITE_OMIT_INTEGRITY_CHECK+/*+** This routine does a complete check of the given BTree file. aRoot[] is+** an array of pages numbers were each page number is the root page of+** a table. nRoot is the number of entries in aRoot.+**+** A read-only or read-write transaction must be opened before calling+** this function.+**+** Write the number of error seen in *pnErr. Except for some memory+** allocation errors, an error message held in memory obtained from+** malloc is returned if *pnErr is non-zero. If *pnErr==0 then NULL is+** returned. If a memory allocation error occurs, NULL is returned.+*/+SQLITE_API char *SQLITE_STDCALL sqlite3BtreeIntegrityCheck(+ Btree *p, /* The btree to be checked */+ int *aRoot, /* An array of root pages numbers for individual trees */+ int nRoot, /* Number of entries in aRoot[] */+ int mxErr, /* Stop reporting errors after this many */+ int *pnErr /* Write number of errors seen to this variable */+){+ Pgno i;+ IntegrityCk sCheck;+ BtShared *pBt = p->pBt;+ int savedDbFlags = pBt->pBt->flags;+ char zErr[100];+ VVA_ONLY( int nRef );++ sqlite3BtreeEnter(p);+ assert( p->inTrans>TRANS_NONE && pBt->inTransaction>TRANS_NONE );+ assert( (nRef = sqlite3PagerRefcount(pBt->pPager))>=0 );+ sCheck.pBt = pBt;+ sCheck.pPager = pBt->pPager;+ sCheck.nPage = btreePagecount(sCheck.pBt);+ sCheck.mxErr = mxErr;+ sCheck.nErr = 0;+ sCheck.mallocFailed = 0;+ sCheck.zPfx = 0;+ sCheck.v1 = 0;+ sCheck.v2 = 0;+ sCheck.aPgRef = 0;+ sCheck.heap = 0;+ sqlite3StrAccumInit(&sCheck.errMsg, 0, zErr, sizeof(zErr), SQLITE_MAX_LENGTH);+ if( sCheck.nPage==0 ){+ goto integrity_ck_cleanup;+ }++ sCheck.aPgRef = sqlite3MallocZero((sCheck.nPage / 8)+ 1);+ if( !sCheck.aPgRef ){+ sCheck.mallocFailed = 1;+ goto integrity_ck_cleanup;+ }+ sCheck.heap = (u32*)sqlite3PageMalloc( pBt->pageSize );+ if( sCheck.heap==0 ){+ sCheck.mallocFailed = 1;+ goto integrity_ck_cleanup;+ }++ i = PENDING_BYTE_PAGE(pBt);+ if( i<=sCheck.nPage ) setPageReferenced(&sCheck, i);++ /* Check the integrity of the freelist+ */+ sCheck.zPfx = "Main freelist: ";+ checkList(&sCheck, 1, get4byte(&pBt->pPage1->aData[32]),+ get4byte(&pBt->pPage1->aData[36]));+ sCheck.zPfx = 0;++ /* Check all the tables.+ */+ testcase( pBt->pBt->flags & SQLITE_CellSizeCk );+ pBt->pBt->flags &= ~SQLITE_CellSizeCk;+ for(i=0; (int)i<nRoot && sCheck.mxErr; i++){+ i64 notUsed;+ if( aRoot[i]==0 ) continue;+#ifndef SQLITE_OMIT_AUTOVACUUM+ if( pBt->autoVacuum && aRoot[i]>1 ){+ checkPtrmap(&sCheck, aRoot[i], PTRMAP_ROOTPAGE, 0);+ }+#endif+ checkTreePage(&sCheck, aRoot[i], ¬Used, LARGEST_INT64);+ }+ pBt->pBt->flags = savedDbFlags;++ /* Make sure every page in the file is referenced+ */+ for(i=1; i<=sCheck.nPage && sCheck.mxErr; i++){+#ifdef SQLITE_OMIT_AUTOVACUUM+ if( getPageReferenced(&sCheck, i)==0 ){+ checkAppendMsg(&sCheck, "Page %d is never used", i);+ }+#else+ /* If the database supports auto-vacuum, make sure no tables contain+ ** references to pointer-map pages.+ */+ if( getPageReferenced(&sCheck, i)==0 && + (PTRMAP_PAGENO(pBt, i)!=i || !pBt->autoVacuum) ){+ checkAppendMsg(&sCheck, "Page %d is never used", i);+ }+ if( getPageReferenced(&sCheck, i)!=0 && + (PTRMAP_PAGENO(pBt, i)==i && pBt->autoVacuum) ){+ checkAppendMsg(&sCheck, "Pointer map page %d is referenced", i);+ }+#endif+ }++ /* Clean up and report errors.+ */+integrity_ck_cleanup:+ sqlite3PageFree(sCheck.heap);+ sqlite3_free(sCheck.aPgRef);+ if( sCheck.mallocFailed ){+ sqlite3StrAccumReset(&sCheck.errMsg);+ sCheck.nErr++;+ }+ *pnErr = sCheck.nErr;+ if( sCheck.nErr==0 ) sqlite3StrAccumReset(&sCheck.errMsg);+ /* Make sure this analysis did not leave any unref() pages. */+ assert( nRef==sqlite3PagerRefcount(pBt->pPager) );+ sqlite3BtreeLeave(p);+ return sqlite3StrAccumFinish(&sCheck.errMsg);+}+#endif /* SQLITE_OMIT_INTEGRITY_CHECK */++SQLITE_API int SQLITE_STDCALL sqlite3BtreeFileFormat(Btree *p){+ return p->pBt->file_format;+}++/*+** Return the full pathname of the underlying database file. Return+** an empty string if the database is in-memory or a TEMP database.+**+** The pager filename is invariant as long as the pager is+** open so it is safe to access without the BtShared mutex.+*/+SQLITE_API const char *SQLITE_STDCALL sqlite3BtreeGetFilename(Btree *p){+ assert( p->pBt->pPager!=0 );+ return sqlite3PagerFilename(p->pBt->pPager, 1);+}++/*+** Return the pathname of the journal file for this database. The return+** value of this routine is the same regardless of whether the journal file+** has been created or not.+**+** The pager journal filename is invariant as long as the pager is+** open so it is safe to access without the BtShared mutex.+*/+SQLITE_API const char *SQLITE_STDCALL sqlite3BtreeGetJournalname(Btree *p){+ assert( p->pBt->pPager!=0 );+ return sqlite3PagerJournalname(p->pBt->pPager);+}++/*+** Return non-zero if a transaction is active.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeIsInTrans(Btree *p){+ assert( p==0 || sqlite3_mutex_held(p->db->mutex) );+ return (p && (p->inTrans==TRANS_WRITE));+}++#ifndef SQLITE_OMIT_WAL+/*+** Run a checkpoint on the Btree passed as the first argument.+**+** Return SQLITE_LOCKED if this or any other connection has an open +** transaction on the shared-cache the argument Btree is connected to.+**+** Parameter eMode is one of SQLITE_CHECKPOINT_PASSIVE, FULL or RESTART.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCheckpoint(Btree *p, int eMode, int *pnLog, int *pnCkpt){+ int rc = SQLITE_OK;+ if( p ){+ BtShared *pBt = p->pBt;+ sqlite3BtreeEnter(p);+ if( pBt->inTransaction!=TRANS_NONE ){+ rc = SQLITE_LOCKED;+ }else{+ rc = sqlite3PagerCheckpoint(pBt->pPager, eMode, pnLog, pnCkpt);+ }+ sqlite3BtreeLeave(p);+ }+ return rc;+}+#endif++/*+** Return non-zero if a read (or write) transaction is active.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeIsInReadTrans(Btree *p){+ assert( p );+ assert( sqlite3_mutex_held(p->db->mutex) );+ return p->inTrans!=TRANS_NONE;+}++SQLITE_API int SQLITE_STDCALL sqlite3BtreeIsInBackup(Btree *p){+ assert( p );+ assert( sqlite3_mutex_held(p->db->mutex) );+ return p->nBackup!=0;+}++/*+** This function returns a pointer to a blob of memory associated with+** a single shared-btree. The memory is used by client code for its own+** purposes (for example, to store a high-level schema associated with +** the shared-btree). The btree layer manages reference counting issues.+**+** The first time this is called on a shared-btree, nBytes bytes of memory+** are allocated, zeroed, and returned to the caller. For each subsequent +** call the nBytes parameter is ignored and a pointer to the same blob+** of memory returned. +**+** If the nBytes parameter is 0 and the blob of memory has not yet been+** allocated, a null pointer is returned. If the blob has already been+** allocated, it is returned as normal.+**+** Just before the shared-btree is closed, the function passed as the +** xFree argument when the memory allocation was made is invoked on the +** blob of allocated memory. The xFree function should not call sqlite3_free()+** on the memory, the btree layer does that.+*/+SQLITE_API void *SQLITE_STDCALL sqlite3BtreeSchema(Btree *p, int nBytes, void(*xFree)(void *)){+ BtShared *pBt = p->pBt;+ sqlite3BtreeEnter(p);+ if( !pBt->pSchema && nBytes ){+ pBt->pSchema = sqlite3DbMallocZero(0, nBytes);+ pBt->xFreeSchema = xFree;+ }+ sqlite3BtreeLeave(p);+ return pBt->pSchema;+}++/*+** Return SQLITE_LOCKED_SHAREDCACHE if another user of the same shared +** btree as the argument handle holds an exclusive lock on the +** sqlite_master table. Otherwise SQLITE_OK.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSchemaLocked(Btree *p){+ int rc;+ assert( sqlite3_mutex_held(p->db->mutex) );+ sqlite3BtreeEnter(p);+ rc = querySharedCacheTableLock(p, MASTER_ROOT, READ_LOCK);+ assert( rc==SQLITE_OK || rc==SQLITE_LOCKED_SHAREDCACHE );+ sqlite3BtreeLeave(p);+ return rc;+}+++#ifndef SQLITE_OMIT_SHARED_CACHE+/*+** Obtain a lock on the table whose root page is iTab. The+** lock is a write lock if isWritelock is true or a read lock+** if it is false.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeLockTable(Btree *p, int iTab, u8 isWriteLock){+ int rc = SQLITE_OK;+ assert( p->inTrans!=TRANS_NONE );+ if( p->sharable ){+ u8 lockType = READ_LOCK + isWriteLock;+ assert( READ_LOCK+1==WRITE_LOCK );+ assert( isWriteLock==0 || isWriteLock==1 );++ sqlite3BtreeEnter(p);+ rc = querySharedCacheTableLock(p, iTab, lockType);+ if( rc==SQLITE_OK ){+ rc = setSharedCacheTableLock(p, iTab, lockType);+ }+ sqlite3BtreeLeave(p);+ }+ return rc;+}+#endif++#ifndef SQLITE_OMIT_INCRBLOB+/*+** Argument pCsr must be a cursor opened for writing on an +** INTKEY table currently pointing at a valid table entry. +** This function modifies the data stored as part of that entry.+**+** Only the data content may only be modified, it is not possible to +** change the length of the data stored. If this function is called with+** parameters that attempt to write past the end of the existing data,+** no modifications are made and SQLITE_CORRUPT is returned.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreePutData(BtCursor *pCsr, u32 offset, u32 amt, void *z){+ int rc;+ assert( cursorHoldsMutex(pCsr) );+ assert( sqlite3_mutex_held(pCsr->pBtree->db->mutex) );+ assert( pCsr->curFlags & BTCF_Incrblob );++ rc = restoreCursorPosition(pCsr);+ if( rc!=SQLITE_OK ){+ return rc;+ }+ assert( pCsr->eState!=CURSOR_REQUIRESEEK );+ if( pCsr->eState!=CURSOR_VALID ){+ return SQLITE_ABORT;+ }++ /* Save the positions of all other cursors open on this table. This is+ ** required in case any of them are holding references to an xFetch+ ** version of the b-tree page modified by the accessPayload call below.+ **+ ** Note that pCsr must be open on a INTKEY table and saveCursorPosition()+ ** and hence saveAllCursors() cannot fail on a BTREE_INTKEY table, hence+ ** saveAllCursors can only return SQLITE_OK.+ */+ VVA_ONLY(rc =) saveAllCursors(pCsr->pBt, pCsr->pgnoRoot, pCsr);+ assert( rc==SQLITE_OK );++ /* Check some assumptions: + ** (a) the cursor is open for writing,+ ** (b) there is a read/write transaction open,+ ** (c) the connection holds a write-lock on the table (if required),+ ** (d) there are no conflicting read-locks, and+ ** (e) the cursor points at a valid row of an intKey table.+ */+ if( (pCsr->curFlags & BTCF_WriteFlag)==0 ){+ return SQLITE_READONLY;+ }+ assert( (pCsr->pBt->btsFlags & BTS_READ_ONLY)==0+ && pCsr->pBt->inTransaction==TRANS_WRITE );+ assert( hasSharedCacheTableLock(pCsr->pBtree, pCsr->pgnoRoot, 0, 2) );+ assert( !hasReadConflicts(pCsr->pBtree, pCsr->pgnoRoot) );+ assert( pCsr->apPage[pCsr->iPage]->intKey );++ return accessPayload(pCsr, offset, amt, (unsigned char *)z, 1);+}++/* +** Mark this cursor as an incremental blob cursor.+*/+SQLITE_API void SQLITE_STDCALL sqlite3BtreeIncrblobCursor(BtCursor *pCur){+ pCur->curFlags |= BTCF_Incrblob;+ pCur->pBtree->hasIncrblobCur = 1;+}+#endif++/*+** Set both the "read version" (single byte at byte offset 18) and +** "write version" (single byte at byte offset 19) fields in the database+** header to iVersion.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeSetVersion(Btree *pBtree, int iVersion){+ BtShared *pBt = pBtree->pBt;+ int rc; /* Return code */+ + assert( iVersion==1 || iVersion==2 );++ /* If setting the version fields to 1, do not automatically open the+ ** WAL connection, even if the version fields are currently set to 2.+ */+ pBt->btsFlags &= ~BTS_NO_WAL;+ if( iVersion==1 ) pBt->btsFlags |= BTS_NO_WAL;++ rc = sqlite3BtreeBeginTrans(pBtree, 0);+ if( rc==SQLITE_OK ){+ u8 *aData = pBt->pPage1->aData;+ if( aData[18]!=(u8)iVersion || aData[19]!=(u8)iVersion ){+ rc = sqlite3BtreeBeginTrans(pBtree, 2);+ if( rc==SQLITE_OK ){+ rc = sqlite3PagerWrite(pBt->pPage1->pDbPage);+ if( rc==SQLITE_OK ){+ aData[18] = (u8)iVersion;+ aData[19] = (u8)iVersion;+ }+ }+ }+ }++ pBt->btsFlags &= ~BTS_NO_WAL;+ return rc;+}++/*+** set the mask of hint flags for cursor pCsr.+*/+SQLITE_API void SQLITE_STDCALL sqlite3BtreeCursorHints(BtCursor *pCsr, unsigned int mask){+ assert( mask==BTREE_BULKLOAD || mask==BTREE_SEEK_EQ || mask==0 );+ pCsr->hints = mask;+}++#ifdef SQLITE_DEBUG+/*+** Return true if the cursor has a hint specified. This routine is+** only used from within assert() statements+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeCursorHasHint(BtCursor *pCsr, unsigned int mask){+ return (pCsr->hints & mask)!=0;+}+#endif++/*+** Return true if the given Btree is read-only.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeIsReadonly(Btree *p){+ return (p->pBt->btsFlags & BTS_READ_ONLY)!=0;+}++/*+** Return the size of the header added to each page by this module.+*/+SQLITE_PRIVATE int sqlite3HeaderSizeBtree(void){ return ROUND8(sizeof(MemPage)); }++SQLITE_API const char *SQLITE_STDCALL sqlite3BtreeErrName(int rc){+ const char *zName = 0;+ int i, origRc = rc;+ for(i=0; i<2 && zName==0; i++, rc &= 0xff){+ switch( rc ){+ case SQLITE_OK: zName = "SQLITE_OK"; break;+ case SQLITE_ERROR: zName = "SQLITE_ERROR"; break;+ case SQLITE_INTERNAL: zName = "SQLITE_INTERNAL"; break;+ case SQLITE_PERM: zName = "SQLITE_PERM"; break;+ case SQLITE_ABORT: zName = "SQLITE_ABORT"; break;+ case SQLITE_ABORT_ROLLBACK: zName = "SQLITE_ABORT_ROLLBACK"; break;+ case SQLITE_BUSY: zName = "SQLITE_BUSY"; break;+ case SQLITE_BUSY_RECOVERY: zName = "SQLITE_BUSY_RECOVERY"; break;+ case SQLITE_BUSY_SNAPSHOT: zName = "SQLITE_BUSY_SNAPSHOT"; break;+ case SQLITE_LOCKED: zName = "SQLITE_LOCKED"; break;+ case SQLITE_LOCKED_SHAREDCACHE: zName = "SQLITE_LOCKED_SHAREDCACHE";break;+ case SQLITE_NOMEM: zName = "SQLITE_NOMEM"; break;+ case SQLITE_READONLY: zName = "SQLITE_READONLY"; break;+ case SQLITE_READONLY_RECOVERY: zName = "SQLITE_READONLY_RECOVERY"; break;+ case SQLITE_READONLY_CANTLOCK: zName = "SQLITE_READONLY_CANTLOCK"; break;+ case SQLITE_READONLY_ROLLBACK: zName = "SQLITE_READONLY_ROLLBACK"; break;+ case SQLITE_READONLY_DBMOVED: zName = "SQLITE_READONLY_DBMOVED"; break;+ case SQLITE_INTERRUPT: zName = "SQLITE_INTERRUPT"; break;+ case SQLITE_IOERR: zName = "SQLITE_IOERR"; break;+ case SQLITE_IOERR_READ: zName = "SQLITE_IOERR_READ"; break;+ case SQLITE_IOERR_SHORT_READ: zName = "SQLITE_IOERR_SHORT_READ"; break;+ case SQLITE_IOERR_WRITE: zName = "SQLITE_IOERR_WRITE"; break;+ case SQLITE_IOERR_FSYNC: zName = "SQLITE_IOERR_FSYNC"; break;+ case SQLITE_IOERR_DIR_FSYNC: zName = "SQLITE_IOERR_DIR_FSYNC"; break;+ case SQLITE_IOERR_TRUNCATE: zName = "SQLITE_IOERR_TRUNCATE"; break;+ case SQLITE_IOERR_FSTAT: zName = "SQLITE_IOERR_FSTAT"; break;+ case SQLITE_IOERR_UNLOCK: zName = "SQLITE_IOERR_UNLOCK"; break;+ case SQLITE_IOERR_RDLOCK: zName = "SQLITE_IOERR_RDLOCK"; break;+ case SQLITE_IOERR_DELETE: zName = "SQLITE_IOERR_DELETE"; break;+ case SQLITE_IOERR_NOMEM: zName = "SQLITE_IOERR_NOMEM"; break;+ case SQLITE_IOERR_ACCESS: zName = "SQLITE_IOERR_ACCESS"; break;+ case SQLITE_IOERR_CHECKRESERVEDLOCK:+ zName = "SQLITE_IOERR_CHECKRESERVEDLOCK"; break;+ case SQLITE_IOERR_LOCK: zName = "SQLITE_IOERR_LOCK"; break;+ case SQLITE_IOERR_CLOSE: zName = "SQLITE_IOERR_CLOSE"; break;+ case SQLITE_IOERR_DIR_CLOSE: zName = "SQLITE_IOERR_DIR_CLOSE"; break;+ case SQLITE_IOERR_SHMOPEN: zName = "SQLITE_IOERR_SHMOPEN"; break;+ case SQLITE_IOERR_SHMSIZE: zName = "SQLITE_IOERR_SHMSIZE"; break;+ case SQLITE_IOERR_SHMLOCK: zName = "SQLITE_IOERR_SHMLOCK"; break;+ case SQLITE_IOERR_SHMMAP: zName = "SQLITE_IOERR_SHMMAP"; break;+ case SQLITE_IOERR_SEEK: zName = "SQLITE_IOERR_SEEK"; break;+ case SQLITE_IOERR_DELETE_NOENT: zName = "SQLITE_IOERR_DELETE_NOENT";break;+ case SQLITE_IOERR_MMAP: zName = "SQLITE_IOERR_MMAP"; break;+ case SQLITE_IOERR_GETTEMPPATH: zName = "SQLITE_IOERR_GETTEMPPATH"; break;+ case SQLITE_IOERR_CONVPATH: zName = "SQLITE_IOERR_CONVPATH"; break;+ case SQLITE_CORRUPT: zName = "SQLITE_CORRUPT"; break;+ case SQLITE_CORRUPT_VTAB: zName = "SQLITE_CORRUPT_VTAB"; break;+ case SQLITE_NOTFOUND: zName = "SQLITE_NOTFOUND"; break;+ case SQLITE_FULL: zName = "SQLITE_FULL"; break;+ case SQLITE_CANTOPEN: zName = "SQLITE_CANTOPEN"; break;+ case SQLITE_CANTOPEN_NOTEMPDIR: zName = "SQLITE_CANTOPEN_NOTEMPDIR";break;+ case SQLITE_CANTOPEN_ISDIR: zName = "SQLITE_CANTOPEN_ISDIR"; break;+ case SQLITE_CANTOPEN_FULLPATH: zName = "SQLITE_CANTOPEN_FULLPATH"; break;+ case SQLITE_CANTOPEN_CONVPATH: zName = "SQLITE_CANTOPEN_CONVPATH"; break;+ case SQLITE_PROTOCOL: zName = "SQLITE_PROTOCOL"; break;+ case SQLITE_EMPTY: zName = "SQLITE_EMPTY"; break;+ case SQLITE_SCHEMA: zName = "SQLITE_SCHEMA"; break;+ case SQLITE_TOOBIG: zName = "SQLITE_TOOBIG"; break;+ case SQLITE_CONSTRAINT: zName = "SQLITE_CONSTRAINT"; break;+ case SQLITE_CONSTRAINT_UNIQUE: zName = "SQLITE_CONSTRAINT_UNIQUE"; break;+ case SQLITE_CONSTRAINT_TRIGGER: zName = "SQLITE_CONSTRAINT_TRIGGER";break;+ case SQLITE_CONSTRAINT_FOREIGNKEY:+ zName = "SQLITE_CONSTRAINT_FOREIGNKEY"; break;+ case SQLITE_CONSTRAINT_CHECK: zName = "SQLITE_CONSTRAINT_CHECK"; break;+ case SQLITE_CONSTRAINT_PRIMARYKEY:+ zName = "SQLITE_CONSTRAINT_PRIMARYKEY";break;+ case SQLITE_CONSTRAINT_NOTNULL: zName = "SQLITE_CONSTRAINT_NOTNULL";break;+ case SQLITE_CONSTRAINT_COMMITHOOK:+ zName = "SQLITE_CONSTRAINT_COMMITHOOK";break;+ case SQLITE_CONSTRAINT_VTAB: zName = "SQLITE_CONSTRAINT_VTAB"; break;+ case SQLITE_CONSTRAINT_FUNCTION:+ zName = "SQLITE_CONSTRAINT_FUNCTION";break;+ case SQLITE_CONSTRAINT_ROWID: zName = "SQLITE_CONSTRAINT_ROWID"; break;+ case SQLITE_MISMATCH: zName = "SQLITE_MISMATCH"; break;+ case SQLITE_MISUSE: zName = "SQLITE_MISUSE"; break;+ case SQLITE_NOLFS: zName = "SQLITE_NOLFS"; break;+ case SQLITE_AUTH: zName = "SQLITE_AUTH"; break;+ case SQLITE_FORMAT: zName = "SQLITE_FORMAT"; break;+ case SQLITE_RANGE: zName = "SQLITE_RANGE"; break;+ case SQLITE_NOTADB: zName = "SQLITE_NOTADB"; break;+ case SQLITE_ROW: zName = "SQLITE_ROW"; break;+ case SQLITE_NOTICE: zName = "SQLITE_NOTICE"; break;+ case SQLITE_NOTICE_RECOVER_WAL: zName = "SQLITE_NOTICE_RECOVER_WAL";break;+ case SQLITE_NOTICE_RECOVER_ROLLBACK:+ zName = "SQLITE_NOTICE_RECOVER_ROLLBACK"; break;+ case SQLITE_WARNING: zName = "SQLITE_WARNING"; break;+ case SQLITE_WARNING_AUTOINDEX: zName = "SQLITE_WARNING_AUTOINDEX"; break;+ case SQLITE_DONE: zName = "SQLITE_DONE"; break;+ }+ }+ if( zName==0 ){+ static char zBuf[50];+ sqlite3_snprintf(sizeof(zBuf), zBuf, "SQLITE_UNKNOWN(%d)", origRc);+ zName = zBuf;+ }+ return zName;+}++/*+** The following functions:+**+** sqlite3BtreeSerialType()+** sqlite3BtreeSerialTypeLen()+** sqlite3BtreeSerialLen()+** sqlite3BtreeSerialPut()+** sqlite3BtreeSerialGet()+**+** encapsulate the code that serializes values for storage in SQLite+** data and index records. Each serialized value consists of a+** 'serial-type' and a blob of data. The serial type is an 8-byte unsigned+** integer, stored as a varint.+**+** In an SQLite index record, the serial type is stored directly before+** the blob of data that it corresponds to. In a table record, all serial+** types are stored at the start of the record, and the blobs of data at+** the end. Hence these functions allow the caller to handle the+** serial-type and data blob separately.+**+** The following table describes the various storage classes for data:+**+** serial type bytes of data type+** -------------- --------------- ---------------+** 0 0 NULL+** 1 1 signed integer+** 2 2 signed integer+** 3 3 signed integer+** 4 4 signed integer+** 5 6 signed integer+** 6 8 signed integer+** 7 8 IEEE float+** 8 0 Integer constant 0+** 9 0 Integer constant 1+** 10,11 reserved for expansion+** N>=12 and even (N-12)/2 BLOB+** N>=13 and odd (N-13)/2 text+**+** The 8 and 9 types were added in 3.3.0, file format 4. Prior versions+** of SQLite will not understand those serial types.+*/++/*+** Return the serial-type for the value stored in pMem.+*/+SQLITE_API u32 SQLITE_STDCALL sqlite3BtreeSerialType(Mem *pMem, int file_format){+ int flags = pMem->flags;+ u32 n;++ if( flags&MEM_Null ){+ return 0;+ }+ if( flags&MEM_Int ){+ /* Figure out whether to use 1, 2, 4, 6 or 8 bytes. */+# define MAX_6BYTE ((((i64)0x00008000)<<32)-1)+ i64 i = pMem->u.i;+ u64 u;+ if( i<0 ){+ u = ~i;+ }else{+ u = i;+ }+ if( u<=127 ){+ return ((i&1)==i && file_format>=4) ? 8+(u32)u : 1;+ }+ if( u<=32767 ) return 2;+ if( u<=8388607 ) return 3;+ if( u<=2147483647 ) return 4;+ if( u<=MAX_6BYTE ) return 5;+ return 6;+ }+ if( flags&MEM_Real ){+ return 7;+ }+ assert( pMem->pBtree->mallocFailed || flags&(MEM_Str|MEM_Blob) );+ assert( pMem->n>=0 );+ n = (u32)pMem->n;+ if( flags & MEM_Zero ){+ n += pMem->u.nZero;+ }+ return ((n*2) + 12 + ((flags&MEM_Str)!=0));+}++/*+** The sizes for serial types less than 12+*/+static const u8 sqlite3SmallTypeSizes[] = {+ 0, 1, 2, 3, 4, 6, 8, 8, 0, 0, 0, 0+};++/*+** Return the length of the data corresponding to the supplied serial-type.+*/+SQLITE_API u32 SQLITE_STDCALL sqlite3BtreeSerialTypeLen(u32 serial_type){+ if( serial_type>=12 ){+ return (serial_type-12)/2;+ }else{+ return sqlite3SmallTypeSizes[serial_type];+ }+}++/*+** If we are on an architecture with mixed-endian floating +** points (ex: ARM7) then swap the lower 4 bytes with the +** upper 4 bytes. Return the result.+**+** For most architectures, this is a no-op.+**+** (later): It is reported to me that the mixed-endian problem+** on ARM7 is an issue with GCC, not with the ARM7 chip. It seems+** that early versions of GCC stored the two words of a 64-bit+** float in the wrong order. And that error has been propagated+** ever since. The blame is not necessarily with GCC, though.+** GCC might have just copying the problem from a prior compiler.+** I am also told that newer versions of GCC that follow a different+** ABI get the byte order right.+**+** Developers using SQLite on an ARM7 should compile and run their+** application using -DSQLITE_DEBUG=1 at least once. With DEBUG+** enabled, some asserts below will ensure that the byte order of+** floating point values is correct.+**+** (2007-08-30) Frank van Vugt has studied this problem closely+** and has send his findings to the SQLite developers. Frank+** writes that some Linux kernels offer floating point hardware+** emulation that uses only 32-bit mantissas instead of a full +** 48-bits as required by the IEEE standard. (This is the+** CONFIG_FPE_FASTFPE option.) On such systems, floating point+** byte swapping becomes very complicated. To avoid problems,+** the necessary byte swapping is carried out using a 64-bit integer+** rather than a 64-bit float. Frank assures us that the code here+** works for him. We, the developers, have no way to independently+** verify this, but Frank seems to know what he is talking about+** so we trust him.+*/+#ifdef SQLITE_MIXED_ENDIAN_64BIT_FLOAT+static u64 floatSwap(u64 in){+ union {+ u64 r;+ u32 i[2];+ } u;+ u32 t;++ u.r = in;+ t = u.i[0];+ u.i[0] = u.i[1];+ u.i[1] = t;+ return u.r;+}+# define swapMixedEndianFloat(X) X = floatSwap(X)+#else+# define swapMixedEndianFloat(X)+#endif++/*+** Write the serialized data blob for the value stored in pMem into +** buf. It is assumed that the caller has allocated sufficient space.+** Return the number of bytes written.+**+** nBuf is the amount of space left in buf[]. The caller is responsible+** for allocating enough space to buf[] to hold the entire field, exclusive+** of the pMem->u.nZero bytes for a MEM_Zero value.+**+** Return the number of bytes actually written into buf[]. The number+** of bytes in the zero-filled tail is included in the return value only+** if those bytes were zeroed in buf[].+*/ +SQLITE_API u32 SQLITE_STDCALL sqlite3BtreeSerialPut(u8 *buf, Mem *pMem, u32 serial_type){+ u32 len;++ /* Integer and Real */+ if( serial_type<=7 && serial_type>0 ){+ u64 v;+ u32 i;+ if( serial_type==7 ){+ assert( sizeof(v)==sizeof(pMem->u.r) );+ memcpy(&v, &pMem->u.r, sizeof(v));+ swapMixedEndianFloat(v);+ }else{+ v = pMem->u.i;+ }+ len = i = sqlite3SmallTypeSizes[serial_type];+ assert( i>0 );+ do{+ buf[--i] = (u8)(v&0xFF);+ v >>= 8;+ }while( i );+ return len;+ }++ /* String or blob */+ if( serial_type>=12 ){+ assert( pMem->n + ((pMem->flags & MEM_Zero)?pMem->u.nZero:0)+ == (int)sqlite3BtreeSerialTypeLen(serial_type) );+ len = pMem->n;+ memcpy(buf, pMem->z, len);+ return len;+ }++ /* NULL or constants 0 or 1 */+ return 0;+}++/* Input "x" is a sequence of unsigned characters that represent a+** big-endian integer. Return the equivalent native integer+*/+#define ONE_BYTE_INT(x) ((i8)(x)[0])+#define TWO_BYTE_INT(x) (256*(i8)((x)[0])|(x)[1])+#define THREE_BYTE_INT(x) (65536*(i8)((x)[0])|((x)[1]<<8)|(x)[2])+#define FOUR_BYTE_UINT(x) (((u32)(x)[0]<<24)|((x)[1]<<16)|((x)[2]<<8)|(x)[3])+#define FOUR_BYTE_INT(x) (16777216*(i8)((x)[0])|((x)[1]<<16)|((x)[2]<<8)|(x)[3])++/*+** Size of struct Mem not including the Mem.zMalloc member or anything that+** follows.+*/+#define MEMCELLSIZE offsetof(Mem,zMalloc)++#define VdbeMemDynamic(X) \+ (((X)->flags&MEM_Dyn)!=0)++/*+** Initialize bulk memory to be a consistent Mem object.+**+** The minimum amount of initialization feasible is performed.+*/+SQLITE_PRIVATE void sqlite3VdbeMemInit(Mem *pMem, Btree *pBtree, u16 flags){+ assert( (flags & ~MEM_TypeMask)==0 );+ pMem->flags = flags;+ pMem->pBtree = pBtree;+ pMem->szMalloc = 0;+}++/*+** If pMem is an object with a valid string representation, this routine+** ensures the internal encoding for the string representation is+** 'desiredEnc', one of SQLITE_UTF8, SQLITE_UTF16LE or SQLITE_UTF16BE.+**+** If pMem is not a string object, or the encoding of the string+** representation is already stored using the requested encoding, then this+** routine is a no-op.+**+** SQLITE_OK is returned if the conversion is successful (or not required).+** SQLITE_NOMEM may be returned if a malloc() fails during conversion+** between formats.+*/+SQLITE_PRIVATE int sqlite3VdbeChangeEncoding(Mem *pMem, int desiredEnc){+ assert( (pMem->flags&MEM_RowSet)==0 );+ assert( desiredEnc==SQLITE_UTF8 || desiredEnc==SQLITE_UTF16LE+ || desiredEnc==SQLITE_UTF16BE );+ if( !(pMem->flags&MEM_Str) || pMem->enc==desiredEnc ){+ return SQLITE_OK;+ }+ assert( pMem->db==0 || sqlite3_mutex_held(pMem->db->mutex) );+ return SQLITE_ERROR;+}++/*+** If the memory cell contains a value that must be freed by+** invoking the external callback in Mem.xDel, then this routine+** will free that value. It also sets Mem.flags to MEM_Null.+**+** This is a helper routine for sqlite3VdbeMemSetNull() and+** for sqlite3VdbeMemRelease(). Use those other routines as the+** entry point for releasing Mem resources.+*/+static SQLITE_NOINLINE void vdbeMemClearExternAndSetNull(Mem *p){+ assert( p->db==0 || sqlite3_mutex_held(p->db->mutex) );+ assert( VdbeMemDynamic(p) );+ if( p->flags&MEM_Dyn ){+ assert( p->xDel!=SQLITE_DYNAMIC && p->xDel!=0 );+ p->xDel((void *)p->z);+ }+ p->flags = MEM_Null;+}++/*+** Delete any previous value and set the value stored in *pMem to NULL.+**+** This routine calls the Mem.xDel destructor to dispose of values that+** require the destructor. But it preserves the Mem.zMalloc memory allocation.+** To free all resources, use sqlite3VdbeMemRelease(), which both calls this+** routine to invoke the destructor and deallocates Mem.zMalloc.+**+** Use this routine to reset the Mem prior to insert a new value.+**+** Use sqlite3VdbeMemRelease() to complete erase the Mem prior to abandoning it.+*/+SQLITE_PRIVATE void sqlite3VdbeMemSetNull(Mem *pMem){+ if( VdbeMemDynamic(pMem) ){+ vdbeMemClearExternAndSetNull(pMem);+ }else{+ pMem->flags = MEM_Null;+ }+}++/*+** Make sure pMem->z points to a writable allocation of at least +** min(n,32) bytes.+**+** If the bPreserve argument is true, then copy of the content of+** pMem->z into the new allocation. pMem must be either a string or+** blob if bPreserve is true. If bPreserve is false, any prior content+** in pMem->z is discarded.+*/+SQLITE_PRIVATE SQLITE_NOINLINE int sqlite3VdbeMemGrow(Mem *pMem, int n, int bPreserve){+ assert( sqlite3VdbeCheckMemInvariants(pMem) );+ assert( (pMem->flags&MEM_RowSet)==0 );++ /* If the bPreserve flag is set to true, then the memory cell must already+ ** contain a valid string or blob value. */+ assert( bPreserve==0 || pMem->flags&(MEM_Blob|MEM_Str) );+ testcase( bPreserve && pMem->z==0 );++ assert( pMem->szMalloc==0+ || pMem->szMalloc==sqlite3DbMallocSize(pMem->pBtree, pMem->zMalloc) );+ if( pMem->szMalloc<n ){+ if( n<32 ) n = 32;+ if( bPreserve && pMem->szMalloc>0 && pMem->z==pMem->zMalloc ){+ pMem->z = pMem->zMalloc = sqlite3DbReallocOrFree(pMem->pBtree, pMem->z, n);+ bPreserve = 0;+ }else{+ if( pMem->szMalloc>0 ) sqlite3DbFree(pMem->pBtree, pMem->zMalloc);+ pMem->zMalloc = sqlite3DbMallocRaw(pMem->pBtree, n);+ }+ if( pMem->zMalloc==0 ){+ sqlite3VdbeMemSetNull(pMem);+ pMem->z = 0;+ pMem->szMalloc = 0;+ return SQLITE_NOMEM;+ }else{+ pMem->szMalloc = sqlite3DbMallocSize(pMem->pBtree, pMem->zMalloc);+ }+ }++ if( bPreserve && pMem->z && pMem->z!=pMem->zMalloc ){+ memcpy(pMem->zMalloc, pMem->z, pMem->n);+ }+ if( (pMem->flags&MEM_Dyn)!=0 ){+ assert( pMem->xDel!=0 && pMem->xDel!=SQLITE_DYNAMIC );+ pMem->xDel((void *)(pMem->z));+ }++ pMem->z = pMem->zMalloc;+ pMem->flags &= ~(MEM_Dyn|MEM_Ephem|MEM_Static);+ return SQLITE_OK;+}++/*+** Change the pMem->zMalloc allocation to be at least szNew bytes.+** If pMem->zMalloc already meets or exceeds the requested size, this+** routine is a no-op.+**+** Any prior string or blob content in the pMem object may be discarded.+** The pMem->xDel destructor is called, if it exists. Though MEM_Str+** and MEM_Blob values may be discarded, MEM_Int, MEM_Real, and MEM_Null+** values are preserved.+**+** Return SQLITE_OK on success or an error code (probably SQLITE_NOMEM)+** if unable to complete the resizing.+*/+SQLITE_PRIVATE int sqlite3VdbeMemClearAndResize(Mem *pMem, int szNew){+ assert( szNew>0 );+ assert( (pMem->flags & MEM_Dyn)==0 || pMem->szMalloc==0 );+ if( pMem->szMalloc<szNew ){+ return sqlite3VdbeMemGrow(pMem, szNew, 0);+ }+ assert( (pMem->flags & MEM_Dyn)==0 );+ pMem->z = pMem->zMalloc;+ pMem->flags &= (MEM_Null|MEM_Int|MEM_Real);+ return SQLITE_OK;+}++#ifndef SQLITE_OMIT_INCRBLOB+ int sqlite3VdbeMemExpandBlob(Mem *);+ #define ExpandBlob(P) (((P)->flags&MEM_Zero)?sqlite3VdbeMemExpandBlob(P):0)+#else+ #define sqlite3VdbeMemExpandBlob(x) SQLITE_OK+ #define ExpandBlob(P) SQLITE_OK+#endif++/*+** Change pMem so that its MEM_Str or MEM_Blob value is stored in+** MEM.zMalloc, where it can be safely written.+**+** Return SQLITE_OK on success or SQLITE_NOMEM if malloc fails.+*/+SQLITE_PRIVATE int sqlite3VdbeMemMakeWriteable(Mem *pMem){+ int f;+ assert( pMem->pBtree==0 || sqlite3_mutex_held(pMem->pBtree->mutex) );+ assert( (pMem->flags&MEM_RowSet)==0 );+ ExpandBlob(pMem);+ f = pMem->flags;+ if( (f&(MEM_Str|MEM_Blob)) && (pMem->szMalloc==0 || pMem->z!=pMem->zMalloc) ){+ if( sqlite3VdbeMemGrow(pMem, pMem->n + 2, 1) ){+ return SQLITE_NOMEM;+ }+ pMem->z[pMem->n] = 0;+ pMem->z[pMem->n+1] = 0;+ pMem->flags |= MEM_Term;+ }+ pMem->flags &= ~MEM_Ephem;+#ifdef SQLITE_DEBUG+ pMem->pScopyFrom = 0;+#endif++ return SQLITE_OK;+}++/*+** It is already known that pMem contains an unterminated string.+** Add the zero terminator.+*/+static SQLITE_NOINLINE int vdbeMemAddTerminator(Mem *pMem){+ if( sqlite3VdbeMemGrow(pMem, pMem->n+2, 1) ){+ return SQLITE_NOMEM;+ }+ pMem->z[pMem->n] = 0;+ pMem->z[pMem->n+1] = 0;+ pMem->flags |= MEM_Term;+ return SQLITE_OK;+}++/*+** Make sure the given Mem is \u0000 terminated.+*/+SQLITE_PRIVATE int sqlite3VdbeMemNulTerminate(Mem *pMem){+ assert( pMem->pBtree==0 || sqlite3_mutex_held(pMem->pBtree->mutex) );+ testcase( (pMem->flags & (MEM_Term|MEM_Str))==(MEM_Term|MEM_Str) );+ testcase( (pMem->flags & (MEM_Term|MEM_Str))==0 );+ if( (pMem->flags & (MEM_Term|MEM_Str))!=MEM_Str ){+ return SQLITE_OK; /* Nothing to do */+ }else{+ return vdbeMemAddTerminator(pMem);+ }+}++/*+** Add MEM_Str to the set of representations for the given Mem. Numbers+** are converted using sqlite3_snprintf(). Converting a BLOB to a string+** is a no-op.+**+** Existing representations MEM_Int and MEM_Real are invalidated if+** bForce is true but are retained if bForce is false.+**+** A MEM_Null value will never be passed to this function. This function is+** used for converting values to text for returning to the user (i.e. via+** sqlite3_value_text()), or for ensuring that values to be used as btree+** keys are strings. In the former case a NULL pointer is returned the+** user and the latter is an internal programming error.+*/+SQLITE_PRIVATE int sqlite3VdbeMemStringify(Mem *pMem, u8 enc, u8 bForce){+ int fg = pMem->flags;+ const int nByte = 32;++ assert( pMem->pBtree==0 || sqlite3_mutex_held(pMem->pBtree->mutex) );+ assert( !(fg&MEM_Zero) );+ assert( !(fg&(MEM_Str|MEM_Blob)) );+ assert( fg&(MEM_Int|MEM_Real) );+ assert( (pMem->flags&MEM_RowSet)==0 );+ assert( EIGHT_BYTE_ALIGNMENT(pMem) );+++ if( sqlite3VdbeMemClearAndResize(pMem, nByte) ){+ return SQLITE_NOMEM;+ }++ /* For a Real or Integer, use sqlite3_snprintf() to produce the UTF-8+ ** string representation of the value. Then, if the required encoding+ ** is UTF-16le or UTF-16be do a translation.+ ** + ** FIX ME: It would be better if sqlite3_snprintf() could do UTF-16.+ */+ if( fg & MEM_Int ){+ sqlite3_snprintf(nByte, pMem->z, "%lld", pMem->u.i);+ }else{+ assert( fg & MEM_Real );+ sqlite3_snprintf(nByte, pMem->z, "%!.15g", pMem->u.r);+ }+ pMem->n = sqlite3Strlen30(pMem->z);+ pMem->enc = SQLITE_UTF8;+ pMem->flags |= MEM_Str|MEM_Term;+ if( bForce ) pMem->flags &= ~(MEM_Int|MEM_Real);+ sqlite3VdbeChangeEncoding(pMem, enc);+ return SQLITE_OK;+}++/*+** Release memory held by the Mem p, both external memory cleared+** by p->xDel and memory in p->zMalloc.+**+** This is a helper routine invoked by sqlite3VdbeMemRelease() in+** the unusual case where there really is memory in p that needs+** to be freed.+*/+static SQLITE_NOINLINE void vdbeMemClear(Mem *p){+ if( VdbeMemDynamic(p) ){+ vdbeMemClearExternAndSetNull(p);+ }+ if( p->szMalloc ){+ sqlite3DbFree(p->pBtree, p->zMalloc);+ p->szMalloc = 0;+ }+ p->z = 0;+}++/*+** Release any memory resources held by the Mem. Both the memory that is+** free by Mem.xDel and the Mem.zMalloc allocation are freed.+**+** Use this routine prior to clean up prior to abandoning a Mem, or to+** reset a Mem back to its minimum memory utilization.+**+** Use sqlite3VdbeMemSetNull() to release just the Mem.xDel space+** prior to inserting new content into the Mem.+*/+SQLITE_PRIVATE void sqlite3VdbeMemRelease(Mem *p){+ assert( sqlite3VdbeCheckMemInvariants(p) );+ if( VdbeMemDynamic(p) || p->szMalloc ){+ vdbeMemClear(p);+ }+}++/*+** Make an shallow copy of pFrom into pTo. Prior contents of+** pTo are freed. The pFrom->z field is not duplicated. If+** pFrom->z is used, then pTo->z points to the same thing as pFrom->z+** and flags gets srcType (either MEM_Ephem or MEM_Static).+*/+static void sqlite3VdbeMemShallowCopy(Mem *pTo, const Mem *pFrom, int srcType);+static SQLITE_NOINLINE void vdbeClrCopy(Mem *pTo, const Mem *pFrom, int eType){+ vdbeMemClearExternAndSetNull(pTo);+ assert( !VdbeMemDynamic(pTo) );+ sqlite3VdbeMemShallowCopy(pTo, pFrom, eType);+}+static void sqlite3VdbeMemShallowCopy(Mem *pTo, const Mem *pFrom, int srcType){+ assert( (pFrom->flags & MEM_RowSet)==0 );+ assert( pTo->pBtree==pFrom->pBtree );+ if( VdbeMemDynamic(pTo) ){ vdbeClrCopy(pTo,pFrom,srcType); return; }+ memcpy(pTo, pFrom, MEMCELLSIZE);+ if( (pFrom->flags&MEM_Static)==0 ){+ pTo->flags &= ~(MEM_Dyn|MEM_Static|MEM_Ephem);+ assert( srcType==MEM_Ephem || srcType==MEM_Static );+ pTo->flags |= srcType;+ }+}++/*+** Deserialize the data blob pointed to by buf as serial type serial_type+** and store the result in pMem. Return the number of bytes read.+**+** This function is implemented as two separate routines for performance.+** The few cases that require local variables are broken out into a separate+** routine so that in most cases the overhead of moving the stack pointer+** is avoided.+*/ +static u32 SQLITE_NOINLINE serialGet(+ const unsigned char *buf, /* Buffer to deserialize from */+ u32 serial_type, /* Serial type to deserialize */+ Mem *pMem /* Memory cell to write value into */+){+ u64 x = FOUR_BYTE_UINT(buf);+ u32 y = FOUR_BYTE_UINT(buf+4);+ x = (x<<32) + y;+ if( serial_type==6 ){+ /* EVIDENCE-OF: R-29851-52272 Value is a big-endian 64-bit+ ** twos-complement integer. */+ pMem->u.i = *(i64*)&x;+ pMem->flags = MEM_Int;+ testcase( pMem->u.i<0 );+ }else{+ /* EVIDENCE-OF: R-57343-49114 Value is a big-endian IEEE 754-2008 64-bit+ ** floating point number. */+#if !defined(NDEBUG) && !defined(SQLITE_OMIT_FLOATING_POINT)+ /* Verify that integers and floating point values use the same+ ** byte order. Or, that if SQLITE_MIXED_ENDIAN_64BIT_FLOAT is+ ** defined that 64-bit floating point values really are mixed+ ** endian.+ */+ static const u64 t1 = ((u64)0x3ff00000)<<32;+ static const double r1 = 1.0;+ u64 t2 = t1;+ swapMixedEndianFloat(t2);+ assert( sizeof(r1)==sizeof(t2) && memcmp(&r1, &t2, sizeof(r1))==0 );+#endif+ assert( sizeof(x)==8 && sizeof(pMem->u.r)==8 );+ swapMixedEndianFloat(x);+ memcpy(&pMem->u.r, &x, sizeof(x));+ pMem->flags = sqlite3IsNaN(pMem->u.r) ? MEM_Null : MEM_Real;+ }+ return 8;+}+SQLITE_API u32 SQLITE_STDCALL sqlite3BtreeSerialGet(+ const unsigned char *buf, /* Buffer to deserialize from */+ u32 serial_type, /* Serial type to deserialize */+ Mem *pMem /* Memory cell to write value into */+){+ switch( serial_type ){+ case 10: /* Reserved for future use */+ case 11: /* Reserved for future use */+ case 0: { /* Null */+ /* EVIDENCE-OF: R-24078-09375 Value is a NULL. */+ pMem->flags = MEM_Null;+ break;+ }+ case 1: {+ /* EVIDENCE-OF: R-44885-25196 Value is an 8-bit twos-complement+ ** integer. */+ pMem->u.i = ONE_BYTE_INT(buf);+ pMem->flags = MEM_Int;+ testcase( pMem->u.i<0 );+ return 1;+ }+ case 2: { /* 2-byte signed integer */+ /* EVIDENCE-OF: R-49794-35026 Value is a big-endian 16-bit+ ** twos-complement integer. */+ pMem->u.i = TWO_BYTE_INT(buf);+ pMem->flags = MEM_Int;+ testcase( pMem->u.i<0 );+ return 2;+ }+ case 3: { /* 3-byte signed integer */+ /* EVIDENCE-OF: R-37839-54301 Value is a big-endian 24-bit+ ** twos-complement integer. */+ pMem->u.i = THREE_BYTE_INT(buf);+ pMem->flags = MEM_Int;+ testcase( pMem->u.i<0 );+ return 3;+ }+ case 4: { /* 4-byte signed integer */+ /* EVIDENCE-OF: R-01849-26079 Value is a big-endian 32-bit+ ** twos-complement integer. */+ pMem->u.i = FOUR_BYTE_INT(buf);+ pMem->flags = MEM_Int;+ testcase( pMem->u.i<0 );+ return 4;+ }+ case 5: { /* 6-byte signed integer */+ /* EVIDENCE-OF: R-50385-09674 Value is a big-endian 48-bit+ ** twos-complement integer. */+ pMem->u.i = FOUR_BYTE_UINT(buf+2) + (((i64)1)<<32)*TWO_BYTE_INT(buf);+ pMem->flags = MEM_Int;+ testcase( pMem->u.i<0 );+ return 6;+ }+ case 6: /* 8-byte signed integer */+ case 7: { /* IEEE floating point */+ /* These use local variables, so do them in a separate routine+ ** to avoid having to move the frame pointer in the common case */+ return serialGet(buf,serial_type,pMem);+ }+ case 8: /* Integer 0 */+ case 9: { /* Integer 1 */+ /* EVIDENCE-OF: R-12976-22893 Value is the integer 0. */+ /* EVIDENCE-OF: R-18143-12121 Value is the integer 1. */+ pMem->u.i = serial_type-8;+ pMem->flags = MEM_Int;+ return 0;+ }+ default: {+ /* EVIDENCE-OF: R-14606-31564 Value is a BLOB that is (N-12)/2 bytes in+ ** length.+ ** EVIDENCE-OF: R-28401-00140 Value is a string in the text encoding and+ ** (N-13)/2 bytes in length. */+ static const u16 aFlag[] = { MEM_Blob|MEM_Ephem, MEM_Str|MEM_Ephem };+ pMem->z = (char *)buf;+ pMem->n = (serial_type-12)/2;+ pMem->flags = aFlag[serial_type&1];+ return pMem->n;+ }+ }+ return 0;+}++/*+** This routine is used to allocate sufficient space for an UnpackedRecord+** structure large enough to be used with sqlite3VdbeRecordUnpack() if+** the first argument is a pointer to KeyInfo structure pKeyInfo.+**+** The space is either allocated using sqlite3DbMallocRaw() or from within+** the unaligned buffer passed via the second and third arguments (presumably+** stack space). If the former, then *ppFree is set to a pointer that should+** be eventually freed by the caller using sqlite3DbFree(). Or, if the +** allocation comes from the pSpace/szSpace buffer, *ppFree is set to NULL+** before returning.+**+** If an OOM error occurs, NULL is returned.+*/+SQLITE_PRIVATE UnpackedRecord *sqlite3VdbeAllocUnpackedRecord(+ KeyInfo *pKeyInfo, /* Description of the record */+ char *pSpace, /* Unaligned space available */+ int szSpace, /* Size of pSpace[] in bytes */+ char **ppFree /* OUT: Caller should free this pointer */+){+ UnpackedRecord *p; /* Unpacked record to return */+ int nOff; /* Increment pSpace by nOff to align it */+ int nByte; /* Number of bytes required for *p */++ /* We want to shift the pointer pSpace up such that it is 8-byte aligned.+ ** Thus, we need to calculate a value, nOff, between 0 and 7, to shift + ** it by. If pSpace is already 8-byte aligned, nOff should be zero.+ */+ nOff = (8 - (SQLITE_PTR_TO_INT(pSpace) & 7)) & 7;+ nByte = ROUND8(sizeof(UnpackedRecord)) + sizeof(Mem)*(pKeyInfo->nField+1);+ if( nByte>szSpace+nOff ){+ p = (UnpackedRecord *)sqlite3DbMallocRaw(pKeyInfo->pBtree, nByte);+ *ppFree = (char *)p;+ if( !p ) return 0;+ }else{+ p = (UnpackedRecord*)&pSpace[nOff];+ *ppFree = 0;+ }++ p->aMem = (Mem*)&((char*)p)[ROUND8(sizeof(UnpackedRecord))];+ assert( pKeyInfo->aSortOrder!=0 );+ p->pKeyInfo = pKeyInfo;+ p->nField = pKeyInfo->nField + 1;+ return p;+}++/*+** Given the nKey-byte encoding of a record in pKey[], populate the +** UnpackedRecord structure indicated by the fourth argument with the+** contents of the decoded record.+*/ +SQLITE_PRIVATE void sqlite3VdbeRecordUnpack(+ KeyInfo *pKeyInfo, /* Information about the record format */+ int nKey, /* Size of the binary record */+ const void *pKey, /* The binary record */+ UnpackedRecord *p /* Populate this structure before returning. */+){+ const unsigned char *aKey = (const unsigned char *)pKey;+ int d; + u32 idx; /* Offset in aKey[] to read from */+ u16 u; /* Unsigned loop counter */+ u32 szHdr;+ Mem *pMem = p->aMem;++ p->default_rc = 0;+ assert( EIGHT_BYTE_ALIGNMENT(pMem) );+ idx = getVarint32(aKey, szHdr);+ d = szHdr;+ u = 0;+ while( idx<szHdr && d<=nKey ){+ u32 serial_type;++ idx += getVarint32(&aKey[idx], serial_type);+ pMem->enc = pKeyInfo->enc;+ pMem->pBtree = pKeyInfo->pBtree;+ /* pMem->flags = 0; // sqlite3BtreeSerialGet() will set this for us */+ pMem->szMalloc = 0;+ d += sqlite3BtreeSerialGet(&aKey[d], serial_type, pMem);+ pMem++;+ if( (++u)>=p->nField ) break;+ }+ assert( u<=pKeyInfo->nField + 1 );+ p->nField = u;+}++#if SQLITE_DEBUG+/*+** Count the number of fields (a.k.a. columns) in the record given by+** pKey,nKey. The verify that this count is less than or equal to the+** limit given by pKeyInfo->nField + pKeyInfo->nXField.+**+** If this constraint is not satisfied, it means that the high-speed+** vdbeRecordCompareInt() and vdbeRecordCompareString() routines will+** not work correctly. If this assert() ever fires, it probably means+** that the KeyInfo.nField or KeyInfo.nXField values were computed+** incorrectly.+*/+static void vdbeAssertFieldCountWithinLimits(+ int nKey, const void *pKey, /* The record to verify */ + const KeyInfo *pKeyInfo /* Compare size with this KeyInfo */+){+ int nField = 0;+ u32 szHdr;+ u32 idx;+ u32 notUsed;+ const unsigned char *aKey = (const unsigned char*)pKey;++ if( CORRUPT_DB ) return;+ idx = getVarint32(aKey, szHdr);+ assert( nKey>=0 );+ assert( szHdr<=(u32)nKey );+ while( idx<szHdr ){+ idx += getVarint32(aKey+idx, notUsed);+ nField++;+ }+ assert( nField <= pKeyInfo->nField+pKeyInfo->nXField );+}+#else+# define vdbeAssertFieldCountWithinLimits(A,B,C)+#endif++/*+** This function is an optimized version of sqlite3BtreeRecordCompare() +** that (a) the first field of pPKey2 is an integer, and (b) the +** size-of-header varint at the start of (pKey1/nKey1) fits in a single+** byte (i.e. is less than 128).+**+** To avoid concerns about buffer overreads, this routine is only used+** on schemas where the maximum valid header size is 63 bytes or less.+*/+static int vdbeRecordCompareInt(+ int nKey1, const void *pKey1, /* Left key */+ UnpackedRecord *pPKey2 /* Right key */+){+ const u8 *aKey = &((const u8*)pKey1)[*(const u8*)pKey1 & 0x3F];+ int serial_type = ((const u8*)pKey1)[1];+ int res;+ u32 y;+ u64 x;+ i64 v = pPKey2->aMem[0].u.i;+ i64 lhs;++ vdbeAssertFieldCountWithinLimits(nKey1, pKey1, pPKey2->pKeyInfo);+ assert( (*(u8*)pKey1)<=0x3F || CORRUPT_DB );+ switch( serial_type ){+ case 1: { /* 1-byte signed integer */+ lhs = ONE_BYTE_INT(aKey);+ testcase( lhs<0 );+ break;+ }+ case 2: { /* 2-byte signed integer */+ lhs = TWO_BYTE_INT(aKey);+ testcase( lhs<0 );+ break;+ }+ case 3: { /* 3-byte signed integer */+ lhs = THREE_BYTE_INT(aKey);+ testcase( lhs<0 );+ break;+ }+ case 4: { /* 4-byte signed integer */+ y = FOUR_BYTE_UINT(aKey);+ lhs = (i64)*(int*)&y;+ testcase( lhs<0 );+ break;+ }+ case 5: { /* 6-byte signed integer */+ lhs = FOUR_BYTE_UINT(aKey+2) + (((i64)1)<<32)*TWO_BYTE_INT(aKey);+ testcase( lhs<0 );+ break;+ }+ case 6: { /* 8-byte signed integer */+ x = FOUR_BYTE_UINT(aKey);+ x = (x<<32) | FOUR_BYTE_UINT(aKey+4);+ lhs = *(i64*)&x;+ testcase( lhs<0 );+ break;+ }+ case 8: + lhs = 0;+ break;+ case 9:+ lhs = 1;+ break;++ /* This case could be removed without changing the results of running+ ** this code. Including it causes gcc to generate a faster switch + ** statement (since the range of switch targets now starts at zero and+ ** is contiguous) but does not cause any duplicate code to be generated+ ** (as gcc is clever enough to combine the two like cases). Other + ** compilers might be similar. */ + case 0: case 7:+ return sqlite3BtreeRecordCompare(nKey1, pKey1, pPKey2);++ default:+ return sqlite3BtreeRecordCompare(nKey1, pKey1, pPKey2);+ }++ if( v>lhs ){+ res = pPKey2->r1;+ }else if( v<lhs ){+ res = pPKey2->r2;+ }else if( pPKey2->nField>1 ){+ /* The first fields of the two keys are equal. Compare the trailing + ** fields. */+ res = sqlite3VdbeRecordCompareWithSkip(nKey1, pKey1, pPKey2, 1);+ }else{+ /* The first fields of the two keys are equal and there are no trailing+ ** fields. Return pPKey2->default_rc in this case. */+ res = pPKey2->default_rc;+ }++ assert( vdbeRecordCompareDebug(nKey1, pKey1, pPKey2, res) );+ return res;+}++/*+** This function is an optimized version of sqlite3BtreeRecordCompare() +** that (a) the first field of pPKey2 is a string, that (b) the first field+** uses the collation sequence BINARY and (c) that the size-of-header varint +** at the start of (pKey1/nKey1) fits in a single byte.+*/+static int vdbeRecordCompareString(+ int nKey1, const void *pKey1, /* Left key */+ UnpackedRecord *pPKey2 /* Right key */+){+ const u8 *aKey1 = (const u8*)pKey1;+ int serial_type;+ int res;++ vdbeAssertFieldCountWithinLimits(nKey1, pKey1, pPKey2->pKeyInfo);+ getVarint32(&aKey1[1], serial_type);+ if( serial_type<12 ){+ res = pPKey2->r1; /* (pKey1/nKey1) is a number or a null */+ }else if( !(serial_type & 0x01) ){ + res = pPKey2->r2; /* (pKey1/nKey1) is a blob */+ }else{+ int nCmp;+ int nStr;+ int szHdr = aKey1[0];++ nStr = (serial_type-12) / 2;+ if( (szHdr + nStr) > nKey1 ){+ pPKey2->errCode = (u8)SQLITE_CORRUPT_BKPT;+ return 0; /* Corruption */+ }+ nCmp = MIN( pPKey2->aMem[0].n, nStr );+ res = memcmp(&aKey1[szHdr], pPKey2->aMem[0].z, nCmp);++ if( res==0 ){+ res = nStr - pPKey2->aMem[0].n;+ if( res==0 ){+ if( pPKey2->nField>1 ){+ res = sqlite3VdbeRecordCompareWithSkip(nKey1, pKey1, pPKey2, 1);+ }else{+ res = pPKey2->default_rc;+ }+ }else if( res>0 ){+ res = pPKey2->r2;+ }else{+ res = pPKey2->r1;+ }+ }else if( res>0 ){+ res = pPKey2->r2;+ }else{+ res = pPKey2->r1;+ }+ }++ assert( vdbeRecordCompareDebug(nKey1, pKey1, pPKey2, res)+ || CORRUPT_DB+ || pPKey2->pKeyInfo->pBtree->mallocFailed+ );+ return res;+}++/*+** If the given Mem* has a zero-filled tail, turn it into an ordinary+** blob stored in dynamically allocated space.+*/+#ifndef SQLITE_OMIT_INCRBLOB+SQLITE_PRIVATE int sqlite3VdbeMemExpandBlob(Mem *pMem){+ if( pMem->flags & MEM_Zero ){+ int nByte;+ assert( pMem->flags&MEM_Blob );+ assert( (pMem->flags&MEM_RowSet)==0 );+ assert( pMem->pBtree==0 || sqlite3_mutex_held(pMem->pBtree->mutex) );++ /* Set nByte to the number of bytes required to store the expanded blob. */+ nByte = pMem->n + pMem->u.nZero;+ if( nByte<=0 ){+ nByte = 1;+ }+ if( sqlite3VdbeMemGrow(pMem, nByte, 1) ){+ return SQLITE_NOMEM;+ }++ memset(&pMem->z[pMem->n], 0, pMem->u.nZero);+ pMem->n += pMem->u.nZero;+ pMem->flags &= ~MEM_Zero;+ }+ return SQLITE_OK;+}+#endif++/*+** Convert a 64-bit IEEE double into a 64-bit signed integer.+** If the double is out of range of a 64-bit signed integer then+** return the closest available 64-bit signed integer.+*/+static i64 doubleToInt64(double r){+#ifdef SQLITE_OMIT_FLOATING_POINT+ /* When floating-point is omitted, double and int64 are the same thing */+ return r;+#else+ /*+ ** Many compilers we encounter do not define constants for the+ ** minimum and maximum 64-bit integers, or they define them+ ** inconsistently. And many do not understand the "LL" notation.+ ** So we define our own static constants here using nothing+ ** larger than a 32-bit integer constant.+ */+ static const i64 maxInt = LARGEST_INT64;+ static const i64 minInt = SMALLEST_INT64;++ if( r<=(double)minInt ){+ return minInt;+ }else if( r>=(double)maxInt ){+ return maxInt;+ }else{+ return (i64)r;+ }+#endif+}++/*+** Return some kind of integer value which is the best we can do+** at representing the value that *pMem describes as an integer.+** If pMem is an integer, then the value is exact. If pMem is+** a floating-point then the value returned is the integer part.+** If pMem is a string or blob, then we make an attempt to convert+** it into an integer and return that. If pMem represents an+** an SQL-NULL value, return 0.+**+** If pMem represents a string value, its encoding might be changed.+*/+SQLITE_PRIVATE i64 sqlite3VdbeIntValue(Mem *pMem){+ int flags;+ assert( pMem->pBtree==0 || sqlite3_mutex_held(pMem->pBtree->mutex) );+ assert( EIGHT_BYTE_ALIGNMENT(pMem) );+ flags = pMem->flags;+ if( flags & MEM_Int ){+ return pMem->u.i;+ }else if( flags & MEM_Real ){+ return doubleToInt64(pMem->u.r);+ }else if( flags & (MEM_Str|MEM_Blob) ){+ i64 value = 0;+ assert( pMem->z || pMem->n==0 );+ sqlite3Atoi64(pMem->z, &value, pMem->n, pMem->enc);+ return value;+ }else{+ return 0;+ }+}++/*+** Return the best representation of pMem that we can get into a+** double. If pMem is already a double or an integer, return its+** value. If it is a string or blob, try to convert it to a double.+** If it is a NULL, return 0.0.+*/+SQLITE_PRIVATE double sqlite3VdbeRealValue(Mem *pMem){+ assert( pMem->pBtree==0 || sqlite3_mutex_held(pMem->pBtree->mutex) );+ assert( EIGHT_BYTE_ALIGNMENT(pMem) );+ if( pMem->flags & MEM_Real ){+ return pMem->u.r;+ }else if( pMem->flags & MEM_Int ){+ return (double)pMem->u.i;+ }else if( pMem->flags & (MEM_Str|MEM_Blob) ){+ /* (double)0 In case of SQLITE_OMIT_FLOATING_POINT... */+ double val = (double)0;+ sqlite3AtoF(pMem->z, &val, pMem->n, pMem->enc);+ return val;+ }else{+ /* (double)0 In case of SQLITE_OMIT_FLOATING_POINT... */+ return (double)0;+ }+}++/*+** The pVal argument is known to be a value other than NULL.+** Convert it into a string with encoding enc and return a pointer+** to a zero-terminated version of that string.+*/+static SQLITE_NOINLINE const void *valueToText(Mem* pVal, u8 enc){+ assert( pVal!=0 );+ assert( pVal->pBtree==0 || sqlite3_mutex_held(pVal->pBtree->mutex) );+ assert( (enc&3)==(enc&~SQLITE_UTF16_ALIGNED) );+ assert( (pVal->flags & MEM_RowSet)==0 );+ assert( (pVal->flags & (MEM_Null))==0 );+ if( pVal->flags & (MEM_Blob|MEM_Str) ){+ pVal->flags |= MEM_Str;+ if( pVal->flags & MEM_Zero ){+ sqlite3VdbeMemExpandBlob(pVal);+ }+ if( pVal->enc != (enc & ~SQLITE_UTF16_ALIGNED) ){+ sqlite3VdbeChangeEncoding(pVal, enc & ~SQLITE_UTF16_ALIGNED);+ }+ if( (enc & SQLITE_UTF16_ALIGNED)!=0 && 1==(1&SQLITE_PTR_TO_INT(pVal->z)) ){+ assert( (pVal->flags & (MEM_Ephem|MEM_Static))!=0 );+ if( sqlite3VdbeMemMakeWriteable(pVal)!=SQLITE_OK ){+ return 0;+ }+ }+ sqlite3VdbeMemNulTerminate(pVal); /* IMP: R-31275-44060 */+ }else{+ sqlite3VdbeMemStringify(pVal, enc, 0);+ assert( 0==(1&SQLITE_PTR_TO_INT(pVal->z)) );+ }+ assert(pVal->enc==(enc & ~SQLITE_UTF16_ALIGNED) || pVal->pBtree==0+ || pVal->pBtree->mallocFailed );+ if( pVal->enc==(enc & ~SQLITE_UTF16_ALIGNED) ){+ return pVal->z;+ }else{+ return 0;+ }+}++/* This function is only available internally, it is not part of the+** external API. It works in a similar way to sqlite3_value_text(),+** except the data returned is in the encoding specified by the second+** parameter, which must be one of SQLITE_UTF16BE, SQLITE_UTF16LE or+** SQLITE_UTF8.+**+** (2006-02-16:) The enc value can be or-ed with SQLITE_UTF16_ALIGNED.+** If that is the case, then the result must be aligned on an even byte+** boundary.+*/+SQLITE_PRIVATE const void *sqlite3ValueText(Mem* pVal, u8 enc){+ if( !pVal ) return 0;+ assert( pVal->pBtree==0 || sqlite3_mutex_held(pVal->pBtree->mutex) );+ assert( (enc&3)==(enc&~SQLITE_UTF16_ALIGNED) );+ assert( (pVal->flags & MEM_RowSet)==0 );+ if( (pVal->flags&MEM_Str)==MEM_Str && pVal->enc==enc ){+ return pVal->z;+ }+ if( pVal->flags&MEM_Null ){+ return 0;+ }+ return valueToText(pVal, enc);+}++/*+** Both *pMem1 and *pMem2 contain string values. Compare the two values+** using the collation sequence pColl. As usual, return a negative , zero+** or positive value if *pMem1 is less than, equal to or greater than +** *pMem2, respectively. Similar in spirit to "rc = (*pMem1) - (*pMem2);".+*/+static int vdbeCompareMemString(+ const Mem *pMem1,+ const Mem *pMem2,+ const CollSeq *pColl,+ u8 *prcErr /* If an OOM occurs, set to SQLITE_NOMEM */+){+ if( pMem1->enc==pColl->enc ){+ /* The strings are already in the correct encoding. Call the+ ** comparison function directly */+ return pColl->xCmp(pColl->pUser,pMem1->n,pMem1->z,pMem2->n,pMem2->z);+ }else{+ int rc;+ const void *v1, *v2;+ int n1, n2;+ Mem c1;+ Mem c2;+ sqlite3VdbeMemInit(&c1, pMem1->pBtree, MEM_Null);+ sqlite3VdbeMemInit(&c2, pMem1->pBtree, MEM_Null);+ sqlite3VdbeMemShallowCopy(&c1, pMem1, MEM_Ephem);+ sqlite3VdbeMemShallowCopy(&c2, pMem2, MEM_Ephem);+ v1 = sqlite3ValueText(&c1, pColl->enc);+ n1 = v1==0 ? 0 : c1.n;+ v2 = sqlite3ValueText(&c2, pColl->enc);+ n2 = v2==0 ? 0 : c2.n;+ rc = pColl->xCmp(pColl->pUser, n1, v1, n2, v2);+ sqlite3VdbeMemRelease(&c1);+ sqlite3VdbeMemRelease(&c2);+ if( (v1==0 || v2==0) && prcErr ) *prcErr = SQLITE_NOMEM;+ return rc;+ }+}++/*+** The first argument passed to this function is a serial-type that+** corresponds to an integer - all values between 1 and 9 inclusive +** except 7. The second points to a buffer containing an integer value+** serialized according to serial_type. This function deserializes+** and returns the value.+*/+static i64 vdbeRecordDecodeInt(u32 serial_type, const u8 *aKey){+ u32 y;+ assert( CORRUPT_DB || (serial_type>=1 && serial_type<=9 && serial_type!=7) );+ switch( serial_type ){+ case 0:+ case 1:+ testcase( aKey[0]&0x80 );+ return ONE_BYTE_INT(aKey);+ case 2:+ testcase( aKey[0]&0x80 );+ return TWO_BYTE_INT(aKey);+ case 3:+ testcase( aKey[0]&0x80 );+ return THREE_BYTE_INT(aKey);+ case 4: {+ testcase( aKey[0]&0x80 );+ y = FOUR_BYTE_UINT(aKey);+ return (i64)*(int*)&y;+ }+ case 5: {+ testcase( aKey[0]&0x80 );+ return FOUR_BYTE_UINT(aKey+2) + (((i64)1)<<32)*TWO_BYTE_INT(aKey);+ }+ case 6: {+ u64 x = FOUR_BYTE_UINT(aKey);+ testcase( aKey[0]&0x80 );+ x = (x<<32) | FOUR_BYTE_UINT(aKey+4);+ return (i64)*(i64*)&x;+ }+ }++ return (serial_type - 8);+}++/*+** This function compares the two table rows or index records+** specified by {nKey1, pKey1} and pPKey2. It returns a negative, zero+** or positive integer if key1 is less than, equal to or +** greater than key2. The {nKey1, pKey1} key must be a blob+** created by the OP_MakeRecord opcode of the VDBE. The pPKey2+** key must be a parsed key such as obtained from+** sqlite3VdbeParseRecord.+**+** If argument bSkip is non-zero, it is assumed that the caller has already+** determined that the first fields of the keys are equal.+**+** Key1 and Key2 do not have to contain the same number of fields. If all +** fields that appear in both keys are equal, then pPKey2->default_rc is +** returned.+**+** If database corruption is discovered, set pPKey2->errCode to +** SQLITE_CORRUPT and return 0. If an OOM error is encountered, +** pPKey2->errCode is set to SQLITE_NOMEM and, if it is not NULL, the+** malloc-failed flag set on database handle (pPKey2->pKeyInfo->pBtree).+*/+SQLITE_PRIVATE int sqlite3VdbeRecordCompareWithSkip(+ int nKey1, const void *pKey1, /* Left key */+ UnpackedRecord *pPKey2, /* Right key */+ int bSkip /* If true, skip the first field */+){+ u32 d1; /* Offset into aKey[] of next data element */+ int i; /* Index of next field to compare */+ u32 szHdr1; /* Size of record header in bytes */+ u32 idx1; /* Offset of first type in header */+ int rc = 0; /* Return value */+ Mem *pRhs = pPKey2->aMem; /* Next field of pPKey2 to compare */+ KeyInfo *pKeyInfo = pPKey2->pKeyInfo;+ const unsigned char *aKey1 = (const unsigned char *)pKey1;+ Mem mem1;++ /* If bSkip is true, then the caller has already determined that the first+ ** two elements in the keys are equal. Fix the various stack variables so+ ** that this routine begins comparing at the second field. */+ if( bSkip ){+ u32 s1;+ idx1 = 1 + getVarint32(&aKey1[1], s1);+ szHdr1 = aKey1[0];+ d1 = szHdr1 + sqlite3BtreeSerialTypeLen(s1);+ i = 1;+ pRhs++;+ }else{+ idx1 = getVarint32(aKey1, szHdr1);+ d1 = szHdr1;+ if( d1>(unsigned)nKey1 ){ + pPKey2->errCode = (u8)SQLITE_CORRUPT_BKPT;+ return 0; /* Corruption */+ }+ i = 0;+ }++ VVA_ONLY( mem1.szMalloc = 0; ) /* Only needed by assert() statements */+ assert( pPKey2->pKeyInfo->nField+pPKey2->pKeyInfo->nXField>=pPKey2->nField + || CORRUPT_DB );+ assert( pPKey2->pKeyInfo->aSortOrder!=0 );+ assert( pPKey2->pKeyInfo->nField>0 );+ assert( idx1<=szHdr1 || CORRUPT_DB );+ do{+ u32 serial_type;++ /* RHS is an integer */+ if( pRhs->flags & MEM_Int ){+ serial_type = aKey1[idx1];+ testcase( serial_type==12 );+ if( serial_type>=10 ){+ rc = +1;+ }else if( serial_type==0 ){+ rc = -1;+ }else if( serial_type==7 ){+ double rhs = (double)pRhs->u.i;+ sqlite3BtreeSerialGet(&aKey1[d1], serial_type, &mem1);+ if( mem1.u.r<rhs ){+ rc = -1;+ }else if( mem1.u.r>rhs ){+ rc = +1;+ }+ }else{+ i64 lhs = vdbeRecordDecodeInt(serial_type, &aKey1[d1]);+ i64 rhs = pRhs->u.i;+ if( lhs<rhs ){+ rc = -1;+ }else if( lhs>rhs ){+ rc = +1;+ }+ }+ }++ /* RHS is real */+ else if( pRhs->flags & MEM_Real ){+ serial_type = aKey1[idx1];+ if( serial_type>=10 ){+ /* Serial types 12 or greater are strings and blobs (greater than+ ** numbers). Types 10 and 11 are currently "reserved for future + ** use", so it doesn't really matter what the results of comparing+ ** them to numberic values are. */+ rc = +1;+ }else if( serial_type==0 ){+ rc = -1;+ }else{+ double rhs = pRhs->u.r;+ double lhs;+ sqlite3BtreeSerialGet(&aKey1[d1], serial_type, &mem1);+ if( serial_type==7 ){+ lhs = mem1.u.r;+ }else{+ lhs = (double)mem1.u.i;+ }+ if( lhs<rhs ){+ rc = -1;+ }else if( lhs>rhs ){+ rc = +1;+ }+ }+ }++ /* RHS is a string */+ else if( pRhs->flags & MEM_Str ){+ getVarint32(&aKey1[idx1], serial_type);+ testcase( serial_type==12 );+ if( serial_type<12 ){+ rc = -1;+ }else if( !(serial_type & 0x01) ){+ rc = +1;+ }else{+ mem1.n = (serial_type - 12) / 2;+ testcase( (d1+mem1.n)==(unsigned)nKey1 );+ testcase( (d1+mem1.n+1)==(unsigned)nKey1 );+ if( (d1+mem1.n) > (unsigned)nKey1 ){+ pPKey2->errCode = (u8)SQLITE_CORRUPT_BKPT;+ return 0; /* Corruption */+ }else if( pKeyInfo->aColl[i] ){+ mem1.enc = pKeyInfo->enc;+ mem1.pBtree = pKeyInfo->pBtree;+ mem1.flags = MEM_Str;+ mem1.z = (char*)&aKey1[d1];+ rc = vdbeCompareMemString(+ &mem1, pRhs, pKeyInfo->aColl[i], &pPKey2->errCode+ );+ }else{+ int nCmp = MIN(mem1.n, pRhs->n);+ rc = memcmp(&aKey1[d1], pRhs->z, nCmp);+ if( rc==0 ) rc = mem1.n - pRhs->n; + }+ }+ }++ /* RHS is a blob */+ else if( pRhs->flags & MEM_Blob ){+ getVarint32(&aKey1[idx1], serial_type);+ testcase( serial_type==12 );+ if( serial_type<12 || (serial_type & 0x01) ){+ rc = -1;+ }else{+ int nStr = (serial_type - 12) / 2;+ testcase( (d1+nStr)==(unsigned)nKey1 );+ testcase( (d1+nStr+1)==(unsigned)nKey1 );+ if( (d1+nStr) > (unsigned)nKey1 ){+ pPKey2->errCode = (u8)SQLITE_CORRUPT_BKPT;+ return 0; /* Corruption */+ }else{+ int nCmp = MIN(nStr, pRhs->n);+ rc = memcmp(&aKey1[d1], pRhs->z, nCmp);+ if( rc==0 ) rc = nStr - pRhs->n;+ }+ }+ }++ /* RHS is null */+ else{+ serial_type = aKey1[idx1];+ rc = (serial_type!=0);+ }++ if( rc!=0 ){+ if( pKeyInfo->aSortOrder[i] ){+ rc = -rc;+ }+ assert( vdbeRecordCompareDebug(nKey1, pKey1, pPKey2, rc) );+ assert( mem1.szMalloc==0 ); /* See comment below */+ return rc;+ }++ i++;+ pRhs++;+ d1 += sqlite3BtreeSerialTypeLen(serial_type);+ idx1 += sqlite3BtreeVarintLen(serial_type);+ }while( idx1<(unsigned)szHdr1 && i<pPKey2->nField && d1<=(unsigned)nKey1 );++ /* No memory allocation is ever used on mem1. Prove this using+ ** the following assert(). If the assert() fails, it indicates a+ ** memory leak and a need to call sqlite3VdbeMemRelease(&mem1). */+ assert( mem1.szMalloc==0 );++ /* rc==0 here means that one or both of the keys ran out of fields and+ ** all the fields up to that point were equal. Return the default_rc+ ** value. */+ assert( CORRUPT_DB + || vdbeRecordCompareDebug(nKey1, pKey1, pPKey2, pPKey2->default_rc) + || pKeyInfo->pBtree->mallocFailed+ );+ return pPKey2->default_rc;+}+SQLITE_API int SQLITE_STDCALL sqlite3BtreeRecordCompare(+ int nKey1, const void *pKey1, /* Left key */+ UnpackedRecord *pPKey2 /* Right key */+){+ return sqlite3VdbeRecordCompareWithSkip(nKey1, pKey1, pPKey2, 0);+}++/*+** Return a pointer to an sqlite3BtreeRecordCompare() compatible function+** suitable for comparing serialized records to the unpacked record passed+** as the only argument.+*/+SQLITE_PRIVATE RecordCompare sqlite3VdbeFindCompare(UnpackedRecord *p){+ /* varintRecordCompareInt() and varintRecordCompareString() both assume+ ** that the size-of-header varint that occurs at the start of each record+ ** fits in a single byte (i.e. is 127 or less). varintRecordCompareInt()+ ** also assumes that it is safe to overread a buffer by at least the + ** maximum possible legal header size plus 8 bytes. Because there is+ ** guaranteed to be at least 74 (but not 136) bytes of padding following each+ ** buffer passed to varintRecordCompareInt() this makes it convenient to+ ** limit the size of the header to 64 bytes in cases where the first field+ ** is an integer.+ **+ ** The easiest way to enforce this limit is to consider only records with+ ** 13 fields or less. If the first field is an integer, the maximum legal+ ** header size is (12*5 + 1 + 1) bytes. */+ if( (p->pKeyInfo->nField + p->pKeyInfo->nXField)<=13 ){+ int flags = p->aMem[0].flags;+ if( p->pKeyInfo->aSortOrder[0] ){+ p->r1 = 1;+ p->r2 = -1;+ }else{+ p->r1 = -1;+ p->r2 = 1;+ }+ if( (flags & MEM_Int) ){+ return vdbeRecordCompareInt;+ }+ testcase( flags & MEM_Real );+ testcase( flags & MEM_Null );+ testcase( flags & MEM_Blob );+ if( (flags & (MEM_Real|MEM_Null|MEM_Blob))==0 && p->pKeyInfo->aColl[0]==0 ){+ assert( flags & MEM_Str );+ return vdbeRecordCompareString;+ }+ }++ return sqlite3BtreeRecordCompare;+}++/*+** Move data out of a btree key or data field and into a Mem structure.+** The data or key is taken from the entry that pCur is currently pointing+** to. offset and amt determine what portion of the data or key to retrieve.+** key is true to get the key or false to get data. The result is written+** into the pMem element.+**+** The pMem object must have been initialized. This routine will use+** pMem->zMalloc to hold the content from the btree, if possible. New+** pMem->zMalloc space will be allocated if necessary. The calling routine+** is responsible for making sure that the pMem object is eventually+** destroyed.+**+** If this routine fails for any reason (malloc returns NULL or unable+** to read from the disk) then the pMem is left in an inconsistent state.+*/+static SQLITE_NOINLINE int vdbeMemFromBtreeResize(+ BtCursor *pCur, /* Cursor pointing at record to retrieve. */+ u32 offset, /* Offset from the start of data to return bytes from. */+ u32 amt, /* Number of bytes to return. */+ int key, /* If true, retrieve from the btree key, not data. */+ Mem *pMem /* OUT: Return data in this Mem structure. */+){+ int rc;+ pMem->flags = MEM_Null;+ if( SQLITE_OK==(rc = sqlite3VdbeMemClearAndResize(pMem, amt+2)) ){+ if( key ){+ rc = sqlite3BtreeKey(pCur, offset, amt, pMem->z);+ }else{+ rc = sqlite3BtreeData(pCur, offset, amt, pMem->z);+ }+ if( rc==SQLITE_OK ){+ pMem->z[amt] = 0;+ pMem->z[amt+1] = 0;+ pMem->flags = MEM_Blob|MEM_Term;+ pMem->n = (int)amt;+ }else{+ sqlite3VdbeMemRelease(pMem);+ }+ }+ return rc;+}++SQLITE_PRIVATE int sqlite3VdbeMemFromBtree(+ BtCursor *pCur, /* Cursor pointing at record to retrieve. */+ u32 offset, /* Offset from the start of data to return bytes from. */+ u32 amt, /* Number of bytes to return. */+ int key, /* If true, retrieve from the btree key, not data. */+ Mem *pMem /* OUT: Return data in this Mem structure. */+){+ char *zData; /* Data from the btree layer */+ u32 available = 0; /* Number of bytes available on the local btree page */+ int rc = SQLITE_OK; /* Return code */++ assert( sqlite3BtreeCursorIsValid(pCur) );+ assert( !VdbeMemDynamic(pMem) );++ /* Note: the calls to BtreeKeyFetch() and DataFetch() below assert() + ** that both the BtShared and database handle mutexes are held. */+ assert( (pMem->flags & MEM_RowSet)==0 );+ if( key ){+ zData = (char *)sqlite3BtreeKeyFetch(pCur, &available);+ }else{+ zData = (char *)sqlite3BtreeDataFetch(pCur, &available);+ }+ assert( zData!=0 );++ if( offset+amt<=available ){+ pMem->z = &zData[offset];+ pMem->flags = MEM_Blob|MEM_Ephem;+ pMem->n = (int)amt;+ }else{+ rc = vdbeMemFromBtreeResize(pCur, offset, amt, key, pMem);+ }++ return rc;+}++/*+** pCur points at an index entry created using the OP_MakeRecord opcode.+** Read the rowid (the last field in the record) and store it in *rowid.+** Return SQLITE_OK if everything works, or an error code otherwise.+**+** pCur might be pointing to text obtained from a corrupt database file.+** So the content cannot be trusted. Do appropriate checks on the content.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeIdxRowid(Btree* pBtree, BtCursor *pCur, i64 *rowid){+ i64 nCellKey = 0;+ int rc;+ u32 szHdr; /* Size of the header */+ u32 typeRowid; /* Serial type of the rowid */+ u32 lenRowid; /* Size of the rowid */+ Mem m, v;++ /* Get the size of the index entry. Only indices entries of less+ ** than 2GiB are support - anything large must be database corruption.+ ** Any corruption is detected in sqlite3BtreeParseCellPtr(), though, so+ ** this code can safely assume that nCellKey is 32-bits + */+ assert( sqlite3BtreeCursorIsValid(pCur) );+ VVA_ONLY(rc =) sqlite3BtreeKeySize(pCur, &nCellKey);+ assert( rc==SQLITE_OK ); /* pCur is always valid so KeySize cannot fail */+ assert( (nCellKey & SQLITE_MAX_U32)==(u64)nCellKey );++ /* Read in the complete content of the index entry */+ sqlite3VdbeMemInit(&m, pBtree, 0);+ rc = sqlite3VdbeMemFromBtree(pCur, 0, (u32)nCellKey, 1, &m);+ if( rc ){+ return rc;+ }++ /* The index entry must begin with a header size */+ (void)getVarint32((u8*)m.z, szHdr);+ testcase( szHdr==3 );+ testcase( szHdr==m.n );+ if( unlikely(szHdr<3 || (int)szHdr>m.n) ){+ goto idx_rowid_corruption;+ }++ /* The last field of the index should be an integer - the ROWID.+ ** Verify that the last entry really is an integer. */+ (void)getVarint32((u8*)&m.z[szHdr-1], typeRowid);+ testcase( typeRowid==1 );+ testcase( typeRowid==2 );+ testcase( typeRowid==3 );+ testcase( typeRowid==4 );+ testcase( typeRowid==5 );+ testcase( typeRowid==6 );+ testcase( typeRowid==8 );+ testcase( typeRowid==9 );+ if( unlikely(typeRowid<1 || typeRowid>9 || typeRowid==7) ){+ goto idx_rowid_corruption;+ }+ lenRowid = sqlite3SmallTypeSizes[typeRowid];+ testcase( (u32)m.n==szHdr+lenRowid );+ if( unlikely((u32)m.n<szHdr+lenRowid) ){+ goto idx_rowid_corruption;+ }++ /* Fetch the integer off the end of the index record */+ sqlite3BtreeSerialGet((u8*)&m.z[m.n-lenRowid], typeRowid, &v);+ *rowid = v.u.i;+ sqlite3VdbeMemRelease(&m);+ return SQLITE_OK;++ /* Jump here if database corruption is detected after m has been+ ** allocated. Free the m object and return SQLITE_CORRUPT. */+idx_rowid_corruption:+ testcase( m.szMalloc!=0 );+ sqlite3VdbeMemRelease(&m);+ return SQLITE_CORRUPT_BKPT;+}++/************** End of btree.c ***********************************************/+/************** Begin file backup.c ******************************************/+/*+** 2009 January 28+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This file contains the implementation of the sqlite3_backup_XXX() +** API functions and the related features.+*/+/* #include "sqliteInt.h" */+/* #include "btreeInt.h" */++/*+** Structure allocated for each backup operation.+*/+struct sqlite3_backup {+ Btree *pDest; /* Destination b-tree file */+ u32 iDestSchema; /* Original schema cookie in destination */+ int bDestLocked; /* True once a write-transaction is open on pDest */++ Pgno iNext; /* Page number of the next source page to copy */+ Btree *pSrc; /* Source b-tree file */++ int rc; /* Backup process error code */++ /* These two variables are set by every call to backup_step(). They are+ ** read by calls to backup_remaining() and backup_pagecount().+ */+ Pgno nRemaining; /* Number of pages left to copy */+ Pgno nPagecount; /* Total number of pages to copy */++ int isAttached; /* True once backup has been registered with pager */+ sqlite3_backup *pNext; /* Next backup associated with source pager */+};++/*+** Argument rc is an SQLite error code. Return true if this error is +** considered fatal if encountered during a backup operation. All errors+** are considered fatal except for SQLITE_BUSY and SQLITE_LOCKED.+*/+static int isFatalError(int rc){+ return (rc!=SQLITE_OK && rc!=SQLITE_BUSY && ALWAYS(rc!=SQLITE_LOCKED));+}++/*+** Parameter zSrcData points to a buffer containing the data for +** page iSrcPg from the source database. Copy this data into the +** destination database.+*/+static int backupOnePage(+ sqlite3_backup *p, /* Backup handle */+ Pgno iSrcPg, /* Source database page to backup */+ const u8 *zSrcData, /* Source database page data */+ int bUpdate /* True for an update, false otherwise */+){+ Pager * const pDestPager = sqlite3BtreePager(p->pDest);+ const int nSrcPgsz = sqlite3BtreeGetPageSize(p->pSrc);+ int nDestPgsz = sqlite3BtreeGetPageSize(p->pDest);+ const int nCopy = MIN(nSrcPgsz, nDestPgsz);+ const i64 iEnd = (i64)iSrcPg*(i64)nSrcPgsz;+#ifdef SQLITE_HAS_CODEC+ /* Use BtreeGetReserveNoMutex() for the source b-tree, as although it is+ ** guaranteed that the shared-mutex is held by this thread, handle+ ** p->pSrc may not actually be the owner. */+ int nSrcReserve = sqlite3BtreeGetReserveNoMutex(p->pSrc);+ int nDestReserve = sqlite3BtreeGetOptimalReserve(p->pDest);+#endif+ int rc = SQLITE_OK;+ i64 iOff;++ assert( sqlite3BtreeGetReserveNoMutex(p->pSrc)>=0 );+ assert( p->bDestLocked );+ assert( !isFatalError(p->rc) );+ assert( iSrcPg!=PENDING_BYTE_PAGE(p->pSrc->pBt) );+ assert( zSrcData );++#ifdef SQLITE_HAS_CODEC+ /* Backup is not possible if the page size of the destination is changing+ ** and a codec is in use.+ */+ if( nSrcPgsz!=nDestPgsz && sqlite3PagerGetCodec(pDestPager)!=0 ){+ rc = SQLITE_READONLY;+ }++ /* Backup is not possible if the number of bytes of reserve space differ+ ** between source and destination. If there is a difference, try to+ ** fix the destination to agree with the source. If that is not possible,+ ** then the backup cannot proceed.+ */+ if( nSrcReserve!=nDestReserve ){+ u32 newPgsz = nSrcPgsz;+ rc = sqlite3PagerSetPagesize(pDestPager, &newPgsz, nSrcReserve);+ if( rc==SQLITE_OK && newPgsz!=nSrcPgsz ) rc = SQLITE_READONLY;+ }+#endif++ /* This loop runs once for each destination page spanned by the source + ** page. For each iteration, variable iOff is set to the byte offset+ ** of the destination page.+ */+ for(iOff=iEnd-(i64)nSrcPgsz; rc==SQLITE_OK && iOff<iEnd; iOff+=nDestPgsz){+ DbPage *pDestPg = 0;+ Pgno iDest = (Pgno)(iOff/nDestPgsz)+1;+ if( iDest==PENDING_BYTE_PAGE(p->pDest->pBt) ) continue;+ if( SQLITE_OK==(rc = sqlite3PagerGet(pDestPager, iDest, &pDestPg))+ && SQLITE_OK==(rc = sqlite3PagerWrite(pDestPg))+ ){+ const u8 *zIn = &zSrcData[iOff%nSrcPgsz];+ u8 *zDestData = sqlite3PagerGetData(pDestPg);+ u8 *zOut = &zDestData[iOff%nDestPgsz];++ /* Copy the data from the source page into the destination page.+ ** Then clear the Btree layer MemPage.isInit flag. Both this module+ ** and the pager code use this trick (clearing the first byte+ ** of the page 'extra' space to invalidate the Btree layers+ ** cached parse of the page). MemPage.isInit is marked + ** "MUST BE FIRST" for this purpose.+ */+ memcpy(zOut, zIn, nCopy);+ ((u8 *)sqlite3PagerGetExtra(pDestPg))[0] = 0;+ if( iOff==0 && bUpdate==0 ){+ sqlite3Put4byte(&zOut[28], sqlite3BtreeLastPage(p->pSrc));+ }+ }+ sqlite3PagerUnref(pDestPg);+ }++ return rc;+}++/*+** This function is called after the contents of page iPage of the+** source database have been modified. If page iPage has already been +** copied into the destination database, then the data written to the+** destination is now invalidated. The destination copy of iPage needs+** to be updated with the new data before the backup operation is+** complete.+**+** It is assumed that the mutex associated with the BtShared object+** corresponding to the source database is held when this function is+** called.+*/+static SQLITE_NOINLINE void backupUpdate(+ sqlite3_backup *p,+ Pgno iPage,+ const u8 *aData+){+ assert( p!=0 );+ do{+ assert( sqlite3_mutex_held(p->pSrc->pBt->mutex) );+ if( !isFatalError(p->rc) && iPage<p->iNext ){+ /* The backup process p has already copied page iPage. But now it+ ** has been modified by a transaction on the source pager. Copy+ ** the new data into the backup.+ */+ int rc;+ assert( p->pDest );+ sqlite3_mutex_enter(p->pDest->mutex);+ rc = backupOnePage(p, iPage, aData, 1);+ sqlite3_mutex_leave(p->pDest->mutex);+ assert( rc!=SQLITE_BUSY && rc!=SQLITE_LOCKED );+ if( rc!=SQLITE_OK ){+ p->rc = rc;+ }+ }+ }while( (p = p->pNext)!=0 );+}+SQLITE_PRIVATE void sqlite3BackupUpdate(sqlite3_backup *pBackup, Pgno iPage, const u8 *aData){+ if( pBackup ) backupUpdate(pBackup, iPage, aData);+}++/*+** Restart the backup process. This is called when the pager layer+** detects that the database has been modified by an external database+** connection. In this case there is no way of knowing which of the+** pages that have been copied into the destination database are still +** valid and which are not, so the entire process needs to be restarted.+**+** It is assumed that the mutex associated with the BtShared object+** corresponding to the source database is held when this function is+** called.+*/+SQLITE_PRIVATE void sqlite3BackupRestart(sqlite3_backup *pBackup){+ sqlite3_backup *p; /* Iterator variable */+ for(p=pBackup; p; p=p->pNext){+ assert( sqlite3_mutex_held(p->pSrc->pBt->mutex) );+ p->iNext = 1;+ }+}++/************** End of backup.c **********************************************/+/************** Begin file journal.c *****************************************/+/*+** 2007 August 22+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file implements a special kind of sqlite3_file object used+** by SQLite to create journal files if the atomic-write optimization+** is enabled.+**+** The distinctive characteristic of this sqlite3_file is that the+** actual on disk file is created lazily. When the file is created,+** the caller specifies a buffer size for an in-memory buffer to+** be used to service read() and write() requests. The actual file+** on disk is not created or populated until either:+**+** 1) The in-memory representation grows too large for the allocated +** buffer, or+** 2) The sqlite3JournalCreate() function is called.+*/+#ifdef SQLITE_ENABLE_ATOMIC_WRITE+/* #include "sqliteInt.h" */+++/*+** A JournalFile object is a subclass of sqlite3_file used by+** as an open file handle for journal files.+*/+struct JournalFile {+ sqlite3_io_methods *pMethod; /* I/O methods on journal files */+ int nBuf; /* Size of zBuf[] in bytes */+ char *zBuf; /* Space to buffer journal writes */+ int iSize; /* Amount of zBuf[] currently used */+ int flags; /* xOpen flags */+ sqlite3_vfs *pVfs; /* The "real" underlying VFS */+ sqlite3_file *pReal; /* The "real" underlying file descriptor */+ const char *zJournal; /* Name of the journal file */+};+typedef struct JournalFile JournalFile;++/*+** If it does not already exists, create and populate the on-disk file +** for JournalFile p.+*/+static int createFile(JournalFile *p){+ int rc = SQLITE_OK;+ if( !p->pReal ){+ sqlite3_file *pReal = (sqlite3_file *)&p[1];+ rc = sqlite3OsOpen(p->pVfs, p->zJournal, pReal, p->flags, 0);+ if( rc==SQLITE_OK ){+ p->pReal = pReal;+ if( p->iSize>0 ){+ assert(p->iSize<=p->nBuf);+ rc = sqlite3OsWrite(p->pReal, p->zBuf, p->iSize, 0);+ }+ if( rc!=SQLITE_OK ){+ /* If an error occurred while writing to the file, close it before+ ** returning. This way, SQLite uses the in-memory journal data to + ** roll back changes made to the internal page-cache before this+ ** function was called. */+ sqlite3OsClose(pReal);+ p->pReal = 0;+ }+ }+ }+ return rc;+}++/*+** Close the file.+*/+static int jrnlClose(sqlite3_file *pJfd){+ JournalFile *p = (JournalFile *)pJfd;+ if( p->pReal ){+ sqlite3OsClose(p->pReal);+ }+ sqlite3_free(p->zBuf);+ return SQLITE_OK;+}++/*+** Read data from the file.+*/+static int jrnlRead(+ sqlite3_file *pJfd, /* The journal file from which to read */+ void *zBuf, /* Put the results here */+ int iAmt, /* Number of bytes to read */+ sqlite_int64 iOfst /* Begin reading at this offset */+){+ int rc = SQLITE_OK;+ JournalFile *p = (JournalFile *)pJfd;+ if( p->pReal ){+ rc = sqlite3OsRead(p->pReal, zBuf, iAmt, iOfst);+ }else if( (iAmt+iOfst)>p->iSize ){+ rc = SQLITE_IOERR_SHORT_READ;+ }else{+ memcpy(zBuf, &p->zBuf[iOfst], iAmt);+ }+ return rc;+}++/*+** Write data to the file.+*/+static int jrnlWrite(+ sqlite3_file *pJfd, /* The journal file into which to write */+ const void *zBuf, /* Take data to be written from here */+ int iAmt, /* Number of bytes to write */+ sqlite_int64 iOfst /* Begin writing at this offset into the file */+){+ int rc = SQLITE_OK;+ JournalFile *p = (JournalFile *)pJfd;+ if( !p->pReal && (iOfst+iAmt)>p->nBuf ){+ rc = createFile(p);+ }+ if( rc==SQLITE_OK ){+ if( p->pReal ){+ rc = sqlite3OsWrite(p->pReal, zBuf, iAmt, iOfst);+ }else{+ memcpy(&p->zBuf[iOfst], zBuf, iAmt);+ if( p->iSize<(iOfst+iAmt) ){+ p->iSize = (iOfst+iAmt);+ }+ }+ }+ return rc;+}++/*+** Truncate the file.+*/+static int jrnlTruncate(sqlite3_file *pJfd, sqlite_int64 size){+ int rc = SQLITE_OK;+ JournalFile *p = (JournalFile *)pJfd;+ if( p->pReal ){+ rc = sqlite3OsTruncate(p->pReal, size);+ }else if( size<p->iSize ){+ p->iSize = size;+ }+ return rc;+}++/*+** Sync the file.+*/+static int jrnlSync(sqlite3_file *pJfd, int flags){+ int rc;+ JournalFile *p = (JournalFile *)pJfd;+ if( p->pReal ){+ rc = sqlite3OsSync(p->pReal, flags);+ }else{+ rc = SQLITE_OK;+ }+ return rc;+}++/*+** Query the size of the file in bytes.+*/+static int jrnlFileSize(sqlite3_file *pJfd, sqlite_int64 *pSize){+ int rc = SQLITE_OK;+ JournalFile *p = (JournalFile *)pJfd;+ if( p->pReal ){+ rc = sqlite3OsFileSize(p->pReal, pSize);+ }else{+ *pSize = (sqlite_int64) p->iSize;+ }+ return rc;+}++/*+** Table of methods for JournalFile sqlite3_file object.+*/+static struct sqlite3_io_methods JournalFileMethods = {+ 1, /* iVersion */+ jrnlClose, /* xClose */+ jrnlRead, /* xRead */+ jrnlWrite, /* xWrite */+ jrnlTruncate, /* xTruncate */+ jrnlSync, /* xSync */+ jrnlFileSize, /* xFileSize */+ 0, /* xLock */+ 0, /* xUnlock */+ 0, /* xCheckReservedLock */+ 0, /* xFileControl */+ 0, /* xSectorSize */+ 0, /* xDeviceCharacteristics */+ 0, /* xShmMap */+ 0, /* xShmLock */+ 0, /* xShmBarrier */+ 0 /* xShmUnmap */+};++/* +** Open a journal file.+*/+SQLITE_PRIVATE int sqlite3JournalOpen(+ sqlite3_vfs *pVfs, /* The VFS to use for actual file I/O */+ const char *zName, /* Name of the journal file */+ sqlite3_file *pJfd, /* Preallocated, blank file handle */+ int flags, /* Opening flags */+ int nBuf /* Bytes buffered before opening the file */+){+ JournalFile *p = (JournalFile *)pJfd;+ memset(p, 0, sqlite3JournalSize(pVfs));+ if( nBuf>0 ){+ p->zBuf = sqlite3MallocZero(nBuf);+ if( !p->zBuf ){+ return SQLITE_NOMEM;+ }+ }else{+ return sqlite3OsOpen(pVfs, zName, pJfd, flags, 0);+ }+ p->pMethod = &JournalFileMethods;+ p->nBuf = nBuf;+ p->flags = flags;+ p->zJournal = zName;+ p->pVfs = pVfs;+ return SQLITE_OK;+}++/*+** If the argument p points to a JournalFile structure, and the underlying+** file has not yet been created, create it now.+*/+SQLITE_PRIVATE int sqlite3JournalCreate(sqlite3_file *p){+ if( p->pMethods!=&JournalFileMethods ){+ return SQLITE_OK;+ }+ return createFile((JournalFile *)p);+}++/*+** The file-handle passed as the only argument is guaranteed to be an open+** file. It may or may not be of class JournalFile. If the file is a+** JournalFile, and the underlying file on disk has not yet been opened,+** return 0. Otherwise, return 1.+*/+SQLITE_PRIVATE int sqlite3JournalExists(sqlite3_file *p){+ return (p->pMethods!=&JournalFileMethods || ((JournalFile *)p)->pReal!=0);+}++/* +** Return the number of bytes required to store a JournalFile that uses vfs+** pVfs to create the underlying on-disk files.+*/+SQLITE_PRIVATE int sqlite3JournalSize(sqlite3_vfs *pVfs){+ return (pVfs->szOsFile+sizeof(JournalFile));+}+#endif++/************** End of journal.c *********************************************/+/************** Begin file memjournal.c **************************************/+/*+** 2008 October 7+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+**+** This file contains code use to implement an in-memory rollback journal.+** The in-memory rollback journal is used to journal transactions for+** ":memory:" databases and when the journal_mode=MEMORY pragma is used.+*/+/* #include "sqliteInt.h" */++/* Forward references to internal structures */+typedef struct MemJournal MemJournal;+typedef struct FilePoint FilePoint;+typedef struct FileChunk FileChunk;++/* Space to hold the rollback journal is allocated in increments of+** this many bytes.+**+** The size chosen is a little less than a power of two. That way,+** the FileChunk object will have a size that almost exactly fills+** a power-of-two allocation. This minimizes wasted space in power-of-two+** memory allocators.+*/+#define JOURNAL_CHUNKSIZE ((int)(1024-sizeof(FileChunk*)))++/*+** The rollback journal is composed of a linked list of these structures.+*/+struct FileChunk {+ FileChunk *pNext; /* Next chunk in the journal */+ u8 zChunk[JOURNAL_CHUNKSIZE]; /* Content of this chunk */+};++/*+** An instance of this object serves as a cursor into the rollback journal.+** The cursor can be either for reading or writing.+*/+struct FilePoint {+ sqlite3_int64 iOffset; /* Offset from the beginning of the file */+ FileChunk *pChunk; /* Specific chunk into which cursor points */+};++/*+** This subclass is a subclass of sqlite3_file. Each open memory-journal+** is an instance of this class.+*/+struct MemJournal {+ sqlite3_io_methods *pMethod; /* Parent class. MUST BE FIRST */+ FileChunk *pFirst; /* Head of in-memory chunk-list */+ FilePoint endpoint; /* Pointer to the end of the file */+ FilePoint readpoint; /* Pointer to the end of the last xRead() */+};++/*+** Read data from the in-memory journal file. This is the implementation+** of the sqlite3_vfs.xRead method.+*/+static int memjrnlRead(+ sqlite3_file *pJfd, /* The journal file from which to read */+ void *zBuf, /* Put the results here */+ int iAmt, /* Number of bytes to read */+ sqlite_int64 iOfst /* Begin reading at this offset */+){+ MemJournal *p = (MemJournal *)pJfd;+ u8 *zOut = zBuf;+ int nRead = iAmt;+ int iChunkOffset;+ FileChunk *pChunk;++ /* SQLite never tries to read past the end of a rollback journal file */+ assert( iOfst+iAmt<=p->endpoint.iOffset );++ if( p->readpoint.iOffset!=iOfst || iOfst==0 ){+ sqlite3_int64 iOff = 0;+ for(pChunk=p->pFirst; + ALWAYS(pChunk) && (iOff+JOURNAL_CHUNKSIZE)<=iOfst;+ pChunk=pChunk->pNext+ ){+ iOff += JOURNAL_CHUNKSIZE;+ }+ }else{+ pChunk = p->readpoint.pChunk;+ }++ iChunkOffset = (int)(iOfst%JOURNAL_CHUNKSIZE);+ do {+ int iSpace = JOURNAL_CHUNKSIZE - iChunkOffset;+ int nCopy = MIN(nRead, (JOURNAL_CHUNKSIZE - iChunkOffset));+ memcpy(zOut, &pChunk->zChunk[iChunkOffset], nCopy);+ zOut += nCopy;+ nRead -= iSpace;+ iChunkOffset = 0;+ } while( nRead>=0 && (pChunk=pChunk->pNext)!=0 && nRead>0 );+ p->readpoint.iOffset = iOfst+iAmt;+ p->readpoint.pChunk = pChunk;++ return SQLITE_OK;+}++/*+** Write data to the file.+*/+static int memjrnlWrite(+ sqlite3_file *pJfd, /* The journal file into which to write */+ const void *zBuf, /* Take data to be written from here */+ int iAmt, /* Number of bytes to write */+ sqlite_int64 iOfst /* Begin writing at this offset into the file */+){+ MemJournal *p = (MemJournal *)pJfd;+ int nWrite = iAmt;+ u8 *zWrite = (u8 *)zBuf;++ /* An in-memory journal file should only ever be appended to. Random+ ** access writes are not required by sqlite.+ */+ assert( iOfst==p->endpoint.iOffset );+ UNUSED_PARAMETER(iOfst);++ while( nWrite>0 ){+ FileChunk *pChunk = p->endpoint.pChunk;+ int iChunkOffset = (int)(p->endpoint.iOffset%JOURNAL_CHUNKSIZE);+ int iSpace = MIN(nWrite, JOURNAL_CHUNKSIZE - iChunkOffset);++ if( iChunkOffset==0 ){+ /* New chunk is required to extend the file. */+ FileChunk *pNew = sqlite3_malloc(sizeof(FileChunk));+ if( !pNew ){+ return SQLITE_IOERR_NOMEM;+ }+ pNew->pNext = 0;+ if( pChunk ){+ assert( p->pFirst );+ pChunk->pNext = pNew;+ }else{+ assert( !p->pFirst );+ p->pFirst = pNew;+ }+ p->endpoint.pChunk = pNew;+ }++ memcpy(&p->endpoint.pChunk->zChunk[iChunkOffset], zWrite, iSpace);+ zWrite += iSpace;+ nWrite -= iSpace;+ p->endpoint.iOffset += iSpace;+ }++ return SQLITE_OK;+}++/*+** Truncate the file.+*/+static int memjrnlTruncate(sqlite3_file *pJfd, sqlite_int64 size){+ MemJournal *p = (MemJournal *)pJfd;+ FileChunk *pChunk;+ assert(size==0);+ UNUSED_PARAMETER(size);+ pChunk = p->pFirst;+ while( pChunk ){+ FileChunk *pTmp = pChunk;+ pChunk = pChunk->pNext;+ sqlite3_free(pTmp);+ }+ sqlite3MemJournalOpen(pJfd);+ return SQLITE_OK;+}++/*+** Close the file.+*/+static int memjrnlClose(sqlite3_file *pJfd){+ memjrnlTruncate(pJfd, 0);+ return SQLITE_OK;+}+++/*+** Sync the file.+**+** Syncing an in-memory journal is a no-op. And, in fact, this routine+** is never called in a working implementation. This implementation+** exists purely as a contingency, in case some malfunction in some other+** part of SQLite causes Sync to be called by mistake.+*/+static int memjrnlSync(sqlite3_file *NotUsed, int NotUsed2){+ UNUSED_PARAMETER2(NotUsed, NotUsed2);+ return SQLITE_OK;+}++/*+** Query the size of the file in bytes.+*/+static int memjrnlFileSize(sqlite3_file *pJfd, sqlite_int64 *pSize){+ MemJournal *p = (MemJournal *)pJfd;+ *pSize = (sqlite_int64) p->endpoint.iOffset;+ return SQLITE_OK;+}++/*+** Table of methods for MemJournal sqlite3_file object.+*/+static const struct sqlite3_io_methods MemJournalMethods = {+ 1, /* iVersion */+ memjrnlClose, /* xClose */+ memjrnlRead, /* xRead */+ memjrnlWrite, /* xWrite */+ memjrnlTruncate, /* xTruncate */+ memjrnlSync, /* xSync */+ memjrnlFileSize, /* xFileSize */+ 0, /* xLock */+ 0, /* xUnlock */+ 0, /* xCheckReservedLock */+ 0, /* xFileControl */+ 0, /* xSectorSize */+ 0, /* xDeviceCharacteristics */+ 0, /* xShmMap */+ 0, /* xShmLock */+ 0, /* xShmBarrier */+ 0, /* xShmUnmap */+ 0, /* xFetch */+ 0 /* xUnfetch */+};++/* +** Open a journal file.+*/+SQLITE_PRIVATE void sqlite3MemJournalOpen(sqlite3_file *pJfd){+ MemJournal *p = (MemJournal *)pJfd;+ assert( EIGHT_BYTE_ALIGNMENT(p) );+ memset(p, 0, sqlite3MemJournalSize());+ p->pMethod = (sqlite3_io_methods*)&MemJournalMethods;+}++/*+** Return true if the file-handle passed as an argument is +** an in-memory journal +*/+SQLITE_PRIVATE int sqlite3IsMemJournal(sqlite3_file *pJfd){+ return pJfd->pMethods==&MemJournalMethods;+}++/* +** Return the number of bytes required to store a MemJournal file descriptor.+*/+SQLITE_PRIVATE int sqlite3MemJournalSize(void){+ return sizeof(MemJournal);+}++/************** End of memjournal.c ******************************************/+/************** Begin file main.c ********************************************/+/* #include "sqliteInt.h" */++/* IMPLEMENTATION-OF: R-63124-39300 The sqlite3_sourceid() function returns a+** pointer to a string constant whose value is the same as the+** SQLITE_SOURCE_ID C preprocessor macro. +*/+SQLITE_PRIVATE const char *sqlite3_sourceid(void){ return SQLITE_SOURCE_ID; }++/*+** If the following global variable points to a string which is the+** name of a directory, then that directory will be used to store+** temporary files.+**+** See also the "PRAGMA temp_store_directory" SQL command.+*/+SQLITE_PRIVATE char *sqlite3_temp_directory = 0;++/*+** Initialize SQLite. +**+** This routine must be called to initialize the memory allocation,+** VFS, and mutex subsystems prior to doing any serious work with+** SQLite. But as long as you do not compile with SQLITE_OMIT_AUTOINIT+** this routine will be called automatically by key routines such as+** sqlite3_open(). +**+** This routine is a no-op except on its very first call for the process,+** or for the first call after a call to sqlite3BtreeShutdown.+**+** The first thread to call this routine runs the initialization to+** completion. If subsequent threads call this routine before the first+** thread has finished the initialization process, then the subsequent+** threads must block until the first thread finishes with the initialization.+**+** The first thread might call this routine recursively. Recursive+** calls to this routine should not block, of course. Otherwise the+** initialization process would never complete.+**+** Let X be the first thread to enter this routine. Let Y be some other+** thread. Then while the initial invocation of this routine by X is+** incomplete, it is required that:+**+** * Calls to this routine from Y must block until the outer-most+** call by X completes.+**+** * Recursive calls to this routine from thread X return immediately+** without blocking.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeInitialize(void){+ MUTEX_LOGIC( sqlite3_mutex *pMaster; ) /* The main static mutex */+ int rc; /* Result code */+#ifdef SQLITE_EXTRA_INIT+ int bRunExtraInit = 0; /* Extra initialization needed */+#endif++#ifdef SQLITE_OMIT_WSD+ rc = sqlite3_wsd_init(4096, 24);+ if( rc!=SQLITE_OK ){+ return rc;+ }+#endif++ /* If the following assert() fails on some obscure processor/compiler+ ** combination, the work-around is to set the correct pointer+ ** size at compile-time using -DSQLITE_PTRSIZE=n compile-time option */+ assert( SQLITE_PTRSIZE==sizeof(char*) );++ /* If SQLite is already completely initialized, then this call+ ** to sqlite3BtreeInitialize() should be a no-op. But the initialization+ ** must be complete. So isInit must not be set until the very end+ ** of this routine.+ */+ if( sqlite3GlobalConfig.isInit ) return SQLITE_OK;++ /* Make sure the mutex subsystem is initialized. If unable to + ** initialize the mutex subsystem, return early with the error.+ ** If the system is so sick that we are unable to allocate a mutex,+ ** there is not much SQLite is going to be able to do.+ **+ ** The mutex subsystem must take care of serializing its own+ ** initialization.+ */+ rc = sqlite3MutexInit();+ if( rc ) return rc;++ /* Initialize the malloc() system and the recursive pInitMutex mutex.+ ** This operation is protected by the STATIC_MASTER mutex. Note that+ ** MutexAlloc() is called for a static mutex prior to initializing the+ ** malloc subsystem - this implies that the allocation of a static+ ** mutex must not require support from the malloc subsystem.+ */+ MUTEX_LOGIC( pMaster = sqlite3MutexAlloc(SQLITE_MUTEX_STATIC_MASTER); )+ sqlite3_mutex_enter(pMaster);+ sqlite3GlobalConfig.isMutexInit = 1;+ if( !sqlite3GlobalConfig.isMallocInit ){+ rc = sqlite3MallocInit();+ }+ if( rc==SQLITE_OK ){+ sqlite3GlobalConfig.isMallocInit = 1;+ if( !sqlite3GlobalConfig.pInitMutex ){+ sqlite3GlobalConfig.pInitMutex =+ sqlite3MutexAlloc(SQLITE_MUTEX_RECURSIVE);+ if( sqlite3GlobalConfig.bCoreMutex && !sqlite3GlobalConfig.pInitMutex ){+ rc = SQLITE_NOMEM;+ }+ }+ }+ if( rc==SQLITE_OK ){+ sqlite3GlobalConfig.nRefInitMutex++;+ }+ sqlite3_mutex_leave(pMaster);++ /* If rc is not SQLITE_OK at this point, then either the malloc+ ** subsystem could not be initialized or the system failed to allocate+ ** the pInitMutex mutex. Return an error in either case. */+ if( rc!=SQLITE_OK ){+ return rc;+ }++ /* Do the rest of the initialization under the recursive mutex so+ ** that we will be able to handle recursive calls into+ ** sqlite3BtreeInitialize(). The recursive calls normally come through+ ** sqlite3_os_init() when it invokes sqlite3_vfs_register(), but other+ ** recursive calls might also be possible.+ **+ ** IMPLEMENTATION-OF: R-00140-37445 SQLite automatically serializes calls+ ** to the xInit method, so the xInit method need not be threadsafe.+ **+ ** The following mutex is what serializes access to the appdef pcache xInit+ ** methods. The sqlite3_pcache_methods.xInit() all is embedded in the+ ** call to sqlite3PcacheInitialize().+ */+ sqlite3_mutex_enter(sqlite3GlobalConfig.pInitMutex);+ if( sqlite3GlobalConfig.isInit==0 && sqlite3GlobalConfig.inProgress==0 ){+ sqlite3GlobalConfig.inProgress = 1;+ if( sqlite3GlobalConfig.isPCacheInit==0 ){+ rc = sqlite3PcacheInitialize();+ }+ if( rc==SQLITE_OK ){+ sqlite3GlobalConfig.isPCacheInit = 1;+ rc = sqlite3OsInit();+ }+ if( rc==SQLITE_OK ){+ sqlite3PCacheBufferSetup( sqlite3GlobalConfig.pPage, + sqlite3GlobalConfig.szPage, sqlite3GlobalConfig.nPage);+ sqlite3GlobalConfig.isInit = 1;+#ifdef SQLITE_EXTRA_INIT+ bRunExtraInit = 1;+#endif+ }+ sqlite3GlobalConfig.inProgress = 0;+ }+ sqlite3_mutex_leave(sqlite3GlobalConfig.pInitMutex);++ /* Go back under the static mutex and clean up the recursive+ ** mutex to prevent a resource leak.+ */+ sqlite3_mutex_enter(pMaster);+ sqlite3GlobalConfig.nRefInitMutex--;+ if( sqlite3GlobalConfig.nRefInitMutex<=0 ){+ assert( sqlite3GlobalConfig.nRefInitMutex==0 );+ sqlite3_mutex_free(sqlite3GlobalConfig.pInitMutex);+ sqlite3GlobalConfig.pInitMutex = 0;+ }+ sqlite3_mutex_leave(pMaster);++ /* The following is just a sanity check to make sure SQLite has+ ** been compiled correctly. It is important to run this code, but+ ** we don't want to run it too often and soak up CPU cycles for no+ ** reason. So we run it once during initialization.+ */+#ifndef NDEBUG+#ifndef SQLITE_OMIT_FLOATING_POINT+ /* This section of code's only "output" is via assert() statements. */+ if ( rc==SQLITE_OK ){+ u64 x = (((u64)1)<<63)-1;+ double y;+ assert(sizeof(x)==8);+ assert(sizeof(x)==sizeof(y));+ memcpy(&y, &x, 8);+ assert( sqlite3IsNaN(y) );+ }+#endif+#endif++ /* Do extra initialization steps requested by the SQLITE_EXTRA_INIT+ ** compile-time option.+ */+#ifdef SQLITE_EXTRA_INIT+ if( bRunExtraInit ){+ int SQLITE_EXTRA_INIT(const char*);+ rc = SQLITE_EXTRA_INIT(0);+ }+#endif++ return rc;+}++/*+** Undo the effects of sqlite3BtreeInitialize(). Must not be called while+** there are outstanding database connections or memory allocations or+** while any part of SQLite is otherwise in use in any thread. This+** routine is not threadsafe. But it is safe to invoke this routine+** on when SQLite is already shut down. If SQLite is already shut down+** when this routine is invoked, then this routine is a harmless no-op.+*/+SQLITE_API int SQLITE_STDCALL sqlite3BtreeShutdown(void){+#ifdef SQLITE_OMIT_WSD+ int rc = sqlite3_wsd_init(4096, 24);+ if( rc!=SQLITE_OK ){+ return rc;+ }+#endif++ if( sqlite3GlobalConfig.isInit ){+#ifdef SQLITE_EXTRA_SHUTDOWN+ void SQLITE_EXTRA_SHUTDOWN(void);+ SQLITE_EXTRA_SHUTDOWN();+#endif+ sqlite3_os_end();+ sqlite3GlobalConfig.isInit = 0;+ }+ if( sqlite3GlobalConfig.isPCacheInit ){+ sqlite3PcacheShutdown();+ sqlite3GlobalConfig.isPCacheInit = 0;+ }+ if( sqlite3GlobalConfig.isMallocInit ){+ sqlite3MallocEnd();+ sqlite3GlobalConfig.isMallocInit = 0;+ }+ if( sqlite3GlobalConfig.isMutexInit ){+ sqlite3MutexEnd();+ sqlite3GlobalConfig.isMutexInit = 0;+ }++ return SQLITE_OK;+}++/*+** The following routines are substitutes for constants SQLITE_CORRUPT,+** SQLITE_MISUSE, SQLITE_CANTOPEN, SQLITE_IOERR and possibly other error+** constants. They serve two purposes:+**+** 1. Serve as a convenient place to set a breakpoint in a debugger+** to detect when version error conditions occurs.+**+** 2. Invoke sqlite3_log() to provide the source code location where+** a low-level error is first detected.+*/+SQLITE_PRIVATE int sqlite3CorruptError(int lineno){+ testcase( sqlite3GlobalConfig.xLog!=0 );+ sqlite3_log(SQLITE_CORRUPT,+ "database corruption at line %d of [%.10s]",+ lineno, 20+sqlite3_sourceid());+ return SQLITE_CORRUPT;+}+SQLITE_PRIVATE int sqlite3MisuseError(int lineno){+ testcase( sqlite3GlobalConfig.xLog!=0 );+ sqlite3_log(SQLITE_MISUSE, + "misuse at line %d of [%.10s]",+ lineno, 20+sqlite3_sourceid());+ return SQLITE_MISUSE;+}+SQLITE_PRIVATE int sqlite3CantopenError(int lineno){+ testcase( sqlite3GlobalConfig.xLog!=0 );+ sqlite3_log(SQLITE_CANTOPEN, + "cannot open file at line %d of [%.10s]",+ lineno, 20+sqlite3_sourceid());+ return SQLITE_CANTOPEN;+}++/*+** Invoke the given busy handler.+**+** This routine is called when an operation failed with a lock.+** If this routine returns non-zero, the lock is retried. If it+** returns 0, the operation aborts with an SQLITE_BUSY error.+*/+SQLITE_PRIVATE int sqlite3InvokeBusyHandler(BusyHandler *p){+ int rc;+ if( NEVER(p==0) || p->xFunc==0 || p->nBusy<0 ) return 0;+ rc = p->xFunc(p->pArg, p->nBusy);+ if( rc==0 ){+ p->nBusy = -1;+ }else{+ p->nBusy++;+ }+ return rc; +}++/*+** This API allows applications to modify the global configuration of+** the SQLite library at run-time.+**+** This routine should only be called when there are no outstanding+** database connections or memory allocations. This routine is not+** threadsafe. Failure to heed these warnings can lead to unpredictable+** behavior.+*/+SQLITE_PRIVATE int sqlite3_config(int op, ...){+ va_list ap;+ int rc = SQLITE_OK;++ /* sqlite3_config() shall return SQLITE_MISUSE if it is invoked while+ ** the SQLite library is in use. */+ if( sqlite3GlobalConfig.isInit ) return SQLITE_MISUSE_BKPT;++ va_start(ap, op);+ switch( op ){++ /* Mutex configuration options are only available in a threadsafe+ ** compile.+ */+#if defined(SQLITE_THREADSAFE) && SQLITE_THREADSAFE>0 /* IMP: R-54466-46756 */+ case SQLITE_CONFIG_SINGLETHREAD: {+ /* EVIDENCE-OF: R-02748-19096 This option sets the threading mode to+ ** Single-thread. */+ sqlite3GlobalConfig.bCoreMutex = 0; /* Disable mutex on core */+ sqlite3GlobalConfig.bFullMutex = 0; /* Disable mutex on connections */+ break;+ }+#endif+#if defined(SQLITE_THREADSAFE) && SQLITE_THREADSAFE>0 /* IMP: R-20520-54086 */+ case SQLITE_CONFIG_MULTITHREAD: {+ /* EVIDENCE-OF: R-14374-42468 This option sets the threading mode to+ ** Multi-thread. */+ sqlite3GlobalConfig.bCoreMutex = 1; /* Enable mutex on core */+ sqlite3GlobalConfig.bFullMutex = 0; /* Disable mutex on connections */+ break;+ }+#endif+#if defined(SQLITE_THREADSAFE) && SQLITE_THREADSAFE>0 /* IMP: R-59593-21810 */+ case SQLITE_CONFIG_SERIALIZED: {+ /* EVIDENCE-OF: R-41220-51800 This option sets the threading mode to+ ** Serialized. */+ sqlite3GlobalConfig.bCoreMutex = 1; /* Enable mutex on core */+ sqlite3GlobalConfig.bFullMutex = 1; /* Enable mutex on connections */+ break;+ }+#endif+#if defined(SQLITE_THREADSAFE) && SQLITE_THREADSAFE>0 /* IMP: R-63666-48755 */+ case SQLITE_CONFIG_MUTEX: {+ /* Specify an alternative mutex implementation */+ sqlite3GlobalConfig.mutex = *va_arg(ap, sqlite3_mutex_methods*);+ break;+ }+#endif+#if defined(SQLITE_THREADSAFE) && SQLITE_THREADSAFE>0 /* IMP: R-14450-37597 */+ case SQLITE_CONFIG_GETMUTEX: {+ /* Retrieve the current mutex implementation */+ *va_arg(ap, sqlite3_mutex_methods*) = sqlite3GlobalConfig.mutex;+ break;+ }+#endif++ case SQLITE_CONFIG_MALLOC: {+ /* EVIDENCE-OF: R-55594-21030 The SQLITE_CONFIG_MALLOC option takes a+ ** single argument which is a pointer to an instance of the+ ** sqlite3_mem_methods structure. The argument specifies alternative+ ** low-level memory allocation routines to be used in place of the memory+ ** allocation routines built into SQLite. */+ sqlite3GlobalConfig.m = *va_arg(ap, sqlite3_mem_methods*);+ break;+ }+ case SQLITE_CONFIG_GETMALLOC: {+ /* EVIDENCE-OF: R-51213-46414 The SQLITE_CONFIG_GETMALLOC option takes a+ ** single argument which is a pointer to an instance of the+ ** sqlite3_mem_methods structure. The sqlite3_mem_methods structure is+ ** filled with the currently defined memory allocation routines. */+ if( sqlite3GlobalConfig.m.xMalloc==0 ) sqlite3MemSetDefault();+ *va_arg(ap, sqlite3_mem_methods*) = sqlite3GlobalConfig.m;+ break;+ }+ case SQLITE_CONFIG_MEMSTATUS: {+ /* EVIDENCE-OF: R-61275-35157 The SQLITE_CONFIG_MEMSTATUS option takes+ ** single argument of type int, interpreted as a boolean, which enables+ ** or disables the collection of memory allocation statistics. */+ sqlite3GlobalConfig.bMemstat = va_arg(ap, int);+ break;+ }+ case SQLITE_CONFIG_SCRATCH: {+ /* EVIDENCE-OF: R-08404-60887 There are three arguments to+ ** SQLITE_CONFIG_SCRATCH: A pointer an 8-byte aligned memory buffer from+ ** which the scratch allocations will be drawn, the size of each scratch+ ** allocation (sz), and the maximum number of scratch allocations (N). */+ sqlite3GlobalConfig.pScratch = va_arg(ap, void*);+ sqlite3GlobalConfig.szScratch = va_arg(ap, int);+ sqlite3GlobalConfig.nScratch = va_arg(ap, int);+ break;+ }+ case SQLITE_CONFIG_PAGECACHE: {+ /* EVIDENCE-OF: R-31408-40510 There are three arguments to+ ** SQLITE_CONFIG_PAGECACHE: A pointer to 8-byte aligned memory, the size+ ** of each page buffer (sz), and the number of pages (N). */+ sqlite3GlobalConfig.pPage = va_arg(ap, void*);+ sqlite3GlobalConfig.szPage = va_arg(ap, int);+ sqlite3GlobalConfig.nPage = va_arg(ap, int);+ break;+ }+ case SQLITE_CONFIG_PCACHE_HDRSZ: {+ /* EVIDENCE-OF: R-39100-27317 The SQLITE_CONFIG_PCACHE_HDRSZ option takes+ ** a single parameter which is a pointer to an integer and writes into+ ** that integer the number of extra bytes per page required for each page+ ** in SQLITE_CONFIG_PAGECACHE. */+ *va_arg(ap, int*) = + sqlite3HeaderSizeBtree() ++ sqlite3HeaderSizePcache() ++ sqlite3HeaderSizePcache1();+ break;+ }++ case SQLITE_CONFIG_PCACHE: {+ /* no-op */+ break;+ }+ case SQLITE_CONFIG_GETPCACHE: {+ /* now an error */+ rc = SQLITE_ERROR;+ break;+ }++ case SQLITE_CONFIG_PCACHE2: {+ /* EVIDENCE-OF: R-63325-48378 The SQLITE_CONFIG_PCACHE2 option takes a+ ** single argument which is a pointer to an sqlite3_pcache_methods2+ ** object. This object specifies the interface to a custom page cache+ ** implementation. */+ sqlite3GlobalConfig.pcache2 = *va_arg(ap, sqlite3_pcache_methods2*);+ break;+ }+ case SQLITE_CONFIG_GETPCACHE2: {+ /* EVIDENCE-OF: R-22035-46182 The SQLITE_CONFIG_GETPCACHE2 option takes a+ ** single argument which is a pointer to an sqlite3_pcache_methods2+ ** object. SQLite copies of the current page cache implementation into+ ** that object. */+ if( sqlite3GlobalConfig.pcache2.xInit==0 ){+ sqlite3PCacheSetDefault();+ }+ *va_arg(ap, sqlite3_pcache_methods2*) = sqlite3GlobalConfig.pcache2;+ break;+ }++/* EVIDENCE-OF: R-06626-12911 The SQLITE_CONFIG_HEAP option is only+** available if SQLite is compiled with either SQLITE_ENABLE_MEMSYS3 or+** SQLITE_ENABLE_MEMSYS5 and returns SQLITE_ERROR if invoked otherwise. */+#if defined(SQLITE_ENABLE_MEMSYS3) || defined(SQLITE_ENABLE_MEMSYS5)+ case SQLITE_CONFIG_HEAP: {+ /* EVIDENCE-OF: R-19854-42126 There are three arguments to+ ** SQLITE_CONFIG_HEAP: An 8-byte aligned pointer to the memory, the+ ** number of bytes in the memory buffer, and the minimum allocation size.+ */+ sqlite3GlobalConfig.pHeap = va_arg(ap, void*);+ sqlite3GlobalConfig.nHeap = va_arg(ap, int);+ sqlite3GlobalConfig.mnReq = va_arg(ap, int);++ if( sqlite3GlobalConfig.mnReq<1 ){+ sqlite3GlobalConfig.mnReq = 1;+ }else if( sqlite3GlobalConfig.mnReq>(1<<12) ){+ /* cap min request size at 2^12 */+ sqlite3GlobalConfig.mnReq = (1<<12);+ }++ if( sqlite3GlobalConfig.pHeap==0 ){+ /* EVIDENCE-OF: R-49920-60189 If the first pointer (the memory pointer)+ ** is NULL, then SQLite reverts to using its default memory allocator+ ** (the system malloc() implementation), undoing any prior invocation of+ ** SQLITE_CONFIG_MALLOC.+ **+ ** Setting sqlite3GlobalConfig.m to all zeros will cause malloc to+ ** revert to its default implementation when sqlite3BtreeInitialize() is run+ */+ memset(&sqlite3GlobalConfig.m, 0, sizeof(sqlite3GlobalConfig.m));+ }else{+ /* EVIDENCE-OF: R-61006-08918 If the memory pointer is not NULL then the+ ** alternative memory allocator is engaged to handle all of SQLites+ ** memory allocation needs. */+#ifdef SQLITE_ENABLE_MEMSYS3+ sqlite3GlobalConfig.m = *sqlite3MemGetMemsys3();+#endif+#ifdef SQLITE_ENABLE_MEMSYS5+ sqlite3GlobalConfig.m = *sqlite3MemGetMemsys5();+#endif+ }+ break;+ }+#endif++ case SQLITE_CONFIG_LOOKASIDE: {+ sqlite3GlobalConfig.szLookaside = va_arg(ap, int);+ sqlite3GlobalConfig.nLookaside = va_arg(ap, int);+ break;+ }+ + /* Record a pointer to the logger function and its first argument.+ ** The default is NULL. Logging is disabled if the function pointer is+ ** NULL.+ */+ case SQLITE_CONFIG_LOG: {+ /* MSVC is picky about pulling func ptrs from va lists.+ ** http://support.microsoft.com/kb/47961+ ** sqlite3GlobalConfig.xLog = va_arg(ap, void(*)(void*,int,const char*));+ */+ typedef void(*LOGFUNC_t)(void*,int,const char*);+ sqlite3GlobalConfig.xLog = va_arg(ap, LOGFUNC_t);+ sqlite3GlobalConfig.pLogArg = va_arg(ap, void*);+ break;+ }++ /* EVIDENCE-OF: R-55548-33817 The compile-time setting for URI filenames+ ** can be changed at start-time using the+ ** sqlite3_config(SQLITE_CONFIG_URI,1) or+ ** sqlite3_config(SQLITE_CONFIG_URI,0) configuration calls.+ */+ case SQLITE_CONFIG_URI: {+ /* EVIDENCE-OF: R-25451-61125 The SQLITE_CONFIG_URI option takes a single+ ** argument of type int. If non-zero, then URI handling is globally+ ** enabled. If the parameter is zero, then URI handling is globally+ ** disabled. */+ sqlite3GlobalConfig.bOpenUri = va_arg(ap, int);+ break;+ }++ case SQLITE_CONFIG_COVERING_INDEX_SCAN: {+ /* EVIDENCE-OF: R-36592-02772 The SQLITE_CONFIG_COVERING_INDEX_SCAN+ ** option takes a single integer argument which is interpreted as a+ ** boolean in order to enable or disable the use of covering indices for+ ** full table scans in the query optimizer. */+ sqlite3GlobalConfig.bUseCis = va_arg(ap, int);+ break;+ }++ case SQLITE_CONFIG_MMAP_SIZE: {+ /* EVIDENCE-OF: R-58063-38258 SQLITE_CONFIG_MMAP_SIZE takes two 64-bit+ ** integer (sqlite3_int64) values that are the default mmap size limit+ ** (the default setting for PRAGMA mmap_size) and the maximum allowed+ ** mmap size limit. */+ sqlite3_int64 szMmap = va_arg(ap, sqlite3_int64);+ sqlite3_int64 mxMmap = va_arg(ap, sqlite3_int64);+ /* EVIDENCE-OF: R-53367-43190 If either argument to this option is+ ** negative, then that argument is changed to its compile-time default.+ **+ ** EVIDENCE-OF: R-34993-45031 The maximum allowed mmap size will be+ ** silently truncated if necessary so that it does not exceed the+ ** compile-time maximum mmap size set by the SQLITE_MAX_MMAP_SIZE+ ** compile-time option.+ */+ if( mxMmap<0 || mxMmap>SQLITE_MAX_MMAP_SIZE ){+ mxMmap = SQLITE_MAX_MMAP_SIZE;+ }+ if( szMmap<0 ) szMmap = SQLITE_DEFAULT_MMAP_SIZE;+ if( szMmap>mxMmap) szMmap = mxMmap;+ sqlite3GlobalConfig.mxMmap = mxMmap;+ sqlite3GlobalConfig.szMmap = szMmap;+ break;+ }++#if SQLITE_OS_WIN && defined(SQLITE_WIN32_MALLOC) /* IMP: R-04780-55815 */+ case SQLITE_CONFIG_WIN32_HEAPSIZE: {+ /* EVIDENCE-OF: R-34926-03360 SQLITE_CONFIG_WIN32_HEAPSIZE takes a 32-bit+ ** unsigned integer value that specifies the maximum size of the created+ ** heap. */+ sqlite3GlobalConfig.nHeap = va_arg(ap, int);+ break;+ }+#endif++ case SQLITE_CONFIG_PMASZ: {+ sqlite3GlobalConfig.szPma = va_arg(ap, unsigned int);+ break;+ }++ default: {+ rc = SQLITE_ERROR;+ break;+ }+ }+ va_end(ap);+ return rc;+}++/************** End of main.c ************************************************/
@@ -0,0 +1,705 @@+/*+** 2001 September 15+**+** The author disclaims copyright to this source code. In place of+** a legal notice, here is a blessing:+**+** May you do good and not evil.+** May you find forgiveness for yourself and forgive others.+** May you share freely, never taking more than you give.+**+*************************************************************************+** This header file defines the interface that the sqlite B-Tree file+** subsystem. See comments in the source code for a detailed description+** of what each interface routine does.+*/+#ifndef _BTREE_H_+#define _BTREE_H_++/*+** The SQLITE_THREADSAFE macro must be defined as 0, 1, or 2.+** 0 means mutexes are permanently disable and the library is never+** threadsafe. 1 means the library is serialized which is the highest+** level of threadsafety. 2 means the library is multithreaded - multiple+** threads can use SQLite as long as no two threads try to use the same+** database connection at the same time.+**+** Older versions of SQLite used an optional THREADSAFE macro.+** We support that for legacy.+*/+#if !defined(SQLITE_THREADSAFE)+# if defined(THREADSAFE)+# define SQLITE_THREADSAFE THREADSAFE+# else+# define SQLITE_THREADSAFE 1 /* IMP: R-07272-22309 */+# endif+#endif++/*+** CAPI3REF: 64-Bit Integer Types+** KEYWORDS: sqlite_int64 sqlite_uint64+**+** Because there is no cross-platform way to specify 64-bit integer types+** SQLite includes typedefs for 64-bit signed and unsigned integers.+**+** The sqlite3_int64 and sqlite3_uint64 are the preferred type definitions.+** The sqlite_int64 and sqlite_uint64 types are supported for backwards+** compatibility only.+**+** ^The sqlite3_int64 and sqlite_int64 types can store integer values+** between -9223372036854775808 and +9223372036854775807 inclusive. ^The+** sqlite3_uint64 and sqlite_uint64 types can store integer values +** between 0 and +18446744073709551615 inclusive.+*/+#ifdef SQLITE_INT64_TYPE+ typedef SQLITE_INT64_TYPE sqlite_int64;+ typedef unsigned SQLITE_INT64_TYPE sqlite_uint64;+#elif defined(_MSC_VER) || defined(__BORLANDC__)+ typedef __int64 sqlite_int64;+ typedef unsigned __int64 sqlite_uint64;+#else+ typedef long long int sqlite_int64;+ typedef unsigned long long int sqlite_uint64;+#endif+typedef sqlite_int64 sqlite3_int64;+typedef sqlite_uint64 sqlite3_uint64;++/*+** Integers of known sizes. These typedefs might change for architectures+** where the sizes very. Preprocessor macros are available so that the+** types can be conveniently redefined at compile-type. Like this:+**+** cc '-DUINTPTR_TYPE=long long int' ...+*/+#ifndef UINT32_TYPE+# ifdef HAVE_UINT32_T+# define UINT32_TYPE uint32_t+# else+# define UINT32_TYPE unsigned int+# endif+#endif+#ifndef UINT16_TYPE+# ifdef HAVE_UINT16_T+# define UINT16_TYPE uint16_t+# else+# define UINT16_TYPE unsigned short int+# endif+#endif+#ifndef INT16_TYPE+# ifdef HAVE_INT16_T+# define INT16_TYPE int16_t+# else+# define INT16_TYPE short int+# endif+#endif+#ifndef UINT8_TYPE+# ifdef HAVE_UINT8_T+# define UINT8_TYPE uint8_t+# else+# define UINT8_TYPE unsigned char+# endif+#endif+#ifndef INT8_TYPE+# ifdef HAVE_INT8_T+# define INT8_TYPE int8_t+# else+# define INT8_TYPE signed char+# endif+#endif+#ifndef LONGDOUBLE_TYPE+# define LONGDOUBLE_TYPE long double+#endif+typedef sqlite_int64 i64; /* 8-byte signed integer */+typedef sqlite_uint64 u64; /* 8-byte unsigned integer */+typedef UINT32_TYPE u32; /* 4-byte unsigned integer */+typedef UINT16_TYPE u16; /* 2-byte unsigned integer */+typedef INT16_TYPE i16; /* 2-byte signed integer */+typedef UINT8_TYPE u8; /* 1-byte unsigned integer */+typedef INT8_TYPE i8; /* 1-byte signed integer */++/* TODO: This definition is just included so other modules compile. It+** needs to be revisited.+*/+#define SQLITE_N_BTREE_META 16++/*+** If defined as non-zero, auto-vacuum is enabled by default. Otherwise+** it must be turned on for each database using "PRAGMA auto_vacuum = 1".+*/+#ifndef SQLITE_DEFAULT_AUTOVACUUM+ #define SQLITE_DEFAULT_AUTOVACUUM 0+#endif++#define BTREE_AUTOVACUUM_NONE 0 /* Do not do auto-vacuum */+#define BTREE_AUTOVACUUM_FULL 1 /* Do full auto-vacuum */+#define BTREE_AUTOVACUUM_INCR 2 /* Incremental vacuum */++/*+** CAPI3REF: Initialize The SQLite Library+**+** ^The sqlite3BtreeInitialize() routine initializes the+** SQLite library. ^The sqlite3BtreeShutdown() routine+** deallocates any resources that were allocated by sqlite3BtreeInitialize().+** These routines are designed to aid in process initialization and+** shutdown on embedded systems. Workstation applications using+** SQLite normally do not need to invoke either of these routines.+**+** A call to sqlite3BtreeInitialize() is an "effective" call if it is+** the first time sqlite3BtreeInitialize() is invoked during the lifetime of+** the process, or if it is the first time sqlite3BtreeInitialize() is invoked+** following a call to sqlite3BtreeShutdown(). ^(Only an effective call+** of sqlite3BtreeInitialize() does any initialization. All other calls+** are harmless no-ops.)^+**+** A call to sqlite3BtreeShutdown() is an "effective" call if it is the first+** call to sqlite3BtreeShutdown() since the last sqlite3BtreeInitialize(). ^(Only+** an effective call to sqlite3BtreeShutdown() does any deinitialization.+** All other valid calls to sqlite3BtreeShutdown() are harmless no-ops.)^+**+** The sqlite3BtreeInitialize() interface is threadsafe, but sqlite3BtreeShutdown()+** is not. The sqlite3BtreeShutdown() interface must only be called from a+** single thread. All open [database connections] must be closed and all+** other SQLite resources must be deallocated prior to invoking+** sqlite3BtreeShutdown().+**+** Among other things, ^sqlite3BtreeInitialize() will invoke+** sqlite3_os_init(). Similarly, ^sqlite3BtreeShutdown()+** will invoke sqlite3_os_end().+**+** ^The sqlite3BtreeInitialize() routine returns [SQLITE_OK] on success.+** ^If for some reason, sqlite3BtreeInitialize() is unable to initialize+** the library (perhaps it is unable to allocate a needed resource such+** as a mutex) it returns an [error code] other than [SQLITE_OK].+**+** ^The sqlite3BtreeInitialize() routine is called internally by many other+** SQLite interfaces so that an application usually does not need to+** invoke sqlite3BtreeInitialize() directly. For example, [sqlite3_open()]+** calls sqlite3BtreeInitialize() so the SQLite library will be automatically+** initialized when [sqlite3_open()] is called if it has not be initialized+** already. ^However, if SQLite is compiled with the [SQLITE_OMIT_AUTOINIT]+** compile-time option, then the automatic calls to sqlite3BtreeInitialize()+** are omitted and the application must call sqlite3BtreeInitialize() directly+** prior to using any other SQLite interface. For maximum portability,+** it is recommended that applications always invoke sqlite3BtreeInitialize()+** directly prior to using any other SQLite interface. Future releases+** of SQLite may require this. In other words, the behavior exhibited+** when SQLite is compiled with [SQLITE_OMIT_AUTOINIT] might become the+** default behavior in some future release of SQLite.+**+** The sqlite3_os_init() routine does operating-system specific+** initialization of the SQLite library. The sqlite3_os_end()+** routine undoes the effect of sqlite3_os_init(). Typical tasks+** performed by these routines include allocation or deallocation+** of static resources, initialization of global variables,+** setting up a default [sqlite3_vfs] module, or setting up+** a default configuration using [sqlite3_config()].+**+** The application should never invoke either sqlite3_os_init()+** or sqlite3_os_end() directly. The application should only invoke+** sqlite3BtreeInitialize() and sqlite3BtreeShutdown(). The sqlite3_os_init()+** interface is called automatically by sqlite3BtreeInitialize() and+** sqlite3_os_end() is called by sqlite3BtreeShutdown(). Appropriate+** implementations for sqlite3_os_init() and sqlite3_os_end()+** are built into SQLite when it is compiled for Unix, Windows, or OS/2.+** When [custom builds | built for other platforms]+** (using the [SQLITE_OS_OTHER=1] compile-time+** option) the application must supply a suitable implementation for+** sqlite3_os_init() and sqlite3_os_end(). An application-supplied+** implementation of sqlite3_os_init() or sqlite3_os_end()+** must return [SQLITE_OK] on success and some other [error code] upon+** failure.+*/+int sqlite3BtreeInitialize(void);+int sqlite3BtreeShutdown(void);++/*+** CAPI3REF: Result Codes+** KEYWORDS: {result code definitions}+**+** Many SQLite functions return an integer result code from the set shown+** here in order to indicate success or failure.+**+** New error codes may be added in future versions of SQLite.+**+** See also: [extended result code definitions]+*/+#define SQLITE_OK 0 /* Successful result */+/* beginning-of-error-codes */+#define SQLITE_ERROR 1 /* SQL error or missing database */+#define SQLITE_INTERNAL 2 /* Internal logic error in SQLite */+#define SQLITE_PERM 3 /* Access permission denied */+#define SQLITE_ABORT 4 /* Callback routine requested an abort */+#define SQLITE_BUSY 5 /* The database file is locked */+#define SQLITE_LOCKED 6 /* A table in the database is locked */+#define SQLITE_NOMEM 7 /* A malloc() failed */+#define SQLITE_READONLY 8 /* Attempt to write a readonly database */+#define SQLITE_INTERRUPT 9 /* Operation terminated by sqlite3_interrupt()*/+#define SQLITE_IOERR 10 /* Some kind of disk I/O error occurred */+#define SQLITE_CORRUPT 11 /* The database disk image is malformed */+#define SQLITE_NOTFOUND 12 /* Unknown opcode in sqlite3_file_control() */+#define SQLITE_FULL 13 /* Insertion failed because database is full */+#define SQLITE_CANTOPEN 14 /* Unable to open the database file */+#define SQLITE_PROTOCOL 15 /* Database lock protocol error */+#define SQLITE_EMPTY 16 /* Database is empty */+#define SQLITE_SCHEMA 17 /* The database schema changed */+#define SQLITE_TOOBIG 18 /* String or BLOB exceeds size limit */+#define SQLITE_CONSTRAINT 19 /* Abort due to constraint violation */+#define SQLITE_MISMATCH 20 /* Data type mismatch */+#define SQLITE_MISUSE 21 /* Library used incorrectly */+#define SQLITE_NOLFS 22 /* Uses OS features not supported on host */+#define SQLITE_AUTH 23 /* Authorization denied */+#define SQLITE_FORMAT 24 /* Auxiliary database format error */+#define SQLITE_RANGE 25 /* 2nd parameter to sqlite3_bind out of range */+#define SQLITE_NOTADB 26 /* File opened that is not a database file */+#define SQLITE_NOTICE 27 /* Notifications from sqlite3_log() */+#define SQLITE_WARNING 28 /* Warnings from sqlite3_log() */+#define SQLITE_ROW 100 /* sqlite3_step() has another row ready */+#define SQLITE_DONE 101 /* sqlite3_step() has finished executing */+/* end-of-error-codes */++/*+** CAPI3REF: Extended Result Codes+** KEYWORDS: {extended result code definitions}+**+** In its default configuration, SQLite API routines return one of 30 integer+** [result codes]. However, experience has shown that many of+** these result codes are too coarse-grained. They do not provide as+** much information about problems as programmers might like. In an effort to+** address this, newer versions of SQLite (version 3.3.8 and later) include+** support for additional result codes that provide more detailed information+** about errors. These [extended result codes] are enabled or disabled+** on a per database connection basis using the+** [sqlite3_extended_result_codes()] API. Or, the extended code for+** the most recent error can be obtained using+** [sqlite3_extended_errcode()].+*/+#define SQLITE_IOERR_READ (SQLITE_IOERR | (1<<8))+#define SQLITE_IOERR_SHORT_READ (SQLITE_IOERR | (2<<8))+#define SQLITE_IOERR_WRITE (SQLITE_IOERR | (3<<8))+#define SQLITE_IOERR_FSYNC (SQLITE_IOERR | (4<<8))+#define SQLITE_IOERR_DIR_FSYNC (SQLITE_IOERR | (5<<8))+#define SQLITE_IOERR_TRUNCATE (SQLITE_IOERR | (6<<8))+#define SQLITE_IOERR_FSTAT (SQLITE_IOERR | (7<<8))+#define SQLITE_IOERR_UNLOCK (SQLITE_IOERR | (8<<8))+#define SQLITE_IOERR_RDLOCK (SQLITE_IOERR | (9<<8))+#define SQLITE_IOERR_DELETE (SQLITE_IOERR | (10<<8))+#define SQLITE_IOERR_BLOCKED (SQLITE_IOERR | (11<<8))+#define SQLITE_IOERR_NOMEM (SQLITE_IOERR | (12<<8))+#define SQLITE_IOERR_ACCESS (SQLITE_IOERR | (13<<8))+#define SQLITE_IOERR_CHECKRESERVEDLOCK (SQLITE_IOERR | (14<<8))+#define SQLITE_IOERR_LOCK (SQLITE_IOERR | (15<<8))+#define SQLITE_IOERR_CLOSE (SQLITE_IOERR | (16<<8))+#define SQLITE_IOERR_DIR_CLOSE (SQLITE_IOERR | (17<<8))+#define SQLITE_IOERR_SHMOPEN (SQLITE_IOERR | (18<<8))+#define SQLITE_IOERR_SHMSIZE (SQLITE_IOERR | (19<<8))+#define SQLITE_IOERR_SHMLOCK (SQLITE_IOERR | (20<<8))+#define SQLITE_IOERR_SHMMAP (SQLITE_IOERR | (21<<8))+#define SQLITE_IOERR_SEEK (SQLITE_IOERR | (22<<8))+#define SQLITE_IOERR_DELETE_NOENT (SQLITE_IOERR | (23<<8))+#define SQLITE_IOERR_MMAP (SQLITE_IOERR | (24<<8))+#define SQLITE_IOERR_GETTEMPPATH (SQLITE_IOERR | (25<<8))+#define SQLITE_IOERR_CONVPATH (SQLITE_IOERR | (26<<8))+#define SQLITE_IOERR_VNODE (SQLITE_IOERR | (27<<8))+#define SQLITE_LOCKED_SHAREDCACHE (SQLITE_LOCKED | (1<<8))+#define SQLITE_BUSY_RECOVERY (SQLITE_BUSY | (1<<8))+#define SQLITE_BUSY_SNAPSHOT (SQLITE_BUSY | (2<<8))+#define SQLITE_CANTOPEN_NOTEMPDIR (SQLITE_CANTOPEN | (1<<8))+#define SQLITE_CANTOPEN_ISDIR (SQLITE_CANTOPEN | (2<<8))+#define SQLITE_CANTOPEN_FULLPATH (SQLITE_CANTOPEN | (3<<8))+#define SQLITE_CANTOPEN_CONVPATH (SQLITE_CANTOPEN | (4<<8))+#define SQLITE_CORRUPT_VTAB (SQLITE_CORRUPT | (1<<8))+#define SQLITE_READONLY_RECOVERY (SQLITE_READONLY | (1<<8))+#define SQLITE_READONLY_CANTLOCK (SQLITE_READONLY | (2<<8))+#define SQLITE_READONLY_ROLLBACK (SQLITE_READONLY | (3<<8))+#define SQLITE_READONLY_DBMOVED (SQLITE_READONLY | (4<<8))+#define SQLITE_ABORT_ROLLBACK (SQLITE_ABORT | (2<<8))+#define SQLITE_CONSTRAINT_CHECK (SQLITE_CONSTRAINT | (1<<8))+#define SQLITE_CONSTRAINT_COMMITHOOK (SQLITE_CONSTRAINT | (2<<8))+#define SQLITE_CONSTRAINT_FOREIGNKEY (SQLITE_CONSTRAINT | (3<<8))+#define SQLITE_CONSTRAINT_FUNCTION (SQLITE_CONSTRAINT | (4<<8))+#define SQLITE_CONSTRAINT_NOTNULL (SQLITE_CONSTRAINT | (5<<8))+#define SQLITE_CONSTRAINT_PRIMARYKEY (SQLITE_CONSTRAINT | (6<<8))+#define SQLITE_CONSTRAINT_TRIGGER (SQLITE_CONSTRAINT | (7<<8))+#define SQLITE_CONSTRAINT_UNIQUE (SQLITE_CONSTRAINT | (8<<8))+#define SQLITE_CONSTRAINT_VTAB (SQLITE_CONSTRAINT | (9<<8))+#define SQLITE_CONSTRAINT_ROWID (SQLITE_CONSTRAINT |(10<<8))+#define SQLITE_NOTICE_RECOVER_WAL (SQLITE_NOTICE | (1<<8))+#define SQLITE_NOTICE_RECOVER_ROLLBACK (SQLITE_NOTICE | (2<<8))+#define SQLITE_WARNING_AUTOINDEX (SQLITE_WARNING | (1<<8))+#define SQLITE_AUTH_USER (SQLITE_AUTH | (1<<8))++/* Reserved: 0x00F00000 */++/*+** Forward declarations of structure+*/+typedef struct Btree Btree;+typedef struct BtCursor BtCursor;+typedef struct BtShared BtShared;+typedef struct Mem Mem;+typedef struct KeyInfo KeyInfo;+typedef struct UnpackedRecord UnpackedRecord;+++int sqlite3BtreeOpen(+ const char *zVfs, /* VFS to use with this b-tree */+ const char *zFilename, /* Name of database file to open */+ Btree **ppBtree, /* Return open Btree* here */+ int flags, /* Flags */+ int vfsFlags /* Flags passed through to VFS open */+);++/* The flags parameter to sqlite3BtreeOpen can be the bitwise or of the+** following values.+**+** NOTE: These values must match the corresponding PAGER_ values in+** pager.h.+*/+#define BTREE_OMIT_JOURNAL 1 /* Do not create or use a rollback journal */+#define BTREE_MEMORY 2 /* This is an in-memory DB */+#define BTREE_SINGLE 4 /* The file contains at most 1 b-tree */+#define BTREE_UNORDERED 8 /* Use of a hash implementation is OK */++/*+** CAPI3REF: Flags For File Open Operations+**+** These bit values are intended for use in the+** 3rd parameter to the [sqlite3_open_v2()] interface and+** in the 4th parameter to the [sqlite3_vfs.xOpen] method.+*/+#define SQLITE_OPEN_READONLY 0x00000001 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_READWRITE 0x00000002 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_CREATE 0x00000004 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_DELETEONCLOSE 0x00000008 /* VFS only */+#define SQLITE_OPEN_EXCLUSIVE 0x00000010 /* VFS only */+#define SQLITE_OPEN_AUTOPROXY 0x00000020 /* VFS only */+#define SQLITE_OPEN_URI 0x00000040 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_MEMORY 0x00000080 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_MAIN_DB 0x00000100 /* VFS only */+#define SQLITE_OPEN_TEMP_DB 0x00000200 /* VFS only */+#define SQLITE_OPEN_TRANSIENT_DB 0x00000400 /* VFS only */+#define SQLITE_OPEN_MAIN_JOURNAL 0x00000800 /* VFS only */+#define SQLITE_OPEN_TEMP_JOURNAL 0x00001000 /* VFS only */+#define SQLITE_OPEN_SUBJOURNAL 0x00002000 /* VFS only */+#define SQLITE_OPEN_MASTER_JOURNAL 0x00004000 /* VFS only */+#define SQLITE_OPEN_NOMUTEX 0x00008000 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_FULLMUTEX 0x00010000 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_SHAREDCACHE 0x00020000 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_PRIVATECACHE 0x00040000 /* Ok for sqlite3_open_v2() */+#define SQLITE_OPEN_WAL 0x00080000 /* VFS only */++int sqlite3BtreeClose(Btree*);+int sqlite3BtreeSetCacheSize(Btree*,int);+#if SQLITE_MAX_MMAP_SIZE>0+ int sqlite3BtreeSetMmapLimit(Btree*,sqlite3_int64);+#endif+int sqlite3BtreeSetPagerFlags(Btree*,unsigned);+int sqlite3BtreeSyncDisabled(Btree*);+int sqlite3BtreeSetPageSize(Btree *p, int nPagesize, int nReserve, int eFix);+int sqlite3BtreeGetPageSize(Btree*);+int sqlite3BtreeMaxPageCount(Btree*,int);+u32 sqlite3BtreeLastPage(Btree*);+int sqlite3BtreeSecureDelete(Btree*,int);+int sqlite3BtreeGetOptimalReserve(Btree*);+int sqlite3BtreeGetReserveNoMutex(Btree *p);+int sqlite3BtreeSetAutoVacuum(Btree *, int);+int sqlite3BtreeGetAutoVacuum(Btree *);+int sqlite3BtreeBeginTrans(Btree*,int);+int sqlite3BtreeCommitPhaseOne(Btree*, const char *zMaster);+int sqlite3BtreeCommitPhaseTwo(Btree*, int);+int sqlite3BtreeCommit(Btree*);+int sqlite3BtreeRollback(Btree*,int,int);+int sqlite3BtreeBeginStmt(Btree*,int);+int sqlite3BtreeCreateTable(Btree*, int*, int flags);+int sqlite3BtreeIsInTrans(Btree*);+int sqlite3BtreeIsInReadTrans(Btree*);+int sqlite3BtreeIsInBackup(Btree*);+void *sqlite3BtreeSchema(Btree *, int, void(*)(void *));+int sqlite3BtreeSchemaLocked(Btree *pBtree);+int sqlite3BtreeLockTable(Btree *pBtree, int iTab, u8 isWriteLock);+int sqlite3BtreeSavepoint(Btree *, int, int);++int sqlite3BtreeFileFormat(Btree *);+const char *sqlite3BtreeGetFilename(Btree *);+const char *sqlite3BtreeGetJournalname(Btree *);+int sqlite3BtreeCopyFile(Btree *, Btree *);++int sqlite3BtreeIncrVacuum(Btree *);++/* The flags parameter to sqlite3BtreeCreateTable can be the bitwise OR+** of the flags shown below.+**+** Every SQLite table must have either BTREE_INTKEY or BTREE_BLOBKEY set.+** With BTREE_INTKEY, the table key is a 64-bit integer and arbitrary data+** is stored in the leaves. (BTREE_INTKEY is used for SQL tables.) With+** BTREE_BLOBKEY, the key is an arbitrary BLOB and no content is stored+** anywhere - the key is the content. (BTREE_BLOBKEY is used for SQL+** indices.)+*/+#define BTREE_INTKEY 1 /* Table has only 64-bit signed integer keys */+#define BTREE_BLOBKEY 2 /* Table has keys only - no data */++int sqlite3BtreeDropTable(Btree*, int, int*);+int sqlite3BtreeClearTable(Btree*, int, int*);+int sqlite3BtreeClearTableOfCursor(BtCursor*);+int sqlite3BtreeTripAllCursors(Btree*, int, int);++void sqlite3BtreeGetMeta(Btree *pBtree, int idx, u32 *pValue);+int sqlite3BtreeUpdateMeta(Btree*, int idx, u32 value);++int sqlite3BtreeNewDb(Btree *p);++/*+** The second parameter to sqlite3BtreeGetMeta or sqlite3BtreeUpdateMeta+** should be one of the following values. The integer values are assigned +** to constants so that the offset of the corresponding field in an+** SQLite database header may be found using the following formula:+**+** offset = 36 + (idx * 4)+**+** For example, the free-page-count field is located at byte offset 36 of+** the database file header. The incr-vacuum-flag field is located at+** byte offset 64 (== 36+4*7).+**+** The BTREE_DATA_VERSION value is not really a value stored in the header.+** It is a read-only number computed by the pager. But we merge it with+** the header value access routines since its access pattern is the same.+** Call it a "virtual meta value".+*/+#define BTREE_FREE_PAGE_COUNT 0+#define BTREE_SCHEMA_VERSION 1+#define BTREE_FILE_FORMAT 2+#define BTREE_DEFAULT_CACHE_SIZE 3+#define BTREE_LARGEST_ROOT_PAGE 4+#define BTREE_TEXT_ENCODING 5+#define BTREE_USER_VERSION 6+#define BTREE_INCR_VACUUM 7+#define BTREE_APPLICATION_ID 8+#define BTREE_DATA_VERSION 15 /* A virtual meta-value */++/*+** An instance of the following structure holds information about a+** single index record that has already been parsed out into individual+** values.+**+** A record is an object that contains one or more fields of data.+** Records are used to store the content of a table row and to store+** the key of an index. A blob encoding of a record is created by+** the OP_MakeRecord opcode of the VDBE and is disassembled by the+** OP_Column opcode.+**+** This structure holds a record that has already been disassembled+** into its constituent fields.+**+** The r1 and r2 member variables are only used by the optimized comparison+** functions vdbeRecordCompareInt() and vdbeRecordCompareString().+*/+struct UnpackedRecord {+ KeyInfo *pKeyInfo; /* Collation and sort-order information */+ u16 nField; /* Number of entries in apMem[] */+ i8 default_rc; /* Comparison result if keys are equal */+ u8 errCode; /* Error detected by xRecordCompare (CORRUPT or NOMEM) */+ Mem *aMem; /* Values */+ int r1; /* Value to return if (lhs > rhs) */+ int r2; /* Value to return if (rhs < lhs) */+};++/* One or more of the following flags are set to indicate the validOK+** representations of the value stored in the Mem struct.+**+** If the MEM_Null flag is set, then the value is an SQL NULL value.+** No other flags may be set in this case.+**+** If the MEM_Str flag is set then Mem.z points at a string representation.+** Usually this is encoded in the same unicode encoding as the main+** database (see below for exceptions). If the MEM_Term flag is also+** set, then the string is nul terminated. The MEM_Int and MEM_Real +** flags may coexist with the MEM_Str flag.+*/+#define MEM_Null 0x0001 /* Value is NULL */+#define MEM_Str 0x0002 /* Value is a string */+#define MEM_Int 0x0004 /* Value is an integer */+#define MEM_Real 0x0008 /* Value is a real number */+#define MEM_Blob 0x0010 /* Value is a BLOB */++#define MEM_Term 0x0200 /* String rep is nul terminated */+#define MEM_Dyn 0x0400 /* Need to call Mem.xDel() on Mem.z */+#define MEM_Static 0x0800 /* Mem.z points to a static string */+#define MEM_Ephem 0x1000 /* Mem.z points to an ephemeral string */+#define MEM_Zero 0x4000 /* Mem.i contains count of 0s appended to blob */++/*+** Internally, the vdbe manipulates nearly all SQL values as Mem+** structures. Each Mem struct may cache multiple representations (string,+** integer etc.) of the same value.+*/+struct Mem {+ union MemValue {+ double r; /* Real value used when MEM_Real is set in flags */+ i64 i; /* Integer value used when MEM_Int is set in flags */+ int nZero; /* Used when bit MEM_Zero is set in flags */+ } u;+ u16 flags; /* Some combination of MEM_Null, MEM_Str, MEM_Dyn, etc. */+ u8 enc; /* SQLITE_UTF8, SQLITE_UTF16BE, SQLITE_UTF16LE */+ u8 eSubtype; /* Subtype for this value */+ int n; /* Number of characters in string value, excluding '\0' */+ char *z; /* String or BLOB value */+ /* ShallowCopy only needs to copy the information above */+ char *zMalloc; /* Space to hold MEM_Str or MEM_Blob if szMalloc>0 */+ int szMalloc; /* Size of the zMalloc allocation */+ u32 uTemp; /* Transient storage for serial_type in OP_MakeRecord */+ Btree *pBtree; /* The associated database connection */+ void (*xDel)(void*);/* Destructor for Mem.z - only valid if MEM_Dyn */+#ifdef SQLITE_DEBUG+ Mem *pScopyFrom; /* This Mem is a shallow copy of pScopyFrom */+ void *pFiller; /* So that sizeof(Mem) is a multiple of 8 */+#endif+};++/*+** Values that may be OR'd together to form the second argument of an+** sqlite3BtreeCursorHints() call.+**+** The BTREE_BULKLOAD flag is set on index cursors when the index is going+** to be filled with content that is already in sorted order.+**+** The BTREE_SEEK_EQ flag is set on cursors that will get OP_SeekGE or+** OP_SeekLE opcodes for a range search, but where the range of entries+** selected will all have the same key. In other words, the cursor will+** be used only for equality key searches.+**+*/+#define BTREE_BULKLOAD 0x00000001 /* Used to full index in sorted order */+#define BTREE_SEEK_EQ 0x00000002 /* EQ seeks only - no range seeks */++int sqlite3BtreeCursor(+ Btree*, /* BTree containing table to open */+ int iTable, /* Index of root page */+ int wrFlag, /* 1 for writing. 0 for read-only */+ int N, int X, /* index of N key columns and X extra columns */+ BtCursor **ppCursor /* Space to write cursor pointer */+);+int sqlite3BtreeCursorSize(void);++int sqlite3BtreeCloseCursor(BtCursor*);+void sqlite3BtreeInitUnpackedRecord(+ UnpackedRecord *pUnKey,+ BtCursor* pCur,+ int nField,+ int default_rc,+ Mem* pMem);+int sqlite3BtreeMovetoUnpacked(+ BtCursor*,+ UnpackedRecord *pUnKey,+ i64 intKey,+ int bias,+ int *pRes+);+int sqlite3BtreeCursorHasMoved(BtCursor*);+int sqlite3BtreeCursorRestore(BtCursor*, int*);+int sqlite3BtreeDelete(BtCursor*, int);+int sqlite3BtreeInsert(BtCursor*, const void *pKey, i64 nKey,+ const void *pData, int nData,+ int nZero, int bias, int seekResult);+int sqlite3BtreeFirst(BtCursor*, int *pRes);+int sqlite3BtreeLast(BtCursor*, int *pRes);+int sqlite3BtreeNext(BtCursor*, int *pRes);+int sqlite3BtreeEof(BtCursor*);+int sqlite3BtreePrevious(BtCursor*, int *pRes);+int sqlite3BtreeKeySize(BtCursor*, i64 *pSize);+int sqlite3BtreeKey(BtCursor*, u32 offset, u32 amt, void*);+const void *sqlite3BtreeKeyFetch(BtCursor*, u32 *pAmt);+const void *sqlite3BtreeDataFetch(BtCursor*, u32 *pAmt);+int sqlite3BtreeDataSize(BtCursor*, u32 *pSize);+int sqlite3BtreeData(BtCursor*, u32 offset, u32 amt, void*);++char *sqlite3BtreeIntegrityCheck(Btree*, int *aRoot, int nRoot, int, int*);+struct Pager *sqlite3BtreePager(Btree*);++int sqlite3BtreePutData(BtCursor*, u32 offset, u32 amt, void*);+void sqlite3BtreeIncrblobCursor(BtCursor *);+void sqlite3BtreeClearCursor(BtCursor *);+int sqlite3BtreeSetVersion(Btree *pBt, int iVersion);+void sqlite3BtreeCursorHints(BtCursor *, unsigned int mask);+#ifdef SQLITE_DEBUG+int sqlite3BtreeCursorHasHint(BtCursor*, unsigned int mask);+#endif+int sqlite3BtreeIsReadonly(Btree *pBt);++#ifndef NDEBUG+int sqlite3BtreeCursorIsValid(BtCursor*);+#endif++#ifndef SQLITE_OMIT_BTREECOUNT+int sqlite3BtreeCount(BtCursor *, i64 *);+#endif++#ifdef SQLITE_TEST+int sqlite3BtreeCursorInfo(BtCursor*, int*, int);+void sqlite3BtreeCursorList(Btree*);+#endif++#ifndef SQLITE_OMIT_WAL+ int sqlite3BtreeCheckpoint(Btree*, int, int *, int *);+#endif++/*+** If we are not using shared cache, then there is no need to+** use mutexes to access the BtShared structures. So make the+** Enter and Leave procedures no-ops.+*/+#ifndef SQLITE_OMIT_SHARED_CACHE+ void sqlite3BtreeEnter(Btree*);+#else+# define sqlite3BtreeEnter(X) +#endif++#if !defined(SQLITE_OMIT_SHARED_CACHE) && SQLITE_THREADSAFE+ int sqlite3BtreeSharable(Btree*);+ void sqlite3BtreeLeave(Btree*);+ void sqlite3BtreeEnterCursor(BtCursor*);+ void sqlite3BtreeLeaveCursor(BtCursor*);+#else++# define sqlite3BtreeSharable(X) 0+# define sqlite3BtreeLeave(X)+# define sqlite3BtreeEnterCursor(X)+# define sqlite3BtreeLeaveCursor(X)+#endif++u32 sqlite3BtreeSerialType(Mem *pMem, int file_format);+u32 sqlite3BtreeSerialTypeLen(u32);+u32 sqlite3BtreeSerialGet(const unsigned char*, u32, Mem *);+u32 sqlite3BtreeSerialPut(u8*, Mem*, u32);++/*+** Routines to read and write variable-length integers. These used to+** be defined locally, but now we use the varint routines in the util.c+** file.+*/+int sqlite3BtreePutVarint(unsigned char*, u64);+u8 sqlite3BtreeGetVarint(const unsigned char *, u64 *);+u8 sqlite3BtreeGetVarint32(const unsigned char *, u32 *);+int sqlite3BtreeVarintLen(u64 v);++/*+** The common case is for a varint to be a single byte. They following+** macros handle the common case without a procedure call, but then call+** the procedure for larger varints.+*/+#define getVarint32(A,B) \+ (u8)((*(A)<(u8)0x80)?((B)=(u32)*(A)),1:sqlite3BtreeGetVarint32((A),(u32 *)&(B)))+#define putVarint32(A,B) \+ (u8)(((u32)(B)<(u32)0x80)?(*(A)=(unsigned char)(B)),1:\+ sqlite3BtreePutVarint((A),(B)))+#define getVarint sqlite3BtreeGetVarint+#define putVarint sqlite3BtreePutVarint+++int sqlite3BtreeIdxRowid(Btree*, BtCursor*, i64*);++int sqlite3BtreeRecordCompare(int,const void*,UnpackedRecord*);++const char *sqlite3BtreeErrName(int rc);++#endif /* _BTREE_H_ */
@@ -0,0 +1,128 @@+using System;+using System.Collections.Generic;+using System.Linq;+using System.Text;+using System.Threading.Tasks;++namespace PGFSharp+{+ // Brackets should only be constructed from the Concrete class.+ // These classes just store the data, they do not own or use+ // unmanaged memory (except in the builder class).+ + public interface IBracketChild {+ bool IsString {get;}+ string AsStringChild {get;}+ Bracket AsBracketChild {get;}+ }++ /// <summary>+ /// A representation for a syntactic constituent in the parse tree+ /// of a sentence.+ /// </summary>+ public class Bracket : IBracketChild+ {+ public class StringChildBracket : IBracketChild {++ string str;+ internal StringChildBracket(string str) {+ this.str = str;+ }++ public bool IsString => true;+ public string AsStringChild => str;+ public Bracket AsBracketChild {+ get {+ throw new NotImplementedException ();+ }+ }++ public override string ToString () => AsStringChild;+ }++ internal class BracketBuilder {+ internal Native.PgfLinFuncs LinFuncs { get; private set; }++ private Stack<Bracket> stack = new Stack<Bracket> ();+ private Bracket final = null;+ internal BracketBuilder() {+ LinFuncs = new Native.PgfLinFuncs {+ symbol_token = SymbolToken,+ begin_prase = BeginPhrase,+ end_phrase = EndPhrase,+ symbol_ne = null,+ symbol_bind = null,+ symbol_capit = null,+ symbol_meta = SymbolMeta+ };+ }++ // TODO: the Python wrapper discards begin/end phrase pairs+ // which don't have any tokens. Is this correct and/or necessary?+ private void SymbolToken(IntPtr self, IntPtr token) {+ var str = Native.NativeString.StringFromNativeUtf8 (token);+ stack.Peek ().AddChild (new StringChildBracket (str));+ }++ private void BeginPhrase(IntPtr self, IntPtr cat, int fid, UIntPtr lindex, IntPtr fun) {+ stack.Push (new Bracket ());+ }++ private void EndPhrase(IntPtr self, IntPtr cat, int fid, UIntPtr lindex, IntPtr fun) {+ var b = stack.Pop ();++ b.CatName = Native.NativeString.StringFromNativeUtf8 (cat);+ b.FunName = Native.NativeString.StringFromNativeUtf8 (fun);+ b.FId = fid;+ b.LIndex = (int) lindex;++ if (stack.Count == 0)+ final = b;+ else + stack.Peek ().AddChild (b);+ }+ + private void SymbolMeta(IntPtr self, int meta_id) {+ stack.Peek().AddChild(new StringChildBracket("?"));+ }++ public Bracket Build() {+ return final;+ }+ }++ private List<IBracketChild> _children = new List<IBracketChild> ();+ private Bracket() {+ }++ private void AddChild(IBracketChild c) {+ _children.Add(c);+ }++ public bool IsString => false;+ public Bracket AsBracketChild => this;+ public string AsStringChild {+ get {+ throw new NotImplementedException ();+ }+ }++ public IEnumerable<IBracketChild> Children { get { return _children; } }++ public string CatName { get; private set; }+ public string FunName { get; private set; }+ public int FId { get; private set; }+ public int LIndex { get; private set; }++ public override string ToString ()+ {+ return "(" + CatName + ":" + FId + " " + String.Join (" ", Children) + ")";+ }++ public string ToBracketsString => "{" + String.Join(" ", + Children.Select(c => (c is Bracket) ? ((Bracket)c).ToBracketsString : c.ToString() )+ ) + "}";+ }+++}
@@ -0,0 +1,173 @@+using System;+using System.Collections.Generic;+using System.Linq;+using System.Text;+using System.Threading.Tasks;+using System.Runtime.InteropServices;++namespace PGFSharp+{+ /// <summary>+ /// The class for concrete syntaxes.+ /// </summary>+ public class Concr+ {+ internal IntPtr Ptr { get; private set; }++ /// <summary>+ /// Abstract grammar for this language.+ /// </summary>+ public PGF PGF { get; private set; }++ private Concr() { }++ internal static Concr FromPtr(PGF g, IntPtr ptr)+ {+ var concr = new Concr();+ concr.PGF = g;+ concr.Ptr = ptr;+ return concr;+ }++ /// <summary>+ /// Name of the grammar.+ /// </summary>+ public string Name => Native.NativeString.StringFromNativeUtf8(Native.pgf_concrete_name(Ptr));+ public override string ToString() => $"Concrete:{Name} of {PGF.Name}";++ /// <summary>+ /// Parse given input string in the concrete grammar.+ /// </summary>+ /// <param name="str">Input string to be parsed.</param>+ /// <param name="cat">Category (Type) to parse.</param>+ /// <param name="heuristics">Heuristic (see the GF C runtime docs).</param>+ /// <param name="Callback1">Callback function.</param>+ /// <param name="Callback2">Callback function.</param>+ /// <returns>Enumerates pairs of (abstract grammar) expressions and corresponding probability.</returns>+ public IEnumerable<Tuple<Expr, float>> Parse(string str, Type cat = null, double? heuristics = null,+ Action Callback1 = null, Action Callback2 = null)+ {+ var parse_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(parse_pool);+ cat = cat ?? PGF.StartCat;++ using (var nativeStr = new Native.NativeString(str))+ {+ var result_pool = new NativeGU.NativeMemoryPool();+ var callbackMap = Native.pgf_new_callbacks_map(this.Ptr, parse_pool.Ptr);++ var iterator = Native.pgf_parse_with_heuristics(this.Ptr, cat.Ptr,+ nativeStr.Ptr, heuristics ?? -1, callbackMap,+ exn.Ptr, parse_pool.Ptr, result_pool.Ptr);++ if (iterator == IntPtr.Zero || exn.IsRaised)+ {+ throw new ParseError();+ }+ else+ {+ foreach (var ptr in NativeGU.IteratorToIEnumerable(iterator, parse_pool.Ptr))+ {+ var exprProb = (Native.PgfExprProb)Marshal.PtrToStructure(ptr, typeof(Native.PgfExprProb));+ yield return Tuple.Create(Expr.FromPtr(exprProb.expr, result_pool),+ exprProb.prob);+ }+ }+ }+ }++ /// <summary>+ /// Linearize expression, i.e. produce a string in the concrete grammar from an expression in the abstract grammar.+ /// </summary>+ /// <param name="e"></param>+ /// <returns></returns>+ public string Linearize(Expr e)+ {+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);++ var buf = NativeGU.gu_new_string_buf(tmp_pool.Ptr);+ var out_ = NativeGU.gu_string_buf_out(buf);++ Native.pgf_linearize(Ptr, e.Ptr, out_, exn.Ptr);+ if (exn.IsRaised)+ {+ throw new PGFError();+ }+ else+ {+ var cstr = NativeGU.gu_string_buf_freeze(buf, tmp_pool.Ptr);+ return Native.NativeString.StringFromNativeUtf8(cstr);+ }+ }++ /// <summary>+ /// Get all possible linearization for an expression (see <see cref="Linearize(Expression)"/>).+ /// </summary>+ /// <param name="e"></param>+ /// <returns></returns>+ public IEnumerable<string> LinearizeAll(Expr e)+ {+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);++ var cts = Native.pgf_lzr_concretize(Ptr, e.Ptr, exn.Ptr, tmp_pool.Ptr);+ if (exn.IsRaised || cts == IntPtr.Zero) throw new PGFError("Could not linearize the abstract tree.");++ return NativeGU.IteratorToIEnumerable(cts, tmp_pool.Ptr).Select(LinearizeCnc);+ }++ private string LinearizeCnc(IntPtr cnc)+ {+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);++ var sbuf = NativeGU.gu_new_string_buf(tmp_pool.Ptr);+ var out_ = NativeGU.gu_string_buf_out(sbuf);++ var wrapped = Native.pgf_lzr_wrap_linref(cnc, tmp_pool.Ptr);+ Native.pgf_lzr_linearize_simple(Ptr, wrapped, 0, out_, exn.Ptr, tmp_pool.Ptr);++ if (exn.IsRaised) throw new PGFError("Could not linearize abstract tree.");++ var cstr = NativeGU.gu_string_buf_freeze(sbuf, tmp_pool.Ptr);+ return Native.NativeString.StringFromNativeUtf8(cstr);+ }++ /// <summary>+ /// Get the bracketed (structured) linearization of an expression.+ /// </summary>+ /// <param name="e"></param>+ /// <returns></returns>+ public Bracket BracketedLinearize(Expr e)+ {+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);++ var cts = Native.pgf_lzr_concretize(Ptr, e.Ptr, exn.Ptr, tmp_pool.Ptr);++ var ctree = IntPtr.Zero;+ NativeGU.gu_enum_next(cts, ref ctree, tmp_pool.Ptr);++ if (ctree == IntPtr.Zero)+ {+ return null;+ }++ ctree = Native.pgf_lzr_wrap_linref(ctree, tmp_pool.Ptr);++ var builder = new Bracket.BracketBuilder();++ var mem = Marshal.AllocHGlobal(Marshal.SizeOf<Native.PgfLinFuncs>());+ Marshal.StructureToPtr<Native.PgfLinFuncs>(builder.LinFuncs, mem, false);++ Native.pgf_lzr_linearize(Ptr, ctree, 0, ref mem, tmp_pool.Ptr);++ var b = builder.Build();++ Marshal.FreeHGlobal(mem);++ return b;+ }+ }+}
@@ -0,0 +1,46 @@+using System;+using System.Collections.Generic;+using System.Linq;+using System.Text;+using System.Threading.Tasks;++namespace PGFSharp+{++ [Serializable]+ public class PGFError : Exception+ {+ public PGFError() { }+ public PGFError(string message) : base(message) { }+ public PGFError(string message, Exception inner) : base(message, inner) { }+ protected PGFError(+ System.Runtime.Serialization.SerializationInfo info,+ System.Runtime.Serialization.StreamingContext context) : base(info, context)+ { }+ }+++ [Serializable]+ public class ParseError : Exception+ {+ public ParseError() { }+ public ParseError(string message) : base(message) { }+ public ParseError(string message, Exception inner) : base(message, inner) { }+ protected ParseError(+ System.Runtime.Serialization.SerializationInfo info,+ System.Runtime.Serialization.StreamingContext context) : base(info, context)+ { }+ }++ [Serializable]+ public class TypeError : Exception+ {+ public TypeError() { }+ public TypeError(string message) : base(message) { }+ public TypeError(string message, Exception inner) : base(message, inner) { }+ protected TypeError(+ System.Runtime.Serialization.SerializationInfo info,+ System.Runtime.Serialization.StreamingContext context) : base(info, context)+ { }+ }+}
@@ -0,0 +1,136 @@+using System;+using System.Collections.Generic;+using System.Linq;+using System.Runtime.InteropServices;+using System.Text;+using System.Threading.Tasks;++namespace PGFSharp+{+ internal class UnsupportedExpr : Expr+ {+ internal UnsupportedExpr(IntPtr expr, NativeGU.NativeMemoryPool pool) : base(expr, pool) { }+ public override R Accept<R>(IVisitor<R> visitor)+ {+ throw new NotImplementedException();+ }+ }++ /// <summary>+ /// A representation for an abstract syntax tree.+ /// </summary>+ public abstract class Expr+ {+ internal IntPtr DataPtr => NativeGU.gu_variant_open(_ptr).Data; // PgfExprLit* + internal PgfExprTag Tag => (PgfExprTag)NativeGU.gu_variant_open(_ptr).Tag;++ internal IntPtr MkStringVariant(byte tag, string s, ref IntPtr out_)+ {+ var size = Encoding.UTF8.GetByteCount(s);+ IntPtr slitPtr = NativeGU.gu_alloc_variant(tag,+ (UIntPtr)(size + 1), UIntPtr.Zero, ref out_, _pool.Ptr);+ Native.NativeString.CopyToPreallocated(s, slitPtr);+ return slitPtr;+ }++ /// <summary>+ /// Read expression from string.+ /// </summary>+ /// <param name="exprStr"></param>+ /// <returns></returns>+ public static Expr ReadExpr(string exprStr)+ {+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);+ var result_pool = new NativeGU.NativeMemoryPool();+ using (var strNative = new Native.NativeString(exprStr))+ {+ var in_ = NativeGU.gu_data_in(strNative.Ptr, strNative.Size, tmp_pool.Ptr);+ var expr = Native.pgf_read_expr(in_, result_pool.Ptr, tmp_pool.Ptr, exn.Ptr);+ if (exn.IsRaised || expr == IntPtr.Zero)+ {+ throw new PGFError();+ }+ else+ {+ return Expr.FromPtr(expr, result_pool);+ }+ }+ }++ internal enum PgfExprTag+ {+ PGF_EXPR_ABS,+ PGF_EXPR_APP,+ PGF_EXPR_LIT,+ PGF_EXPR_META,+ PGF_EXPR_FUN,+ PGF_EXPR_VAR,+ PGF_EXPR_TYPED,+ PGF_EXPR_IMPL_ARG,+ PGF_EXPR_NUM_TAGS // not used+ };++ public interface IVisitor<R>+ {+ R VisitLiteralInt(int value);+ R VisitLiteralFloat(double value);+ R VisitLiteralString(string value);+ R VisitApplication(string fname, Expr[] args);++ //R VisitMetaVariable (int id); Dont' care about this for now...++ // Remove this, Function objects use VisitApplication with empty args instead.+ //R VisitFunction (string fname); // Will this be used?+ }++ public class Visitor<R> : IVisitor<R>+ {+ public Func<int, R> fVisitLiteralInt { get; set; } = null;+ public R VisitLiteralInt(int x1) => fVisitLiteralInt(x1);+ public Func<double, R> fVisitLiteralFlt { get; set; } = null;+ public R VisitLiteralFloat(double x1) => fVisitLiteralFlt(x1);+ public Func<string, R> fVisitLiteralStr { get; set; } = null;+ public R VisitLiteralString(string x1) => fVisitLiteralStr(x1);+ public Func<string, Expr[], R> fVisitApplication { get; set; } = null;+ public R VisitApplication(string x1, Expr[] x2) => fVisitApplication(x1, x2);+ }++ public abstract R Accept<R>(IVisitor<R> visitor);++ internal IntPtr _ptr = IntPtr.Zero;+ internal NativeGU.NativeMemoryPool _pool;+ internal IntPtr Ptr => _ptr;++ internal Expr() { }+ internal Expr(IntPtr ptr, NativeGU.NativeMemoryPool pool)+ {+ _ptr = ptr; _pool = pool;+ }++ // Factories+ private static Dictionary<PgfExprTag, Func<IntPtr, NativeGU.NativeMemoryPool, Expr>> factories =+ new Dictionary<PgfExprTag, Func<IntPtr, NativeGU.NativeMemoryPool, Expr>>{++ { PgfExprTag.PGF_EXPR_LIT, (e, p) => LiteralExpr.FromPtr (e, p) },+ { PgfExprTag.PGF_EXPR_APP, (e, p) => new ApplicationExpr (e, p) },+ { PgfExprTag.PGF_EXPR_FUN, (e, p) => new FunctionExpr (e, p) },+ { PgfExprTag.PGF_EXPR_META, (e, p) => new MetaVariableExpr (e, p) }+ };++ internal static Expr FromPtr(IntPtr expr, NativeGU.NativeMemoryPool pool)+ {+ var Tag = (PgfExprTag)NativeGU.gu_variant_open(expr).Tag;+ if (factories.ContainsKey(Tag))+ {+ return factories[Tag](expr, pool);+ }+ else+ return new UnsupportedExpr(expr, pool);+ }++ public override string ToString() =>+ Native.ReadString((output,exn) => Native.pgf_print_expr(_ptr, IntPtr.Zero, 0, output, exn.Ptr));++ }+}
@@ -0,0 +1,15 @@+using System;+using System.Runtime.InteropServices;++namespace PGFSharp+{+ /*public class Abs : Expression+ {+ public Abs ()+ {+ }+ }+*/++}+
@@ -0,0 +1,57 @@+using System;+using System.Runtime.InteropServices;+using System.Collections.Generic;+using System.Linq;++namespace PGFSharp+{+ public class ApplicationExpr : Expr+ {+ public override R Accept<R> (IVisitor<R> visitor)+ {+ var args = new List<Expr> ();+ var expr = this;+ while (expr.Function is ApplicationExpr) {+ args.Add (expr.Argument);+ expr = expr.Function as ApplicationExpr;+ }+ args.Add (expr.Argument);+ if (!(expr.Function is FunctionExpr))+ throw new ArgumentException ();++ args.Reverse ();+ return visitor.VisitApplication ((expr.Function as FunctionExpr).Name, args.ToArray());+ }+ + [StructLayout(LayoutKind.Sequential)]+ private struct PgfExprApp {+ public IntPtr Function;+ public IntPtr Argument;+ }++ private PgfExprApp Data => Marshal.PtrToStructure<PgfExprApp>(DataPtr);++ public Expr Function => Expr.FromPtr(Data.Function, _pool);+ public Expr Argument => Expr.FromPtr(Data.Argument, _pool);++ internal ApplicationExpr(IntPtr ptr, NativeGU.NativeMemoryPool pool) : base(ptr, pool) { }+ public ApplicationExpr(string fname, IEnumerable<Expr> args)+ {+ _pool = new NativeGU.NativeMemoryPool();+ MkStringVariant((byte)PgfExprTag.PGF_EXPR_FUN, fname, ref _ptr);+ foreach (var arg in args) {+ var fun = _ptr;+ var exprApp = NativeGU.gu_alloc_variant((byte)PgfExprTag.PGF_EXPR_APP,+ (UIntPtr)Marshal.SizeOf<PgfExprApp>(), UIntPtr.Zero, ref _ptr, _pool.Ptr);++ Native.EditStruct<PgfExprApp> (exprApp, (ref PgfExprApp app) => {+ app.Function = fun;+ app.Argument = arg.Ptr;+ });+ }+++ }+ }+}+
@@ -0,0 +1,18 @@+using System;+using System.Linq;+using System.Collections.Generic;++namespace PGFSharp+{+ public class FunctionExpr : Expr+ {+ public override R Accept<R> (IVisitor<R> visitor)+ {+ return visitor.VisitApplication (Name, new Expr[] {});+ }+ + internal FunctionExpr (IntPtr expr, NativeGU.NativeMemoryPool pool) : base(expr,pool) {}+ public string Name => Native.NativeString.StringFromNativeUtf8(DataPtr);+ }+}+
@@ -0,0 +1,127 @@+using System;+using System.Runtime.InteropServices;+using System.Text;++namespace PGFSharp+{+ public class LiteralStringExpr : LiteralExpr+ {+ internal LiteralStringExpr(IntPtr expr, NativeGU.NativeMemoryPool pool) : base(expr, pool) { }+ public LiteralStringExpr(string s) : base()+ {+ _pool = new NativeGU.NativeMemoryPool();++ var exprTag = (byte)(int)PgfExprTag.PGF_EXPR_LIT;+ IntPtr litPtr = NativeGU.gu_alloc_variant(exprTag,+ (UIntPtr)Marshal.SizeOf<NativePgfExprLit>(), UIntPtr.Zero, ref _ptr, _pool.Ptr);++ Native.EditStruct<NativePgfExprLit>(litPtr, (ref NativePgfExprLit lit) => {+ MkStringVariant((byte)PgfLiteralTag.PGF_LITERAL_STR, s, ref lit.lit);+ });+ }++ public override R Accept<R>(IVisitor<R> visitor)+ {+ return visitor.VisitLiteralString(Value);+ }++ public string Value => Native.NativeString.StringFromNativeUtf8(LitDataPtr);+ }++ public class LiteralIntExpr : LiteralExpr+ {+ internal LiteralIntExpr(IntPtr expr, NativeGU.NativeMemoryPool pool) : base(expr, pool) { }+ public LiteralIntExpr(int val) : base()+ {+ Initialize<NativePgfLiteralInt>(PgfLiteralTag.PGF_LITERAL_INT,+ (ref NativePgfLiteralInt ilit) => ilit.val = val);+ }++ public override R Accept<R>(IVisitor<R> visitor)+ {+ return visitor.VisitLiteralInt(Value);+ }++ public int Value => Marshal.PtrToStructure<NativePgfLiteralInt>(LitDataPtr).val;+ + [StructLayout(LayoutKind.Sequential)]+ private struct NativePgfLiteralInt { public int val; }+ }++ public class LiteralFloatExpr : LiteralExpr+ {+ internal LiteralFloatExpr(IntPtr expr, NativeGU.NativeMemoryPool pool) : base(expr, pool) { }+ public LiteralFloatExpr(double val) : base()+ {+ Initialize<NativePgfLiteralFlt>(PgfLiteralTag.PGF_LITERAL_FLT,+ (ref NativePgfLiteralFlt flit) => flit.val = val);+ }++ public override R Accept<R>(IVisitor<R> visitor)+ {+ return visitor.VisitLiteralFloat(Value);+ }++ public double Value => Marshal.PtrToStructure<NativePgfLiteralFlt>(LitDataPtr).val;+ + [StructLayout(LayoutKind.Sequential)]+ private struct NativePgfLiteralFlt { public double val; }+ }++ public abstract class LiteralExpr : Expr+ {+ internal LiteralExpr(IntPtr expr, NativeGU.NativeMemoryPool pool) : base(expr, pool) { }+ internal LiteralExpr() { }++ internal new static Expr FromPtr(IntPtr expr, NativeGU.NativeMemoryPool pool)+ {+ var dataPtr = NativeGU.gu_variant_open(expr).Data; // PgfExprLit* + var data = Marshal.PtrToStructure<NativePgfExprLit>(dataPtr);+ var literalTag = (PgfLiteralTag)NativeGU.gu_variant_open(data.lit).Tag;++ switch(literalTag)+ {+ case PgfLiteralTag.PGF_LITERAL_STR:+ return new LiteralStringExpr(expr, pool);+ case PgfLiteralTag.PGF_LITERAL_INT:+ return new LiteralIntExpr(expr, pool);+ case PgfLiteralTag.PGF_LITERAL_FLT:+ return new LiteralFloatExpr(expr, pool);+ default:+ throw new ArgumentException();+ }+ }++ internal void Initialize<TNative>(PgfLiteralTag litTag, Native.StructAction<TNative> setValue, UIntPtr? size = null) {+ _pool = new NativeGU.NativeMemoryPool();++ var exprTag = (byte)(int)PgfExprTag.PGF_EXPR_LIT;+ IntPtr litPtr = NativeGU.gu_alloc_variant ( exprTag,+ (UIntPtr)Marshal.SizeOf<NativePgfExprLit>(), UIntPtr.Zero, ref _ptr, _pool.Ptr);++ Native.EditStruct<NativePgfExprLit> (litPtr, (ref NativePgfExprLit lit) => {+ IntPtr ilitPtr = NativeGU.gu_alloc_variant ((byte)litTag,+ (UIntPtr)Marshal.SizeOf<TNative> (), UIntPtr.Zero, ref lit.lit, _pool.Ptr);++ Native.EditStruct<TNative>(ilitPtr, setValue); + });+ }++ // Deref DatPtr to det PgfExprLit.+ private NativePgfExprLit Data => Marshal.PtrToStructure<NativePgfExprLit>(DataPtr);++ private PgfLiteralTag LiteralTag => (PgfLiteralTag) NativeGU.gu_variant_open(Data.lit).Tag;+ internal IntPtr LitDataPtr => NativeGU.gu_variant_open(Data.lit).Data;++ internal enum PgfLiteralTag {+ PGF_LITERAL_STR,+ PGF_LITERAL_INT,+ PGF_LITERAL_FLT,+ PGF_LITERAL_NUM_TAGS+ }++ [StructLayout(LayoutKind.Sequential)]+ internal struct NativePgfExprLit { public IntPtr lit; }+ }+}+
@@ -0,0 +1,34 @@+using System;+using System.Runtime.InteropServices;++namespace PGFSharp+{+ public class MetaVariableExpr : Expr {++ internal MetaVariableExpr() {+ _pool = new NativeGU.NativeMemoryPool();+ IntPtr exprMetaPtr = NativeGU.gu_alloc_variant ((byte)PgfExprTag.PGF_EXPR_META,+ (UIntPtr)Marshal.SizeOf <NativePgfExprMeta>(), UIntPtr.Zero, ref _ptr, _pool.Ptr);++ Native.EditStruct<NativePgfExprMeta> (exprMetaPtr, (ref NativePgfExprMeta m) => m.Id = 0);+ }++ internal MetaVariableExpr(IntPtr ptr, NativeGU.NativeMemoryPool pool) : base(ptr, pool) { }+++ public int Id => Data.Id;+ private NativePgfExprMeta Data => Marshal.PtrToStructure<NativePgfExprMeta>(DataPtr);++ public override R Accept<R> (IVisitor<R> visitor)+ {+ // return visitor.VisitMetaVariable (Id);++ // Not supported yet.+ throw new NotImplementedException();+ }++ [StructLayout(LayoutKind.Sequential)]+ private struct NativePgfExprMeta { public int Id; }+ }+}+
@@ -0,0 +1,312 @@+using System;+using System.Collections.Generic;+using System.Linq;+using System.Runtime.InteropServices;+using System.Text;+using System.Threading.Tasks;++/// <summary>+/// Portable grammar format PInvoke functions.+/// </summary>+namespace PGFSharp+{+ internal static class Native+ {++ internal class NativeString : IDisposable+ {+ public IntPtr Ptr { get; private set; }+ public int Size { get; private set; }+ + public NativeString(string s)+ {+ Ptr = NativeUtf8FromString(s);+ Size = Encoding.UTF8.GetByteCount(s);+ }++ public void Dispose()+ {+ Marshal.FreeHGlobal(Ptr);+ Ptr = IntPtr.Zero;+ }++ public static IntPtr NativeUtf8FromString(string managedString)+ {+ int len = Encoding.UTF8.GetByteCount(managedString);+ IntPtr nativeUtf8 = Marshal.AllocHGlobal(len + 1);+ CopyToPreallocated(managedString, nativeUtf8, len);+ return nativeUtf8;+ }++ public static void CopyToPreallocated(string managedString, IntPtr ptr, int? len = null)+ {+ if (len == null) len = Encoding.UTF8.GetByteCount(managedString);+ byte[] buffer = new byte[len.Value + 1];+ Encoding.UTF8.GetBytes(managedString, 0, managedString.Length, buffer, 0);+ Marshal.Copy(buffer, 0, ptr, buffer.Length);+ }++ public static string StringFromNativeUtf8(IntPtr nativeUtf8)+ {+ int len = 0;+ while (Marshal.ReadByte(nativeUtf8, len) != 0) ++len;+ byte[] buffer = new byte[len];+ Marshal.Copy(nativeUtf8, buffer, 0, buffer.Length);+ return Encoding.UTF8.GetString(buffer);+ }+ }++ public delegate void StructAction<T>(ref T st);+ public static void EditStruct<T>(IntPtr ptr, StructAction<T> f)+ {+ var str = Marshal.PtrToStructure<T>(ptr);+ f(ref str);+ Marshal.StructureToPtr<T>(str, ptr, false);+ }++ const string LIBNAME = "pgf.dll";+ const CallingConvention CC = CallingConvention.Cdecl;+++ #region Basic+ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_read([MarshalAs(UnmanagedType.LPStr)] string fpath, IntPtr pool, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_read_in(IntPtr in_, IntPtr pool, IntPtr tmp_pool, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_concrete_load(IntPtr concr, IntPtr in_, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_abstract_name(IntPtr pgf);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_concrete_name(IntPtr concr);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_start_cat(IntPtr pgf, IntPtr pool);++ #endregion++ #region Linearization++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_linearize(IntPtr concr, IntPtr expr, IntPtr out_, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_lzr_concretize(IntPtr concr, IntPtr expr, IntPtr err, IntPtr tmp_pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_lzr_wrap_linref(IntPtr ctree, IntPtr tmp_pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_lzr_linearize(IntPtr concr, IntPtr ctree, int lin_idx, ref IntPtr funcs, IntPtr tmp_pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_lzr_linearize_simple(IntPtr concr, IntPtr ctree, int lin_idx, IntPtr out_, IntPtr exn, IntPtr tmp_pool);+ #endregion+++ #region Iteration+ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_iter_languages(IntPtr pgf, ref GuMapItor itor, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_iter_categories(IntPtr pgf, ref GuMapItor itor, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_iter_functions(IntPtr pgf, ref GuMapItor itor, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_iter_functions_by_cat(IntPtr pgf, IntPtr catNameStr, ref GuMapItor itor, IntPtr err);++ #endregion++ #region Type+ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_function_type(IntPtr pgf, IntPtr funNameStr);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_read_type(IntPtr in_, IntPtr pool, IntPtr tmp_pool, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_print_type(IntPtr expr, IntPtr ctxt, int prec, IntPtr output, IntPtr err);+ #endregion++ #region Expression+ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void pgf_print_expr(IntPtr expr, IntPtr ctxt, int prec, IntPtr output, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_read_expr(IntPtr in_, IntPtr pool, IntPtr tmp_pool, IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_compute(IntPtr pgf, IntPtr expr, IntPtr err, IntPtr tmp_pool, IntPtr res_pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_generate_all(IntPtr pgf, IntPtr type, IntPtr err, IntPtr iter_pool, IntPtr out_pool);+ #endregion++ #region Concrete+ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_parse_with_heuristics(IntPtr concr, IntPtr cat, IntPtr sentence,+ double heuristics, IntPtr callbacks, IntPtr exn,+ IntPtr parsePl, IntPtr exprPl);+ #endregion++ #region Callbacks+ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr pgf_new_callbacks_map(IntPtr concr, IntPtr pool);+ #endregion++ //public delegate void GuMapItorFn(IntPtr self, [MarshalAs(UnmanagedType.LPStr)] string key, IntPtr value, IntPtr err);+ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void GuMapItorFn(IntPtr self, IntPtr key, IntPtr value, IntPtr err);+++ /*+ public delegate void GuFinalizerFn(IntPtr self);++ [StructLayout(LayoutKind.Sequential)]+ public struct GuFinalizer+ {+ [MarshalAs(UnmanagedType.FunctionPtr)]+ public GuFinalizerFn fn;+ }++ [StructLayout(LayoutKind.Sequential)]+ public struct PgfConcr+ {+ public IntPtr name, abstr, cflags, printnames,+ ccats, fun_indices, coerce_idx, cncfuns,+ sequences, cnccats;+ public int total_cats;+ public IntPtr pool;+ GuFinalizer fin;+ }*/++ [StructLayout(LayoutKind.Sequential)]+ public struct GuMapItor+ {+ [MarshalAs(UnmanagedType.FunctionPtr)]+ public GuMapItorFn fn;+ }++ [StructLayout(LayoutKind.Sequential)]+ public struct PgfExprProb+ {+ public float prob;+ public IntPtr expr; // PgfExpr type (not pointer, but typedef PgfExpr -> GuVariant -> uintptr_t)+ }+++ #region Linearization callbacks++ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void LinFuncSymbolToken(IntPtr self, IntPtr token);++ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void LinFuncBeginPhrase(IntPtr self, IntPtr cat, int fid, UIntPtr lindex, IntPtr fun);++ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void LinFuncEndPhrase(IntPtr self, IntPtr cat, int fid, UIntPtr lindex, IntPtr fun);++ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void LinFuncSymbolNonexistant(IntPtr self);++ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void LinFuncSymbolBinding(IntPtr self);++ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void LinFuncSymbolCapitalization(IntPtr self);++ [UnmanagedFunctionPointer(CallingConvention.Cdecl)]+ public delegate void LinFuncSymbolMeta(IntPtr self, int meta_id);++ [StructLayout(LayoutKind.Sequential)]+ public struct PgfLinFuncs+ {+ [MarshalAs(UnmanagedType.FunctionPtr)]+ public LinFuncSymbolToken symbol_token;++ [MarshalAs(UnmanagedType.FunctionPtr)]+ public LinFuncBeginPhrase begin_prase;++ [MarshalAs(UnmanagedType.FunctionPtr)]+ public LinFuncEndPhrase end_phrase;++ [MarshalAs(UnmanagedType.FunctionPtr)]+ public LinFuncSymbolNonexistant symbol_ne;++ [MarshalAs(UnmanagedType.FunctionPtr)]+ public LinFuncSymbolBinding symbol_bind;++ [MarshalAs(UnmanagedType.FunctionPtr)]+ public LinFuncSymbolCapitalization symbol_capit;+ + [MarshalAs(UnmanagedType.FunctionPtr)]+ public LinFuncSymbolMeta symbol_meta;+ }++ #endregion+++ /*+ [StructLayout(LayoutKind.Sequential)]+ public struct PGFClosure+ {+ public GuMapItor fn;+ public IntPtr grammar;+ public IntPtr obj;+ }*/++ public static string ReadString(Action<IntPtr, NativeGU.NativeExceptionContext> f)+ {+ var pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(pool);+ var sbuf = NativeGU.gu_new_string_buf(pool.Ptr);+ var output = NativeGU.gu_string_buf_out(sbuf);+ f(output, exn);+ if (exn.IsRaised) throw new Exception();+ var strPtr = NativeGU.gu_string_buf_freeze(sbuf, pool.Ptr);+ var str = Native.NativeString.StringFromNativeUtf8(strPtr);+ return str;+ }++ public delegate void MapIterFunc(IntPtr pgf, ref GuMapItor fn, IntPtr err);+ public delegate void IterNameFunc(IntPtr pgf, IntPtr name, ref GuMapItor fn, IntPtr err);++ public class IterFuncCurryName+ {+ private IntPtr name;+ private IterNameFunc func;+ public IterFuncCurryName(IterNameFunc f, IntPtr name)+ {+ this.func = f;+ this.name = name;+ }++ public void IterFunc(IntPtr pgf, ref GuMapItor fn, IntPtr err)+ {+ func(pgf, name, ref fn, err);+ }+ }++ public static void MapIter(MapIterFunc iter, IntPtr _pgf, Action<string, IntPtr> action)+ {+ var pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(pool);+ var f = new GuMapItor()+ {+ fn = (self, key, value, _err) =>+ {+ action(Native.NativeString.StringFromNativeUtf8(key), value);+ if (exn.IsRaised) throw new Exception();+ }+ };++ iter(_pgf, ref f, exn.Ptr);+ }+ }+}
@@ -0,0 +1,127 @@+using System;+using System.Collections.Generic;+using System.Linq;+using System.Runtime.InteropServices;+using System.Text;+using System.Threading.Tasks;++namespace PGFSharp+{+ internal static class NativeGU+ {++ const string LIBNAME = "gu.dll";+ const CallingConvention CC = CallingConvention.Cdecl;++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_new_pool();++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_new_exn(IntPtr pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void gu_pool_free(IntPtr pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr get_gu_null_variant();++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_string_buf_out(IntPtr sbuf);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_new_string_buf(IntPtr pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_data_in(IntPtr str, int len, IntPtr pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_string_buf_freeze(IntPtr sbuf, IntPtr pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ [return: MarshalAs(UnmanagedType.I1)]+ public static extern bool gu_exn_is_raised(IntPtr err);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern void gu_enum_next(IntPtr enum_, ref IntPtr outPtr, IntPtr pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern GuVariantInfo gu_variant_open(IntPtr variant);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_alloc_variant(byte tag, UIntPtr size, UIntPtr align, ref IntPtr out_, IntPtr pool);++ [DllImport(LIBNAME, CallingConvention = CC)]+ public static extern IntPtr gu_make_variant(byte tag, UIntPtr size, UIntPtr align, ref IntPtr init, IntPtr pool);++ [StructLayout(LayoutKind.Sequential)]+ public struct GuVariantInfo+ {+ public int Tag;+ public IntPtr Data;+ }+++ [StructLayout(LayoutKind.Sequential)]+ public struct GuSeq+ {+ public UIntPtr length;+ }++ public static uint SeqLength(IntPtr seqptr)+ {+ var seq = Marshal.PtrToStructure<GuSeq>(seqptr);+ return (uint)seq.length;+ }++ public static T gu_seq_index<T>(IntPtr seq, int index)+ {+ var dataPtr = seq + Marshal.SizeOf<GuSeq>();+ var hypoPtr = dataPtr + index * Marshal.SizeOf<T>();+ var hypo = Marshal.PtrToStructure<T>(hypoPtr);+ return hypo;+ }++ public class NativeMemoryPool+ {+ private IntPtr _ptr;+ internal IntPtr Ptr => _ptr;++ public NativeMemoryPool()+ {+ _ptr = gu_new_pool();+ if (_ptr == IntPtr.Zero) throw new Exception();+ }++ ~NativeMemoryPool()+ {+ gu_pool_free(_ptr);+ _ptr = IntPtr.Zero;+ }+ }++ public class NativeExceptionContext+ {+ private IntPtr _ptr;+ internal IntPtr Ptr => _ptr;++ public NativeExceptionContext(NativeMemoryPool pool)+ {+ _ptr = gu_new_exn(pool.Ptr);+ if (_ptr == IntPtr.Zero) throw new Exception();+ }++ public bool IsRaised => gu_exn_is_raised(_ptr);+ }++ public static IEnumerable<IntPtr> IteratorToIEnumerable(IntPtr iterator, IntPtr pool)+ {+ IntPtr ptr = IntPtr.Zero;+ NativeGU.gu_enum_next(iterator, ref ptr, pool);+ while (ptr != IntPtr.Zero)+ {+ yield return ptr;+ NativeGU.gu_enum_next(iterator, ref ptr, pool);+ }+ }+ }+}
@@ -0,0 +1,211 @@+using System;+using System.Dynamic;+using System.Collections.Generic;+using System.Linq;+using System.Runtime.InteropServices;+using System.Text;+using System.Threading.Tasks;++namespace PGFSharp+{+ /// <summary>+ /// The class for PGF grammars.+ /// </summary>+ public class PGF+ {+ private PGF() { }++ IntPtr _ptr;+ NativeGU.NativeMemoryPool pool;++ /// <summary>+ /// Reads a grammar with the specified file path.+ /// </summary>+ /// <param name="fn">The path to the file.</param>+ /// <returns>an object representing the grammar in memory.</returns>+ public static PGF ReadPGF(string fn)+ {+ var obj = new PGF();+ var exn = new NativeGU.NativeExceptionContext(new NativeGU.NativeMemoryPool());+ obj.pool = new NativeGU.NativeMemoryPool();+ obj._ptr = Native.pgf_read(fn, obj.pool.Ptr, exn.Ptr);+ if (exn.IsRaised)+ {+ throw new PGFError($"Could not read PGF from file {fn}. ({System.IO.Directory.GetCurrentDirectory()})");+ }+ return obj;+ }++ public override string ToString() => $"Grammar:{Name}, {String.Join(", ", Languages.Keys)}";++ /// <summary>+ /// Name of the abstract grammar.+ /// </summary>+ public string Name => Native.NativeString.StringFromNativeUtf8(Native.pgf_abstract_name(_ptr));++ /// <summary>+ /// Default category of the grammar.+ /// </summary>+ public Type StartCat => Type.FromPtr(Native.pgf_start_cat(_ptr, pool.Ptr), pool);++ /// <summary>+ /// All concrete grammars in the language.+ /// </summary>+ public Dictionary<string, Concr> Languages+ {+ get+ {+ var dict = new Dictionary<string, Concr>();+ Native.MapIter(Native.pgf_iter_languages, _ptr, (k, v) => dict[k] = Concr.FromPtr(this, dereference(v)));+ return dict;+ }+ }++ private IntPtr dereference(IntPtr ptr)+ {+ return (IntPtr)Marshal.PtrToStructure(ptr, typeof(IntPtr));+ }++ /// <summary>+ /// All categories in the abstract grammar.+ /// </summary>+ public IEnumerable<string> Categories => GetStringList(Native.pgf_iter_categories);++ /// <summary>+ /// All functions in the abstract grammar.+ /// </summary>+ public IEnumerable<string> Functions => GetStringList(Native.pgf_iter_functions);++ /// <summary>+ /// Returns a list with all functions with a given return category.+ /// </summary>+ /// <param name="catName">The name of the return category.</param>+ public IEnumerable<string> FunctionsByCat(string catName)+ {+ using (var str = new Native.NativeString(catName))+ {+ return GetStringList(new Native.IterFuncCurryName(Native.pgf_iter_functions_by_cat, str.Ptr).IterFunc);+ }+ }++ /// <summary>+ /// Returns the type of the function with the given name.+ /// </summary>+ /// <param name="funName">The name of the function.</param>+ /// <returns></returns>+ public Type FunctionType(string funName)+ {+ using (var str = new Native.NativeString(funName))+ {+ var typePtr = Native.pgf_function_type(_ptr, str.Ptr);+ if (typePtr == IntPtr.Zero) throw new NullReferenceException();+ return Type.FromPtr(typePtr, pool);+ }+ }++ /// <summary>+ /// Normalizes an expression to its normal form by using the 'def' rules in the grammar.+ /// </summary>+ /// <param name="expr">the original expression.</param>+ /// <returns>the normalized expression.</returns>+ public Expr Compute(Expr expr)+ {+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);+ var result_pool = new NativeGU.NativeMemoryPool();+ var newExpr = Native.pgf_compute(_ptr, expr.Ptr, exn.Ptr, pool.Ptr, result_pool.Ptr);++ if (exn.IsRaised || newExpr == IntPtr.Zero)+ {+ throw new PGFError("Could not reduce expression.");+ }+ else+ {+ return Expr.FromPtr(newExpr, result_pool);+ }+ }++ /// <summary>+ /// Returns an enumerable over the set of all expression in+ /// the given category. The expressions are enumerated in decreasing+ /// probability order.+ /// </summary>+ /// <param name="cat">the start category.</param>+ /// <returns></returns>+ public IEnumerable<Expr> GenerateAll(Type cat = null)+ {+ cat = cat ?? StartCat;+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);+ var result_pool = new NativeGU.NativeMemoryPool();+ IntPtr ptr = IntPtr.Zero;+ var iterator = Native.pgf_generate_all(this._ptr, cat.Ptr, exn.Ptr, tmp_pool.Ptr, result_pool.Ptr);++ return NativeGU.IteratorToIEnumerable(iterator, tmp_pool.Ptr).Select(p =>+ {+ var exprProb = Marshal.PtrToStructure<Native.PgfExprProb>(ptr);+ return Expr.FromPtr(exprProb.expr, result_pool);++ });+ }++ private IEnumerable<string> GetStringList(Native.MapIterFunc f)+ {+ var c = new List<string>();+ Native.MapIter(f, _ptr, (k, v) => c.Add(k));+ return c;+ }+ + public dynamic Embed() {+ return new GrammarEmbedding(this);+ }++ private class GrammarEmbedding : DynamicObject {+ private PGF gr;++ public GrammarEmbedding(PGF gr) {+ this.gr = gr;+ }+ + public override bool TryGetMember(GetMemberBinder binder, out object result)+ {+ result = null;++ using (var str = new Native.NativeString(binder.Name))+ {+ var typePtr = Native.pgf_function_type(gr._ptr, str.Ptr);+ if (typePtr == IntPtr.Zero)+ return false;+ }++ result = new ApplicationExpr(binder.Name, new Expr[0]);+ return true;+ }++ public override bool TryInvokeMember(InvokeMemberBinder binder, object[] args, out object result) {+ result = null;++ uint n_hypos = 0;+ using (var str = new Native.NativeString(binder.Name))+ {+ var typePtr = Native.pgf_function_type(gr._ptr, str.Ptr);+ if (typePtr == IntPtr.Zero)+ return false;+ n_hypos = NativeGU.SeqLength(Marshal.PtrToStructure<Type.PgfType>(typePtr).hypos);+ }++ if (args.Length != n_hypos)+ return false;+ + Expr[] exprs = new Expr[args.Length];+ for (var i = 0; i < args.Length; i++) {+ exprs[i] = args[i] as Expr;+ if (exprs[i] == null)+ return false;+ }+ result = new ApplicationExpr(binder.Name, exprs);+ return true;+ }+ }+ }+}
@@ -0,0 +1,71 @@+<?xml version="1.0" encoding="utf-8"?>+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">+ <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />+ <PropertyGroup>+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>+ <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>+ <ProjectGuid>{81C13B1B-FE00-4A56-A831-964D55032CDD}</ProjectGuid>+ <OutputType>Library</OutputType>+ <AppDesignerFolder>Properties</AppDesignerFolder>+ <RootNamespace>PGFSharp</RootNamespace>+ <AssemblyName>PGFSharp</AssemblyName>+ <TargetFrameworkVersion>v4.5.1</TargetFrameworkVersion>+ <FileAlignment>512</FileAlignment>+ </PropertyGroup>+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">+ <DebugSymbols>true</DebugSymbols>+ <DebugType>full</DebugType>+ <Optimize>false</Optimize>+ <OutputPath>bin\Debug\</OutputPath>+ <DefineConstants>DEBUG;TRACE</DefineConstants>+ <ErrorReport>prompt</ErrorReport>+ <WarningLevel>4</WarningLevel>+ </PropertyGroup>+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">+ <DebugType>pdbonly</DebugType>+ <Optimize>true</Optimize>+ <OutputPath>bin\Release\</OutputPath>+ <DefineConstants>TRACE</DefineConstants>+ <ErrorReport>prompt</ErrorReport>+ <WarningLevel>4</WarningLevel>+ </PropertyGroup>+ <PropertyGroup>+ <DocumentationFile>$(OutputPath)PGFSharp.xml</DocumentationFile>+ </PropertyGroup>+ <ItemGroup>+ <Reference Include="System" />+ <Reference Include="System.Core" />+ <Reference Include="System.Xml.Linq" />+ <Reference Include="System.Data.DataSetExtensions" />+ <Reference Include="Microsoft.CSharp" />+ <Reference Include="System.Data" />+ <Reference Include="System.Net.Http" />+ <Reference Include="System.Xml" />+ </ItemGroup>+ <ItemGroup>+ <Compile Include="Bracket.cs" />+ <Compile Include="Concr.cs" />+ <Compile Include="Exceptions.cs" />+ <Compile Include="Native.cs" />+ <Compile Include="NativeGU.cs" />+ <Compile Include="PGF.cs" />+ <Compile Include="Type.cs" />+ <Compile Include="Expr.cs" />+ <Compile Include="Expr\Literal.cs" />+ <Compile Include="Expr\MetaVariable.cs" />+ <Compile Include="Expr\Application.cs" />+ <Compile Include="Expr\Function.cs" />+ <Compile Include="Properties\AssemblyInfo.cs" />+ </ItemGroup>+ <Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />+ <!-- To modify your build process, add your task inside one of the targets below and uncomment it. + Other similar extension points exist, see Microsoft.Common.targets.+ <Target Name="BeforeBuild">+ </Target>+ <Target Name="AfterBuild">+ </Target>+ -->+ <ItemGroup>+ <Folder Include="Expression\" />+ </ItemGroup>+</Project>
@@ -0,0 +1,36 @@+using System.Reflection;+using System.Runtime.CompilerServices;+using System.Runtime.InteropServices;++// General Information about an assembly is controlled through the following +// set of attributes. Change these attribute values to modify the information+// associated with an assembly.+[assembly: AssemblyTitle("PGF")]+[assembly: AssemblyDescription("")]+[assembly: AssemblyConfiguration("")]+[assembly: AssemblyCompany("")]+[assembly: AssemblyProduct("")]+[assembly: AssemblyCopyright("")]+[assembly: AssemblyTrademark("")]+[assembly: AssemblyCulture("")]++// Setting ComVisible to false makes the types in this assembly not visible +// to COM components. If you need to access a type in this assembly from +// COM, set the ComVisible attribute to true on that type.+[assembly: ComVisible(false)]++// The following GUID is for the ID of the typelib if this project is exposed to COM+[assembly: Guid("81c13b1b-fe00-4a56-a831-964d55032cdd")]++// Version information for an assembly consists of the following four values:+//+// Major Version+// Minor Version +// Build Number+// Revision+//+// You can specify all the values or you can default the Build and Revision Numbers +// by using the '*' as shown below:+// [assembly: AssemblyVersion("1.0.*")]+[assembly: AssemblyVersion("3.8.0.0")]+[assembly: AssemblyFileVersion("3.8.0.0")]
@@ -0,0 +1,92 @@+using System;+using System.Collections.Generic;+using System.Linq;+using System.Runtime.InteropServices;+using System.Text;+using System.Threading.Tasks;++namespace PGFSharp+{+ /// <summary>+ /// A class for types in the abstract syntax of a grammar.+ /// </summary>+ public class Type+ {+ private IntPtr _ptr;+ internal IntPtr Ptr => _ptr;+ private NativeGU.NativeMemoryPool _pool;+ private Type() { }++ internal static Type FromPtr(IntPtr type, NativeGU.NativeMemoryPool pool)+ {+ var t = new Type();+ t._ptr = type;+ t._pool = pool;+ return t;+ }++ public override string ToString() =>+ Native.ReadString((output,exn) => Native.pgf_print_type(_ptr, IntPtr.Zero, 0, output, exn.Ptr));++ private PgfType Data => Marshal.PtrToStructure<PgfType>(_ptr);++ /// <summary>+ /// Read type from string.+ /// </summary>+ /// <param name="typeStr"></param>+ /// <returns></returns>+ public static Type ReadType(string typeStr)+ {+ var tmp_pool = new NativeGU.NativeMemoryPool();+ var exn = new NativeGU.NativeExceptionContext(tmp_pool);+ var result_pool = new NativeGU.NativeMemoryPool();+ using (var strNative = new Native.NativeString(typeStr))+ {+ var in_ = NativeGU.gu_data_in(strNative.Ptr, strNative.Size, tmp_pool.Ptr);+ var typ = Native.pgf_read_type(in_, result_pool.Ptr, tmp_pool.Ptr, exn.Ptr);+ if (exn.IsRaised || typ == IntPtr.Zero)+ {+ throw new PGFError();+ }+ else+ {+ return Type.FromPtr(typ, result_pool);+ }+ }+ }++ /// <summary>+ /// Get the hypotheses of a type (function argument types).+ /// </summary>+ public IEnumerable<Type> Hypotheses+ {+ get+ {+ var n_hypos = NativeGU.SeqLength(Data.hypos);+ for (int i = 0; i < n_hypos; i++)+ {+ var hypo = NativeGU.gu_seq_index<PgfHypo>(Data.hypos, i);+ var type = Type.FromPtr(hypo.type, this._pool);+ yield return type;+ }+ }+ }++ [StructLayout(LayoutKind.Sequential)]+ internal struct PgfType+ {+ public IntPtr hypos; // GuSeq of PgfHypo+ public IntPtr cid;+ public UIntPtr n_exprs;+ public IntPtr exprs;+ }++ [StructLayout(LayoutKind.Sequential)]+ private struct PgfHypo+ {+ public int pgfBindType; // enum+ public IntPtr cid; // PgfCId (string)+ public IntPtr type; // PgfType*+ }+ }+}
@@ -0,0 +1,3 @@+module PGF(module PGF2) where++import PGF2
@@ -0,0 +1,1 @@+module PGF.Internal where
@@ -0,0 +1,1258 @@+{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, ScopedTypeVariables #-}+-------------------------------------------------+-- |+-- Module : PGF2+-- Maintainer : Krasimir Angelov+-- Stability : stable+-- Portability : portable+--+-- This module is an Application Programming Interface to+-- load and interpret grammars compiled in the Portable Grammar Format (PGF).+-- The PGF format is produced as the final output from the GF compiler.+-- The API is meant to be used for embedding GF grammars in Haskell+-- programs+-------------------------------------------------++#include <pgf/pgf.h>+#include <pgf/linearizer.h>+#include <gu/enum.h>+#include <gu/exn.h>++module PGF2 (-- * PGF+ PGF,readPGF,showPGF,++ -- * Identifiers+ CId,++ -- * Abstract syntax+ AbsName,abstractName,+ -- ** Categories+ Cat,categories,categoryContext,+ -- ** Functions+ Fun, functions, functionsByCat,+ functionType, functionIsConstructor, hasLinearization,+ -- ** Expressions+ Expr,showExpr,readExpr,pExpr,+ mkAbs,unAbs,+ mkApp,unApp,+ mkStr,unStr,+ mkInt,unInt,+ mkFloat,unFloat,+ mkMeta,unMeta,+ mkCId,+ exprHash, exprSize, exprFunctions, exprSubstitute,+ treeProbability,++ -- ** Types+ Type, Hypo, BindType(..), startCat,+ readType, showType, showContext,+ mkType, unType,++ -- ** Type checking+ checkExpr, inferExpr, checkType,++ -- ** Computing+ compute,++ -- * Concrete syntax+ ConcName,Concr,languages,concreteName,languageCode,++ -- ** Linearization+ linearize,linearizeAll,tabularLinearize,tabularLinearizeAll,bracketedLinearize,bracketedLinearizeAll,+ FId, LIndex, BracketedString(..), showBracketedString, flattenBracketedString,+ printName,++ alignWords,+ -- ** Parsing+ ParseOutput(..), parse, parseWithHeuristics,+ -- ** Sentence Lookup+ lookupSentence,+ -- ** Generation+ generateAll,+ -- ** Morphological Analysis+ MorphoAnalysis, lookupMorpho, fullFormLexicon,+ -- ** Visualizations+ GraphvizOptions(..), graphvizDefaults,+ graphvizAbstractTree, graphvizParseTree, graphvizWordAlignment,++ -- * Exceptions+ PGFError(..),++ -- * Grammar specific callbacks+ LiteralCallback,literalCallbacks+ ) where++import Prelude hiding (fromEnum,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint+import Control.Exception(Exception,throwIO)+import Control.Monad(forM_)+import System.IO.Unsafe(unsafePerformIO,unsafeInterleaveIO)+import Text.PrettyPrint+import PGF2.Expr+import PGF2.Type+import PGF2.FFI++import Foreign hiding ( Pool, newPool, unsafePerformIO )+import Foreign.C+import Data.Typeable+import qualified Data.Map as Map+import Data.IORef+import Data.Char(isUpper,isSpace)+import Data.List(isSuffixOf,maximumBy,nub)+import Data.Function(on)++ +-----------------------------------------------------------------------+-- Functions that take a PGF.+-- PGF has many Concrs.+--+-- A Concr retains its PGF in a field in order to retain a reference to+-- the foreign pointer in case if the application still has a reference+-- to Concr but has lost its reference to PGF.+++type AbsName = CId -- ^ Name of abstract syntax+type ConcName = CId -- ^ Name of concrete syntax++-- | Reads file in Portable Grammar Format and produces+-- 'PGF' structure. The file is usually produced with:+--+-- > $ gf -make <grammar file name>+readPGF :: FilePath -> IO PGF+readPGF fpath =+ do pool <- gu_new_pool+ pgf <- withCString fpath $ \c_fpath ->+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ pgf <- pgf_read c_fpath pool exn+ failed <- gu_exn_is_raised exn+ if failed+ then do is_errno <- gu_exn_caught exn gu_exn_type_GuErrno+ if is_errno+ then do perrno <- (#peek GuExn, data.data) exn+ errno <- peek perrno+ gu_pool_free pool+ ioError (errnoToIOError "readPGF" (Errno errno) Nothing (Just fpath))+ else do gu_pool_free pool+ throwIO (PGFError "The grammar cannot be loaded")+ else return pgf+ pgfFPtr <- newForeignPtr gu_pool_finalizer pool+ return (PGF pgf (touchForeignPtr pgfFPtr))++showPGF :: PGF -> String+showPGF p =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ do (sb,out) <- newOut tmpPl+ exn <- gu_new_exn tmpPl+ pgf_print (pgf p) out exn+ touchPGF p+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s++-- | List of all languages available in the grammar.+languages :: PGF -> Map.Map ConcName Concr+languages p =+ unsafePerformIO $+ do ref <- newIORef Map.empty+ allocaBytes (#size GuMapItor) $ \itor ->+ do fptr <- wrapMapItorCallback (getLanguages ref)+ (#poke GuMapItor, fn) itor fptr+ pgf_iter_languages (pgf p) itor nullPtr+ freeHaskellFunPtr fptr+ readIORef ref+ where+ getLanguages :: IORef (Map.Map String Concr) -> MapItorCallback+ getLanguages ref itor key value exn = do+ langs <- readIORef ref+ name <- peekUtf8CString (castPtr key)+ concr <- fmap (\ptr -> Concr ptr (touchPGF p)) $ peek (castPtr value)+ writeIORef ref $! Map.insert name concr langs++-- | The abstract language name is the name of the top-level+-- abstract module+concreteName :: Concr -> ConcName+concreteName c = unsafePerformIO (peekUtf8CString =<< pgf_concrete_name (concr c))++languageCode :: Concr -> String+languageCode c = unsafePerformIO (peekUtf8CString =<< pgf_language_code (concr c))+++-- | Generates an exhaustive possibly infinite list of+-- all abstract syntax expressions of the given type. +-- The expressions are ordered by their probability.+generateAll :: PGF -> Type -> [(Expr,Float)]+generateAll p (Type ctype _) =+ unsafePerformIO $+ do genPl <- gu_new_pool+ exprPl <- gu_new_pool+ exn <- gu_new_exn genPl+ enum <- pgf_generate_all (pgf p) ctype exn genPl exprPl+ genFPl <- newForeignPtr gu_pool_finalizer genPl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ fromPgfExprEnum enum genFPl (touchPGF p >> touchForeignPtr exprFPl)++-- | The abstract language name is the name of the top-level+-- abstract module+abstractName :: PGF -> AbsName+abstractName p = unsafePerformIO (peekUtf8CString =<< pgf_abstract_name (pgf p))++-- | The start category is defined in the grammar with+-- the \'startcat\' flag. This is usually the sentence category+-- but it is not necessary. Despite that there is a start category+-- defined you can parse with any category. The start category+-- definition is just for convenience.+startCat :: PGF -> Type+startCat p = unsafePerformIO $ do+ typPl <- gu_new_pool+ c_type <- pgf_start_cat (pgf p) typPl+ typeFPl <- newForeignPtr gu_pool_finalizer typPl+ return (Type c_type (touchForeignPtr typeFPl))++loadConcr :: Concr -> FilePath -> IO ()+loadConcr c fpath =+ withCString fpath $ \c_fpath ->+ withCString "rb" $ \c_mode ->+ withGuPool $ \tmpPl -> do+ file <- fopen c_fpath c_mode+ inp <- gu_file_in file tmpPl+ exn <- gu_new_exn tmpPl+ pgf_concrete_load (concr c) inp exn+ failed <- gu_exn_is_raised exn+ if failed+ then do is_errno <- gu_exn_caught exn gu_exn_type_GuErrno+ if is_errno+ then do perrno <- (#peek GuExn, data.data) exn+ errno <- peek perrno+ ioError (errnoToIOError "loadConcr" (Errno errno) Nothing (Just fpath))+ else do throwIO (PGFError "The language cannot be loaded")+ else return ()++unloadConcr :: Concr -> IO ()+unloadConcr c = pgf_concrete_unload (concr c)++-- | The type of a function+functionType :: PGF -> Fun -> Maybe Type+functionType p fn =+ unsafePerformIO $+ withGuPool $ \tmpPl -> do+ c_fn <- newUtf8CString fn tmpPl+ c_type <- pgf_function_type (pgf p) c_fn+ return (if c_type == nullPtr+ then Nothing+ else Just (Type c_type (touchPGF p)))++-- | The type of a function+functionIsConstructor :: PGF -> Fun -> Bool+functionIsConstructor p fn =+ unsafePerformIO $+ withGuPool $ \tmpPl -> do+ c_fn <- newUtf8CString fn tmpPl+ res <- pgf_function_is_constructor (pgf p) c_fn+ touchPGF p+ return (res /= 0)++-- | Checks an expression against a specified type.+checkExpr :: PGF -> Expr -> Type -> Either String Expr+checkExpr (PGF p _) (Expr c_expr touch1) (Type c_ty touch2) =+ unsafePerformIO $+ alloca $ \pexpr ->+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ exprPl <- gu_new_pool+ poke pexpr c_expr+ pgf_check_expr p pexpr c_ty exn exprPl+ touch1 >> touch2+ status <- gu_exn_is_raised exn+ if not status+ then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ c_expr <- peek pexpr+ return (Right (Expr c_expr (touchForeignPtr exprFPl)))+ else do is_tyerr <- gu_exn_caught exn gu_exn_type_PgfTypeError+ c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ gu_pool_free exprPl+ if is_tyerr+ then return (Left msg)+ else throwIO (PGFError msg)++-- | Tries to infer the type of an expression. Note that+-- even if the expression is type correct it is not always+-- possible to infer its type in the GF type system.+-- In this case the function returns an error.+inferExpr :: PGF -> Expr -> Either String (Expr, Type)+inferExpr (PGF p _) (Expr c_expr touch1) =+ unsafePerformIO $+ alloca $ \pexpr ->+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ exprPl <- gu_new_pool+ poke pexpr c_expr+ c_ty <- pgf_infer_expr p pexpr exn exprPl+ touch1+ status <- gu_exn_is_raised exn+ if not status+ then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ let touch = touchForeignPtr exprFPl+ c_expr <- peek pexpr+ return (Right (Expr c_expr touch, Type c_ty touch))+ else do is_tyerr <- gu_exn_caught exn gu_exn_type_PgfTypeError+ c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ gu_pool_free exprPl+ if is_tyerr+ then return (Left msg)+ else throwIO (PGFError msg)++-- | Check whether a type is consistent with the abstract+-- syntax of the grammar.+checkType :: PGF -> Type -> Either String Type+checkType (PGF p _) (Type c_ty touch1) =+ unsafePerformIO $+ alloca $ \pty ->+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ typePl <- gu_new_pool+ poke pty c_ty+ pgf_check_type p pty exn typePl+ touch1+ status <- gu_exn_is_raised exn+ if not status+ then do typeFPl <- newForeignPtr gu_pool_finalizer typePl+ c_ty <- peek pty+ return (Right (Type c_ty (touchForeignPtr typeFPl)))+ else do is_tyerr <- gu_exn_caught exn gu_exn_type_PgfTypeError+ c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ gu_pool_free typePl+ if is_tyerr+ then return (Left msg)+ else throwIO (PGFError msg)++compute :: PGF -> Expr -> Expr+compute (PGF p _) (Expr c_expr touch1) =+ unsafePerformIO $+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ exprPl <- gu_new_pool+ c_expr <- pgf_compute p c_expr exn tmpPl exprPl+ touch1+ status <- gu_exn_is_raised exn+ if not status+ then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return (Expr c_expr (touchForeignPtr exprFPl))+ else do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ gu_pool_free exprPl+ throwIO (PGFError msg)++treeProbability :: PGF -> Expr -> Float+treeProbability (PGF p _) (Expr c_expr touch1) =+ unsafePerformIO $ do+ res <- pgf_compute_tree_probability p c_expr+ touch1+ return (realToFrac res)++exprHash :: Int32 -> Expr -> Int32+exprHash h (Expr c_expr touch1) =+ unsafePerformIO $ do+ h <- pgf_expr_hash (fromIntegral h) c_expr+ touch1+ return (fromIntegral h)++exprSize :: Expr -> Int+exprSize (Expr c_expr touch1) =+ unsafePerformIO $ do+ size <- pgf_expr_size c_expr+ touch1+ return (fromIntegral size)++exprFunctions :: Expr -> [Fun]+exprFunctions (Expr c_expr touch) =+ unsafePerformIO $+ withGuPool $ \tmpPl -> do+ seq <- pgf_expr_functions c_expr tmpPl+ len <- (#peek GuSeq, len) seq+ arr <- peekArray (fromIntegral (len :: CInt)) (seq `plusPtr` (#offset GuSeq, data))+ funs <- mapM peekUtf8CString arr+ touch+ return funs++exprSubstitute :: Expr -> [Expr] -> Expr+exprSubstitute (Expr c_expr touch) meta_values =+ unsafePerformIO $+ withGuPool $ \tmpPl -> do+ c_meta_values <- newSequence (#size PgfExpr) pokeExpr meta_values tmpPl+ exprPl <- gu_new_pool+ c_expr <- pgf_expr_substitute c_expr c_meta_values exprPl+ touch+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ let touch' = sequence_ (touchForeignPtr exprFPl : map touchExpr meta_values)+ return (Expr c_expr touch')+ where+ pokeExpr ptr (Expr c_expr _) = poke ptr c_expr++-----------------------------------------------------------------------------+-- Graphviz++data GraphvizOptions = GraphvizOptions {noLeaves :: Bool,+ noFun :: Bool,+ noCat :: Bool,+ noDep :: Bool,+ nodeFont :: String,+ leafFont :: String,+ nodeColor :: String,+ leafColor :: String,+ nodeEdgeStyle :: String,+ leafEdgeStyle :: String+ }++graphvizDefaults = GraphvizOptions False False False True "" "" "" "" "" ""++-- | Renders an abstract syntax tree in a Graphviz format.+graphvizAbstractTree :: PGF -> GraphvizOptions -> Expr -> String+graphvizAbstractTree p opts e =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ do (sb,out) <- newOut tmpPl+ exn <- gu_new_exn tmpPl+ c_opts <- newGraphvizOptions tmpPl opts+ pgf_graphviz_abstract_tree (pgf p) (expr e) c_opts out exn+ touchExpr e+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s+++graphvizParseTree :: Concr -> GraphvizOptions -> Expr -> String+graphvizParseTree c opts e =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ do (sb,out) <- newOut tmpPl+ exn <- gu_new_exn tmpPl+ c_opts <- newGraphvizOptions tmpPl opts+ pgf_graphviz_parse_tree (concr c) (expr e) c_opts out exn+ touchExpr e+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s++graphvizWordAlignment :: [Concr] -> GraphvizOptions -> Expr -> String+graphvizWordAlignment cs opts e =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ withArrayLen (map concr cs) $ \n_concrs ptr ->+ do (sb,out) <- newOut tmpPl+ exn <- gu_new_exn tmpPl+ c_opts <- newGraphvizOptions tmpPl opts+ pgf_graphviz_word_alignment ptr (fromIntegral n_concrs) (expr e) c_opts out exn+ touchExpr e+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s++newGraphvizOptions :: Ptr GuPool -> GraphvizOptions -> IO (Ptr PgfGraphvizOptions)+newGraphvizOptions pool opts = do+ c_opts <- gu_malloc pool (#size PgfGraphvizOptions)+ (#poke PgfGraphvizOptions, noLeaves) c_opts (if noLeaves opts then 1 else 0 :: CInt)+ (#poke PgfGraphvizOptions, noFun) c_opts (if noFun opts then 1 else 0 :: CInt)+ (#poke PgfGraphvizOptions, noCat) c_opts (if noCat opts then 1 else 0 :: CInt)+ (#poke PgfGraphvizOptions, noDep) c_opts (if noDep opts then 1 else 0 :: CInt)+ newUtf8CString (nodeFont opts) pool >>= (#poke PgfGraphvizOptions, nodeFont) c_opts+ newUtf8CString (leafFont opts) pool >>= (#poke PgfGraphvizOptions, leafFont) c_opts+ newUtf8CString (nodeColor opts) pool >>= (#poke PgfGraphvizOptions, nodeColor) c_opts+ newUtf8CString (leafColor opts) pool >>= (#poke PgfGraphvizOptions, leafColor) c_opts+ newUtf8CString (nodeEdgeStyle opts) pool >>= (#poke PgfGraphvizOptions, nodeEdgeStyle) c_opts+ newUtf8CString (leafEdgeStyle opts) pool >>= (#poke PgfGraphvizOptions, leafEdgeStyle) c_opts+ return c_opts++-----------------------------------------------------------------------------+-- Functions using Concr+-- Morpho analyses, parsing & linearization++type MorphoAnalysis = (Fun,Cat,Float)++lookupMorpho :: Concr -> String -> [MorphoAnalysis]+lookupMorpho (Concr concr master) sent =+ unsafePerformIO $+ withGuPool $ \tmpPl -> do+ ref <- newIORef []+ cback <- gu_malloc tmpPl (#size PgfMorphoCallback)+ fptr <- wrapLookupMorphoCallback (getAnalysis ref)+ (#poke PgfMorphoCallback, callback) cback fptr+ c_sent <- newUtf8CString sent tmpPl+ pgf_lookup_morpho concr c_sent cback nullPtr+ freeHaskellFunPtr fptr+ readIORef ref++fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])]+fullFormLexicon lang =+ unsafePerformIO $+ do pl <- gu_new_pool+ enum <- pgf_fullform_lexicon (concr lang) pl+ fpl <- newForeignPtr gu_pool_finalizer pl+ fromFullFormEntry enum fpl+ where+ fromFullFormEntry :: Ptr GuEnum -> ForeignPtr GuPool -> IO [(String, [MorphoAnalysis])]+ fromFullFormEntry enum fpl =+ do ffEntry <- alloca $ \ptr ->+ withForeignPtr fpl $ \pl ->+ do gu_enum_next enum ptr pl+ peek ptr+ if ffEntry == nullPtr+ then do finalizeForeignPtr fpl+ touchConcr lang+ return []+ else do tok <- peekUtf8CString =<< pgf_fullform_get_string ffEntry+ ref <- newIORef []+ allocaBytes (#size PgfMorphoCallback) $ \cback ->+ do fptr <- wrapLookupMorphoCallback (getAnalysis ref)+ (#poke PgfMorphoCallback, callback) cback fptr+ pgf_fullform_get_analyses ffEntry cback nullPtr+ ans <- readIORef ref+ toks <- unsafeInterleaveIO (fromFullFormEntry enum fpl)+ return ((tok,ans) : toks)++getAnalysis :: IORef [MorphoAnalysis] -> LookupMorphoCallback+getAnalysis ref self c_lemma c_anal prob exn = do+ ans <- readIORef ref+ lemma <- peekUtf8CString c_lemma+ anal <- peekUtf8CString c_anal+ writeIORef ref ((lemma, anal, prob):ans)++-- | This data type encodes the different outcomes which you could get from the parser.+data ParseOutput+ = ParseFailed Int String -- ^ The integer is the position in number of unicode characters where the parser failed.+ -- The string is the token where the parser have failed.+ | ParseOk [(Expr,Float)] -- ^ If the parsing and the type checking are successful we get a list of abstract syntax trees.+ -- The list should be non-empty.+ | ParseIncomplete -- ^ The sentence is not complete.++parse :: Concr -> Type -> String -> ParseOutput+parse lang ty sent = parseWithHeuristics lang ty sent (-1.0) []++parseWithHeuristics :: Concr -- ^ the language with which we parse+ -> Type -- ^ the start category+ -> String -- ^ the input sentence+ -> Double -- ^ the heuristic factor. + -- A negative value tells the parser + -- to lookup up the default from + -- the grammar flags+ -> [(Cat, Int -> Int -> Maybe (Expr,Float,Int))]+ -- ^ a list of callbacks for literal categories.+ -- The arguments of the callback are:+ -- the index of the constituent for the literal category;+ -- the input sentence; the current offset in the sentence.+ -- If a literal has been recognized then the output should+ -- be Just (expr,probability,end_offset)+ -> ParseOutput+parseWithHeuristics lang (Type ctype touchType) sent heuristic callbacks =+ unsafePerformIO $+ do exprPl <- gu_new_pool+ parsePl <- gu_new_pool+ exn <- gu_new_exn parsePl+ sent <- newUtf8CString sent parsePl+ callbacks_map <- mkCallbacksMap (concr lang) callbacks parsePl+ enum <- pgf_parse_with_heuristics (concr lang) ctype sent heuristic callbacks_map exn parsePl exprPl+ touchType+ failed <- gu_exn_is_raised exn+ if failed+ then do is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError+ if is_parse_error+ then do c_err <- (#peek GuExn, data.data) exn+ c_incomplete <- (#peek PgfParseError, incomplete) c_err+ if (c_incomplete :: CInt) == 0+ then do c_offset <- (#peek PgfParseError, offset) c_err+ token_ptr <- (#peek PgfParseError, token_ptr) c_err+ token_len <- (#peek PgfParseError, token_len) c_err+ tok <- peekUtf8CStringLen token_ptr token_len+ gu_pool_free parsePl+ gu_pool_free exprPl+ return (ParseFailed (fromIntegral (c_offset :: CInt)) tok)+ else do gu_pool_free parsePl+ gu_pool_free exprPl+ return ParseIncomplete+ else do is_exn <- gu_exn_caught exn gu_exn_type_PgfExn+ if is_exn+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ gu_pool_free parsePl+ gu_pool_free exprPl+ throwIO (PGFError msg)+ else do gu_pool_free parsePl+ gu_pool_free exprPl+ throwIO (PGFError "Parsing failed")+ else do parseFPl <- newForeignPtr gu_pool_finalizer parsePl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ exprs <- fromPgfExprEnum enum parseFPl (touchConcr lang >> touchForeignPtr exprFPl)+ return (ParseOk exprs)++mkCallbacksMap :: Ptr PgfConcr -> [(String, Int -> Int -> Maybe (Expr,Float,Int))] -> Ptr GuPool -> IO (Ptr PgfCallbacksMap)+mkCallbacksMap concr callbacks pool = do+ callbacks_map <- pgf_new_callbacks_map concr pool+ forM_ callbacks $ \(cat,match) -> do+ ccat <- newUtf8CString cat pool+ match <- wrapLiteralMatchCallback (match_callback match)+ predict <- wrapLiteralPredictCallback predict_callback+ hspgf_callbacks_map_add_literal concr callbacks_map ccat match predict pool+ return callbacks_map+ where+ match_callback match clin_idx poffset out_pool = do+ coffset <- peek poffset+ case match (fromIntegral clin_idx) (fromIntegral coffset) of+ Nothing -> return nullPtr+ Just (e,prob,offset') -> do poke poffset (fromIntegral offset')++ -- here we copy the expression to out_pool+ c_e <- withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ + (sb,out) <- newOut tmpPl+ let printCtxt = nullPtr+ pgf_print_expr (expr e) printCtxt 1 out exn+ c_str <- gu_string_buf_freeze sb tmpPl++ guin <- gu_string_in c_str tmpPl+ pgf_read_expr guin out_pool tmpPl exn++ ep <- gu_malloc out_pool (#size PgfExprProb)+ (#poke PgfExprProb, expr) ep c_e+ (#poke PgfExprProb, prob) ep prob+ return ep++ predict_callback _ _ _ = return nullPtr++lookupSentence :: Concr -- ^ the language with which we parse+ -> Type -- ^ the start category+ -> String -- ^ the input sentence+ -> [(Expr,Float)]+lookupSentence lang (Type ctype _) sent =+ unsafePerformIO $+ do exprPl <- gu_new_pool+ parsePl <- gu_new_pool+ sent <- newUtf8CString sent parsePl+ enum <- pgf_lookup_sentence (concr lang) ctype sent parsePl exprPl+ parseFPl <- newForeignPtr gu_pool_finalizer parsePl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ exprs <- fromPgfExprEnum enum parseFPl (touchConcr lang >> touchForeignPtr exprFPl)+ return exprs+++-- | The oracle is a triple of functions.+-- The first two take a category name and a linearization field name+-- and they should return True/False when the corresponding +-- prediction or completion is appropriate. The third function+-- is the oracle for literals.+type Oracle = (Maybe (Cat -> String -> Int -> Bool)+ ,Maybe (Cat -> String -> Int -> Bool)+ ,Maybe (Cat -> String -> Int -> Maybe (Expr,Float,Int))+ )++parseWithOracle :: Concr -- ^ the language with which we parse+ -> Cat -- ^ the start category+ -> String -- ^ the input sentence+ -> Oracle+ -> ParseOutput+parseWithOracle lang cat sent (predict,complete,literal) =+ unsafePerformIO $+ do parsePl <- gu_new_pool+ exprPl <- gu_new_pool+ exn <- gu_new_exn parsePl+ cat <- newUtf8CString cat parsePl+ sent <- newUtf8CString sent parsePl+ predictPtr <- maybe (return nullFunPtr) (wrapOracleCallback . oracleWrapper) predict+ completePtr <- maybe (return nullFunPtr) (wrapOracleCallback . oracleWrapper) complete+ literalPtr <- maybe (return nullFunPtr) (wrapOracleLiteralCallback . oracleLiteralWrapper) literal+ cback <- hspgf_new_oracle_callback sent predictPtr completePtr literalPtr parsePl+ enum <- pgf_parse_with_oracle (concr lang) cat sent cback exn parsePl exprPl+ failed <- gu_exn_is_raised exn+ if failed+ then do is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError+ if is_parse_error+ then do c_err <- (#peek GuExn, data.data) exn+ c_incomplete <- (#peek PgfParseError, incomplete) c_err+ if (c_incomplete :: CInt) == 0+ then do c_offset <- (#peek PgfParseError, offset) c_err+ token_ptr <- (#peek PgfParseError, token_ptr) c_err+ token_len <- (#peek PgfParseError, token_len) c_err+ tok <- peekUtf8CStringLen token_ptr token_len+ gu_pool_free parsePl+ gu_pool_free exprPl+ return (ParseFailed (fromIntegral (c_offset :: CInt)) tok)+ else do gu_pool_free parsePl+ gu_pool_free exprPl+ return ParseIncomplete+ else do is_exn <- gu_exn_caught exn gu_exn_type_PgfExn+ if is_exn+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ gu_pool_free parsePl+ gu_pool_free exprPl+ throwIO (PGFError msg)+ else do gu_pool_free parsePl+ gu_pool_free exprPl+ throwIO (PGFError "Parsing failed")+ else do parseFPl <- newForeignPtr gu_pool_finalizer parsePl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ exprs <- fromPgfExprEnum enum parseFPl (touchConcr lang >> touchForeignPtr exprFPl)+ return (ParseOk exprs)+ where+ oracleWrapper oracle catPtr lblPtr offset = do+ cat <- peekUtf8CString catPtr+ lbl <- peekUtf8CString lblPtr+ return (oracle cat lbl (fromIntegral offset))++ oracleLiteralWrapper oracle catPtr lblPtr poffset out_pool = do+ cat <- peekUtf8CString catPtr+ lbl <- peekUtf8CString lblPtr+ offset <- peek poffset+ case oracle cat lbl (fromIntegral offset) of+ Just (e,prob,offset) ->+ do poke poffset (fromIntegral offset)++ -- here we copy the expression to out_pool+ c_e <- withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl++ (sb,out) <- newOut tmpPl+ let printCtxt = nullPtr+ pgf_print_expr (expr e) printCtxt 1 out exn+ c_str <- gu_string_buf_freeze sb tmpPl++ guin <- gu_string_in c_str tmpPl+ pgf_read_expr guin out_pool tmpPl exn++ ep <- gu_malloc out_pool (#size PgfExprProb)+ (#poke PgfExprProb, expr) ep c_e+ (#poke PgfExprProb, prob) ep prob+ return ep+ Nothing -> do return nullPtr++-- | Returns True if there is a linearization defined for that function in that language+hasLinearization :: Concr -> Fun -> Bool+hasLinearization lang id = unsafePerformIO $+ withGuPool $ \pl -> do+ res <- newUtf8CString id pl >>= pgf_has_linearization (concr lang)+ return (res /= 0)++-- | Linearizes an expression as a string in the language+linearize :: Concr -> Expr -> String+linearize lang e = unsafePerformIO $+ withGuPool $ \pl ->+ do (sb,out) <- newOut pl+ exn <- gu_new_exn pl+ pgf_linearize (concr lang) (expr e) out exn+ touchExpr e+ failed <- gu_exn_is_raised exn+ if failed+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist+ if is_nonexist+ then return ""+ else do is_exn <- gu_exn_caught exn gu_exn_type_PgfExn+ if is_exn+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ throwIO (PGFError msg)+ else throwIO (PGFError "The abstract tree cannot be linearized")+ else do lin <- gu_string_buf_freeze sb pl+ peekUtf8CString lin++-- | Generates all possible linearizations of an expression+linearizeAll :: Concr -> Expr -> [String]+linearizeAll lang e = unsafePerformIO $+ do pl <- gu_new_pool+ exn <- gu_new_exn pl+ cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl+ failed <- gu_exn_is_raised exn+ if failed+ then throwExn exn pl+ else collect cts exn pl+ where+ collect cts exn pl = withGuPool $ \tmpPl -> do+ ctree <- alloca $ \ptr -> do gu_enum_next cts ptr tmpPl+ peek ptr+ if ctree == nullPtr+ then do gu_pool_free pl+ touchExpr e+ return []+ else do (sb,out) <- newOut tmpPl+ ctree <- pgf_lzr_wrap_linref ctree tmpPl+ pgf_lzr_linearize_simple (concr lang) ctree 0 out exn tmpPl+ failed <- gu_exn_is_raised exn+ if failed+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist+ if is_nonexist+ then collect cts exn pl+ else throwExn exn pl+ else do lin <- gu_string_buf_freeze sb tmpPl+ s <- peekUtf8CString lin+ ss <- collect cts exn pl+ return (s:ss)++ throwExn exn pl = do+ is_exn <- gu_exn_caught exn gu_exn_type_PgfExn+ if is_exn+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ gu_pool_free pl+ throwIO (PGFError msg)+ else do gu_pool_free pl+ throwIO (PGFError "The abstract tree cannot be linearized")++-- | Generates a table of linearizations for an expression+tabularLinearize :: Concr -> Expr -> [(String, String)]+tabularLinearize lang e = + case tabularLinearizeAll lang e of+ (lins:_) -> lins+ _ -> []++-- | Generates a table of linearizations for an expression+tabularLinearizeAll :: Concr -> Expr -> [[(String, String)]]+tabularLinearizeAll lang e = unsafePerformIO $+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ cts <- pgf_lzr_concretize (concr lang) (expr e) exn tmpPl+ failed <- gu_exn_is_raised exn+ if failed+ then throwExn exn+ else collect cts exn tmpPl+ where+ collect cts exn tmpPl = do+ ctree <- alloca $ \ptr -> do gu_enum_next cts ptr tmpPl+ peek ptr+ if ctree == nullPtr+ then do touchExpr e+ return []+ else do labels <- alloca $ \p_n_lins ->+ alloca $ \p_labels -> do+ pgf_lzr_get_table (concr lang) ctree p_n_lins p_labels+ n_lins <- peek p_n_lins+ labels <- peek p_labels+ labels <- peekArray (fromIntegral n_lins) labels+ labels <- mapM peekCString labels+ return labels+ lins <- collectTable lang ctree 0 labels exn tmpPl+ linss <- collect cts exn tmpPl+ return (lins : linss)++ collectTable lang ctree lin_idx [] exn tmpPl = return []+ collectTable lang ctree lin_idx (label:labels) exn tmpPl = do+ (sb,out) <- newOut tmpPl+ pgf_lzr_linearize_simple (concr lang) ctree lin_idx out exn tmpPl+ failed <- gu_exn_is_raised exn+ if failed+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist+ if is_nonexist+ then collectTable lang ctree (lin_idx+1) labels exn tmpPl+ else throwExn exn+ else do lin <- gu_string_buf_freeze sb tmpPl+ s <- peekUtf8CString lin+ ss <- collectTable lang ctree (lin_idx+1) labels exn tmpPl+ return ((label,s):ss)++ throwExn exn = do+ is_exn <- gu_exn_caught exn gu_exn_type_PgfExn+ if is_exn+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ throwIO (PGFError msg)+ else do throwIO (PGFError "The abstract tree cannot be linearized")++type FId = Int+type LIndex = Int++-- | BracketedString represents a sentence that is linearized+-- as usual but we also want to retain the ''brackets'' that+-- mark the beginning and the end of each constituent.+data BracketedString+ = Leaf String -- ^ this is the leaf i.e. a single token+ | BIND -- ^ the surrounding tokens must be bound together+ | Bracket CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [BracketedString]+ -- ^ this is a bracket. The 'CId' is the category of+ -- the phrase. The 'FId' is an unique identifier for+ -- every phrase in the sentence. For context-free grammars+ -- i.e. without discontinuous constituents this identifier+ -- is also unique for every bracket. When there are discontinuous + -- phrases then the identifiers are unique for every phrase but+ -- not for every bracket since the bracket represents a constituent.+ -- The different constituents could still be distinguished by using+ -- the constituent index i.e. 'LIndex'. If the grammar is reduplicating+ -- then the constituent indices will be the same for all brackets+ -- that represents the same constituent.+ -- The second 'CId' is the name of the abstract function that generated+ -- this phrase.++-- | Renders the bracketed string as a string where +-- the brackets are shown as @(S ...)@ where+-- @S@ is the category.+showBracketedString :: BracketedString -> String+showBracketedString = render . ppBracketedString++ppBracketedString (Leaf t) = text t+ppBracketedString BIND = text "&+"+ppBracketedString (Bracket cat fid index _ bss) = parens (text cat <> colon <> int fid <+> hsep (map ppBracketedString bss))++-- | Extracts the sequence of tokens from the bracketed string+flattenBracketedString :: BracketedString -> [String]+flattenBracketedString (Leaf w) = [w]+flattenBracketedString BIND = []+flattenBracketedString (Bracket _ _ _ _ bss) = concatMap flattenBracketedString bss++bracketedLinearize :: Concr -> Expr -> [BracketedString]+bracketedLinearize lang e = unsafePerformIO $+ withGuPool $ \pl -> + do exn <- gu_new_exn pl+ cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl+ failed <- gu_exn_is_raised exn+ if failed+ then throwExn exn+ else do ctree <- alloca $ \ptr -> do gu_enum_next cts ptr pl+ peek ptr+ if ctree == nullPtr+ then do touchExpr e+ return []+ else do ctree <- pgf_lzr_wrap_linref ctree pl+ ref <- newIORef ([],[])+ withBracketLinFuncs ref exn $ \ppLinFuncs ->+ pgf_lzr_linearize (concr lang) ctree 0 ppLinFuncs pl+ failed <- gu_exn_is_raised exn+ if failed+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist+ if is_nonexist+ then return []+ else throwExn exn+ else do (_,bs) <- readIORef ref+ return (reverse bs)++bracketedLinearizeAll :: Concr -> Expr -> [[BracketedString]]+bracketedLinearizeAll lang e = unsafePerformIO $+ withGuPool $ \pl -> + do exn <- gu_new_exn pl+ cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl+ failed <- gu_exn_is_raised exn+ if failed+ then do touchExpr e+ throwExn exn+ else do ref <- newIORef ([],[])+ bss <- withBracketLinFuncs ref exn $ \ppLinFuncs ->+ collect ref cts ppLinFuncs exn pl+ touchExpr e+ return bss+ where+ collect ref cts ppLinFuncs exn pl = withGuPool $ \tmpPl -> do+ ctree <- alloca $ \ptr -> do gu_enum_next cts ptr tmpPl+ peek ptr+ if ctree == nullPtr+ then return []+ else do ctree <- pgf_lzr_wrap_linref ctree pl+ pgf_lzr_linearize (concr lang) ctree 0 ppLinFuncs pl+ failed <- gu_exn_is_raised exn+ if failed+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist+ if is_nonexist+ then collect ref cts ppLinFuncs exn pl+ else throwExn exn+ else do (_,bs) <- readIORef ref+ writeIORef ref ([],[])+ bss <- collect ref cts ppLinFuncs exn pl+ return (reverse bs : bss)++withBracketLinFuncs ref exn f =+ allocaBytes (#size PgfLinFuncs) $ \pLinFuncs ->+ alloca $ \ppLinFuncs -> do+ fptr_symbol_token <- wrapSymbolTokenCallback (symbol_token ref)+ fptr_begin_phrase <- wrapPhraseCallback (begin_phrase ref)+ fptr_end_phrase <- wrapPhraseCallback (end_phrase ref)+ fptr_symbol_ne <- wrapSymbolNonExistCallback (symbol_ne exn)+ fptr_symbol_bind <- wrapSymbolBindCallback (symbol_bind ref)+ fptr_symbol_meta <- wrapSymbolMetaCallback (symbol_meta ref)+ (#poke PgfLinFuncs, symbol_token) pLinFuncs fptr_symbol_token+ (#poke PgfLinFuncs, begin_phrase) pLinFuncs fptr_begin_phrase+ (#poke PgfLinFuncs, end_phrase) pLinFuncs fptr_end_phrase+ (#poke PgfLinFuncs, symbol_ne) pLinFuncs fptr_symbol_ne+ (#poke PgfLinFuncs, symbol_bind) pLinFuncs fptr_symbol_bind+ (#poke PgfLinFuncs, symbol_capit) pLinFuncs nullPtr+ (#poke PgfLinFuncs, symbol_meta) pLinFuncs fptr_symbol_meta+ poke ppLinFuncs pLinFuncs+ res <- f ppLinFuncs+ freeHaskellFunPtr fptr_symbol_token+ freeHaskellFunPtr fptr_begin_phrase+ freeHaskellFunPtr fptr_end_phrase+ freeHaskellFunPtr fptr_symbol_ne+ freeHaskellFunPtr fptr_symbol_bind+ freeHaskellFunPtr fptr_symbol_meta+ return res+ where+ symbol_token ref _ c_token = do+ (stack,bs) <- readIORef ref+ token <- peekUtf8CString c_token+ writeIORef ref (stack,Leaf token : bs)++ begin_phrase ref _ c_cat c_fid c_lindex c_fun = do+ (stack,bs) <- readIORef ref+ writeIORef ref (bs:stack,[])++ end_phrase ref _ c_cat c_fid c_lindex c_fun = do+ (bs':stack,bs) <- readIORef ref+ cat <- peekUtf8CString c_cat+ let fid = fromIntegral c_fid+ let lindex = fromIntegral c_lindex+ fun <- peekUtf8CString c_fun+ writeIORef ref (stack, Bracket cat fid lindex fun (reverse bs) : bs')++ symbol_ne exn _ = do+ gu_exn_raise exn gu_exn_type_PgfLinNonExist+ return ()++ symbol_bind ref _ = do+ (stack,bs) <- readIORef ref+ writeIORef ref (stack,BIND : bs)+ return ()++ symbol_meta ref _ meta_id = do+ (stack,bs) <- readIORef ref+ writeIORef ref (stack,Leaf "?" : bs)++throwExn exn = do+ is_exn <- gu_exn_caught exn gu_exn_type_PgfExn+ if is_exn+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ throwIO (PGFError msg)+ else do throwIO (PGFError "The abstract tree cannot be linearized")++alignWords :: Concr -> Expr -> [(String, [Int])]+alignWords lang e = unsafePerformIO $+ withGuPool $ \pl ->+ do exn <- gu_new_exn pl+ seq <- pgf_align_words (concr lang) (expr e) exn pl+ touchConcr lang+ touchExpr e+ failed <- gu_exn_is_raised exn+ if failed+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist+ if is_nonexist+ then return []+ else do is_exn <- gu_exn_caught exn gu_exn_type_PgfExn+ if is_exn+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ throwIO (PGFError msg)+ else throwIO (PGFError "The abstract tree cannot be linearized")+ else do len <- (#peek GuSeq, len) seq+ arr <- peekArray (fromIntegral (len :: CInt)) (seq `plusPtr` (#offset GuSeq, data))+ mapM peekAlignmentPhrase arr+ where+ peekAlignmentPhrase :: Ptr () -> IO (String, [Int])+ peekAlignmentPhrase ptr = do+ c_phrase <- (#peek PgfAlignmentPhrase, phrase) ptr+ phrase <- peekUtf8CString c_phrase+ n_fids <- (#peek PgfAlignmentPhrase, n_fids) ptr+ (fids :: [CInt]) <- peekArray (fromIntegral (n_fids :: CInt)) (ptr `plusPtr` (#offset PgfAlignmentPhrase, fids))+ return (phrase, map fromIntegral fids)++printName :: Concr -> Fun -> Maybe String+printName lang fun =+ unsafePerformIO $+ withGuPool $ \tmpPl -> do+ c_fun <- newUtf8CString fun tmpPl+ c_name <- pgf_print_name (concr lang) c_fun+ name <- if c_name == nullPtr+ then return Nothing+ else fmap Just (peekUtf8CString c_name)+ touchConcr lang+ return name++-- | List of all functions defined in the abstract syntax+functions :: PGF -> [Fun]+functions p =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ allocaBytes (#size GuMapItor) $ \itor -> do+ exn <- gu_new_exn tmpPl+ ref <- newIORef []+ fptr <- wrapMapItorCallback (getFunctions ref)+ (#poke GuMapItor, fn) itor fptr+ pgf_iter_functions (pgf p) itor exn+ touchPGF p+ freeHaskellFunPtr fptr+ fs <- readIORef ref+ return (reverse fs)+ where+ getFunctions :: IORef [String] -> MapItorCallback+ getFunctions ref itor key value exn = do+ names <- readIORef ref+ name <- peekUtf8CString (castPtr key)+ writeIORef ref $! (name : names)++-- | List of all functions defined for a category+functionsByCat :: PGF -> Cat -> [Fun]+functionsByCat p cat =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ allocaBytes (#size GuMapItor) $ \itor -> do+ exn <- gu_new_exn tmpPl+ ref <- newIORef []+ fptr <- wrapMapItorCallback (getFunctions ref)+ (#poke GuMapItor, fn) itor fptr+ ccat <- newUtf8CString cat tmpPl+ pgf_iter_functions_by_cat (pgf p) ccat itor exn+ touchPGF p+ freeHaskellFunPtr fptr+ fs <- readIORef ref+ return (reverse fs)+ where+ getFunctions :: IORef [String] -> MapItorCallback+ getFunctions ref itor key value exn = do+ names <- readIORef ref+ name <- peekUtf8CString (castPtr key)+ writeIORef ref $! (name : names)++-- | List of all categories defined in the grammar.+-- The categories are defined in the abstract syntax+-- with the \'cat\' keyword.+categories :: PGF -> [Cat]+categories p =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ allocaBytes (#size GuMapItor) $ \itor -> do+ exn <- gu_new_exn tmpPl+ ref <- newIORef []+ fptr <- wrapMapItorCallback (getCategories ref)+ (#poke GuMapItor, fn) itor fptr+ pgf_iter_categories (pgf p) itor exn+ touchPGF p+ freeHaskellFunPtr fptr+ cs <- readIORef ref+ return (reverse cs)+ where+ getCategories :: IORef [String] -> MapItorCallback+ getCategories ref itor key value exn = do+ names <- readIORef ref+ name <- peekUtf8CString (castPtr key)+ writeIORef ref $! (name : names)++categoryContext :: PGF -> Cat -> [Hypo]+categoryContext p cat =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ do c_cat <- newUtf8CString cat tmpPl+ c_hypos <- pgf_category_context (pgf p) c_cat+ if c_hypos == nullPtr+ then return []+ else do n_hypos <- (#peek GuSeq, len) c_hypos+ peekHypos (c_hypos `plusPtr` (#offset GuSeq, data)) 0 n_hypos+ where+ peekHypos :: Ptr a -> Int -> Int -> IO [Hypo]+ peekHypos c_hypo i n+ | i < n = do cid <- (#peek PgfHypo, cid) c_hypo >>= peekUtf8CString+ c_ty <- (#peek PgfHypo, type) c_hypo+ bt <- fmap toBindType ((#peek PgfHypo, bind_type) c_hypo)+ hs <- peekHypos (plusPtr c_hypo (#size PgfHypo)) (i+1) n+ return ((bt,cid,Type c_ty (touchPGF p)) : hs)+ | otherwise = return []++ toBindType :: CInt -> BindType+ toBindType (#const PGF_BIND_TYPE_EXPLICIT) = Explicit+ toBindType (#const PGF_BIND_TYPE_IMPLICIT) = Implicit++categoryProb :: PGF -> Cat -> Float+categoryProb p cat =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ do c_cat <- newUtf8CString cat tmpPl+ c_prob <- pgf_category_prob (pgf p) c_cat+ touchPGF p+ return (realToFrac c_prob)++-----------------------------------------------------------------------------+-- Helper functions++fromPgfExprEnum :: Ptr GuEnum -> ForeignPtr GuPool -> IO () -> IO [(Expr, Float)]+fromPgfExprEnum enum fpl touch =+ do pgfExprProb <- alloca $ \ptr ->+ withForeignPtr fpl $ \pl ->+ do gu_enum_next enum ptr pl+ peek ptr+ if pgfExprProb == nullPtr+ then do finalizeForeignPtr fpl+ return []+ else do expr <- (#peek PgfExprProb, expr) pgfExprProb+ ts <- unsafeInterleaveIO (fromPgfExprEnum enum fpl touch)+ prob <- (#peek PgfExprProb, prob) pgfExprProb+ return ((Expr expr touch,prob) : ts)++-----------------------------------------------------------------------+-- Exceptions++newtype PGFError = PGFError String+ deriving (Show, Typeable)++instance Exception PGFError++-----------------------------------------------------------------------++type LiteralCallback =+ PGF -> (ConcName,Concr) -> String -> Int -> Int -> Maybe (Expr,Float,Int)++-- | Callbacks for the App grammar+literalCallbacks :: [(AbsName,[(Cat,LiteralCallback)])]+literalCallbacks = [("App",[("PN",nerc),("Symb",chunk)])]++-- | Named entity recognition for the App grammar +-- (based on ../java/org/grammaticalframework/pgf/NercLiteralCallback.java)+nerc :: LiteralCallback+nerc pgf (lang,concr) sentence lin_idx offset =+ case consume capitalized (drop offset sentence) of+ (capwords@(_:_),rest) |+ not ("Eng" `isSuffixOf` lang && name `elem` ["I","I'm"]) ->+ if null ls+ then pn+ else case cat of+ "PN" -> retLit (mkApp lemma [])+ "WeekDay" -> retLit (mkApp "weekdayPN" [mkApp lemma []])+ "Month" -> retLit (mkApp "monthPN" [mkApp lemma []])+ _ -> Nothing+ where+ retLit e = Just (e,0,end_offset)+ where end_offset = offset+length name+ pn = retLit (mkApp "SymbPN" [mkApp "MkSymb" [mkStr name]])+ ((lemma,cat),_) = maximumBy (compare `on` snd) (reverse ls)+ ls = [((fun,cat),p)+ |(fun,_,p)<-lookupMorpho concr name,+ Just cat <- [functionCat fun],+ cat/="Nationality"]+ name = trimRight (concat capwords)+ _ -> Nothing+ where+ -- | Variant of unfoldr+ consume munch xs =+ case munch xs of+ Nothing -> ([],xs)+ Just (y,xs') -> (y:ys,xs'')+ where (ys,xs'') = consume munch xs'++ functionCat f = fmap ((\(_,c,_) -> c) . unType) (functionType pgf f)++-- | Callback to parse arbitrary words as chunks (from+-- ../java/org/grammaticalframework/pgf/UnknownLiteralCallback.java)+chunk :: LiteralCallback+chunk _ (_,concr) sentence lin_idx offset =+ case uncapitalized (drop offset sentence) of+ Just (word0@(_:_),rest) | null (lookupMorpho concr word) ->+ Just (expr,0,offset+length word)+ where+ word = trimRight word0+ expr = mkApp "MkSymb" [mkStr word]+ _ -> Nothing+++-- More helper functions++trimRight = reverse . dropWhile isSpace . reverse++capitalized = capitalized' isUpper+uncapitalized = capitalized' (not.isUpper)++capitalized' test s@(c:_) | test c =+ case span (not.isSpace) s of+ (name,rest1) ->+ case span isSpace rest1 of+ (space,rest2) -> Just (name++space,rest2)+capitalized' not s = Nothing
@@ -0,0 +1,271 @@+#include <pgf/pgf.h>++module PGF2.Expr where++import System.IO.Unsafe(unsafePerformIO)+import Foreign hiding (unsafePerformIO)+import Foreign.C+import Data.IORef+import PGF2.FFI++-- | An data type that represents+-- identifiers for functions and categories in PGF.+type CId = String++wildCId = "_" :: CId++type Cat = CId -- ^ Name of syntactic category+type Fun = CId -- ^ Name of function++data BindType = + Explicit+ | Implicit+ deriving Show++-----------------------------------------------------------------------------+-- Expressions++-- The C structure for the expression may point to other structures+-- which are allocated from other pools. In order to ensure that+-- they are not released prematurely we use the exprMaster to+-- store references to other Haskell objects++data Expr = Expr {expr :: PgfExpr, touchExpr :: Touch}++instance Show Expr where+ show = showExpr []++instance Eq Expr where+ (Expr e1 e1_touch) == (Expr e2 e2_touch) = + unsafePerformIO $ do+ res <- pgf_expr_eq e1 e2+ e1_touch >> e2_touch+ return (res /= 0)++-- | Constructs an expression by lambda abstraction+mkAbs :: BindType -> CId -> Expr -> Expr+mkAbs bind_type var (Expr body bodyTouch) =+ unsafePerformIO $ do+ exprPl <- gu_new_pool+ cvar <- newUtf8CString var exprPl+ c_expr <- pgf_expr_abs cbind_type cvar body exprPl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return (Expr c_expr (bodyTouch >> touchForeignPtr exprFPl))+ where+ cbind_type =+ case bind_type of+ Explicit -> (#const PGF_BIND_TYPE_EXPLICIT)+ Implicit -> (#const PGF_BIND_TYPE_IMPLICIT)++-- | Decomposes an expression into an abstraction and a body+unAbs :: Expr -> Maybe (BindType, CId, Expr)+unAbs (Expr expr touch) =+ unsafePerformIO $ do+ c_abs <- pgf_expr_unabs expr+ if c_abs == nullPtr+ then return Nothing+ else do bt <- fmap toBindType ((#peek PgfExprAbs, bind_type) c_abs)+ var <- (#peek PgfExprAbs, id) c_abs >>= peekUtf8CString+ c_body <- (#peek PgfExprAbs, body) c_abs+ return (Just (bt, var, Expr c_body touch))+ where+ toBindType :: CInt -> BindType+ toBindType (#const PGF_BIND_TYPE_EXPLICIT) = Explicit+ toBindType (#const PGF_BIND_TYPE_IMPLICIT) = Implicit++-- | Constructs an expression by applying a function to a list of expressions+mkApp :: Fun -> [Expr] -> Expr+mkApp fun args =+ unsafePerformIO $+ withCString fun $ \cfun ->+ allocaBytes ((#size PgfApplication) + len * sizeOf (undefined :: PgfExpr)) $ \papp -> do+ (#poke PgfApplication, fun) papp cfun+ (#poke PgfApplication, n_args) papp len+ pokeArray (papp `plusPtr` (#offset PgfApplication, args)) (map expr args)+ exprPl <- gu_new_pool+ c_expr <- pgf_expr_apply papp exprPl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return (Expr c_expr (mapM_ touchExpr args >> touchForeignPtr exprFPl))+ where+ len = length args++-- | Decomposes an expression into an application of a function+unApp :: Expr -> Maybe (Fun,[Expr])+unApp (Expr expr touch) =+ unsafePerformIO $+ withGuPool $ \pl -> do+ appl <- pgf_expr_unapply expr pl+ if appl == nullPtr+ then return Nothing+ else do + fun <- peekCString =<< (#peek PgfApplication, fun) appl+ arity <- (#peek PgfApplication, n_args) appl :: IO CInt + c_args <- peekArray (fromIntegral arity) (appl `plusPtr` (#offset PgfApplication, args))+ return $ Just (fun, [Expr c_arg touch | c_arg <- c_args])++-- | Constructs an expression from a string literal+mkStr :: String -> Expr+mkStr str =+ unsafePerformIO $+ withCString str $ \cstr -> do+ exprPl <- gu_new_pool+ c_expr <- pgf_expr_string cstr exprPl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return (Expr c_expr (touchForeignPtr exprFPl))++-- | Decomposes an expression into a string literal+unStr :: Expr -> Maybe String+unStr (Expr expr touch) =+ unsafePerformIO $ do+ plit <- pgf_expr_unlit expr (#const PGF_LITERAL_STR)+ if plit == nullPtr+ then return Nothing+ else do s <- peekUtf8CString (plit `plusPtr` (#offset PgfLiteralStr, val))+ touch+ return (Just s)++-- | Constructs an expression from an integer literal+mkInt :: Int -> Expr+mkInt val =+ unsafePerformIO $ do+ exprPl <- gu_new_pool+ c_expr <- pgf_expr_int (fromIntegral val) exprPl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return (Expr c_expr (touchForeignPtr exprFPl))++-- | Decomposes an expression into an integer literal+unInt :: Expr -> Maybe Int+unInt (Expr expr touch) =+ unsafePerformIO $ do+ plit <- pgf_expr_unlit expr (#const PGF_LITERAL_INT)+ if plit == nullPtr+ then return Nothing+ else do n <- peek (plit `plusPtr` (#offset PgfLiteralInt, val))+ touch+ return (Just (fromIntegral (n :: CInt)))++-- | Constructs an expression from a real number+mkFloat :: Double -> Expr+mkFloat val =+ unsafePerformIO $ do+ exprPl <- gu_new_pool+ c_expr <- pgf_expr_float (realToFrac val) exprPl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return (Expr c_expr (touchForeignPtr exprFPl))++-- | Decomposes an expression into a real number literal+unFloat :: Expr -> Maybe Double+unFloat (Expr expr touch) =+ unsafePerformIO $ do+ plit <- pgf_expr_unlit expr (#const PGF_LITERAL_FLT)+ if plit == nullPtr+ then return Nothing+ else do n <- peek (plit `plusPtr` (#offset PgfLiteralFlt, val))+ touch+ return (Just (realToFrac (n :: CDouble)))++-- | Constructs a meta variable as an expression+mkMeta :: Int -> Expr+mkMeta id =+ unsafePerformIO $ do+ exprPl <- gu_new_pool+ c_expr <- pgf_expr_meta (fromIntegral id) exprPl+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return (Expr c_expr (touchForeignPtr exprFPl))++-- | Decomposes an expression into a meta variable+unMeta :: Expr -> Maybe Int+unMeta (Expr expr touch) =+ unsafePerformIO $ do+ c_meta <- pgf_expr_unmeta expr+ if c_meta == nullPtr+ then return Nothing+ else do id <- (#peek PgfExprMeta, id) c_meta+ touch+ return (Just (fromIntegral (id :: CInt)))++-- | this functions is only for backward compatibility with the old Haskell runtime+mkCId x = x++-- | parses a 'String' as an expression+readExpr :: String -> Maybe Expr+readExpr str =+ unsafePerformIO $+ do exprPl <- gu_new_pool+ withGuPool $ \tmpPl ->+ do c_str <- newUtf8CString str tmpPl+ guin <- gu_string_in c_str tmpPl+ exn <- gu_new_exn tmpPl+ c_expr <- pgf_read_expr guin exprPl tmpPl exn+ status <- gu_exn_is_raised exn+ if (not status && c_expr /= nullPtr)+ then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ return $ Just (Expr c_expr (touchForeignPtr exprFPl))+ else do gu_pool_free exprPl+ return Nothing++pExpr :: ReadS Expr+pExpr str =+ unsafePerformIO $+ do exprPl <- gu_new_pool+ withGuPool $ \tmpPl ->+ do ref <- newIORef (str,str,str)+ exn <- gu_new_exn tmpPl+ c_fetch_char <- wrapParserGetc (fetch_char ref)+ c_parser <- pgf_new_parser nullPtr c_fetch_char exprPl tmpPl exn+ c_expr <- pgf_expr_parser_expr c_parser 1+ status <- gu_exn_is_raised exn+ if (not status && c_expr /= nullPtr)+ then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ (str,_,_) <- readIORef ref+ return [(Expr c_expr (touchForeignPtr exprFPl),str)]+ else do gu_pool_free exprPl+ return []+ where+ fetch_char :: IORef (String,String,String) -> Ptr () -> (#type bool) -> Ptr GuExn -> IO (#type GuUCS)+ fetch_char ref _ mark exn = do+ (str1,str2,str3) <- readIORef ref+ let str1' = if mark /= 0+ then str2+ else str1+ case str3 of+ [] -> do writeIORef ref (str1',str3,[])+ gu_exn_raise exn gu_exn_type_GuEOF+ return (-1)+ (c:cs) -> do writeIORef ref (str1',str3,cs)+ return ((fromIntegral . fromEnum) c)++foreign import ccall "pgf/expr.h pgf_new_parser"+ pgf_new_parser :: Ptr () -> (FunPtr ParserGetc) -> Ptr GuPool -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfExprParser)++foreign import ccall "pgf/expr.h pgf_expr_parser_expr"+ pgf_expr_parser_expr :: Ptr PgfExprParser -> (#type bool) -> IO PgfExpr++type ParserGetc = Ptr () -> (#type bool) -> Ptr GuExn -> IO (#type GuUCS)++foreign import ccall "wrapper"+ wrapParserGetc :: ParserGetc -> IO (FunPtr ParserGetc)++-- | renders an expression as a 'String'. The list+-- of identifiers is the list of all free variables+-- in the expression in order reverse to the order+-- of binding.+showExpr :: [CId] -> Expr -> String+showExpr scope e = + unsafePerformIO $+ withGuPool $ \tmpPl ->+ do (sb,out) <- newOut tmpPl+ printCtxt <- newPrintCtxt scope tmpPl+ exn <- gu_new_exn tmpPl+ pgf_print_expr (expr e) printCtxt 1 out exn+ touchExpr e+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s++newPrintCtxt :: [String] -> Ptr GuPool -> IO (Ptr PgfPrintContext)+newPrintCtxt [] pool = return nullPtr+newPrintCtxt (x:xs) pool = do+ pctxt <- gu_malloc pool (#size PgfPrintContext)+ newUtf8CString x pool >>= (#poke PgfPrintContext, name) pctxt+ newPrintCtxt xs pool >>= (#poke PgfPrintContext, next) pctxt+ return pctxt
@@ -0,0 +1,532 @@+{-# LANGUAGE ForeignFunctionInterface, MagicHash, BangPatterns #-}++module PGF2.FFI where++#include <gu/defs.h>+#include <gu/hash.h>+#include <gu/utf8.h>+#include <pgf/pgf.h>++import Foreign ( alloca, peek, poke, peekByteOff )+import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Exception+import GHC.Ptr+import Data.Int+import Data.Word++type Touch = IO ()++-- | An abstract data type representing multilingual grammar+-- in Portable Grammar Format.+data PGF = PGF {pgf :: Ptr PgfPGF, touchPGF :: Touch}+data Concr = Concr {concr :: Ptr PgfConcr, touchConcr :: Touch}++------------------------------------------------------------------+-- libgu API++data GuEnum+data GuExn+data GuIn+data GuOut+data GuKind+data GuType+data GuString+data GuStringBuf+data GuMap+data GuMapItor+data GuHasher+data GuSeq+data GuBuf+data GuPool+type GuVariant = Ptr ()+type GuHash = (#type GuHash)+type GuUCS = (#type GuUCS)++type CSizeT = (#type size_t)+type CUInt8 = (#type uint8_t)++foreign import ccall unsafe fopen :: CString -> CString -> IO (Ptr ())++foreign import ccall unsafe "gu/mem.h gu_new_pool"+ gu_new_pool :: IO (Ptr GuPool)++foreign import ccall unsafe "gu/mem.h gu_malloc"+ gu_malloc :: Ptr GuPool -> CSizeT -> IO (Ptr a)++foreign import ccall unsafe "gu/mem.h gu_malloc_aligned"+ gu_malloc_aligned :: Ptr GuPool -> CSizeT -> CSizeT -> IO (Ptr a)++foreign import ccall unsafe "gu/mem.h gu_pool_free"+ gu_pool_free :: Ptr GuPool -> IO ()++foreign import ccall unsafe "gu/mem.h &gu_pool_free"+ gu_pool_finalizer :: FinalizerPtr GuPool++foreign import ccall unsafe "gu/exn.h gu_new_exn"+ gu_new_exn :: Ptr GuPool -> IO (Ptr GuExn)++foreign import ccall unsafe "gu/exn.h gu_exn_is_raised"+ gu_exn_is_raised :: Ptr GuExn -> IO Bool++foreign import ccall unsafe "gu/exn.h gu_exn_caught_"+ gu_exn_caught :: Ptr GuExn -> CString -> IO Bool++foreign import ccall unsafe "gu/exn.h gu_exn_raise_"+ gu_exn_raise :: Ptr GuExn -> CString -> IO (Ptr ())++gu_exn_type_GuErrno = Ptr "GuErrno"## :: CString++gu_exn_type_GuEOF = Ptr "GuEOF"## :: CString++gu_exn_type_PgfLinNonExist = Ptr "PgfLinNonExist"## :: CString++gu_exn_type_PgfExn = Ptr "PgfExn"## :: CString++gu_exn_type_PgfParseError = Ptr "PgfParseError"## :: CString++gu_exn_type_PgfTypeError = Ptr "PgfTypeError"## :: CString++foreign import ccall unsafe "gu/string.h gu_string_in"+ gu_string_in :: CString -> Ptr GuPool -> IO (Ptr GuIn)++foreign import ccall unsafe "gu/string.h gu_new_string_buf"+ gu_new_string_buf :: Ptr GuPool -> IO (Ptr GuStringBuf)++foreign import ccall unsafe "gu/string.h gu_string_buf_out"+ gu_string_buf_out :: Ptr GuStringBuf -> IO (Ptr GuOut)++foreign import ccall unsafe "gu/file.h gu_file_in"+ gu_file_in :: Ptr () -> Ptr GuPool -> IO (Ptr GuIn)++foreign import ccall unsafe "gu/enum.h gu_enum_next"+ gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO ()+ +foreign import ccall unsafe "gu/string.h gu_string_buf_freeze"+ gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString++foreign import ccall unsafe "gu/utf8.h gu_utf8_decode"+ gu_utf8_decode :: Ptr CString -> IO GuUCS++foreign import ccall unsafe "gu/utf8.h gu_utf8_encode"+ gu_utf8_encode :: GuUCS -> Ptr CString -> IO ()++foreign import ccall unsafe "gu/seq.h gu_make_seq"+ gu_make_seq :: CSizeT -> CSizeT -> Ptr GuPool -> IO (Ptr GuSeq)++foreign import ccall unsafe "gu/seq.h gu_make_buf"+ gu_make_buf :: CSizeT -> Ptr GuPool -> IO (Ptr GuBuf)++foreign import ccall unsafe "gu/map.h gu_make_map"+ gu_make_map :: CSizeT -> Ptr GuHasher -> CSizeT -> Ptr a -> CSizeT -> Ptr GuPool -> IO (Ptr GuMap)++foreign import ccall unsafe "gu/map.h gu_map_insert"+ gu_map_insert :: Ptr GuMap -> Ptr a -> IO (Ptr b)++foreign import ccall unsafe "gu/map.h gu_map_find_default"+ gu_map_find_default :: Ptr GuMap -> Ptr a -> IO (Ptr b)++foreign import ccall "gu/map.h gu_map_iter"+ gu_map_iter :: Ptr GuMap -> Ptr GuMapItor -> Ptr GuExn -> IO ()++foreign import ccall unsafe "gu/hash.h &gu_int_hasher"+ gu_int_hasher :: Ptr GuHasher++foreign import ccall unsafe "gu/hash.h &gu_addr_hasher"+ gu_addr_hasher :: Ptr GuHasher++foreign import ccall unsafe "gu/hash.h &gu_string_hasher"+ gu_string_hasher :: Ptr GuHasher++foreign import ccall unsafe "gu/hash.h &gu_null_struct"+ gu_null_struct :: Ptr a++foreign import ccall unsafe "gu/variant.h gu_variant_tag"+ gu_variant_tag :: GuVariant -> IO CInt++foreign import ccall unsafe "gu/variant.h gu_variant_data"+ gu_variant_data :: GuVariant -> IO (Ptr a)++foreign import ccall unsafe "gu/variant.h gu_alloc_variant"+ gu_alloc_variant :: CUInt8 -> CSizeT -> CSizeT -> Ptr GuVariant -> Ptr GuPool -> IO (Ptr a)+++withGuPool :: (Ptr GuPool -> IO a) -> IO a+withGuPool f = bracket gu_new_pool gu_pool_free f++newOut :: Ptr GuPool -> IO (Ptr GuStringBuf, Ptr GuOut)+newOut pool =+ do sb <- gu_new_string_buf pool+ out <- gu_string_buf_out sb+ return (sb,out)++peekUtf8CString :: CString -> IO String+peekUtf8CString ptr =+ alloca $ \pptr ->+ poke pptr ptr >> decode pptr+ where+ decode pptr = do+ x <- gu_utf8_decode pptr+ if x == 0+ then return []+ else do cs <- decode pptr+ return (((toEnum . fromEnum) x) : cs)++peekUtf8CStringLen :: CString -> CInt -> IO String+peekUtf8CStringLen ptr len =+ alloca $ \pptr ->+ poke pptr ptr >> decode pptr (ptr `plusPtr` fromIntegral len)+ where+ decode pptr end = do+ ptr <- peek pptr+ if ptr >= end+ then return []+ else do x <- gu_utf8_decode pptr+ cs <- decode pptr end+ return (((toEnum . fromEnum) x) : cs)++pokeUtf8CString :: String -> CString -> IO ()+pokeUtf8CString s ptr =+ alloca $ \pptr ->+ poke pptr ptr >> encode s pptr+ where+ encode [] pptr = do+ gu_utf8_encode 0 pptr+ encode (c:cs) pptr = do+ gu_utf8_encode ((toEnum . fromEnum) c) pptr+ encode cs pptr++newUtf8CString :: String -> Ptr GuPool -> IO CString+newUtf8CString s pool = do+ ptr <- gu_malloc pool (fromIntegral (utf8Length s))+ pokeUtf8CString s ptr+ return ptr++utf8Length s = count 0 s+ where+ count !c [] = c+1+ count !c (x:xs)+ | ucs < 0x80 = count (c+1) xs+ | ucs < 0x800 = count (c+2) xs+ | ucs < 0x10000 = count (c+3) xs+ | ucs < 0x200000 = count (c+4) xs+ | ucs < 0x4000000 = count (c+5) xs+ | otherwise = count (c+6) xs+ where+ ucs = fromEnum x++peekSequence peekElem size ptr = do+ c_len <- (#peek GuSeq, len) ptr+ peekElems (c_len :: CSizeT) (ptr `plusPtr` (#offset GuSeq, data))+ where+ peekElems 0 ptr = return []+ peekElems len ptr = do+ e <- peekElem ptr+ es <- peekElems (len-1) (ptr `plusPtr` size)+ return (e:es)++newSequence :: CSizeT -> (Ptr a -> v -> IO ()) -> [v] -> Ptr GuPool -> IO (Ptr GuSeq)+newSequence elem_size pokeElem values pool = do+ c_seq <- gu_make_seq elem_size (fromIntegral (length values)) pool+ pokeElems (c_seq `plusPtr` (#offset GuSeq, data)) values+ return c_seq+ where+ pokeElems ptr [] = return ()+ pokeElems ptr (x:xs) = do+ pokeElem ptr x+ pokeElems (ptr `plusPtr` (fromIntegral elem_size)) xs++------------------------------------------------------------------+-- libpgf API++data PgfPGF+data PgfApplication+data PgfConcr+type PgfExpr = Ptr ()+data PgfExprProb+data PgfExprParser+data PgfFullFormEntry+data PgfMorphoCallback+data PgfPrintContext+type PgfType = Ptr ()+data PgfCallbacksMap+data PgfOracleCallback+data PgfCncTree+data PgfLinFuncs+data PgfGraphvizOptions+type PgfBindType = (#type PgfBindType)+data PgfAbsFun+data PgfAbsCat+data PgfCCat+data PgfCncFun+data PgfProductionApply++foreign import ccall "pgf/pgf.h pgf_read"+ pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF)++foreign import ccall "pgf/pgf.h pgf_write"+ pgf_write :: Ptr PgfPGF -> CString -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_abstract_name"+ pgf_abstract_name :: Ptr PgfPGF -> IO CString++foreign import ccall "pgf/pgf.h pgf_iter_languages"+ pgf_iter_languages :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_get_language"+ pgf_get_language :: Ptr PgfPGF -> CString -> IO (Ptr PgfConcr)++foreign import ccall "pgf/pgf.h pgf_concrete_name"+ pgf_concrete_name :: Ptr PgfConcr -> IO CString++foreign import ccall "pgf/pgf.h pgf_concrete_load"+ pgf_concrete_load :: Ptr PgfConcr -> Ptr GuIn -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_concrete_unload"+ pgf_concrete_unload :: Ptr PgfConcr -> IO ()++foreign import ccall "pgf/pgf.h pgf_language_code"+ pgf_language_code :: Ptr PgfConcr -> IO CString++foreign import ccall "pgf/pgf.h pgf_iter_categories"+ pgf_iter_categories :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_start_cat"+ pgf_start_cat :: Ptr PgfPGF -> Ptr GuPool -> IO PgfType++foreign import ccall "pgf/pgf.h pgf_category_context"+ pgf_category_context :: Ptr PgfPGF -> CString -> IO (Ptr GuSeq)++foreign import ccall "pgf/pgf.h pgf_category_prob"+ pgf_category_prob :: Ptr PgfPGF -> CString -> IO (#type prob_t)++foreign import ccall "pgf/pgf.h pgf_iter_functions"+ pgf_iter_functions :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_iter_functions_by_cat"+ pgf_iter_functions_by_cat :: Ptr PgfPGF -> CString -> Ptr GuMapItor -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_function_type"+ pgf_function_type :: Ptr PgfPGF -> CString -> IO PgfType++foreign import ccall "pgf/expr.h pgf_function_is_constructor"+ pgf_function_is_constructor :: Ptr PgfPGF -> CString -> IO (#type bool)++foreign import ccall "pgf/pgf.h pgf_print_name"+ pgf_print_name :: Ptr PgfConcr -> CString -> IO CString++foreign import ccall "pgf/pgf.h pgf_has_linearization"+ pgf_has_linearization :: Ptr PgfConcr -> CString -> IO CInt++foreign import ccall "pgf/pgf.h pgf_linearize"+ pgf_linearize :: Ptr PgfConcr -> PgfExpr -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_lzr_concretize"+ pgf_lzr_concretize :: Ptr PgfConcr -> PgfExpr -> Ptr GuExn -> Ptr GuPool -> IO (Ptr GuEnum)++foreign import ccall "pgf/pgf.h pgf_lzr_wrap_linref"+ pgf_lzr_wrap_linref :: Ptr PgfCncTree -> Ptr GuPool -> IO (Ptr PgfCncTree)++foreign import ccall "pgf/pgf.h pgf_lzr_linearize_simple"+ pgf_lzr_linearize_simple :: Ptr PgfConcr -> Ptr PgfCncTree -> CSizeT -> Ptr GuOut -> Ptr GuExn -> Ptr GuPool -> IO ()++foreign import ccall "pgf/pgf.h pgf_lzr_linearize"+ pgf_lzr_linearize :: Ptr PgfConcr -> Ptr PgfCncTree -> CSizeT -> Ptr (Ptr PgfLinFuncs) -> Ptr GuPool -> IO ()++foreign import ccall "pgf/pgf.h pgf_lzr_get_table"+ pgf_lzr_get_table :: Ptr PgfConcr -> Ptr PgfCncTree -> Ptr CSizeT -> Ptr (Ptr CString) -> IO ()++type SymbolTokenCallback = Ptr (Ptr PgfLinFuncs) -> CString -> IO ()+type PhraseCallback = Ptr (Ptr PgfLinFuncs) -> CString -> CInt -> CSizeT -> CString -> IO ()+type NonExistCallback = Ptr (Ptr PgfLinFuncs) -> IO ()+type BindCallback = Ptr (Ptr PgfLinFuncs) -> IO ()+type MetaCallback = Ptr (Ptr PgfLinFuncs) -> CInt -> IO ()++foreign import ccall "wrapper"+ wrapSymbolTokenCallback :: SymbolTokenCallback -> IO (FunPtr SymbolTokenCallback)++foreign import ccall "wrapper"+ wrapPhraseCallback :: PhraseCallback -> IO (FunPtr PhraseCallback)++foreign import ccall "wrapper"+ wrapSymbolNonExistCallback :: NonExistCallback -> IO (FunPtr NonExistCallback)++foreign import ccall "wrapper"+ wrapSymbolBindCallback :: BindCallback -> IO (FunPtr BindCallback)++foreign import ccall "wrapper"+ wrapSymbolMetaCallback :: MetaCallback -> IO (FunPtr MetaCallback)++foreign import ccall "pgf/pgf.h pgf_align_words"+ pgf_align_words :: Ptr PgfConcr -> PgfExpr -> Ptr GuExn -> Ptr GuPool -> IO (Ptr GuSeq)++foreign import ccall "pgf/pgf.h pgf_parse_with_heuristics"+ pgf_parse_with_heuristics :: Ptr PgfConcr -> PgfType -> CString -> Double -> Ptr PgfCallbacksMap -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)++foreign import ccall "pgf/pgf.h pgf_lookup_sentence"+ pgf_lookup_sentence :: Ptr PgfConcr -> PgfType -> CString -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)++type LiteralMatchCallback = CSizeT -> Ptr CSizeT -> Ptr GuPool -> IO (Ptr PgfExprProb)++foreign import ccall "wrapper"+ wrapLiteralMatchCallback :: LiteralMatchCallback -> IO (FunPtr LiteralMatchCallback)++type LiteralPredictCallback = CSizeT -> CString -> Ptr GuPool -> IO (Ptr PgfExprProb)++foreign import ccall "wrapper"+ wrapLiteralPredictCallback :: LiteralPredictCallback -> IO (FunPtr LiteralPredictCallback)++foreign import ccall "pgf/pgf.h pgf_new_callbacks_map"+ pgf_new_callbacks_map :: Ptr PgfConcr -> Ptr GuPool -> IO (Ptr PgfCallbacksMap)++foreign import ccall+ hspgf_callbacks_map_add_literal :: Ptr PgfConcr -> Ptr PgfCallbacksMap -> CString -> FunPtr LiteralMatchCallback -> FunPtr LiteralPredictCallback -> Ptr GuPool -> IO ()++type OracleCallback = CString -> CString -> CSizeT -> IO Bool+type OracleLiteralCallback = CString -> CString -> Ptr CSizeT -> Ptr GuPool -> IO (Ptr PgfExprProb)++foreign import ccall "wrapper"+ wrapOracleCallback :: OracleCallback -> IO (FunPtr OracleCallback)++foreign import ccall "wrapper"+ wrapOracleLiteralCallback :: OracleLiteralCallback -> IO (FunPtr OracleLiteralCallback)++foreign import ccall+ hspgf_new_oracle_callback :: CString -> FunPtr OracleCallback -> FunPtr OracleCallback -> FunPtr OracleLiteralCallback -> Ptr GuPool -> IO (Ptr PgfOracleCallback)++foreign import ccall "pgf/pgf.h pgf_parse_with_oracle"+ pgf_parse_with_oracle :: Ptr PgfConcr -> CString -> CString -> Ptr PgfOracleCallback -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)++foreign import ccall "pgf/pgf.h pgf_lookup_morpho"+ pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()++type LookupMorphoCallback = Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO ()++foreign import ccall "wrapper"+ wrapLookupMorphoCallback :: LookupMorphoCallback -> IO (FunPtr LookupMorphoCallback)++type MapItorCallback = Ptr GuMapItor -> Ptr () -> Ptr () -> Ptr GuExn -> IO ()++foreign import ccall "wrapper"+ wrapMapItorCallback :: MapItorCallback -> IO (FunPtr MapItorCallback)++foreign import ccall "pgf/pgf.h pgf_fullform_lexicon"+ pgf_fullform_lexicon :: Ptr PgfConcr -> Ptr GuPool -> IO (Ptr GuEnum)++foreign import ccall "pgf/pgf.h pgf_fullform_get_string"+ pgf_fullform_get_string :: Ptr PgfFullFormEntry -> IO CString++foreign import ccall "pgf/pgf.h pgf_fullform_get_analyses"+ pgf_fullform_get_analyses :: Ptr PgfFullFormEntry -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_expr_apply"+ pgf_expr_apply :: Ptr PgfApplication -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/pgf.h pgf_expr_unapply"+ pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)++foreign import ccall "pgf/pgf.h pgf_expr_abs"+ pgf_expr_abs :: PgfBindType -> CString -> PgfExpr -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/pgf.h pgf_expr_unabs"+ pgf_expr_unabs :: PgfExpr -> IO (Ptr a)++foreign import ccall "pgf/pgf.h pgf_expr_meta"+ pgf_expr_meta :: CInt -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/pgf.h pgf_expr_unmeta"+ pgf_expr_unmeta :: PgfExpr -> IO (Ptr a)++foreign import ccall "pgf/pgf.h pgf_expr_string"+ pgf_expr_string :: CString -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/pgf.h pgf_expr_int"+ pgf_expr_int :: CInt -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/pgf.h pgf_expr_float"+ pgf_expr_float :: CDouble -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/pgf.h pgf_expr_unlit"+ pgf_expr_unlit :: PgfExpr -> CInt -> IO (Ptr a)++foreign import ccall "pgf/expr.h pgf_expr_arity"+ pgf_expr_arity :: PgfExpr -> IO CInt++foreign import ccall "pgf/expr.h pgf_expr_eq"+ pgf_expr_eq :: PgfExpr -> PgfExpr -> IO CInt++foreign import ccall "pgf/expr.h pgf_expr_hash"+ pgf_expr_hash :: GuHash -> PgfExpr -> IO GuHash++foreign import ccall "pgf/expr.h pgf_expr_size"+ pgf_expr_size :: PgfExpr -> IO CInt++foreign import ccall "pgf/expr.h pgf_expr_functions"+ pgf_expr_functions :: PgfExpr -> Ptr GuPool -> IO (Ptr GuSeq)++foreign import ccall "pgf/expr.h pgf_expr_substitute"+ pgf_expr_substitute :: PgfExpr -> Ptr GuSeq -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/expr.h pgf_compute_tree_probability"+ pgf_compute_tree_probability :: Ptr PgfPGF -> PgfExpr -> IO CFloat++foreign import ccall "pgf/expr.h pgf_check_expr"+ pgf_check_expr :: Ptr PgfPGF -> Ptr PgfExpr -> PgfType -> Ptr GuExn -> Ptr GuPool -> IO ()++foreign import ccall "pgf/expr.h pgf_infer_expr"+ pgf_infer_expr :: Ptr PgfPGF -> Ptr PgfExpr -> Ptr GuExn -> Ptr GuPool -> IO PgfType++foreign import ccall "pgf/expr.h pgf_check_type"+ pgf_check_type :: Ptr PgfPGF -> Ptr PgfType -> Ptr GuExn -> Ptr GuPool -> IO ()++foreign import ccall "pgf/expr.h pgf_compute"+ pgf_compute :: Ptr PgfPGF -> PgfExpr -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO PgfExpr++foreign import ccall "pgf/expr.h pgf_print_expr"+ pgf_print_expr :: PgfExpr -> Ptr PgfPrintContext -> CInt -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/expr.h pgf_print_expr_tuple"+ pgf_print_expr_tuple :: CSizeT -> Ptr PgfExpr -> Ptr PgfPrintContext -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/expr.h pgf_print_type"+ pgf_print_type :: PgfType -> Ptr PgfPrintContext -> CInt -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/expr.h pgf_print_context"+ pgf_print_context :: Ptr GuSeq -> Ptr PgfPrintContext -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/pgf.h pgf_generate_all"+ pgf_generate_all :: Ptr PgfPGF -> PgfType -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)++foreign import ccall "pgf/pgf.h pgf_print"+ pgf_print :: Ptr PgfPGF -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/expr.h pgf_read_expr"+ pgf_read_expr :: Ptr GuIn -> Ptr GuPool -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr++foreign import ccall "pgf/expr.h pgf_read_expr_tuple"+ pgf_read_expr_tuple :: Ptr GuIn -> CSizeT -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt++foreign import ccall "pgf/expr.h pgf_read_expr_matrix"+ pgf_read_expr_matrix :: Ptr GuIn -> CSizeT -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuSeq)++foreign import ccall "pgf/expr.h pgf_read_type"+ pgf_read_type :: Ptr GuIn -> Ptr GuPool -> Ptr GuPool -> Ptr GuExn -> IO PgfType++foreign import ccall "pgf/graphviz.h pgf_graphviz_abstract_tree"+ pgf_graphviz_abstract_tree :: Ptr PgfPGF -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/graphviz.h pgf_graphviz_parse_tree"+ pgf_graphviz_parse_tree :: Ptr PgfConcr -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/graphviz.h pgf_graphviz_word_alignment"+ pgf_graphviz_word_alignment :: Ptr (Ptr PgfConcr) -> CSizeT -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO ()++foreign import ccall "pgf/data.h pgf_parser_index"+ pgf_parser_index :: Ptr PgfConcr -> Ptr PgfCCat -> GuVariant -> (#type bool) -> Ptr GuPool -> IO ()++foreign import ccall "pgf/data.h pgf_lzr_index"+ pgf_lzr_index :: Ptr PgfConcr -> Ptr PgfCCat -> GuVariant -> (#type bool) -> Ptr GuPool -> IO ()++foreign import ccall "pgf/data.h pgf_production_is_lexical"+ pgf_production_is_lexical :: Ptr PgfProductionApply -> Ptr GuBuf -> Ptr GuPool -> IO (#type bool)
@@ -0,0 +1,935 @@+{-# LANGUAGE ImplicitParams, RankNTypes #-}++module PGF2.Internal(-- * Access the internal structures+ FId,isPredefFId,+ FunId,Token,Production(..),PArg(..),Symbol(..),Literal(..),+ globalFlags, abstrFlags, concrFlags,+ concrTotalCats, concrCategories, concrProductions,+ concrTotalFuns, concrFunction,+ concrTotalSeqs, concrSequence,+ + -- * Building new PGFs in memory+ build, eAbs, eApp, eMeta, eFun, eVar, eTyped, eImplArg, dTyp, hypo,+ AbstrInfo, newAbstr, ConcrInfo, newConcr, newPGF,+ + -- * Expose PGF and Concr for FFI with C+ PGF(..), Concr(..),+ + -- * Write an in-memory PGF to a file+ writePGF+ ) where++#include <pgf/data.h>++import PGF2+import PGF2.FFI+import PGF2.Expr+import PGF2.Type+import System.IO.Unsafe(unsafePerformIO)+import Foreign+import Foreign.C+import Data.IORef+import Data.Maybe(fromMaybe)+import Data.List(sortBy)+import Control.Exception(Exception,throwIO)+import Control.Monad(foldM)+import qualified Data.Map as Map++type Token = String+data Symbol+ = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex+ | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex+ | SymVar {-# UNPACK #-} !Int {-# UNPACK #-} !Int+ | SymKS Token+ | SymKP [Symbol] [([Symbol],[String])]+ | SymBIND -- the special BIND token+ | SymNE -- non exist+ | SymSOFT_BIND -- the special SOFT_BIND token+ | SymSOFT_SPACE -- the special SOFT_SPACE token+ | SymCAPIT -- the special CAPIT token+ | SymALL_CAPIT -- the special ALL_CAPIT token+ deriving (Eq,Ord,Show)+data Production+ = PApply {-# UNPACK #-} !FunId [PArg]+ | PCoerce {-# UNPACK #-} !FId+ deriving (Eq,Ord,Show)+data PArg = PArg [FId] {-# UNPACK #-} !FId deriving (Eq,Ord,Show)+type FunId = Int+type SeqId = Int+data Literal =+ LStr String -- ^ a string constant+ | LInt Int -- ^ an integer constant+ | LFlt Double -- ^ a floating point constant+ deriving (Eq,Ord,Show)+++-----------------------------------------------------------------------+-- Access the internal structures+-----------------------------------------------------------------------++globalFlags :: PGF -> [(String,Literal)]+globalFlags p = unsafePerformIO $ do+ c_flags <- (#peek PgfPGF, gflags) (pgf p)+ flags <- peekFlags c_flags+ touchPGF p+ return flags++abstrFlags :: PGF -> [(String,Literal)]+abstrFlags p = unsafePerformIO $ do+ c_flags <- (#peek PgfPGF, abstract.aflags) (pgf p)+ flags <- peekFlags c_flags+ touchPGF p+ return flags++concrFlags :: Concr -> [(String,Literal)]+concrFlags c = unsafePerformIO $ do+ c_flags <- (#peek PgfConcr, cflags) (concr c)+ flags <- peekFlags c_flags+ touchConcr c+ return flags++peekFlags :: Ptr GuSeq -> IO [(String,Literal)]+peekFlags c_flags = do+ c_len <- (#peek GuSeq, len) c_flags+ peekFlags (c_len :: CInt) (c_flags `plusPtr` (#offset GuSeq, data))+ where+ peekFlags 0 ptr = return []+ peekFlags c_len ptr = do+ name <- (#peek PgfFlag, name) ptr >>= peekUtf8CString+ value <- (#peek PgfFlag, value) ptr >>= peekLiteral+ flags <- peekFlags (c_len-1) (ptr `plusPtr` (#size PgfFlag))+ return ((name,value):flags)++peekLiteral :: GuVariant -> IO Literal+peekLiteral p = do+ tag <- gu_variant_tag p+ ptr <- gu_variant_data p+ case tag of+ (#const PGF_LITERAL_STR) -> do { val <- peekUtf8CString (ptr `plusPtr` (#offset PgfLiteralStr, val));+ return (LStr val) }+ (#const PGF_LITERAL_INT) -> do { val <- peek (ptr `plusPtr` (#offset PgfLiteralInt, val));+ return (LInt (fromIntegral (val :: CInt))) }+ (#const PGF_LITERAL_FLT) -> do { val <- peek (ptr `plusPtr` (#offset PgfLiteralFlt, val));+ return (LFlt (realToFrac (val :: CDouble))) }+ _ -> error "Unknown literal type in the grammar"++concrTotalCats :: Concr -> FId+concrTotalCats c = unsafePerformIO $ do+ c_total_cats <- (#peek PgfConcr, total_cats) (concr c)+ touchConcr c+ return (fromIntegral (c_total_cats :: CInt))++concrCategories :: Concr -> [(Cat,FId,FId,[String])]+concrCategories c = + unsafePerformIO $+ withGuPool $ \tmpPl ->+ allocaBytes (#size GuMapItor) $ \itor -> do+ exn <- gu_new_exn tmpPl+ ref <- newIORef []+ fptr <- wrapMapItorCallback (getCategories ref)+ (#poke GuMapItor, fn) itor fptr+ c_cnccats <- (#peek PgfConcr, cnccats) (concr c)+ gu_map_iter c_cnccats itor exn+ touchConcr c+ freeHaskellFunPtr fptr+ cs <- readIORef ref+ return (reverse cs)+ where+ getCategories ref itor key value exn = do+ names <- readIORef ref+ name <- peekUtf8CString (castPtr key)+ c_cnccat <- peek (castPtr value)+ c_cats <- (#peek PgfCncCat, cats) c_cnccat+ c_len <- (#peek GuSeq, len) c_cats+ first <- peek (c_cats `plusPtr` (#offset GuSeq, data)) >>= peekFId+ last <- peek (c_cats `plusPtr` ((#offset GuSeq, data) + (fromIntegral (c_len-1::CSizeT))*(#size PgfCCat*))) >>= peekFId+ c_n_lins <- (#peek PgfCncCat, n_lins) c_cnccat+ arr <- peekArray (fromIntegral (c_n_lins :: CSizeT)) (c_cnccat `plusPtr` (#offset PgfCncCat, labels))+ labels <- mapM peekUtf8CString arr+ writeIORef ref ((name,first,last,labels) : names)++concrProductions :: Concr -> FId -> [Production]+concrProductions c fid = unsafePerformIO $ do+ c_ccats <- (#peek PgfConcr, ccats) (concr c)+ res <- alloca $ \pfid -> do+ poke pfid (fromIntegral fid :: CInt)+ gu_map_find_default c_ccats pfid >>= peek+ if res == nullPtr+ then do touchConcr c+ return []+ else do c_prods <- (#peek PgfCCat, prods) res+ if c_prods == nullPtr+ then do touchConcr c+ return []+ else do res <- peekSequence (deRef peekProduction) (#size GuVariant) c_prods+ touchConcr c+ return res+ where+ peekProduction p = do+ tag <- gu_variant_tag p+ dt <- gu_variant_data p+ case tag of+ (#const PGF_PRODUCTION_APPLY) -> do { c_cncfun <- (#peek PgfProductionApply, fun) dt ;+ c_funid <- (#peek PgfCncFun, funid) c_cncfun ;+ c_args <- (#peek PgfProductionApply, args) dt ;+ pargs <- peekSequence peekPArg (#size PgfPArg) c_args ;+ return (PApply (fromIntegral (c_funid :: CInt)) pargs) }+ (#const PGF_PRODUCTION_COERCE)-> do { c_coerce <- (#peek PgfProductionCoerce, coerce) dt ;+ fid <- peekFId c_coerce ;+ return (PCoerce fid) }+ _ -> error "Unknown production type in the grammar"+ where+ peekPArg ptr = do+ c_hypos <- (#peek PgfPArg, hypos) ptr+ hypos <- peekSequence (deRef peekFId) (#size int) c_hypos+ c_ccat <- (#peek PgfPArg, ccat) ptr+ fid <- peekFId c_ccat+ return (PArg hypos fid)++peekFId c_ccat = do+ c_fid <- (#peek PgfCCat, fid) c_ccat+ return (fromIntegral (c_fid :: CInt))++concrTotalFuns :: Concr -> FunId+concrTotalFuns c = unsafePerformIO $ do+ c_cncfuns <- (#peek PgfConcr, cncfuns) (concr c)+ c_len <- (#peek GuSeq, len) c_cncfuns+ touchConcr c+ return (fromIntegral (c_len :: CSizeT))++concrFunction :: Concr -> FunId -> (Fun,[SeqId])+concrFunction c funid = unsafePerformIO $ do+ c_cncfuns <- (#peek PgfConcr, cncfuns) (concr c)+ c_cncfun <- peek (c_cncfuns `plusPtr` ((#offset GuSeq, data)+funid*(#size PgfCncFun*)))+ c_absfun <- (#peek PgfCncFun, absfun) c_cncfun+ c_name <- (#peek PgfAbsFun, name) c_absfun+ name <- peekUtf8CString c_name+ c_n_lins <- (#peek PgfCncFun, n_lins) c_cncfun+ arr <- peekArray (fromIntegral (c_n_lins :: CSizeT)) (c_cncfun `plusPtr` (#offset PgfCncFun, lins))+ seqs_seq <- (#peek PgfConcr, sequences) (concr c)+ touchConcr c+ let seqs = seqs_seq `plusPtr` (#offset GuSeq, data)+ return (name, map (toSeqId seqs) arr)+ where+ toSeqId seqs seq = minusPtr seq seqs `div` (#size PgfSequence)++concrTotalSeqs :: Concr -> SeqId+concrTotalSeqs c = unsafePerformIO $ do+ seq <- (#peek PgfConcr, sequences) (concr c)+ c_len <- (#peek GuSeq, len) seq+ touchConcr c+ return (fromIntegral (c_len :: CSizeT))++concrSequence :: Concr -> SeqId -> [Symbol]+concrSequence c seqid = unsafePerformIO $ do+ c_sequences <- (#peek PgfConcr, sequences) (concr c)+ let c_sequence = c_sequences `plusPtr` ((#offset GuSeq, data)+seqid*(#size PgfSequence))+ c_syms <- (#peek PgfSequence, syms) c_sequence+ res <- peekSequence (deRef peekSymbol) (#size GuVariant) c_syms+ touchConcr c+ return res+ where+ peekSymbol p = do+ tag <- gu_variant_tag p+ dt <- gu_variant_data p+ case tag of+ (#const PGF_SYMBOL_CAT) -> peekSymbolIdx SymCat dt+ (#const PGF_SYMBOL_LIT) -> peekSymbolIdx SymLit dt+ (#const PGF_SYMBOL_VAR) -> peekSymbolIdx SymVar dt+ (#const PGF_SYMBOL_KS) -> peekSymbolKS dt+ (#const PGF_SYMBOL_KP) -> peekSymbolKP dt+ (#const PGF_SYMBOL_BIND) -> return SymBIND+ (#const PGF_SYMBOL_SOFT_BIND) -> return SymSOFT_BIND+ (#const PGF_SYMBOL_NE) -> return SymNE+ (#const PGF_SYMBOL_SOFT_SPACE) -> return SymSOFT_SPACE+ (#const PGF_SYMBOL_CAPIT) -> return SymCAPIT+ (#const PGF_SYMBOL_ALL_CAPIT) -> return SymALL_CAPIT+ _ -> error "Unknown symbol type in the grammar"++ peekSymbolIdx constr dt = do+ c_d <- (#peek PgfSymbolIdx, d) dt+ c_r <- (#peek PgfSymbolIdx, r) dt+ return (constr (fromIntegral (c_d :: CInt)) (fromIntegral (c_r :: CInt)))++ peekSymbolKS dt = do+ token <- peekUtf8CString (dt `plusPtr` (#offset PgfSymbolKS, token))+ return (SymKS token)++ peekSymbolKP dt = do+ c_default_form <- (#peek PgfSymbolKP, default_form) dt+ default_form <- peekSequence (deRef peekSymbol) (#size GuVariant) c_default_form+ c_n_forms <- (#peek PgfSymbolKP, n_forms) dt+ forms <- peekForms (c_n_forms :: CSizeT) (dt `plusPtr` (#offset PgfSymbolKP, forms))+ return (SymKP default_form forms)++ peekForms 0 ptr = return []+ peekForms len ptr = do+ c_form <- (#peek PgfAlternative, form) ptr+ form <- peekSequence (deRef peekSymbol) (#size GuVariant) c_form+ c_prefixes <- (#peek PgfAlternative, prefixes) ptr+ prefixes <- peekSequence (deRef peekUtf8CString) (#size GuString*) c_prefixes+ forms <- peekForms (len-1) (ptr `plusPtr` (#size PgfAlternative))+ return ((form,prefixes):forms)++deRef peekValue ptr = peek ptr >>= peekValue++fidString, fidInt, fidFloat, fidVar, fidStart :: FId+fidString = (-1)+fidInt = (-2)+fidFloat = (-3)+fidVar = (-4)+fidStart = (-5)++isPredefFId :: FId -> Bool+isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])+++-----------------------------------------------------------------------+-- Building new PGFs in memory+-----------------------------------------------------------------------++data Builder s = Builder (Ptr GuPool) Touch+newtype B s a = B a++build :: (forall s . (?builder :: Builder s) => B s a) -> a+build f =+ unsafePerformIO $ do+ pool <- gu_new_pool+ poolFPtr <- newForeignPtr gu_pool_finalizer pool+ let ?builder = Builder pool (touchForeignPtr poolFPtr)+ let B res = f+ return res++eAbs :: (?builder :: Builder s) => BindType -> String -> B s Expr -> B s Expr+eAbs bind_type var (B (Expr body _)) =+ unsafePerformIO $+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_EXPR_ABS)+ (#size PgfExprAbs)+ (#const gu_alignof(PgfExprAbs))+ pptr pool+ cvar <- newUtf8CString var pool+ (#poke PgfExprAbs, bind_type) ptr (cbind_type :: PgfBindType)+ (#poke PgfExprAbs, id) ptr cvar+ (#poke PgfExprAbs, body) ptr body+ e <- peek pptr+ return (B (Expr e touch))+ where+ (Builder pool touch) = ?builder++ cbind_type =+ case bind_type of+ Explicit -> (#const PGF_BIND_TYPE_EXPLICIT)+ Implicit -> (#const PGF_BIND_TYPE_IMPLICIT)++eApp :: (?builder :: Builder s) => B s Expr -> B s Expr -> B s Expr+eApp (B (Expr fun _)) (B (Expr arg _)) =+ unsafePerformIO $+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_EXPR_APP)+ (#size PgfExprApp)+ (#const gu_alignof(PgfExprApp))+ pptr pool+ (#poke PgfExprApp, fun) ptr fun+ (#poke PgfExprApp, arg) ptr arg+ e <- peek pptr+ return (B (Expr e touch))+ where+ (Builder pool touch) = ?builder++eMeta :: (?builder :: Builder s) => Int -> B s Expr+eMeta id =+ unsafePerformIO $+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_EXPR_META)+ (fromIntegral (#size PgfExprMeta))+ (#const gu_alignof(PgfExprMeta))+ pptr pool+ (#poke PgfExprMeta, id) ptr (fromIntegral id :: CInt)+ e <- peek pptr+ return (B (Expr e touch))+ where+ (Builder pool touch) = ?builder++eFun :: (?builder :: Builder s) => Fun -> B s Expr+eFun fun =+ unsafePerformIO $+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_EXPR_FUN)+ (fromIntegral ((#size PgfExprFun)+utf8Length fun))+ (#const gu_flex_alignof(PgfExprFun))+ pptr pool+ pokeUtf8CString fun (ptr `plusPtr` (#offset PgfExprFun, fun))+ e <- peek pptr+ return (B (Expr e touch))+ where+ (Builder pool touch) = ?builder++eVar :: (?builder :: Builder s) => Int -> B s Expr+eVar var =+ unsafePerformIO $+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_EXPR_VAR)+ (#size PgfExprVar)+ (#const gu_alignof(PgfExprVar))+ pptr pool+ (#poke PgfExprVar, var) ptr (fromIntegral var :: CInt)+ e <- peek pptr+ return (B (Expr e touch))+ where+ (Builder pool touch) = ?builder++eTyped :: (?builder :: Builder s) => B s Expr -> B s Type -> B s Expr+eTyped (B (Expr e _)) (B (Type ty _)) =+ unsafePerformIO $+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_EXPR_TYPED)+ (#size PgfExprTyped)+ (#const gu_alignof(PgfExprTyped))+ pptr pool+ (#poke PgfExprTyped, expr) ptr e+ (#poke PgfExprTyped, type) ptr ty+ e <- peek pptr+ return (B (Expr e touch))+ where+ (Builder pool touch) = ?builder++eImplArg :: (?builder :: Builder s) => B s Expr -> B s Expr+eImplArg (B (Expr e _)) =+ unsafePerformIO $+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_EXPR_IMPL_ARG)+ (#size PgfExprImplArg)+ (#const gu_alignof(PgfExprImplArg))+ pptr pool+ (#poke PgfExprImplArg, expr) ptr e+ e <- peek pptr+ return (B (Expr e touch))+ where+ (Builder pool touch) = ?builder++hypo :: BindType -> CId -> B s Type -> (B s Hypo)+hypo bind_type var (B ty) = B (bind_type,var,ty)++dTyp :: (?builder :: Builder s) => [B s Hypo] -> Cat -> [B s Expr] -> B s Type+dTyp hypos cat es =+ unsafePerformIO $ do+ ptr <- gu_malloc_aligned pool + ((#size PgfType)+n_exprs*(#size GuVariant))+ (#const gu_flex_alignof(PgfType))+ c_hypos <- newHypos hypos pool+ c_cat <- newUtf8CString cat pool+ (#poke PgfType, hypos) ptr c_hypos+ (#poke PgfType, cid) ptr c_cat+ (#poke PgfType, n_exprs) ptr n_exprs+ pokeArray (ptr `plusPtr` (#offset PgfType, exprs)) [e | B (Expr e _) <- es]+ return (B (Type ptr touch))+ where+ (Builder pool touch) = ?builder+ n_exprs = fromIntegral (length es) :: CSizeT++newHypos :: [B s Hypo] -> Ptr GuPool -> IO (Ptr GuSeq)+newHypos hypos pool = do+ c_hypos <- gu_make_seq (#size PgfHypo) (fromIntegral (length hypos)) pool+ pokeHypos (c_hypos `plusPtr` (#offset GuSeq, data)) hypos+ return c_hypos+ where+ pokeHypos ptr [] = return ()+ pokeHypos ptr (B (bind_type,var,Type ty _):hypos) = do+ c_var <- newUtf8CString var pool+ (#poke PgfHypo, bind_type) ptr (cbind_type :: PgfBindType)+ (#poke PgfHypo, cid) ptr c_var+ (#poke PgfHypo, type) ptr ty+ pokeHypos (ptr `plusPtr` (#size PgfHypo)) hypos+ where+ cbind_type =+ case bind_type of+ Explicit -> (#const PGF_BIND_TYPE_EXPLICIT)+ Implicit -> (#const PGF_BIND_TYPE_IMPLICIT)+++data AbstrInfo = AbstrInfo (Ptr GuSeq) (Ptr GuSeq) (Map.Map String (Ptr PgfAbsCat)) (Ptr GuSeq) (Map.Map String (Ptr PgfAbsFun)) (Ptr PgfAbsFun) (Ptr GuBuf) Touch++newAbstr :: (?builder :: Builder s) => [(String,Literal)] ->+ [(Cat,[B s Hypo],Float)] ->+ [(Fun,B s Type,Int,Float)] ->+ AbstrInfo+newAbstr aflags cats funs = unsafePerformIO $ do+ c_aflags <- newFlags aflags pool+ (c_cats,abscats) <- newAbsCats (sortByFst3 cats) pool+ (c_funs,absfuns) <- newAbsFuns (sortByFst4 funs) pool+ c_abs_lin_fun <- newAbsLinFun+ c_non_lexical_buf <- gu_make_buf (#size PgfProductionIdxEntry) pool+ return (AbstrInfo c_aflags c_cats abscats c_funs absfuns c_abs_lin_fun c_non_lexical_buf touch)+ where+ (Builder pool touch) = ?builder++ newAbsCats values pool = do+ c_seq <- gu_make_seq (#size PgfAbsCat) (fromIntegral (length values)) pool+ abscats <- pokeElems (c_seq `plusPtr` (#offset GuSeq, data)) Map.empty values+ return (c_seq,abscats)+ where+ pokeElems ptr abscats [] = return abscats+ pokeElems ptr abscats (x:xs) = do+ abscats <- pokeAbsCat ptr abscats x+ pokeElems (ptr `plusPtr` (#size PgfAbsCat)) abscats xs++ pokeAbsCat ptr abscats (name,hypos,prob) = do+ c_name <- newUtf8CString name pool+ c_hypos <- newHypos hypos pool+ (#poke PgfAbsCat, name) ptr c_name+ (#poke PgfAbsCat, context) ptr c_hypos+ (#poke PgfAbsCat, prob) ptr (realToFrac prob :: CFloat)+ return (Map.insert name ptr abscats)++ newAbsFuns values pool = do+ c_seq <- gu_make_seq (#size PgfAbsFun) (fromIntegral (length values)) pool+ absfuns <- pokeElems (c_seq `plusPtr` (#offset GuSeq, data)) Map.empty values+ return (c_seq,absfuns)+ where+ pokeElems ptr absfuns [] = return absfuns+ pokeElems ptr absfuns (x:xs) = do+ absfuns <- pokeAbsFun ptr absfuns x+ pokeElems (ptr `plusPtr` (#size PgfAbsFun)) absfuns xs++ pokeAbsFun ptr absfuns (name,B (Type c_ty _),arity,prob) = do+ pfun <- gu_alloc_variant (#const PGF_EXPR_FUN)+ (fromIntegral ((#size PgfExprFun)+utf8Length name))+ (#const gu_flex_alignof(PgfExprFun))+ (ptr `plusPtr` (#offset PgfAbsFun, ep.expr)) pool+ let c_name = (pfun `plusPtr` (#offset PgfExprFun, fun))+ pokeUtf8CString name c_name+ (#poke PgfAbsFun, name) ptr c_name+ (#poke PgfAbsFun, type) ptr c_ty+ (#poke PgfAbsFun, arity) ptr (fromIntegral arity :: CInt)+ (#poke PgfAbsFun, defns) ptr nullPtr+ (#poke PgfAbsFun, ep.prob) ptr (realToFrac prob :: CFloat)+ return (Map.insert name ptr absfuns)++ newAbsLinFun = do+ ptr <- gu_malloc_aligned pool+ (#size PgfAbsFun)+ (#const gu_alignof(PgfAbsFun))+ c_wild <- newUtf8CString "_" pool+ c_ty <- gu_malloc_aligned pool+ (#size PgfType)+ (#const gu_alignof(PgfType))+ (#poke PgfType, hypos) c_ty nullPtr+ (#poke PgfType, cid) c_ty c_wild+ (#poke PgfType, n_exprs) c_ty (0 :: CSizeT)+ (#poke PgfAbsFun, name) ptr c_wild+ (#poke PgfAbsFun, type) ptr c_ty+ (#poke PgfAbsFun, arity) ptr (0 :: CSizeT)+ (#poke PgfAbsFun, defns) ptr nullPtr+ (#poke PgfAbsFun, ep.prob) ptr (- log 0 :: CFloat)+ (#poke PgfAbsFun, ep.expr) ptr nullPtr+ return ptr+++data ConcrInfo = ConcrInfo (Ptr GuSeq) (Ptr GuMap) (Ptr GuMap) (Ptr GuSeq) (Ptr GuSeq) (Ptr GuMap) (Ptr PgfConcr -> Ptr GuPool -> IO ()) CInt++newConcr :: (?builder :: Builder s) => AbstrInfo ->+ [(String,Literal)] -> -- ^ Concrete syntax flags+ [(String,String)] -> -- ^ Printnames+ [(FId,[FunId])] -> -- ^ Lindefs+ [(FId,[FunId])] -> -- ^ Linrefs+ [(FId,[Production])] -> -- ^ Productions+ [(Fun,[SeqId])] -> -- ^ Concrete functions (must be sorted by Fun)+ [[Symbol]] -> -- ^ Sequences (must be sorted)+ [(Cat,FId,FId,[String])] -> -- ^ Concrete categories+ FId -> -- ^ The total count of the categories+ ConcrInfo+newConcr (AbstrInfo _ _ abscats _ absfuns c_abs_lin_fun c_non_lexical_buf _) cflags printnames lindefs linrefs prods cncfuns sequences cnccats total_cats = unsafePerformIO $ do+ c_cflags <- newFlags cflags pool+ c_printname <- newMap (#size GuString) gu_string_hasher newUtf8CString + (#size GuString) (pokeString pool)+ printnames pool+ c_seqs <- newSequence (#size PgfSequence) pokeSequence sequences pool+ let seqs_ptr = c_seqs `plusPtr` (#offset GuSeq, data)+ c_cncfuns <- newSequence (#size PgfCncFun*) (pokeCncFun seqs_ptr) (zip [0..] cncfuns) pool+ let funs_ptr = c_cncfuns `plusPtr` (#offset GuSeq, data)+ c_ccats <- gu_make_map (#size int) gu_int_hasher+ (#size PgfCCat*) gu_null_struct+ (#const GU_MAP_DEFAULT_INIT_SIZE)+ pool+ mapM_ (addLindefs c_ccats funs_ptr) lindefs+ mapM_ (addLinrefs c_ccats funs_ptr) linrefs+ mk_index <- foldM (addProductions c_ccats funs_ptr c_non_lexical_buf) (\concr pool -> return ()) prods+ c_cnccats <- newMap (#size GuString) gu_string_hasher newUtf8CString (#size PgfCncCat*) (pokeCncCat c_ccats) (map (\v@(k,_,_,_) -> (k,v)) cnccats) pool+ return (ConcrInfo c_cflags c_printname c_ccats c_cncfuns c_seqs c_cnccats mk_index (fromIntegral total_cats))+ where+ (Builder pool touch) = ?builder++ pokeCncFun seqs_ptr ptr cncfun = do+ c_cncfun <- newCncFun absfuns nullPtr cncfun pool+ poke ptr c_cncfun++ pokeSequence c_seq syms = do+ c_syms <- newSymbols syms pool+ (#poke PgfSequence, syms) c_seq c_syms+ (#poke PgfSequence, idx) c_seq nullPtr++ addLindefs c_ccats funs_ptr (fid,funids) = do+ c_ccat <- getCCat c_ccats fid pool+ c_funs <- newSequence (#size PgfCncFun*) (pokeRefDefFunId funs_ptr) funids pool+ (#poke PgfCCat, lindefs) c_ccat c_funs++ addLinrefs c_ccats funs_ptr (fid,funids) = do+ c_ccat <- getCCat c_ccats fid pool+ c_funs <- newSequence (#size PgfCncFun*) (pokeRefDefFunId funs_ptr) funids pool+ (#poke PgfCCat, linrefs) c_ccat c_funs++ addProductions c_ccats funs_ptr c_non_lexical_buf mk_index (fid,prods) = do+ c_ccat <- getCCat c_ccats fid pool+ let n_prods = length prods+ c_prods <- gu_make_seq (#size PgfProduction) (fromIntegral n_prods) pool+ (#poke PgfCCat, prods) c_ccat c_prods+ pokeProductions c_ccat (c_prods `plusPtr` (#offset GuSeq, data)) 0 (n_prods-1) mk_index prods+ where+ pokeProductions c_ccat ptr top bot mk_index [] = return mk_index+ pokeProductions c_ccat ptr top bot mk_index (prod:prods) = do+ (is_lexical,c_prod) <- newProduction c_ccats funs_ptr c_non_lexical_buf prod pool+ let mk_index' = \concr pool -> do pgf_parser_index concr c_ccat c_prod is_lexical pool+ pgf_lzr_index concr c_ccat c_prod is_lexical pool+ mk_index concr pool+ if is_lexical == 0+ then do poke (ptr `plusPtr` ((#size PgfProduction)*top)) c_prod+ pokeProductions c_ccat ptr (top+1) bot mk_index' prods+ else do poke (ptr `plusPtr` ((#size PgfProduction)*bot)) c_prod+ pokeProductions c_ccat ptr top (bot-1) mk_index' prods++ pokeRefDefFunId funs_ptr ptr funid = do+ let c_fun = funs_ptr `plusPtr` (funid * (#size PgfCncFun))+ (#poke PgfCncFun, absfun) c_fun c_abs_lin_fun+ poke ptr c_fun++ pokeCncCat c_ccats ptr (name,start,end,labels) = do+ let n_lins = fromIntegral (length labels) :: CSizeT+ c_cnccat <- gu_malloc_aligned pool + ((#size PgfCncCat)+n_lins*(#size GuString))+ (#const gu_flex_alignof(PgfCncCat))+ case Map.lookup name abscats of+ Just c_abscat -> (#poke PgfCncCat, abscat) c_cnccat c_abscat+ Nothing -> throwIO (PGFError ("The category "++name++" is not in the abstract syntax"))+ c_ccats <- newSequence (#size PgfCCat*) pokeFId [start..end] pool+ (#poke PgfCncCat, cats) c_cnccat c_ccats+ pokeLabels (c_cnccat `plusPtr` (#offset PgfCncCat, labels)) labels+ poke ptr c_cnccat+ where+ pokeFId ptr fid = do+ c_ccat <- getCCat c_ccats fid pool+ poke ptr c_ccat+ + pokeLabels ptr [] = return []+ pokeLabels ptr (l:ls) = do+ c_l <- newUtf8CString l pool+ poke ptr c_l+ pokeLabels (ptr `plusPtr` (#size GuString)) ls+++newPGF :: (?builder :: Builder s) => [(String,Literal)] ->+ AbsName ->+ AbstrInfo ->+ [(ConcName,ConcrInfo)] ->+ B s PGF+newPGF gflags absname (AbstrInfo c_aflags c_cats _ c_funs _ c_abs_lin_fun _ _) concrs =+ unsafePerformIO $ do+ ptr <- gu_malloc_aligned pool+ (#size PgfPGF)+ (#const gu_alignof(PgfPGF))+ c_gflags <- newFlags gflags pool+ c_absname <- newUtf8CString absname pool+ let c_abstr = ptr `plusPtr` (#offset PgfPGF, abstract)+ c_concrs <- newSequence (#size PgfConcr) (pokeConcr c_abstr) concrs pool+ (#poke PgfPGF, major_version) ptr (2 :: (#type uint16_t))+ (#poke PgfPGF, minor_version) ptr (0 :: (#type uint16_t))+ (#poke PgfPGF, gflags) ptr c_gflags+ (#poke PgfPGF, abstract.name) ptr c_absname+ (#poke PgfPGF, abstract.aflags) ptr c_aflags+ (#poke PgfPGF, abstract.funs) ptr c_funs+ (#poke PgfPGF, abstract.cats) ptr c_cats+ (#poke PgfPGF, abstract.abs_lin_fun) ptr c_abs_lin_fun+ (#poke PgfPGF, concretes) ptr c_concrs+ (#poke PgfPGF, pool) ptr pool+ return (B (PGF ptr touch))+ where+ (Builder pool touch) = ?builder++ pokeConcr c_abstr ptr (name, ConcrInfo c_cflags c_printnames c_ccats c_cncfuns c_seqs c_cnccats mk_index c_total_cats) = do+ c_name <- newUtf8CString name pool+ c_fun_indices <- gu_make_map (#size GuString) gu_string_hasher+ (#size PgfCncOverloadMap*) gu_null_struct+ (#const GU_MAP_DEFAULT_INIT_SIZE)+ pool+ c_coerce_idx <- gu_make_map (#size PgfCCat*) gu_addr_hasher+ (#size GuBuf*) gu_null_struct+ (#const GU_MAP_DEFAULT_INIT_SIZE)+ pool+ (#poke PgfConcr, name) ptr c_name+ (#poke PgfConcr, abstr) ptr c_abstr+ (#poke PgfConcr, cflags) ptr c_cflags+ (#poke PgfConcr, printnames) ptr c_printnames+ (#poke PgfConcr, ccats) ptr c_ccats+ (#poke PgfConcr, fun_indices) ptr c_fun_indices+ (#poke PgfConcr, coerce_idx) ptr c_coerce_idx+ (#poke PgfConcr, cncfuns) ptr c_cncfuns+ (#poke PgfConcr, sequences) ptr c_seqs+ (#poke PgfConcr, cnccats) ptr c_cnccats+ (#poke PgfConcr, total_cats) ptr c_total_cats+ (#poke PgfConcr, pool) ptr nullPtr+ mk_index ptr pool+++newFlags :: [(String,Literal)] -> Ptr GuPool -> IO (Ptr GuSeq)+newFlags flags pool = newSequence (#size PgfFlag) pokeFlag (sortByFst flags) pool+ where+ pokeFlag c_flag (name,value) = do+ c_name <- newUtf8CString name pool+ c_value <- newLiteral value pool+ (#poke PgfFlag, name) c_flag c_name+ (#poke PgfFlag, value) c_flag c_value+++newLiteral :: Literal -> Ptr GuPool -> IO GuVariant+newLiteral (LStr val) pool =+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_LITERAL_STR)+ (fromIntegral ((#size PgfLiteralStr)+utf8Length val))+ (#const gu_flex_alignof(PgfLiteralStr))+ pptr pool+ pokeUtf8CString val (ptr `plusPtr` (#offset PgfLiteralStr, val))+ peek pptr+newLiteral (LInt val) pool =+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_LITERAL_INT)+ (fromIntegral (#size PgfLiteralInt))+ (#const gu_alignof(PgfLiteralInt))+ pptr pool+ (#poke PgfLiteralInt, val) ptr (fromIntegral val :: CInt)+ peek pptr+newLiteral (LFlt val) pool =+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_LITERAL_FLT)+ (fromIntegral (#size PgfLiteralFlt))+ (#const gu_alignof(PgfLiteralFlt))+ pptr pool+ (#poke PgfLiteralFlt, val) ptr (realToFrac val :: CDouble)+ peek pptr+++newProduction :: Ptr GuMap -> Ptr PgfCncFun -> Ptr GuBuf -> Production -> Ptr GuPool -> IO ((#type bool), GuVariant)+newProduction c_ccats funs_ptr c_non_lexical_buf (PApply fun_id args) pool =+ alloca $ \pptr -> do+ let c_fun = funs_ptr `plusPtr` (fun_id * (#size PgfCncFun))+ c_args <- newSequence (#size PgfPArg) pokePArg args pool+ ptr <- gu_alloc_variant (#const PGF_PRODUCTION_APPLY)+ (fromIntegral (#size PgfProductionApply))+ (#const gu_alignof(PgfProductionApply))+ pptr pool+ (#poke PgfProductionApply, fun) ptr c_fun+ (#poke PgfProductionApply, args) ptr c_args+ is_lexical <- pgf_production_is_lexical ptr c_non_lexical_buf pool+ c_prod <- peek pptr+ return (is_lexical,c_prod)+ where+ pokePArg ptr (PArg hypos ccat) = do+ c_ccat <- getCCat c_ccats ccat pool+ (#poke PgfPArg, ccat) ptr c_ccat+ c_hypos <- newSequence (#size PgfCCat*) pokeCCat hypos pool+ (#poke PgfPArg, hypos) ptr c_hypos++ pokeCCat ptr ccat = do+ c_ccat <- getCCat c_ccats ccat pool+ poke ptr c_ccat++newProduction c_ccats funs_ptr c_non_lexical_buf (PCoerce fid) pool =+ alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_PRODUCTION_COERCE)+ (fromIntegral (#size PgfProductionCoerce))+ (#const gu_alignof(PgfProductionCoerce))+ pptr pool+ c_ccat <- getCCat c_ccats fid pool+ (#poke PgfProductionCoerce, coerce) ptr c_ccat+ c_prod <- peek pptr+ return (0,c_prod)+++newCncFun absfuns seqs_ptr (funid,(fun,seqids)) pool =+ do let c_absfun = fromMaybe nullPtr (Map.lookup fun absfuns)+ c_ep = if c_absfun == nullPtr+ then nullPtr+ else c_absfun `plusPtr` (#offset PgfAbsFun, ep)+ n_lins = fromIntegral (length seqids) :: CSizeT+ ptr <- gu_malloc_aligned pool+ ((#size PgfCncFun)+n_lins*(#size PgfSequence*))+ (#const gu_flex_alignof(PgfCncFun))+ (#poke PgfCncFun, absfun) ptr c_absfun+ (#poke PgfCncFun, ep) ptr c_ep+ (#poke PgfCncFun, funid) ptr (funid :: CInt)+ (#poke PgfCncFun, n_lins) ptr n_lins+ pokeSequences seqs_ptr (ptr `plusPtr` (#offset PgfCncFun, lins)) seqids+ return ptr+ where+ pokeSequences seqs_ptr ptr [] = return ()+ pokeSequences seqs_ptr ptr (seqid:seqids) = do+ poke ptr (seqs_ptr `plusPtr` (seqid * (#size PgfSequence)))+ pokeSequences seqs_ptr (ptr `plusPtr` (#size PgfSequence*)) seqids++getCCat c_ccats fid pool =+ alloca $ \pfid -> do+ poke pfid (fromIntegral fid :: CInt)+ ptr <- gu_map_find_default c_ccats pfid+ c_ccat <- peek ptr+ if c_ccat /= nullPtr+ then return c_ccat+ else do c_ccat <- gu_malloc_aligned pool+ (#size PgfCCat)+ (#const gu_alignof(PgfCCat))+ (#poke PgfCCat, cnccat) c_ccat nullPtr+ (#poke PgfCCat, lindefs) c_ccat nullPtr+ (#poke PgfCCat, linrefs) c_ccat nullPtr+ (#poke PgfCCat, n_synprods) c_ccat (0 :: CSizeT)+ (#poke PgfCCat, prods) c_ccat nullPtr+ (#poke PgfCCat, viterbi_prob) c_ccat (0 :: CFloat)+ (#poke PgfCCat, fid) c_ccat fid+ (#poke PgfCCat, conts) c_ccat nullPtr+ (#poke PgfCCat, answers) c_ccat nullPtr+ ptr <- gu_map_insert c_ccats pfid+ poke ptr c_ccat+ return c_ccat++newSymbol :: Symbol -> Ptr GuPool -> IO GuVariant+newSymbol (SymCat d r) pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_CAT)+ (fromIntegral (#size PgfSymbolCat))+ (#const gu_alignof(PgfSymbolCat))+ pptr pool+ (#poke PgfSymbolCat, d) ptr (fromIntegral d :: CInt)+ (#poke PgfSymbolCat, r) ptr (fromIntegral r :: CInt)+ peek pptr+newSymbol (SymLit d r) pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_LIT)+ (fromIntegral (#size PgfSymbolLit))+ (#const gu_alignof(PgfSymbolLit))+ pptr pool+ (#poke PgfSymbolLit, d) ptr (fromIntegral d :: CInt)+ (#poke PgfSymbolLit, r) ptr (fromIntegral r :: CInt)+ peek pptr+newSymbol (SymVar d r) pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_VAR)+ (fromIntegral (#size PgfSymbolVar))+ (#const gu_alignof(PgfSymbolVar))+ pptr pool+ (#poke PgfSymbolVar, d) ptr (fromIntegral d :: CInt)+ (#poke PgfSymbolVar, r) ptr (fromIntegral r :: CInt)+ peek pptr+newSymbol (SymKS t) pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_KS)+ (fromIntegral ((#size PgfSymbolKS)+utf8Length t))+ (#const gu_flex_alignof(PgfSymbolKS))+ pptr pool+ pokeUtf8CString t (ptr `plusPtr` (#offset PgfSymbolKS, token))+ peek pptr+newSymbol (SymKP def alts) pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_KP)+ (fromIntegral ((#size PgfSymbolKP)+(length alts * (#size PgfAlternative))))+ (#const gu_flex_alignof(PgfSymbolKP))+ pptr pool+ c_def <- newSymbols def pool+ (#poke PgfSymbolKP, default_form) ptr c_def+ pokeAlternatives (ptr `plusPtr` (#offset PgfSymbolKP, forms)) alts pool+ peek pptr+newSymbol SymBIND pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_BIND)+ (fromIntegral (#size PgfSymbolBIND))+ (#const gu_alignof(PgfSymbolBIND))+ pptr pool+ peek pptr+newSymbol SymNE pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_NE)+ (fromIntegral (#size PgfSymbolNE))+ (#const gu_alignof(PgfSymbolNE))+ pptr pool+ peek pptr+newSymbol SymSOFT_BIND pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_SOFT_BIND)+ (fromIntegral (#size PgfSymbolBIND))+ (#const gu_alignof(PgfSymbolBIND))+ pptr pool+ peek pptr+newSymbol SymSOFT_SPACE pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_SOFT_SPACE)+ (fromIntegral (#size PgfSymbolBIND))+ (#const gu_alignof(PgfSymbolBIND))+ pptr pool+ peek pptr+newSymbol SymCAPIT pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_CAPIT)+ (fromIntegral (#size PgfSymbolCAPIT))+ (#const gu_alignof(PgfSymbolCAPIT))+ pptr pool+ peek pptr+newSymbol SymALL_CAPIT pool = alloca $ \pptr -> do+ ptr <- gu_alloc_variant (#const PGF_SYMBOL_ALL_CAPIT)+ (fromIntegral (#size PgfSymbolCAPIT))+ (#const gu_alignof(PgfSymbolCAPIT))+ pptr pool+ peek pptr++newSymbols syms pool = newSequence (#size PgfSymbol) pokeSymbol syms pool+ where+ pokeSymbol p_sym sym = do+ c_sym <- newSymbol sym pool+ poke p_sym c_sym++pokeAlternatives ptr [] pool = return ()+pokeAlternatives ptr ((syms,prefixes):alts) pool = do+ c_syms <- newSymbols syms pool+ c_prefixes <- newSequence (#size GuString) (pokeString pool) prefixes pool+ (#poke PgfAlternative, form) ptr c_syms+ (#poke PgfAlternative, prefixes) ptr c_prefixes+ pokeAlternatives (ptr `plusPtr` (#size PgfAlternative)) alts pool++pokeString pool c_elem str = do+ c_str <- newUtf8CString str pool+ poke c_elem c_str++newMap key_size hasher newKey elem_size pokeElem values pool = do+ map <- gu_make_map key_size hasher+ elem_size gu_null_struct+ (#const GU_MAP_DEFAULT_INIT_SIZE)+ pool+ insert map values pool+ return map+ where+ insert map [] pool = return ()+ insert map ((key,elem):values) pool = do+ c_key <- newKey key pool+ c_elem <- gu_map_insert map c_key+ pokeElem c_elem elem+ insert map values pool+++writePGF :: FilePath -> PGF -> IO ()+writePGF fpath p = do+ pool <- gu_new_pool+ exn <- gu_new_exn pool+ withCString fpath $ \c_fpath ->+ pgf_write (pgf p) c_fpath exn+ touchPGF p+ failed <- gu_exn_is_raised exn+ if failed+ then do is_errno <- gu_exn_caught exn gu_exn_type_GuErrno+ if is_errno+ then do perrno <- (#peek GuExn, data.data) exn+ errno <- peek perrno+ gu_pool_free pool+ ioError (errnoToIOError "writePGF" (Errno errno) Nothing (Just fpath))+ else do gu_pool_free pool+ throwIO (PGFError "The grammar cannot be stored")+ else do gu_pool_free pool+ return ()++sortByFst = sortBy (\(x,_) (y,_) -> compare x y)+sortByFst3 = sortBy (\(x,_,_) (y,_,_) -> compare x y)+sortByFst4 = sortBy (\(x,_,_,_) (y,_,_,_) -> compare x y)
@@ -0,0 +1,141 @@+#include <pgf/pgf.h>++module PGF2.Type where++import System.IO.Unsafe(unsafePerformIO)+import Foreign hiding (unsafePerformIO)+import Foreign.C+import qualified Text.PrettyPrint as PP+import Data.List(mapAccumL)+import PGF2.Expr+import PGF2.FFI++-- The C structure for the expression may point to other structures+-- which are allocated from other pools. In order to ensure that+-- they are not released prematurely we use the exprMaster to+-- store references to other Haskell objects+data Type = Type {typ :: PgfExpr, touchType :: Touch}++-- | 'Hypo' represents a hypothesis in a type i.e. in the type A -> B, A is the hypothesis+type Hypo = (BindType,CId,Type)++instance Show Type where+ show = showType []++-- | parses a 'String' as a type+readType :: String -> Maybe Type+readType str =+ unsafePerformIO $+ do typPl <- gu_new_pool+ withGuPool $ \tmpPl ->+ do c_str <- newUtf8CString str tmpPl+ guin <- gu_string_in c_str tmpPl+ exn <- gu_new_exn tmpPl+ c_type <- pgf_read_type guin typPl tmpPl exn+ status <- gu_exn_is_raised exn+ if (not status && c_type /= nullPtr)+ then do typFPl <- newForeignPtr gu_pool_finalizer typPl+ return $ Just (Type c_type (touchForeignPtr typFPl))+ else do gu_pool_free typPl+ return Nothing++-- | renders a type as a 'String'. The list+-- of identifiers is the list of all free variables+-- in the type in order reverse to the order+-- of binding.+showType :: [CId] -> Type -> String+showType scope (Type ty touch) = + unsafePerformIO $+ withGuPool $ \tmpPl ->+ do (sb,out) <- newOut tmpPl+ printCtxt <- newPrintCtxt scope tmpPl+ exn <- gu_new_exn tmpPl+ pgf_print_type ty printCtxt 0 out exn+ touch+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s++-- | creates a type from a list of hypothesises, a category and +-- a list of arguments for the category. The operation +-- @mkType [h_1,...,h_n] C [e_1,...,e_m]@ will create +-- @h_1 -> ... -> h_n -> C e_1 ... e_m@+mkType :: [Hypo] -> CId -> [Expr] -> Type+mkType hypos cat exprs = unsafePerformIO $ do+ typPl <- gu_new_pool+ let n_exprs = fromIntegral (length exprs) :: CSizeT+ c_type <- gu_malloc typPl ((#size PgfType) + n_exprs * (#size PgfExpr))+ c_hypos <- newSequence (#size PgfHypo) (pokeHypo typPl) hypos typPl+ (#poke PgfType, hypos) c_type c_hypos+ ccat <- newUtf8CString cat typPl+ (#poke PgfType, cid) c_type ccat+ (#poke PgfType, n_exprs) c_type n_exprs+ pokeExprs (c_type `plusPtr` (#offset PgfType, exprs)) exprs+ typFPl <- newForeignPtr gu_pool_finalizer typPl+ return (Type c_type (mapM_ touchHypo hypos >> mapM_ touchExpr exprs >> touchForeignPtr typFPl))++pokeHypo :: Ptr GuPool -> Ptr a -> Hypo -> IO ()+pokeHypo pool c_hypo (bind_type,cid,Type c_ty _) = do+ (#poke PgfHypo, bind_type) c_hypo cbind_type+ newUtf8CString cid pool >>= (#poke PgfHypo, cid) c_hypo+ (#poke PgfHypo, type) c_hypo c_ty+ where+ cbind_type :: CInt+ cbind_type =+ case bind_type of+ Explicit -> (#const PGF_BIND_TYPE_EXPLICIT)+ Implicit -> (#const PGF_BIND_TYPE_IMPLICIT)++pokeExprs ptr [] = return ()+pokeExprs ptr ((Expr e _):es) = do+ poke ptr e+ pokeExprs (plusPtr ptr (#size PgfExpr)) es+ +touchHypo (_,_,ty) = touchType ty++-- | Decomposes a type into a list of hypothesises, a category and +-- a list of arguments for the category.+unType :: Type -> ([Hypo],CId,[Expr])+unType (Type c_type touch) = unsafePerformIO $ do+ cid <- (#peek PgfType, cid) c_type >>= peekUtf8CString+ c_hypos <- (#peek PgfType, hypos) c_type+ n_hypos <- (#peek GuSeq, len) c_hypos+ hs <- peekHypos (c_hypos `plusPtr` (#offset GuSeq, data)) 0 n_hypos+ n_exprs <- (#peek PgfType, n_exprs) c_type+ es <- peekExprs (c_type `plusPtr` (#offset PgfType, exprs)) 0 n_exprs+ return (hs,cid,es)+ where+ peekHypos :: Ptr a -> Int -> Int -> IO [Hypo]+ peekHypos c_hypo i n+ | i < n = do cid <- (#peek PgfHypo, cid) c_hypo >>= peekUtf8CString+ c_ty <- (#peek PgfHypo, type) c_hypo+ bt <- fmap toBindType ((#peek PgfHypo, bind_type) c_hypo)+ hs <- peekHypos (plusPtr c_hypo (#size PgfHypo)) (i+1) n+ return ((bt,cid,Type c_ty touch) : hs)+ | otherwise = return []++ toBindType :: CInt -> BindType+ toBindType (#const PGF_BIND_TYPE_EXPLICIT) = Explicit+ toBindType (#const PGF_BIND_TYPE_IMPLICIT) = Implicit++ peekExprs ptr i n+ | i < n = do e <- peekElemOff ptr i+ es <- peekExprs ptr (i+1) n+ return (Expr e touch : es)+ | otherwise = return []++-- | renders a type as a 'String'. The list+-- of identifiers is the list of all free variables+-- in the type in order reverse to the order+-- of binding.+showContext :: [CId] -> [Hypo] -> String+showContext scope hypos =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ do (sb,out) <- newOut tmpPl+ c_hypos <- newSequence (#size PgfHypo) (pokeHypo tmpPl) hypos tmpPl+ printCtxt <- newPrintCtxt scope tmpPl+ exn <- gu_new_exn tmpPl+ pgf_print_context c_hypos printCtxt out exn+ mapM_ touchHypo hypos+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s
@@ -0,0 +1,26 @@+This is a binding to the new GF runtime in C.++The files are:++PGF2.hsc -- a user API similar to Python and Java APIs+PGF2/FFI.hs -- an internal module with FFI definitions for + -- the relevant C functions++HOW TO COMPILE:++cabal install++HOW TO USE:++- Import PGF to the Haskell program that you're writing. + The Cabal infrastructure will make sure to tell the compiler+ where to find the relevant modules. Example:++ module Main where++ import PGF2+ import qualified Data.Map as Map++ main = do+ pgf <- readPGF "Foo.pgf"+ let Just english = Map.lookup "FooEng" (languages pgf)
@@ -0,0 +1,349 @@+{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification #-}++#include <pgf/pgf.h>+#include <gu/exn.h>+#include <sg/sg.h>++module SG( SG, openSG, closeSG+ , beginTrans, commit, rollback, inTransaction+ , SgId+ , insertExpr, getExpr, queryExpr+ , updateFtsIndex+ , queryLinearization+ , readTriple, showTriple+ , insertTriple, getTriple+ , queryTriple+ , query+ ) where++import Foreign hiding (unsafePerformIO)+import Foreign.C+import SG.FFI+import PGF2.FFI+import PGF2.Expr++import Data.Typeable+import Control.Exception(Exception,SomeException,catch,throwIO)+import System.IO.Unsafe(unsafePerformIO,unsafeInterleaveIO)++-----------------------------------------------------------------------+-- Global database operations and types++newtype SG = SG {sg :: Ptr SgSG}++openSG :: FilePath -> IO SG+openSG fpath =+ withCString fpath $ \c_fpath ->+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ sg <- sg_open c_fpath exn+ failed <- gu_exn_is_raised exn+ if failed+ then do is_errno <- gu_exn_caught exn gu_exn_type_GuErrno+ if is_errno+ then do perrno <- (#peek GuExn, data.data) exn+ errno <- peek perrno+ ioError (errnoToIOError "openSG" (Errno errno) Nothing (Just fpath))+ else do is_sgerr <- gu_exn_caught exn gu_exn_type_SgError+ if is_sgerr+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ throwIO (SGError msg)+ else throwIO (SGError "The database cannot be opened")+ else return (SG sg)++closeSG :: SG -> IO ()+closeSG (SG sg) =+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ sg <- sg_close sg exn+ handle_sg_exn exn++beginTrans :: SG -> IO ()+beginTrans (SG sg) =+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ sg <- sg_begin_trans sg exn+ handle_sg_exn exn++commit :: SG -> IO ()+commit (SG sg) =+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ sg <- sg_commit sg exn+ handle_sg_exn exn++rollback :: SG -> IO ()+rollback (SG sg) =+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ sg <- sg_rollback sg exn+ handle_sg_exn exn++inTransaction :: SG -> IO a -> IO a+inTransaction sg f =+ catch (beginTrans sg >> f >>= \x -> commit sg >> return x)+ (\e -> rollback sg >> throwIO (e :: SomeException))++-----------------------------------------------------------------------+-- Expressions++insertExpr :: SG -> Expr -> IO SgId+insertExpr (SG sg) (Expr expr touch) =+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ id <- sg_insert_expr sg expr 1 exn+ touch+ handle_sg_exn exn+ return id++getExpr :: SG -> SgId -> IO (Maybe Expr)+getExpr (SG sg) id = do+ exprPl <- gu_new_pool+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ c_expr <- sg_get_expr sg id exprPl exn+ handle_sg_exn exn+ if c_expr == nullPtr+ then do touchForeignPtr exprFPl+ return Nothing+ else do return $ Just (Expr c_expr (touchForeignPtr exprFPl))++queryExpr :: SG -> Expr -> IO [(SgId,Expr)]+queryExpr (SG sg) (Expr query touch) =+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ res <- sg_query_expr sg query tmpPl exn+ touch+ handle_sg_exn exn+ fetchResults res exn+ where+ fetchResults res exn = do+ exprPl <- gu_new_pool+ (key,c_expr) <- alloca $ \pKey -> do+ c_expr <- sg_query_next sg res pKey exprPl exn+ key <- peek pKey+ return (key,c_expr)+ failed <- gu_exn_is_raised exn+ if failed+ then do gu_pool_free exprPl+ sg_query_close sg res exn+ handle_sg_exn exn+ return []+ else if c_expr == nullPtr+ then do gu_pool_free exprPl+ sg_query_close sg res exn+ return []+ else do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ rest <- fetchResults res exn+ return ((key,Expr c_expr (touchForeignPtr exprFPl)) : rest)++updateFtsIndex :: SG -> PGF -> IO ()+updateFtsIndex (SG sg) p = do+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ sg_update_fts_index sg (pgf p) exn+ handle_sg_exn exn++queryLinearization :: SG -> String -> IO [Expr]+queryLinearization (SG sg) query = do+ exprPl <- gu_new_pool+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ (withGuPool $ \tmpPl -> do+ c_query <- newUtf8CString query tmpPl+ exn <- gu_new_exn tmpPl+ seq <- sg_query_linearization sg c_query tmpPl exn+ handle_sg_exn exn+ len <- (#peek GuSeq, len) seq+ ids <- peekArray (fromIntegral (len :: CInt)) (seq `plusPtr` (#offset GuSeq, data))+ getExprs exprFPl exprPl exn ids)+ where+ getExprs exprFPl exprPl exn [] = return []+ getExprs exprFPl exprPl exn (id:ids) = do+ c_expr <- sg_get_expr sg id exprPl exn+ handle_sg_exn exn+ if c_expr == nullPtr+ then getExprs exprFPl exprPl exn ids+ else do let e = Expr c_expr (touchForeignPtr exprFPl)+ es <- getExprs exprFPl exprPl exn ids+ return (e:es)++-----------------------------------------------------------------------+-- Triples++readTriple :: String -> Maybe (Expr,Expr,Expr)+readTriple str =+ unsafePerformIO $+ do exprPl <- gu_new_pool+ withGuPool $ \tmpPl ->+ withTriple $ \triple ->+ do c_str <- newUtf8CString str tmpPl+ guin <- gu_string_in c_str tmpPl+ exn <- gu_new_exn tmpPl+ ok <- pgf_read_expr_tuple guin 3 triple exprPl exn+ status <- gu_exn_is_raised exn+ if (ok == 1 && not status)+ then do c_expr1 <- peekElemOff triple 0+ c_expr2 <- peekElemOff triple 1+ c_expr3 <- peekElemOff triple 2+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ let touch = touchForeignPtr exprFPl+ return $ Just (Expr c_expr1 touch,Expr c_expr2 touch,Expr c_expr3 touch)+ else do gu_pool_free exprPl+ return Nothing++showTriple :: Expr -> Expr -> Expr -> String+showTriple (Expr expr1 touch1) (Expr expr2 touch2) (Expr expr3 touch3) =+ unsafePerformIO $+ withGuPool $ \tmpPl ->+ withTriple $ \triple -> do+ (sb,out) <- newOut tmpPl+ let printCtxt = nullPtr+ exn <- gu_new_exn tmpPl+ pokeElemOff triple 0 expr1+ pokeElemOff triple 1 expr2+ pokeElemOff triple 2 expr3+ pgf_print_expr_tuple 3 triple printCtxt out exn+ touch1 >> touch2 >> touch3+ s <- gu_string_buf_freeze sb tmpPl+ peekUtf8CString s++insertTriple :: SG -> Expr -> Expr -> Expr -> IO SgId+insertTriple (SG sg) (Expr expr1 touch1) (Expr expr2 touch2) (Expr expr3 touch3) =+ withGuPool $ \tmpPl -> + withTriple $ \triple -> do+ exn <- gu_new_exn tmpPl+ pokeElemOff triple 0 expr1+ pokeElemOff triple 1 expr2+ pokeElemOff triple 2 expr3+ id <- sg_insert_triple sg triple exn+ touch1 >> touch2 >> touch3+ handle_sg_exn exn+ return id++getTriple :: SG -> SgId -> IO (Maybe (Expr,Expr,Expr))+getTriple (SG sg) id = do+ exprPl <- gu_new_pool+ exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ let touch = touchForeignPtr exprFPl+ withGuPool $ \tmpPl ->+ withTriple $ \triple -> do+ exn <- gu_new_exn tmpPl+ res <- sg_get_triple sg id triple exprPl exn+ handle_sg_exn exn+ if res /= 0+ then do c_expr1 <- peekElemOff triple 0+ c_expr2 <- peekElemOff triple 1+ c_expr3 <- peekElemOff triple 2+ return (Just (Expr c_expr1 touch+ ,Expr c_expr2 touch+ ,Expr c_expr3 touch+ ))+ else do touch+ return Nothing++queryTriple :: SG -> Maybe Expr -> Maybe Expr -> Maybe Expr -> IO [(SgId,Expr,Expr,Expr)]+queryTriple (SG sg) mb_expr1 mb_expr2 mb_expr3 =+ withGuPool $ \tmpPl ->+ withTriple $ \triple -> do+ exn <- gu_new_exn tmpPl+ pokeElemOff triple 0 (toCExpr mb_expr1)+ pokeElemOff triple 1 (toCExpr mb_expr2)+ pokeElemOff triple 2 (toCExpr mb_expr3)+ res <- sg_query_triple sg triple exn+ handle_sg_exn exn+ unsafeInterleaveIO (fetchResults res)+ where+ toCExpr Nothing = nullPtr+ toCExpr (Just (Expr expr _)) = expr++ fromCExpr c_expr touch Nothing = Expr c_expr touch+ fromCExpr c_expr touch (Just e) = e++ fetchResults res = do+ exprPl <- gu_new_pool+ alloca $ \pKey ->+ withGuPool $ \tmpPl ->+ withTriple $ \triple -> do+ exn <- gu_new_exn tmpPl+ r <- sg_triple_result_fetch res pKey triple exprPl exn+ failed <- gu_exn_is_raised exn+ if failed+ then do gu_pool_free exprPl+ sg_triple_result_close res exn+ handle_sg_exn exn+ return []+ else if r == 0+ then do gu_pool_free exprPl+ sg_triple_result_close res exn+ return []+ else do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ let touch = touchForeignPtr exprFPl+ c_expr1 <- peekElemOff triple 0+ c_expr2 <- peekElemOff triple 1+ c_expr3 <- peekElemOff triple 2+ key <- peek pKey+ rest <- unsafeInterleaveIO (fetchResults res)+ return ((key,fromCExpr c_expr1 touch mb_expr1+ ,fromCExpr c_expr2 touch mb_expr2+ ,fromCExpr c_expr3 touch mb_expr3) : rest)+++query :: SG -> String -> IO [[Expr]]+query (SG sg) str =+ withGuPool $ \tmpPl ->+ do c_str <- newUtf8CString str tmpPl+ guin <- gu_string_in c_str tmpPl+ exn <- gu_new_exn tmpPl+ seq <- pgf_read_expr_matrix guin 3 tmpPl exn+ if seq /= nullPtr+ then do count <- (#peek GuSeq, len) seq+ q <- sg_query sg (count `div` 3) (seq `plusPtr` (#offset GuSeq, data)) exn+ handle_sg_exn exn+ n_cols <- sg_query_result_columns q+ unsafeInterleaveIO (fetchResults q n_cols)+ else return []+ where+ fetchResults q n_cols =+ withGuPool $ \tmpPl -> do+ exn <- gu_new_exn tmpPl+ pExprs <- gu_malloc tmpPl ((#size PgfExpr) * n_cols)+ exprPl <- gu_new_pool+ res <- sg_query_result_fetch q pExprs exprPl exn+ failed <- gu_exn_is_raised exn+ if failed+ then do gu_pool_free exprPl+ sg_query_result_close q exn+ handle_sg_exn exn+ return []+ else if res /= 0+ then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl+ let touch = touchForeignPtr exprFPl+ row <- fmap (map (flip Expr touch)) $ peekArray (fromIntegral n_cols) pExprs+ rows <- unsafeInterleaveIO (fetchResults q n_cols)+ return (row:rows)+ else do gu_pool_free exprPl+ sg_query_result_close q exn+ return []++-----------------------------------------------------------------------+-- Exceptions++newtype SGError = SGError String+ deriving (Show, Typeable)++instance Exception SGError++handle_sg_exn exn = do+ failed <- gu_exn_is_raised exn+ if failed+ then do is_sgerr <- gu_exn_caught exn gu_exn_type_SgError+ if is_sgerr+ then do c_msg <- (#peek GuExn, data.data) exn+ msg <- peekUtf8CString c_msg+ throwIO (SGError msg)+ else throwIO (SGError "Unknown database error")+ else return ()++-----------------------------------------------------------------------
@@ -0,0 +1,84 @@+{-# LANGUAGE ForeignFunctionInterface, MagicHash #-}+module SG.FFI where++import Foreign+import Foreign.C+import PGF2.FFI+import GHC.Ptr+import Data.Int++data SgSG+data SgQueryExprResult+data SgTripleResult+data SgQueryResult+type SgId = Int64++foreign import ccall "sg/sg.h sg_open"+ sg_open :: CString -> Ptr GuExn -> IO (Ptr SgSG)++foreign import ccall "sg/sg.h sg_close"+ sg_close :: Ptr SgSG -> Ptr GuExn -> IO ()++foreign import ccall "sg/sg.h sg_begin_trans"+ sg_begin_trans :: Ptr SgSG -> Ptr GuExn -> IO ()++foreign import ccall "sg/sg.h sg_commit"+ sg_commit :: Ptr SgSG -> Ptr GuExn -> IO ()++foreign import ccall "sg/sg.h sg_rollback"+ sg_rollback :: Ptr SgSG -> Ptr GuExn -> IO ()++foreign import ccall "sg/sg.h sg_insert_expr"+ sg_insert_expr :: Ptr SgSG -> PgfExpr -> CInt -> Ptr GuExn -> IO SgId++foreign import ccall "sg/sg.h sg_get_expr"+ sg_get_expr :: Ptr SgSG -> SgId -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr++foreign import ccall "sg/sg.h sg_query_expr"+ sg_query_expr :: Ptr SgSG -> PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO (Ptr SgQueryExprResult)++foreign import ccall "sg/sg.h sg_query_next"+ sg_query_next :: Ptr SgSG -> Ptr SgQueryExprResult -> Ptr SgId -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr++foreign import ccall "sg/sg.h sg_query_close"+ sg_query_close :: Ptr SgSG -> Ptr SgQueryExprResult -> Ptr GuExn -> IO ()++foreign import ccall "sg/sg.h sg_update_fts_index"+ sg_update_fts_index :: Ptr SgSG -> Ptr PgfPGF -> Ptr GuExn -> IO ()++foreign import ccall "sg/sg.h sg_query_linearization"+ sg_query_linearization :: Ptr SgSG -> CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuSeq)++foreign import ccall "sg/sg.h sg_insert_triple"+ sg_insert_triple :: Ptr SgSG -> SgTriple -> Ptr GuExn -> IO SgId++foreign import ccall "sg/sg.h sg_get_triple"+ sg_get_triple :: Ptr SgSG -> SgId -> SgTriple -> Ptr GuPool -> Ptr GuExn -> IO CInt++foreign import ccall "sg/sg.h sg_query_triple"+ sg_query_triple :: Ptr SgSG -> SgTriple -> Ptr GuExn -> IO (Ptr SgTripleResult)++foreign import ccall "sg/sg.h sg_triple_result_fetch"+ sg_triple_result_fetch :: Ptr SgTripleResult -> Ptr SgId -> SgTriple -> Ptr GuPool -> Ptr GuExn -> IO CInt++foreign import ccall "sg/sg.h sg_triple_result_close"+ sg_triple_result_close :: Ptr SgTripleResult -> Ptr GuExn -> IO ()++foreign import ccall "sg/sg.h sg_query"+ sg_query :: Ptr SgSG -> CSizeT -> Ptr PgfExpr -> Ptr GuExn -> IO (Ptr SgQueryResult)++foreign import ccall "sg/sg.h sg_query_result_columns"+ sg_query_result_columns :: Ptr SgQueryResult -> IO CSizeT++foreign import ccall "sg/sg.h sg_query_result_fetch"+ sg_query_result_fetch :: Ptr SgQueryResult -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt++foreign import ccall "sg/sg.h sg_query_result_close"+ sg_query_result_close :: Ptr SgQueryResult -> Ptr GuExn -> IO ()++type SgTriple = Ptr PgfExpr++withTriple :: (SgTriple -> IO a) -> IO a+withTriple = allocaArray 3++gu_exn_type_SgError = Ptr "SgError"# :: CString
@@ -0,0 +1,87 @@+-- | pgf-shell: A simple shell to illustrate the use of the Haskell binding+-- to the C implementation of the PGF run-time system.+--+-- The shell has 4 commands:+--+-- * parse: p <lang> <text>+-- * linearize: l <lang> <tree>+-- * translate: t <lang> <lang> <text> +-- * import: i <path to pgf>++import Control.Monad(forever)+import Control.Monad.State(evalStateT,put,get,gets,liftIO)+import Control.Exception.Lifted as L(catch)+import Data.Char(isSpace)+import qualified Data.Map as M+import System.IO(hFlush,stdout)+import System.Environment+import PGF2+import qualified Data.Map as Map++main = getPGF =<< getArgs++getPGF [path] = pgfShell =<< readPGF path+getPGF _ = putStrLn "Usage: pgf-shell <path to pgf>"++pgfShell pgf =+ do putStrLn . unwords . M.keys $ languages pgf+ flip evalStateT (pgf,[]) $ forever $ do puts "> "; liftIO $ hFlush stdout+ execute =<< liftIO readLn++execute cmd =+ case cmd of+ L lang tree -> do pgf <- gets fst+ c <- getConcr' pgf lang+ put (pgf,[])+ putln $ linearize c tree+ P lang s -> do pgf <- gets fst+ c <- getConcr' pgf lang+ case parse c (startCat pgf) s of+ ParseFailed _ tok -> do put (pgf,[])+ putln ("Parse error: "++tok)+ ParseOk ts -> do put (pgf,map show ts)+ pop+ T from to s -> do pgf <- gets fst+ cfrom <- getConcr' pgf from+ cto <- getConcr' pgf to+ case parse cfrom (startCat pgf) s of+ ParseFailed _ tok -> do put (pgf,[])+ putln ("Parse error: "++tok)+ ParseOk ts -> do put (pgf,map (linearize cto.fst) ts)+ pop+ I path -> do pgf <- liftIO (readPGF path)+ putln . unwords . M.keys $ languages pgf+ put (pgf,[])+ Empty -> pop+ Unknown s -> putln ("Unknown command: "++s) + `L.catch` (liftIO . print . (id::IOError->IOError))++pop = do (pgf,ls) <- get+ let (ls1,ls2) = splitAt 1 ls+ putl ls1+ put (pgf,ls2)++getConcr' pgf lang =+ maybe (fail $ "Concrete syntax not found: "++show lang) return $+ Map.lookup lang (languages pgf)++printl xs = liftIO $ putl $ map show xs+putl ls = liftIO . putStr $ unlines ls+putln s = liftIO $ putStrLn s+puts s = liftIO $ putStr s++-- | Abstracy syntax of shell commands+data Command = P String String | L String Expr | T String String String+ | I FilePath | Empty | Unknown String+ deriving Show++-- | Shell command parser+instance Read Command where+ readsPrec _ s =+ take 1 $+ [(P l r2,"") | ("p",r1)<-lex s, (l,r2) <- lex r1]+ ++ [(L l t,"") | ("l",r1)<-lex s, (l,r2)<- lex r1, Just t<-[readExpr r2]]+ ++ [(T l1 l2 r3,"") | ("t",r1)<-lex s, (l1,r2)<-lex r1, (l2,r3)<-lex r2]+ ++ [(I (dropWhile isSpace r),"") | ("i",r)<-lex s]+ ++ [(Empty,"") | ("","") <- lex s]+ ++ [(Unknown s,"")]
@@ -0,0 +1,37 @@+name: pgf2+version: 0.1.0.0+-- synopsis:+-- description:+homepage: http://www.grammaticalframework.org+license: LGPL-3+--license-file: LICENSE+author: Krasimir Angelov, Inari+maintainer:+-- copyright:+category: Language+build-type: Simple+extra-source-files: README+cabal-version: >=1.10++library+ exposed-modules: PGF2, PGF2.Internal, SG+ -- backwards compatibility API:+ --, PGF, PGF.Internal+ other-modules: PGF2.FFI, PGF2.Expr, PGF2.Type, SG.FFI+ build-depends: base >=4.3,+ containers, pretty+ -- hs-source-dirs:+ default-language: Haskell2010+ build-tools: hsc2hs++ extra-libraries: sg pgf gu+ cc-options: -std=c99+ c-sources: utils.c++executable pgf-shell+ main-is: pgf-shell.hs+ hs-source-dirs: examples+ build-depends: base, pgf2, containers, mtl, lifted-base+ default-language: Haskell2010+ if impl(ghc>=7.0)+ ghc-options: -rtsopts
@@ -0,0 +1,160 @@+#include <HsFFI.h>+#include <pgf/pgf.h>+#include <gu/utf8.h>++typedef struct {+ PgfLiteralCallback callback;+ PgfExprProb* (*match)(size_t lin_idx, size_t* poffset,+ GuPool *out_pool);+ GuFinalizer fin;+} HSPgfLiteralCallback;++static size_t+hspgf_offset2hs(GuString sentence, size_t offset)+{+ const uint8_t *start = sentence;+ const uint8_t *end = sentence + offset;+ size_t hs_offset = 0;+ while (start < end) {+ gu_utf8_decode(&start);+ hs_offset++;+ }+ return hs_offset;+}++static size_t+hspgf_hs2offset(GuString sentence, size_t hs_offset)+{+ const uint8_t *start = sentence;+ const uint8_t *end = start;+ while (hs_offset > 0) {+ gu_utf8_decode(&end);+ hs_offset--;+ }+ + return (end - start);+}++static PgfExprProb*+hspgf_match_callback(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ HSPgfLiteralCallback* callback = (HSPgfLiteralCallback*) self;++ size_t hs_offset =+ hspgf_offset2hs(sentence, *poffset);+ PgfExprProb* ep =+ callback->match(lin_idx, &hs_offset, out_pool);+ *poffset = hspgf_hs2offset(sentence, hs_offset);++ return ep;+}++static void+hspgf_literal_callback_fin(GuFinalizer* self)+{+ HSPgfLiteralCallback* callback = gu_container(self, HSPgfLiteralCallback, fin);+ + if (callback->callback.match != NULL)+ hs_free_fun_ptr((HsFunPtr) callback->match);+ if (callback->callback.predict != NULL)+ hs_free_fun_ptr((HsFunPtr) callback->callback.predict);+}++void+hspgf_callbacks_map_add_literal(PgfConcr* concr, PgfCallbacksMap* callbacks,+ PgfCId cat, HsFunPtr match, HsFunPtr predict,+ GuPool* pool)+{+ HSPgfLiteralCallback* callback = gu_new(HSPgfLiteralCallback, pool);+ callback->callback.match = hspgf_match_callback;+ callback->callback.predict = (void*) predict;+ callback->match = (void*) match;+ callback->fin.fn = hspgf_literal_callback_fin;+ gu_pool_finally(pool, &callback->fin);+ pgf_callbacks_map_add_literal(concr, callbacks, cat, &callback->callback);+}++typedef struct {+ PgfOracleCallback oracle;+ GuString sentence;+ bool (*predict) (PgfCId cat,+ GuString label,+ size_t offset);+ bool (*complete)(PgfCId cat,+ GuString label,+ size_t offset);+ PgfExprProb* (*literal)(PgfCId cat,+ GuString label,+ size_t* poffset,+ GuPool *out_pool);+ GuFinalizer fin;+} HSPgfOracleCallback;++static bool+hspgf_predict_callback(PgfOracleCallback* self,+ PgfCId cat,+ GuString label,+ size_t offset)+{+ HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle);+ oracle->predict(cat,label,hspgf_offset2hs(oracle->sentence, offset));+}++static bool+hspgf_complete_callback(PgfOracleCallback* self,+ PgfCId cat,+ GuString label,+ size_t offset)+{+ HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle);+ oracle->complete(cat,label,hspgf_offset2hs(oracle->sentence, offset));+}++static PgfExprProb*+hspgf_literal_callback(PgfOracleCallback* self,+ PgfCId cat,+ GuString label,+ size_t* poffset,+ GuPool *out_pool)+{+ HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle);+ size_t hs_offset = hspgf_offset2hs(oracle->sentence, *poffset);+ PgfExprProb* ep =+ oracle->literal(cat,label,&hs_offset,out_pool);+ *poffset = hspgf_hs2offset(oracle->sentence, hs_offset);+ return ep;+}++static void+hspgf_oracle_callback_fin(GuFinalizer* self)+{+ HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, fin);++ if (oracle->predict != NULL)+ hs_free_fun_ptr((HsFunPtr) oracle->predict);+ if (oracle->complete != NULL)+ hs_free_fun_ptr((HsFunPtr) oracle->complete);+ if (oracle->literal != NULL)+ hs_free_fun_ptr((HsFunPtr) oracle->literal);+}++PgfOracleCallback*+hspgf_new_oracle_callback(GuString sentence,+ HsFunPtr predict, HsFunPtr complete, HsFunPtr literal,+ GuPool* pool)+{+ HSPgfOracleCallback* oracle = gu_new(HSPgfOracleCallback, pool);+ oracle->oracle.predict = predict ? hspgf_predict_callback : NULL;+ oracle->oracle.complete = complete ? hspgf_complete_callback : NULL;+ oracle->oracle.literal = literal ? hspgf_literal_callback : NULL;+ oracle->sentence = sentence;+ oracle->predict = (void*) predict;+ oracle->complete = (void*) complete;+ oracle->literal = (void*) literal;+ oracle->fin.fn = hspgf_oracle_callback_fin;+ gu_pool_finally(pool, &oracle->fin);+ return &oracle->oracle;+}
@@ -0,0 +1,814 @@+{-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Binary+-- Copyright : Lennart Kolmodin+-- License : BSD3-style (see LICENSE)+-- +-- Maintainer : Lennart Kolmodin <kolmodin@dtek.chalmers.se>+-- Stability : unstable+-- Portability : portable to Hugs and GHC. Requires the FFI and some flexible instances+--+-- Binary serialisation of Haskell values to and from lazy ByteStrings.+-- The Binary library provides methods for encoding Haskell values as+-- streams of bytes directly in memory. The resulting @ByteString@ can+-- then be written to disk, sent over the network, or futher processed+-- (for example, compressed with gzip).+--+-- The 'Binary' package is notable in that it provides both pure, and+-- high performance serialisation.+--+-- Values are always encoded in network order (big endian) form, and+-- encoded data should be portable across machine endianess, word size,+-- or compiler version. For example, data encoded using the Binary class+-- could be written from GHC, and read back in Hugs.+--+-----------------------------------------------------------------------------++module Data.Binary (++ -- * The Binary class+ Binary(..)++ -- $example++ -- * The Get and Put monads+ , Get+ , Put++ -- * Useful helpers for writing instances+ , putWord8+ , getWord8++ -- * Binary serialisation+ , encode -- :: Binary a => a -> ByteString+ , decode -- :: Binary a => ByteString -> a++ -- * IO functions for serialisation+ , encodeFile -- :: Binary a => FilePath -> a -> IO ()+ , decodeFile -- :: Binary a => FilePath -> IO a++ , encodeFile_ -- :: FilePath -> Put -> IO ()+ , decodeFile_ -- :: FilePath -> Get a -> IO a++-- Lazy put and get+-- , lazyPut+-- , lazyGet++ , module Data.Word -- useful++ ) where++#include "MachDeps.h"++import Data.Word++import Data.Binary.Put+import Data.Binary.Get+import Data.Binary.IEEE754 ( putFloat64be, getFloat64be)+import Control.Monad+import Control.Exception+import Foreign+import System.IO++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as L++import Data.Char (chr,ord)+import Data.List (unfoldr)++-- And needed for the instances:+import qualified Data.ByteString as B+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Ratio as R++import qualified Data.Tree as T++import Data.Array.Unboxed++--+-- This isn't available in older Hugs or older GHC+--+#if __GLASGOW_HASKELL__ >= 606+import qualified Data.Sequence as Seq+import qualified Data.Foldable as Fold+#endif++------------------------------------------------------------------------++-- | The @Binary@ class provides 'put' and 'get', methods to encode and+-- decode a Haskell value to a lazy ByteString. It mirrors the Read and+-- Show classes for textual representation of Haskell types, and is+-- suitable for serialising Haskell values to disk, over the network.+--+-- For parsing and generating simple external binary formats (e.g. C+-- structures), Binary may be used, but in general is not suitable+-- for complex protocols. Instead use the Put and Get primitives+-- directly.+--+-- Instances of Binary should satisfy the following property:+--+-- > decode . encode == id+--+-- That is, the 'get' and 'put' methods should be the inverse of each+-- other. A range of instances are provided for basic Haskell types. +--+class Binary t where+ -- | Encode a value in the Put monad.+ put :: t -> Put+ -- | Decode a value in the Get monad+ get :: Get t++-- $example+-- To serialise a custom type, an instance of Binary for that type is+-- required. For example, suppose we have a data structure:+--+-- > data Exp = IntE Int+-- > | OpE String Exp Exp+-- > deriving Show+--+-- We can encode values of this type into bytestrings using the+-- following instance, which proceeds by recursively breaking down the+-- structure to serialise:+--+-- > instance Binary Exp where+-- > put (IntE i) = do put (0 :: Word8)+-- > put i+-- > put (OpE s e1 e2) = do put (1 :: Word8)+-- > put s+-- > put e1+-- > put e2+-- > +-- > get = do t <- get :: Get Word8+-- > case t of+-- > 0 -> do i <- get+-- > return (IntE i)+-- > 1 -> do s <- get+-- > e1 <- get+-- > e2 <- get+-- > return (OpE s e1 e2)+--+-- Note how we write an initial tag byte to indicate each variant of the+-- data type.+--+-- We can simplify the writing of 'get' instances using monadic+-- combinators:+-- +-- > get = do tag <- getWord8+-- > case tag of+-- > 0 -> liftM IntE get+-- > 1 -> liftM3 OpE get get get+--+-- The generation of Binary instances has been automated by a script+-- using Scrap Your Boilerplate generics. Use the script here:+-- <http://darcs.haskell.org/binary/tools/derive/BinaryDerive.hs>.+--+-- To derive the instance for a type, load this script into GHCi, and+-- bring your type into scope. Your type can then have its Binary+-- instances derived as follows:+--+-- > $ ghci -fglasgow-exts BinaryDerive.hs+-- > *BinaryDerive> :l Example.hs+-- > *Main> deriveM (undefined :: Drinks)+-- >+-- > instance Binary Main.Drinks where+-- > put (Beer a) = putWord8 0 >> put a+-- > put Coffee = putWord8 1+-- > put Tea = putWord8 2+-- > put EnergyDrink = putWord8 3+-- > put Water = putWord8 4+-- > put Wine = putWord8 5+-- > put Whisky = putWord8 6+-- > get = do+-- > tag_ <- getWord8+-- > case tag_ of+-- > 0 -> get >>= \a -> return (Beer a)+-- > 1 -> return Coffee+-- > 2 -> return Tea+-- > 3 -> return EnergyDrink+-- > 4 -> return Water+-- > 5 -> return Wine+-- > 6 -> return Whisky+-- >+--+-- To serialise this to a bytestring, we use 'encode', which packs the+-- data structure into a binary format, in a lazy bytestring+--+-- > > let e = OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2))+-- > > let v = encode e+--+-- Where 'v' is a binary encoded data structure. To reconstruct the+-- original data, we use 'decode'+--+-- > > decode v :: Exp+-- > OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2))+--+-- The lazy ByteString that results from 'encode' can be written to+-- disk, and read from disk using Data.ByteString.Lazy IO functions,+-- such as hPutStr or writeFile:+--+-- > > writeFile "/tmp/exp.txt" (encode e)+--+-- And read back with:+--+-- > > readFile "/tmp/exp.txt" >>= return . decode :: IO Exp+-- > OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2))+--+-- We can also directly serialise a value to and from a Handle, or a file:+-- +-- > > v <- decodeFile "/tmp/exp.txt" :: IO Exp+-- > OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2))+--+-- And write a value to disk+--+-- > > encodeFile "/tmp/a.txt" v+--++------------------------------------------------------------------------+-- Wrappers to run the underlying monad++-- | Encode a value using binary serialisation to a lazy ByteString.+--+encode :: Binary a => a -> ByteString+encode = runPut . put+{-# INLINE encode #-}++-- | Decode a value from a lazy ByteString, reconstructing the original structure.+--+decode :: Binary a => ByteString -> a+decode = runGet get++------------------------------------------------------------------------+-- Convenience IO operations++-- | Lazily serialise a value to a file+--+-- This is just a convenience function, it's defined simply as:+--+-- > encodeFile f = B.writeFile f . encode+--+-- So for example if you wanted to compress as well, you could use:+--+-- > B.writeFile f . compress . encode+--+encodeFile :: Binary a => FilePath -> a -> IO ()+encodeFile f v = L.writeFile f (encode v)++encodeFile_ :: FilePath -> Put -> IO ()+encodeFile_ f m = L.writeFile f (runPut m)++-- | Lazily reconstruct a value previously written to a file.+--+-- This is just a convenience function, it's defined simply as:+--+-- > decodeFile f = return . decode =<< B.readFile f+--+-- So for example if you wanted to decompress as well, you could use:+--+-- > return . decode . decompress =<< B.readFile f+--+decodeFile :: Binary a => FilePath -> IO a+decodeFile f = bracket (openBinaryFile f ReadMode) hClose $ \h -> do+ s <- L.hGetContents h+ evaluate $ runGet get s++decodeFile_ :: FilePath -> Get a -> IO a+decodeFile_ f m = bracket (openBinaryFile f ReadMode) hClose $ \h -> do+ s <- L.hGetContents h+ evaluate $ runGet m s++-- needs bytestring 0.9.1.x to work ++------------------------------------------------------------------------+-- Lazy put and get++-- lazyPut :: (Binary a) => a -> Put+-- lazyPut a = put (encode a)++-- lazyGet :: (Binary a) => Get a+-- lazyGet = fmap decode get++------------------------------------------------------------------------+-- Simple instances++-- The () type need never be written to disk: values of singleton type+-- can be reconstructed from the type alone+instance Binary () where+ put () = return ()+ get = return ()++-- Bools are encoded as a byte in the range 0 .. 1+instance Binary Bool where+ put = putWord8 . fromIntegral . fromEnum+ get = liftM (toEnum . fromIntegral) getWord8++-- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2+instance Binary Ordering where+ put = putWord8 . fromIntegral . fromEnum+ get = liftM (toEnum . fromIntegral) getWord8++------------------------------------------------------------------------+-- Words and Ints++-- Words8s are written as bytes+instance Binary Word8 where+ put = putWord8+ get = getWord8++-- Words16s are written as 2 bytes in big-endian (network) order+instance Binary Word16 where+ put = putWord16be+ get = getWord16be++-- Words32s are written as 4 bytes in big-endian (network) order+instance Binary Word32 where+ put = putWord32be+ get = getWord32be++-- Words64s are written as 8 bytes in big-endian (network) order+instance Binary Word64 where+ put = putWord64be+ get = getWord64be++-- Int8s are written as a single byte.+instance Binary Int8 where+ put i = put (fromIntegral i :: Word8)+ get = liftM fromIntegral (get :: Get Word8)++-- Int16s are written as a 2 bytes in big endian format+instance Binary Int16 where+ put i = put (fromIntegral i :: Word16)+ get = liftM fromIntegral (get :: Get Word16)++-- Int32s are written as a 4 bytes in big endian format+instance Binary Int32 where+ put i = put (fromIntegral i :: Word32)+ get = liftM fromIntegral (get :: Get Word32)++-- Int64s are written as a 8 bytes in big endian format+instance Binary Int64 where+ put i = put (fromIntegral i :: Word64)+ get = liftM fromIntegral (get :: Get Word64)++------------------------------------------------------------------------++-- Words are written as sequence of bytes. The last bit of each+-- byte indicates whether there are more bytes to be read+instance Binary Word where+ put i | i <= 0x7f = do put a+ | i <= 0x3fff = do put (a .|. 0x80)+ put b+ | i <= 0x1fffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put c+ | i <= 0xfffffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put d+-- -- #if WORD_SIZE_IN_BITS < 64+ | otherwise = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put e+{-+-- Restricted to 32 bits even on 64-bit systems, so that negative+-- Ints are written as 5 bytes instead of 10 bytes (TH 2013-02-13)+--#else+ | i <= 0x7ffffffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put e+ | i <= 0x3ffffffffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put (e .|. 0x80)+ put f+ | i <= 0x1ffffffffffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put (e .|. 0x80)+ put (f .|. 0x80)+ put g+ | i <= 0xffffffffffffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put (e .|. 0x80)+ put (f .|. 0x80)+ put (g .|. 0x80)+ put h+ | i <= 0xffffffffffffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put (e .|. 0x80)+ put (f .|. 0x80)+ put (g .|. 0x80)+ put h+ | i <= 0x7fffffffffffffff = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put (e .|. 0x80)+ put (f .|. 0x80)+ put (g .|. 0x80)+ put (h .|. 0x80)+ put j+ | otherwise = do put (a .|. 0x80)+ put (b .|. 0x80)+ put (c .|. 0x80)+ put (d .|. 0x80)+ put (e .|. 0x80)+ put (f .|. 0x80)+ put (g .|. 0x80)+ put (h .|. 0x80)+ put (j .|. 0x80)+ put k+-- #endif+-}+ where+ a = fromIntegral ( i .&. 0x7f) :: Word8+ b = fromIntegral (shiftR i 7 .&. 0x7f) :: Word8+ c = fromIntegral (shiftR i 14 .&. 0x7f) :: Word8+ d = fromIntegral (shiftR i 21 .&. 0x7f) :: Word8+ e = fromIntegral (shiftR i 28 .&. 0x7f) :: Word8+{-+ f = fromIntegral (shiftR i 35 .&. 0x7f) :: Word8+ g = fromIntegral (shiftR i 42 .&. 0x7f) :: Word8+ h = fromIntegral (shiftR i 49 .&. 0x7f) :: Word8+ j = fromIntegral (shiftR i 56 .&. 0x7f) :: Word8+ k = fromIntegral (shiftR i 63 .&. 0x7f) :: Word8+-}+ get = do i <- getWord8+ (if i <= 0x7f+ then return (fromIntegral i)+ else do n <- get+ return $ (n `shiftL` 7) .|. (fromIntegral (i .&. 0x7f)))++-- Int has the same representation as Word+instance Binary Int where+ put i = put (fromIntegral i :: Word)+ get = liftM toInt32 (get :: Get Word)+ where+ -- restrict to 32 bits (for PGF portability, TH 2013-02-13)+ toInt32 w = fromIntegral (fromIntegral w::Int32)::Int++------------------------------------------------------------------------+-- +-- Portable, and pretty efficient, serialisation of Integer+--++-- Fixed-size type for a subset of Integer+type SmallInt = Int32++-- Integers are encoded in two ways: if they fit inside a SmallInt,+-- they're written as a byte tag, and that value. If the Integer value+-- is too large to fit in a SmallInt, it is written as a byte array,+-- along with a sign and length field.++instance Binary Integer where++ {-# INLINE put #-}+ put n | n >= lo && n <= hi = do+ putWord8 0+ put (fromIntegral n :: SmallInt) -- fast path+ where+ lo = fromIntegral (minBound :: SmallInt) :: Integer+ hi = fromIntegral (maxBound :: SmallInt) :: Integer++ put n = do+ putWord8 1+ put sign+ put (unroll (abs n)) -- unroll the bytes+ where+ sign = fromIntegral (signum n) :: Word8++ {-# INLINE get #-}+ get = do+ tag <- get :: Get Word8+ case tag of+ 0 -> liftM fromIntegral (get :: Get SmallInt)+ _ -> do sign <- get+ bytes <- get+ let v = roll bytes+ return $! if sign == (1 :: Word8) then v else - v++--+-- Fold and unfold an Integer to and from a list of its bytes+--+unroll :: Integer -> [Word8]+unroll = unfoldr step+ where+ step 0 = Nothing+ step i = Just (fromIntegral i, i `shiftR` 8)++roll :: [Word8] -> Integer+roll = foldr unstep 0+ where+ unstep b a = a `shiftL` 8 .|. fromIntegral b++{-++--+-- An efficient, raw serialisation for Integer (GHC only)+--++-- TODO This instance is not architecture portable. GMP stores numbers as+-- arrays of machine sized words, so the byte format is not portable across+-- architectures with different endianess and word size.++import Data.ByteString.Base (toForeignPtr,unsafePackAddress, memcpy)+import GHC.Base hiding (ord, chr)+import GHC.Prim+import GHC.Ptr (Ptr(..))+import GHC.IOBase (IO(..))++instance Binary Integer where+ put (S# i) = putWord8 0 >> put (I# i)+ put (J# s ba) = do+ putWord8 1+ put (I# s)+ put (BA ba)++ get = do+ b <- getWord8+ case b of+ 0 -> do (I# i#) <- get+ return (S# i#)+ _ -> do (I# s#) <- get+ (BA a#) <- get+ return (J# s# a#)++instance Binary ByteArray where++ -- Pretty safe.+ put (BA ba) =+ let sz = sizeofByteArray# ba -- (primitive) in *bytes*+ addr = byteArrayContents# ba+ bs = unsafePackAddress (I# sz) addr+ in put bs -- write as a ByteString. easy, yay!++ -- Pretty scary. Should be quick though+ get = do+ (fp, off, n@(I# sz)) <- liftM toForeignPtr get -- so decode a ByteString+ assert (off == 0) $ return $ unsafePerformIO $ do+ (MBA arr) <- newByteArray sz -- and copy it into a ByteArray#+ let to = byteArrayContents# (unsafeCoerce# arr) -- urk, is this safe?+ withForeignPtr fp $ \from -> memcpy (Ptr to) from (fromIntegral n)+ freezeByteArray arr++-- wrapper for ByteArray#+data ByteArray = BA {-# UNPACK #-} !ByteArray#+data MBA = MBA {-# UNPACK #-} !(MutableByteArray# RealWorld)++newByteArray :: Int# -> IO MBA+newByteArray sz = IO $ \s ->+ case newPinnedByteArray# sz s of { (# s', arr #) ->+ (# s', MBA arr #) }++freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray+freezeByteArray arr = IO $ \s ->+ case unsafeFreezeByteArray# arr s of { (# s', arr' #) ->+ (# s', BA arr' #) }++-}++instance (Binary a,Integral a) => Binary (R.Ratio a) where+ put r = put (R.numerator r) >> put (R.denominator r)+ get = liftM2 (R.%) get get++------------------------------------------------------------------------++-- Char is serialised as UTF-8+instance Binary Char where+ put a | c <= 0x7f = put (fromIntegral c :: Word8)+ | c <= 0x7ff = do put (0xc0 .|. y)+ put (0x80 .|. z)+ | c <= 0xffff = do put (0xe0 .|. x)+ put (0x80 .|. y)+ put (0x80 .|. z)+ | c <= 0x10ffff = do put (0xf0 .|. w)+ put (0x80 .|. x)+ put (0x80 .|. y)+ put (0x80 .|. z)+ | otherwise = error "Not a valid Unicode code point"+ where+ c = ord a+ z, y, x, w :: Word8+ z = fromIntegral (c .&. 0x3f)+ y = fromIntegral (shiftR c 6 .&. 0x3f)+ x = fromIntegral (shiftR c 12 .&. 0x3f)+ w = fromIntegral (shiftR c 18 .&. 0x7)++ get = do+ let getByte = liftM (fromIntegral :: Word8 -> Int) get+ shiftL6 = flip shiftL 6 :: Int -> Int+ w <- getByte+ r <- case () of+ _ | w < 0x80 -> return w+ | w < 0xe0 -> do+ x <- liftM (xor 0x80) getByte+ return (x .|. shiftL6 (xor 0xc0 w))+ | w < 0xf0 -> do+ x <- liftM (xor 0x80) getByte+ y <- liftM (xor 0x80) getByte+ return (y .|. shiftL6 (x .|. shiftL6+ (xor 0xe0 w)))+ | otherwise -> do+ x <- liftM (xor 0x80) getByte+ y <- liftM (xor 0x80) getByte+ z <- liftM (xor 0x80) getByte+ return (z .|. shiftL6 (y .|. shiftL6+ (x .|. shiftL6 (xor 0xf0 w))))+ return $! chr r++------------------------------------------------------------------------+-- Instances for the first few tuples++instance (Binary a, Binary b) => Binary (a,b) where+ put (a,b) = put a >> put b+ get = liftM2 (,) get get++instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where+ put (a,b,c) = put a >> put b >> put c+ get = liftM3 (,,) get get get++instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where+ put (a,b,c,d) = put a >> put b >> put c >> put d+ get = liftM4 (,,,) get get get get++instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d,e) where+ put (a,b,c,d,e) = put a >> put b >> put c >> put d >> put e+ get = liftM5 (,,,,) get get get get get++-- +-- and now just recurse:+--++instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f)+ => Binary (a,b,c,d,e,f) where+ put (a,b,c,d,e,f) = put (a,(b,c,d,e,f))+ get = do (a,(b,c,d,e,f)) <- get ; return (a,b,c,d,e,f)++instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g)+ => Binary (a,b,c,d,e,f,g) where+ put (a,b,c,d,e,f,g) = put (a,(b,c,d,e,f,g))+ get = do (a,(b,c,d,e,f,g)) <- get ; return (a,b,c,d,e,f,g)++instance (Binary a, Binary b, Binary c, Binary d, Binary e,+ Binary f, Binary g, Binary h)+ => Binary (a,b,c,d,e,f,g,h) where+ put (a,b,c,d,e,f,g,h) = put (a,(b,c,d,e,f,g,h))+ get = do (a,(b,c,d,e,f,g,h)) <- get ; return (a,b,c,d,e,f,g,h)++instance (Binary a, Binary b, Binary c, Binary d, Binary e,+ Binary f, Binary g, Binary h, Binary i)+ => Binary (a,b,c,d,e,f,g,h,i) where+ put (a,b,c,d,e,f,g,h,i) = put (a,(b,c,d,e,f,g,h,i))+ get = do (a,(b,c,d,e,f,g,h,i)) <- get ; return (a,b,c,d,e,f,g,h,i)++instance (Binary a, Binary b, Binary c, Binary d, Binary e,+ Binary f, Binary g, Binary h, Binary i, Binary j)+ => Binary (a,b,c,d,e,f,g,h,i,j) where+ put (a,b,c,d,e,f,g,h,i,j) = put (a,(b,c,d,e,f,g,h,i,j))+ get = do (a,(b,c,d,e,f,g,h,i,j)) <- get ; return (a,b,c,d,e,f,g,h,i,j)++------------------------------------------------------------------------+-- Container types++instance Binary a => Binary [a] where+ put l = put (length l) >> mapM_ put l+ get = do n <- get :: Get Int+ xs <- replicateM n get+ return xs++instance (Binary a) => Binary (Maybe a) where+ put Nothing = putWord8 0+ put (Just x) = putWord8 1 >> put x+ get = do+ w <- getWord8+ case w of+ 0 -> return Nothing+ _ -> liftM Just get++instance (Binary a, Binary b) => Binary (Either a b) where+ put (Left a) = putWord8 0 >> put a+ put (Right b) = putWord8 1 >> put b+ get = do+ w <- getWord8+ case w of+ 0 -> liftM Left get+ _ -> liftM Right get++------------------------------------------------------------------------+-- ByteStrings (have specially efficient instances)++instance Binary B.ByteString where+ put bs = do put (B.length bs)+ putByteString bs+ get = get >>= getByteString++--+-- Using old versions of fps, this is a type synonym, and non portable+-- +-- Requires 'flexible instances'+--+instance Binary ByteString where+ put bs = do put (fromIntegral (L.length bs) :: Int)+ putLazyByteString bs+ get = get >>= getLazyByteString++------------------------------------------------------------------------+-- Maps and Sets++instance (Ord a, Binary a) => Binary (Set.Set a) where+ put s = put (Set.size s) >> mapM_ put (Set.toAscList s)+ get = liftM Set.fromDistinctAscList get++instance (Ord k, Binary k, Binary e) => Binary (Map.Map k e) where+ put m = put (Map.size m) >> mapM_ put (Map.toAscList m)+ get = liftM Map.fromDistinctAscList get++instance Binary IntSet.IntSet where+ put s = put (IntSet.size s) >> mapM_ put (IntSet.toAscList s)+ get = liftM IntSet.fromDistinctAscList get++instance (Binary e) => Binary (IntMap.IntMap e) where+ put m = put (IntMap.size m) >> mapM_ put (IntMap.toAscList m)+ get = liftM IntMap.fromDistinctAscList get++------------------------------------------------------------------------+-- Queues and Sequences++#if __GLASGOW_HASKELL__ >= 606+--+-- This is valid Hugs, but you need the most recent Hugs+--++instance (Binary e) => Binary (Seq.Seq e) where+ put s = put (Seq.length s) >> Fold.mapM_ put s+ get = do n <- get :: Get Int+ rep Seq.empty n get+ where rep xs 0 _ = return $! xs+ rep xs n g = xs `seq` n `seq` do+ x <- g+ rep (xs Seq.|> x) (n-1) g++#endif++------------------------------------------------------------------------+-- Floating point++-- instance Binary Double where+-- put d = put (decodeFloat d)+-- get = liftM2 encodeFloat get get++instance Binary Double where+ put = putFloat64be+ get = getFloat64be++instance Binary Float where+ put f = put (decodeFloat f)+ get = liftM2 encodeFloat get get++------------------------------------------------------------------------+-- Trees++instance (Binary e) => Binary (T.Tree e) where+ put (T.Node r s) = put r >> put s+ get = liftM2 T.Node get get++------------------------------------------------------------------------+-- Arrays++instance (Binary i, Ix i, Binary e) => Binary (Array i e) where+ put a = do+ put (bounds a)+ put (rangeSize $ bounds a) -- write the length+ mapM_ put (elems a) -- now the elems.+ get = do+ bs <- get+ n <- get -- read the length+ xs <- replicateM n get -- now the elems.+ return (listArray bs xs)++--+-- The IArray UArray e constraint is non portable. Requires flexible instances+--+instance (Binary i, Ix i, Binary e, IArray UArray e) => Binary (UArray i e) where+ put a = do+ put (bounds a)+ put (rangeSize $ bounds a) -- now write the length+ mapM_ put (elems a)+ get = do+ bs <- get+ n <- get+ xs <- replicateM n get+ return (listArray bs xs)
@@ -0,0 +1,434 @@+{-# LANGUAGE CPP, MagicHash #-}+-- for unboxed shifts++-----------------------------------------------------------------------------+-- |+-- Module : Data.Binary.Builder+-- Copyright : Lennart Kolmodin, Ross Paterson+-- License : BSD3-style (see LICENSE)+-- +-- Maintainer : Lennart Kolmodin <kolmodin@dtek.chalmers.se>+-- Stability : experimental+-- Portability : portable to Hugs and GHC+--+-- Efficient construction of lazy bytestrings.+--+-----------------------------------------------------------------------------++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Data.Binary.Builder (++ -- * The Builder type+ Builder+ , toLazyByteString++ -- * Constructing Builders+ , empty+ , singleton+ , append+ , fromByteString -- :: S.ByteString -> Builder+ , fromLazyByteString -- :: L.ByteString -> Builder++ -- * Flushing the buffer state+ , flush++ -- * Derived Builders+ -- ** Big-endian writes+ , putWord16be -- :: Word16 -> Builder+ , putWord32be -- :: Word32 -> Builder+ , putWord64be -- :: Word64 -> Builder++ -- ** Little-endian writes+ , putWord16le -- :: Word16 -> Builder+ , putWord32le -- :: Word32 -> Builder+ , putWord64le -- :: Word64 -> Builder++ -- ** Host-endian, unaligned writes+ , putWordhost -- :: Word -> Builder+ , putWord16host -- :: Word16 -> Builder+ , putWord32host -- :: Word32 -> Builder+ , putWord64host -- :: Word64 -> Builder++ ) where++#if MIN_VERSION_base(4,8,0)+import Prelude hiding (empty)+#endif+import Foreign(Word,Word8,Ptr,Storable,ForeignPtr,withForeignPtr,poke,plusPtr,sizeOf)+import System.IO.Unsafe(unsafePerformIO)+import Data.Monoid+--import Data.Word+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++#ifdef BYTESTRING_IN_BASE+import Data.ByteString.Base (inlinePerformIO)+import qualified Data.ByteString.Base as S+#else+import Data.ByteString.Internal (inlinePerformIO)+import qualified Data.ByteString.Internal as S+--import qualified Data.ByteString.Lazy.Internal as L+#endif++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base(Int(..),uncheckedShiftRL# )+import GHC.Word (Word32(..),Word16(..),Word64(..))++#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608+import GHC.Word (uncheckedShiftRL64#)+#endif+#endif++------------------------------------------------------------------------++-- | A 'Builder' is an efficient way to build lazy 'L.ByteString's.+-- There are several functions for constructing 'Builder's, but only one+-- to inspect them: to extract any data, you have to turn them into lazy+-- 'L.ByteString's using 'toLazyByteString'.+--+-- Internally, a 'Builder' constructs a lazy 'L.Bytestring' by filling byte+-- arrays piece by piece. As each buffer is filled, it is \'popped\'+-- off, to become a new chunk of the resulting lazy 'L.ByteString'.+-- All this is hidden from the user of the 'Builder'.++newtype Builder = Builder {+ -- Invariant (from Data.ByteString.Lazy):+ -- The lists include no null ByteStrings.+ runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]+ }++#if MIN_VERSION_base(4,11,0)+instance Semigroup Builder where+ (<>) = append+#endif++instance Monoid Builder where+ mempty = empty+ {-# INLINE mempty #-}+ mappend = append+ {-# INLINE mappend #-}++------------------------------------------------------------------------++-- | /O(1)./ The empty Builder, satisfying+--+-- * @'toLazyByteString' 'empty' = 'L.empty'@+--+empty :: Builder+empty = Builder id+{-# INLINE empty #-}++-- | /O(1)./ A Builder taking a single byte, satisfying+--+-- * @'toLazyByteString' ('singleton' b) = 'L.singleton' b@+--+singleton :: Word8 -> Builder+singleton = writeN 1 . flip poke+{-# INLINE singleton #-}++------------------------------------------------------------------------++-- | /O(1)./ The concatenation of two Builders, an associative operation+-- with identity 'empty', satisfying+--+-- * @'toLazyByteString' ('append' x y) = 'L.append' ('toLazyByteString' x) ('toLazyByteString' y)@+--+append :: Builder -> Builder -> Builder+append (Builder f) (Builder g) = Builder (f . g)+{-# INLINE append #-}++-- | /O(1)./ A Builder taking a 'S.ByteString', satisfying+--+-- * @'toLazyByteString' ('fromByteString' bs) = 'L.fromChunks' [bs]@+--+fromByteString :: S.ByteString -> Builder+fromByteString bs+ | S.null bs = empty+ | otherwise = flush `append` mapBuilder (bs :)+{-# INLINE fromByteString #-}++-- | /O(1)./ A Builder taking a lazy 'L.ByteString', satisfying+--+-- * @'toLazyByteString' ('fromLazyByteString' bs) = bs@+--+fromLazyByteString :: L.ByteString -> Builder+fromLazyByteString bss = flush `append` mapBuilder (L.toChunks bss ++)+{-# INLINE fromLazyByteString #-}++------------------------------------------------------------------------++-- Our internal buffer type+data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)+ {-# UNPACK #-} !Int -- offset+ {-# UNPACK #-} !Int -- used bytes+ {-# UNPACK #-} !Int -- length left++------------------------------------------------------------------------++-- | /O(n)./ Extract a lazy 'L.ByteString' from a 'Builder'.+-- The construction work takes place if and when the relevant part of+-- the lazy 'L.ByteString' is demanded.+--+toLazyByteString :: Builder -> L.ByteString+toLazyByteString m = L.fromChunks $ unsafePerformIO $ do+ buf <- newBuffer defaultSize+ return (runBuilder (m `append` flush) (const []) buf)++-- | /O(1)./ Pop the 'S.ByteString' we have constructed so far, if any,+-- yielding a new chunk in the result lazy 'L.ByteString'.+flush :: Builder+flush = Builder $ \ k buf@(Buffer p o u l) ->+ if u == 0+ then k buf+ else S.PS p o u : k (Buffer p (o+u) 0 l)++------------------------------------------------------------------------++--+-- copied from Data.ByteString.Lazy+--+defaultSize :: Int+defaultSize = 32 * k - overhead+ where k = 1024+ overhead = 2 * sizeOf (undefined :: Int)++------------------------------------------------------------------------++-- | Sequence an IO operation on the buffer+unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder+unsafeLiftIO f = Builder $ \ k buf -> inlinePerformIO $ do+ buf' <- f buf+ return (k buf')+{-# INLINE unsafeLiftIO #-}++-- | Get the size of the buffer+withSize :: (Int -> Builder) -> Builder+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->+ runBuilder (f l) k buf++-- | Map the resulting list of bytestrings.+mapBuilder :: ([S.ByteString] -> [S.ByteString]) -> Builder+mapBuilder f = Builder (f .)++------------------------------------------------------------------------++-- | Ensure that there are at least @n@ many bytes available.+ensureFree :: Int -> Builder+ensureFree n = n `seq` withSize $ \ l ->+ if n <= l then empty else+ flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize)))+{-# INLINE ensureFree #-}++-- | Ensure that @n@ many bytes are available, and then use @f@ to write some+-- bytes into the memory.+writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder+writeN n f = ensureFree n `append` unsafeLiftIO (writeNBuffer n f)+{-# INLINE writeN #-}++writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer+writeNBuffer n f (Buffer fp o u l) = do+ withForeignPtr fp (\p -> f (p `plusPtr` (o+u)))+ return (Buffer fp o (u+n) (l-n))+{-# INLINE writeNBuffer #-}++newBuffer :: Int -> IO Buffer+newBuffer size = do+ fp <- S.mallocByteString size+ return $! Buffer fp 0 0 size+{-# INLINE newBuffer #-}++------------------------------------------------------------------------+-- Aligned, host order writes of storable values++-- | Ensure that @n@ many bytes are available, and then use @f@ to write some+-- storable values into the memory.+writeNbytes :: Storable a => Int -> (Ptr a -> IO ()) -> Builder+writeNbytes n f = ensureFree n `append` unsafeLiftIO (writeNBufferBytes n f)+{-# INLINE writeNbytes #-}++writeNBufferBytes :: Storable a => Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer+writeNBufferBytes n f (Buffer fp o u l) = do+ withForeignPtr fp (\p -> f (p `plusPtr` (o+u)))+ return (Buffer fp o (u+n) (l-n))+{-# INLINE writeNBufferBytes #-}++------------------------------------------------------------------------++--+-- We rely on the fromIntegral to do the right masking for us.+-- The inlining here is critical, and can be worth 4x performance+--++-- | Write a Word16 in big endian format+putWord16be :: Word16 -> Builder+putWord16be w = writeN 2 $ \p -> do+ poke p (fromIntegral (shiftr_w16 w 8) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (w) :: Word8)+{-# INLINE putWord16be #-}++-- | Write a Word16 in little endian format+putWord16le :: Word16 -> Builder+putWord16le w = writeN 2 $ \p -> do+ poke p (fromIntegral (w) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)+{-# INLINE putWord16le #-}++-- putWord16le w16 = writeN 2 (\p -> poke (castPtr p) w16)++-- | Write a Word32 in big endian format+putWord32be :: Word32 -> Builder+putWord32be w = writeN 4 $ \p -> do+ poke p (fromIntegral (shiftr_w32 w 24) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 8) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (w) :: Word8)+{-# INLINE putWord32be #-}++--+-- a data type to tag Put/Check. writes construct these which are then+-- inlined and flattened. matching Checks will be more robust with rules.+--++-- | Write a Word32 in little endian format+putWord32le :: Word32 -> Builder+putWord32le w = writeN 4 $ \p -> do+ poke p (fromIntegral (w) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 8) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 16) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 w 24) :: Word8)+{-# INLINE putWord32le #-}++-- on a little endian machine:+-- putWord32le w32 = writeN 4 (\p -> poke (castPtr p) w32)++-- | Write a Word64 in big endian format+putWord64be :: Word64 -> Builder+#if WORD_SIZE_IN_BITS < 64+--+-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to+-- Word32, and write that+--+putWord64be w =+ let a = fromIntegral (shiftr_w64 w 32) :: Word32+ b = fromIntegral w :: Word32+ in writeN 8 $ \p -> do+ poke p (fromIntegral (shiftr_w32 a 24) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 8) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (a) :: Word8)+ poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 8) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral (b) :: Word8)+#else+putWord64be w = writeN 8 $ \p -> do+ poke p (fromIntegral (shiftr_w64 w 56) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 48) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 40) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 32) :: Word8)+ poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 24) :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 16) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 8) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral (w) :: Word8)+#endif+{-# INLINE putWord64be #-}++-- | Write a Word64 in little endian format+putWord64le :: Word64 -> Builder++#if WORD_SIZE_IN_BITS < 64+putWord64le w =+ let b = fromIntegral (shiftr_w64 w 32) :: Word32+ a = fromIntegral w :: Word32+ in writeN 8 $ \p -> do+ poke (p) (fromIntegral (a) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 8) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)+ poke (p `plusPtr` 4) (fromIntegral (b) :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 8) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)+#else+putWord64le w = writeN 8 $ \p -> do+ poke p (fromIntegral (w) :: Word8)+ poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 8) :: Word8)+ poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 16) :: Word8)+ poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 24) :: Word8)+ poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 32) :: Word8)+ poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 40) :: Word8)+ poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 48) :: Word8)+ poke (p `plusPtr` 7) (fromIntegral (shiftr_w64 w 56) :: Word8)+#endif+{-# INLINE putWord64le #-}++-- on a little endian machine:+-- putWord64le w64 = writeN 8 (\p -> poke (castPtr p) w64)++------------------------------------------------------------------------+-- Unaligned, word size ops++-- | /O(1)./ A Builder taking a single native machine word. The word is+-- written in host order, host endian form, for the machine you're on.+-- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine,+-- 4 bytes. Values written this way are not portable to+-- different endian or word sized machines, without conversion.+--+putWordhost :: Word -> Builder+putWordhost w = writeNbytes (sizeOf (undefined :: Word)) (\p -> poke p w)+{-# INLINE putWordhost #-}++-- | Write a Word16 in native host order and host endianness.+-- 2 bytes will be written, unaligned.+putWord16host :: Word16 -> Builder+putWord16host w16 = writeNbytes (sizeOf (undefined :: Word16)) (\p -> poke p w16)+{-# INLINE putWord16host #-}++-- | Write a Word32 in native host order and host endianness.+-- 4 bytes will be written, unaligned.+putWord32host :: Word32 -> Builder+putWord32host w32 = writeNbytes (sizeOf (undefined :: Word32)) (\p -> poke p w32)+{-# INLINE putWord32host #-}++-- | Write a Word64 in native host order.+-- On a 32 bit machine we write two host order Word32s, in big endian form.+-- 8 bytes will be written, unaligned.+putWord64host :: Word64 -> Builder+putWord64host w = writeNbytes (sizeOf (undefined :: Word64)) (\p -> poke p w)+{-# INLINE putWord64host #-}++------------------------------------------------------------------------+-- Unchecked shifts++{-# INLINE shiftr_w16 #-}+shiftr_w16 :: Word16 -> Int -> Word16+{-# INLINE shiftr_w32 #-}+shiftr_w32 :: Word32 -> Int -> Word32+{-# INLINE shiftr_w64 #-}+shiftr_w64 :: Word64 -> Int -> Word64++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)++#if WORD_SIZE_IN_BITS < 64+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)++#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftRL64"+ uncheckedShiftRL64# :: Word64# -> Int# -> Word64#+#endif++#else+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)+#endif++#else+shiftr_w16 = shiftR+shiftr_w32 = shiftR+shiftr_w64 = shiftR+#endif
@@ -0,0 +1,544 @@+{-# LANGUAGE CPP, MagicHash #-}+-- for unboxed shifts++-----------------------------------------------------------------------------+-- |+-- Module : Data.Binary.Get+-- Copyright : Lennart Kolmodin+-- License : BSD3-style (see LICENSE)+-- +-- Maintainer : Lennart Kolmodin <kolmodin@dtek.chalmers.se>+-- Stability : experimental+-- Portability : portable to Hugs and GHC.+--+-- The Get monad. A monad for efficiently building structures from+-- encoded lazy ByteStrings+--+-----------------------------------------------------------------------------++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Data.Binary.Get (++ -- * The Get type+ Get+ , runGet+ , runGetState++ -- * Parsing+ , skip+ , uncheckedSkip+ , lookAhead+ , lookAheadM+ , lookAheadE+ , uncheckedLookAhead++ -- * Utility+ , bytesRead+ , getBytes+ , remaining+ , isEmpty++ -- * Parsing particular types+ , getWord8++ -- ** ByteStrings+ , getByteString+ , getLazyByteString+ , getLazyByteStringNul+ , getRemainingLazyByteString++ -- ** Big-endian reads+ , getWord16be+ , getWord32be+ , getWord64be++ -- ** Little-endian reads+ , getWord16le+ , getWord32le+ , getWord64le++ -- ** Host-endian, unaligned reads+ , getWordhost+ , getWord16host+ , getWord32host+ , getWord64host++ ) where++import Control.Monad (when,liftM, ap)+import Control.Monad.Fix+import Data.Maybe (isNothing)++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++#ifdef BYTESTRING_IN_BASE+import qualified Data.ByteString.Base as B+#else+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Lazy.Internal as L+#endif++import Control.Applicative (Applicative(..))++import Foreign++-- used by splitAtST+#if MIN_VERSION_base(4,6,0)+import Control.Monad.ST.Unsafe(unsafeInterleaveST)+#else+import Control.Monad.ST(unsafeInterleaveST)+#endif+import Control.Monad.ST(runST)+import Data.STRef++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base+import GHC.Word+--import GHC.Int+#endif++-- | The parse state+data S = S {-# UNPACK #-} !B.ByteString -- current chunk+ L.ByteString -- the rest of the input+ {-# UNPACK #-} !Int64 -- bytes read++-- | The Get monad is just a State monad carrying around the input ByteString+newtype Get a = Get { unGet :: S -> (a, S) }++instance Functor Get where+ fmap f m = Get (\s -> case unGet m s of+ (a, s') -> (f a, s'))+ {-# INLINE fmap #-}++instance Applicative Get where+ pure = return+ (<*>) = ap++instance Monad Get where+ return a = Get (\s -> (a, s))+ {-# INLINE return #-}++ m >>= k = Get (\s -> case unGet m s of+ (a, s') -> unGet (k a) s')+ {-# INLINE (>>=) #-}++ fail = failDesc++instance MonadFix Get where+ mfix f = Get (\s -> let (a,s') = unGet (f a) s + in (a,s'))++------------------------------------------------------------------------++get :: Get S+get = Get (\s -> (s, s))++put :: S -> Get ()+put s = Get (\_ -> ((), s))++------------------------------------------------------------------------+--+-- dons, GHC 6.10: explicit inlining disabled, was killing performance.+-- Without it, GHC seems to do just fine. And we get similar+-- performance with 6.8.2 anyway.+--++initState :: L.ByteString -> S+initState xs = mkState xs 0+{- INLINE initState -}++{-+initState (B.LPS xs) =+ case xs of+ [] -> S B.empty L.empty 0+ (x:xs') -> S x (B.LPS xs') 0+-}++#ifndef BYTESTRING_IN_BASE+mkState :: L.ByteString -> Int64 -> S+mkState l = case l of+ L.Empty -> S B.empty L.empty+ L.Chunk x xs -> S x xs+{- INLINE mkState -}++#else+mkState :: L.ByteString -> Int64 -> S+mkState (B.LPS xs) =+ case xs of+ [] -> S B.empty L.empty+ (x:xs') -> S x (B.LPS xs')+#endif++-- | Run the Get monad applies a 'get'-based parser on the input ByteString+runGet :: Get a -> L.ByteString -> a+runGet m str = case unGet m (initState str) of (a, _) -> a++-- | Run the Get monad applies a 'get'-based parser on the input+-- ByteString. Additional to the result of get it returns the number of+-- consumed bytes and the rest of the input.+runGetState :: Get a -> L.ByteString -> Int64 -> (a, L.ByteString, Int64)+runGetState m str off =+ case unGet m (mkState str off) of+ (a, ~(S s ss newOff)) -> (a, s `joinBS` ss, newOff)++------------------------------------------------------------------------++failDesc :: String -> Get a+failDesc err = do+ S _ _ bytes <- get+ Get (error (err ++ ". Failed reading at byte position " ++ show bytes))++-- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.+skip :: Int -> Get ()+skip n = readN (fromIntegral n) (const ())++-- | Skip ahead @n@ bytes. No error if there isn't enough bytes.+uncheckedSkip :: Int64 -> Get ()+uncheckedSkip n = do+ S s ss bytes <- get+ if fromIntegral (B.length s) >= n+ then put (S (B.drop (fromIntegral n) s) ss (bytes + n))+ else do+ let rest = L.drop (n - fromIntegral (B.length s)) ss+ put $! mkState rest (bytes + n)++-- | Run @ga@, but return without consuming its input.+-- Fails if @ga@ fails.+lookAhead :: Get a -> Get a+lookAhead ga = do+ s <- get+ a <- ga+ put s+ return a++-- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'.+-- Fails if @gma@ fails.+lookAheadM :: Get (Maybe a) -> Get (Maybe a)+lookAheadM gma = do+ s <- get+ ma <- gma+ when (isNothing ma) $+ put s+ return ma++-- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'.+-- Fails if @gea@ fails.+lookAheadE :: Get (Either a b) -> Get (Either a b)+lookAheadE gea = do+ s <- get+ ea <- gea+ case ea of+ Left _ -> put s+ _ -> return ()+ return ea++-- | Get the next up to @n@ bytes as a lazy ByteString, without consuming them. +uncheckedLookAhead :: Int64 -> Get L.ByteString+uncheckedLookAhead n = do+ S s ss _ <- get+ if n <= fromIntegral (B.length s)+ then return (L.fromChunks [B.take (fromIntegral n) s])+ else return $ L.take n (s `joinBS` ss)++------------------------------------------------------------------------+-- Utility++-- | Get the total number of bytes read to this point.+bytesRead :: Get Int64+bytesRead = do+ S _ _ b <- get+ return b++-- | Get the number of remaining unparsed bytes.+-- Useful for checking whether all input has been consumed.+-- Note that this forces the rest of the input.+remaining :: Get Int64+remaining = do+ S s ss _ <- get+ return (fromIntegral (B.length s) + L.length ss)++-- | Test whether all input has been consumed,+-- i.e. there are no remaining unparsed bytes.+isEmpty :: Get Bool+isEmpty = do+ S s ss _ <- get+ return (B.null s && L.null ss)++------------------------------------------------------------------------+-- Utility with ByteStrings++-- | An efficient 'get' method for strict ByteStrings. Fails if fewer+-- than @n@ bytes are left in the input.+getByteString :: Int -> Get B.ByteString+getByteString n = readN n id+{-# INLINE getByteString #-}++-- | An efficient 'get' method for lazy ByteStrings. Does not fail if fewer than+-- @n@ bytes are left in the input.+getLazyByteString :: Int64 -> Get L.ByteString+getLazyByteString n = do+ S s ss bytes <- get+ let big = s `joinBS` ss+ case splitAtST n big of+ (consume, rest) -> do put $ mkState rest (bytes + n)+ return consume+{-# INLINE getLazyByteString #-}++-- | Get a lazy ByteString that is terminated with a NUL byte. Fails+-- if it reaches the end of input without hitting a NUL.+getLazyByteStringNul :: Get L.ByteString+getLazyByteStringNul = do+ S s ss bytes <- get+ let big = s `joinBS` ss+ (consume, t) = L.break (== 0) big+ (h, rest) = L.splitAt 1 t+ if L.null h+ then fail "too few bytes"+ else do+ put $ mkState rest (bytes + L.length consume + 1)+ return consume+{-# INLINE getLazyByteStringNul #-}++-- | Get the remaining bytes as a lazy ByteString+getRemainingLazyByteString :: Get L.ByteString+getRemainingLazyByteString = do+ S s ss _ <- get+ return (s `joinBS` ss)++------------------------------------------------------------------------+-- Helpers++-- | Pull @n@ bytes from the input, as a strict ByteString.+getBytes :: Int -> Get B.ByteString+getBytes n = do+ S s ss bytes <- get+ if n <= B.length s+ then do let (consume,rest) = B.splitAt n s+ put $! S rest ss (bytes + fromIntegral n)+ return $! consume+ else+ case L.splitAt (fromIntegral n) (s `joinBS` ss) of+ (consuming, rest) ->+ do let now = B.concat . L.toChunks $ consuming+ put $! mkState rest (bytes + fromIntegral n)+ -- forces the next chunk before this one is returned+ if (B.length now < n)+ then+ fail "too few bytes"+ else+ return now+{- INLINE getBytes -}+-- ^ important++#ifndef BYTESTRING_IN_BASE+joinBS :: B.ByteString -> L.ByteString -> L.ByteString+joinBS bb lb+ | B.null bb = lb+ | otherwise = L.Chunk bb lb++#else+joinBS :: B.ByteString -> L.ByteString -> L.ByteString+joinBS bb (B.LPS lb)+ | B.null bb = B.LPS lb+ | otherwise = B.LPS (bb:lb)+#endif+ -- don't use L.append, it's strict in it's second argument :/+{- INLINE joinBS -}++-- | Split a ByteString. If the first result is consumed before the --+-- second, this runs in constant heap space.+--+-- You must force the returned tuple for that to work, e.g.+-- +-- > case splitAtST n xs of+-- > (ys,zs) -> consume ys ... consume zs+--+splitAtST :: Int64 -> L.ByteString -> (L.ByteString, L.ByteString)+splitAtST i ps | i <= 0 = (L.empty, ps)+#ifndef BYTESTRING_IN_BASE+splitAtST i ps = runST (+ do r <- newSTRef undefined+ xs <- first r i ps+ ys <- unsafeInterleaveST (readSTRef r)+ return (xs, ys))++ where+ first r 0 xs@(L.Chunk _ _) = writeSTRef r xs >> return L.Empty+ first r _ L.Empty = writeSTRef r L.Empty >> return L.Empty++ first r n (L.Chunk x xs)+ | n < l = do writeSTRef r (L.Chunk (B.drop (fromIntegral n) x) xs)+ return $ L.Chunk (B.take (fromIntegral n) x) L.Empty+ | otherwise = do writeSTRef r (L.drop (n - l) xs)+ liftM (L.Chunk x) $ unsafeInterleaveST (first r (n - l) xs)++ where l = fromIntegral (B.length x)+#else+splitAtST i (B.LPS ps) = runST (+ do r <- newSTRef undefined+ xs <- first r i ps+ ys <- unsafeInterleaveST (readSTRef r)+ return (B.LPS xs, B.LPS ys))++ where first r 0 xs = writeSTRef r xs >> return []+ first r _ [] = writeSTRef r [] >> return []+ first r n (x:xs)+ | n < l = do writeSTRef r (B.drop (fromIntegral n) x : xs)+ return [B.take (fromIntegral n) x]+ | otherwise = do writeSTRef r (L.toChunks (L.drop (n - l) (B.LPS xs)))+ fmap (x:) $ unsafeInterleaveST (first r (n - l) xs)++ where l = fromIntegral (B.length x)+#endif+{- INLINE splitAtST -}++-- Pull n bytes from the input, and apply a parser to those bytes,+-- yielding a value. If less than @n@ bytes are available, fail with an+-- error. This wraps @getBytes@.+readN :: Int -> (B.ByteString -> a) -> Get a+readN n f = fmap f $ getBytes n+{- INLINE readN -}+-- ^ important++------------------------------------------------------------------------+-- Primtives++-- helper, get a raw Ptr onto a strict ByteString copied out of the+-- underlying lazy byteString. So many indirections from the raw parser+-- state that my head hurts...++getPtr :: Storable a => Int -> Get a+getPtr n = do+ (fp,o,_) <- readN n B.toForeignPtr+ return . B.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)+{- INLINE getPtr -}++------------------------------------------------------------------------++-- | Read a Word8 from the monad state+getWord8 :: Get Word8+getWord8 = getPtr (sizeOf (undefined :: Word8))+{- INLINE getWord8 -}++-- | Read a Word16 in big endian format+getWord16be :: Get Word16+getWord16be = do+ s <- readN 2 id+ return $! (fromIntegral (s `B.index` 0) `shiftl_w16` 8) .|.+ (fromIntegral (s `B.index` 1))+{- INLINE getWord16be -}++-- | Read a Word16 in little endian format+getWord16le :: Get Word16+getWord16le = do+ s <- readN 2 id+ return $! (fromIntegral (s `B.index` 1) `shiftl_w16` 8) .|.+ (fromIntegral (s `B.index` 0) )+{- INLINE getWord16le -}++-- | Read a Word32 in big endian format+getWord32be :: Get Word32+getWord32be = do+ s <- readN 4 id+ return $! (fromIntegral (s `B.index` 0) `shiftl_w32` 24) .|.+ (fromIntegral (s `B.index` 1) `shiftl_w32` 16) .|.+ (fromIntegral (s `B.index` 2) `shiftl_w32` 8) .|.+ (fromIntegral (s `B.index` 3) )+{- INLINE getWord32be -}++-- | Read a Word32 in little endian format+getWord32le :: Get Word32+getWord32le = do+ s <- readN 4 id+ return $! (fromIntegral (s `B.index` 3) `shiftl_w32` 24) .|.+ (fromIntegral (s `B.index` 2) `shiftl_w32` 16) .|.+ (fromIntegral (s `B.index` 1) `shiftl_w32` 8) .|.+ (fromIntegral (s `B.index` 0) )+{- INLINE getWord32le -}++-- | Read a Word64 in big endian format+getWord64be :: Get Word64+getWord64be = do+ s <- readN 8 id+ return $! (fromIntegral (s `B.index` 0) `shiftl_w64` 56) .|.+ (fromIntegral (s `B.index` 1) `shiftl_w64` 48) .|.+ (fromIntegral (s `B.index` 2) `shiftl_w64` 40) .|.+ (fromIntegral (s `B.index` 3) `shiftl_w64` 32) .|.+ (fromIntegral (s `B.index` 4) `shiftl_w64` 24) .|.+ (fromIntegral (s `B.index` 5) `shiftl_w64` 16) .|.+ (fromIntegral (s `B.index` 6) `shiftl_w64` 8) .|.+ (fromIntegral (s `B.index` 7) )+{- INLINE getWord64be -}++-- | Read a Word64 in little endian format+getWord64le :: Get Word64+getWord64le = do+ s <- readN 8 id+ return $! (fromIntegral (s `B.index` 7) `shiftl_w64` 56) .|.+ (fromIntegral (s `B.index` 6) `shiftl_w64` 48) .|.+ (fromIntegral (s `B.index` 5) `shiftl_w64` 40) .|.+ (fromIntegral (s `B.index` 4) `shiftl_w64` 32) .|.+ (fromIntegral (s `B.index` 3) `shiftl_w64` 24) .|.+ (fromIntegral (s `B.index` 2) `shiftl_w64` 16) .|.+ (fromIntegral (s `B.index` 1) `shiftl_w64` 8) .|.+ (fromIntegral (s `B.index` 0) )+{- INLINE getWord64le -}++------------------------------------------------------------------------+-- Host-endian reads++-- | /O(1)./ Read a single native machine word. The word is read in+-- host order, host endian form, for the machine you're on. On a 64 bit+-- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.+getWordhost :: Get Word+getWordhost = getPtr (sizeOf (undefined :: Word))+{- INLINE getWordhost -}++-- | /O(1)./ Read a 2 byte Word16 in native host order and host endianness.+getWord16host :: Get Word16+getWord16host = getPtr (sizeOf (undefined :: Word16))+{- INLINE getWord16host -}++-- | /O(1)./ Read a Word32 in native host order and host endianness.+getWord32host :: Get Word32+getWord32host = getPtr (sizeOf (undefined :: Word32))+{- INLINE getWord32host -}++-- | /O(1)./ Read a Word64 in native host order and host endianess.+getWord64host :: Get Word64+getWord64host = getPtr (sizeOf (undefined :: Word64))+{- INLINE getWord64host -}++------------------------------------------------------------------------+-- Unchecked shifts++shiftl_w16 :: Word16 -> Int -> Word16+shiftl_w32 :: Word32 -> Int -> Word32+shiftl_w64 :: Word64 -> Int -> Word64++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)+shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)++#if WORD_SIZE_IN_BITS < 64+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)++#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftL64"+ uncheckedShiftL64# :: Word64# -> Int# -> Word64#+#endif++#else+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)+#endif++#else+shiftl_w16 = shiftL+shiftl_w32 = shiftL+shiftl_w64 = shiftL+#endif
@@ -0,0 +1,402 @@+% Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+% +% This program is free software: you can redistribute it and/or modify+% it under the terms of the GNU General Public License as published by+% the Free Software Foundation, either version 3 of the License, or+% any later version.+% +% This program is distributed in the hope that it will be useful,+% but WITHOUT ANY WARRANTY; without even the implied warranty of+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+% GNU General Public License for more details.+% +% You should have received a copy of the GNU General Public License+% along with this program. If not, see <http://www.gnu.org/licenses/>.++\ignore{+\begin{code}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Data.Binary.IEEE754 (+ -- * Parsing+ getFloat16be, getFloat16le+ , getFloat32be, getFloat32le+ , getFloat64be, getFloat64le++ -- * Serializing+ , putFloat32be, putFloat32le+ , putFloat64be, putFloat64le+) where++import Data.Bits ((.&.), (.|.), shiftL, shiftR, Bits)+import Data.Word (Word8)+import Data.List (foldl')++import qualified Data.ByteString as B+import Data.Binary.Get (Get, getByteString)+import Data.Binary.Put (Put, putByteString)+\end{code}+}++\section{Parsing}++\subsection{Public interface}++\begin{code}+getFloat16be :: Get Float+getFloat16be = getFloat (ByteCount 2) splitBytes+\end{code}++\begin{code}+getFloat16le :: Get Float+getFloat16le = getFloat (ByteCount 2) $ splitBytes . reverse+\end{code}++\begin{code}+getFloat32be :: Get Float+getFloat32be = getFloat (ByteCount 4) splitBytes+\end{code}++\begin{code}+getFloat32le :: Get Float+getFloat32le = getFloat (ByteCount 4) $ splitBytes . reverse+\end{code}++\begin{code}+getFloat64be :: Get Double+getFloat64be = getFloat (ByteCount 8) splitBytes+\end{code}++\begin{code}+getFloat64le :: Get Double+getFloat64le = getFloat (ByteCount 8) $ splitBytes . reverse+\end{code}++\subsection{Implementation}++Split the raw byte array into (sign, exponent, significand) components.+The exponent and signifcand are drawn directly from the bits in the+original float, and have not been unbiased or otherwise modified.++\begin{code}+splitBytes :: [Word8] -> RawFloat+splitBytes bs = RawFloat width sign exp' sig expWidth sigWidth where+ width = ByteCount (length bs)+ nBits = bitsInWord8 bs+ sign = if head bs .&. 0x80 == 0x80+ then Negative+ else Positive++ expStart = 1+ expWidth = exponentWidth nBits+ expEnd = expStart + expWidth+ exp' = Exponent . fromIntegral $ bitSlice bs expStart expEnd++ sigWidth = nBits - expEnd+ sig = Significand $ bitSlice bs expEnd nBits+\end{code}++\subsubsection{Encodings and special values}++The next step depends on the value of the exponent $e$, size of the+exponent field in bits $w$, and value of the significand.++\begin{table}[h]+\begin{center}+\begin{tabular}{lrl}+\toprule+Exponent & Significand & Format \\+\midrule+$0$ & $0$ & Zero \\+$0$ & $> 0$ & Denormalised \\+$1 \leq e \leq 2^w - 2$ & \textit{any} & Normalised \\+$2^w-1$ & $0$ & Infinity \\+$2^w-1$ & $> 0$ & NaN \\+\bottomrule+\end{tabular}+\end{center}+\end{table}++There's no built-in literals for Infinity or NaN, so they+are constructed using the {\tt Read} instances for {\tt Double} and+{\tt Float}.++\begin{code}+merge :: (Read a, RealFloat a) => RawFloat -> a+merge f@(RawFloat _ _ e sig eWidth _)+ | e == 0 = if sig == 0+ then 0.0+ else denormalised f+ | e == eMax - 1 = if sig == 0+ then read "Infinity"+ else read "NaN"+ | otherwise = normalised f+ where eMax = 2 `pow` eWidth+\end{code}++If a value is normalised, its significand has an implied {\tt 1} bit+in its most-significant bit. The significand must be adjusted by+this value before being passed to {\tt encodeField}.++\begin{code}+normalised :: RealFloat a => RawFloat -> a+normalised f = encodeFloat fraction exp' where+ Significand sig = rawSignificand f+ Exponent exp' = unbiased - sigWidth++ fraction = sig + (1 `bitShiftL` rawSignificandWidth f)++ sigWidth = fromIntegral $ rawSignificandWidth f+ unbiased = unbias (rawExponent f) (rawExponentWidth f)+\end{code}++For denormalised values, the implied {\tt 1} bit is the least-significant+bit of the exponent.++\begin{code}+denormalised :: RealFloat a => RawFloat -> a+denormalised f = encodeFloat sig exp' where+ Significand sig = rawSignificand f+ Exponent exp' = unbiased - sigWidth + 1++ sigWidth = fromIntegral $ rawSignificandWidth f+ unbiased = unbias (rawExponent f) (rawExponentWidth f)+\end{code}++By composing {\tt splitBytes} and {\tt merge}, the absolute value of the+float is calculated. Before being returned to the calling function, it+must be signed appropriately.++\begin{code}+getFloat :: (Read a, RealFloat a) => ByteCount+ -> ([Word8] -> RawFloat) -> Get a+getFloat (ByteCount width) parser = do+ raw <- fmap (parser . B.unpack) $ getByteString width+ let absFloat = merge raw+ return $ case rawSign raw of+ Positive -> absFloat+ Negative -> -absFloat+\end{code}++\section{Serialising}++\subsection{Public interface}++\begin{code}+putFloat32be :: Float -> Put+putFloat32be = putFloat (ByteCount 4) id+\end{code}++\begin{code}+putFloat32le :: Float -> Put+putFloat32le = putFloat (ByteCount 4) reverse+\end{code}++\begin{code}+putFloat64be :: Double -> Put+putFloat64be = putFloat (ByteCount 8) id+\end{code}++\begin{code}+putFloat64le :: Double -> Put+putFloat64le = putFloat (ByteCount 8) reverse+\end{code}++\subsection{Implementation}++Serialisation is similar to parsing. First, the float is converted to+a structure representing raw bitfields. The values returned from+{\tt decodeFloat} are clamped to their expected lengths before being+stored in the {\tt RawFloat}.++\begin{code}+splitFloat :: RealFloat a => ByteCount -> a -> RawFloat+splitFloat width x = raw where+ raw = RawFloat width sign clampedExp clampedSig expWidth sigWidth+ sign = if isNegativeNaN x || isNegativeZero x || x < 0+ then Negative+ else Positive+ clampedExp = clamp expWidth exp'+ clampedSig = clamp sigWidth sig+ (exp', sig) = case (dFraction, dExponent, biasedExp) of+ (0, 0, _) -> (0, 0)+ (_, _, 0) -> (0, Significand $ truncatedSig + 1)+ _ -> (biasedExp, Significand truncatedSig)+ expWidth = exponentWidth $ bitCount width+ sigWidth = bitCount width - expWidth - 1 -- 1 for sign bit++ (dFraction, dExponent) = decodeFloat x++ rawExp = Exponent $ dExponent + fromIntegral sigWidth+ biasedExp = bias rawExp expWidth+ truncatedSig = abs dFraction - (1 `bitShiftL` sigWidth)+\end{code}++Then, the {\tt RawFloat} is converted to a list of bytes by mashing all+the fields together into an {\tt Integer}, and chopping up that integer+in 8-bit blocks.++\begin{code}+rawToBytes :: RawFloat -> [Word8]+rawToBytes raw = integerToBytes mashed width where+ RawFloat width sign exp' sig expWidth sigWidth = raw+ sign' :: Word8+ sign' = case sign of+ Positive -> 0+ Negative -> 1+ mashed = mashBits sig sigWidth .+ mashBits exp' expWidth .+ mashBits sign' 1 $ 0+\end{code}++{\tt clamp}, given a maximum bit count and a value, will strip any 1-bits+in positions above the count.++\begin{code}+clamp :: (Num a, Bits a) => BitCount -> a -> a+clamp = (.&.) . mask where+ mask 1 = 1+ mask n | n > 1 = (mask (n - 1) `shiftL` 1) + 1+ mask _ = undefined+\end{code}++For merging the fields, just shift the starting integer over a bit and+then \textsc{or} it with the next value. The weird parameter order allows+easy composition.++\begin{code}+mashBits :: (Bits a, Integral a) => a -> BitCount -> Integer -> Integer+mashBits _ 0 x = x+mashBits y n x = (x `bitShiftL` n) .|. fromIntegral y+\end{code}++Given an integer, read it in 255-block increments starting from the LSB.+Each increment is converted to a byte and added to the final list.++\begin{code}+integerToBytes :: Integer -> ByteCount -> [Word8]+integerToBytes _ 0 = []+integerToBytes x n = bytes where+ bytes = integerToBytes (x `shiftR` 8) (n - 1) ++ [step]+ step = fromIntegral x .&. 0xFF+\end{code}++Finally, the raw parsing is wrapped up in {\tt Put}. The second parameter+allows the same code paths to be used for little- and big-endian+serialisation.++\begin{code}+putFloat :: (RealFloat a) => ByteCount -> ([Word8] -> [Word8]) -> a -> Put+putFloat width f x = putByteString $ B.pack bytes where+ bytes = f . rawToBytes . splitFloat width $ x+\end{code}++\section{Raw float components}++Information about the raw bit patterns in the float is stored in+{\tt RawFloat}, so they don't have to be passed around to the various+format cases. The exponent should be biased, and the significand+shouldn't have it's implied MSB (if applicable).++\begin{code}+data RawFloat = RawFloat+ { rawWidth :: ByteCount+ , rawSign :: Sign+ , rawExponent :: Exponent+ , rawSignificand :: Significand+ , rawExponentWidth :: BitCount+ , rawSignificandWidth :: BitCount+ }+ deriving (Show)+\end{code}++\section{Exponents}++Calculate the proper size of the exponent field, in bits, given the+size of the full structure.++\begin{code}+exponentWidth :: BitCount -> BitCount+exponentWidth k+ | k == 16 = 5+ | k == 32 = 8+ | k `mod` 32 == 0 = ceiling (4 * logBase 2 (fromIntegral k)) - 13+ | otherwise = error "Invalid length of floating-point value"+\end{code}++\begin{code}+bias :: Exponent -> BitCount -> Exponent+bias e eWidth = e - (1 - (2 `pow` (eWidth - 1)))+\end{code}++\begin{code}+unbias :: Exponent -> BitCount -> Exponent+unbias e eWidth = e + 1 - (2 `pow` (eWidth - 1))+\end{code}++\section{Byte and bit counting}++\begin{code}+data Sign = Positive | Negative+ deriving (Show)++newtype Exponent = Exponent Int+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral, Bits)++newtype Significand = Significand Integer+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral, Bits)++newtype BitCount = BitCount Int+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral)++newtype ByteCount = ByteCount Int+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral)++bitCount :: ByteCount -> BitCount+bitCount (ByteCount x) = BitCount (x * 8)++bitsInWord8 :: [Word8] -> BitCount+bitsInWord8 = bitCount . ByteCount . length++bitShiftL :: (Bits a) => a -> BitCount -> a+bitShiftL x (BitCount n) = shiftL x n++bitShiftR :: (Bits a) => a -> BitCount -> a+bitShiftR x (BitCount n) = shiftR x n+\end{code}++\section{Utility}++Considering a byte list as a sequence of bits, slice it from start+inclusive to end exclusive, and return the resulting bit sequence as an+integer.++\begin{code}+bitSlice :: [Word8] -> BitCount -> BitCount -> Integer+bitSlice bs = sliceInt (foldl' step 0 bs) bitCount' where+ step acc w = shiftL acc 8 + fromIntegral w+ bitCount' = bitsInWord8 bs+\end{code}++Slice a single integer by start and end bit location++\begin{code}+sliceInt :: Integer -> BitCount -> BitCount -> BitCount -> Integer+sliceInt x xBitCount s e = fromIntegral sliced where+ sliced = (x .&. startMask) `bitShiftR` (xBitCount - e)+ startMask = n1Bits (xBitCount - s)+ n1Bits n = (2 `pow` n) - 1+\end{code}++Integral version of {\tt (**)}++\begin{code}+pow :: (Integral a, Integral b, Integral c) => a -> b -> c+pow b e = floor $ fromIntegral b ** fromIntegral e+\end{code}++Detect whether a float is {\tt $-$NaN}++\begin{code}+isNegativeNaN :: RealFloat a => a -> Bool+isNegativeNaN x = isNaN x && (floor x > 0)+\end{code}
@@ -0,0 +1,210 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Binary.Put+-- Copyright : Lennart Kolmodin+-- License : BSD3-style (see LICENSE)+-- +-- Maintainer : Lennart Kolmodin <kolmodin@dtek.chalmers.se>+-- Stability : stable+-- Portability : Portable to Hugs and GHC. Requires MPTCs+--+-- The Put monad. A monad for efficiently constructing lazy bytestrings.+--+-----------------------------------------------------------------------------++module Data.Binary.Put (++ -- * The Put type+ Put+ , PutM(..)+ , runPut+ , runPutM+ , putBuilder+ , execPut++ -- * Flushing the implicit parse state+ , flush++ -- * Primitives+ , putWord8+ , putByteString+ , putLazyByteString++ -- * Big-endian primitives+ , putWord16be+ , putWord32be+ , putWord64be++ -- * Little-endian primitives+ , putWord16le+ , putWord32le+ , putWord64le++ -- * Host-endian, unaligned writes+ , putWordhost -- :: Word -> Put+ , putWord16host -- :: Word16 -> Put+ , putWord32host -- :: Word32 -> Put+ , putWord64host -- :: Word64 -> Put++ ) where++import Data.Monoid+import Data.Binary.Builder (Builder, toLazyByteString)+import qualified Data.Binary.Builder as B++import Data.Word+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import Control.Applicative+++------------------------------------------------------------------------++-- XXX Strict in buffer only. +data PairS a = PairS a {-UNPACK-}!Builder++sndS :: PairS a -> Builder+sndS (PairS _ b) = b++-- | The PutM type. A Writer monad over the efficient Builder monoid.+newtype PutM a = Put { unPut :: PairS a }++-- | Put merely lifts Builder into a Writer monad, applied to ().+type Put = PutM ()++instance Functor PutM where+ fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w+ {-# INLINE fmap #-}++instance Applicative PutM where+ pure = return+ m <*> k = Put $+ let PairS f w = unPut m+ PairS x w' = unPut k+ in PairS (f x) (w `mappend` w')++-- Standard Writer monad, with aggressive inlining+instance Monad PutM where+ return a = Put $ PairS a mempty+ {-# INLINE return #-}++ m >>= k = Put $+ let PairS a w = unPut m+ PairS b w' = unPut (k a)+ in PairS b (w `mappend` w')+ {-# INLINE (>>=) #-}++ m >> k = Put $+ let PairS _ w = unPut m+ PairS b w' = unPut k+ in PairS b (w `mappend` w')+ {-# INLINE (>>) #-}++tell :: Builder -> Put+tell b = Put $ PairS () b+{-# INLINE tell #-}++putBuilder :: Builder -> Put+putBuilder = tell+{-# INLINE putBuilder #-}++-- | Run the 'Put' monad+execPut :: PutM a -> Builder+execPut = sndS . unPut+{-# INLINE execPut #-}++-- | Run the 'Put' monad with a serialiser+runPut :: Put -> L.ByteString+runPut = toLazyByteString . sndS . unPut+{-# INLINE runPut #-}++-- | Run the 'Put' monad with a serialiser and get its result+runPutM :: PutM a -> (a, L.ByteString)+runPutM (Put (PairS f s)) = (f, toLazyByteString s)+{-# INLINE runPutM #-}++------------------------------------------------------------------------++-- | Pop the ByteString we have constructed so far, if any, yielding a+-- new chunk in the result ByteString.+flush :: Put+flush = tell B.flush+{-# INLINE flush #-}++-- | Efficiently write a byte into the output buffer+putWord8 :: Word8 -> Put+putWord8 = tell . B.singleton+{-# INLINE putWord8 #-}++-- | An efficient primitive to write a strict ByteString into the output buffer.+-- It flushes the current buffer, and writes the argument into a new chunk.+putByteString :: S.ByteString -> Put+putByteString = tell . B.fromByteString+{-# INLINE putByteString #-}++-- | Write a lazy ByteString efficiently, simply appending the lazy+-- ByteString chunks to the output buffer+putLazyByteString :: L.ByteString -> Put+putLazyByteString = tell . B.fromLazyByteString+{-# INLINE putLazyByteString #-}++-- | Write a Word16 in big endian format+putWord16be :: Word16 -> Put+putWord16be = tell . B.putWord16be+{-# INLINE putWord16be #-}++-- | Write a Word16 in little endian format+putWord16le :: Word16 -> Put+putWord16le = tell . B.putWord16le+{-# INLINE putWord16le #-}++-- | Write a Word32 in big endian format+putWord32be :: Word32 -> Put+putWord32be = tell . B.putWord32be+{-# INLINE putWord32be #-}++-- | Write a Word32 in little endian format+putWord32le :: Word32 -> Put+putWord32le = tell . B.putWord32le+{-# INLINE putWord32le #-}++-- | Write a Word64 in big endian format+putWord64be :: Word64 -> Put+putWord64be = tell . B.putWord64be+{-# INLINE putWord64be #-}++-- | Write a Word64 in little endian format+putWord64le :: Word64 -> Put+putWord64le = tell . B.putWord64le+{-# INLINE putWord64le #-}++------------------------------------------------------------------------++-- | /O(1)./ Write a single native machine word. The word is+-- written in host order, host endian form, for the machine you're on.+-- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine,+-- 4 bytes. Values written this way are not portable to+-- different endian or word sized machines, without conversion.+--+putWordhost :: Word -> Put+putWordhost = tell . B.putWordhost+{-# INLINE putWordhost #-}++-- | /O(1)./ Write a Word16 in native host order and host endianness.+-- For portability issues see @putWordhost@.+putWord16host :: Word16 -> Put+putWord16host = tell . B.putWord16host+{-# INLINE putWord16host #-}++-- | /O(1)./ Write a Word32 in native host order and host endianness.+-- For portability issues see @putWordhost@.+putWord32host :: Word32 -> Put+putWord32host = tell . B.putWord32host+{-# INLINE putWord32host #-}++-- | /O(1)./ Write a Word64 in native host order+-- On a 32 bit machine we write two host order Word32s, in big endian form.+-- For portability issues see @putWordhost@.+putWord64host :: Word64 -> Put+putWord64host = tell . B.putWord64host+{-# INLINE putWord64host #-}
@@ -0,0 +1,425 @@+{-# LANGUAGE BangPatterns #-}+-------------------------------------------------+-- |+-- Module : PGF+-- Maintainer : Krasimir Angelov+-- Stability : stable+-- Portability : portable+--+-- This module is an Application Programming Interface to +-- load and interpret grammars compiled in Portable Grammar Format (PGF).+-- The PGF format is produced as a final output from the GF compiler.+-- The API is meant to be used for embedding GF grammars in Haskell +-- programs+-------------------------------------------------++module PGF(+ -- * PGF+ PGF,+ readPGF,+ parsePGF,++ -- * Identifiers+ CId, mkCId, wildCId,+ showCId, readCId,+ -- extra+ ppCId, pIdent, utf8CId,++ -- * Languages+ Language, + showLanguage, readLanguage,+ languages, abstractName, languageCode,++ -- * Types+ Type, Hypo,+ showType, readType,+ mkType, mkHypo, mkDepHypo, mkImplHypo,+ unType,+ categories, categoryContext, startCat,++ -- * Functions+ functions, functionsByCat, functionType, missingLins,++ -- * Expressions & Trees+ -- ** Tree+ Tree,++ -- ** Expr+ Expr,+ showExpr, readExpr,+ mkAbs, unAbs,+ mkApp, unApp, unapply,+ mkStr, unStr,+ mkInt, unInt,+ mkDouble, unDouble,+ mkFloat, unFloat,+ mkMeta, unMeta,+ -- extra+ pExpr, exprSize, exprFunctions,++ -- * Operations+ -- ** Linearization+ linearize, linearizeAllLang, linearizeAll, bracketedLinearize, bracketedLinearizeAll, tabularLinearizes,+ groupResults, -- lins of trees by language, removing duplicates+ showPrintName,+ + BracketedString(..), FId, LIndex, Token,+ Forest.showBracketedString,flattenBracketedString,++ -- ** Parsing+ parse, parseAllLang, parseAll, parse_, parseWithRecovery, complete,++ -- ** Evaluation+ PGF.compute, paraphrase,++ -- ** Type Checking+ -- | The type checker in PGF does both type checking and renaming+ -- i.e. it verifies that all identifiers are declared and it+ -- distinguishes between global function or type indentifiers and+ -- variable names. The type checker should always be applied on+ -- expressions entered by the user i.e. those produced via functions+ -- like 'readType' and 'readExpr' because otherwise unexpected results+ -- could appear. All typechecking functions returns updated versions+ -- of the input types or expressions because the typechecking could+ -- also lead to metavariables instantiations.+ checkType, checkExpr, inferExpr,+ TcError(..), ppTcError,++ -- ** Low level parsing API+ Parse.ParseState,+ Parse.initState, Parse.nextState, Parse.getCompletions, Parse.recoveryStates, + Parse.ParseInput(..), Parse.simpleParseInput, Parse.mkParseInput,+ Parse.ParseOutput(..), Parse.getParseOutput,+ Parse.getContinuationInfo,++ -- ** Generation+ -- | The PGF interpreter allows automatic generation of+ -- abstract syntax expressions of a given type. Since the+ -- type system of GF allows dependent types, the generation+ -- is in general undecidable. In fact, the set of all type+ -- signatures in the grammar is equivalent to a Turing-complete language (Prolog).+ --+ -- There are several generation methods which mainly differ in:+ --+ -- * whether the expressions are sequentially or randomly generated?+ --+ -- * are they generated from a template? The template is an expression+ -- containing meta variables which the generator will fill in.+ --+ -- * is there a limit of the depth of the expression?+ -- The depth can be used to limit the search space, which + -- in some cases is the only way to make the search decidable.+ generateAll, generateAllDepth,+ generateFrom, generateFromDepth,+ generateRandom, generateRandomDepth,+ generateRandomFrom, generateRandomFromDepth,++ -- ** Morphological Analysis+ Lemma, Analysis, Morpho,+ lookupMorpho, buildMorpho, fullFormLexicon,+ morphoMissing,+ -- extra:+ morphoKnown, isInMorpho,++ -- ** Visualizations+ graphvizAbstractTree,+ graphvizParseTree,+ graphvizParseTreeDep,+ graphvizDependencyTree,+ graphvizBracketedString,+ graphvizAlignment,+ gizaAlignment,+ GraphvizOptions(..),+ graphvizDefaults,+ conlls2latexDoc,+ -- extra:+ Labels, getDepLabels,+ CncLabels, getCncDepLabels,+ + -- * Probabilities+ Probabilities,+ mkProbabilities,+ defaultProbabilities,+ showProbabilities,+ readProbabilitiesFromFile,+ -- extra:+ probTree, setProbabilities, rankTreesByProbs,+ + -- -- ** SortTop+-- forExample,++ -- * Browsing+ browse,+ -- * Tries+ ATree(..),Trie(..),toATree,toTrie+ ) where++import PGF.CId+import PGF.Linearize+--import PGF.SortTop+import PGF.Generate+import PGF.TypeCheck+import PGF.Paraphrase+import PGF.VisualizeTree+import PGF.Probabilistic+import PGF.Macros+import PGF.Expr (Tree)+import PGF.Morphology+import PGF.Data+import PGF.Binary ()+import qualified PGF.Forest as Forest+import qualified PGF.Parse as Parse+import PGF.Utilities(replace)++--import Data.Char+import qualified Data.Map as Map+--import qualified Data.IntMap as IntMap+--import Data.Maybe+import Data.Binary+import Data.ByteString.Lazy (ByteString)+import Data.List(mapAccumL)+--import System.Random (newStdGen)+--import Control.Monad+import Text.PrettyPrint++---------------------------------------------------+-- Interface+---------------------------------------------------++-- | Reads file in Portable Grammar Format and produces+-- 'PGF' structure. The file is usually produced with:+--+-- > $ gf -make <grammar file name>+readPGF :: FilePath -> IO PGF++-- | Like @readPGF@ but you have the manage file-handling.+--+-- @since 3.9.1+parsePGF :: ByteString -> PGF++-- | Tries to parse the given string in the specified language+-- and to produce abstract syntax expression.+parse :: PGF -> Language -> Type -> String -> [Tree]++-- | The same as 'parseAllLang' but does not return+-- the language.+parseAll :: PGF -> Type -> String -> [[Tree]]++-- | Tries to parse the given string with all available languages.+-- The returned list contains pairs of language+-- and list of abstract syntax expressions +-- (this is a list, since grammars can be ambiguous). +-- Only those languages+-- for which at least one parsing is possible are listed.+parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])]++-- | The same as 'parse' but returns more detailed information+parse_ :: PGF -> Language -> Type -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)++-- | This is an experimental function. Use it on your own risk+parseWithRecovery :: PGF -> Language -> Type -> [Type] -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)++-- | List of all languages available in the given grammar.+languages :: PGF -> [Language]++-- | Gets the RFC 4646 language tag +-- of the language which the given concrete syntax implements,+-- if this is listed in the source grammar.+-- Example language tags include @\"en\"@ for English,+-- and @\"en-UK\"@ for British English.+languageCode :: PGF -> Language -> Maybe String++-- | The abstract language name is the name of the top-level+-- abstract module+abstractName :: PGF -> Language++-- | List of all categories defined in the given grammar.+-- The categories are defined in the abstract syntax+-- with the \'cat\' keyword.+categories :: PGF -> [CId]++categoryContext :: PGF -> CId -> Maybe [Hypo]++-- | The start category is defined in the grammar with+-- the \'startcat\' flag. This is usually the sentence category+-- but it is not necessary. Despite that there is a start category+-- defined you can parse with any category. The start category+-- definition is just for convenience.+startCat :: PGF -> Type++-- | List of all functions defined in the abstract syntax+functions :: PGF -> [CId]++-- | List of all functions defined for a given category+functionsByCat :: PGF -> CId -> [CId]++-- | The type of a given function+functionType :: PGF -> CId -> Maybe Type+++---------------------------------------------------+-- Implementation+---------------------------------------------------++readPGF = decodeFile++parsePGF = decode++parse pgf lang typ s =+ case parse_ pgf lang typ (Just 4) s of+ (Parse.ParseOk ts,_) -> ts+ _ -> []++parseAll mgr typ = map snd . parseAllLang mgr typ++parseAllLang mgr typ s = + [(lang,ts) | lang <- languages mgr, (Parse.ParseOk ts,_) <- [parse_ mgr lang typ (Just 4) s]]++parse_ pgf lang typ dp s = + case Map.lookup lang (concretes pgf) of+ Just cnc -> Parse.parse pgf lang typ dp (words s)+ Nothing -> error ("Unknown language: " ++ showCId lang)++parseWithRecovery pgf lang typ open_typs dp s = Parse.parseWithRecovery pgf lang typ open_typs dp (words s)++complete :: PGF -> Language -> Type -> String -> String -> (BracketedString,String,Map.Map Token [CId])+complete pgf from typ input prefix =+ let ws = words input+ ps0 = Parse.initState pgf from typ+ (ps,ws') = loop ps0 ws+ bs = snd (Parse.getParseOutput ps typ Nothing)+ in if not (null ws')+ then (bs, unwords (if null prefix then ws' else ws'++[prefix]), Map.empty)+ else (bs, prefix, fmap getFuns (Parse.getCompletions ps prefix))+ where+ loop ps [] = (ps,[])+ loop ps (w:ws) = case Parse.nextState ps (Parse.simpleParseInput w) of+ Left es -> (ps,w:ws)+ Right ps -> loop ps ws++ getFuns ps = [cid | (funid,cid,seq) <- snd . head $ Map.toList contInfo]+ where+ contInfo = Parse.getContinuationInfo ps++groupResults :: [[(Language,String)]] -> [(Language,[String])]+groupResults = Map.toList . foldr more Map.empty . start . concat+ where+ start ls = [(l,[s]) | (l,s) <- ls]+ more (l,s) = + Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s++abstractName pgf = absname pgf++languages pgf = Map.keys (concretes pgf)++languageCode pgf lang = + case lookConcrFlag pgf lang (mkCId "language") of+ Just (LStr s) -> Just (replace '_' '-' s)+ _ -> Nothing++categories pgf = [c | (c,hs) <- Map.toList (cats (abstract pgf))]++categoryContext pgf cat =+ case Map.lookup cat (cats (abstract pgf)) of+ Just (hypos,_,_) -> Just hypos+ Nothing -> Nothing++startCat pgf = DTyp [] (lookStartCat pgf) []++functions pgf = Map.keys (funs (abstract pgf))++functionsByCat pgf cat =+ case Map.lookup cat (cats (abstract pgf)) of+ Just (_,fns,_) -> map snd fns+ Nothing -> []++functionType pgf fun =+ case Map.lookup fun (funs (abstract pgf)) of+ Just (ty,_,_,_) -> Just ty+ Nothing -> Nothing++-- | Converts an expression to normal form+compute :: PGF -> Expr -> Expr+compute pgf = PGF.Data.normalForm (funs (abstract pgf),const Nothing) 0 []++exprSize :: Expr -> Int+exprSize (EAbs _ _ e) = exprSize e+exprSize (EApp e1 e2) = exprSize e1 + exprSize e2+exprSize (ETyped e ty)= exprSize e+exprSize (EImplArg e) = exprSize e+exprSize _ = 1++exprFunctions :: Expr -> [CId]+exprFunctions (EAbs _ _ e) = exprFunctions e+exprFunctions (EApp e1 e2) = exprFunctions e1 ++ exprFunctions e2+exprFunctions (ETyped e ty)= exprFunctions e+exprFunctions (EImplArg e) = exprFunctions e+exprFunctions (EFun f) = [f]+exprFunctions _ = []++--exprFunctions :: Expr -> [Fun]++browse :: PGF -> CId -> Maybe (String,[CId],[CId])+browse pgf id = fmap (\def -> (def,producers,consumers)) definition+ where+ definition = case Map.lookup id (funs (abstract pgf)) of+ Just (ty,_,Just (eqs,_),_) -> Just $ render (text "fun" <+> ppCId id <+> colon <+> ppType 0 [] ty $$+ if null eqs+ then empty+ else text "def" <+> vcat [let scope = foldl pattScope [] patts+ ds = map (ppPatt 9 scope) patts+ in ppCId id <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])+ Just (ty,_,Nothing,_) -> Just $ render (text "data" <+> ppCId id <+> colon <+> ppType 0 [] ty)+ Nothing -> case Map.lookup id (cats (abstract pgf)) of+ Just (hyps,_,_) -> Just $ render (text "cat" <+> ppCId id <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)))+ Nothing -> Nothing++ (producers,consumers) = Map.foldrWithKey accum ([],[]) (funs (abstract pgf))+ where+ accum f (ty,_,_,_) (plist,clist) = + let !plist' = if id `elem` ps then f : plist else plist+ !clist' = if id `elem` cs then f : clist else clist+ in (plist',clist')+ where+ (ps,cs) = tyIds ty++ tyIds (DTyp hyps cat es) = (foldr expIds (cat:concat css) es,concat pss)+ where+ (pss,css) = unzip [tyIds ty | (_,_,ty) <- hyps]++ expIds (EAbs _ _ e) ids = expIds e ids+ expIds (EApp e1 e2) ids = expIds e1 (expIds e2 ids)+ expIds (EFun id) ids = id : ids+ expIds (ETyped e _) ids = expIds e ids+ expIds _ ids = ids++-- | A type for plain applicative trees+data ATree t = Other t | App CId [ATree t] deriving Show+data Trie = Oth Tree | Ap CId [[Trie ]] deriving Show+-- ^ A type for tries of plain applicative trees++-- | Convert a 'Tree' to an 'ATree'+toATree :: Tree -> ATree Tree+toATree e = maybe (Other e) app (unApp e)+ where+ app (f,es) = App f (map toATree es)++-- | Combine a list of trees into a trie+toTrie = combines . map ((:[]) . singleton)+ where+ singleton t = case t of+ Other e -> Oth e+ App f ts -> Ap f [map singleton ts]++ combines [] = []+ combines (ts:tss) = ts1:combines tss2+ where+ (ts1,tss2) = combines2 [] tss ts+ combines2 ots [] ts1 = (ts1,reverse ots)+ combines2 ots (ts2:tss) ts1 =+ maybe (combines2 (ts2:ots) tss ts1) (combines2 ots tss) (combine ts1 ts2)++ combine ts us = mapM combine2 (zip ts us)+ where+ combine2 (Ap f ts,Ap g us) | f==g = Just (Ap f (combines (ts++us)))+ combine2 _ = Nothing
@@ -0,0 +1,281 @@+module PGF.Binary(putSplitAbs) where + +import PGF.CId +import PGF.Data +import PGF.Optimize +import PGF.ByteCode +import qualified PGF.OldBinary as Old +import Data.Binary +import Data.Binary.Put +import Data.Binary.Get +import Data.Array.IArray +import qualified Data.Map as Map +import qualified Data.IntMap as IntMap +--import qualified Data.Set as Set +import Control.Monad + +pgfMajorVersion, pgfMinorVersion :: Word16 +version@(pgfMajorVersion, pgfMinorVersion) = (2,1) + +instance Binary PGF where + put pgf = do putWord16be pgfMajorVersion + putWord16be pgfMinorVersion + put (gflags pgf) + put (absname pgf, abstract pgf) + put (concretes pgf) + get = do major<- getWord16be + minor <- getWord16be + let v = (major,minor) + if major==pgfMajorVersion && minor<=pgfMinorVersion + then getPGF' + else if v==Old.version + then Old.getPGF' + else fail $ "Unsupported PGF version "++show (major,minor) + +getPGF'=do gflags <- get + (absname,abstract) <- get + concretes <- get + return $ updateProductionIndices $ + (PGF{ gflags=gflags + , absname=absname, abstract=abstract + , concretes=concretes + }) + +instance Binary CId where + put (CId bs) = put bs + get = liftM CId get + +instance Binary Abstr where + put abs = do put (aflags abs) + put (Map.map (\(ty,arity,mb_eq,prob) -> (ty,arity,fmap fst mb_eq,prob)) (funs abs)) + put (cats abs) + get = do aflags <- get + funs <- get + cats <- get + return (Abstr{ aflags=aflags + , funs=Map.map (\(ty,arity,mb_eq,prob) -> (ty,arity,fmap (\eq -> (eq,[])) mb_eq,prob)) funs + , cats=cats + }) + +putSplitAbs :: PGF -> Put +putSplitAbs pgf = do + putWord16be pgfMajorVersion + putWord16be pgfMinorVersion + put (Map.insert (mkCId "split") (LStr "true") (gflags pgf)) + put (absname pgf, abstract pgf) + put [(name,cflags cnc) | (name,cnc) <- Map.toList (concretes pgf)] + +instance Binary Concr where + put cnc = do put (cflags cnc) + put (printnames cnc) + putArray2 (sequences cnc) + putArray (cncfuns cnc) + put (lindefs cnc) + put (linrefs cnc) + put (productions cnc) + put (cnccats cnc) + put (totalCats cnc) + get = do cflags <- get + printnames <- get + sequences <- getArray2 + cncfuns <- getArray + lindefs <- get + linrefs <- get + productions <- get + cnccats <- get + totalCats <- get + return (Concr{ cflags=cflags, printnames=printnames + , sequences=sequences, cncfuns=cncfuns + , lindefs=lindefs, linrefs=linrefs + , productions=productions + , pproductions = IntMap.empty + , lproductions = Map.empty + , lexicon = IntMap.empty + , cnccats=cnccats, totalCats=totalCats + }) + +instance Binary Expr where + put (EAbs b x exp) = putWord8 0 >> put (b,x,exp) + put (EApp e1 e2) = putWord8 1 >> put (e1,e2) + put (ELit l) = putWord8 2 >> put l + put (EMeta i) = putWord8 3 >> put i + put (EFun f) = putWord8 4 >> put f + put (EVar i) = putWord8 5 >> put i + put (ETyped e ty) = putWord8 6 >> put (e,ty) + put (EImplArg e) = putWord8 7 >> put e + get = do tag <- getWord8 + case tag of + 0 -> liftM3 EAbs get get get + 1 -> liftM2 EApp get get + 2 -> liftM ELit get + 3 -> liftM EMeta get + 4 -> liftM EFun get + 5 -> liftM EVar get + 6 -> liftM2 ETyped get get + 7 -> liftM EImplArg get + _ -> decodingError + +instance Binary Patt where + put (PApp f ps) = putWord8 0 >> put (f,ps) + put (PVar x) = putWord8 1 >> put x + put (PAs x p) = putWord8 2 >> put (x,p) + put PWild = putWord8 3 + put (PLit l) = putWord8 4 >> put l + put (PImplArg p) = putWord8 5 >> put p + put (PTilde p) = putWord8 6 >> put p + get = do tag <- getWord8 + case tag of + 0 -> liftM2 PApp get get + 1 -> liftM PVar get + 2 -> liftM2 PAs get get + 3 -> return PWild + 4 -> liftM PLit get + 5 -> liftM PImplArg get + 6 -> liftM PTilde get + _ -> decodingError + +instance Binary Equation where + put (Equ ps e) = put (ps,e) + get = liftM2 Equ get get + +instance Binary Instr where + put (CHECK_ARGS n) = putWord8 0 >> put n + put (CASE id l) = putWord8 4 >> put (id,l) + put (CASE_LIT (LInt n) l) = putWord8 8 >> put (n,l) + put (CASE_LIT (LStr s) l) = putWord8 9 >> put (s,l) + put (CASE_LIT (LFlt d) l) = putWord8 10 >> put (d,l) + put (SAVE n) = putWord8 12 >> put n + put (ALLOC n) = putWord8 16 >> put n + put (PUT_CONSTR id) = putWord8 20 >> put id + put (PUT_CLOSURE l) = putWord8 24 >> put l + put (PUT_LIT (LInt n)) = putWord8 28 >> put n + put (PUT_LIT (LStr s)) = putWord8 29 >> put s + put (PUT_LIT (LFlt d)) = putWord8 30 >> put d + put (SET (HEAP n)) = putWord8 32 >> put n + put (SET (ARG_VAR n)) = putWord8 33 >> put n + put (SET (FREE_VAR n)) = putWord8 34 >> put n + put (SET (GLOBAL id)) = putWord8 35 >> put id + put (SET_PAD ) = putWord8 36 + put (PUSH_FRAME ) = putWord8 40 + put (PUSH (HEAP n)) = putWord8 44 >> put n + put (PUSH (ARG_VAR n)) = putWord8 45 >> put n + put (PUSH (FREE_VAR n)) = putWord8 46 >> put n + put (PUSH (GLOBAL id)) = putWord8 47 >> put id + put (TUCK (HEAP n) i) = putWord8 48 >> put (n,i) + put (TUCK (ARG_VAR n) i) = putWord8 49 >> put (n,i) + put (TUCK (FREE_VAR n) i) = putWord8 50 >> put (n,i) + put (TUCK (GLOBAL id) i) = putWord8 51 >> put (id,i) + put (EVAL (HEAP n) RecCall) = putWord8 52 >> put n + put (EVAL (ARG_VAR n) RecCall) = putWord8 53 >> put n + put (EVAL (FREE_VAR n) RecCall) = putWord8 54 >> put n + put (EVAL (GLOBAL id) RecCall) = putWord8 55 >> put id + put (EVAL (HEAP n) (TailCall a)) = putWord8 56 >> put n >> put a + put (EVAL (ARG_VAR n) (TailCall a)) = putWord8 57 >> put n >> put a + put (EVAL (FREE_VAR n) (TailCall a)) = putWord8 58 >> put n >> put a + put (EVAL (GLOBAL id) (TailCall a)) = putWord8 59 >> put id >> put a + put (EVAL (HEAP n) UpdateCall) = putWord8 60 >> put n + put (EVAL (ARG_VAR n) UpdateCall) = putWord8 61 >> put n + put (EVAL (FREE_VAR n) UpdateCall) = putWord8 62 >> put n + put (EVAL (GLOBAL id) UpdateCall) = putWord8 63 >> put id + put (DROP n ) = putWord8 64 >> put n + put (JUMP l ) = putWord8 68 >> put l + put (FAIL ) = putWord8 72 + put (PUSH_ACCUM (LInt n)) = putWord8 76 >> put n + put (PUSH_ACCUM (LStr s)) = putWord8 77 >> put s + put (PUSH_ACCUM (LFlt d)) = putWord8 78 >> put d + put (POP_ACCUM ) = putWord8 80 + put (ADD ) = putWord8 84 + +instance Binary Type where + put (DTyp hypos cat exps) = put (hypos,cat,exps) + get = liftM3 DTyp get get get + +instance Binary BindType where + put Explicit = putWord8 0 + put Implicit = putWord8 1 + get = do tag <- getWord8 + case tag of + 0 -> return Explicit + 1 -> return Implicit + _ -> decodingError + +instance Binary CncFun where + put (CncFun fun lins) = put fun >> putArray lins + get = liftM2 CncFun get getArray + +instance Binary CncCat where + put (CncCat s e labels) = do put (s,e) + putArray labels + get = liftM3 CncCat get get getArray + +instance Binary Symbol where + put (SymCat n l) = putWord8 0 >> put (n,l) + put (SymLit n l) = putWord8 1 >> put (n,l) + put (SymVar n l) = putWord8 2 >> put (n,l) + put (SymKS ts) = putWord8 3 >> put ts + put (SymKP d vs) = putWord8 4 >> put (d,vs) + put SymBIND = putWord8 5 + put SymSOFT_BIND = putWord8 6 + put SymNE = putWord8 7 + put SymSOFT_SPACE = putWord8 8 + put SymCAPIT = putWord8 9 + put SymALL_CAPIT = putWord8 10 + get = do tag <- getWord8 + case tag of + 0 -> liftM2 SymCat get get + 1 -> liftM2 SymLit get get + 2 -> liftM2 SymVar get get + 3 -> liftM SymKS get + 4 -> liftM2 (\d vs -> SymKP d vs) get get + 5 -> return SymBIND + 6 -> return SymSOFT_BIND + 7 -> return SymNE + 8 -> return SymSOFT_SPACE + 9 -> return SymCAPIT + 10-> return SymALL_CAPIT + _ -> decodingError + +instance Binary PArg where + put (PArg hypos fid) = put (map snd hypos,fid) + get = get >>= \(hypos,fid) -> return (PArg (zip (repeat fidVar) hypos) fid) + +instance Binary Production where + put (PApply ruleid args) = putWord8 0 >> put (ruleid,args) + put (PCoerce fcat) = putWord8 1 >> put fcat + get = do tag <- getWord8 + case tag of + 0 -> liftM2 PApply get get + 1 -> liftM PCoerce get + _ -> decodingError + +instance Binary Literal where + put (LStr s) = putWord8 0 >> put s + put (LInt i) = putWord8 1 >> put i + put (LFlt d) = putWord8 2 >> put d + get = do tag <- getWord8 + case tag of + 0 -> liftM LStr get + 1 -> liftM LInt get + 2 -> liftM LFlt get + _ -> decodingError + + +putArray :: (Binary e, IArray a e) => a Int e -> Put +putArray a = do put (rangeSize $ bounds a) -- write the length + mapM_ put (elems a) -- now the elems. + +getArray :: (Binary e, IArray a e) => Get (a Int e) +getArray = do n <- get -- read the length + xs <- replicateM n get -- now the elems. + return (listArray (0,n-1) xs) + +putArray2 :: (Binary e, IArray a1 (a2 Int e), IArray a2 e) => a1 Int (a2 Int e) -> Put +putArray2 a = do put (rangeSize $ bounds a) -- write the length + mapM_ putArray (elems a) -- now the elems. + +getArray2 :: (Binary e, IArray a1 (a2 Int e), IArray a2 e) => Get (a1 Int (a2 Int e)) +getArray2 = do n <- get -- read the length + xs <- replicateM n getArray -- now the elems. + return (listArray (0,n-1) xs) + +decodingError = fail "This file was compiled with different version of GF"
@@ -0,0 +1,89 @@+module PGF.ByteCode(Literal(..),+ CodeLabel, Instr(..), IVal(..), TailInfo(..),+ ppLit, ppCode, ppInstr+ ) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint+import PGF.CId+import Text.PrettyPrint++data Literal =+ LStr String -- ^ string constant+ | LInt Int -- ^ integer constant+ | LFlt Double -- ^ floating point constant+ deriving (Eq,Ord,Show)++type CodeLabel = Int++data Instr+ = CHECK_ARGS {-# UNPACK #-} !Int+ | CASE CId {-# UNPACK #-} !CodeLabel+ | CASE_LIT Literal {-# UNPACK #-} !CodeLabel+ | SAVE {-# UNPACK #-} !Int+ | ALLOC {-# UNPACK #-} !Int+ | PUT_CONSTR CId+ | PUT_CLOSURE {-# UNPACK #-} !CodeLabel+ | PUT_LIT Literal+ | SET IVal+ | SET_PAD+ | PUSH_FRAME+ | PUSH IVal+ | TUCK IVal {-# UNPACK #-} !Int+ | EVAL IVal TailInfo+ | DROP {-# UNPACK #-} !Int+ | JUMP {-# UNPACK #-} !CodeLabel+ | FAIL+ | PUSH_ACCUM Literal+ | POP_ACCUM+ | ADD++data IVal+ = HEAP {-# UNPACK #-} !Int+ | ARG_VAR {-# UNPACK #-} !Int+ | FREE_VAR {-# UNPACK #-} !Int+ | GLOBAL CId+ deriving Eq++data TailInfo+ = RecCall+ | TailCall {-# UNPACK #-} !Int+ | UpdateCall++ppLit (LStr s) = text (show s)+ppLit (LInt n) = int n+ppLit (LFlt d) = double d++ppCode :: Int -> [[Instr]] -> Doc+ppCode l [] = empty+ppCode l (is:iss) = ppLabel l <+> vcat (map ppInstr is) $$ ppCode (l+1) iss++ppInstr (CHECK_ARGS n) = text "CHECK_ARGS " <+> int n+ppInstr (CASE id l ) = text "CASE " <+> ppCId id <+> ppLabel l+ppInstr (CASE_LIT lit l ) = text "CASE_LIT " <+> ppLit lit <+> ppLabel l+ppInstr (SAVE n) = text "SAVE " <+> int n+ppInstr (ALLOC n) = text "ALLOC " <+> int n+ppInstr (PUT_CONSTR id) = text "PUT_CONSTR " <+> ppCId id+ppInstr (PUT_CLOSURE l) = text "PUT_CLOSURE" <+> ppLabel l+ppInstr (PUT_LIT lit ) = text "PUT_LIT " <+> ppLit lit+ppInstr (SET v) = text "SET " <+> ppIVal v+ppInstr (SET_PAD ) = text "SET_PAD"+ppInstr (PUSH_FRAME ) = text "PUSH_FRAME"+ppInstr (PUSH v) = text "PUSH " <+> ppIVal v+ppInstr (EVAL v ti) = text "EVAL " <+> ppIVal v <+> ppTailInfo ti+ppInstr (TUCK v n ) = text "TUCK " <+> ppIVal v <+> int n+ppInstr (DROP n ) = text "DROP " <+> int n+ppInstr (JUMP l ) = text "JUMP " <+> ppLabel l+ppInstr (FAIL ) = text "FAIL"+ppInstr (PUSH_ACCUM lit) = text "PUSH_ACCUM " <+> ppLit lit+ppInstr (POP_ACCUM ) = text "POP_ACCUM"+ppInstr (ADD ) = text "ADD"++ppIVal (HEAP n) = text "hp" <> parens (int n)+ppIVal (ARG_VAR n) = text "stk" <> parens (int n)+ppIVal (FREE_VAR n) = text "env" <> parens (int n)+ppIVal (GLOBAL id) = ppCId id++ppTailInfo RecCall = empty+ppTailInfo (TailCall n) = text "tail" <> parens (int n)+ppTailInfo UpdateCall = text "update"++ppLabel l = text (let s = show l in replicate (3-length s) '0' ++ s)
@@ -0,0 +1,95 @@+module PGF.CId (CId(..), + mkCId, wildCId,+ readCId, showCId,+ + -- utils+ utf8CId, pCId, pIdent, ppCId) where++import Control.Monad+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.UTF8 as UTF8+import Data.Char+import qualified Text.ParserCombinators.ReadP as RP+import qualified Text.PrettyPrint as PP+++-- | An abstract data type that represents+-- identifiers for functions and categories in PGF.+newtype CId = CId BS.ByteString deriving (Eq,Ord)++wildCId :: CId+wildCId = CId (BS.singleton '_')++-- | Creates a new identifier from 'String'+mkCId :: String -> CId+mkCId s = CId (UTF8.fromString s)++-- | Creates an identifier from a UTF-8-encoded 'ByteString'+utf8CId = CId++-- | Reads an identifier from 'String'. The function returns 'Nothing' if the string is not valid identifier.+readCId :: String -> Maybe CId+readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of+ [x] -> Just x+ _ -> Nothing++-- | Renders the identifier as 'String'+showCId :: CId -> String+showCId (CId x) = + let raw = UTF8.toString x+ in if isIdent raw+ then raw+ else "'" ++ concatMap escape raw ++ "'"+ where+ isIdent [] = False+ isIdent (c:cs) = isIdentFirst c && all isIdentRest cs++ escape '\'' = "\\\'"+ escape '\\' = "\\\\"+ escape c = [c]++instance Show CId where+ showsPrec _ = showString . showCId++instance Read CId where+ readsPrec _ = RP.readP_to_S pCId++pCId :: RP.ReadP CId+pCId = do s <- pIdent+ if s == "_"+ then RP.pfail+ else return (mkCId s)++pIdent :: RP.ReadP String+pIdent = + liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)+ `mplus`+ do RP.char '\''+ cs <- RP.many1 insideChar+ RP.char '\''+ return cs+-- where+insideChar = RP.readS_to_P $ \s ->+ case s of+ [] -> []+ ('\\':'\\':cs) -> [('\\',cs)]+ ('\\':'\'':cs) -> [('\'',cs)]+ ('\\':cs) -> []+ ('\'':cs) -> []+ (c:cs) -> [(c,cs)]++isIdentFirst c =+ (c == '_') ||+ (c >= 'a' && c <= 'z') ||+ (c >= 'A' && c <= 'Z') ||+ (c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')+isIdentRest c = + (c == '_') ||+ (c == '\'') ||+ (c >= '0' && c <= '9') ||+ (c >= 'a' && c <= 'z') ||+ (c >= 'A' && c <= 'Z') ||+ (c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')++ppCId :: CId -> PP.Doc+ppCId = PP.text . showCId
@@ -0,0 +1,135 @@+module PGF.Data (module PGF.Data, module PGF.Expr, module PGF.Type) where++import PGF.CId+import PGF.Expr hiding (Value, Sig, Env, Tree, eval, apply, applyValue, value2expr)+import PGF.ByteCode+import PGF.Type++import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified PGF.TrieMap as TMap+import Data.Array.IArray+import Data.Array.Unboxed+--import Data.List+++-- internal datatypes for PGF++-- | An abstract data type representing multilingual grammar+-- in Portable Grammar Format.+data PGF = PGF {+ gflags :: Map.Map CId Literal, -- value of a global flag+ absname :: CId ,+ abstract :: Abstr ,+ concretes :: Map.Map CId Concr+ }++data Abstr = Abstr {+ aflags :: Map.Map CId Literal, -- ^ value of a flag+ funs :: Map.Map CId (Type,Int,Maybe ([Equation],[[Instr]]),Double),-- ^ type, arrity and definition of function + probability+ cats :: Map.Map CId ([Hypo],[(Double, CId)],Double) -- ^ 1. context of a category+ -- 2. functions of a category. The functions are stored+ -- in decreasing probability order.+ -- 3. probability+ }++data Concr = Concr {+ cflags :: Map.Map CId Literal, -- value of a flag+ printnames :: Map.Map CId String, -- printname of a cat or a fun+ cncfuns :: Array FunId CncFun,+ lindefs :: IntMap.IntMap [FunId],+ linrefs :: IntMap.IntMap [FunId],+ sequences :: Array SeqId Sequence,+ productions :: IntMap.IntMap (Set.Set Production), -- the original productions loaded from the PGF file+ pproductions :: IntMap.IntMap (Set.Set Production), -- productions needed for parsing+ lproductions :: Map.Map CId (IntMap.IntMap (Set.Set Production)), -- productions needed for linearization+ cnccats :: Map.Map CId CncCat,+ lexicon :: IntMap.IntMap (IntMap.IntMap (TMap.TrieMap Token IntSet.IntSet)),+ totalCats :: {-# UNPACK #-} !FId+ }++type Token = String+type FId = Int+type LIndex = Int+type DotPos = Int+data Symbol+ = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex+ | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex+ | SymVar {-# UNPACK #-} !Int {-# UNPACK #-} !Int+ | SymKS Token+ | SymKP [Symbol] [([Symbol],[String])]+ | SymBIND -- the special BIND token+ | SymNE -- non exist+ | SymSOFT_BIND -- the special SOFT_BIND token+ | SymSOFT_SPACE -- the special SOFT_SPACE token+ | SymCAPIT -- the special CAPIT token+ | SymALL_CAPIT -- the special ALL_CAPIT token+ deriving (Eq,Ord,Show)+data Production+ = PApply {-# UNPACK #-} !FunId [PArg]+ | PCoerce {-# UNPACK #-} !FId+ | PConst CId Expr [Token]+ deriving (Eq,Ord,Show)+data PArg = PArg [(FId,FId)] {-# UNPACK #-} !FId deriving (Eq,Ord,Show)+data CncCat = CncCat {-# UNPACK #-} !FId {-# UNPACK #-} !FId {-# UNPACK #-} !(Array LIndex String)+data CncFun = CncFun CId {-# UNPACK #-} !(UArray LIndex SeqId) deriving (Eq,Ord,Show)+type Sequence = Array DotPos Symbol+type FunId = Int+type SeqId = Int++-- merge two PGFs; fails if different abstract names; priority to second arg++unionPGF :: PGF -> PGF -> PGF+unionPGF one two = fst $ msgUnionPGF one two++msgUnionPGF :: PGF -> PGF -> (PGF, Maybe String)+msgUnionPGF one two = case absname one of+ n | n == wildCId -> (two, Nothing) -- extending empty grammar+ | n == absname two && haveSameFunsPGF one two -> (one { -- extending grammar with same abstract+ concretes = Map.union (concretes two) (concretes one)+ }, Nothing)+ _ -> (two, -- abstracts don't match, discard the old one -- error msg in Importing.ioUnionPGF+ Just "Abstract changed, previous concretes discarded.")++emptyPGF :: PGF+emptyPGF = PGF {+ gflags = Map.empty,+ absname = wildCId,+ abstract = error "empty grammar, no abstract",+ concretes = Map.empty+ }++-- sameness of function type signatures, checked when importing a new concrete in env+haveSameFunsPGF :: PGF -> PGF -> Bool+haveSameFunsPGF one two = + let + fsone = [(f,t) | (f,(t,_,_,_)) <- Map.toList (funs (abstract one))]+ fstwo = [(f,t) | (f,(t,_,_,_)) <- Map.toList (funs (abstract two))]+ in fsone == fstwo++-- | This is just a 'CId' with the language name.+-- A language name is the identifier that you write in the +-- top concrete or abstract module in GF after the +-- concrete/abstract keyword. Example:+-- +-- > abstract Lang = ...+-- > concrete LangEng of Lang = ...+type Language = CId++readLanguage :: String -> Maybe Language+readLanguage = readCId++showLanguage :: Language -> String+showLanguage = showCId++fidString, fidInt, fidFloat, fidVar, fidStart :: FId+fidString = (-1)+fidInt = (-2)+fidFloat = (-3)+fidVar = (-4)+fidStart = (-5)++isPredefFId :: FId -> Bool+isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])
@@ -0,0 +1,241 @@+module PGF.Editor (+ State, -- datatype -- type-annotated possibly open tree with a focus+ Dict, -- datatype -- abstract syntax information optimized for editing+ Position, -- datatype -- path from top to focus + new, -- :: Type -> State -- create new State+ refine, -- :: Dict -> CId -> State -> State -- refine focus with CId+ replace, -- :: Dict -> Tree -> State -> State -- replace focus with Tree+ delete, -- :: State -> State -- replace focus with ?+ goNextMeta, -- :: State -> State -- move focus to next ? node+ goNext, -- :: State -> State -- move to next node+ goTop, -- :: State -> State -- move focus to the top (=root)+ goPosition, -- :: Position -> State -> State -- move focus to given position+ mkPosition, -- :: [Int] -> Position -- list of choices (top = [])+ showPosition,-- :: Position -> [Int] -- readable position + focusType, -- :: State -> Type -- get the type of focus+ stateTree, -- :: State -> Tree -- get the current tree+ isMetaFocus, -- :: State -> Bool -- whether focus is ?+ allMetas, -- :: State -> [(Position,Type)] -- all ?s and their positions+ prState, -- :: State -> String -- print state, focus marked *+ refineMenu, -- :: Dict -> State -> [CId] -- get refinement menu+ pgf2dict -- :: PGF -> Dict -- create editing Dict from PGF+ ) where++import PGF.Data+import PGF.CId+import qualified Data.Map as M+import Debug.Trace ----++-- API++new :: Type -> State+new (DTyp _ t _) = etree2state (uETree t)++refine :: Dict -> CId -> State -> State+refine dict f = replaceInState (mkRefinement dict f)++replace :: Dict -> Tree -> State -> State+replace dict t = replaceInState (tree2etree dict t)++delete :: State -> State+delete s = replaceInState (uETree (typ (tree s))) s++goNextMeta :: State -> State+goNextMeta s = + if isComplete s then s+ else let s1 = goNext s in if isMetaFocus s1 + then s1 else goNextMeta s1++isComplete :: State -> Bool+isComplete s = isc (tree s) where+ isc t = case atom t of+ AMeta _ -> False+ ACon _ -> all isc (children t)++goTop :: State -> State+goTop = navigate (const top)++goPosition :: [Int] -> State -> State+goPosition p s = s{position = p}++mkPosition :: [Int] -> Position+mkPosition = id++refineMenu :: Dict -> State -> [CId]+refineMenu dict s = maybe [] (map fst) $ M.lookup (focusBType s) (refines dict)++focusType :: State -> Type+focusType s = btype2type (focusBType s)++stateTree :: State -> Tree+stateTree = etree2tree . tree++pgf2dict :: PGF -> Dict+pgf2dict pgf = Dict (M.fromAscList fus) refs where+ fus = [(f,mkFType ty) | (f,(ty,_)) <- M.toList (funs abs)]+ refs = M.fromAscList [(c, fusTo c) | (c,_) <- M.toList (cats abs)]+ fusTo c = [(f,ty) | (f,ty@(_,k)) <- fus, k==c] ---- quadratic+ mkFType (DTyp hyps c _) = ([k | Hyp _ (DTyp _ k _) <- hyps],c) ----dep types+ abs = abstract pgf++etree2tree :: ETree -> Tree+etree2tree t = case atom t of+ ACon f -> Fun f (map etree2tree (children t))+ AMeta i -> Meta i++tree2etree :: Dict -> Tree -> ETree+tree2etree dict t = case t of+ Fun f _ -> annot (look f) t+ where+ annot (tys,ty) tr = case tr of + Fun f trs -> ETree (ACon f) ty [annt t tr | (t,tr) <- zip tys trs]+ Meta i -> ETree (AMeta i) ty []+ annt ty tr = case tr of+ Fun _ _ -> tree2etree dict tr+ Meta _ -> annot ([],ty) tr+ look f = maybe undefined id $ M.lookup f (functs dict)++prState :: State -> String+prState s = unlines [replicate i ' ' ++ f | (i,f) <- pr [] (tree s)] where+ pr i t = + (ind i,prAtom i (atom t)) : concat [pr (sub j i) c | (j,c) <- zip [0..] (children t)]+ prAtom i a = prFocus i ++ case a of+ ACon f -> prCId f+ AMeta i -> "?" ++ show i+ prFocus i = if i == position s then "*" else ""+ ind i = 2 * length i+ sub j i = i ++ [j]++showPosition :: Position -> [Int]+showPosition = id++allMetas :: State -> [(Position,Type)]+allMetas s = [(reverse p, btype2type ty) | (p,ty) <- metas [] (tree s)] where+ metas p t = + (if isMetaAtom (atom t) then [(p,typ t)] else []) ++ + concat [metas (i:p) u | (i,u) <- zip [0..] (children t)]++---- Trees and navigation++data ETree = ETree {+ atom :: Atom,+ typ :: BType,+ children :: [ETree]+ }+ deriving Show++data Atom =+ ACon CId+ | AMeta Int+ deriving Show++btype2type :: BType -> Type+btype2type t = DTyp [] t []++uETree :: BType -> ETree+uETree ty = ETree (AMeta 0) ty []++data State = State {+ position :: Position,+ tree :: ETree+ }+ deriving Show++type Position = [Int]++top :: Position+top = []++up :: Position -> Position+up p = case p of+ _:_ -> init p+ _ -> p++down :: Position -> Position+down = (++[0])++left :: Position -> Position+left p = case p of+ _:_ | last p > 0 -> init p ++ [last p - 1]+ _ -> top++right :: Position -> Position+right p = case p of+ _:_ -> init p ++ [last p + 1]+ _ -> top++etree2state :: ETree -> State+etree2state = State top++doInState :: (ETree -> ETree) -> State -> State+doInState f s = s{tree = change (position s) (tree s)} where+ change p t = case p of+ [] -> f t+ n:ns -> let (ts1,t0:ts2) = splitAt n (children t) in + t{children = ts1 ++ [change ns t0] ++ ts2}++subtree :: Position -> ETree -> ETree+subtree p t = case p of+ [] -> t+ n:ns -> subtree ns (children t !! n)++focus :: State -> ETree+focus s = subtree (position s) (tree s)++focusBType :: State -> BType+focusBType s = typ (focus s)++navigate :: (Position -> Position) -> State -> State+navigate p s = s{position = p (position s)}++-- p is a fix-point aspect of state change+untilFix :: Eq a => (State -> a) -> (State -> Bool) -> (State -> State) -> State -> State+untilFix p b f s = + if b s + then s + else let fs = f s in if p fs == p s + then s + else untilFix p b f fs++untilPosition :: (State -> Bool) -> (State -> State) -> State -> State+untilPosition = untilFix position++goNext :: State -> State+goNext s = case focus s of+ st | not (null (children st)) -> navigate down s+ _ -> findSister s+ where+ findSister s = case s of+ s' | null (position s') -> s'+ s' | hasYoungerSisters s' -> navigate right s'+ s' -> findSister (navigate up s')+ hasYoungerSisters s = case position s of+ p@(_:_) -> length (children (focus (navigate up s))) > last p + 1+ _ -> False++isMetaFocus :: State -> Bool+isMetaFocus s = isMetaAtom (atom (focus s))++isMetaAtom :: Atom -> Bool+isMetaAtom a = case a of+ AMeta _ -> True+ _ -> False++replaceInState :: ETree -> State -> State+replaceInState t = doInState (const t)+++-------++type BType = CId ----dep types+type FType = ([BType],BType) ----dep types++data Dict = Dict {+ functs :: M.Map CId FType,+ refines :: M.Map BType [(CId,FType)]+ }++mkRefinement :: Dict -> CId -> ETree+mkRefinement dict f = ETree (ACon f) val (map uETree args) where+ (args,val) = maybe undefined id $ M.lookup f (functs dict)+
@@ -0,0 +1,406 @@+module PGF.Expr(Tree, BindType(..), Expr(..), Literal(..), Patt(..), Equation(..), + readExpr, showExpr, pExpr, pBinds, ppExpr, ppPatt, pattScope, + + mkAbs, unAbs, + mkApp, unApp, unapply, + mkStr, unStr, + mkInt, unInt, + mkDouble, unDouble, + mkFloat, unFloat, + mkMeta, unMeta, + + normalForm, + + -- needed in the typechecker + Value(..), Env, Sig, eval, apply, applyValue, value2expr, + + MetaId, + + -- helpers + pMeta,pArg,pLit,freshName,ppMeta,ppLit,ppParens + ) where + +import PGF.CId +import PGF.Type +import PGF.ByteCode + +import Data.Char +--import Data.Maybe +import Data.List as List +import qualified Data.Map as Map hiding (showTree) +import Control.Monad +import qualified Text.PrettyPrint as PP +import qualified Text.ParserCombinators.ReadP as RP + +type MetaId = Int + +data BindType = + Explicit + | Implicit + deriving (Eq,Ord,Show) + +-- | Tree is the abstract syntax representation of a given sentence +-- in some concrete syntax. Technically 'Tree' is a type synonym +-- of 'Expr'. +type Tree = Expr + +-- | An expression in the abstract syntax of the grammar. It could be +-- both parameter of a dependent type or an abstract syntax tree for +-- for some sentence. +data Expr = + EAbs BindType CId Expr -- ^ lambda abstraction + | EApp Expr Expr -- ^ application + | ELit Literal -- ^ literal + | EMeta {-# UNPACK #-} !MetaId -- ^ meta variable + | EFun CId -- ^ function or data constructor + | EVar {-# UNPACK #-} !Int -- ^ variable with de Bruijn index + | ETyped Expr Type -- ^ local type signature + | EImplArg Expr -- ^ implicit argument in expression + deriving (Eq,Ord,Show) + +-- | The pattern is used to define equations in the abstract syntax of the grammar. +data Patt = + PApp CId [Patt] -- ^ application. The identifier should be constructor i.e. defined with 'data' + | PLit Literal -- ^ literal + | PVar CId -- ^ variable + | PAs CId Patt -- ^ variable@pattern + | PWild -- ^ wildcard + | PImplArg Patt -- ^ implicit argument in pattern + | PTilde Expr + deriving Show + +-- | The equation is used to define lambda function as a sequence +-- of equations with pattern matching. The list of 'Expr' represents +-- the patterns and the second 'Expr' is the function body for this +-- equation. +data Equation = + Equ [Patt] Expr + deriving Show + +-- | parses 'String' as an expression +readExpr :: String -> Maybe Expr +readExpr s = case [x | (x,cs) <- RP.readP_to_S pExpr s, all isSpace cs] of + [x] -> Just x + _ -> Nothing + +-- | renders expression as 'String'. The list +-- of identifiers is the list of all free variables +-- in the expression in order reverse to the order +-- of binding. +showExpr :: [CId] -> Expr -> String +showExpr vars = PP.render . ppExpr 0 vars + +instance Read Expr where + readsPrec _ = RP.readP_to_S pExpr + +mkAbs :: BindType -> CId -> Expr -> Expr +mkAbs = EAbs + +unAbs :: Expr -> Maybe (BindType, CId, Expr) +unAbs (EAbs bt x e) = Just (bt,x,e) +unAbs (ETyped e ty) = unAbs e +unAbs (EImplArg e) = unAbs e +unAbs _ = Nothing + +-- | Constructs an expression by applying a function to a list of expressions +mkApp :: CId -> [Expr] -> Expr +mkApp f es = foldl EApp (EFun f) es + +-- | Decomposes an expression into application of function +unApp :: Expr -> Maybe (CId,[Expr]) +unApp e = case unapply e of + (EFun f,es) -> Just (f,es) + _ -> Nothing + +-- | Decomposes an expression into an application of a constructor such as a constant or a metavariable +unapply :: Expr -> (Expr,[Expr]) +unapply = extract [] + where + extract es f@(EFun _) = (f,es) + extract es (EApp e1 e2) = extract (e2:es) e1 + extract es (ETyped e ty)= extract es e + extract es (EImplArg e) = extract es e + extract es h = (h,es) + +-- | Constructs an expression from string literal +mkStr :: String -> Expr +mkStr s = ELit (LStr s) + +-- | Decomposes an expression into string literal +unStr :: Expr -> Maybe String +unStr (ELit (LStr s)) = Just s +unStr (ETyped e ty) = unStr e +unStr (EImplArg e) = unStr e +unStr _ = Nothing + +-- | Constructs an expression from integer literal +mkInt :: Int -> Expr +mkInt i = ELit (LInt i) + +-- | Decomposes an expression into integer literal +unInt :: Expr -> Maybe Int +unInt (ELit (LInt i)) = Just i +unInt (ETyped e ty) = unInt e +unInt (EImplArg e) = unInt e +unInt _ = Nothing + +-- | Constructs an expression from real number literal +mkDouble :: Double -> Expr +mkDouble f = ELit (LFlt f) + +-- | Decomposes an expression into real number literal +unDouble :: Expr -> Maybe Double +unDouble (ELit (LFlt f)) = Just f +unDouble (ETyped e ty) = unDouble e +unDouble (EImplArg e) = unDouble e +unDouble _ = Nothing + +mkFloat = mkDouble +unFloat = unDouble + +-- | Constructs an expression which is meta variable +mkMeta :: Int -> Expr +mkMeta i = EMeta i + +-- | Checks whether an expression is a meta variable +unMeta :: Expr -> Maybe Int +unMeta (EMeta i) = Just i +unMeta (ETyped e ty) = unMeta e +unMeta (EImplArg e) = unMeta e +unMeta _ = Nothing + +----------------------------------------------------- +-- Parsing +----------------------------------------------------- + +pExpr :: RP.ReadP Expr +pExpr = RP.skipSpaces >> (pAbs RP.<++ pTerm) + where + pTerm = do f <- pFactor + RP.skipSpaces + as <- RP.sepBy pArg RP.skipSpaces + return (foldl EApp f as) + + pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") pBinds + e <- pExpr + return (foldr (\(b,x) e -> EAbs b x e) e xs) + +pBinds :: RP.ReadP [(BindType,CId)] +pBinds = do xss <- RP.sepBy1 (RP.skipSpaces >> pBind) (RP.skipSpaces >> RP.char ',') + return (concat xss) + where + pCIdOrWild = pCId `mplus` (RP.char '_' >> return wildCId) + + pBind = + do x <- pCIdOrWild + return [(Explicit,x)] + `mplus` + RP.between (RP.char '{') + (RP.skipSpaces >> RP.char '}') + (RP.sepBy1 (RP.skipSpaces >> pCIdOrWild >>= \id -> return (Implicit,id)) (RP.skipSpaces >> RP.char ',')) + +pArg = fmap EImplArg (RP.between (RP.char '{') (RP.char '}') pExpr) + RP.<++ + pFactor + +pFactor = fmap EFun pCId + RP.<++ fmap ELit pLit + RP.<++ fmap EMeta pMeta + RP.<++ RP.between (RP.char '(') (RP.skipSpaces >> RP.char ')') pExpr + RP.<++ RP.between (RP.char '<') (RP.skipSpaces >> RP.char '>') pTyped + +pTyped = do RP.skipSpaces + e <- pExpr + RP.skipSpaces + RP.char ':' + RP.skipSpaces + ty <- pType + return (ETyped e ty) + +pMeta = do RP.char '?' + ds <- RP.munch isDigit + return (read ('0':ds)) + +pLit :: RP.ReadP Literal +pLit = liftM LStr (RP.readS_to_P reads) + RP.<++ + liftM LInt (RP.readS_to_P reads) + RP.<++ + liftM LFlt (RP.readS_to_P reads) + + +----------------------------------------------------- +-- Printing +----------------------------------------------------- + +ppExpr :: Int -> [CId] -> Expr -> PP.Doc +ppExpr d scope (EAbs b x e) = let (bs,xs,e1) = getVars [] [] (EAbs b x e) + in ppParens (d > 1) (PP.char '\\' PP.<> + PP.hsep (PP.punctuate PP.comma (reverse (List.zipWith ppBind bs xs))) PP.<+> + PP.text "->" PP.<+> + ppExpr 1 (xs++scope) e1) + where + getVars bs xs (EAbs b x e) = getVars (b:bs) ((freshName x xs):xs) e + getVars bs xs e = (bs,xs,e) +ppExpr d scope (EApp e1 e2) = ppParens (d > 3) ((ppExpr 3 scope e1) PP.<+> (ppExpr 4 scope e2)) +ppExpr d scope (ELit l) = ppLit l +ppExpr d scope (EMeta n) = ppMeta n +ppExpr d scope (EFun f) = ppCId f +ppExpr d scope (EVar i) = ppCId (scope !! i) +ppExpr d scope (ETyped e ty)= PP.char '<' PP.<> ppExpr 0 scope e PP.<+> PP.colon PP.<+> ppType 0 scope ty PP.<> PP.char '>' +ppExpr d scope (EImplArg e) = PP.braces (ppExpr 0 scope e) + +ppPatt :: Int -> [CId] -> Patt -> PP.Doc +ppPatt d scope (PApp f ps) = let ds = List.map (ppPatt 2 scope) ps + in ppParens (not (List.null ps) && d > 1) (ppCId f PP.<+> PP.hsep ds) +ppPatt d scope (PLit l) = ppLit l +ppPatt d scope (PVar f) = ppCId f +ppPatt d scope (PAs x p) = ppCId x PP.<> PP.char '@' PP.<> ppPatt 3 scope p +ppPatt d scope PWild = PP.char '_' +ppPatt d scope (PImplArg p) = PP.braces (ppPatt 0 scope p) +ppPatt d scope (PTilde e) = PP.char '~' PP.<> ppExpr 6 scope e + +pattScope :: [CId] -> Patt -> [CId] +pattScope scope (PApp f ps) = foldl pattScope scope ps +pattScope scope (PLit l) = scope +pattScope scope (PVar f) = f:scope +pattScope scope (PAs x p) = pattScope (x:scope) p +pattScope scope PWild = scope +pattScope scope (PImplArg p) = pattScope scope p +pattScope scope (PTilde e) = scope + +ppBind Explicit x = ppCId x +ppBind Implicit x = PP.braces (ppCId x) + +ppMeta :: MetaId -> PP.Doc +ppMeta n + | n == 0 = PP.char '?' + | otherwise = PP.char '?' PP.<> PP.int n + +ppParens True = PP.parens +ppParens False = id + +freshName :: CId -> [CId] -> CId +freshName x xs0 = loop 1 x + where + xs = wildCId : xs0 + + loop i y + | elem y xs = loop (i+1) (mkCId (show x++show i)) + | otherwise = y + + +----------------------------------------------------- +-- Computation +----------------------------------------------------- + +-- | Compute an expression to normal form +normalForm :: Sig -> Int -> Env -> Expr -> Expr +normalForm sig k env e = value2expr sig k (eval sig env e) + +value2expr sig i (VApp f vs) = foldl EApp (EFun f) (List.map (value2expr sig i) vs) +value2expr sig i (VGen j vs) = foldl EApp (EVar (i-j-1)) (List.map (value2expr sig i) vs) +value2expr sig i (VMeta j env vs) = case snd sig j of + Just e -> value2expr sig i (apply sig env e vs) + Nothing -> foldl EApp (EMeta j) (List.map (value2expr sig i) vs) +value2expr sig i (VSusp j env vs k) = value2expr sig i (k (VGen j vs)) +value2expr sig i (VConst f vs) = foldl EApp (EFun f) (List.map (value2expr sig i) vs) +value2expr sig i (VLit l) = ELit l +value2expr sig i (VClosure env (EAbs b x e)) = EAbs b (mkCId ('v':show i)) (value2expr sig (i+1) (eval sig ((VGen i []):env) e)) +value2expr sig i (VImplArg v) = EImplArg (value2expr sig i v) + +data Value + = VApp CId [Value] + | VLit Literal + | VMeta {-# UNPACK #-} !MetaId Env [Value] + | VSusp {-# UNPACK #-} !MetaId Env [Value] (Value -> Value) + | VGen {-# UNPACK #-} !Int [Value] + | VConst CId [Value] + | VClosure Env Expr + | VImplArg Value + +type Sig = ( Map.Map CId (Type,Int,Maybe ([Equation],[[Instr]]),Double) -- type and def of a fun + , Int -> Maybe Expr -- lookup for metavariables + ) +type Env = [Value] + +eval :: Sig -> Env -> Expr -> Value +eval sig env (EVar i) = env !! i +eval sig env (EFun f) = case Map.lookup f (fst sig) of + Just (_,a,meqs,_) -> case meqs of + Just (eqs,_) + -> if a == 0 + then case eqs of + Equ [] e : _ -> eval sig [] e + _ -> VConst f [] + else VApp f [] + Nothing -> VApp f [] + Nothing -> error ("unknown function "++showCId f) +eval sig env (EApp e1 e2) = apply sig env e1 [eval sig env e2] +eval sig env (EAbs b x e) = VClosure env (EAbs b x e) +eval sig env (EMeta i) = case snd sig i of + Just e -> eval sig env e + Nothing -> VMeta i env [] +eval sig env (ELit l) = VLit l +eval sig env (ETyped e _) = eval sig env e +eval sig env (EImplArg e) = VImplArg (eval sig env e) + +apply :: Sig -> Env -> Expr -> [Value] -> Value +apply sig env e [] = eval sig env e +apply sig env (EVar i) vs = applyValue sig (env !! i) vs +apply sig env (EFun f) vs = case Map.lookup f (fst sig) of + Just (_,a,meqs,_) -> case meqs of + Just (eqs,_) -> if a <= length vs + then match sig f eqs vs + else VApp f vs + Nothing -> VApp f vs + Nothing -> error ("unknown function "++showCId f) +apply sig env (EApp e1 e2) vs = apply sig env e1 (eval sig env e2 : vs) +apply sig env (EAbs b x e) (v:vs) = case (b,v) of + (Implicit,VImplArg v) -> apply sig (v:env) e vs + (Explicit, v) -> apply sig (v:env) e vs +apply sig env (EMeta i) vs = case snd sig i of + Just e -> apply sig env e vs + Nothing -> VMeta i env vs +apply sig env (ELit l) vs = error "literal of function type" +apply sig env (ETyped e _) vs = apply sig env e vs +apply sig env (EImplArg _) vs = error "implicit argument in function position" + +applyValue sig v [] = v +applyValue sig (VApp f vs0) vs = apply sig [] (EFun f) (vs0++vs) +applyValue sig (VLit _) vs = error "literal of function type" +applyValue sig (VMeta i env vs0) vs = VMeta i env (vs0++vs) +applyValue sig (VGen i vs0) vs = VGen i (vs0++vs) +applyValue sig (VSusp i env vs0 k) vs = VSusp i env vs0 (\v -> applyValue sig (k v) vs) +applyValue sig (VConst f vs0) vs = VConst f (vs0++vs) +applyValue sig (VClosure env (EAbs b x e)) (v:vs) = case (b,v) of + (Implicit,VImplArg v) -> apply sig (v:env) e vs + (Explicit, v) -> apply sig (v:env) e vs +applyValue sig (VImplArg _) vs = error "implicit argument in function position" + +----------------------------------------------------- +-- Pattern matching +----------------------------------------------------- + +match :: Sig -> CId -> [Equation] -> [Value] -> Value +match sig f eqs as0 = + case eqs of + [] -> VConst f as0 + (Equ ps res):eqs -> tryMatches eqs ps as0 res [] + where + tryMatches eqs [] as res env = apply sig env res as + tryMatches eqs (p:ps) (a:as) res env = tryMatch p a env + where + tryMatch (PVar x ) (v ) env = tryMatches eqs ps as res (v:env) + tryMatch (PAs x p ) (v ) env = tryMatch p v (v:env) + tryMatch (PWild ) (_ ) env = tryMatches eqs ps as res env + tryMatch (p ) (VMeta i envi vs ) env = VSusp i envi vs (\v -> tryMatch p v env) + tryMatch (p ) (VGen i vs ) env = VConst f as0 + tryMatch (p ) (VSusp i envi vs k) env = VSusp i envi vs (\v -> tryMatch p (k v) env) + tryMatch (p ) v@(VConst _ _ ) env = VConst f as0 + tryMatch (PApp f1 ps1) (VApp f2 vs2 ) env | f1 == f2 = tryMatches eqs (ps1++ps) (vs2++as) res env + tryMatch (PLit l1 ) (VLit l2 ) env | l1 == l2 = tryMatches eqs ps as res env + tryMatch (PImplArg p ) (VImplArg v ) env = tryMatch p v env + tryMatch (PTilde _ ) (_ ) env = tryMatches eqs ps as res env + tryMatch _ _ env = match sig f eqs as0 +
@@ -0,0 +1,28 @@+module PGF.Expr where + +import PGF.CId +import qualified Text.PrettyPrint as PP +import qualified Text.ParserCombinators.ReadP as RP + +data Expr + +instance Eq Expr +instance Ord Expr +instance Show Expr + + +data BindType = Explicit | Implicit + +instance Eq BindType +instance Ord BindType +instance Show BindType + + +pArg :: RP.ReadP Expr +pBinds :: RP.ReadP [(BindType,CId)] + +ppExpr :: Int -> [CId] -> Expr -> PP.Doc + +freshName :: CId -> [CId] -> CId + +ppParens :: Bool -> PP.Doc -> PP.Doc
@@ -0,0 +1,210 @@+{-# LANGUAGE TypeSynonymInstances #-} + +------------------------------------------------- +-- | +-- Module : PGF +-- Maintainer : Krasimir Angelov +-- Stability : stable +-- Portability : portable +-- +-- Forest is a compact representation of a set +-- of parse trees. This let us to efficiently +-- represent local ambiguities +-- +------------------------------------------------- + +module PGF.Forest( Forest(..) + , BracketedString, showBracketedString, lengthBracketedString + , linearizeWithBrackets + , getAbsTrees + ) where + +import PGF.CId +import PGF.Data +import PGF.Macros +import PGF.TypeCheck +import PGF.Generate +import Data.List +import Data.Array.IArray +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified Data.IntSet as IntSet +import qualified Data.IntMap as IntMap +import Control.Monad +import Control.Monad.State +import PGF.Utilities (nub') + +data Forest + = Forest + { abstr :: Abstr + , concr :: Concr + , forest :: IntMap.IntMap (Set.Set Production) + , root :: [([Symbol],[PArg])] + } + +-------------------------------------------------------------------- +-- Rendering of bracketed strings +-------------------------------------------------------------------- + +linearizeWithBrackets :: Maybe Int -> Forest -> BracketedString +linearizeWithBrackets dp = head . snd . untokn Nothing . (:[]) .bracketedTokn dp + +--------------------------------------------------------------- +-- Internally we have to do everything with Tokn first because +-- we must handle the pre {...} construction. +-- + +bracketedTokn :: Maybe Int -> Forest -> BracketedTokn +bracketedTokn dp f@(Forest abs cnc forest root) = + case [computeSeq isTrusted seq (map (render forest) args) | (seq,args) <- root] of + ([bs@(Bracket_{})]:_) -> bs + (bss:_) -> Bracket_ wildCId 0 0 wildCId [] bss + [] -> Bracket_ wildCId 0 0 wildCId [] [] + where + isTrusted (_,fid) = IntSet.member fid trusted + + trusted = foldl1 IntSet.intersection [IntSet.unions (map (trustedSpots IntSet.empty) args) | (_,args) <- root] + + render forest arg@(PArg hypos fid) = + case IntMap.lookup fid forest >>= Set.maxView of + Just (p,set) -> let (ct,fid',fun,es,(_,lin)) = descend (if Set.null set then forest else IntMap.insert fid set forest) p + in (ct,fid',fun,es,(map getVar hypos,lin)) + Nothing -> error ("wrong forest id " ++ show fid) + where + descend forest (PApply funid args) = let (CncFun fun _lins) = cncfuns cnc ! funid + cat = case isLindefCId fun of + Just cat -> cat + Nothing -> case Map.lookup fun (funs abs) of + Just (DTyp _ cat _,_,_,_) -> cat + largs = map (render forest) args + ltable = mkLinTable cnc isTrusted [] funid largs + in ((cat,fid),0,wildCId,either (const []) id $ getAbsTrees f arg Nothing dp,ltable) + descend forest (PCoerce fid) = render forest (PArg [] fid) + descend forest (PConst cat e ts) = ((cat,fid),0,wildCId,[e],([],listArray (0,0) [map LeafKS ts])) + + getVar (fid,_) + | fid == fidVar = wildCId + | otherwise = x + where + (x:_) = [x | PConst _ (EFun x) _ <- maybe [] Set.toList (IntMap.lookup fid forest)] + + trustedSpots parents (PArg _ fid) + | fid < totalCats cnc || -- forest ids from the grammar correspond to metavariables + IntSet.member fid parents -- this avoids loops in the grammar + = IntSet.empty + | otherwise = IntSet.insert fid $ + case IntMap.lookup fid forest of + Just prods -> foldl1 IntSet.intersection [descend prod | prod <- Set.toList prods] + Nothing -> IntSet.empty + where + parents' = IntSet.insert fid parents + + descend (PApply funid args) = IntSet.unions (map (trustedSpots parents') args) + descend (PCoerce fid) = trustedSpots parents' (PArg [] fid) + descend (PConst c e _) = IntSet.empty + +isLindefCId id + | take l s == lindef = Just (mkCId (drop l s)) + | otherwise = Nothing + where + s = showCId id + lindef = "lindef " + l = length lindef + +-- | This function extracts the list of all completed parse trees +-- that spans the whole input consumed so far. The trees are also +-- limited by the category specified, which is usually +-- the same as the startup category. +getAbsTrees :: Forest -> PArg -> Maybe Type -> Maybe Int -> Either [(FId,TcError)] [Expr] +getAbsTrees (Forest abs cnc forest root) arg@(PArg _ fid) ty dp = + let (err,res) = runTcM abs (do e <- go Set.empty emptyScope (fmap (TTyp []) ty) arg + generateForForest (prove dp) e) emptyMetaStore fid + in if null res + then Left (nub err) + else Right (nub' [e | (_,_,e) <- res]) + where + go rec_ scope_ mb_tty_ (PArg hypos fid) + | fid < totalCats cnc = case mb_tty of + Just tty -> do i <- newMeta scope tty + return (mkAbs (EMeta i)) + Nothing -> mzero + | Set.member fid rec_ = mzero + | otherwise = do fid0 <- get + put fid + x <- foldForest (\funid args trees -> + do let CncFun fn _lins = cncfuns cnc ! funid + case isLindefCId fn of + Just _ -> do arg <- go (Set.insert fid rec_) scope mb_tty (head args) + return (mkAbs arg) + Nothing -> do ty_fn <- lookupFunType fn + (e,tty0) <- foldM (\(e1,tty) arg -> goArg (Set.insert fid rec_) scope fid e1 arg tty) + (EFun fn,TTyp [] ty_fn) args + case mb_tty of + Just tty -> do i <- newGuardedMeta e + eqType scope (scopeSize scope) i tty tty0 + Nothing -> return () + return (mkAbs e) + `mplus` + trees) + (\const _ trees -> do + const <- case mb_tty of + Just tty -> tcExpr scope const tty + Nothing -> fmap fst $ infExpr scope const + return (mkAbs const) + `mplus` + trees) + mzero fid forest + put fid0 + return x + + where + (scope,mkAbs,mb_tty) = updateScope hypos scope_ id mb_tty_ + + goArg rec_ scope fid e1 arg (TTyp delta (DTyp ((bt,x,ty):hs) c es)) = do + e2' <- go rec_ scope (Just (TTyp delta ty)) arg + let e2 = case bt of + Explicit -> e2' + Implicit -> EImplArg e2' + if x == wildCId + then return (EApp e1 e2,TTyp delta (DTyp hs c es)) + else do v2 <- eval (scopeEnv scope) e2' + return (EApp e1 e2,TTyp (v2:delta) (DTyp hs c es)) + + updateScope [] scope mkAbs mb_tty = (scope,mkAbs,mb_tty) + updateScope ((fid,_):hypos) scope mkAbs mb_tty = + case mb_tty of + Just (TTyp delta (DTyp ((bt,y,ty):hs) c es)) -> + if y == wildCId + then updateScope hypos (addScopedVar x (TTyp delta ty) scope) + (mkAbs . EAbs bt x) + (Just (TTyp delta (DTyp hs c es))) + else updateScope hypos (addScopedVar x (TTyp delta ty) scope) + (mkAbs . EAbs bt x) + (Just (TTyp ((VGen (scopeSize scope) []):delta) (DTyp hs c es))) + Nothing -> (scope,mkAbs,Nothing) + where + (x:_) | fid == fidVar = [wildCId] + | otherwise = [x | PConst _ (EFun x) _ <- maybe [] Set.toList (IntMap.lookup fid forest)] + +foldForest :: (FunId -> [PArg] -> b -> b) -> (Expr -> [String] -> b -> b) -> b -> FId -> IntMap.IntMap (Set.Set Production) -> b +foldForest f g b fcat forest = + case IntMap.lookup fcat forest of + Nothing -> b + Just set -> Set.foldr foldProd b set + where + foldProd (PCoerce fcat) b = foldForest f g b fcat forest + foldProd (PApply funid args) b = f funid args b + foldProd (PConst _ const toks) b = g const toks b + + +------------------------------------------------------------------------------ +-- Selectors + +instance Selector FId where + splitSelector s = (s,s) + select cat scope dp = do + gens <- typeGenerators scope cat + TcM (\abstr k h -> iter k gens) + where + iter k [] ms s = id + iter k ((_,e,tty):fns) ms s = k (e,tty) ms s . iter k fns ms s
@@ -0,0 +1,216 @@+module PGF.Generate + ( generateAll, generateAllDepth+ , generateFrom, generateFromDepth+ , generateRandom, generateRandomDepth+ , generateRandomFrom, generateRandomFromDepth+ , generateOntology, generateOntologyDepth+ , prove+ ) where++import PGF.CId+import PGF.Data+import PGF.TypeCheck+import Control.Monad+import Control.Monad.State+import Control.Monad.Identity+import System.Random+import Data.Maybe(isNothing)++------------------------------------------------------------------------------+-- The API++-- | Generates an exhaustive possibly infinite list of+-- abstract syntax expressions.+generateAll :: PGF -> Type -> [Expr]+generateAll pgf ty = generateAllDepth pgf ty Nothing++-- | A variant of 'generateAll' which also takes as argument+-- the upper limit of the depth of the generated expression.+generateAllDepth :: PGF -> Type -> Maybe Int -> [Expr]+generateAllDepth pgf ty dp = generate () pgf ty dp++-- | Generates a list of abstract syntax expressions+-- in a way similar to 'generateAll' but instead of+-- generating all instances of a given type, this+-- function uses a template. +generateFrom :: PGF -> Expr -> [Expr]+generateFrom pgf ex = generateFromDepth pgf ex Nothing++-- | A variant of 'generateFrom' which also takes as argument+-- the upper limit of the depth of the generated subexpressions.+generateFromDepth :: PGF -> Expr -> Maybe Int -> [Expr]+generateFromDepth pgf e dp = + [e | (_,_,e) <- snd $ runTcM (abstract pgf)+ (generateForMetas (prove dp) e)+ emptyMetaStore ()]++-- | Generates an infinite list of random abstract syntax expressions.+-- This is usefull for tree bank generation which after that can be used+-- for grammar testing.+generateRandom :: RandomGen g => g -> PGF -> Type -> [Expr]+generateRandom g pgf ty = generateRandomDepth g pgf ty Nothing++-- | A variant of 'generateRandom' which also takes as argument+-- the upper limit of the depth of the generated expression.+generateRandomDepth :: RandomGen g => g -> PGF -> Type -> Maybe Int -> [Expr]+generateRandomDepth g pgf ty dp = restart g (\g -> generate (Identity g) pgf ty dp)++-- | Random generation based on template+generateRandomFrom :: RandomGen g => g -> PGF -> Expr -> [Expr]+generateRandomFrom g pgf e = generateRandomFromDepth g pgf e Nothing++-- | Random generation based on template with a limitation in the depth.+generateRandomFromDepth :: RandomGen g => g -> PGF -> Expr -> Maybe Int -> [Expr]+generateRandomFromDepth g pgf e dp = + restart g (\g -> [e | (_,ms,e) <- snd $ runTcM (abstract pgf)+ (generateForMetas (prove dp) e)+ emptyMetaStore (Identity g)])++generateOntology :: RandomGen g => g -> PGF -> Type -> [(Maybe Expr, Type)] -> [Expr]+generateOntology g pgf ty args = generateOntologyDepth g pgf ty args Nothing++generateOntologyDepth :: RandomGen g => g -> PGF -> Type -> [(Maybe Expr, Type)] -> Maybe Int -> [Expr]+generateOntologyDepth g pgf ty args dp =+ restart g (\g -> [e | (_,(Ontology args' _),e) <- snd $ runTcM (abstract pgf)+ (prove dp emptyScope (TTyp [] ty) >>= checkResolvedMetaStore emptyScope)+ emptyMetaStore+ (Ontology args g),+ all (isNothing . fst) args'])++------------------------------------------------------------------------------+-- The main generation algorithm++generate :: Selector sel => sel -> PGF -> Type -> Maybe Int -> [Expr]+generate sel pgf ty dp =+ [e | (_,ms,e) <- snd $ runTcM (abstract pgf)+ (prove dp emptyScope (TTyp [] ty) >>= checkResolvedMetaStore emptyScope)+ emptyMetaStore sel]+++prove :: Selector sel => Maybe Int -> Scope -> TType -> TcM sel Expr+prove dp scope (TTyp env1 (DTyp hypos1 cat es1)) = do+ vs1 <- mapM (PGF.TypeCheck.eval env1) es1+ let scope' = exScope scope env1 hypos1+ (fe,TTyp env2 (DTyp hypos2 _ es2)) <- select cat scope' dp+ case dp of+ Just 0 | not (null hypos2) -> mzero+ _ -> return ()+ (env2,args) <- mkEnv scope' env2 hypos2+ vs2 <- mapM (PGF.TypeCheck.eval env2) es2+ sequence_ [eqValue mzero suspend (scopeSize scope') v1 v2 | (v1,v2) <- zip vs1 vs2]+ es <- mapM (descend scope') args+ return (abs hypos1 (foldl EApp fe es))+ where+ suspend i c = do+ mv <- getMeta i+ case mv of+ MBound e -> c e+ MUnbound x scope tty cs -> setMeta i (MUnbound x scope tty (c:cs))++ abs [] e = e+ abs ((bt,x,ty):hypos) e = EAbs bt x (abs hypos e)++ exScope scope env [] = scope+ exScope scope env ((bt,x,ty):hypos) = + let env' | x /= wildCId = VGen (scopeSize scope) [] : env+ | otherwise = env+ in exScope (addScopedVar x (TTyp env ty) scope) env' hypos++ mkEnv scope env [] = return (env,[])+ mkEnv scope env ((bt,x,ty):hypos) = do+ (env,arg) <- if x /= wildCId+ then do i <- newMeta scope (TTyp env ty)+ return (VMeta i (scopeEnv scope) [] : env,Right (EMeta i))+ else return (env,Left (TTyp env ty))+ (env,args) <- mkEnv scope env hypos+ return (env,(bt,arg):args)++ descend scope (bt,arg) = do+ let dp' = fmap (flip (-) 1) dp+ e <- case arg of+ Right e -> return e+ Left tty -> prove dp' scope tty+ e <- case bt of+ Implicit -> return (EImplArg e)+ Explicit -> return e+ return e+++-- Helper function for random generation. After every+-- success we must restart the search to find sufficiently different solution.+restart :: RandomGen g => g -> (g -> [a]) -> [a]+restart g f =+ let (g1,g2) = split g+ in case f g1 of+ [] -> []+ (x:xs) -> x : restart g2 f+++------------------------------------------------------------------------------+-- Selectors++instance Selector () where+ splitSelector s = (s,s)+ select cat scope dp = do+ gens <- typeGenerators scope cat+ TcM (\abstr k h -> iter k gens)+ where+ iter k [] ms s = id+ iter k ((_,e,tty):fns) ms s = k (e,tty) ms s . iter k fns ms s+++instance RandomGen g => Selector (Identity g) where+ splitSelector (Identity g) = let (g1,g2) = split g+ in (Identity g1, Identity g2)++ select cat scope dp = do+ gens <- typeGenerators scope cat+ TcM (\abstr k h -> iter k 1.0 gens)+ where+ iter k p [] ms (Identity g) = id+ iter k p gens ms (Identity g) = let (d,g') = randomR (0.0,p) g+ (g1,g2) = split g'+ (p',e_ty,gens') = hit d gens+ in k e_ty ms (Identity g1) . iter k (p-p') gens' ms (Identity g2)++ hit :: Double -> [(Double,Expr,TType)] -> (Double,(Expr,TType),[(Double,Expr,TType)])+ hit d (gen@(p,e,ty):gens)+ | d < p || null gens = (p,(e,ty),gens)+ | otherwise = let (p',e_ty',gens') = hit (d-p) gens+ in (p',e_ty',gen:gens')+++data Ontology a = Ontology [(Maybe Expr, Type)] a++instance RandomGen g => Selector (Ontology g) where+ splitSelector (Ontology args g) = let (g1,g2) = split g+ in (Ontology args g1, Ontology args g2)++ select cat scope dp = do+ Ontology args g <- get+ case pickArg [] cat args of+ [] -> do gens <- typeGenerators scope cat+ TcM (\abstr k h -> iter k 1.0 gens)+ alts -> msum [ case mb_e of+ Just e -> do put (Ontology args g)+ return (e, TTyp [] ty)+ Nothing -> mzero+ | (mb_e,ty,args) <- alts]+ where+ iter k p [] ms (Ontology ce g) = id+ iter k p gens ms (Ontology ce g) =+ let (d,g') = randomR (0.0,p) g+ (g1,g2) = split g'+ (p',e_ty,gens') = hit d gens+ in k e_ty ms (Ontology ce g1) . iter k (p-p') gens' ms (Ontology ce g2)++ hit :: Double -> [(Double,Expr,TType)] -> (Double,(Expr,TType),[(Double,Expr,TType)])+ hit d (gen@(p,e,ty):gens) | d < p || null gens = (p,(e,ty),gens)+ | otherwise = let (p',e_ty',gens') = hit (d-p) gens+ in (p',e_ty',gen:gens')++ pickArg args' cat' [] = []+ pickArg args' cat' (arg@(mb_e,ty@(DTyp _ cat _)):args)+ | cat' == cat = (mb_e, ty, foldl (flip (:)) args args') : + pickArg (arg:args') cat' args+ | otherwise = pickArg (arg:args') cat' args
@@ -0,0 +1,78 @@+-- | Auxiliary types and functions for use with grammars translated to Haskell+-- with @gf -output-format=haskell -haskell=concrete@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+module PGF.Haskell where+import Control.Applicative((<$>),(<*>))+import Control.Monad(join)+import Data.Char(toUpper)+import Data.List(isPrefixOf)+import qualified Data.Map as M++-- ** Concrete syntax++-- | For enumerating parameter values used in tables+class EnumAll a where enumAll :: [a]++-- | Tables+table vs = let m = M.fromList (zip enumAll vs) in (M.!) m+++-- | Token sequences, output form linearization functions+type Str = [Tok] -- token sequence++-- | Tokens+data Tok = TK String | TP [([Prefix],Str)] Str | BIND | SOFT_BIND | SOFT_SPACE | CAPIT | ALL_CAPIT+ deriving (Eq,Ord,Show)++type Prefix = String -- ^ To be matched with the prefix of a following token++-- | Render a token sequence as a 'String'+fromStr :: Str -> String+fromStr = from False id+ where+ from space cap ts =+ case ts of+ [] -> []+ TK s:ts -> put s++from True cap ts+ BIND:ts -> from False cap ts+ SOFT_BIND:ts -> from False cap ts+ SOFT_SPACE:ts -> from True cap ts+ CAPIT:ts -> from space toUpper1 ts+ ALL_CAPIT:ts -> from space toUpperAll ts+ TP alts def:ts -> from space cap (pick alts def r++[TK r]) -- hmm+ where r = fromStr ts+ where+ put s = [' '|space]++cap s++ toUpper1 (c:s) = toUpper c:s+ toUpper1 s = s++ toUpperAll = map toUpper++ pick alts def r = head ([str|(ps,str)<-alts,any (`isPrefixOf` r) ps]++[def])++-- *** Common record types++-- | Overloaded function to project the @s@ field from any record type+class Has_s r a | r -> a where proj_s :: r -> a++-- | Haskell representation of the GF record type @{s:t}@+data R_s t = R_s t deriving (Eq,Ord,Show)+instance (EnumAll t) => EnumAll (R_s t) where enumAll = R_s <$> enumAll+instance Has_s (R_s t) t where proj_s (R_s t) = t++-- | Coerce from any record type @{...,s:t,...}@ to the supertype @{s:t}@+to_R_s r = R_s (proj_s r)+++-- *** Variants++infixr 5 +++++-- | Concatenation with variants+xs +++ ys = (++) <$> xs <*> ys++-- | Selection from tables with variants+t ! p = join (t p)+t !$ p = join (t <$> p)+t !* p = join (t <*> p)
@@ -0,0 +1,19 @@+{-# OPTIONS_HADDOCK hide #-}+-------------------------------------------------+-- |+-- Stability : unstable+--+-------------------------------------------------+module PGF.Internal(module Internal) where+import PGF.Binary as Internal+import PGF.Data as Internal+import PGF.Macros as Internal+import PGF.Optimize as Internal+import PGF.Printer as Internal+import PGF.Utilities as Internal+import PGF.ByteCode as Internal++import Data.Binary as Internal+import Data.Binary.Get as Internal+import Data.Binary.IEEE754 as Internal+import Data.Binary.Put as Internal
@@ -0,0 +1,135 @@+{-# LANGUAGE FlexibleContexts #-}+module PGF.Linearize+ ( linearize+ , linearizeAll+ , linearizeAllLang+ , bracketedLinearize+ , bracketedLinearizeAll+ , tabularLinearizes+ ) where++import PGF.CId+import PGF.Data+import PGF.Macros+import PGF.Expr+import Data.Array.IArray+import Data.List+--import Control.Monad+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import qualified Data.Set as Set++--------------------------------------------------------------------+-- The API+--------------------------------------------------------------------++-- | Linearizes given expression as string in the language+linearize :: PGF -> Language -> Tree -> String+linearize pgf lang = concat . take 1 . map (unwords . concatMap flattenBracketedString . snd . untokn Nothing . firstLin cnc) . linTree pgf cnc+ where+ cnc = lookMap (error "no lang") lang (concretes pgf)++-- | The same as 'linearizeAllLang' but does not return+-- the language.+linearizeAll :: PGF -> Tree -> [String]+linearizeAll pgf = map snd . linearizeAllLang pgf++-- | Linearizes given expression as string in all languages+-- available in the grammar.+linearizeAllLang :: PGF -> Tree -> [(Language,String)]+linearizeAllLang pgf t = [(lang,linearize pgf lang t) | lang <- Map.keys (concretes pgf)]++-- | Linearizes given expression as a bracketed string in the language+bracketedLinearize :: PGF -> Language -> Tree -> [BracketedString]+bracketedLinearize pgf lang = head . map (snd . untokn Nothing . firstLin cnc) . linTree pgf cnc+ where+ cnc = lookMap (error "no lang") lang (concretes pgf)++ head [] = []+ head (bs:bss) = bs++-- | Linearizes given expression as a bracketed string in the language+bracketedLinearizeAll :: PGF -> Language -> Tree -> [[BracketedString]]+bracketedLinearizeAll pgf lang = map (snd . untokn Nothing . firstLin cnc) . linTree pgf cnc+ where+ cnc = lookMap (error "no lang") lang (concretes pgf)++firstLin cnc arg@(ct@(cat,n_fid),fid,fun,es,(xs,lin)) =+ case IntMap.lookup fid (linrefs cnc) of+ Just (funid:_) -> snd (mkLinTable cnc (const True) [] funid [arg]) ! 0+ _ -> [LeafKS []]++-- | Creates a table from feature name to linearization. +-- The outher list encodes the variations+tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]+tabularLinearizes pgf lang e = map cnv (linTree pgf cnc e)+ where+ cnc = lookMap (error "no lang") lang (concretes pgf)++ cnv (ct@(cat,_),_,_,_,(_,lin)) = zip (lbls cat) $ map (unwords . concatMap flattenBracketedString . snd . untokn Nothing) (elems lin)++ lbls cat = case Map.lookup cat (cnccats (lookConcr pgf lang)) of+ Just (CncCat _ _ lbls) -> elems lbls+ Nothing -> error "No labels"++--------------------------------------------------------------------+-- Implementation+--------------------------------------------------------------------++linTree :: PGF -> Concr -> Expr -> [(CncType, FId, CId, [Expr], LinTable)]+linTree pgf cnc e = nub (map snd (lin Nothing 0 e [] [] e []))+ where+ lp = lproductions cnc++ lin mb_cty n_fid e0 ys xs (EAbs _ x e) es = lin mb_cty n_fid e0 ys (x:xs) e es+ lin mb_cty n_fid e0 ys xs (EApp e1 e2) es = lin mb_cty n_fid e0 ys xs e1 (e2:es)+ lin mb_cty n_fid e0 ys xs (EImplArg e) es = lin mb_cty n_fid e0 ys xs e es+ lin mb_cty n_fid e0 ys xs (ETyped e _) es = lin mb_cty n_fid e0 ys xs e es+ lin mb_cty n_fid e0 ys xs (EFun f) es = apply mb_cty n_fid e0 ys xs f es+ lin mb_cty n_fid e0 ys xs (EMeta i) es = def mb_cty n_fid e0 ys xs ('?':show i)+ lin mb_cty n_fid e0 ys xs (EVar i) _ = def mb_cty n_fid e0 ys xs (showCId ((xs++ys) !! i))+ lin mb_cty n_fid e0 ys xs (ELit l) [] = case l of+ LStr s -> return (n_fid+1,((cidString,n_fid),fidString,wildCId,[e0],([],ss s)))+ LInt n -> return (n_fid+1,((cidInt, n_fid),fidInt, wildCId,[e0],([],ss (show n))))+ LFlt f -> return (n_fid+1,((cidFloat, n_fid),fidFloat, wildCId,[e0],([],ss (show f))))++ ss s = listArray (0,0) [[LeafKS s]]++ apply :: Maybe CncType -> FId -> Expr -> [CId] -> [CId] -> CId -> [Expr] -> [(FId,(CncType, FId, CId, [Expr], LinTable))]+ apply mb_cty n_fid e0 ys xs f es =+ case Map.lookup f lp of+ Just prods -> do (funid,(cat,fid),ctys) <- getApps prods+ (n_fid,args) <- descend n_fid (zip ctys es)+ return (n_fid+1,((cat,n_fid),fid,f,[e0],mkLinTable cnc (const True) xs funid args))+ Nothing -> def mb_cty n_fid e0 ys xs ("[" ++ showCId f ++ "]") -- fun without lin+ where+ getApps prods =+ case mb_cty of+ Just (cat,fid) -> maybe [] (concatMap (toApp fid) . Set.toList) (IntMap.lookup fid prods)+ Nothing -> concat [toApp fid prod | (fid,set) <- IntMap.toList prods, prod <- Set.toList set]+ where+ toApp fid (PApply funid pargs) =+ let Just (ty,_,_,_) = Map.lookup f (funs (abstract pgf))+ (args,res) = catSkeleton ty+ in [(funid,(res,fid),zip args [fid | PArg _ fid <- pargs])]+ toApp _ (PCoerce fid) = + maybe [] (concatMap (toApp fid) . Set.toList) (IntMap.lookup fid prods)++ descend n_fid [] = return (n_fid,[])+ descend n_fid ((cty,e):fes) = do (n_fid,arg) <- lin (Just cty) n_fid e (xs++ys) [] e []+ (n_fid,args) <- descend n_fid fes+ return (n_fid,arg:args)++ def (Just (cat,fid)) n_fid e0 ys xs s =+ case IntMap.lookup fid (lindefs cnc) of+ Just funs -> do funid <- funs+ let args = [((wildCId, n_fid),fidString,wildCId,[e0],([],ss s))]+ return (n_fid+2,((cat,n_fid+1),fid,wildCId,[e0],mkLinTable cnc (const True) xs funid args))+ Nothing+ | isPredefFId fid -> return (n_fid+2,((cat,n_fid+1),fid,wildCId,[e0],(xs,listArray (0,0) [[LeafKS s]])))+ | otherwise -> do PCoerce fid <- maybe [] Set.toList (IntMap.lookup fid (pproductions cnc))+ def (Just (cat,fid)) n_fid e0 ys xs s+ def Nothing n_fid e0 ys xs s = []++--amapWithIndex :: (IArray a e1, IArray a e2, Ix i) => (i -> e1 -> e2) -> a i e1 -> a i e2+--amapWithIndex f arr = listArray (bounds arr) (map (uncurry f) (assocs arr))
@@ -0,0 +1,243 @@+module PGF.Macros where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import PGF.CId+import PGF.Data+import Control.Monad+import qualified Data.Map as Map+--import qualified Data.Set as Set+--import qualified Data.IntMap as IntMap+--import qualified Data.IntSet as IntSet+import qualified Data.Array as Array+--import Data.Maybe+import Data.List+import Data.Array.IArray+import Text.PrettyPrint++-- operations for manipulating PGF grammars and objects++mapConcretes :: (Concr -> Concr) -> PGF -> PGF+mapConcretes f pgf = pgf { concretes = Map.map f (concretes pgf) }++lookType :: Abstr -> CId -> Type+lookType abs f = + case lookMap (error $ "lookType " ++ show f) f (funs abs) of+ (ty,_,_,_) -> ty++isData :: Abstr -> CId -> Bool+isData abs f =+ case Map.lookup f (funs abs) of+ Just (_,_,Nothing,_) -> True -- the encoding of data constrs+ _ -> False++lookValCat :: Abstr -> CId -> CId+lookValCat abs = valCat . lookType abs++lookStartCat :: PGF -> CId+lookStartCat pgf = mkCId $+ case msum $ Data.List.map (Map.lookup (mkCId "startcat")) [gflags pgf, aflags (abstract pgf)] of+ Just (LStr s) -> s+ _ -> "S"++lookGlobalFlag :: PGF -> CId -> Maybe Literal+lookGlobalFlag pgf f = Map.lookup f (gflags pgf)++lookAbsFlag :: PGF -> CId -> Maybe Literal+lookAbsFlag pgf f = Map.lookup f (aflags (abstract pgf))++lookConcr :: PGF -> Language -> Concr+lookConcr pgf cnc = + lookMap (error $ "Missing concrete syntax: " ++ showCId cnc) cnc $ concretes pgf++-- use if name fails, use abstract + name; so e.g. "Eng" becomes "DemoEng" +lookConcrComplete :: PGF -> CId -> Concr+lookConcrComplete pgf cnc = + case Map.lookup cnc (concretes pgf) of+ Just c -> c+ _ -> lookConcr pgf (mkCId (showCId (absname pgf) ++ showCId cnc))++lookConcrFlag :: PGF -> CId -> CId -> Maybe Literal+lookConcrFlag pgf lang f = Map.lookup f $ cflags $ lookConcr pgf lang++functionsToCat :: PGF -> CId -> [(CId,Type)]+functionsToCat pgf cat =+ [(f,ty) | (_,f) <- fs, Just (ty,_,_,_) <- [Map.lookup f $ funs $ abstract pgf]]+ where + (_,fs,_) = lookMap ([],[],0) cat $ cats $ abstract pgf++-- | List of functions that lack linearizations in the given language.+missingLins :: PGF -> Language -> [CId]+missingLins pgf lang = [c | c <- fs, not (hasl c)] where+ fs = Map.keys $ funs $ abstract pgf+ hasl = hasLin pgf lang++hasLin :: PGF -> Language -> CId -> Bool+hasLin pgf lang f = Map.member f $ lproductions $ lookConcr pgf lang++restrictPGF :: (CId -> Bool) -> PGF -> PGF+restrictPGF cond pgf = pgf {+ abstract = abstr {+ funs = Map.filterWithKey (\c _ -> cond c) (funs abstr),+ cats = Map.map (\(hyps,fs,p) -> (hyps,filter (cond . snd) fs,p)) (cats abstr)+ }+ } ---- restrict concrs also, might be needed+ where+ abstr = abstract pgf++depth :: Expr -> Int+depth (EAbs _ _ t) = depth t+depth (EApp e1 e2) = max (depth e1) (depth e2) + 1+depth _ = 1++cftype :: [CId] -> CId -> Type+cftype args val = DTyp [(Explicit,wildCId,cftype [] arg) | arg <- args] val []++typeOfHypo :: Hypo -> Type+typeOfHypo (_,_,ty) = ty++catSkeleton :: Type -> ([CId],CId)+catSkeleton ty = case ty of+ DTyp hyps val _ -> ([valCat (typeOfHypo h) | h <- hyps],val)++typeSkeleton :: Type -> ([(Int,CId)],CId)+typeSkeleton ty = case ty of+ DTyp hyps val _ -> ([(contextLength ty, valCat ty) | h <- hyps, let ty = typeOfHypo h],val)++valCat :: Type -> CId+valCat ty = case ty of+ DTyp _ val _ -> val++contextLength :: Type -> Int+contextLength ty = case ty of+ DTyp hyps _ _ -> length hyps++-- | Show the printname of function or category+showPrintName :: PGF -> Language -> CId -> String+showPrintName pgf lang id = lookMap (showCId id) id $ printnames $ lookMap (error "no lang") lang $ concretes pgf++-- lookup with default value+lookMap :: Ord i => a -> i -> Map.Map i a -> a +lookMap d c m = Map.findWithDefault d c m++--- from Operations+combinations :: [[a]] -> [[a]]+combinations t = case t of + [] -> [[]]+ aa:uu -> [a:u | a <- aa, u <- combinations uu]++cidString = mkCId "String"+cidInt = mkCId "Int"+cidFloat = mkCId "Float"+cidVar = mkCId "__gfVar"+++-- Utilities for doing linearization++-- | BracketedString represents a sentence that is linearized+-- as usual but we also want to retain the ''brackets'' that+-- mark the beginning and the end of each constituent.+data BracketedString+ = Leaf Token -- ^ this is the leaf i.e. a single token+ | Bracket CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [Expr] [BracketedString]+ -- ^ this is a bracket. The 'CId' is the category of+ -- the phrase. The 'FId' is an unique identifier for+ -- every phrase in the sentence. For context-free grammars+ -- i.e. without discontinuous constituents this identifier+ -- is also unique for every bracket. When there are discontinuous + -- phrases then the identifiers are unique for every phrase but+ -- not for every bracket since the bracket represents a constituent.+ -- The different constituents could still be distinguished by using+ -- the constituent index i.e. 'LIndex'. If the grammar is reduplicating+ -- then the constituent indices will be the same for all brackets+ -- that represents the same constituent.++data BracketedTokn+ = Bracket_ CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [Expr] [BracketedTokn] -- Invariant: the list is not empty+ | LeafKS Token+ | LeafNE+ | LeafBIND+ | LeafSOFT_BIND+ | LeafCAPIT+ | LeafKP [BracketedTokn] [([BracketedTokn],[String])]+ deriving Eq++type LinTable = ([CId],Array.Array LIndex [BracketedTokn])++-- | Renders the bracketed string as string where +-- the brackets are shown as @(S ...)@ where+-- @S@ is the category.+showBracketedString :: BracketedString -> String+showBracketedString = render . ppBracketedString++ppBracketedString (Leaf t) = text t+ppBracketedString (Bracket cat fid index _ _ bss) = parens (ppCId cat <> colon <> int fid <+> hsep (map ppBracketedString bss))++-- | The length of the bracketed string in number of tokens.+lengthBracketedString :: BracketedString -> Int+lengthBracketedString (Leaf _) = 1+lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss)++untokn :: Maybe String -> [BracketedTokn] -> (Maybe String,[BracketedString])+untokn nw bss =+ let (nw',bss') = mapAccumR untokn nw bss+ in case sequence bss' of+ Just bss -> (nw,concat bss)+ Nothing -> (nw,[])+ where+ untokn nw (Bracket_ cat fid index fun es bss) =+ let (nw',bss') = mapAccumR untokn nw bss+ in case sequence bss' of+ Just bss -> (nw',Just [Bracket cat fid index fun es (concat bss)])+ Nothing -> (Nothing, Nothing)+ untokn nw (LeafKS t)+ | null t = (nw,Just [])+ | otherwise = (Just t,Just [Leaf t])+ untokn nw LeafNE = (Nothing, Nothing)+ untokn nw (LeafKP d vs) = let (nw',bss') = mapAccumR untokn nw (sel d vs nw)+ in case sequence bss' of+ Just bss -> (nw',Just (concat bss))+ Nothing -> (Nothing, Nothing)+ where+ sel d vs Nothing = d+ sel d vs (Just w) =+ case [v | (v,cs) <- vs, any (\c -> isPrefixOf c w) cs] of+ v:_ -> v+ _ -> d++type CncType = (CId, FId) -- concrete type is the abstract type (the category) + the forest id++mkLinTable :: Concr -> (CncType -> Bool) -> [CId] -> FunId -> [(CncType,FId,CId,[Expr],LinTable)] -> LinTable+mkLinTable cnc filter xs funid args = (xs,listArray (bounds lins) [computeSeq filter (elems (sequences cnc ! seqid)) args | seqid <- elems lins])+ where+ (CncFun _ lins) = cncfuns cnc ! funid++computeSeq :: (CncType -> Bool) -> [Symbol] -> [(CncType,FId,CId,[Expr],LinTable)] -> [BracketedTokn]+computeSeq filter seq args = concatMap compute seq+ where+ compute (SymCat d r) = getArg d r+ compute (SymLit d r) = getArg d r+ compute (SymVar d r) = getVar d r+ compute (SymKS t) = [LeafKS t]+ compute SymNE = [LeafNE]+ compute SymBIND = [LeafKS "&+"]+ compute SymSOFT_BIND = []+ compute SymSOFT_SPACE = []+ compute SymCAPIT = [LeafKS "&|"]+ compute SymALL_CAPIT = [LeafKS "&|"]+ compute (SymKP syms alts) = [LeafKP (concatMap compute syms) [(concatMap compute syms,cs) | (syms,cs) <- alts]]++ getArg d r+ | not (null arg_lin) &&+ filter ct = [Bracket_ cat fid r fun es arg_lin]+ | otherwise = arg_lin+ where+ arg_lin = lin ! r+ (ct@(cat,fid),_,fun,es,(_xs,lin)) = args !! d++ getVar d r = [LeafKS (showCId (xs !! r))]+ where+ (_ct,_,_fun,_es,(xs,_lin)) = args !! d++flattenBracketedString :: BracketedString -> [String]+flattenBracketedString (Leaf w) = [w]+flattenBracketedString (Bracket _ _ _ _ _ bss) = concatMap flattenBracketedString bss
@@ -0,0 +1,66 @@+module PGF.Morphology(Lemma,Analysis,Morpho,+ buildMorpho,isInMorpho,+ lookupMorpho,fullFormLexicon,+ morphoMissing,morphoKnown,morphoClassify,+ missingWordMsg) where++import PGF.CId+import PGF.Data++import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.IntMap as IntMap+import Data.Array.IArray+--import Data.List (intersperse)+import Data.Char (isDigit) ----++-- these 4 definitions depend on the datastructure used++type Lemma = CId+type Analysis = String++newtype Morpho = Morpho (Map.Map String [(Lemma,Analysis)])++buildMorpho :: PGF -> Language -> Morpho+buildMorpho pgf lang = Morpho $+ case Map.lookup lang (concretes pgf) of+ Just pinfo -> collectWords pinfo+ Nothing -> Map.empty++collectWords pinfo = Map.fromListWith (++)+ [(t, [(fun,lbls ! l)]) | (CncCat s e lbls) <- Map.elems (cnccats pinfo)+ , fid <- [s..e]+ , PApply funid _ <- maybe [] Set.toList (IntMap.lookup fid (productions pinfo))+ , let CncFun fun lins = cncfuns pinfo ! funid+ , (l,seqid) <- assocs lins+ , sym <- elems (sequences pinfo ! seqid)+ , t <- sym2tokns sym]+ where+ sym2tokns (SymKS t) = [t]+ sym2tokns (SymKP ts alts) = concat (map sym2tokns ts ++ [sym2tokns sym | (syms,ps) <- alts, sym <- syms])+ sym2tokns _ = []++lookupMorpho :: Morpho -> String -> [(Lemma,Analysis)]+lookupMorpho (Morpho mo) s = maybe [] id $ Map.lookup s mo++isInMorpho :: Morpho -> String -> Bool+isInMorpho (Morpho mo) s = maybe False (const True) $ Map.lookup s mo++fullFormLexicon :: Morpho -> [(String,[(Lemma,Analysis)])]+fullFormLexicon (Morpho mo) = Map.toList mo++morphoMissing :: Morpho -> [String] -> [String]+morphoMissing = morphoClassify False++morphoKnown :: Morpho -> [String] -> [String]+morphoKnown = morphoClassify True++morphoClassify :: Bool -> Morpho -> [String] -> [String]+morphoClassify k mo ws = [w | w <- ws, k /= null (lookupMorpho mo w), notLiteral w] where+ notLiteral w = not (all isDigit w) ---- should be defined somewhere++missingWordMsg :: Morpho -> [String] -> String+missingWordMsg morpho ws = case morphoMissing morpho ws of+ [] -> ", but all words are known"+ ws -> "; unknown words: " ++ unwords ws+
@@ -0,0 +1,181 @@+-- | Read PGF files created with GF 3.5 and a few older releases+module PGF.OldBinary(getPGF,getPGF',version) where++import PGF.CId+import PGF.Data+import PGF.Optimize+import Data.Binary+import Data.Binary.Get+import Data.Array.IArray+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import qualified Data.Set as Set+import Control.Monad++pgfMajorVersion, pgfMinorVersion :: Word16+version@(pgfMajorVersion, pgfMinorVersion) = (1,0)++getPGF = do v1 <- getWord16be+ v2 <- getWord16be+ let v=(v1,v2)+ if v==version + then getPGF'+ else decodingError ("version "++show v++"/="++show version)++getPGF'=do gflags <- getFlags+ absname <- getCId+ abstract <- getAbstract+ concretes <- getMap getCId getConcr+ return $ updateProductionIndices $+ (PGF{ gflags=gflags+ , absname=absname, abstract=abstract+ , concretes=concretes+ })++getCId = liftM CId get++getAbstract =+ do aflags <- getFlags+ funs <- getMap getCId getFun+ cats <- getMap getCId getCat+ return (Abstr{ aflags=aflags+ , funs=fmap (\(w,x,y,z) -> (w,x,fmap (flip (,) []) y,z)) funs+ , cats=fmap (\(x,y) -> (x,y,0)) cats+ })+getFun :: Get (Type,Int,Maybe [Equation],Double)+getFun = (,,,) `fmap` getType `ap` get `ap` getMaybe (getList getEquation) `ap` get++getCat :: Get ([Hypo],[(Double, CId)])+getCat = getPair (getList getHypo) (getList (getPair get getCId))++getFlags = getMap getCId getLiteral++getConcr =+ do cflags <- getFlags+ printnames <- getMap getCId get+ (scnt,seqs) <- getList' getSequence+ (fcnt,cncfuns) <- getList' getCncFun+ lindefs <- get+ productions <- getIntMap (getSet getProduction)+ cnccats <- getMap getCId getCncCat+ totalCats <- get+ let rseq = listToArray [SymCat 0 0]+ rfun = CncFun (mkCId "linref") (listToArray [scnt])+ linrefs = IntMap.fromList [(i,[fcnt])|i<-[0..totalCats-1]]+ return (Concr{ cflags=cflags, printnames=printnames+ , sequences=toArray (scnt+1,seqs++[rseq])+ , cncfuns=toArray (fcnt+1,cncfuns++[rfun])+ , lindefs=lindefs, linrefs=linrefs+ , productions=productions+ , pproductions = IntMap.empty+ , lproductions = Map.empty+ , lexicon = IntMap.empty+ , cnccats=cnccats, totalCats=totalCats+ })++getExpr =+ do tag <- getWord8+ case tag of+ 0 -> liftM3 EAbs getBindType getCId getExpr+ 1 -> liftM2 EApp getExpr getExpr+ 2 -> liftM ELit getLiteral+ 3 -> liftM EMeta get+ 4 -> liftM EFun getCId+ 5 -> liftM EVar get+ 6 -> liftM2 ETyped getExpr getType+ 7 -> liftM EImplArg getExpr+ _ -> decodingError "getExpr"++getPatt =+ do tag <- getWord8+ case tag of+ 0 -> liftM2 PApp getCId (getList getPatt)+ 1 -> liftM PVar getCId+ 2 -> liftM2 PAs getCId getPatt+ 3 -> return PWild+ 4 -> liftM PLit getLiteral+ 5 -> liftM PImplArg getPatt+ 6 -> liftM PTilde getExpr+ _ -> decodingError "getPatt"++getEquation = liftM2 Equ (getList getPatt) getExpr++getType = liftM3 DTyp (getList getHypo) getCId (getList getExpr)+getHypo = (,,) `fmap` getBindType `ap` getCId `ap` getType++getBindType =+ do tag <- getWord8+ case tag of+ 0 -> return Explicit+ 1 -> return Implicit+ _ -> decodingError "getBindType"++getCncFun = liftM2 CncFun getCId (getArray get)++getCncCat = liftM3 CncCat get get (getArray get)++getSequence = listToArray `fmap` getSymbols++getSymbols = concat `fmap` getList getSymbol++getSymbol :: Get [Symbol]+getSymbol =+ do tag <- getWord8+ case tag of+ 0 -> (:[]) `fmap` liftM2 SymCat get get+ 1 -> (:[]) `fmap` liftM2 SymLit get get+ 2 -> (:[]) `fmap` liftM2 SymVar get get+ 3 -> liftM (map SymKS) get+ 4 -> (:[]) `fmap` liftM2 SymKP (getList getTokenSymbol) getAlternatives+ _ -> decodingError ("getSymbol "++show tag)++getAlternatives = getList (getPair (getList getTokenSymbol) get)+ :: Get [([Symbol],[String])]+getTokenSymbol = fmap SymKS get++--getTokens = unwords `fmap` get++getPArg = get >>= \(hypos,fid) -> return (PArg (zip (repeat fidVar) hypos) fid)++getProduction =+ do tag <- getWord8+ case tag of+ 0 -> liftM2 PApply get (getList getPArg)+ 1 -> liftM PCoerce get+ _ -> decodingError "getProduction"++getLiteral =+ do tag <- getWord8+ case tag of+ 0 -> liftM LStr get+ 1 -> liftM LInt get+ 2 -> liftM LFlt get+ _ -> decodingError "getLiteral"+++getArray :: IArray a e => Get e -> Get (a Int e)+getArray get1 = toArray `fmap` getList' get1++toArray (n,xs) = listArray (0::Int,n-1) xs+listToArray xs = toArray (length xs,xs)++--getArray2 :: (IArray a1 (a2 Int e), IArray a2 e) => Get e -> Get (a1 Int (a2 Int e))+--getArray2 get1 = getArray (getArray get1)++getList get1 = snd `fmap` getList' get1++getList' get1 = do n <- get :: Get Int+ xs <- replicateM n get1+ return (n,xs)++getMaybe get1 =+ do isJust <- get+ if isJust then fmap Just get1 else return Nothing++getMap getK getV = Map.fromDistinctAscList `fmap` getList (getPair getK getV)+getIntMap getV = IntMap.fromDistinctAscList `fmap` getList (getPair get getV)+getSet getV = Set.fromDistinctAscList `fmap` getList getV++getPair get1 get2 = (,) `fmap` get1 `ap` get2++decodingError explain = fail $ "Unable to read PGF file ("++explain++")"
@@ -0,0 +1,259 @@+{-# LANGUAGE BangPatterns #-}+module PGF.Optimize+ ( optimizePGF+ , updateProductionIndices+ ) where++import PGF.CId+import PGF.Data+import PGF.Macros+--import Data.Maybe+import Data.List (mapAccumL)+import Data.Array.IArray+import Data.Array.MArray+import Data.Array.Unsafe as U(unsafeFreeze)+import Data.Array.ST+import Data.Array.Unboxed+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.IntSet as IntSet+import qualified Data.IntMap as IntMap+import qualified PGF.TrieMap as TrieMap+import qualified Data.List as List+import Control.Monad.ST+import Debug.Trace++optimizePGF :: PGF -> PGF+optimizePGF pgf = pgf{concretes=fmap (updateConcrete (abstract pgf) . + topDownFilter (lookStartCat pgf) .+ bottomUpFilter ) (concretes pgf)}++updateProductionIndices :: PGF -> PGF+updateProductionIndices pgf = pgf{concretes = fmap (updateConcrete (abstract pgf)) (concretes pgf)}++topDownFilter :: CId -> Concr -> Concr+topDownFilter startCat cnc =+ let env0 = (Map.empty,Map.empty)+ (env1,defs) = IntMap.mapAccumWithKey (\env fid funids -> mapAccumL (optimizeFun fid [PArg [] fidVar]) env funids) + env0+ (lindefs cnc)+ (env2,refs) = IntMap.mapAccumWithKey (\env fid funids -> mapAccumL (optimizeFun fidVar [PArg [] fid]) env funids)+ env1+ (linrefs cnc)+ (env3,prods) = IntMap.mapAccumWithKey (\env fid set -> mapAccumLSet (optimizeProd fid) env set)+ env2+ (productions cnc)+ cats = Map.mapWithKey filterCatLabels (cnccats cnc)+ (seqs,funs) = env3+ in cnc{ sequences = mkSetArray seqs+ , cncfuns = mkSetArray funs+ , productions = prods+ , cnccats = cats+ , lindefs = defs+ , linrefs = refs+ }+ where+ fid2cat fid =+ case IntMap.lookup fid fid2catMap of+ Just cat -> cat+ Nothing -> case [fid | Just set <- [IntMap.lookup fid (productions cnc)], PCoerce fid <- Set.toList set] of+ (fid:_) -> fid2cat fid+ _ -> error "unknown forest id"+ where+ fid2catMap = IntMap.fromList ((fidVar,cidVar) : [(fid,cat) | (cat,CncCat start end lbls) <- Map.toList (cnccats cnc),+ fid <- [start..end]])++ starts =+ case Map.lookup startCat (cnccats cnc) of+ Just (CncCat _ _ lbls) -> [(startCat,lbl) | lbl <- indices lbls]+ Nothing -> []++ allRelations =+ Map.unionsWith Set.union+ [rel fid prod | (fid,set) <- IntMap.toList (productions cnc),+ prod <- Set.toList set]+ where+ rel fid (PApply funid args) = Map.fromList [((fid2cat fid,lbl),deps args seqid) | (lbl,seqid) <- assocs lin]+ where+ CncFun _ lin = cncfuns cnc ! funid+ rel fid _ = Map.empty++ deps args seqid = Set.fromList [let PArg _ fid = args !! r in (fid2cat fid,d) | SymCat r d <- elems seq]+ where+ seq = sequences cnc ! seqid++ -- here we create a mapping from a category to an array of indices.+ -- An element of the array is equal to -1 if the corresponding index+ -- is not going to be used in the optimized grammar, or the new index+ -- if it will be used+ closure :: Map.Map CId (UArray LIndex LIndex)+ closure = runST $ do + set <- initSet+ addLitCat cidString set+ addLitCat cidInt set+ addLitCat cidFloat set+ addLitCat cidVar set+ closureSet set starts+ doneSet set+ where+ initSet :: ST s (Map.Map CId (STUArray s LIndex LIndex))+ initSet =+ fmap Map.fromAscList $ sequence+ [fmap ((,) cat) (newArray (bounds lbls) (-1))+ | (cat,CncCat _ _ lbls) <- Map.toAscList (cnccats cnc)]++ addLitCat cat set =+ case Map.lookup cat set of+ Just indices -> writeArray indices 0 0+ Nothing -> return ()++ closureSet set [] = return ()+ closureSet set (x@(cat,index):xs) =+ case Map.lookup cat set of+ Just indices -> do v <- readArray indices index+ writeArray indices index 0+ if v < 0+ then case Map.lookup x allRelations of+ Just ys -> closureSet set (Set.toList ys++xs)+ Nothing -> closureSet set xs+ else closureSet set xs+ Nothing -> error "unknown cat"++ doneSet set =+ fmap Map.fromAscList $ mapM done (Map.toAscList set)+ where+ done (cat,indices) = do+ (s,e) <- getBounds indices+ reindex indices s e 0+ indices <- U.unsafeFreeze indices+ return (cat,indices)+ + reindex indices i j k+ | i <= j = do v <- readArray indices i+ if v < 0+ then reindex indices (i+1) j k+ else writeArray indices i k >>+ reindex indices (i+1) j (k+1)+ | otherwise = return ()++ optimizeProd res env (PApply funid args) =+ let (env',funid') = optimizeFun res args env funid+ in (env', PApply funid' args)+ optimizeProd res env prod = (env,prod)+ + optimizeFun res args (seqs,funs) funid =+ let (seqs',lin') = mapAccumL addUnique seqs [amap updateSymbol (sequences cnc ! seqid) | + (lbl,seqid) <- assocs lin, indicesOf res ! lbl >= 0]+ (funs',funid') = addUnique funs (CncFun fun (mkArray lin'))+ in ((seqs',funs'), funid')+ where+ CncFun fun lin = cncfuns cnc ! funid++ indicesOf fid+ | fid < 0 = listArray (0,0) [0]+ | otherwise =+ case Map.lookup (fid2cat fid) closure of+ Just indices -> indices+ Nothing -> error "unknown category"++ addUnique seqs seq =+ case Map.lookup seq seqs of+ Just seqid -> (seqs,seqid)+ Nothing -> let seqid = Map.size seqs+ in (Map.insert seq seqid seqs, seqid)++ updateSymbol (SymCat r d) = let PArg _ fid = args !! r in SymCat r (indicesOf fid ! d)+ updateSymbol s = s++ filterCatLabels cat (CncCat start end lbls) =+ case Map.lookup cat closure of+ Just indices -> let lbls' = mkArray [lbl | (i,lbl) <- assocs lbls, indices ! i >= 0]+ in CncCat start end lbls'+ Nothing -> error "unknown category"++ mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]+ mkArray lst = listArray (0,length lst-1) lst+ + mapAccumLSet f b set = let (b',lst) = mapAccumL f b (Set.toList set)+ in (b',Set.fromList lst)+++bottomUpFilter :: Concr -> Concr+bottomUpFilter cnc = cnc{productions=filterProductions IntMap.empty (productions cnc)}++filterProductions prods0 prods+ | prods0 == prods1 = prods0+ | otherwise = filterProductions prods1 prods+ where+ prods1 = IntMap.foldrWithKey foldProdSet IntMap.empty prods+ hoc = IntMap.foldr (\set !hoc -> Set.foldr accumHOC hoc set) IntSet.empty prods++ foldProdSet fid set !prods+ | Set.null set1 = prods+ | otherwise = IntMap.insert fid set1 prods+ where+ set1 = Set.filter filterRule set++ filterRule (PApply funid args) = all (\(PArg _ fid) -> isLive fid) args+ filterRule (PCoerce fid) = isLive fid+ filterRule _ = True++ isLive fid = isPredefFId fid || IntMap.member fid prods0 || IntSet.member fid hoc++ accumHOC (PApply funid args) hoc = List.foldl' (\hoc (PArg hypos _) -> List.foldl' (\hoc (_,fid) -> IntSet.insert fid hoc) hoc hypos) hoc args+ accumHOC _ hoc = hoc++splitLexicalRules cnc p_prods =+ IntMap.foldrWithKey split (IntMap.empty,IntMap.empty) p_prods+ where+ split fid set (lex,syn) =+ let (lex0,syn0) = Set.partition isLexical set+ !lex' = if Set.null lex0+ then lex+ else let !mp = IntMap.unionsWith (TrieMap.unionWith IntSet.union)+ [words funid | PApply funid [] <- Set.toList lex0]+ in IntMap.insert fid mp lex+ !syn' = if Set.null syn0+ then syn+ else IntMap.insert fid syn0 syn+ in (lex', syn')+ + + isLexical (PApply _ []) = True+ isLexical _ = False+ + words funid = IntMap.fromList [(lbl,seq2prefix (elems (sequences cnc ! seqid)))+ | (lbl,seqid) <- assocs lins]+ where+ CncFun _ lins = cncfuns cnc ! funid+ + wf ts = (ts,IntSet.singleton funid)+ + seq2prefix [] = TrieMap.fromList [wf []]+ seq2prefix (SymKS t :syms) = TrieMap.fromList [wf [t]]+ seq2prefix (SymKP syms0 alts:syms) = TrieMap.unionsWith IntSet.union+ (seq2prefix (syms0++syms) : + [seq2prefix (syms1 ++ syms) | (syms1,ps) <- alts])+ seq2prefix (SymNE :syms) = TrieMap.empty+ seq2prefix (SymBIND :syms) = TrieMap.fromList [wf ["&+"]]+ seq2prefix (SymSOFT_BIND :syms) = TrieMap.fromList [wf []]+ seq2prefix (SymSOFT_SPACE :syms) = TrieMap.fromList [wf []]+ seq2prefix (SymCAPIT :syms) = TrieMap.fromList [wf ["&|"]]+ seq2prefix (SymALL_CAPIT :syms) = TrieMap.fromList [wf ["&|"]]++updateConcrete abs cnc = + let p_prods0 = filterProductions IntMap.empty (productions cnc)+ (lex,p_prods) = splitLexicalRules cnc p_prods0+ l_prods = linIndex cnc p_prods0+ in cnc{pproductions = p_prods, lproductions = l_prods, lexicon = lex}+ where+ linIndex cnc productions = + Map.fromListWith (IntMap.unionWith Set.union)+ [(fun,IntMap.singleton res (Set.singleton prod)) | (res,prods) <- IntMap.toList productions+ , prod <- Set.toList prods+ , fun <- getFunctions prod]+ where+ getFunctions (PApply funid args) = let CncFun fun _ = cncfuns cnc ! funid in [fun]+ getFunctions (PCoerce fid) = case IntMap.lookup fid productions of+ Nothing -> []+ Just prods -> [fun | prod <- Set.toList prods, fun <- getFunctions prod]
@@ -0,0 +1,113 @@+----------------------------------------------------------------------+-- |+-- Module : Paraphrase+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- Generate parapharases with def definitions.+-----------------------------------------------------------------------------++module PGF.Paraphrase (+ paraphrase,+ paraphraseN+ ) where++import PGF.Data+import PGF.Tree+--import PGF.Macros (lookDef,isData)+--import PGF.CId++import Data.List (nub,sort,group)+import qualified Data.Map as Map++--import Debug.Trace ----++paraphrase :: PGF -> Expr -> [Expr]+paraphrase pgf t = nub (paraphraseN 2 pgf t)++paraphraseN :: Int -> PGF -> Expr -> [Expr]+paraphraseN i pgf = map tree2expr . paraphraseN' i pgf . expr2tree++paraphraseN' :: Int -> PGF -> Tree -> [Tree]+paraphraseN' 0 _ t = [t]+paraphraseN' i pgf t = + step i t ++ [Fun g ts' | Fun g ts <- step (i-1) t, ts' <- sequence (map par ts)]+ where+ par = paraphraseN' (i-1) pgf + step 0 t = [t]+ step i t = let stept = step (i-1) t in stept ++ concat [def u | u <- stept]+ def = fromDef pgf++fromDef :: PGF -> Tree -> [Tree]+fromDef pgf t@(Fun f ts) = defDown t ++ defUp t where+ defDown t = [subst g u | let equ = equsFrom f, (u,g) <- match equ ts, trequ "U" f equ]+ defUp t = [subst g u | equ <- equsTo f, (u,g) <- match [equ] ts, trequ "D" f equ]++ equsFrom f = [(ps,d) | Just equs <- [lookup f equss], (Fun _ ps,d) <- equs]++ equsTo f = [c | (_,equs) <- equss, c <- casesTo f equs]++ casesTo f equs = + [(ps,p) | (p,d@(Fun g ps)) <- equs, g==f, + isClosed d || (length equs == 1 && isLinear d)]++ equss = [(f,[(Fun f (map patt2tree ps), expr2tree d) | (Equ ps d) <- eqs]) | + (f,(_,_,Just (eqs,_),_)) <- Map.assocs (funs (abstract pgf)), not (null eqs)]+ ---- AR 14/12/2010: (expr2tree d) fails unless we send the variable list from ps in eqs;+ ---- cf. PGF.Tree.expr2tree+ trequ s f e = True ----trace (s ++ ": " ++ show f ++ " " ++ show e) True++subst :: Subst -> Tree -> Tree+subst g e = case e of+ Fun f ts -> Fun f (map substg ts)+ Var x -> maybe e id $ lookup x g+ _ -> e+ where+ substg = subst g++type Subst = [(CId,Tree)]++-- this applies to pattern, hence don't need to consider abstractions+isClosed :: Tree -> Bool+isClosed t = case t of+ Fun _ ts -> all isClosed ts+ Var _ -> False+ _ -> True++-- this applies to pattern, hence don't need to consider abstractions+isLinear :: Tree -> Bool+isLinear = nodup . vars where+ vars t = case t of+ Fun _ ts -> concatMap vars ts+ Var x -> [x]+ _ -> []+ nodup = all ((<2) . length) . group . sort+++match :: [([Tree],Tree)] -> [Tree] -> [(Tree, Subst)]+match cases terms = case cases of+ [] -> []+ (patts,_):_ | length patts /= length terms -> []+ (patts,val):cc -> case mapM tryMatch (zip patts terms) of+ Just substs -> return (val, concat substs)+ _ -> match cc terms+ where + tryMatch (p,t) = case (p, t) of+ (Var x, _) | notMeta t -> return [(x,t)]+ (Fun p pp, Fun f tt) | p == f && length pp == length tt -> do+ matches <- mapM tryMatch (zip pp tt)+ return (concat matches)+ _ -> if p==t then return [] else Nothing++ notMeta e = case e of+ Meta _ -> False+ Fun f ts -> all notMeta ts + _ -> True++-- | Converts a pattern to tree.+patt2tree :: Patt -> Tree+patt2tree (PApp f ps) = Fun f (map patt2tree ps)+patt2tree (PLit l) = Lit l+patt2tree (PVar x) = Var x+patt2tree PWild = Meta 0
@@ -0,0 +1,532 @@+{-# LANGUAGE BangPatterns, RankNTypes, FlexibleContexts #-} +module PGF.Parse + ( ParseState + , ErrorState + , initState + , nextState + , getCompletions + , recoveryStates + , ParseInput(..), simpleParseInput, mkParseInput + , ParseOutput(..), getParseOutput + , parse + , parseWithRecovery + , getContinuationInfo + ) where + +import Data.Array.IArray +import Data.Array.Base (unsafeAt) +import Data.List (isPrefixOf, foldl', intercalate) +import Data.Maybe (fromMaybe, maybeToList) +import qualified Data.Map as Map +import qualified PGF.TrieMap as TrieMap +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet +import qualified Data.Set as Set +import Control.Monad + +import PGF.CId +import PGF.Data +import PGF.Expr(Tree) +import PGF.Macros +import PGF.TypeCheck +import PGF.Forest(Forest(Forest), linearizeWithBrackets, getAbsTrees) + +-- | The input to the parser is a pair of predicates. The first one +-- 'piToken' selects a token from a list of suggestions from the grammar, +-- actually appears at the current position in the input string. +-- The second one 'piLiteral' recognizes whether a literal with forest id 'FId' +-- could be matched at the current position. +data ParseInput + = ParseInput + { piToken :: forall a . Map.Map Token a -> Maybe a + , piLiteral :: FId -> Maybe (CId,Tree,[Token]) + } + +-- | This data type encodes the different outcomes which you could get from the parser. +data ParseOutput + = ParseFailed Int -- ^ The integer is the position in number of tokens where the parser failed. + | TypeError [(FId,TcError)] -- ^ The parsing was successful but none of the trees is type correct. + -- The forest id ('FId') points to the bracketed string from the parser + -- where the type checking failed. More than one error is returned + -- if there are many analizes for some phrase but they all are not type correct. + | ParseOk [Tree] -- ^ If the parsing and the type checking are successful we get a list of abstract syntax trees. + -- The list should be non-empty. + | ParseIncomplete -- ^ The sentence is not complete. Only partial output is produced + +parse :: PGF -> Language -> Type -> Maybe Int -> [Token] -> (ParseOutput,BracketedString) +parse pgf lang typ dp toks = loop (initState pgf lang typ) toks + where + loop ps [] = getParseOutput ps typ dp + loop ps (t:ts) = case nextState ps (simpleParseInput t) of + Left es -> case es of + EState _ _ chart -> (ParseFailed (offset chart),snd (getParseOutput ps typ dp)) + Right ps -> loop ps ts + +parseWithRecovery :: PGF -> Language -> Type -> [Type] -> Maybe Int -> [String] -> (ParseOutput,BracketedString) +parseWithRecovery pgf lang typ open_typs dp toks = accept (initState pgf lang typ) toks + where + accept ps [] = getParseOutput ps typ dp + accept ps (t:ts) = + case nextState ps (simpleParseInput t) of + Right ps -> accept ps ts + Left es -> skip (recoveryStates open_typs es) ts + + skip ps_map [] = getParseOutput (fst ps_map) typ dp + skip ps_map (t:ts) = + case Map.lookup t (snd ps_map) of + Just ps -> accept ps ts + Nothing -> skip ps_map ts + + +-- | Creates an initial parsing state for a given language and +-- startup category. +initState :: PGF -> Language -> Type -> ParseState +initState pgf lang (DTyp _ start _) = + let items = case Map.lookup start (cnccats cnc) of + Just (CncCat s e labels) -> + do fid <- range (s,e) + funid <- fromMaybe [] (IntMap.lookup fid (linrefs cnc)) + let lbl = 0 + CncFun _ lins = unsafeAt (cncfuns cnc) funid + return (Active 0 0 funid (unsafeAt lins lbl) [PArg [] fid] (AK fidStart lbl)) + Nothing -> [] + in PState abs + cnc + (Chart emptyAC [] emptyPC (pproductions cnc) (totalCats cnc) 0) + (TrieMap.compose (Just (Set.fromList items)) Map.empty) + where + abs = abstract pgf + cnc = lookConcrComplete pgf lang + + +-- | This function constructs the simplest possible parser input. +-- It checks the tokens for exact matching and recognizes only @String@, @Int@ and @Float@ literals. +-- The @Int@ and @Float@ literals match only if the token passed is some number. +-- The @String@ literal always match but the length of the literal could be only one token. +simpleParseInput :: Token -> ParseInput +simpleParseInput t = ParseInput (Map.lookup t) (matchLit t) + where + matchLit t fid + | fid == fidString = Just (cidString,ELit (LStr t),[t]) + | fid == fidInt = case reads t of {[(n,"")] -> Just (cidInt,ELit (LInt n),[t]); + _ -> Nothing } + | fid == fidFloat = case reads t of {[(d,"")] -> Just (cidFloat,ELit (LFlt d),[t]); + _ -> Nothing } + | fid == fidVar = Just (wildCId,EFun (mkCId t),[t]) + | otherwise = Nothing + +mkParseInput :: PGF -> Language + -> (forall a . b -> Map.Map Token a -> Maybe a) + -> [(CId,b -> Maybe (Tree,[Token]))] + -> (b -> ParseInput) +mkParseInput pgf lang ftok flits = \x -> ParseInput (ftok x) (flit x) + where + flit = mk flits + + cnc = lookConcr pgf lang + + mk [] = \x fid -> Nothing + mk ((c,flit):flits) = \x fid -> case Map.lookup c (cnccats cnc) of + Just (CncCat s e _) | inRange (s,e) fid + -> fmap (\(tree,toks) -> (c,tree,toks)) (flit x) + _ -> mk flits x fid + +-- | From the current state and the next token +-- 'nextState' computes a new state, where the token +-- is consumed and the current position is shifted by one. +-- If the new token cannot be accepted then an error state +-- is returned. +nextState :: ParseState -> ParseInput -> Either ErrorState ParseState +nextState (PState abs cnc chart cnt0) input = + let (mb_agenda,map_items) = TrieMap.decompose cnt0 + agenda = maybe [] Set.toList mb_agenda + cnt = fromMaybe TrieMap.empty (piToken input map_items) + (cnt1,chart1) = process flit ftok cnc agenda cnt chart + chart2 = chart1{ active =emptyAC + , actives=active chart1 : actives chart1 + , passive=emptyPC + , offset =offset chart1+1 + } + in if TrieMap.null cnt1 + then Left (EState abs cnc chart2) + else Right (PState abs cnc chart2 cnt1) + where + flit = piLiteral input + + ftok choices cnt = + case piToken input choices of + Just cnt' -> TrieMap.unionWith Set.union cnt' cnt + Nothing -> cnt + +-- | If the next token is not known but only its prefix (possible empty prefix) +-- then the 'getCompletions' function can be used to calculate the possible +-- next words and the consequent states. This is used for word completions in +-- the GF interpreter. +getCompletions :: ParseState -> String -> Map.Map Token ParseState +getCompletions (PState abs cnc chart cnt0) w = + let (mb_agenda,map_items) = TrieMap.decompose cnt0 + agenda = maybe [] Set.toList mb_agenda + acc = Map.filterWithKey (\tok _ -> isPrefixOf w tok) map_items + (acc',chart1) = process flit ftok cnc agenda acc chart + chart2 = chart1{ active =emptyAC + , actives=active chart1 : actives chart1 + , passive=emptyPC + , offset =offset chart1+1 + } + in fmap (PState abs cnc chart2) acc' + where + flit _ = Nothing + + ftok choices = + Map.unionWith (TrieMap.unionWith Set.union) + (Map.filterWithKey (\tok _ -> isPrefixOf w tok) choices) + +recoveryStates :: [Type] -> ErrorState -> (ParseState, Map.Map Token ParseState) +recoveryStates open_types (EState abs cnc chart) = + let open_fcats = concatMap type2fcats open_types + agenda = foldl (complete open_fcats) [] (actives chart) + (acc,chart1) = process flit ftok cnc agenda Map.empty chart + chart2 = chart1{ active =emptyAC + , actives=active chart1 : actives chart1 + , passive=emptyPC + , offset =offset chart1+1 + } + in (PState abs cnc chart (TrieMap.singleton [] (Set.fromList agenda)), fmap (PState abs cnc chart2) acc) + where + type2fcats (DTyp _ cat _) = case Map.lookup cat (cnccats cnc) of + Just (CncCat s e labels) -> range (s,e) + Nothing -> [] + + complete open_fcats items ac = + foldl (Set.foldr (\(Active j' ppos funid seqid args keyc) -> + (:) (Active j' (ppos+1) funid seqid args keyc))) + items + [set | fcat <- open_fcats, (set,_) <- lookupACByFCat fcat ac] + + flit _ = Nothing + ftok toks = Map.unionWith (TrieMap.unionWith Set.union) toks + +-- | This function extracts the list of all completed parse trees +-- that spans the whole input consumed so far. The trees are also +-- limited by the category specified, which is usually +-- the same as the startup category. +getParseOutput :: ParseState -> Type -> Maybe Int -> (ParseOutput,BracketedString) +getParseOutput (PState abs cnc chart cnt) ty dp = + let froots | null roots = getPartialSeq (sequences cnc) (reverse (active chart1 : actives chart1)) seq + | otherwise = [([SymCat 0 lbl],[PArg [] fid]) | AK fid lbl <- roots] + + f = Forest abs cnc (forest chart1) froots + + bs = linearizeWithBrackets dp f + + res | not (null es) = ParseOk es + | not (null errs) = TypeError errs + | otherwise = ParseIncomplete + where xs = [getAbsTrees f (PArg [] fid) (Just ty) dp | (AK fid lbl) <- roots] + es = concat [es | Right es <- xs] + errs = concat [errs | Left errs <- xs] + + in (res,bs) + where + (mb_agenda,acc) = TrieMap.decompose cnt + agenda = maybe [] Set.toList mb_agenda + (acc',chart1) = process flit ftok cnc agenda (TrieMap.compose Nothing acc) chart + seq = [(j,cutAt ppos toks seqid,args,key) | (toks,set) <- TrieMap.toList acc' + , Active j ppos funid seqid args key <- Set.toList set] + + flit _ = Nothing + ftok toks = TrieMap.unionWith Set.union (TrieMap.compose Nothing toks) + + cutAt ppos toks seqid = + let seq = unsafeAt (sequences cnc) seqid + init = take (ppos-1) (elems seq) + tail = case unsafeAt seq (ppos-1) of + SymKS t -> drop (length toks) [SymKS t] + SymKP ts _ -> reverse (drop (length toks) (reverse ts)) + sym -> [] + in init ++ tail + + roots = do let lbl = 0 + fid <- maybeToList (lookupPC (PK fidStart lbl 0) (passive chart1)) + PApply _ [PArg _ fid] <- maybe [] Set.toList (IntMap.lookup fid (forest chart1)) + return (AK fid lbl) + + +getPartialSeq seqs actives = expand Set.empty + where + expand acc [] = + [(lin,args) | (j,lin,args,key) <- Set.toList acc, j == 0] + expand acc (item@(j,lin,args,key) : items) + | item `Set.member` acc = expand acc items + | otherwise = expand acc' items' + where + acc' = Set.insert item acc + items' = case lookupAC key (actives !! j) of + Nothing -> items + Just (set,_) -> [if j' < j + then let lin' = take ppos (elems (unsafeAt seqs seqid)) + in (j',lin'++map (inc (length args')) lin,args'++args,key') + else (j',lin,args,key') | Active j' ppos funid seqid args' key' <- Set.toList set] ++ items + + inc n (SymCat d r) = SymCat (n+d) r + inc n (SymVar d r) = SymVar (n+d) r + inc n (SymLit d r) = SymLit (n+d) r + inc n s = s + +process flit ftok cnc [] acc chart = (acc,chart) +process flit ftok cnc (item@(Active j ppos funid seqid args key0):items) acc chart + | inRange (bounds lin) ppos = + case unsafeAt lin ppos of + SymCat d r -> let PArg hypos !fid = args !! d + key = AK fid r + + items2 = case lookupPC (mkPK key k) (passive chart) of + Nothing -> items + Just id -> (Active j (ppos+1) funid seqid (updateAt d (PArg hypos id) args) key0) : items + (acc',items4) = predict flit ftok cnc + (IntMap.unionWith Set.union new_sc (forest chart)) + key key k + acc items2 + + new_sc = foldl uu parent_sc hypos + parent_sc = case lookupAC key0 ((active chart : actives chart) !! (k-j)) of + Nothing -> IntMap.empty + Just (set,sc) -> sc + + in case lookupAC key (active chart) of + Nothing -> process flit ftok cnc items4 acc' chart{active=insertAC key (Set.singleton item,new_sc) (active chart)} + Just (set,sc) | Set.member item set -> process flit ftok cnc items acc chart + | otherwise -> process flit ftok cnc items2 acc chart{active=insertAC key (Set.insert item set,IntMap.unionWith Set.union new_sc sc) (active chart)} + SymKS tok -> let !acc' = ftok_ [tok] (Active j (ppos+1) funid seqid args key0) acc + in process flit ftok cnc items acc' chart + SymNE -> process flit ftok cnc items acc chart + SymBIND -> let !acc' = ftok_ ["&+"] (Active j (ppos+1) funid seqid args key0) acc + in process flit ftok cnc items acc' chart + SymSOFT_BIND->process flit ftok cnc ((Active j (ppos+1) funid seqid args key0):items) acc chart + SymSOFT_SPACE->process flit ftok cnc ((Active j (ppos+1) funid seqid args key0):items) acc chart + SymCAPIT -> let !acc' = ftok_ ["&|"] (Active j (ppos+1) funid seqid args key0) acc + in process flit ftok cnc items acc' chart + SymALL_CAPIT->let !acc' = ftok_ ["&|"] (Active j (ppos+1) funid seqid args key0) acc + in process flit ftok cnc items acc' chart + SymKP syms vars + -> let to_tok (SymKS t) = [t] + to_tok SymBIND = ["&+"] + to_tok SymSOFT_BIND = [] + to_tok SymSOFT_SPACE= [] + to_tok SymCAPIT = ["&|"] + to_tok SymALL_CAPIT = ["&|"] + to_tok _ = [] + + !acc' = foldl (\acc syms -> ftok_ (concatMap to_tok syms) (Active j (ppos+1) funid seqid args key0) acc) acc + (syms:[syms' | (syms',_) <- vars]) + in process flit ftok cnc items acc' chart + SymLit d r -> let PArg hypos fid = args !! d + key = AK fid r + !fid' = case lookupPC (mkPK key k) (passive chart) of + Nothing -> fid + Just fid -> fid + + in case [ts | PConst _ _ ts <- maybe [] Set.toList (IntMap.lookup fid' (forest chart))] of + (toks:_) -> let !acc' = ftok_ toks (Active j (ppos+1) funid seqid (updateAt d (PArg hypos fid') args) key0) acc + in process flit ftok cnc items acc' chart + [] -> case flit fid of + Just (cat,lit,toks) + -> let fid' = nextId chart + !acc' = ftok_ toks (Active j (ppos+1) funid seqid (updateAt d (PArg hypos fid') args) key0) acc + in process flit ftok cnc items acc' chart{passive=insertPC (mkPK key k) fid' (passive chart) + ,forest =IntMap.insert fid' (Set.singleton (PConst cat lit toks)) (forest chart) + ,nextId =nextId chart+1 + } + Nothing -> process flit ftok cnc items acc chart + SymVar d r -> let PArg hypos fid0 = args !! d + (fid1,fid2) = hypos !! r + key = AK fid1 0 + !fid' = case lookupPC (mkPK key k) (passive chart) of + Nothing -> fid1 + Just fid -> fid + + in case [ts | PConst _ _ ts <- maybe [] Set.toList (IntMap.lookup fid' (forest chart))] of + (toks:_) -> let !acc' = ftok_ toks (Active j (ppos+1) funid seqid (updateAt d (PArg (updateAt r (fid',fid2) hypos) fid0) args) key0) acc + in process flit ftok cnc items acc' chart + [] -> case flit fid1 of + Just (cat,lit,toks) + -> let fid' = nextId chart + !acc' = ftok_ toks (Active j (ppos+1) funid seqid (updateAt d (PArg (updateAt r (fid',fid2) hypos) fid0) args) key0) acc + in process flit ftok cnc items acc' chart{passive=insertPC (mkPK key k) fid' (passive chart) + ,forest =IntMap.insert fid' (Set.singleton (PConst cat lit toks)) (forest chart) + ,nextId =nextId chart+1 + } + Nothing -> process flit ftok cnc items acc chart + | otherwise = + case lookupPC (mkPK key0 j) (passive chart) of + Nothing -> let fid = nextId chart + + items2 = case lookupAC key0 ((active chart:actives chart) !! (k-j)) of + Nothing -> items + Just (set,sc) -> Set.foldr (\(Active j' ppos funid seqid args keyc) -> + let SymCat d _ = unsafeAt (unsafeAt (sequences cnc) seqid) ppos + PArg hypos _ = args !! d + in (:) (Active j' (ppos+1) funid seqid (updateAt d (PArg hypos fid) args) keyc)) items set + in process flit ftok cnc items2 acc chart{passive=insertPC (mkPK key0 j) fid (passive chart) + ,forest =IntMap.insert fid (Set.singleton (PApply funid args)) (forest chart) + ,nextId =nextId chart+1 + } + Just id -> let items2 = [Active k 0 funid (rhs funid r) args (AK id r) | r <- labelsAC id (active chart)] ++ items + in process flit ftok cnc items2 acc chart{forest = IntMap.insertWith Set.union id (Set.singleton (PApply funid args)) (forest chart)} + where + !lin = unsafeAt (sequences cnc) seqid + !k = offset chart + + mkPK (AK fid lbl) j = PK fid lbl j + + rhs funid lbl = unsafeAt lins lbl + where + CncFun _ lins = unsafeAt (cncfuns cnc) funid + + uu forest (fid1,fid2) = + case IntMap.lookup fid2 (lindefs cnc) of + Just funs -> foldl (\forest funid -> IntMap.insertWith Set.union fid2 (Set.singleton (PApply funid [PArg [] fid1])) forest) forest funs + Nothing -> forest + + ftok_ [] item cnt = ftok Map.empty cnt + ftok_ (tok:toks) item cnt = + ftok (Map.singleton tok (TrieMap.singleton toks (Set.singleton item))) cnt + + predict flit ftok cnc forest key0 key@(AK fid lbl) k acc items = + let (acc1,items1) = case IntMap.lookup fid forest of + Nothing -> (acc,items) + Just set -> Set.foldr foldProd (acc,items) set + + (acc2,items2) = case IntMap.lookup fid (lexicon cnc) >>= IntMap.lookup lbl of + Just tmap -> let (mb_v,toks) = TrieMap.decompose (TrieMap.map (toItems key0 k) tmap) + acc1' = ftok toks acc1 + items1' = maybe [] Set.toList mb_v ++ items1 + in (acc1',items1') + Nothing -> (acc1,items1) + in (acc2,items2) + where + foldProd (PCoerce fid) (acc,items) = predict flit ftok cnc forest key0 (AK fid lbl) k acc items + foldProd (PApply funid args) (acc,items) = (acc,Active k 0 funid (rhs funid lbl) args key0 : items) + foldProd (PConst _ const toks) (acc,items) = (acc,items) + + toItems key@(AK fid lbl) k funids = + Set.fromList [Active k 1 funid (rhs funid lbl) [] key | funid <- IntSet.toList funids] + + +updateAt :: Int -> a -> [a] -> [a] +updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs] + +---------------------------------------------------------------- +-- Active Chart +---------------------------------------------------------------- + +data Active + = Active {-# UNPACK #-} !Int + {-# UNPACK #-} !DotPos + {-# UNPACK #-} !FunId + {-# UNPACK #-} !SeqId + [PArg] + {-# UNPACK #-} !ActiveKey + deriving (Eq,Show,Ord) +data ActiveKey + = AK {-# UNPACK #-} !FId + {-# UNPACK #-} !LIndex + deriving (Eq,Ord,Show) +type ActiveSet = Set.Set Active +type ActiveChart = IntMap.IntMap (IntMap.IntMap (ActiveSet, IntMap.IntMap (Set.Set Production))) + +emptyAC :: ActiveChart +emptyAC = IntMap.empty + +lookupAC :: ActiveKey -> ActiveChart -> Maybe (ActiveSet, IntMap.IntMap (Set.Set Production)) +lookupAC (AK fid lbl) chart = IntMap.lookup fid chart >>= IntMap.lookup lbl + +lookupACByFCat :: FId -> ActiveChart -> [(ActiveSet, IntMap.IntMap (Set.Set Production))] +lookupACByFCat fcat chart = + case IntMap.lookup fcat chart of + Nothing -> [] + Just map -> IntMap.elems map + +labelsAC :: FId -> ActiveChart -> [LIndex] +labelsAC fcat chart = + case IntMap.lookup fcat chart of + Nothing -> [] + Just map -> IntMap.keys map + +insertAC :: ActiveKey -> (ActiveSet, IntMap.IntMap (Set.Set Production)) -> ActiveChart -> ActiveChart +insertAC (AK fcat l) set chart = IntMap.insertWith IntMap.union fcat (IntMap.singleton l set) chart + + +---------------------------------------------------------------- +-- Passive Chart +---------------------------------------------------------------- + +data PassiveKey + = PK {-# UNPACK #-} !FId + {-# UNPACK #-} !LIndex + {-# UNPACK #-} !Int + deriving (Eq,Ord,Show) + +type PassiveChart = Map.Map PassiveKey FId + +emptyPC :: PassiveChart +emptyPC = Map.empty + +lookupPC :: PassiveKey -> PassiveChart -> Maybe FId +lookupPC key chart = Map.lookup key chart + +insertPC :: PassiveKey -> FId -> PassiveChart -> PassiveChart +insertPC key fcat chart = Map.insert key fcat chart + + +---------------------------------------------------------------- +-- Parse State +---------------------------------------------------------------- + +-- | An abstract data type whose values represent +-- the current state in an incremental parser. +data ParseState = PState Abstr Concr Chart Continuation + +data Chart + = Chart + { active :: ActiveChart + , actives :: [ActiveChart] + , passive :: PassiveChart + , forest :: IntMap.IntMap (Set.Set Production) + , nextId :: {-# UNPACK #-} !FId + , offset :: {-# UNPACK #-} !Int + } + deriving Show + +type Continuation = TrieMap.TrieMap Token ActiveSet + +-- | Return the Continuation of a Parsestate with exportable types +-- Used by PGFService +getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId, String)] +getContinuationInfo pstate = Map.map (map f . Set.toList) contMap + where + PState _abstr concr _chart cont = pstate + contMap = Map.fromList (TrieMap.toList cont) -- always get [([], _::ActiveSet)] + f :: Active -> (FunId,CId,String) + f (Active int dotpos funid seqid pargs ak) = (funid, cid, seq) + where + CncFun cid _ = cncfuns concr ! funid + seq = showSeq dotpos (sequences concr ! seqid) + + showSeq :: DotPos -> Sequence -> String + showSeq pos seq = intercalate " " $ scan (drop (pos-1) (elems seq)) + where + -- Scan left-to-right, stop at first non-token + scan :: [Symbol] -> [String] + scan [] = [] + scan (sym:syms) = case sym of + SymKS token -> token : scan syms + _ -> [] + +---------------------------------------------------------------- +-- Error State +---------------------------------------------------------------- + +-- | An abstract data type whose values represent +-- the state in an incremental parser after an error. +data ErrorState = EState Abstr Concr Chart
@@ -0,0 +1,125 @@+{-# LANGUAGE FlexibleContexts #-}+module PGF.Printer (ppPGF,ppCat,ppFId,ppFunId,ppSeqId,ppSeq,ppFun) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import PGF.CId+import PGF.Data+import PGF.ByteCode++import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.IntMap as IntMap+import Data.List+import Data.Array.IArray+--import Data.Array.Unboxed+import Text.PrettyPrint+++ppPGF :: PGF -> Doc+ppPGF pgf = ppAbs (absname pgf) (abstract pgf) $$ ppAll ppCnc (concretes pgf)++ppAbs :: Language -> Abstr -> Doc+ppAbs name a = text "abstract" <+> ppCId name <+> char '{' $$+ nest 2 (ppAll ppFlag (aflags a) $$+ ppAll ppCat (cats a) $$+ ppAll ppFun (funs a)) $$+ char '}'++ppFlag :: CId -> Literal -> Doc+ppFlag flag value = text "flag" <+> ppCId flag <+> char '=' <+> ppLit value <+> char ';'++ppCat :: CId -> ([Hypo],[(Double,CId)],Double) -> Doc+ppCat c (hyps,_,_) = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)) <+> char ';'++ppFun :: CId -> (Type,Int,Maybe ([Equation],[[Instr]]),Double) -> Doc+ppFun f (t,_,Just (eqs,code),_) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';' $$+ (if null eqs+ then empty+ else text "def" <+> vcat [let scope = foldl pattScope [] patts+ ds = map (ppPatt 9 scope) patts+ in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs]) $$+ ppCode 0 code+ppFun f (t,_,Nothing,_) = text "data" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';'++ppCnc :: Language -> Concr -> Doc+ppCnc name cnc =+ text "concrete" <+> ppCId name <+> char '{' $$+ nest 2 (ppAll ppFlag (cflags cnc) $$+ text "productions" $$+ nest 2 (vcat [ppProduction (fcat,prod) | (fcat,set) <- IntMap.toList (productions cnc), prod <- Set.toList set]) $$+ text "lindefs" $$+ nest 2 (vcat (concatMap ppLinDefs (IntMap.toList (lindefs cnc)))) $$+ text "linrefs" $$+ nest 2 (vcat (concatMap ppLinRefs (IntMap.toList (linrefs cnc)))) $$+ text "lin" $$+ nest 2 (vcat (map ppCncFun (assocs (cncfuns cnc)))) $$+ text "sequences" $$+ nest 2 (vcat (map ppSeq (assocs (sequences cnc)))) $$+ text "categories" $$+ nest 2 (vcat (map ppCncCat (Map.toList (cnccats cnc)))) $$+ text "printnames" $$+ nest 2 (vcat (map ppPrintName (Map.toList (printnames cnc))))) $$+ char '}'++ppCncArg :: PArg -> Doc+ppCncArg (PArg hyps fid)+ | null hyps = ppFId fid+ | otherwise = hsep (map (ppFId . snd) hyps) <+> text "->" <+> ppFId fid++ppProduction (fid,PApply funid args) =+ ppFId fid <+> text "->" <+> ppFunId funid <> brackets (hcat (punctuate comma (map ppCncArg args)))+ppProduction (fid,PCoerce arg) =+ ppFId fid <+> text "->" <+> char '_' <> brackets (ppFId arg)+ppProduction (fid,PConst _ _ ss) =+ ppFId fid <+> text "->" <+> ppStrs ss++ppCncFun (funid,CncFun fun arr) =+ ppFunId funid <+> text ":=" <+> parens (hcat (punctuate comma (map ppSeqId (elems arr)))) <+> brackets (ppCId fun)++ppLinDefs (fid,funids) = + [ppFId fid <+> text "->" <+> ppFunId funid <> brackets (ppFId fidVar) | funid <- funids]++ppLinRefs (fid,funids) = + [ppFId fidVar <+> text "->" <+> ppFunId funid <> brackets (ppFId fid) | funid <- funids]++ppSeq (seqid,seq) = + ppSeqId seqid <+> text ":=" <+> hsep (map ppSymbol (elems seq))++ppCncCat (id,(CncCat start end labels)) =+ ppCId id <+> text ":=" <+> (text "range " <+> brackets (ppFId start <+> text ".." <+> ppFId end) $$+ text "labels" <+> brackets (vcat (map (text . show) (elems labels))))++ppPrintName (id,name) =+ ppCId id <+> text ":=" <+> ppStrs [name]++ppSymbol (SymCat d r) = char '<' <> int d <> comma <> int r <> char '>'+ppSymbol (SymLit d r) = char '{' <> int d <> comma <> int r <> char '}'+ppSymbol (SymVar d r) = char '<' <> int d <> comma <> char '$' <> int r <> char '>'+ppSymbol (SymKS t) = doubleQuotes (text t)+ppSymbol SymNE = text "nonExist"+ppSymbol SymBIND = text "BIND"+ppSymbol SymSOFT_BIND = text "SOFT_BIND"+ppSymbol SymSOFT_SPACE= text "SOFT_SPACE"+ppSymbol SymCAPIT = text "CAPIT"+ppSymbol SymALL_CAPIT = text "ALL_CAPIT"+ppSymbol (SymKP syms alts) = text "pre" <+> braces (hsep (punctuate semi (hsep (map ppSymbol syms) : map ppAlt alts)))++ppAlt (syms,ps) = hsep (map ppSymbol syms) <+> char '/' <+> hsep (map (doubleQuotes . text) ps)++ppStrs ss = doubleQuotes (hsep (map text ss))++ppFId fid+ | fid == fidString = text "CString"+ | fid == fidInt = text "CInt"+ | fid == fidFloat = text "CFloat"+ | fid == fidVar = text "CVar"+ | fid == fidStart = text "CStart"+ | otherwise = char 'C' <> int fid++ppFunId funid = char 'F' <> int funid+ppSeqId seqid = char 'S' <> int seqid++-- Utilities++ppAll :: (a -> b -> Doc) -> Map.Map a b -> Doc+ppAll p m = vcat [ p k v | (k,v) <- Map.toList m]
@@ -0,0 +1,283 @@+module PGF.Probabilistic+ ( Probabilities(..)+ , mkProbabilities -- :: PGF -> M.Map CId Double -> Probabilities+ , defaultProbabilities -- :: PGF -> Probabilities+ , getProbabilities+ , setProbabilities+ , showProbabilities -- :: Probabilities -> String+ , readProbabilitiesFromFile -- :: FilePath -> PGF -> IO Probabilities++ , probTree+ , rankTreesByProbs+ , mkProbDefs+ ) where++import PGF.CId+import PGF.Data+import PGF.Macros++import qualified Data.Map as Map+import Data.List (sortBy,partition,nub,mapAccumL)+import Data.Maybe (fromMaybe) --, fromJust++-- | An abstract data structure which represents+-- the probabilities for the different functions in a grammar.+data Probabilities = Probs {+ funProbs :: Map.Map CId Double,+ catProbs :: Map.Map CId (Double, [(Double, CId)])+ }++-- | Renders the probability structure as string+showProbabilities :: Probabilities -> String+showProbabilities = unlines . concatMap prProb . Map.toList . catProbs where+ prProb (c,(p,fns)) = pr (p,c) : map pr fns+ pr (p,f) = showCId f ++ "\t" ++ show p++-- | Reads the probabilities from a file.+-- This should be a text file where on every line+-- there is a function name followed by a real number.+-- The number represents the probability mass allocated for that function.+-- The function name and the probability should be separated by a whitespace.+readProbabilitiesFromFile :: FilePath -> PGF -> IO Probabilities+readProbabilitiesFromFile file pgf = do+ s <- readFile file+ let ps0 = Map.fromList [(mkCId f,read p) | f:p:_ <- map words (lines s)]+ return $ mkProbabilities pgf ps0++-- | Builds probability tables. The second argument is a map+-- which contains the know probabilities. If some function is+-- not in the map then it gets assigned some probability based+-- on the even distribution of the unallocated probability mass+-- for the result category.+mkProbabilities :: PGF -> Map.Map CId Double -> Probabilities+mkProbabilities pgf probs =+ let funs1 = Map.fromList [(f,p) | (_,(_,fns)) <- Map.toList cats1, (p,f) <- fns]+ cats1 = Map.mapWithKey (\c (_,fns,_) -> + let p' = fromMaybe 0 (Map.lookup c probs)+ fns' = sortBy cmpProb (fill fns)+ in (p', fns'))+ (cats (abstract pgf))+ in Probs funs1 cats1+ where+ cmpProb (p1,_) (p2,_) = compare p2 p1++ fill fs = pad [(Map.lookup f probs,f) | (_,f) <- fs]+ where+ pad :: [(Maybe Double,a)] -> [(Double,a)]+ pad pfs = [(fromMaybe deflt mb_p,f) | (mb_p,f) <- pfs]+ where+ deflt = case length [f | (Nothing,f) <- pfs] of+ 0 -> 0+ n -> max 0 ((1 - sum [d | (Just d,f) <- pfs]) / fromIntegral n)++-- | Returns the default even distibution.+defaultProbabilities :: PGF -> Probabilities+defaultProbabilities pgf = mkProbabilities pgf Map.empty++getProbabilities :: PGF -> Probabilities+getProbabilities pgf = Probs {+ funProbs = Map.map (\(_,_,_,p) -> p ) (funs (abstract pgf)),+ catProbs = Map.map (\(_,fns,p) -> (p,fns)) (cats (abstract pgf))+ }++setProbabilities :: Probabilities -> PGF -> PGF+setProbabilities probs pgf = pgf {+ abstract = (abstract pgf) {+ funs = mapUnionWith (\(ty,a,df,_) p -> (ty,a,df, p)) (funs (abstract pgf)) (funProbs probs),+ cats = mapUnionWith (\(hypos,_,_) (p,fns) -> (hypos,fns,p)) (cats (abstract pgf)) (catProbs probs)+ }}+ where+ mapUnionWith f map1 map2 = + Map.mapWithKey (\k v -> maybe v (f v) (Map.lookup k map2)) map1++-- | compute the probability of a given tree+probTree :: PGF -> Expr -> Double+probTree pgf t = case t of+ EApp f e -> probTree pgf f * probTree pgf e+ EFun f -> case Map.lookup f (funs (abstract pgf)) of+ Just (_,_,_,p) -> p+ Nothing -> 1+ _ -> 1++-- | rank from highest to lowest probability+rankTreesByProbs :: PGF -> [Expr] -> [(Expr,Double)]+rankTreesByProbs pgf ts = sortBy (\ (_,p) (_,q) -> compare q p) + [(t, probTree pgf t) | t <- ts]+++mkProbDefs :: PGF -> ([[CId]],[(CId,Type,[Equation])])+mkProbDefs pgf =+ let cs = [(c,hyps,fns) | (c,(hyps0,fs,_)) <- Map.toList (cats (abstract pgf)),+ not (elem c [cidString,cidInt,cidFloat]),+ let hyps = zipWith (\(bt,_,ty) n -> (bt,mkCId ('v':show n),ty))+ hyps0+ [1..]+ fns = [(f,ty) | (_,f) <- fs, + let Just (ty,_,_,_) = Map.lookup f (funs (abstract pgf))]+ ]+ ((_,css),eqss) = mapAccumL (\(ngen,css) (c,hyps,fns) -> + let st0 = (1,Map.empty)+ ((_,eqs_map),cs) = computeConstrs pgf st0 [(fn,[],es) | (fn,(DTyp _ _ es)) <- fns]+ (ngen', eqs) = mapAccumL (mkEquation eqs_map hyps) ngen fns+ ceqs = [(id,DTyp [] cidFloat [],reverse eqs) | (id,eqs) <- Map.toList eqs_map, not (null eqs)]+ in ((ngen',cs:css),(p_f c, mkType c hyps, eqs):ceqs)) (1,[]) cs+ in (reverse (concat css),concat eqss)+ where+ mkEImplArg bt e+ | bt == Explicit = e+ | otherwise = EImplArg e+ + mkPImplArg bt p+ | bt == Explicit = p+ | otherwise = PImplArg p++ mkType c hyps =+ DTyp (hyps++[mkHypo (DTyp [] c es)]) cidFloat []+ where+ is = reverse [0..length hyps-1]+ es = [mkEImplArg bt (EVar i) | (i,(bt,_,_)) <- zip is hyps]++ sig = (funs (abstract pgf), \_ -> Nothing)+ + mkEquation ceqs hyps ngen (fn,ty@(DTyp args _ es)) =+ let fs1 = case Map.lookup (p_f fn) ceqs of+ Nothing -> [mkApp (k_f fn) (map (\(i,_) -> EVar (k-i-1)) vs1)]+ Just eqs | null eqs -> []+ | otherwise -> [mkApp (p_f fn) (map (\(i,_) -> EVar (k-i-1)) vs1)]+ (ngen',fs2) = mapAccumL mkFactor2 ngen vs2+ fs3 = map mkFactor3 vs3+ eq = Equ (map mkTildeP xes++[PApp fn (zipWith mkArgP [1..] args)])+ (mkMult (fs1++fs2++fs3))+ in (ngen',eq)+ where+ xes = map (normalForm sig k env) es++ mkTildeP e =+ case e of+ EImplArg e -> PImplArg (PTilde e)+ e -> PTilde e++ mkArgP n (bt,_,_) = mkPImplArg bt (PVar (mkCId ('v':show n)))++ mkMult [] = ELit (LFlt 1)+ mkMult [e] = e+ mkMult es = mkApp (mkCId "mult") es++ mkFactor2 ngen (src,dst) =+ let vs = [EVar (k-i-1) | (i,ty) <- src]+ in (ngen+1,mkApp (p_i ngen) vs)++ mkFactor3 (i,DTyp _ c es) =+ let v = EVar (k-i-1)+ in mkApp (p_f c) (map (normalForm sig k env) es++[v])++ (k,env,vs1,vs2,vs3) = mkDeps ty++ mkDeps (DTyp args _ es) =+ let (k,env,dep1) = updateArgs 0 [] [] args+ dep2 = foldl (update k env) dep1 es+ (vs2,vs3) = closure k dep2 [] []+ vs1 = concat [src | (src,dst) <- dep2, elem k dst]+ in (k,map (\k -> VGen k []) env,vs1,reverse vs2,vs3)+ where+ updateArgs k env dep [] = (k,env,dep)+ updateArgs k env dep ((_,x,ty@(DTyp _ _ es)) : args) =+ let dep1 = foldl (update k env) dep es ++ [([(k,ty)],[])]+ env1 | x == wildCId = env+ | otherwise = k : env+ in updateArgs (k+1) env1 dep1 args++ update k env dep e =+ case e of+ EApp e1 e2 -> update k env (update k env dep e1) e2+ EFun _ -> dep+ EVar i -> let (dep1,(src,dst):dep2) = splitAt (env !! i) dep+ in dep1++(src,k:dst):dep2++ closure k [] vs2 vs3 = (vs2,vs3)+ closure k ((src,dst):deps) vs2 vs3+ | null dst = closure k deps vs2 (vs3++src)+ | otherwise =+ let (deps1,deps2) = partition (\(src',dst') -> not (null [v1 | v1 <- dst, v2 <- dst', v1 == v2])) deps+ deps3 = (src,dst):deps1+ src2 = concatMap fst deps3+ dst2 = [v | v <- concatMap snd deps3+ , lookup v src2 == Nothing]+ dep2 = (src2,dst2)+ dst' = nub dst+ in if null deps1+ then if dst' == [k]+ then closure k deps2 vs2 vs3+ else closure k deps2 ((src,dst') : vs2) vs3+ else closure k (dep2 : deps2) vs2 vs3+{-+ mkNewSig src =+ DTyp (mkArgs 0 0 [] src) cidFloat []+ where+ mkArgs k l env [] = []+ mkArgs k l env ((i,DTyp _ c es) : src)+ | i == k = let ty = DTyp [] c (map (normalForm sig k env) es)+ in (Explicit,wildCId,ty) : mkArgs (k+1) (l+1) (VGen l [] : env) src+ | otherwise = mkArgs (k+1) l (VMeta 0 env [] : env) src+-}+type CState = (Int,Map.Map CId [Equation])++computeConstrs :: PGF -> CState -> [(CId,[Patt],[Expr])] -> (CState,[[CId]])+computeConstrs pgf (ngen,eqs_map) fns@((id,pts,[]):rest)+ | null rest =+ let eqs_map' = + Map.insertWith (++) (p_f id)+ (if null pts+ then []+ else [Equ pts (ELit (LFlt 1.0))])+ eqs_map+ in ((ngen,eqs_map'),[])+ | otherwise =+ let (st,ks) = mapAccumL mk_k (ngen,eqs_map) fns++ mk_k (ngen,eqs_map) (id,pts,[])+ | null pts = ((ngen,eqs_map),k_f id)+ | otherwise = let eqs_map' = + Map.insertWith (++) + (p_f id) + [Equ pts (EFun (k_i ngen))]+ eqs_map+ in ((ngen+1,eqs_map'),k_i ngen)++ in (st,[ks])+computeConstrs pgf st fns =+ let (st',res) = mapAccumL (\st (p,fns) -> computeConstrs pgf st fns)+ st+ (computeConstr fns)+ in (st',concat res)+ where+ computeConstr fns = merge (split fns (Map.empty,[]))++ merge (cns,vrs) =+ [(p,fns++[(id,ps++[p],es) | (id,ps,es) <- vrs])+ | (p,fns) <- concatMap addArgs (Map.toList cns)]+ +++ if null vrs + then []+ else [(PWild,[(id,ps++[PWild],es) | (id,ps,es) <- vrs])]+ where+ addArgs (cn,fns) = addArg (length args) cn [] fns+ where+ Just (DTyp args _ _es,_,_,_) = Map.lookup cn (funs (abstract pgf))++ addArg 0 cn ps fns = [(PApp cn (reverse ps),fns)]+ addArg n cn ps fns = concat [addArg (n-1) cn (arg:ps) fns' | (arg,fns') <- computeConstr fns]++ split [] (cns,vrs) = (cns,vrs)+ split ((id, ps, e:es):fns) (cns,vrs) = split fns (extract e [])+ where+ extract (EFun cn) args = (Map.insertWith (++) cn [(id,ps,args++es)] cns, vrs)+ extract (EVar i) args = (cns, (id,ps,es):vrs)+ extract (EApp e1 e2) args = extract e1 (e2:args)+ extract (ETyped e ty) args = extract e args+ extract (EImplArg e) args = extract e args++p_f c = mkCId ("p_"++showCId c)+p_i i = mkCId ("p_"++show i)+k_f f = mkCId ("k_"++showCId f)+k_i i = mkCId ("k_"++show i)
@@ -0,0 +1,77 @@+module PGF.SortTop+ ( forExample+ ) where++import PGF.CId+import PGF.Data+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Maybe+++arguments :: Type -> [CId]+arguments (DTyp [] _ _) = []+arguments (DTyp hypos _ _) = [ t | (_,_, DTyp _ t _) <- hypos]++-- topological order of functions+-- in the order that they should be tested and generated in an example-based system++showInOrder :: Abstr -> Set.Set CId -> Set.Set CId -> Set.Set CId -> IO [[((CId,CId),[CId])]]+showInOrder abs fset remset avset = + let mtypes = typesInterm abs fset+ nextsetWithArgs = Set.map (\(x,y) -> ((x, returnCat abs x), fromJust y)) $ Set.filter (isJust.snd) $ Set.map (\x -> (x, isArg abs mtypes avset x)) remset+ nextset = Set.map (fst.fst) nextsetWithArgs+ nextcat = Set.map (returnCat abs) nextset+ diffset = Set.difference remset nextset+ in + if Set.null diffset then do + return [Set.toList nextsetWithArgs]+ else if Set.null nextset then do + putStrLn $ "not comparable : " ++ show diffset+ return []+ else do + + rest <- showInOrder abs (Set.union fset nextset) (Set.difference remset nextset) (Set.union avset nextcat)+ return $ (Set.toList nextsetWithArgs) : rest ++ +isArg :: Abstr -> Map.Map CId CId -> Set.Set CId -> CId -> Maybe [CId]+isArg abs mtypes scid cid = + let p = Map.lookup cid $ funs abs+ (ty,_,_,_) = fromJust p + args = arguments ty + setargs = Set.fromList args+ cond = Set.null $ Set.difference setargs scid+ in + if isNothing p then error $ "not found " ++ show cid ++ "here !!"+ else if cond then return args+ else Nothing ++typesInterm :: Abstr -> Set.Set CId -> Map.Map CId CId+typesInterm abs fset = + let fs = funs abs+ fsetTypes = Set.map (\x -> + let (DTyp _ c _,_,_,_)=fromJust $ Map.lookup x fs+ in (x,c)) fset+ in Map.fromList $ Set.toList fsetTypes ++{-+takeArgs :: Map.Map CId CId -> Map.Map CId Expr -> CId -> Expr+takeArgs mtypes mexpr ty = + let xarg = head $ Map.keys $ Map.filter (==ty) mtypes+ in fromJust $ Map.lookup xarg mexpr ++doesReturnCat :: Type -> CId -> Bool+doesReturnCat (DTyp _ c _) cat = c == cat +-} +returnCat :: Abstr -> CId -> CId +returnCat abs cid = + let p = Map.lookup cid $ funs abs + (DTyp _ c _,_,_,_) = fromJust p + in if isNothing p then error $ "not found "++ show cid ++ " in abstract "+ else c++-- topological order of the categories+forExample :: PGF -> IO [[((CId,CId),[CId])]]+forExample pgf = let abs = abstract pgf + in showInOrder abs Set.empty (Set.fromList $ Map.keys $ funs abs) Set.empty
@@ -0,0 +1,72 @@+module PGF.Tree + ( Tree(..),+ tree2expr, expr2tree,+ prTree+ ) where++import PGF.CId+import PGF.Expr hiding (Tree)++--import Data.Char+import Data.List as List+--import Control.Monad+--import qualified Text.PrettyPrint as PP+--import qualified Text.ParserCombinators.ReadP as RP++-- | The tree is an evaluated expression in the abstract syntax+-- of the grammar. The type is especially restricted to not+-- allow unapplied lambda abstractions. The tree is used directly +-- from the linearizer and is produced directly from the parser.+data Tree = + Abs [(BindType,CId)] Tree -- ^ lambda abstraction. The list of variables is non-empty+ | Var CId -- ^ variable+ | Fun CId [Tree] -- ^ function application+ | Lit Literal -- ^ literal+ | Meta {-# UNPACK #-} !MetaId -- ^ meta variable+ deriving (Eq, Ord)++-----------------------------------------------------+-- Conversion Expr <-> Tree+-----------------------------------------------------++-- | Converts a tree to expression. The conversion+-- is always total, every tree is a valid expression.+tree2expr :: Tree -> Expr+tree2expr = tree2expr []+ where+ tree2expr ys (Fun x ts) = foldl EApp (EFun x) (List.map (tree2expr ys) ts) + tree2expr ys (Lit l) = ELit l+ tree2expr ys (Meta n) = EMeta n+ tree2expr ys (Abs xs t) = foldr (\(b,x) e -> EAbs b x e) (tree2expr (List.map snd (reverse xs)++ys) t) xs+ tree2expr ys (Var x) = case List.lookup x (zip ys [0..]) of+ Just i -> EVar i+ Nothing -> error "unknown variable"++-- | Converts an expression to tree. The conversion is only partial.+-- Variables and meta variables of function type and beta redexes are not allowed.+expr2tree :: Expr -> Tree+expr2tree e = abs [] [] e+ where+ abs ys xs (EAbs b x e) = abs ys ((b,x):xs) e+ abs ys xs (ETyped e _) = abs ys xs e+ abs ys xs e = case xs of+ [] -> app ys [] e+ xs -> Abs (reverse xs) (app (map snd xs++ys) [] e)++ app xs as (EApp e1 e2) = app xs ((abs xs [] e2) : as) e1+ app xs as (ELit l)+ | List.null as = Lit l+ | otherwise = error "literal of function type encountered"+ app xs as (EMeta n)+ | List.null as = Meta n+ | otherwise = error "meta variables of function type are not allowed in trees"+ app xs as (EAbs _ x e) = error "beta redexes are not allowed in trees"+ app xs as (EVar i) = if length xs > i then Var (xs !! i) else Meta i+ ---- AR 14/12/2010: work-around needed in PGF.Paraphrase.fromDef+ app xs as (EFun f) = Fun f as+ app xs as (ETyped e _) = app xs as e+++prTree :: Tree -> String+prTree = showExpr [] . tree2expr+
@@ -0,0 +1,99 @@+module PGF.TrieMap + ( TrieMap + + , empty + , singleton + + , lookup + + , null + , compose + , decompose + + , insertWith + + , union, unionWith + , unions, unionsWith + + , elems + , toList + , fromList, fromListWith + + , map + , mapWithKey + ) where + +import Prelude hiding (lookup, null, map) +import qualified Data.Map as Map +import Data.List (foldl') + +data TrieMap k v = Tr (Maybe v) (Map.Map k (TrieMap k v)) + +empty = Tr Nothing Map.empty + +singleton :: [k] -> a -> TrieMap k a +singleton [] v = Tr (Just v) Map.empty +singleton (k:ks) v = Tr Nothing (Map.singleton k (singleton ks v)) + +lookup :: Ord k => [k] -> TrieMap k a -> Maybe a +lookup [] (Tr mb_v m) = mb_v +lookup (k:ks) (Tr mb_v m) = Map.lookup k m >>= lookup ks + +null :: TrieMap k v -> Bool +null (Tr Nothing m) = Map.null m +null _ = False + +compose :: Maybe v -> Map.Map k (TrieMap k v) -> TrieMap k v +compose mb_v m = Tr mb_v m + +decompose :: TrieMap k v -> (Maybe v, Map.Map k (TrieMap k v)) +decompose (Tr mb_v m) = (mb_v,m) + +insertWith :: Ord k => (v -> v -> v) -> [k] -> v -> TrieMap k v -> TrieMap k v +insertWith f [] v0 (Tr mb_v m) = case mb_v of + Just v -> Tr (Just (f v0 v)) m + Nothing -> Tr (Just v0 ) m +insertWith f (k:ks) v0 (Tr mb_v m) = case Map.lookup k m of + Nothing -> Tr mb_v (Map.insert k (singleton ks v0) m) + Just tr -> Tr mb_v (Map.insert k (insertWith f ks v0 tr) m) + +union :: Ord k => TrieMap k v -> TrieMap k v -> TrieMap k v +union = unionWith (\a b -> a) + +unionWith :: Ord k => (v -> v -> v) -> TrieMap k v -> TrieMap k v -> TrieMap k v +unionWith f (Tr mb_v1 m1) (Tr mb_v2 m2) = + let mb_v = case (mb_v1,mb_v2) of + (Nothing,Nothing) -> Nothing + (Just v ,Nothing) -> Just v + (Nothing,Just v ) -> Just v + (Just v1,Just v2) -> Just (f v1 v2) + m = Map.unionWith (unionWith f) m1 m2 + in Tr mb_v m + +unions :: Ord k => [TrieMap k v] -> TrieMap k v +unions = foldl union empty + +unionsWith :: Ord k => (v -> v -> v) -> [TrieMap k v] -> TrieMap k v +unionsWith f = foldl (unionWith f) empty + +elems :: TrieMap k v -> [v] +elems tr = collect tr [] + where + collect (Tr mb_v m) xs = maybe id (:) mb_v (Map.foldr collect xs m) + +toList :: TrieMap k v -> [([k],v)] +toList tr = collect [] tr [] + where + collect ks (Tr mb_v m) xs = maybe id (\v -> (:) (ks,v)) mb_v (Map.foldrWithKey (\k -> collect (k:ks)) xs m) + +fromListWith :: Ord k => (v -> v -> v) -> [([k],v)] -> TrieMap k v +fromListWith f xs = foldl' (\trie (ks,v) -> insertWith f ks v trie) empty xs + +fromList :: Ord k => [([k],v)] -> TrieMap k v +fromList xs = fromListWith const xs + +map :: (a -> b) -> TrieMap k a -> TrieMap k b +map f (Tr mb_v m) = Tr (fmap f mb_v) (Map.map (map f) m) + +mapWithKey :: ([k] -> a -> b) -> TrieMap k a -> TrieMap k b +mapWithKey f (Tr mb_v m) = Tr (fmap (f []) mb_v) (Map.mapWithKey (\k -> mapWithKey (f . (k:))) m)
@@ -0,0 +1,105 @@+module PGF.Type ( Type(..), Hypo, CId, + readType, showType, + mkType, mkHypo, mkDepHypo, mkImplHypo, + unType, + pType, ppType, ppHypo ) where + +import PGF.CId +import {-# SOURCE #-} PGF.Expr +import Data.Char +import Data.List +import qualified Text.PrettyPrint as PP +import qualified Text.ParserCombinators.ReadP as RP +--import Control.Monad + +-- | To read a type from a 'String', use 'readType'. +data Type = + DTyp [Hypo] CId [Expr] + deriving (Eq,Ord,Show) + +-- | 'Hypo' represents a hypothesis in a type i.e. in the type A -> B, A is the hypothesis +type Hypo = (BindType,CId,Type) + +-- | Reads a 'Type' from a 'String'. +readType :: String -> Maybe Type +readType s = case [x | (x,cs) <- RP.readP_to_S pType s, all isSpace cs] of + [x] -> Just x + _ -> Nothing + +-- | renders type as 'String'. The list +-- of identifiers is the list of all free variables +-- in the expression in order reverse to the order +-- of binding. +showType :: [CId] -> Type -> String +showType vars = PP.render . ppType 0 vars + +-- | creates a type from list of hypothesises, category and +-- list of arguments for the category. The operation +-- @mkType [h_1,...,h_n] C [e_1,...,e_m]@ will create +-- @h_1 -> ... -> h_n -> C e_1 ... e_m@ +mkType :: [Hypo] -> CId -> [Expr] -> Type +mkType hyps cat args = DTyp hyps cat args + +-- | creates hypothesis for non-dependent type i.e. A +mkHypo :: Type -> Hypo +mkHypo ty = (Explicit,wildCId,ty) + +-- | creates hypothesis for dependent type i.e. (x : A) +mkDepHypo :: CId -> Type -> Hypo +mkDepHypo x ty = (Explicit,x,ty) + +-- | creates hypothesis for dependent type with implicit argument i.e. ({x} : A) +mkImplHypo :: CId -> Type -> Hypo +mkImplHypo x ty = (Implicit,x,ty) + +unType :: Type -> ([Hypo], CId, [Expr]) +unType (DTyp hyps cat es) = (hyps, cat, es) + +pType :: RP.ReadP Type +pType = do + RP.skipSpaces + hyps <- RP.sepBy (pHypo >>= \h -> RP.skipSpaces >> RP.string "->" >> return h) RP.skipSpaces + RP.skipSpaces + (cat,args) <- pAtom + return (DTyp (concat hyps) cat args) + where + pHypo = + do (cat,args) <- pAtom + return [(Explicit,wildCId,DTyp [] cat args)] + RP.<++ + do RP.between (RP.char '(') (RP.char ')') pHypoBinds + +pHypoBinds = do + xs <- RP.option [(Explicit,wildCId)] $ do + xs <- pBinds + RP.skipSpaces + RP.char ':' + return xs + ty <- pType + return [(b,v,ty) | (b,v) <- xs] + +pAtom = do + cat <- pCId + RP.skipSpaces + args <- RP.sepBy pArg RP.skipSpaces + return (cat, args) + +ppType :: Int -> [CId] -> Type -> PP.Doc +ppType d scope (DTyp hyps cat args) + | null hyps = ppRes scope cat args + | otherwise = let (scope',hdocs) = mapAccumL (ppHypo 1) scope hyps + in ppParens (d > 0) (foldr (\hdoc doc -> hdoc PP.<+> PP.text "->" PP.<+> doc) (ppRes scope' cat args) hdocs) + where + ppRes scope cat es + | null es = ppCId cat + | otherwise = ppParens (d > 3) (ppCId cat PP.<+> PP.hsep (map (ppExpr 4 scope) es)) + +ppHypo :: Int -> [CId] -> (BindType,CId,Type) -> ([CId],PP.Doc) +ppHypo d scope (Explicit,x,typ) = if x == wildCId + then (scope,ppType d scope typ) + else let y = freshName x scope + in (y:scope,PP.parens (ppCId y PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) +ppHypo d scope (Implicit,x,typ) = if x == wildCId + then (scope,PP.parens (PP.braces (ppCId x) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) + else let y = freshName x scope + in (y:scope,PP.parens (PP.braces (ppCId y) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ))
@@ -0,0 +1,677 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, RankNTypes #-}++----------------------------------------------------------------------+-- |+-- Module : PGF.TypeCheck+-- Maintainer : Krasimir Angelov+-- Stability : (stable)+-- Portability : (portable)+--+-- Type checking in abstract syntax with dependent types.+-- The type checker also performs renaming and checking for unknown+-- functions. The variable references are replaced by de Bruijn indices.+--+-----------------------------------------------------------------------------++module PGF.TypeCheck ( checkType, checkExpr, inferExpr++ , ppTcError, TcError(..)++ -- internals needed for the typechecking of forests+ , MetaStore, emptyMetaStore, newMeta, newGuardedMeta+ , getMeta, setMeta, lookupMeta, MetaValue(..)+ , Scope, emptyScope, scopeSize, scopeEnv, addScopedVar+ , TcM(..), runTcM, TType(..), Selector(..)+ , tcExpr, infExpr, eqType, eqValue+ , lookupFunType, typeGenerators, eval+ , generateForMetas, generateForForest, checkResolvedMetaStore+ ) where++import PGF.Data+import PGF.Expr hiding (eval, apply, applyValue, value2expr)+import qualified PGF.Expr as Expr+import PGF.Macros (cidInt, cidFloat, cidString) -- typeOfHypo+import PGF.CId++import Data.Map as Map+import Data.IntMap as IntMap+import Data.Maybe as Maybe+import Data.List as List+import Control.Applicative+import Control.Monad+--import Control.Monad.Identity+import Control.Monad.State+import Control.Monad.Error+import Text.PrettyPrint++-----------------------------------------------------+-- The Scope+-----------------------------------------------------++data TType = TTyp Env Type+newtype Scope = Scope [(CId,TType)]++emptyScope = Scope []++addScopedVar :: CId -> TType -> Scope -> Scope+addScopedVar x tty (Scope gamma) = Scope ((x,tty):gamma)++-- | returns the type and the De Bruijn index of a local variable+lookupVar :: CId -> Scope -> Maybe (Int,TType)+lookupVar x (Scope gamma) = listToMaybe [(i,tty) | ((y,tty),i) <- zip gamma [0..], x == y]++-- | returns the type and the name of a local variable+getVar :: Int -> Scope -> (CId,TType)+getVar i (Scope gamma) = gamma !! i++scopeEnv :: Scope -> Env+scopeEnv (Scope gamma) = let n = length gamma+ in [VGen (n-i-1) [] | i <- [0..n-1]]++scopeVars :: Scope -> [CId]+scopeVars (Scope gamma) = List.map fst gamma++scopeSize :: Scope -> Int+scopeSize (Scope gamma) = length gamma++-----------------------------------------------------+-- The Monad+-----------------------------------------------------++type MetaStore s = IntMap (MetaValue s)+data MetaValue s+ = MUnbound s Scope TType [Expr -> TcM s ()]+ | MBound Expr+ | MGuarded Expr [Expr -> TcM s ()] {-# UNPACK #-} !Int -- the Int is the number of constraints that have to be solved + -- to unlock this meta variable++newtype TcM s a = TcM {unTcM :: forall b . Abstr -> (a -> MetaStore s -> s -> b -> b) + -> (TcError -> s -> b -> b) + -> (MetaStore s -> s -> b -> b)}++class Selector s where+ splitSelector :: s -> (s,s)+ select :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType)++instance Applicative (TcM s) where+ pure = return+ (<*>) = ap++instance Monad (TcM s) where+ return x = TcM (\abstr k h -> k x)+ f >>= g = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h)++instance Selector s => Alternative (TcM s) where+ empty = mzero+ (<|>) = mplus++instance Selector s => MonadPlus (TcM s) where+ mzero = TcM (\abstr k h ms s -> id)+ mplus f g = TcM (\abstr k h ms s -> let (s1,s2) = splitSelector s+ in unTcM f abstr k h ms s1 . unTcM g abstr k h ms s2)++instance MonadState s (TcM s) where+ get = TcM (\abstr k h ms s -> k s ms s)+ put s = TcM (\abstr k h ms _ -> k () ms s)++instance MonadError TcError (TcM s) where+ throwError e = TcM (\abstr k h ms -> h e)+ catchError f fh = TcM (\abstr k h ms -> unTcM f abstr k (\e s -> unTcM (fh e) abstr k h ms s) ms)++instance Functor (TcM s) where+ fmap f m = TcM (\abstr k h -> unTcM m abstr (k . f) h)++runTcM :: Abstr -> TcM s a -> MetaStore s -> s -> ([(s,TcError)],[(MetaStore s,s,a)])+runTcM abstr f ms s = unTcM f abstr (\x ms s cp b -> let (es,xs) = cp b+ in (es,(ms,s,x) : xs))+ (\e s cp b -> let (es,xs) = cp b+ in ((s,e) : es,xs))+ ms s id ([],[])++lookupCatHyps :: CId -> TcM s [Hypo]+lookupCatHyps cat = TcM (\abstr k h ms -> case Map.lookup cat (cats abstr) of+ Just (hyps,_,_) -> k hyps ms+ Nothing -> h (UnknownCat cat))++lookupFunType :: CId -> TcM s Type+lookupFunType fun = TcM (\abstr k h ms -> case Map.lookup fun (funs abstr) of+ Just (ty,_,_,_) -> k ty ms+ Nothing -> h (UnknownFun fun))++typeGenerators :: Scope -> CId -> TcM s [(Double,Expr,TType)]+typeGenerators scope cat = fmap normalize (liftM2 (++) x y)+ where+ x = return+ [(0.25,EVar i,tty) | (i,(_,tty@(TTyp _ (DTyp _ cat' _)))) <- zip [0..] gamma+ , cat == cat']+ where+ Scope gamma = scope++ y | cat == cidInt = return [(1.0,ELit (LInt 999), TTyp [] (DTyp [] cat []))]+ | cat == cidFloat = return [(1.0,ELit (LFlt 3.14), TTyp [] (DTyp [] cat []))]+ | cat == cidString = return [(1.0,ELit (LStr "Foo"),TTyp [] (DTyp [] cat []))]+ | otherwise = TcM (\abstr k h ms ->+ case Map.lookup cat (cats abstr) of+ Just (_,fns,_) -> unTcM (mapM helper fns) abstr k h ms+ Nothing -> h (UnknownCat cat))++ helper (p,fn) = do+ ty <- lookupFunType fn+ return (p,EFun fn,TTyp [] ty)+ + normalize gens = [(p/s,e,tty) | (p,e,tty) <- gens]+ where+ s = sum [p | (p,_,_) <- gens]++emptyMetaStore :: MetaStore s+emptyMetaStore = IntMap.empty++newMeta :: Scope -> TType -> TcM s MetaId+newMeta scope tty = TcM (\abstr k h ms s -> let metaid = IntMap.size ms + 1+ in k metaid (IntMap.insert metaid (MUnbound s scope tty []) ms) s)++newGuardedMeta :: Expr -> TcM s MetaId+newGuardedMeta e = TcM (\abstr k h ms s -> let metaid = IntMap.size ms + 1+ in k metaid (IntMap.insert metaid (MGuarded e [] 0) ms) s)++getMeta :: MetaId -> TcM s (MetaValue s)+getMeta i = TcM (\abstr k h ms -> case IntMap.lookup i ms of+ Just mv -> k mv ms)++setMeta :: MetaId -> MetaValue s -> TcM s ()+setMeta i mv = TcM (\abstr k h ms -> k () (IntMap.insert i mv ms))++lookupMeta ms i =+ case IntMap.lookup i ms of+ Just (MBound t) -> Just t+ Just (MGuarded t _ x) | x == 0 -> Just t+ | otherwise -> Nothing+ Just (MUnbound _ _ _ _) -> Nothing+ Nothing -> Nothing++addConstraint :: MetaId -> MetaId -> (Expr -> TcM s ()) -> TcM s ()+addConstraint i j c = do+ mv <- getMeta j+ case mv of+ MUnbound s scope tty cs -> addRef >> setMeta j (MUnbound s scope tty ((\e -> release >> c e) : cs))+ MBound e -> c e+ MGuarded e cs x | x == 0 -> c e+ | otherwise -> addRef >> setMeta j (MGuarded e ((\e -> release >> c e) : cs) x)+ where+ addRef = TcM (\abstr k h ms -> case IntMap.lookup i ms of+ Just (MGuarded e cs x) -> k () $! IntMap.insert i (MGuarded e cs (x+1)) ms)++ release = TcM (\abstr k h ms -> case IntMap.lookup i ms of+ Just (MGuarded e cs x) -> if x == 1+ then unTcM (sequence_ [c e | c <- cs]) abstr k h $! IntMap.insert i (MGuarded e [] 0) ms+ else k () $! IntMap.insert i (MGuarded e cs (x-1)) ms)++-----------------------------------------------------+-- Type errors+-----------------------------------------------------++-- | If an error occurs in the typechecking phase+-- the type checker returns not a plain text error message+-- but a 'TcError' structure which describes the error.+data TcError+ = UnknownCat CId -- ^ Unknown category name was found.+ | UnknownFun CId -- ^ Unknown function name was found.+ | WrongCatArgs [CId] Type CId Int Int -- ^ A category was applied to wrong number of arguments.+ -- The first integer is the number of expected arguments and+ -- the second the number of given arguments.+ -- The @[CId]@ argument is the list of free variables+ -- in the type. It should be used for the 'showType' function.+ | TypeMismatch [CId] Expr Type Type -- ^ The expression is not of the expected type.+ -- The first type is the expected type, while+ -- the second is the inferred. The @[CId]@ argument is the list+ -- of free variables in both the expression and the type. + -- It should be used for the 'showType' and 'showExpr' functions.+ | NotFunType [CId] Expr Type -- ^ Something that is not of function type was applied to an argument.+ | CannotInferType [CId] Expr -- ^ It is not possible to infer the type of an expression.+ | UnresolvedMetaVars [CId] Expr [MetaId] -- ^ Some metavariables have to be instantiated in order to complete the typechecking.+ | UnexpectedImplArg [CId] Expr -- ^ Implicit argument was passed where the type doesn't allow it+ | UnsolvableGoal [CId] MetaId Type -- ^ There is a goal that cannot be solved+ deriving Eq++-- | Renders the type checking error to a document. See 'Text.PrettyPrint'.+ppTcError :: TcError -> Doc+ppTcError (UnknownCat cat) = text "Category" <+> ppCId cat <+> text "is not in scope"+ppTcError (UnknownFun fun) = text "Function" <+> ppCId fun <+> text "is not in scope"+ppTcError (WrongCatArgs xs ty cat m n) = text "Category" <+> ppCId cat <+> text "should have" <+> int m <+> text "argument(s), but has been given" <+> int n $$+ text "In the type:" <+> ppType 0 xs ty+ppTcError (TypeMismatch xs e ty1 ty2) = text "Couldn't match expected type" <+> ppType 0 xs ty1 $$+ text " against inferred type" <+> ppType 0 xs ty2 $$+ text "In the expression:" <+> ppExpr 0 xs e+ppTcError (NotFunType xs e ty) = text "A function type is expected for the expression" <+> ppExpr 0 xs e <+> text "instead of type" <+> ppType 0 xs ty+ppTcError (CannotInferType xs e) = text "Cannot infer the type of expression" <+> ppExpr 0 xs e+ppTcError (UnresolvedMetaVars xs e ms) = text "Meta variable(s)" <+> fsep (List.map ppMeta ms) <+> text "should be resolved" $$+ text "in the expression:" <+> ppExpr 0 xs e+ppTcError (UnexpectedImplArg xs e) = braces (ppExpr 0 xs e) <+> text "is implicit argument but not implicit argument is expected here"+ppTcError (UnsolvableGoal xs metaid ty)= text "The goal:" <+> ppMeta metaid <+> colon <+> ppType 0 xs ty $$+ text "cannot be solved"++-----------------------------------------------------+-- checkType+-----------------------------------------------------++-- | Check whether a given type is consistent with the abstract+-- syntax of the grammar.+checkType :: PGF -> Type -> Either TcError Type+checkType pgf ty = + unTcM (do ty <- tcType emptyScope ty+ refineType ty)+ (abstract pgf)+ (\ty ms s _ -> Right ty)+ (\err s _ -> Left err)+ emptyMetaStore () (error "checkType")++tcType :: Scope -> Type -> TcM s Type+tcType scope ty@(DTyp hyps cat es) = do+ (scope,hyps) <- tcHypos scope hyps+ c_hyps <- lookupCatHyps cat+ let m = length es+ n = length [ty | (Explicit,x,ty) <- c_hyps]+ (delta,es) <- tcCatArgs scope es [] c_hyps ty n m+ return (DTyp hyps cat es)++tcHypos :: Scope -> [Hypo] -> TcM s (Scope,[Hypo])+tcHypos scope [] = return (scope,[])+tcHypos scope (h:hs) = do+ (scope,h ) <- tcHypo scope h+ (scope,hs) <- tcHypos scope hs+ return (scope,h:hs)++tcHypo :: Scope -> Hypo -> TcM s (Scope,Hypo)+tcHypo scope (b,x,ty) = do+ ty <- tcType scope ty+ if x == wildCId+ then return (scope,(b,x,ty))+ else return (addScopedVar x (TTyp (scopeEnv scope) ty) scope,(b,x,ty))++tcCatArgs scope [] delta [] ty0 n m = return (delta,[])+tcCatArgs scope (EImplArg e:es) delta ((Explicit,x,ty):hs) ty0 n m = throwError (UnexpectedImplArg (scopeVars scope) e)+tcCatArgs scope (EImplArg e:es) delta ((Implicit,x,ty):hs) ty0 n m = do+ e <- tcExpr scope e (TTyp delta ty)+ (delta,es) <- if x == wildCId+ then tcCatArgs scope es delta hs ty0 n m+ else do v <- eval (scopeEnv scope) e+ tcCatArgs scope es (v:delta) hs ty0 n m+ return (delta,EImplArg e:es)+tcCatArgs scope es delta ((Implicit,x,ty):hs) ty0 n m = do+ i <- newMeta scope (TTyp delta ty)+ (delta,es) <- if x == wildCId+ then tcCatArgs scope es delta hs ty0 n m+ else tcCatArgs scope es (VMeta i (scopeEnv scope) [] : delta) hs ty0 n m+ return (delta,EImplArg (EMeta i) : es)+tcCatArgs scope (e:es) delta ((Explicit,x,ty):hs) ty0 n m = do+ e <- tcExpr scope e (TTyp delta ty)+ (delta,es) <- if x == wildCId+ then tcCatArgs scope es delta hs ty0 n m+ else do v <- eval (scopeEnv scope) e+ tcCatArgs scope es (v:delta) hs ty0 n m+ return (delta,e:es)+tcCatArgs scope _ delta _ ty0@(DTyp _ cat _) n m = do+ throwError (WrongCatArgs (scopeVars scope) ty0 cat n m)++-----------------------------------------------------+-- checkExpr+-----------------------------------------------------++-- | Checks an expression against a specified type.+checkExpr :: PGF -> Expr -> Type -> Either TcError Expr+checkExpr pgf e ty =+ unTcM (do e <- tcExpr emptyScope e (TTyp [] ty)+ checkResolvedMetaStore emptyScope e)+ (abstract pgf)+ (\e ms s _ -> Right e)+ (\err s _ -> Left err)+ emptyMetaStore () (error "checkExpr")++tcExpr :: Scope -> Expr -> TType -> TcM s Expr+tcExpr scope e0@(EAbs Implicit x e) tty =+ case tty of+ TTyp delta (DTyp ((Implicit,y,ty):hs) c es) -> do e <- if y == wildCId+ then tcExpr (addScopedVar x (TTyp delta ty) scope)+ e (TTyp delta (DTyp hs c es))+ else tcExpr (addScopedVar x (TTyp delta ty) scope)+ e (TTyp ((VGen (scopeSize scope) []):delta) (DTyp hs c es))+ return (EAbs Implicit x e)+ _ -> do ty <- evalType (scopeSize scope) tty+ throwError (NotFunType (scopeVars scope) e0 ty)+tcExpr scope e0 (TTyp delta (DTyp ((Implicit,y,ty):hs) c es)) = do+ e0 <- if y == wildCId+ then tcExpr (addScopedVar wildCId (TTyp delta ty) scope)+ e0 (TTyp delta (DTyp hs c es))+ else tcExpr (addScopedVar wildCId (TTyp delta ty) scope)+ e0 (TTyp ((VGen (scopeSize scope) []):delta) (DTyp hs c es))+ return (EAbs Implicit wildCId e0)+tcExpr scope e0@(EAbs Explicit x e) tty =+ case tty of+ TTyp delta (DTyp ((Explicit,y,ty):hs) c es) -> do e <- if y == wildCId+ then tcExpr (addScopedVar x (TTyp delta ty) scope)+ e (TTyp delta (DTyp hs c es))+ else tcExpr (addScopedVar x (TTyp delta ty) scope)+ e (TTyp ((VGen (scopeSize scope) []):delta) (DTyp hs c es))+ return (EAbs Explicit x e)+ _ -> do ty <- evalType (scopeSize scope) tty+ throwError (NotFunType (scopeVars scope) e0 ty)+tcExpr scope (EMeta _) tty = do+ i <- newMeta scope tty+ return (EMeta i)+tcExpr scope e0 tty = do+ (e0,tty0) <- infExpr scope e0+ (e0,tty0) <- appImplArg scope e0 tty0+ i <- newGuardedMeta e0+ eqType scope (scopeSize scope) i tty tty0+ return (EMeta i)+++-----------------------------------------------------+-- inferExpr+-----------------------------------------------------++-- | Tries to infer the type of a given expression. Note that+-- even if the expression is type correct it is not always+-- possible to infer its type in the GF type system.+-- In this case the function returns the 'CannotInferType' error.+inferExpr :: PGF -> Expr -> Either TcError (Expr,Type)+inferExpr pgf e =+ unTcM (do (e,tty) <- infExpr emptyScope e+ e <- checkResolvedMetaStore emptyScope e+ ty <- evalType 0 tty+ return (e,ty))+ (abstract pgf)+ (\e_ty ms s _ -> Right e_ty)+ (\err s _ -> Left err)+ emptyMetaStore () (error "inferExpr")++infExpr :: Scope -> Expr -> TcM s (Expr,TType)+infExpr scope e0@(EApp e1 e2) = do+ (e1,TTyp delta ty) <- infExpr scope e1+ (e0,delta,ty) <- tcArg scope e1 e2 delta ty+ return (e0,TTyp delta ty)+infExpr scope e0@(EFun x) = do+ case lookupVar x scope of+ Just (i,tty) -> return (EVar i,tty)+ Nothing -> do ty <- lookupFunType x+ return (e0,TTyp [] ty)+infExpr scope e0@(EVar i) = do+ return (e0,snd (getVar i scope))+infExpr scope e0@(ELit l) = do+ let cat = case l of+ LStr _ -> mkCId "String"+ LInt _ -> mkCId "Int"+ LFlt _ -> mkCId "Float"+ return (e0,TTyp [] (DTyp [] cat []))+infExpr scope (ETyped e ty) = do+ ty <- tcType scope ty+ e <- tcExpr scope e (TTyp (scopeEnv scope) ty)+ return (ETyped e ty,TTyp (scopeEnv scope) ty)+infExpr scope (EImplArg e) = do+ (e,tty) <- infExpr scope e+ return (EImplArg e,tty)+infExpr scope e = throwError (CannotInferType (scopeVars scope) e)++tcArg scope e1 e2 delta ty0@(DTyp [] c es) = do+ ty1 <- evalType (scopeSize scope) (TTyp delta ty0)+ throwError (NotFunType (scopeVars scope) e1 ty1)+tcArg scope e1 (EImplArg e2) delta ty0@(DTyp ((Explicit,x,ty):hs) c es) = throwError (UnexpectedImplArg (scopeVars scope) e2)+tcArg scope e1 (EImplArg e2) delta ty0@(DTyp ((Implicit,x,ty):hs) c es) = do+ e2 <- tcExpr scope e2 (TTyp delta ty)+ if x == wildCId+ then return (EApp e1 (EImplArg e2), delta,DTyp hs c es)+ else do v2 <- eval (scopeEnv scope) e2+ return (EApp e1 (EImplArg e2),v2:delta,DTyp hs c es)+tcArg scope e1 e2 delta ty0@(DTyp ((Explicit,x,ty):hs) c es) = do+ e2 <- tcExpr scope e2 (TTyp delta ty)+ if x == wildCId+ then return (EApp e1 e2,delta,DTyp hs c es)+ else do v2 <- eval (scopeEnv scope) e2+ return (EApp e1 e2,v2:delta,DTyp hs c es)+tcArg scope e1 e2 delta ty0@(DTyp ((Implicit,x,ty):hs) c es) = do+ i <- newMeta scope (TTyp delta ty)+ if x == wildCId+ then tcArg scope (EApp e1 (EImplArg (EMeta i))) e2 delta (DTyp hs c es)+ else tcArg scope (EApp e1 (EImplArg (EMeta i))) e2 (VMeta i (scopeEnv scope) [] : delta) (DTyp hs c es)++appImplArg scope e (TTyp delta (DTyp ((Implicit,x,ty1):hypos) cat es)) = do+ i <- newMeta scope (TTyp delta ty1)+ let delta' = if x == wildCId+ then delta + else VMeta i (scopeEnv scope) [] : delta+ appImplArg scope (EApp e (EImplArg (EMeta i))) (TTyp delta' (DTyp hypos cat es))+appImplArg scope e tty = return (e,tty)++-----------------------------------------------------+-- eqType+-----------------------------------------------------++eqType :: Scope -> Int -> MetaId -> TType -> TType -> TcM s ()+eqType scope k i0 tty1@(TTyp delta1 ty1@(DTyp hyps1 cat1 es1)) tty2@(TTyp delta2 ty2@(DTyp hyps2 cat2 es2))+ | cat1 == cat2 = do (k,delta1,delta2) <- eqHyps k delta1 hyps1 delta2 hyps2+ sequence_ [eqExpr raiseTypeMatchError (addConstraint i0) k delta1 e1 delta2 e2 | (e1,e2) <- zip es1 es2]+ | otherwise = raiseTypeMatchError+ where+ raiseTypeMatchError = do ty1 <- evalType k tty1+ ty2 <- evalType k tty2+ e <- refineExpr (EMeta i0)+ throwError (TypeMismatch (scopeVars scope) e ty1 ty2)++ eqHyps :: Int -> Env -> [Hypo] -> Env -> [Hypo] -> TcM s (Int,Env,Env)+ eqHyps k delta1 [] delta2 [] =+ return (k,delta1,delta2)+ eqHyps k delta1 ((_,x,ty1) : h1s) delta2 ((_,y,ty2) : h2s) = do+ eqType scope k i0 (TTyp delta1 ty1) (TTyp delta2 ty2)+ if x == wildCId && y == wildCId+ then eqHyps k delta1 h1s delta2 h2s+ else if x /= wildCId && y /= wildCId+ then eqHyps (k+1) ((VGen k []):delta1) h1s ((VGen k []):delta2) h2s+ else raiseTypeMatchError+ eqHyps k delta1 h1s delta2 h2s = raiseTypeMatchError++eqExpr :: (forall a . TcM s a) -> (MetaId -> (Expr -> TcM s ()) -> TcM s ()) -> Int -> Env -> Expr -> Env -> Expr -> TcM s ()+eqExpr fail suspend k env1 e1 env2 e2 = do+ v1 <- eval env1 e1+ v2 <- eval env2 e2+ eqValue fail suspend k v1 v2++eqValue :: (forall a . TcM s a) -> (MetaId -> (Expr -> TcM s ()) -> TcM s ()) -> Int -> Value -> Value -> TcM s ()+eqValue fail suspend k v1 v2 = do+ v1 <- deRef v1+ v2 <- deRef v2+ eqValue' k v1 v2+ where+ deRef v@(VMeta i env vs) = do+ mv <- getMeta i+ case mv of+ MBound e -> apply env e vs+ MGuarded e _ x | x == 0 -> apply env e vs+ | otherwise -> return v+ MUnbound _ _ _ _ -> return v+ deRef v = return v++ eqValue' k (VSusp i env vs1 c) v2 = suspend i (\e -> apply env e vs1 >>= \v1 -> eqValue fail suspend k (c v1) v2)+ eqValue' k v1 (VSusp i env vs2 c) = suspend i (\e -> apply env e vs2 >>= \v2 -> eqValue fail suspend k v1 (c v2))+ eqValue' k (VMeta i env1 vs1) (VMeta j env2 vs2) | i == j = zipWithM_ (eqValue fail suspend k) vs1 vs2+ eqValue' k (VMeta i env1 vs1) v2 = do mv <- getMeta i+ case mv of+ MUnbound _ scopei _ cs -> bind i scopei cs env1 vs1 v2+ MGuarded e cs x -> setMeta i (MGuarded e ((\e -> apply env1 e vs1 >>= \v1 -> eqValue' k v1 v2) : cs) x)+ eqValue' k v1 (VMeta i env2 vs2) = do mv <- getMeta i+ case mv of+ MUnbound _ scopei _ cs -> bind i scopei cs env2 vs2 v1+ MGuarded e cs x -> setMeta i (MGuarded e ((\e -> apply env2 e vs2 >>= \v2 -> eqValue' k v1 v2) : cs) x)+ eqValue' k (VApp f1 vs1) (VApp f2 vs2) | f1 == f2 = zipWithM_ (eqValue fail suspend k) vs1 vs2+ eqValue' k (VConst f1 vs1) (VConst f2 vs2) | f1 == f2 = zipWithM_ (eqValue fail suspend k) vs1 vs2+ eqValue' k (VLit l1) (VLit l2 ) | l1 == l2 = return ()+ eqValue' k (VGen i vs1) (VGen j vs2) | i == j = zipWithM_ (eqValue fail suspend k) vs1 vs2+ eqValue' k (VClosure env1 (EAbs _ x1 e1)) (VClosure env2 (EAbs _ x2 e2)) = let v = VGen k []+ in eqExpr fail suspend (k+1) (v:env1) e1 (v:env2) e2+ eqValue' k (VClosure env1 (EAbs _ x1 e1)) v2 = let v = VGen k []+ in do v1 <- eval (v:env1) e1+ v2 <- applyValue v2 [v]+ eqValue fail suspend (k+1) v1 v2+ eqValue' k v1 (VClosure env2 (EAbs _ x2 e2)) = let v = VGen k []+ in do v1 <- applyValue v1 [v]+ v2 <- eval (v:env2) e2+ eqValue fail suspend (k+1) v1 v2+ eqValue' k v1 v2 = fail++ bind i scope cs env vs0 v = do+ let k = scopeSize scope+ vs = reverse (List.take k env) ++ vs0+ xs = nub [i | VGen i [] <- vs]+ if length vs /= length xs+ then suspend i (\e -> apply env e vs0 >>= \iv -> eqValue fail suspend k iv v)+ else do v <- occurCheck i k xs v+ e0 <- value2expr (length xs) v+ let e = addLam vs0 e0+ setMeta i (MBound e)+ sequence_ [c e | c <- cs]+ where+ addLam [] e = e+ addLam (v:vs) e = EAbs Explicit var (addLam vs e)++ var = mkCId "v"++ occurCheck i0 k xs (VApp f vs) = do vs <- mapM (occurCheck i0 k xs) vs+ return (VApp f vs)+ occurCheck i0 k xs (VLit l) = return (VLit l)+ occurCheck i0 k xs (VMeta i env vs) = do if i == i0+ then fail+ else return ()+ mv <- getMeta i+ case mv of+ MBound e -> apply env e vs >>= occurCheck i0 k xs+ MGuarded e _ _ -> apply env e vs >>= occurCheck i0 k xs+ MUnbound _ scopei _ _ | scopeSize scopei > k -> fail+ | otherwise -> do vs <- mapM (occurCheck i0 k xs) vs+ return (VMeta i env vs)+ occurCheck i0 k xs (VSusp i env vs cnt) = do suspend i (\e -> apply env e vs >>= \v -> occurCheck i0 k xs (cnt v) >> return ())+ return (VSusp i env vs cnt)+ occurCheck i0 k xs (VGen i vs) = case List.findIndex (==i) xs of+ Just i -> do vs <- mapM (occurCheck i0 k xs) vs+ return (VGen i vs)+ Nothing -> fail+ occurCheck i0 k xs (VConst f vs) = do vs <- mapM (occurCheck i0 k xs) vs+ return (VConst f vs)+ occurCheck i0 k xs (VClosure env e) = do env <- mapM (occurCheck i0 k xs) env+ return (VClosure env e)+ occurCheck i0 k xs (VImplArg e) = do e <- occurCheck i0 k xs e+ return (VImplArg e)+++-----------------------------------------------------------+-- three ways of dealing with meta variables that+-- still have to be resolved+-----------------------------------------------------------++checkResolvedMetaStore :: Scope -> Expr -> TcM s Expr+checkResolvedMetaStore scope e = do+ e <- refineExpr e+ TcM (\abstr k h ms -> + let xs = [i | (i,mv) <- IntMap.toList ms, not (isResolved mv)]+ in if List.null xs+ then k () ms+ else h (UnresolvedMetaVars (scopeVars scope) e xs))+ return e+ where+ isResolved (MUnbound _ _ _ []) = True+ isResolved (MGuarded _ _ _) = True+ isResolved (MBound _) = True+ isResolved _ = False++generateForMetas :: Selector s => (Scope -> TType -> TcM s Expr) -> Expr -> TcM s Expr+generateForMetas prove e = do+ (e,_) <- infExpr emptyScope e+ fillinVariables+ refineExpr e+ where+ fillinVariables = do+ fvs <- TcM (\abstr k h ms -> k [(i,s,scope,tty,cs) | (i,MUnbound s scope tty cs) <- IntMap.toList ms] ms)+ case fvs of+ [] -> return ()+ (i,_,scope,tty,cs):_ -> do e <- prove scope tty+ setMeta i (MBound e)+ sequence_ [c e | c <- cs]+ fillinVariables++generateForForest :: (Scope -> TType -> TcM FId Expr) -> Expr -> TcM FId Expr+generateForForest prove e = do+-- fillinVariables+ refineExpr e+{-+ where+ fillinVariables = do+ fvs <- TcM (\abstr k h ms -> k [(i,s,scope,tty,cs) | (i,MUnbound s scope tty cs) <- IntMap.toList ms] ms)+ case fvs of+ [] -> return ()+ (i,s,scope,tty,cs):_ -> TcM (\abstr k h ms s0 ->+ case snd $ runTcM abstr (prove scope tty) ms s of+ [] -> unTcM (do ty <- evalType (scopeSize scope) tty+ throwError (UnsolvableGoal (scopeVars scope) s ty)+ ) abstr k h ms s+ ((ms,_,e):_) -> unTcM (do setMeta i (MBound e)+ sequence_ [c e | c <- cs]+ fillinVariables+ ) abstr k h ms s)+-}++-----------------------------------------------------+-- evalType+-----------------------------------------------------++evalType :: Int -> TType -> TcM s Type+evalType k (TTyp delta ty) = evalTy funs k delta ty+ where+ evalTy sig k delta (DTyp hyps cat es) = do+ (k,delta,hyps) <- evalHypos sig k delta hyps+ es <- mapM (\e -> eval delta e >>= value2expr k) es+ return (DTyp hyps cat es)++ evalHypos sig k delta [] = return (k,delta,[])+ evalHypos sig k delta ((b,x,ty):hyps) = do+ ty <- evalTy sig k delta ty+ (k,delta,hyps) <- if x == wildCId+ then evalHypos sig k delta hyps+ else evalHypos sig (k+1) ((VGen k []):delta) hyps+ return (k,delta,(b,x,ty) : hyps)+++-----------------------------------------------------+-- refinement+-----------------------------------------------------++refineExpr :: Expr -> TcM s Expr+refineExpr e = TcM (\abstr k h ms -> k (refineExpr_ ms e) ms)++refineExpr_ ms e = refine e+ where+ refine (EAbs b x e) = EAbs b x (refine e)+ refine (EApp e1 e2) = EApp (refine e1) (refine e2)+ refine (ELit l) = ELit l+ refine (EMeta i) = case IntMap.lookup i ms of+ Just (MBound e ) -> refine e+ Just (MGuarded e _ _) -> refine e+ _ -> EMeta i+ refine (EFun f) = EFun f+ refine (EVar i) = EVar i+ refine (ETyped e ty) = ETyped (refine e) (refineType_ ms ty)+ refine (EImplArg e) = EImplArg (refine e)++refineType :: Type -> TcM s Type+refineType ty = TcM (\abstr k h ms -> k (refineType_ ms ty) ms)++refineType_ ms (DTyp hyps cat es) = DTyp [(b,x,refineType_ ms ty) | (b,x,ty) <- hyps] cat (List.map (refineExpr_ ms) es)++eval :: Env -> Expr -> TcM s Value+eval env e = TcM (\abstr k h ms -> k (Expr.eval (funs abstr,lookupMeta ms) env e) ms)++apply :: Env -> Expr -> [Value] -> TcM s Value+apply env e vs = TcM (\abstr k h ms -> k (Expr.apply (funs abstr,lookupMeta ms) env e vs) ms)++applyValue :: Value -> [Value] -> TcM s Value+applyValue v vs = TcM (\abstr k h ms -> k (Expr.applyValue (funs abstr,lookupMeta ms) v vs) ms)++value2expr :: Int -> Value -> TcM s Expr+value2expr i v = TcM (\abstr k h ms -> k (Expr.value2expr (funs abstr,lookupMeta ms) i v) ms)
@@ -0,0 +1,20 @@+-- | Basic utilities+module PGF.Utilities where+import Data.Set(empty,member,insert)+++-- | Like 'Data.List.nub', but O(n log n) instead of O(n^2), since it uses a set to lookup previous things.+-- The result list is stable (the elements are returned in the order they occur), and lazy.+-- Requires that the list elements can be compared by Ord.+-- Code ruthlessly taken from <http://hpaste.org/54411>+nub' :: Ord a => [a] -> [a]+nub' = loop empty+ where loop _ [] = []+ loop seen (x : xs)+ | member x seen = loop seen xs+ | otherwise = x : loop (insert x seen) xs+++-- | Replace all occurences of an element by another element.+replace :: Eq a => a -> a -> [a] -> [a]+replace x y = map (\z -> if z == x then y else z)
@@ -0,0 +1,811 @@+----------------------------------------------------------------------+-- |+-- Module : VisualizeTree+-- Maintainer : KA+-- Stability : (stable)+-- Portability : (portable)+--+-- Print a graph of an abstract syntax tree in Graphviz DOT format+-- Based on BB's VisualizeGrammar+-----------------------------------------------------------------------------++module PGF.VisualizeTree+ ( GraphvizOptions(..)+ , graphvizDefaults+ , graphvizAbstractTree+ , graphvizParseTree+ , graphvizParseTreeDep+ , graphvizDependencyTree+ , Labels, getDepLabels+ , CncLabels, getCncDepLabels+ , graphvizBracketedString+ , graphvizAlignment+ , gizaAlignment+ , conlls2latexDoc+ ) where+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint++import PGF.CId (wildCId,showCId,ppCId,mkCId) --CId,pCId,+import PGF.Data+import PGF.Expr (Tree) -- showExpr+import PGF.Linearize+----import PGF.LatexVisualize (conll2latex) ---- should be separate module?+import PGF.Macros (lookValCat, BracketedString(..))+ --lookMap, BracketedTokn(..), flattenBracketedString++import qualified Data.Map as Map+--import qualified Data.IntMap as IntMap+import Data.List (intersperse,nub,mapAccumL,find,groupBy,sortBy)+import Data.Ord (comparing)+--import Data.Char (isDigit)+import Data.Maybe (fromMaybe)+import Text.PrettyPrint++--import Data.Array.IArray+--import Control.Monad+--import qualified Data.Set as Set+--import qualified Text.ParserCombinators.ReadP as RP+++data GraphvizOptions = GraphvizOptions {noLeaves :: Bool,+ noFun :: Bool,+ noCat :: Bool,+ noDep :: Bool,+ nodeFont :: String,+ leafFont :: String,+ nodeColor :: String,+ leafColor :: String,+ nodeEdgeStyle :: String,+ leafEdgeStyle :: String+ }++graphvizDefaults = GraphvizOptions False False False True "" "" "" "" "" ""+++-- | Renders abstract syntax tree in Graphviz format.+-- The pair of 'Bool' @(funs,cats)@ lets you control whether function names and+-- category names are included in the rendered tree.+graphvizAbstractTree :: PGF -> (Bool,Bool) -> Tree -> String+graphvizAbstractTree pgf (funs,cats) = render . tree2graph+ where+ tree2graph t =+ text "graph {" $$+ ppGraph [] [] 0 t $$+ text "}"++ getAbs xs (EAbs _ x e) = getAbs (x:xs) e+ getAbs xs (ETyped e _) = getAbs xs e+ getAbs xs e = (xs,e)++ getApp (EApp x (EImplArg y)) es = getApp x es+ getApp (EApp x y) es = getApp x (y:es)+ getApp (ETyped e _) es = getApp e es+ getApp e es = (e,es)++ getLbl scope (EFun f) = let fun = if funs then ppCId f else empty+ cat = if cats then ppCId (lookValCat (abstract pgf) f) else empty+ sep = if funs && cats then colon else empty+ in fun <+> sep <+> cat+ getLbl scope (ELit l) = text (escapeStr (render (ppLit l)))+ getLbl scope (EMeta i) = ppMeta i+ getLbl scope (EVar i) = ppCId (scope !! i)+ getLbl scope (ETyped e _) = getLbl scope e+ getLbl scope (EImplArg e) = getLbl scope e++ ppGraph scope ps i e0 =+ let (xs, e1) = getAbs [] e0+ (e2,args) = getApp e1 []+ binds = if null xs+ then empty+ else text "\\\\" <> hcat (punctuate comma (map ppCId xs)) <+> text "->"+ (lbl,eargs) = case e2 of+ EAbs _ _ _ -> (char '@', e2:args) -- eta-redexes are rendered with artificial "@" node+ _ -> (getLbl scope' e2, args)+ scope' = xs ++ scope+ in ppNode (i:ps) <> text "[label =" <+> doubleQuotes (binds <+> lbl) <> text ", style = \"solid\", shape = \"plaintext\"] ;" $$+ (if null ps+ then empty+ else ppNode ps <+> text "--" <+> ppNode (i:ps) <+> text "[style = \"solid\"];") $$+ vcat (zipWith (ppGraph scope' (i:ps)) [0..] eargs)++ ppNode ps = char 'n' <> hcat (punctuate (char '_') (map int ps))++ escapeStr [] = []+ escapeStr ('\\':cs) = '\\':'\\':escapeStr cs+ escapeStr ('"' :cs) = '\\':'"' :escapeStr cs+ escapeStr (c :cs) = c :escapeStr cs+++type Labels = Map.Map CId [String]++-- | Visualize word dependency tree.+graphvizDependencyTree+ :: String -- ^ Output format: @"latex"@, @"conll"@, @"malt_tab"@, @"malt_input"@ or @"dot"@+ -> Bool -- ^ Include extra information (debug)+ -> Maybe Labels -- ^ abstract label information obtained with 'getDepLabels'+ -> Maybe CncLabels -- ^ concrete label information obtained with ' ' (was: unused (was: @Maybe String@))+ -> PGF+ -> CId -- ^ The language of analysis+ -> Tree+ -> String -- ^ Rendered output in the specified format+graphvizDependencyTree format debug mlab mclab pgf lang t = + case format of+ "latex" -> render . ppLaTeX $ conll2latex' conll+ "svg" -> render . ppSVG . toSVG $ conll2latex' conll+ "conll" -> printCoNLL conll+ "malt_tab" -> render $ vcat (map (hcat . intersperse (char '\t') . (\ws -> [ws !! 0,ws !! 1,ws !! 3,ws !! 6,ws !! 7])) wnodes)+ "malt_input" -> render $ vcat (map (hcat . intersperse (char '\t') . take 6) wnodes)+ _ -> render $ text "digraph {" $$+ space $$+ nest 2 (text "rankdir=LR ;" $$+ text "node [shape = plaintext] ;" $$+ vcat nodes $$+ vcat links) $$+ text "}"+ where+ conll = maybe conll0 (\ls -> fixCoNLL ls conll0) mclab+ conll0 = (map.map) render wnodes+ nodes = map mkNode leaves+ links = map mkLink [(fid, fromMaybe (dep_lbl,nil) (lookup fid deps)) | ((cat,fid,fun),_,w) <- tail leaves]++-- CoNLL format: ID FORM LEMMA PLEMMA POS PPOS FEAT PFEAT HEAD PHEAD DEPREL PDEPREL+-- P variants are automatically predicted rather than gold standard++ wnodes = [[int i, maltws ws, ppCId fun, ppCId (posCat cat), ppCId cat, unspec, int parent, text lab, unspec, unspec] |+ ((cat,fid,fun),i,ws) <- tail leaves,+ let (lab,parent) = fromMaybe (dep_lbl,0)+ (do (lbl,fid) <- lookup fid deps+ (_,i,_) <- find (\((_,fid1,_),i,_) -> fid == fid1) leaves+ return (lbl,i))+ ]+ maltws = text . concat . intersperse "+" . words -- no spaces in column 2++ nil = -1++ bss = bracketedLinearize pgf lang t++ root = (wildCId,nil,wildCId)++ leaves = (root,0,root_lbl) : (groupAndIndexIt 1 . concatMap (getLeaves root)) bss+ deps = let (_,(h,deps)) = getDeps 0 [] t []+ in (h,(dep_lbl,nil)):deps++ groupAndIndexIt id [] = []+ groupAndIndexIt id ((p,w):pws) = (p,id,w) : groupAndIndexIt (id+1) pws+--- groupAndIndexIt id ((p,w):pws) = let (ws,pws1) = collect pws+--- in (p,id,unwords (w:ws)) : groupAndIndexIt (id+1) pws1+ where+ collect pws@((p1,w):pws1)+ | p == p1 = let (ws,pws2) = collect pws1+ in (w:ws,pws2)+ collect pws = ([],pws)++ getLeaves parent bs =+ case bs of+ Leaf w -> [(parent,w)]+ Bracket cat fid _ fun _ bss -> concatMap (getLeaves (cat,fid,fun)) bss++ mkNode ((_,p,_),i,w) =+ tag p <+> brackets (text "label = " <> doubleQuotes (int i <> char '.' <+> text w)) <+> semi++ mkLink (x,(lbl,y)) = tag y <+> text "->" <+> tag x <+> text "[label = " <> doubleQuotes (text lbl) <> text "] ;"++ labels = maybe Map.empty id mlab+ clabels = maybe [] id mclab++ posCat cat = case Map.lookup cat labels of+ Just [p] -> mkCId p+ _ -> cat++ getDeps n_fid xs (EAbs _ x e) es = getDeps n_fid (x:xs) e es+ getDeps n_fid xs (EApp e1 e2) es = getDeps n_fid xs e1 (e2:es)+ getDeps n_fid xs (EImplArg e) es = getDeps n_fid xs e es+ getDeps n_fid xs (ETyped e _) es = getDeps n_fid xs e es+ getDeps n_fid xs (EFun f) es = let (n_fid_1,ds) = descend n_fid xs es+ (mb_h, deps) = selectHead f ds+ in case mb_h of+ Just (fid,deps0) -> (n_fid_1+1,(fid,deps0+++ [(n_fid_1,(dep_lbl,fid))]+++ concat [(m,(lbl,fid)):ds | (lbl,(m,ds)) <- deps]))+ Nothing -> (n_fid_1+1,(n_fid_1,concat [(m,(lbl,n_fid_1)):ds | (lbl,(m,ds)) <- deps]))+ getDeps n_fid xs (EMeta i) es = (n_fid+2,(n_fid,[]))+ getDeps n_fid xs (EVar i) _ = (n_fid+2,(n_fid,[]))+ getDeps n_fid xs (ELit l) [] = (n_fid+1,(n_fid,[]))++ descend n_fid xs es = mapAccumL (\n_fid e -> getDeps n_fid xs e []) n_fid es++ selectHead f ds =+ case Map.lookup f labels of+ Just lbls -> extractHead (zip lbls ds)+ Nothing -> extractLast ds+ where+ extractHead [] = (Nothing, [])+ extractHead (ld@(l,d):lds)+ | l == head_lbl = (Just d,lds)+ | otherwise = let (mb_h,deps) = extractHead lds+ in (mb_h,ld:deps)++ extractLast [] = (Nothing, [])+ extractLast (d:ds)+ | null ds = (Just d,[])+ | otherwise = let (mb_h,deps) = extractLast ds+ in (mb_h,(dep_lbl,d):deps)++ dep_lbl = "dep"+ head_lbl = "head"+ root_lbl = "ROOT"+ unspec = text "_"++-- | Prepare lines obtained from a configuration file for labels for+-- use with 'graphvizDependencyTree'. Format per line /fun/ /label/@*@.+getDepLabels :: String -> Labels+getDepLabels s = Map.fromList [(mkCId f,ls) | f:ls <- map words (lines s)]++-- the old function, without dependencies+graphvizParseTree :: PGF -> Language -> GraphvizOptions -> Tree -> String+graphvizParseTree = graphvizParseTreeDep Nothing++graphvizParseTreeDep :: Maybe Labels -> PGF -> Language -> GraphvizOptions -> Tree -> String+graphvizParseTreeDep mbl pgf lang opts tree = graphvizBracketedString opts mbl tree $ bracketedLinearize pgf lang tree++graphvizBracketedString :: GraphvizOptions -> Maybe Labels -> Tree -> [BracketedString] -> String+graphvizBracketedString opts mbl tree bss = render graphviz_code+ where+ graphviz_code+ = text "graph {" $$+ text node_style $$+ vcat internal_nodes $$+ (if noLeaves opts then empty+ else text leaf_style $$+ leaf_nodes+ ) $$ text "}"++ leaf_style = mkOption "edge" "style" (leafEdgeStyle opts) +++ mkOption "edge" "color" (leafColor opts) +++ mkOption "node" "fontcolor" (leafColor opts) +++ mkOption "node" "fontname" (leafFont opts) +++ mkOption "node" "shape" "plaintext"++ node_style = mkOption "edge" "style" (nodeEdgeStyle opts) +++ mkOption "edge" "color" (nodeColor opts) +++ mkOption "node" "fontcolor" (nodeColor opts) +++ mkOption "node" "fontname" (nodeFont opts) +++ mkOption "node" "shape" nodeshape+ where nodeshape | noFun opts && noCat opts = "point"+ | otherwise = "plaintext"++ mkOption object optname optvalue+ | null optvalue = ""+ | otherwise = object ++ "[" ++ optname ++ "=\"" ++ optvalue ++ "\"]; "++ mkNode fun cat+ | noFun opts = showCId cat+ | noCat opts = showCId fun+ | otherwise = showCId fun ++ " : " ++ showCId cat++ nil = -1+ internal_nodes = [mkLevel internals |+ internals <- getInternals (map ((,) nil) bss),+ not (null internals)]+ leaf_nodes = mkLevel [(parent, id, mkLeafNode cat word) |+ (id, (parent, (cat,word))) <- zip [100000..] (concatMap (getLeaves (mkCId "?") nil) bss)]++ getInternals [] = []+ getInternals nodes+ = nub [(parent, fid, mkNode fun cat) |+ (parent, Bracket cat fid _ fun _ _) <- nodes]+ : getInternals [(fid, child) |+ (_, Bracket _ fid _ _ _ children) <- nodes,+ child <- children]++ getLeaves cat parent (Leaf word) = [(parent, (cat, word))] -- the lowest cat before the word+ getLeaves _ parent (Bracket cat fid i _ _ children)+ = concatMap (getLeaves cat fid) children++ mkLevel nodes+ = text "subgraph {rank=same;" $$+ nest 2 (-- the following gives the name of the node and its label:+ vcat [tag id <> text (mkOption "" "label" lbl) | (_, id, lbl) <- nodes] $$+ -- the following is for fixing the order between the children:+ (if length nodes > 1 then+ text (mkOption "edge" "style" "invis") $$+ hsep (intersperse (text " -- ") [tag id | (_, id, _) <- nodes]) <+> semi+ else empty)+ ) $$+ text "}" $$+ -- the following is for the edges between parent and children:+ vcat [tag pid <> text " -- " <> tag id <> text (depLabel node) | node@(pid, id, _) <- nodes, pid /= nil] $$+ space++ depLabel node@(parent,id,lbl) + | noDep opts = ";"+ | otherwise = case getArg id of+ Just (fun,arg) -> mkOption "" "label" (lookLabel fun arg) + _ -> ";"+ getArg i = getArgumentPlace i (expr2numtree tree) Nothing++ labels = maybe Map.empty id mbl++ lookLabel fun arg = case Map.lookup fun labels of+ Just xx | length xx > arg -> case xx !! arg of+ "head" -> ""+ l -> l+ _ -> argLabel fun arg+ argLabel fun arg = if arg==0 then "" else "dep#" ++ show arg --showCId fun ++ "#" ++ show arg+ -- assuming the arg is head, if no configuration is given; always true for 1-arg funs+ mkLeafNode cat word+ | noDep opts = word --- || not (noCat opts) -- show POS only if intermediate nodes hidden+ | otherwise = posCat cat ++ "\n" ++ word -- show POS in dependency tree++ posCat cat = case Map.lookup cat labels of+ Just [p] -> p+ _ -> showCId cat++---- to restore the argument place from bracketed linearization+data NumTree = NumTree Int CId [NumTree]++getArgumentPlace :: Int -> NumTree -> Maybe (CId,Int) -> Maybe (CId,Int)+getArgumentPlace i tree@(NumTree int fun ts) mfi+ | i == int = mfi+ | otherwise = case [fj | (t,x) <- zip ts [0..], Just fj <- [getArgumentPlace i t (Just (fun,x))]] of+ fj:_ -> Just fj+ _ -> Nothing++expr2numtree :: Expr -> NumTree+expr2numtree = fst . renumber 0 . flatten where+ flatten e = case e of+ EApp f a -> case flatten f of+ NumTree _ g ts -> NumTree 0 g (ts ++ [flatten a])+ EFun f -> NumTree 0 f []+ renumber i t@(NumTree _ f ts) = case renumbers i ts of+ (ts',j) -> (NumTree j f ts', j+1)+ renumbers i ts = case ts of+ t:tt -> case renumber i t of+ (t',j) -> case renumbers j tt of (tt',k) -> (t':tt',k)+ _ -> ([],i)+----- end this terrible stuff AR 4/11/2015+ ++++type Rel = (Int,[Int])+-- possibly needs changes after clearing about many-to-many on this level++type IndexedSeq = (Int,[String])+type LangSeq = [IndexedSeq]++data PreAlign = PreAlign [LangSeq] [[Rel]]+ deriving Show+-- alignment structure for a phrase in 2 languages, along with the+-- many-to-many relations+++genPreAlignment :: PGF -> [Language] -> Expr -> PreAlign+genPreAlignment pgf langs = lin2align . linsBracketed+ where+ linsBracketed t = [bracketedLinearize pgf lang t | lang <- langs]++ lin2align :: [[BracketedString]] -> PreAlign+ lin2align bsss = PreAlign langSeqs langRels+ where+ (langSeqs,langRels) = mkLayers leaves+ nil = -1+ leaves = map (groupAndIndexIt 0 . concatMap (getLeaves nil)) bsss++ groupAndIndexIt id [] = []+ groupAndIndexIt id ((p,w):pws) = let (ws,pws1) = collect pws+ in (p,id,unwords (w:ws)) : groupAndIndexIt (id+1) pws1+ where+ collect pws@((p1,w):pws1)+ | p == p1 = let (ws,pws2) = collect pws1+ in (w:ws,pws2)+ collect pws = ([],pws)++ getLeaves parent bs =+ case bs of+ Leaf w -> [(parent,w)]+ Bracket _ fid _ _ _ bss -> concatMap (getLeaves fid) bss++ mkLayers (cs:css:rest) = let (lrest, rrest) = mkLayers (css:rest)+ in ((fields cs) : lrest, (map (mkLinks css) cs) : rrest)+ mkLayers [cs] = ([fields cs], [])+ mkLayers _ = ([],[])++ mkLinks cs (p0,id0,_) = (id0,indices)+ where+ indices = [id1 | (p1,id1,_) <- cs, p1 == p0]++ fields cs = [(id, [w]) | (_,id,w) <- cs]+++-- we assume we have 2 languages - source and target+gizaAlignment :: PGF -> (Language,Language) -> Expr -> (String,String,String)+gizaAlignment pgf (l1,l2) e = let PreAlign [rl1,rl2] rels = genPreAlignment pgf [l1,l2] e+ in+ (unwords (map showIndSeq rl1), unwords (concat $ map snd rl2),+ unwords $ words $ showRels rl2 (concat rels))+++showIndSeq (_,l) = let ww = map words l+ w_ = map (intersperse "_") ww+ in+ concat $ concat w_++showRels inds2 [] = []+showRels inds2 ((ind,is):rest) =+ let lOffs = computeOffset inds2 0+ ltemp = [(i,getOffsetIndex i lOffs) | i <- is]+ lcurr = concat $ map (\(offset,ncomp) -> [show ind ++ "-" ++ show (-1 + offset + ii) ++ " "| ii <- [1..ncomp]]) (map snd ltemp)+ lrest = showRels inds2 rest+ in+ (unwords lcurr) ++ lrest++++++++getOffsetIndex i lst = let ll = filter (\(x,_) -> x == i) lst+ in+ snd $ head ll++computeOffset [] transp = []+computeOffset ((i,l):rest) transp = let nw = (length $ words $ concat l)+ in (i,(transp,nw)) : (computeOffset rest (transp + nw))++++-- alignment in the Graphviz format from the intermediate structure+-- same effect as the old direct function+graphvizAlignment :: PGF -> [Language] -> Expr -> String+graphvizAlignment pgf langs exp =+ render (text "digraph {" $$+ space $$+ nest 2 (text "rankdir=LR ;" $$+ text "node [shape = record] ;" $$+ space $$+ renderList 0 lrels rrels) $$+ text "}")+ where+ (PreAlign lrels rrels) = genPreAlignment pgf langs exp+++ renderList ii (l:ls) (r:rs) = struct ii <> text "[label = \"" <> fields l <> text "\"] ;" $$+ (case ls of+ [] -> empty+ _ -> vcat [struct ii <> colon <> tag id0+ <> colon <> char 'e' <+> text "->" <+> struct (ii+1)+ <> colon <> tag id1 <> colon <> char 'w' <+> semi+ | (id0,ids) <- r, id1 <- ids] $$ renderList (ii + 1) ls rs)+ renderList ii [] _ = empty+ renderList ii [l] [] = struct ii <> text "[label = \"" <> fields l <> text "\"] ;"++ fields cs = hsep (intersperse (char '|') [tbrackets (tag id) <> text (' ':w) | (id,ws) <- cs, w <- ws])++++-- auxiliaries for graphviz syntax+struct l = text ("struct" ++ show l)+tbrackets d = char '<' <> d <> char '>'+tag i+ | i < 0 = char 'r' <> int (negate i)+ | otherwise = char 'n' <> int i+++---------------------- should be a separate module?++-- visualization with latex output. AR Nov 2015++conlls2latexDoc :: [String] -> String+conlls2latexDoc =+ render .+ latexDoc .+ vcat .+ intersperse (text "" $+$ app "vspace" (text "4mm")) .+ map conll2latex .+ filter (not . null)++conll2latex :: String -> Doc+conll2latex = ppLaTeX . conll2latex' . parseCoNLL++conll2latex' :: CoNLL -> [LaTeX]+conll2latex' = dep2latex . conll2dep'++data Dep = Dep {+ wordLength :: Int -> Double -- length of word at position int -- was: fixed width, millimetres (>= 20.0)+ , tokens :: [(String,String)] -- word, pos (0..)+ , deps :: [((Int,Int),String)] -- from, to, label+ , root :: Int -- root word position+ }++-- some general measures+defaultWordLength = 20.0 -- the default fixed width word length, making word 100 units+defaultUnit = 0.2 -- unit in latex pictures, 0.2 millimetres+spaceLength = 10.0+charWidth = 1.8++wsize rwld w = 100 * rwld w + spaceLength -- word length, units+wpos rwld i = sum [wsize rwld j | j <- [0..i-1]] -- start position of the i'th word+wdist rwld x y = sum [wsize rwld i | i <- [min x y .. max x y - 1]] -- distance between words x and y+labelheight h = h + arcbase + 3 -- label just above arc; 25 would put it just below+labelstart c = c - 15.0 -- label starts 15u left of arc centre+arcbase = 30.0 -- arcs start and end 40u above the bottom+arcfactor r = r * 600 -- reduction of arc size from word distance+xyratio = 3 -- width/height ratio of arcs++putArc :: (Int -> Double) -> Int -> Int -> Int -> String -> [DrawingCommand]+putArc frwld height x y label = [oval,arrowhead,labelling] where+ oval = Put (ctr,arcbase) (OvalTop (wdth,hght))+ arrowhead = Put (endp,arcbase + 5) (ArrowDown 5) -- downgoing arrow 5u above the arc base+ labelling = Put (labelstart ctr,labelheight (hght/2)) (TinyText label)+ dxy = wdist frwld x y -- distance between words, >>= 20.0+ ndxy = 100 * rwld * fromIntegral height -- distance that is indep of word length+ hdxy = dxy / 2 -- half the distance+ wdth = dxy - (arcfactor rwld)/dxy -- longer arcs are wider in proportion+ hght = ndxy / (xyratio * rwld) -- arc height is independent of word length+ begp = min x y -- begin position of oval+ ctr = wpos frwld begp + hdxy + (if x < y then 20 else 10) -- LR arcs are farther right from center of oval+ endp = (if x < y then (+) else (-)) ctr (wdth/2) -- the point of the arrow+ rwld = 0.5 ----++dep2latex :: Dep -> [LaTeX]+dep2latex d =+ [Comment (unwords (map fst (tokens d))),+ Picture defaultUnit (width,height) (+ [Put (wpos rwld i,0) (Text w) | (i,w) <- zip [0..] (map fst (tokens d))] -- words+ ++ [Put (wpos rwld i,15) (TinyText w) | (i,w) <- zip [0..] (map snd (tokens d))] -- pos tags 15u above bottom+ ++ concat [putArc rwld (aheight x y) x y label | ((x,y),label) <- deps d] -- arcs and labels+ ++ [Put (wpos rwld (root d) + 15,height) (ArrowDown (height-arcbase))]+ ++ [Put (wpos rwld (root d) + 20,height - 10) (TinyText "ROOT")]+ )]+ where+ wld i = wordLength d i -- >= 20.0+ rwld i = (wld i) / defaultWordLength -- >= 1.0+ aheight x y = depth (min x y) (max x y) + 1 ---- abs (x-y)+ arcs = [(min u v, max u v) | ((u,v),_) <- deps d]+ depth x y = case [(u,v) | (u,v) <- arcs, (x < u && v <= y) || (x == u && v < y)] of ---- only projective arcs counted+ [] -> 0+ uvs -> 1 + maximum (0:[depth u v | (u,v) <- uvs])+ width = {-round-} (sum [wsize rwld w | (w,_) <- zip [0..] (tokens d)]) + {-round-} spaceLength * fromIntegral ((length (tokens d)) - 1)+ height = 50 + 20 * {-round-} (maximum (0:[aheight x y | ((x,y),_) <- deps d]))++type CoNLL = [[String]]+parseCoNLL :: String -> CoNLL+parseCoNLL = map words . lines++--conll2dep :: String -> Dep+--conll2dep = conll2dep' . parseCoNLL++conll2dep' :: CoNLL -> Dep+conll2dep' ls = Dep {+ wordLength = wld + , tokens = toks+ , deps = dps+ , root = head $ [read x-1 | x:_:_:_:_:_:"0":_ <- ls] ++ [1]+ }+ where+ wld i = maximum (0:[charWidth * fromIntegral (length w) | w <- let (tok,pos) = toks !! i in [tok,pos]])+ toks = [(w,c) | _:w:_:c:_ <- ls]+ dps = [((read y-1, read x-1),lab) | x:_:_:_:_:_:y:lab:_ <- ls, y /="0"]+ --maxdist = maximum [abs (x-y) | ((x,y),_) <- dps]+++-- * LaTeX Pictures (see https://en.wikibooks.org/wiki/LaTeX/Picture)++-- We render both LaTeX and SVG from this intermediate representation of+-- LaTeX pictures.++data LaTeX = Comment String | Picture UnitLengthMM Size [DrawingCommand]+data DrawingCommand = Put Position Object+data Object = Text String | TinyText String | OvalTop Size | ArrowDown Length++type UnitLengthMM = Double+type Size = (Double,Double)+type Position = (Double,Double)+type Length = Double+++-- * latex formatting+ppLaTeX = vcat . map ppLaTeX1+ where+ ppLaTeX1 el =+ case el of+ Comment s -> comment s+ Picture unit size cmds ->+ app "setlength{\\unitlength}" (text (show unit ++ "mm"))+ $$ hang (app "begin" (text "picture")<>text (show size)) 2+ (vcat (map ppDrawingCommand cmds))+ $$ app "end" (text "picture")+ $$ text ""++ ppDrawingCommand (Put pos obj) = put pos (ppObject obj)++ ppObject obj =+ case obj of+ Text s -> text s+ TinyText s -> small (text s)+ OvalTop size -> text "\\oval" <> text (show size) <> text "[t]"+ ArrowDown len -> app "vector(0,-1)" (text (show len))++ put p@(_,_) = app ("put" ++ show p)+ small w = text "{\\tiny" <+> w <> text "}"+ comment s = text "%%" <+> text s -- line break show follow+ +app macro arg = text "\\" <> text macro <> text "{" <> arg <> text "}"+++latexDoc :: Doc -> Doc+latexDoc body =+ vcat [text "\\documentclass{article}",+ text "\\usepackage[utf8]{inputenc}",+ text "\\begin{document}",+ body,+ text "\\end{document}"]++-- * SVG (see https://www.w3.org/Graphics/SVG/IG/resources/svgprimer.html)++-- | Render LaTeX pictures as SVG+toSVG = concatMap toSVG1+ where+ toSVG1 el =+ case el of+ Comment s -> []+ Picture unit size@(w,h) cmds ->+ [Elem "svg" ["width".=x1,"height".=y0+5,+ ("viewBox",unwords (map show [0,0,x1,y0+5])),+ ("version","1.1"),+ ("xmlns","http://www.w3.org/2000/svg")]+ (white_bg:concatMap draw cmds)]+ where+ white_bg =+ Elem "rect" ["x".=0,"y".=0,"width".=x1,"height".=y0+5,+ ("fill","white")] []++ draw (Put pos obj) = objectSVG pos obj++ objectSVG pos obj =+ case obj of+ Text s -> [text 16 pos s]+ TinyText s -> [text 10 pos s]+ OvalTop size -> [ovalTop pos size]+ ArrowDown len -> arrowDown pos len++ text h (x,y) s =+ Elem "text" ["x".=xc x,"y".=yc y-2,"font-size".=h]+ [CharData s]++ ovalTop (x,y) (w,h) =+ Elem "path" [("d",path),("stroke","black"),("fill","none")] []+ where+ x1 = x-w/2+ x2 = min x (x1+r)+ x3 = max x (x4-r)+ x4 = x+w/2+ y1 = y+ y2 = y+r+ r = h/2+ sx = show . xc+ sy = show . yc+ path = unwords (["M",sx x1,sy y1,"Q",sx x1,sy y2,sx x2,sy y2,+ "L",sx x3,sy y2,"Q",sx x4,sy y2,sx x4,sy y1])++ arrowDown (x,y) len =+ [Elem "line" ["x1".=xc x,"y1".=yc y,"x2".=xc x,"y2".=y2,+ ("stroke","black")] [],+ Elem "path" [("d",unwords arrowhead)] []]+ where+ x2 = xc x+ y2 = yc (y-len)+ arrowhead = "M":map show [x2,y2,x2-3,y2-6,x2+3,y2-6]++ xc x = num x+5+ yc y = y0-num y+ x1 = num w+10+ y0 = num h+20+ num x = round (scale*x)+ scale = unit*5++ infix 0 .=+ n.=v = (n,show v)++-- * SVG is XML++data SVG = CharData String | Elem TagName Attrs [SVG]+type TagName = String+type Attrs = [(String,String)]++ppSVG svg =+ vcat [text "<?xml version=\"1.0\" standalone=\"no\"?>",+ text "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"",+ text "\"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">",+ text "",+ vcat (map ppSVG1 svg)] -- It should be a single <svg> element...+ where+ ppSVG1 svg1 =+ case svg1 of+ CharData s -> text (encode s)+ Elem tag attrs [] ->+ text "<"<>text tag<>cat (map attr attrs) <> text "/>"+ Elem tag attrs svg ->+ cat [text "<"<>text tag<>cat (map attr attrs) <> text ">",+ nest 2 (cat (map ppSVG1 svg)),+ text "</"<>text tag<>text ">"]++ attr (n,v) = text " "<>text n<>text "=\""<>text (encode v)<>text "\""++ encode s = foldr encodeEntity "" s++ encodeEntity = encodeEntity' (const False)+ encodeEntity' esc c r =+ case c of+ '&' -> "&"++r+ '<' -> "<"++r+ '>' -> ">"++r+ _ -> c:r+++----------------------------------+-- concrete syntax annotations (local) on top of conll+-- examples of annotations:+-- UseComp {"not"} PART neg head +-- UseComp {*} AUX cop head++type CncLabels = [(String, String -> Maybe (String -> String,String,String))]+-- (fun, word -> (pos,label,target))+-- the pos can remain unchanged, as in the current notation in the article++fixCoNLL :: CncLabels -> CoNLL -> CoNLL+fixCoNLL labels conll = map fixc conll where+ fixc row = case row of+ (i:word:fun:pos:cat:x_:"0":"dep":xs) -> (i:word:fun:pos:cat:x_:"0":"root":xs) --- change the root label from dep to root + (i:word:fun:pos:cat:x_:j:label:xs) -> case look (fun,word) of+ Just (pos',label',"head") -> (i:word:fun:pos' pos:cat:x_:j :label':xs)+ Just (pos',label',target) -> (i:word:fun:pos' pos:cat:x_: getDep j target:label':xs)+ _ -> row+ _ -> row+ + look (fun,word) = case lookup fun labels of+ Just relabel -> case relabel word of+ Just row -> Just row+ _ -> case lookup "*" labels of+ Just starlabel -> starlabel word+ _ -> Nothing+ _ -> case lookup "*" labels of+ Just starlabel -> starlabel word+ _ -> Nothing+ + getDep j label = maybe j id $ lookup (label,j) [((label,j),i) | i:word:fun:pos:cat:x_:j:label:xs <- conll]++getCncDepLabels :: String -> CncLabels+getCncDepLabels =+ map merge .+ groupBy (\ (x,_) (a,_) -> x == a) .+ sortBy (comparing fst) .+ concatMap analyse .+ filter choose .+ lines+ where+ --- choose is for compatibility with the general notation+ choose line = notElem '(' line && elem '{' line --- ignoring non-local (with "(") and abstract (without "{") rules+ + analyse line = case break (=='{') line of+ (beg,_:ws) -> case break (=='}') ws of+ (toks,_:target) -> case (getToks beg, words target) of+ (funs,[ label,j]) -> [(fun, (tok, (id, label,j))) | fun <- funs, tok <- getToks toks]+ (funs,[pos,label,j]) -> [(fun, (tok, (const pos,label,j))) | fun <- funs, tok <- getToks toks]+ _ -> []+ _ -> []+ _ -> []+ merge rules@((fun,_):_) = (fun, \tok ->+ case lookup tok (map snd rules) of+ Just new -> return new+ _ -> lookup "*" (map snd rules)+ )+ getToks = map unquote . filter (/=",") . toks+ toks s = case lex s of [(t,"")] -> [t] ; [(t,cc)] -> t:toks cc ; _ -> []+ unquote s = case s of '"':cc@(_:_) | last cc == '"' -> init cc ; _ -> s ++printCoNLL :: CoNLL -> String+printCoNLL = unlines . map (concat . intersperse "\t")+
@@ -0,0 +1,70 @@+name: pgf+version: 3.10++cabal-version: >= 1.20+build-type: Simple+license: OtherLicense+category: Natural Language Processing+synopsis: Grammatical Framework+description: A library for interpreting the Portable Grammar Format (PGF)+homepage: http://www.grammaticalframework.org/+bug-reports: https://github.com/GrammaticalFramework/gf-core/issues+maintainer: Thomas Hallgren+tested-with: GHC==7.6.3, GHC==7.8.3, GHC==7.10.3, GHC==8.0.2++Library+ default-language: Haskell2010+ build-depends: base >= 4.6 && <5,+ array,+ containers,+ bytestring,+ utf8-string,+ random,+ pretty,+ mtl,+ exceptions++ other-modules:+ -- not really part of GF but I have changed the original binary library+ -- and we have to keep the copy for now.+ Data.Binary+ Data.Binary.Put+ Data.Binary.Get+ Data.Binary.Builder+ Data.Binary.IEEE754++--ghc-options: -fwarn-unused-imports+--if impl(ghc>=7.8)+-- ghc-options: +RTS -A20M -RTS+ ghc-prof-options: -fprof-auto+ extensions:++ exposed-modules:+ PGF+ PGF.Internal+ PGF.Haskell++ other-modules:+ PGF.Data+ PGF.Macros+ PGF.Binary+ PGF.Optimize+ PGF.Printer+ PGF.CId+ PGF.Expr+ PGF.Generate+ PGF.Linearize+ PGF.Morphology+ PGF.Paraphrase+ PGF.Parse+ PGF.Probabilistic+ PGF.SortTop+ PGF.Tree+ PGF.Type+ PGF.TypeCheck+ PGF.Forest+ PGF.TrieMap+ PGF.VisualizeTree+ PGF.ByteCode+ PGF.OldBinary+ PGF.Utilities
@@ -0,0 +1,15 @@+Before compiling the Java binding you first need to have the C runtime+compiled and installed. You also need to find where your jni.h header+is installed. It is part of the Java JDK, but it might be placed+in different places on different platforms.+The Makefile in this directory will try to figure out the location of+jni.h, but if it doesn't succeed you should add it manually to the+JNI_INCLUDES variable in the beginning of the Makefile.++Once this is done type:++$ make+$ make install++For Windows you might have to uncomment the lines around+WINDOWS_FLAGS in the Makefile.
@@ -0,0 +1,27 @@+ BSD LICENSE++Copyright (c) 1998, Grammatical Framework+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
@@ -0,0 +1,47 @@+C_SOURCES = jpgf.c jsg.c jni_utils.c+JAVA_SOURCES = $(wildcard org/grammaticalframework/pgf/*.java) \+ $(wildcard org/grammaticalframework/sg/*.java)++JNI_INCLUDES = $(if $(wildcard /usr/lib/jvm/default-java/include/.*), -I/usr/lib/jvm/default-java/include -I/usr/lib/jvm/default-java/include/linux, \+ $(if $(wildcard /System/Library/Frameworks/JavaVM.framework/Versions/A/Headers/.*), -I/System/Library/Frameworks/JavaVM.framework/Versions/A/Headers, \+ $(if $(wildcard /Library/Java/Home/include/.*), -I/Library/Java/Home/include/ -I/Library/Java/Home/include/darwin, \+ $(error No JNI headers found))))++# For Windows replace the previous line with something like this:+#+# JNI_INCLUDES = -I "C:/Program Files/Java/jdk1.8.0_171/include" -I "C:/Program Files/Java/jdk1.8.0_171/include/win32" -I "C:/MinGW/msys/1.0/local/include"+# WINDOWS_FLAGS = -L"C:/MinGW/msys/1.0/local/lib" -no-undefined++INSTALL_PATH = /usr/local/lib+LIBTOOL = glibtool --tag=CC++LIBTOOL = $(if $(shell command -v glibtool 2>/dev/null), glibtool --tag=CC, libtool)++all: libjpgf.la jpgf.jar++libjpgf.la: $(patsubst %.c, %.lo, $(C_SOURCES))+ $(LIBTOOL) --mode=link gcc $(CFLAGS) -g -O -o libjpgf.la -shared $^ -rpath $(INSTALL_PATH) -lgu -lpgf -lsg $(WINDOWS_FLAGS)++%.lo : %.c+ $(LIBTOOL) --mode=compile gcc $(CFLAGS) -g -O -c $(JNI_INCLUDES) -std=c99 -shared $< -o $@++jpgf.jar: $(patsubst %.java, %.class, $(JAVA_SOURCES))+ jar -cf $@ org/grammaticalframework/pgf/*.class org/grammaticalframework/sg/*.class++%.class : %.java+ javac $<++install: libjpgf.la jpgf.jar+ $(LIBTOOL) --mode=install install -s libjpgf.la $(INSTALL_PATH)+ install jpgf.jar $(INSTALL_PATH)+++doc:+ javadoc org.grammaticalframework.pgf org.grammaticalframework.sg -d java-api++clean:+ rm -f *.lo+ rm -f *.la+ rm -f -r .libs+ rm -f *.jar+ rm -f org/grammaticalframework/*/*.class
@@ -0,0 +1,34 @@+import java.io.*;+import java.util.*;+import org.grammaticalframework.pgf.*;++public class Test {+ public static void main(String[] args) throws IOException { + PGF gr = null;+ try {+ gr = PGF.readPGF("/home/krasimir/www.grammaticalframework.org/examples/phrasebook/Phrasebook.pgf");+ } catch (FileNotFoundException e) {+ e.printStackTrace();+ return;+ } catch (PGFError e) {+ e.printStackTrace();+ return;+ }+ + Type typ = gr.getFunctionType("Bulgarian");+ System.out.println(typ.getCategory());+ System.out.println(gr.getAbstractName());+ for (Map.Entry<String,Concr> entry : gr.getLanguages().entrySet()) {+ System.out.println(entry.getKey()+" "+entry.getValue()+" "+entry.getValue().getName());+ }++ Concr eng = gr.getLanguages().get("SimpleEng");+ try {+ for (ExprProb ep : eng.parse(gr.getStartCat(), "persons who work with Malmö")) {+ System.out.println("["+ep.getProb()+"] "+ep.getExpr());+ }+ } catch (ParseError e) {+ System.out.println("Parsing failed at token \""+e.getToken()+"\"");+ }+ }+}
@@ -0,0 +1,151 @@+#include <jni.h>+#include <gu/utf8.h>+#include <gu/string.h>+#include <pgf/pgf.h>+#include <pgf/linearizer.h>+#include "jni_utils.h"+#ifndef __MINGW32__+#include <alloca.h>+#else+#include <malloc.h>+#endif++#define l2p(x) ((void*) (intptr_t) (x))+#define p2l(x) ((jlong) (intptr_t) (x))++JPGF_INTERNAL jstring+gu2j_string(JNIEnv *env, GuString s) {+ const char* utf8 = s;+ size_t len = strlen(s);++ jchar* utf16 = alloca(len*sizeof(jchar));+ jchar* dst = utf16;+ while (s-utf8 < len) {+ GuUCS ucs = gu_utf8_decode((const uint8_t**) &s);++ if (ucs <= 0xFFFF) {+ *dst++ = ucs;+ } else {+ ucs -= 0x10000;+ *dst++ = 0xD800+((ucs >> 10) & 0x3FF);+ *dst++ = 0xDC00+(ucs & 0x3FF);+ }+ }++ return (*env)->NewString(env, utf16, dst-utf16);+}++JPGF_INTERNAL jstring+gu2j_string_len(JNIEnv *env, const char* s, size_t len) {+ const char* utf8 = s;++ jchar* utf16 = alloca(len*sizeof(jchar));+ jchar* dst = utf16;+ while (s-utf8 < len) {+ GuUCS ucs = gu_utf8_decode((const uint8_t**) &s);++ if (ucs <= 0xFFFF) {+ *dst++ = ucs;+ } else {+ ucs -= 0x10000;+ *dst++ = 0xD800+((ucs >> 10) & 0x3FF);+ *dst++ = 0xDC00+(ucs & 0x3FF);+ }+ }++ return (*env)->NewString(env, utf16, dst-utf16);+}++JPGF_INTERNAL jstring+gu2j_string_buf(JNIEnv *env, GuStringBuf* sbuf) {+ return gu2j_string_len(env, gu_string_buf_data(sbuf), gu_string_buf_length(sbuf));+}++JPGF_INTERNAL jstring+gu2j_string_capit(JNIEnv *env, GuString s, PgfCapitState capit) {+ const char* utf8 = s;+ size_t len = strlen(s);++ jchar* utf16 = alloca(len*sizeof(jchar));+ jchar* dst = utf16;+ while (s-utf8 < len) {+ GuUCS ucs = gu_utf8_decode((const uint8_t**) &s);++ if (capit == PGF_CAPIT_FIRST) {+ ucs = gu_ucs_to_upper(ucs);+ capit = PGF_CAPIT_NONE;+ } else if (capit == PGF_CAPIT_NEXT) {+ ucs = gu_ucs_to_upper(ucs);+ }++ if (ucs <= 0xFFFF) {+ *dst++ = ucs;+ } else {+ ucs -= 0x10000;+ *dst++ = 0xD800+((ucs >> 10) & 0x3FF);+ *dst++ = 0xDC00+(ucs & 0x3FF);+ }+ }++ return (*env)->NewString(env, utf16, dst-utf16);+}++JPGF_INTERNAL GuString+j2gu_string(JNIEnv *env, jstring s, GuPool* pool) {+ GuString str = (*env)->GetStringUTFChars(env, s, 0);+ GuString copy = gu_string_copy(str, pool);+ (*env)->ReleaseStringUTFChars(env, s, str);+ return copy;+}++JPGF_INTERNAL size_t+gu2j_string_offset(GuString s, size_t offset) {+ const char* utf8 = s;+ size_t joffset = 0;+ while (utf8-s < offset) {+ gu_utf8_decode((const uint8_t**) &utf8);+ joffset++;+ }+ return joffset;+}++JPGF_INTERNAL size_t+j2gu_string_offset(GuString s, size_t joffset) {+ const char* utf8 = s;+ while (joffset > 0) {+ gu_utf8_decode((const uint8_t**) &utf8);+ joffset--;+ }+ return utf8-s;+}++JPGF_INTERNAL void*+get_ref(JNIEnv *env, jobject self) {+ jfieldID refId = (*env)->GetFieldID(env, (*env)->GetObjectClass(env, self), "ref", "J");+ return l2p((*env)->GetLongField(env, self, refId));+}++JPGF_INTERNAL void+throw_jstring_exception(JNIEnv *env, const char* class_name, jstring msg)+{+ jclass exception_class = (*env)->FindClass(env, class_name);+ if (!exception_class)+ return;+ jmethodID constrId = (*env)->GetMethodID(env, exception_class, "<init>", "(Ljava/lang/String;)V");+ if (!constrId)+ return;+ jobject exception = (*env)->NewObject(env, exception_class, constrId, msg);+ if (!exception)+ return;+ (*env)->Throw(env, exception);+}++JPGF_INTERNAL void+throw_string_exception(JNIEnv *env, const char* class_name, const char* msg)+{+ jstring jmsg = (*env)->NewStringUTF(env, msg);+ if (!jmsg)+ return;+ throw_jstring_exception(env, class_name, jmsg);+}+
@@ -0,0 +1,50 @@+#ifndef JNI_UTILS+#define JNI_UTILS++#if defined(_MSC_VER)++#define JPGF_INTERNAL_DECL+#define JPGF_INTERNAL++#else++#define JPGF_INTERNAL_DECL __attribute__ ((visibility ("hidden")))+#define JPGF_INTERNAL __attribute__ ((visibility ("hidden")))++#endif+++#define l2p(x) ((void*) (intptr_t) (x))+#define p2l(x) ((jlong) (intptr_t) (x))++JPGF_INTERNAL_DECL jstring+gu2j_string(JNIEnv *env, GuString s);++JPGF_INTERNAL_DECL jstring+gu2j_string_len(JNIEnv *env, const char* s, size_t len);++JPGF_INTERNAL_DECL jstring+gu2j_string_buf(JNIEnv *env, GuStringBuf* sbuf);++JPGF_INTERNAL jstring+gu2j_string_capit(JNIEnv *env, GuString s, PgfCapitState capit);++JPGF_INTERNAL_DECL GuString+j2gu_string(JNIEnv *env, jstring s, GuPool* pool);++JPGF_INTERNAL_DECL size_t+gu2j_string_offset(GuString s, size_t offset);++JPGF_INTERNAL_DECL size_t+j2gu_string_offset(GuString s, size_t joffset);++JPGF_INTERNAL_DECL void*+get_ref(JNIEnv *env, jobject self);++JPGF_INTERNAL_DECL void+throw_jstring_exception(JNIEnv *env, const char* class_name, jstring msg);++JPGF_INTERNAL_DECL void+throw_string_exception(JNIEnv *env, const char* class_name, const char* msg);++#endif
@@ -0,0 +1,1860 @@+#include <pgf/pgf.h>+#include <pgf/linearizer.h>+#include <gu/mem.h>+#include <gu/exn.h>+#include <math.h>+#include <jni.h>+#include "jni_utils.h"++static JavaVM* cachedJVM;++JNIEXPORT jint JNICALL JNI_OnLoad(JavaVM *jvm, void *reserved)+{+ cachedJVM = jvm;+ return JNI_VERSION_1_6;+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_PGF_readPGF__Ljava_lang_String_2(JNIEnv *env, jclass cls, jstring s)+{ + GuPool* pool = gu_new_pool();+ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ const char *fpath = (*env)->GetStringUTFChars(env, s, 0); ++ // Read the PGF grammar.+ PgfPGF* pgf = pgf_read(fpath, pool, err);++ (*env)->ReleaseStringUTFChars(env, s, fpath);++ if (!gu_ok(err)) {+ if (gu_exn_caught(err, GuErrno)) {+ throw_jstring_exception(env, "java/io/FileNotFoundException", s);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The grammar cannot be loaded");+ }+ gu_pool_free(pool);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jmethodID constrId = (*env)->GetMethodID(env, cls, "<init>", "(JJ)V");+ return (*env)->NewObject(env, cls, constrId, p2l(pool), p2l(pgf));+}++typedef struct {+ GuInStream stream;+ jobject java_stream;+ JNIEnv *env;+ jmethodID read_method;+ jbyteArray buf_array;+ jbyte *buf;+} JInStream;++static const uint8_t*+jpgf_jstream_begin_buffer(GuInStream* self, size_t* sz_out, GuExn* err)+{+ *sz_out = 0;++ JInStream* jstream = (JInStream*) self;+ int sz = (*jstream->env)->CallIntMethod(jstream->env, jstream->java_stream, jstream->read_method, jstream->buf_array);+ if ((*jstream->env)->ExceptionOccurred(jstream->env)) {+ gu_raise(err, PgfExn);+ return NULL;+ }++ jboolean isCopy;+ jstream->buf = (*jstream->env)->GetByteArrayElements(jstream->env, jstream->buf_array, &isCopy);+ if ((*jstream->env)->ExceptionOccurred(jstream->env)) {+ gu_raise(err, PgfExn);+ return NULL;+ }++ *sz_out = (size_t) sz;+ return ((uint8_t*) jstream->buf);+}++static void+jpgf_jstream_end_buffer(GuInStream* self, size_t consumed, GuExn* err)+{+ JInStream* jstream = (JInStream*) self;+ (*jstream->env)->ReleaseByteArrayElements(jstream->env, jstream->buf_array, jstream->buf, JNI_ABORT);+}++static GuInStream*+jpgf_new_java_stream(JNIEnv* env, jobject java_stream, GuPool* pool)+{+ jclass java_stream_class = (*env)->GetObjectClass(env, java_stream);++ JInStream* jstream = gu_new(JInStream, pool);+ jstream->stream.begin_buffer = jpgf_jstream_begin_buffer;+ jstream->stream.end_buffer = jpgf_jstream_end_buffer;+ jstream->stream.input = NULL;+ jstream->java_stream = java_stream;+ jstream->env = env;++ jstream->read_method = (*env)->GetMethodID(env, java_stream_class, "read", "([B)I");+ if (!jstream->read_method) {+ return NULL;+ }++ jstream->buf_array = (*env)->NewByteArray(env, 1024);+ if (!jstream->buf_array) {+ return NULL;+ }++ jstream->buf = NULL;++ return &jstream->stream;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_readPGF__Ljava_io_InputStream_2(JNIEnv *env, jclass cls, jobject java_stream)+{+ GuPool* pool = gu_new_pool();+ GuPool* tmp_pool = gu_local_pool();++ GuInStream* jstream =+ jpgf_new_java_stream(env, java_stream, tmp_pool);+ if (!jstream) {+ gu_pool_free(pool);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ GuIn* in = gu_new_in(jstream, tmp_pool);++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ // Read the PGF grammar.+ PgfPGF* pgf = pgf_read_in(in, pool, tmp_pool, err);+ if (!gu_ok(err)) {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The grammar cannot be loaded");+ gu_pool_free(pool);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jmethodID constrId = (*env)->GetMethodID(env, cls, "<init>", "(JJ)V");+ return (*env)->NewObject(env, cls, constrId, p2l(pool), p2l(pgf));+}++JNIEXPORT jstring JNICALL +Java_org_grammaticalframework_pgf_PGF_getAbstractName(JNIEnv* env, jobject self)+{+ return gu2j_string(env, pgf_abstract_name(get_ref(env, self)));+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_PGF_getStartCat(JNIEnv* env, jobject self)+{+ GuPool* tmp_pool = gu_local_pool();+ PgfType* type = pgf_start_cat(get_ref(env, self), tmp_pool);+ jstring jcat = gu2j_string(env, type->cid);+ gu_pool_free(tmp_pool);+ return jcat;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_getFunctionType(JNIEnv* env, jobject self, jstring jid)+{+ PgfPGF* pgf = get_ref(env, self);+ GuPool* tmp_pool = gu_new_pool();+ PgfCId id = j2gu_string(env, jid, tmp_pool);+ PgfType* tp = pgf_function_type(pgf, id);+ gu_pool_free(tmp_pool);++ if (tp == NULL)+ return NULL;++ jclass type_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Type");+ jmethodID constrId = (*env)->GetMethodID(env, type_class, "<init>", "(Ljava/lang/Object;J)V");+ jobject jtype = (*env)->NewObject(env, type_class, constrId, self, p2l(tp));++ return jtype;+}++JNIEXPORT jdouble JNICALL+Java_org_grammaticalframework_pgf_PGF_getFunctionProb(JNIEnv* env, jobject self, jstring jid)+{+ PgfPGF* pgf = get_ref(env, self);+ GuPool* tmp_pool = gu_local_pool();+ PgfCId id = j2gu_string(env, jid, tmp_pool);+ prob_t prob = pgf_function_prob(pgf, id);+ gu_pool_free(tmp_pool);++ return prob;+}++typedef struct {+ GuMapItor fn;+ JNIEnv *env;+ jobject grammar;+ jobject object;+ jmethodID method_id;+} JPGFClosure;++static void+pgf_collect_langs(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ PgfCId name = (PgfCId) key;+ PgfConcr* concr = *((PgfConcr**) value);+ JPGFClosure* clo = (JPGFClosure*) fn;++ jstring jname = gu2j_string(clo->env, name);++ jclass concr_class = (*clo->env)->FindClass(clo->env, "org/grammaticalframework/pgf/Concr");+ jmethodID constrId = (*clo->env)->GetMethodID(clo->env, concr_class, "<init>", "(Lorg/grammaticalframework/pgf/PGF;J)V");+ jobject jconcr = (*clo->env)->NewObject(clo->env, concr_class, constrId, clo->grammar, p2l(concr));++ (*clo->env)->CallObjectMethod(clo->env, clo->object, clo->method_id, jname, jconcr);+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_getLanguages(JNIEnv* env, jobject self)+{+ jclass map_class = (*env)->FindClass(env, "java/util/HashMap");+ if (!map_class)+ return NULL;+ jmethodID constrId = (*env)->GetMethodID(env, map_class, "<init>", "()V");+ if (!constrId)+ return NULL;+ jobject languages = (*env)->NewObject(env, map_class, constrId);+ if (!languages)+ return NULL;+ jmethodID put_method = (*env)->GetMethodID(env, map_class, "put", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;");+ if (!put_method)+ return NULL;++ PgfPGF* pgf = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ JPGFClosure clo = { { pgf_collect_langs }, env, self, languages, put_method };+ pgf_iter_languages(pgf, &clo.fn, err);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }+ + gu_pool_free(tmp_pool);++ return languages;+}++static void+pgf_collect_names(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ PgfCId name = (PgfCId) key;+ JPGFClosure* clo = (JPGFClosure*) fn;++ jstring jname = gu2j_string(clo->env, name);++ (*clo->env)->CallBooleanMethod(clo->env, clo->object, clo->method_id, jname);+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_getCategories(JNIEnv* env, jobject self)+{+ jclass list_class = (*env)->FindClass(env, "java/util/ArrayList");+ if (!list_class)+ return NULL;+ jmethodID constrId = (*env)->GetMethodID(env, list_class, "<init>", "()V");+ if (!constrId)+ return NULL;+ jobject categories = (*env)->NewObject(env, list_class, constrId);+ if (!categories)+ return NULL;+ jmethodID add_method = (*env)->GetMethodID(env, list_class, "add", "(Ljava/lang/Object;)Z");+ if (!add_method)+ return NULL;++ PgfPGF* pgf = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);+ + JPGFClosure clo = { { pgf_collect_names }, env, self, categories, add_method };+ pgf_iter_categories(pgf, &clo.fn, err);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ return categories;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_getFunctions(JNIEnv* env, jobject self)+{+ jclass list_class = (*env)->FindClass(env, "java/util/ArrayList");+ if (!list_class)+ return NULL;+ jmethodID constrId = (*env)->GetMethodID(env, list_class, "<init>", "()V");+ if (!constrId)+ return NULL;+ jobject functions = (*env)->NewObject(env, list_class, constrId);+ if (!functions)+ return NULL;+ jmethodID add_method = (*env)->GetMethodID(env, list_class, "add", "(Ljava/lang/Object;)Z");+ if (!add_method)+ return NULL;++ PgfPGF* pgf = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);+ + JPGFClosure clo = { { pgf_collect_names }, env, self, functions, add_method };+ pgf_iter_functions(pgf, &clo.fn, err);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ return functions;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_getFunctionsByCat(JNIEnv* env, jobject self, jstring jcat)+{+ jclass list_class = (*env)->FindClass(env, "java/util/ArrayList");+ if (!list_class)+ return NULL;+ jmethodID constrId = (*env)->GetMethodID(env, list_class, "<init>", "()V");+ if (!constrId)+ return NULL;+ jobject functions = (*env)->NewObject(env, list_class, constrId);+ if (!functions)+ return NULL;+ jmethodID add_method = (*env)->GetMethodID(env, list_class, "add", "(Ljava/lang/Object;)Z");+ if (!add_method)+ return NULL;++ PgfPGF* pgf = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();++ PgfCId cat = j2gu_string(env, jcat, tmp_pool);++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);+ + JPGFClosure clo = { { pgf_collect_names }, env, self, functions, add_method };+ pgf_iter_functions_by_cat(pgf, cat, &clo.fn, err);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ return functions;+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_PGF_graphvizAbstractTree(JNIEnv* env, jobject self, jobject jexpr)+{+ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_graphviz_abstract_tree(get_ref(env,self),+ gu_variant_from_ptr(l2p(get_ref(env,jexpr))),+ pgf_default_graphviz_options,+ out, err);++ jstring jstr = gu2j_string_buf(env, sbuf);++ gu_pool_free(tmp_pool);+ return jstr;+}++JNIEXPORT jstring JNICALL +Java_org_grammaticalframework_pgf_Concr_getName(JNIEnv* env, jobject self)+{+ return gu2j_string(env, pgf_concrete_name(get_ref(env, self)));+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_pgf_Concr_load__Ljava_io_InputStream_2(JNIEnv* env, jobject self, jobject java_stream)+{+ GuPool* tmp_pool = gu_local_pool();++ GuInStream* jstream =+ jpgf_new_java_stream(env, java_stream, tmp_pool);+ if (!jstream) {+ gu_pool_free(tmp_pool);+ return;+ }++ GuIn* in = gu_new_in(jstream, tmp_pool);++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ pgf_concrete_load(get_ref(env, self), in, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The language cannot be loaded");+ }+ }++ gu_pool_free(tmp_pool);+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_pgf_Concr_unload(JNIEnv* env, jobject self)+{+ pgf_concrete_unload(get_ref(env, self));+}++JNIEXPORT jlong JNICALL +Java_org_grammaticalframework_pgf_Parser_newCallbacksMap+ (JNIEnv* env, jclass clazz, jobject jconcr, jobject jpool)+{+ return p2l(pgf_new_callbacks_map(get_ref(env, jconcr), get_ref(env, jpool)));+}++typedef struct {+ PgfLiteralCallback callback;+ jobject jcallback;+ jmethodID match_methodId;+ jmethodID predict_methodId;+ GuFinalizer fin;+} JPgfLiteralCallback;++typedef struct {+ GuEnum en;+ jobject jiterator;+ GuFinalizer fin;+} JPgfTokenProbEnum;++static PgfExprProb*+jpgf_literal_callback_match(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ JPgfLiteralCallback* callback = gu_container(self, JPgfLiteralCallback, callback);++ JNIEnv *env;+ (*cachedJVM)->AttachCurrentThread(cachedJVM, (void**)&env, NULL);++ size_t joffset = gu2j_string_offset(sentence, *poffset);+ jobject result = (*env)->CallObjectMethod(env, callback->jcallback, callback->match_methodId, lin_idx, joffset);+ if (result == NULL)+ return NULL;++ jclass result_class = (*env)->GetObjectClass(env, result);+ + jfieldID epId = (*env)->GetFieldID(env, result_class, "ep", "Lorg/grammaticalframework/pgf/ExprProb;");+ jobject jep = (*env)->GetObjectField(env, result, epId);+ jclass ep_class = (*env)->GetObjectClass(env, jep);+ jfieldID exprId = (*env)->GetFieldID(env, ep_class, "expr", "Lorg/grammaticalframework/pgf/Expr;");+ jobject jexpr = (*env)->GetObjectField(env, jep, exprId);+ jfieldID probId = (*env)->GetFieldID(env, ep_class, "prob", "D");+ double prob = (*env)->GetDoubleField(env, jep, probId);++ jfieldID offsetId = (*env)->GetFieldID(env, result_class, "offset", "I");+ *poffset = j2gu_string_offset(sentence, (*env)->GetIntField(env, result, offsetId));++ PgfExprProb* ep = gu_new(PgfExprProb, out_pool);+ ep->expr = gu_variant_from_ptr(get_ref(env, jexpr));+ ep->prob = prob;++ + {+ // This is an uggly hack. We first show the expression ep->expr+ // and then we read it back but in out_pool. The whole purpose+ // of this is to copy the expression from the temporary pool+ // that was created in the Java binding to the parser pool.+ // There should be a real copying function or even better+ // there must be a way to avoid copying at all.++ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_print_expr(ep->expr, NULL, 0, out, err);++ GuString str = gu_string_buf_data(sbuf);+ size_t len = gu_string_buf_length(sbuf);+ GuIn* in = gu_data_in((uint8_t*) str, len, tmp_pool);++ ep->expr = pgf_read_expr(in, out_pool, tmp_pool, err);+ if (!gu_ok(err) || gu_variant_is_null(ep->expr)) {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be parsed");+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ }++ return ep;+}++static void +jpgf_token_prob_enum_fin(GuFinalizer* self)+{+ JPgfTokenProbEnum* en = gu_container(self, JPgfTokenProbEnum, fin);+ + JNIEnv *env;+ (*cachedJVM)->AttachCurrentThread(cachedJVM, (void**)&env, NULL);++ (*env)->DeleteGlobalRef(env, en->jiterator);+}++static GuEnum*+jpgf_literal_callback_predict(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString prefix,+ GuPool *out_pool)+{+ JPgfLiteralCallback* callback = gu_container(self, JPgfLiteralCallback, callback);++ JNIEnv *env;+ (*cachedJVM)->AttachCurrentThread(cachedJVM, (void**)&env, NULL);++ jstring jprefix = gu2j_string(env, prefix);+ jobject jiterator = (*env)->CallObjectMethod(env, callback->jcallback, callback->predict_methodId, lin_idx, jprefix);+ if (jiterator == NULL)+ return NULL;++ JPgfTokenProbEnum* en = gu_new(JPgfTokenProbEnum, out_pool);+ en->en.next = NULL;+ en->jiterator = (*env)->NewGlobalRef(env, jiterator);+ en->fin.fn = jpgf_token_prob_enum_fin;++ gu_pool_finally(out_pool, &en->fin);++ return &en->en;+}++static void +jpgf_literal_callback_fin(GuFinalizer* self)+{+ JPgfLiteralCallback* callback = gu_container(self, JPgfLiteralCallback, fin);+ + JNIEnv *env;+ (*cachedJVM)->AttachCurrentThread(cachedJVM, (void**)&env, NULL);++ (*env)->DeleteGlobalRef(env, callback->jcallback);+}++JNIEXPORT void JNICALL Java_org_grammaticalframework_pgf_Parser_addLiteralCallback+ (JNIEnv* env, jclass clazz, jobject jconcr, jlong callbacksRef, jstring jcat, jobject jcallback, jobject jpool)+{+ PgfConcr* concr = get_ref(env, jconcr);+ GuPool* pool = get_ref(env, jpool);++ JPgfLiteralCallback* callback = gu_new(JPgfLiteralCallback, pool);+ callback->callback.match = jpgf_literal_callback_match;+ callback->callback.predict = jpgf_literal_callback_predict;+ callback->jcallback = (*env)->NewGlobalRef(env, jcallback);+ callback->fin.fn = jpgf_literal_callback_fin;++ jclass callback_class = (*env)->GetObjectClass(env, jcallback);+ callback->match_methodId = (*env)->GetMethodID(env, callback_class, "match", "(II)Lorg/grammaticalframework/pgf/LiteralCallback$CallbackResult;");+ callback->predict_methodId = (*env)->GetMethodID(env, callback_class, "predict", "(ILjava/lang/String;)Ljava/util/Iterator;");++ gu_pool_finally(pool, &callback->fin);+ + pgf_callbacks_map_add_literal(concr, l2p(callbacksRef),+ j2gu_string(env, jcat, pool), &callback->callback);+}++static void+throw_parse_error(JNIEnv *env, PgfParseError* err)+{+ jstring jtoken;+ if (err->incomplete)+ jtoken = NULL;+ else {+ jtoken = gu2j_string_len(env, err->token_ptr, err->token_len);+ if (!jtoken)+ return;+ }++ jclass exception_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/ParseError");+ if (!exception_class)+ return;+ jmethodID constrId = (*env)->GetMethodID(env, exception_class, "<init>", "(Ljava/lang/String;IZ)V");+ if (!constrId)+ return;+ jobject exception = (*env)->NewObject(env, exception_class, constrId, jtoken, err->offset, err->incomplete);+ if (!exception)+ return;+ (*env)->Throw(env, exception);+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_Parser_parseWithHeuristics+ (JNIEnv* env, jclass clazz, jobject jconcr, jstring jstartCat, jstring js, jdouble heuristics, jlong callbacksRef, jobject jpool)+{+ GuPool* pool = get_ref(env, jpool);+ GuPool* out_pool = gu_new_pool();++ GuString startCat = j2gu_string(env, jstartCat, pool);+ GuString s = j2gu_string(env, js, pool);+ GuExn* parse_err = gu_new_exn(pool);++ PgfType* type = gu_new_flex(pool, PgfType, exprs, 0);+ type->hypos = gu_empty_seq();+ type->cid = startCat;+ type->n_exprs = 0;++ GuEnum* res =+ pgf_parse_with_heuristics(get_ref(env, jconcr), type, s, heuristics, l2p(callbacksRef), parse_err, pool, out_pool);++ if (!gu_ok(parse_err)) {+ if (gu_exn_caught(parse_err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(parse_err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else if (gu_exn_caught(parse_err, PgfParseError)) {+ throw_parse_error(env, (PgfParseError*) gu_exn_caught_data(parse_err));+ }++ gu_pool_free(out_pool);+ return NULL;+ }++ jfieldID refId = (*env)->GetFieldID(env, (*env)->GetObjectClass(env, jconcr), "gr", "Lorg/grammaticalframework/pgf/PGF;");+ jobject jpgf = (*env)->GetObjectField(env, jconcr, refId);++ jclass expiter_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/ExprIterator");+ jmethodID constrId = (*env)->GetMethodID(env, expiter_class, "<init>", "(Lorg/grammaticalframework/pgf/PGF;Lorg/grammaticalframework/pgf/Pool;JJ)V");+ jobject jexpiter = (*env)->NewObject(env, expiter_class, constrId, jpgf, jpool, p2l(out_pool), p2l(res));++ return jexpiter;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_Completer_complete(JNIEnv* env, jclass clazz, jobject jconcr, jstring jstartCat, jstring js, jstring jprefix)+{+ GuPool* pool = gu_new_pool();++ GuString startCat = j2gu_string(env, jstartCat, pool);+ GuString s = j2gu_string(env, js, pool);+ GuString prefix = j2gu_string(env, jprefix, pool);+ GuExn* parse_err = gu_new_exn(pool);++ PgfType* type = gu_new_flex(pool, PgfType, exprs, 0);+ type->hypos = gu_empty_seq();+ type->cid = startCat;+ type->n_exprs = 0;++ GuEnum* res =+ pgf_complete(get_ref(env, jconcr), type, s, prefix, parse_err, pool);++ if (!gu_ok(parse_err)) {+ if (gu_exn_caught(parse_err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(parse_err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else if (gu_exn_caught(parse_err, PgfParseError)) {+ throw_parse_error(env, (PgfParseError*) gu_exn_caught_data(parse_err));+ }++ gu_pool_free(pool);+ return NULL;+ }++ jclass tokiter_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/TokenIterator");+ jmethodID constrId = (*env)->GetMethodID(env, tokiter_class, "<init>", "(JJ)V");+ jobject jtokiter = (*env)->NewObject(env, tokiter_class, constrId, p2l(pool), p2l(res));++ return jtokiter;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_SentenceExtractor_lookupSentence+ (JNIEnv* env, jclass clazz, jobject jconcr, jstring jstartCat, jstring js, jobject jpool)+{+ GuPool* pool = get_ref(env, jpool);+ GuPool* out_pool = gu_new_pool();++ GuString startCat = j2gu_string(env, jstartCat, pool);+ GuString s = j2gu_string(env, js, pool);++ PgfType* type = gu_new_flex(pool, PgfType, exprs, 0);+ type->hypos = gu_empty_seq();+ type->cid = startCat;+ type->n_exprs = 0;++ GuEnum* res =+ pgf_lookup_sentence(get_ref(env, jconcr), type, s, pool, out_pool);++ jfieldID refId = (*env)->GetFieldID(env, (*env)->GetObjectClass(env, jconcr), "gr", "Lorg/grammaticalframework/pgf/PGF;");+ jobject jpgf = (*env)->GetObjectField(env, jconcr, refId);++ jclass expiter_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/ExprIterator");+ jmethodID constrId = (*env)->GetMethodID(env, expiter_class, "<init>", "(Lorg/grammaticalframework/pgf/PGF;Lorg/grammaticalframework/pgf/Pool;JJ)V");+ jobject jexpiter = (*env)->NewObject(env, expiter_class, constrId, jpgf, jpool, p2l(out_pool), p2l(res));++ return jexpiter;+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_TokenIterator_fetchTokenProb(JNIEnv* env, jclass clazz, jlong enumRef, jobject jpool)+{+ GuEnum* res = (GuEnum*) l2p(enumRef);++ PgfTokenProb* tp = gu_next(res, PgfTokenProb*, get_ref(env, jpool));+ if (tp == NULL)+ return NULL;++ jclass tp_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/TokenProb");+ jmethodID tp_constrId = (*env)->GetMethodID(env, tp_class, "<init>", "(DLjava/lang/String;Ljava/lang/String;Ljava/lang/String;)V");+ jobject jtp = (*env)->NewObject(env, tp_class, tp_constrId, (double) tp->prob, gu2j_string(env,tp->tok), gu2j_string(env,tp->cat), gu2j_string(env,tp->fun));++ return jtp;+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_ExprIterator_fetchExprProb+ (JNIEnv* env, jclass clazz, jlong enumRef, jobject jpool, jobject gr)+{+ GuEnum* res = (GuEnum*) l2p(enumRef);+ GuPool* pool = get_ref(env, jpool);++ PgfExprProb* ep = gu_next(res, PgfExprProb*, pool);+ if (ep == NULL)+ return NULL;++ jclass expprob_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/ExprProb");+ jmethodID methodId = (*env)->GetStaticMethodID(env, expprob_class, "mkExprProb", + "(Lorg/grammaticalframework/pgf/Pool;Lorg/grammaticalframework/pgf/PGF;JD)Lorg/grammaticalframework/pgf/ExprProb;");+ jobject jexpprob = (*env)->CallStaticObjectMethod(env, expprob_class, methodId, + jpool, gr, p2l(gu_variant_to_ptr(ep->expr)), (double) ep->prob);++ return jexpprob;+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_Concr_linearize(JNIEnv* env, jobject self, jobject jexpr)+{+ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ + pgf_linearize(get_ref(env, self), gu_variant_from_ptr((void*) get_ref(env, jexpr)), out, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfLinNonExist)) {+ gu_pool_free(tmp_pool);+ return NULL;+ } else if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be linearized");+ }+ gu_pool_free(tmp_pool);+ return NULL;+ }++ jstring jstr = gu2j_string_buf(env, sbuf);++ gu_pool_free(tmp_pool);+ + return jstr;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_Concr_linearizeAll(JNIEnv* env, jobject self, jobject jexpr)+{+ PgfConcr* concr = get_ref(env, self);+ + jclass list_class = (*env)->FindClass(env, "java/util/ArrayList");+ jmethodID list_constrId = (*env)->GetMethodID(env, list_class, "<init>", "()V");+ jobject strings = (*env)->NewObject(env, list_class, list_constrId);+ + jmethodID addId = (*env)->GetMethodID(env, list_class, "add", "(Ljava/lang/Object;)Z");++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);+ + GuEnum* cts =+ pgf_lzr_concretize(concr,+ gu_variant_from_ptr((void*) get_ref(env, jexpr)),+ err, tmp_pool);+ if (!gu_ok(err)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ for (;;) {+ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (gu_variant_is_null(ctree))+ break;++ GuPool* step_pool = gu_local_pool();+ GuStringBuf* sbuf = gu_new_string_buf(step_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ ctree = pgf_lzr_wrap_linref(ctree, step_pool);+ pgf_lzr_linearize_simple(concr, ctree, 0, out, err, step_pool);+ if (!gu_ok(err)) {+ gu_pool_free(step_pool);++ if (gu_exn_caught(err, PgfLinNonExist)) { + continue;+ } else if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be linearized");+ }+ gu_pool_free(tmp_pool);+ return NULL;+ }++ jstring jstr = gu2j_string_buf(env, sbuf);++ (*env)->CallBooleanMethod(env, strings, addId, jstr);+ + gu_pool_free(step_pool);+ }++ gu_pool_free(tmp_pool);++ return strings;+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_Concr_tabularLinearize(JNIEnv* env, jobject self, jobject jexpr)+{+ jclass map_class = (*env)->FindClass(env, "java/util/HashMap");+ if (!map_class)+ return NULL;+ jmethodID constrId = (*env)->GetMethodID(env, map_class, "<init>", "()V");+ if (!constrId)+ return NULL;+ jobject table = (*env)->NewObject(env, map_class, constrId);+ if (!table)+ return NULL;++ jmethodID put_method = (*env)->GetMethodID(env, map_class, "put", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;");+ if (!put_method)+ return NULL;+ + PgfConcr* concr = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ GuEnum* cts = + pgf_lzr_concretize(concr,+ gu_variant_from_ptr((void*) get_ref(env, jexpr)),+ err,+ tmp_pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be concretized");+ }+ gu_pool_free(tmp_pool);+ return NULL;+ }++ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (gu_variant_is_null(ctree)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ size_t n_lins;+ GuString* labels;+ pgf_lzr_get_table(concr, ctree, &n_lins, &labels);++ for (size_t lin_idx = 0; lin_idx < n_lins; lin_idx++) {+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_lzr_linearize_simple(concr, ctree, lin_idx, out, err, tmp_pool);++ jstring jstr = NULL;+ if (gu_ok(err)) {+ jstr = gu2j_string_buf(env, sbuf);+ } else {+ gu_exn_clear(err);+ }++ jstring jname = gu2j_string(env, labels[lin_idx]);++ (*env)->CallObjectMethod(env, table, put_method, jname, jstr);++ (*env)->DeleteLocalRef(env, jname);+ + if (jstr != NULL)+ (*env)->DeleteLocalRef(env, jstr);+ }+ + gu_pool_free(tmp_pool);++ return table;+}++typedef struct {+ PgfLinFuncs* funcs;+ JNIEnv* env;+ GuPool* tmp_pool;+ GuBuf* stack;+ GuBuf* list;+ bool bind;+ PgfCapitState capit;+ jobject bind_instance;+ jclass object_class;+ jclass bracket_class;+ jmethodID bracket_constrId;+} PgfBracketLznState;++static void+pgf_bracket_lzn_symbol_token(PgfLinFuncs** funcs, PgfToken tok)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);+ JNIEnv* env = state->env;++ if (state->bind) {+ jobject bind_instance = (*env)->NewLocalRef(env, state->bind_instance);+ gu_buf_push(state->list, jobject, bind_instance);+ state->bind = false;+ } else {+ if (state->capit == PGF_CAPIT_NEXT)+ state->capit = PGF_CAPIT_NONE;+ }++ if (state->capit == PGF_CAPIT_ALL)+ state->capit = PGF_CAPIT_NEXT;++ jstring jtok = gu2j_string_capit(env, tok, state->capit);+ gu_buf_push(state->list, jobject, jtok);+ + if (state->capit == PGF_CAPIT_FIRST)+ state->capit = PGF_CAPIT_NONE;+}++static void+pgf_bracket_lzn_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);+ + gu_buf_push(state->stack, GuBuf*, state->list);+ state->list = gu_new_buf(jobject, state->tmp_pool);+}++static void+pgf_bracket_lzn_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);+ JNIEnv* env = state->env;++ GuBuf* parent = gu_buf_pop(state->stack, GuBuf*);++ if (gu_buf_length(state->list) > 0) {+ jstring jcat = gu2j_string(env, cat);+ jstring jfun = gu2j_string(env, fun);++ size_t len = gu_buf_length(state->list);+ jobjectArray jchildren = (*env)->NewObjectArray(env, len, state->object_class, NULL);+ for (int i = 0; i < len; i++) {+ jobject obj = gu_buf_get(state->list, jobject, i);+ (*env)->SetObjectArrayElement(env, jchildren, i, obj);+ (*env)->DeleteLocalRef(env, obj);+ }++ jobject jbracket = (*env)->NewObject(env, + state->bracket_class,+ state->bracket_constrId, + jcat,+ jfun,+ fid,+ lindex,+ jchildren);++ (*env)->DeleteLocalRef(env, jchildren);+ (*env)->DeleteLocalRef(env, jfun);+ (*env)->DeleteLocalRef(env, jcat);++ gu_buf_push(parent, jobject, jbracket);+ }++ state->list = parent;+}++static void+pgf_bracket_lzn_symbol_bind(PgfLinFuncs** funcs)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);+ state->bind = true;+}++static void+pgf_bracket_lzn_symbol_capit(PgfLinFuncs** funcs, PgfCapitState capit)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);+ state->capit = capit;+}++static void+pgf_bracket_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId id)+{+ pgf_bracket_lzn_symbol_token(funcs, "?");+}++static PgfLinFuncs pgf_bracket_lin_funcs = {+ .symbol_token = pgf_bracket_lzn_symbol_token,+ .begin_phrase = pgf_bracket_lzn_begin_phrase,+ .end_phrase = pgf_bracket_lzn_end_phrase,+ .symbol_ne = NULL,+ .symbol_bind = pgf_bracket_lzn_symbol_bind,+ .symbol_capit = pgf_bracket_lzn_symbol_capit,+ .symbol_meta = pgf_bracket_lzn_symbol_meta+};++JNIEXPORT jobjectArray JNICALL +Java_org_grammaticalframework_pgf_Concr_bracketedLinearize(JNIEnv* env, jobject self, jobject jexpr)+{+ jclass object_class = (*env)->FindClass(env, "java/lang/Object");+ if (!object_class)+ return NULL;++ jclass bracket_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Bracket");+ if (!bracket_class)+ return NULL;+ jmethodID bracket_constrId = (*env)->GetMethodID(env, bracket_class, "<init>", "(Ljava/lang/String;Ljava/lang/String;II[Ljava/lang/Object;)V");+ if (!bracket_constrId)+ return NULL;+ + jclass bind_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/BIND");+ if (!bind_class)+ return NULL;+ jfieldID bind_instance_id = (*env)->GetStaticFieldID(env, bind_class, "instance", "Lorg/grammaticalframework/pgf/BIND;");+ if (!bind_instance_id)+ return NULL;+ jobject bind_instance = (*env)->GetStaticObjectField(env, bind_class, bind_instance_id);+ if (!bind_instance)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ PgfConcr* concr = get_ref(env, self);++ GuEnum* cts = + pgf_lzr_concretize(concr, gu_variant_from_ptr((void*) get_ref(env, jexpr)), err, tmp_pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be concretized");+ }+ gu_pool_free(tmp_pool);+ return NULL;+ }++ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (gu_variant_is_null(ctree)) {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be concretized");+ gu_pool_free(tmp_pool);+ return NULL;+ }++ ctree = pgf_lzr_wrap_linref(ctree, tmp_pool);++ PgfBracketLznState state;+ state.funcs = &pgf_bracket_lin_funcs;+ state.env = env;+ state.tmp_pool = tmp_pool;+ state.stack = gu_new_buf(GuBuf*, tmp_pool);+ state.list = gu_new_buf(jobject, tmp_pool);+ state.bind = true;+ state.capit = PGF_CAPIT_NONE;+ state.bind_instance = bind_instance;+ state.object_class = object_class;+ state.bracket_class = bracket_class;+ state.bracket_constrId = bracket_constrId;+ pgf_lzr_linearize(concr, ctree, 0, &state.funcs, tmp_pool);++ size_t len = gu_buf_length(state.list);+ jobjectArray array = (*env)->NewObjectArray(env, len, object_class, NULL);+ for (int i = 0; i < len; i++) {+ jobject obj = gu_buf_get(state.list, jobject, i);+ (*env)->SetObjectArrayElement(env, array, i, obj);+ (*env)->DeleteLocalRef(env, obj);+ }++ gu_pool_free(tmp_pool);++ return array;+}++typedef struct {+ PgfMorphoCallback fn;+ jobject analyses;+ prob_t prob;+ JNIEnv* env;+ jmethodID addId;+ jclass an_class;+ jmethodID an_constrId;+} JMorphoCallback;++static void+jpgf_collect_morpho(PgfMorphoCallback* self,+ PgfCId lemma, GuString analysis, prob_t prob,+ GuExn* err)+{+ JMorphoCallback* callback = (JMorphoCallback*) self;+ JNIEnv* env = callback->env;+ + jstring jlemma = gu2j_string(env,lemma);+ jstring janalysis = gu2j_string(env,analysis);+ jobject jan = (*env)->NewObject(env, + callback->an_class,+ callback->an_constrId, + jlemma,+ janalysis,+ (double) prob);+ (*env)->CallBooleanMethod(env, callback->analyses, callback->addId, jan);+ (*env)->DeleteLocalRef(env, jan);+ (*env)->DeleteLocalRef(env, janalysis);+ (*env)->DeleteLocalRef(env, jlemma);+ + callback->prob += exp(-prob);+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_Concr_lookupMorpho(JNIEnv* env, jobject self, jstring sentence)+{+ jclass list_class = (*env)->FindClass(env, "java/util/ArrayList");+ jmethodID list_constrId = (*env)->GetMethodID(env, list_class, "<init>", "()V");+ jobject analyses = (*env)->NewObject(env, list_class, list_constrId);+ + jmethodID addId = (*env)->GetMethodID(env, list_class, "add", "(Ljava/lang/Object;)Z");++ jclass an_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/MorphoAnalysis");+ jmethodID an_constrId = (*env)->GetMethodID(env, an_class, "<init>", "(Ljava/lang/String;Ljava/lang/String;D)V");++ GuPool* tmp_pool = gu_new_pool();+ + GuExn* err = gu_exn(tmp_pool);++ JMorphoCallback callback = { { jpgf_collect_morpho }, analyses, 0, env, addId, an_class, an_constrId };+ pgf_lookup_morpho(get_ref(env, self), j2gu_string(env, sentence, tmp_pool),+ &callback.fn, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The lookup failed");+ }+ analyses = NULL;+ }++ gu_pool_free(tmp_pool);++ return analyses;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_Lexicon_lookupWordPrefix+ (JNIEnv* env, jclass clazz, jobject jconcr, jstring prefix)+{+ GuPool* pool = gu_new_pool(); + GuExn* err = gu_new_exn(pool);++ GuEnum* en = + (prefix == NULL) ? pgf_fullform_lexicon(get_ref(env, jconcr), + pool)+ : pgf_lookup_word_prefix(get_ref(env, jconcr), j2gu_string(env, prefix, pool),+ pool, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The lookup failed");+ }+ return NULL;+ }++ jclass iter_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/FullFormIterator");+ jmethodID iter_constrId = (*env)->GetMethodID(env, iter_class, "<init>", "(Lorg/grammaticalframework/pgf/Concr;JJ)V");+ jobject iter = (*env)->NewObject(env, iter_class, iter_constrId, jconcr, p2l(pool), p2l(en));++ return iter;+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_FullFormIterator_fetchFullFormEntry+ (JNIEnv* env, jobject clazz, jlong enumRef, jobject jpool, jobject jconcr)+{+ GuEnum* res = (GuEnum*) l2p(enumRef);++ PgfFullFormEntry* entry = gu_next(res, PgfFullFormEntry*, get_ref(env, jpool));+ if (entry == NULL)+ return NULL;++ GuString form = pgf_fullform_get_string(entry);++ jclass list_class = (*env)->FindClass(env, "java/util/ArrayList");+ jmethodID list_constrId = (*env)->GetMethodID(env, list_class, "<init>", "()V");+ jobject analyses = (*env)->NewObject(env, list_class, list_constrId);++ jmethodID addId = (*env)->GetMethodID(env, list_class, "add", "(Ljava/lang/Object;)Z");++ jclass an_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/MorphoAnalysis");+ jmethodID an_constrId = (*env)->GetMethodID(env, an_class, "<init>", "(Ljava/lang/String;Ljava/lang/String;D)V");++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ JMorphoCallback callback = { { jpgf_collect_morpho }, analyses, 0, env, addId, an_class, an_constrId };+ pgf_fullform_get_analyses(entry, &callback.fn, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The lookup failed");+ }+ analyses = NULL;+ }++ gu_pool_free(tmp_pool);++ jclass entry_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/FullFormEntry");+ jmethodID entry_constrId = (*env)->GetMethodID(env, entry_class, "<init>", "(Ljava/lang/String;DLjava/util/List;)V");+ jobject jentry = (*env)->NewObject(env, entry_class, entry_constrId, gu2j_string(env,form), - log(callback.prob), analyses);++ return jentry;+}++JNIEXPORT jboolean JNICALL+Java_org_grammaticalframework_pgf_Concr_hasLinearization(JNIEnv* env, jobject self, jstring jid)+{+ PgfConcr* concr = get_ref(env, self);+ GuPool* tmp_pool = gu_local_pool();+ PgfCId id = j2gu_string(env, jid, tmp_pool);+ bool res = pgf_has_linearization(concr, id);+ gu_pool_free(tmp_pool);+ return res;+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_Concr_getPrintName(JNIEnv* env, jobject self, jstring jid)+{+ PgfConcr* concr = get_ref(env, self);+ GuPool* tmp_pool = gu_local_pool();+ PgfCId id = j2gu_string(env, jid, tmp_pool);+ GuString name = pgf_print_name(concr, id);+ jstring jname = (name == NULL) ? NULL : gu2j_string(env, name);+ gu_pool_free(tmp_pool);++ return jname;+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_Concr_graphvizParseTree(JNIEnv* env, jobject self, jobject jexpr)+{+ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_graphviz_parse_tree(get_ref(env,self),+ gu_variant_from_ptr(l2p(get_ref(env,jexpr))),+ pgf_default_graphviz_options,+ out, err);++ jstring jstr = gu2j_string_buf(env, sbuf);++ gu_pool_free(tmp_pool);+ return jstr;+}++JNIEXPORT jlong JNICALL+Java_org_grammaticalframework_pgf_Pool_alloc(JNIEnv* env, jclass clazz)+{+ return p2l(gu_new_pool());+}++JNIEXPORT void JNICALL +Java_org_grammaticalframework_pgf_Pool_free(JNIEnv* env, jclass clazz, jlong ref)+{+ gu_pool_free((GuPool*) l2p(ref));+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_Expr_showExpr(JNIEnv* env, jclass clazz, jlong ref)+{+ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_print_expr(gu_variant_from_ptr(l2p(ref)), NULL, 0, out, err);++ jstring jstr = gu2j_string_buf(env, sbuf);++ gu_pool_free(tmp_pool);+ return jstr;+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_Expr_readExpr(JNIEnv* env, jclass clazz, jstring s)+{+ GuPool* pool = gu_new_pool();+ + GuPool* tmp_pool = gu_local_pool();+ GuString buf = j2gu_string(env, s, tmp_pool);+ GuIn* in = gu_data_in((uint8_t*) buf, strlen(buf), tmp_pool);+ GuExn* err = gu_exn(tmp_pool);++ PgfExpr e = pgf_read_expr(in, pool, tmp_pool, err);+ if (!gu_ok(err) || gu_variant_is_null(e)) {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be parsed");+ gu_pool_free(tmp_pool);+ gu_pool_free(pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jclass pool_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Pool");+ jmethodID pool_constrId = (*env)->GetMethodID(env, pool_class, "<init>", "(J)V");+ jobject jpool = (*env)->NewObject(env, pool_class, pool_constrId, p2l(pool));++ jmethodID constrId = (*env)->GetMethodID(env, clazz, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");+ return (*env)->NewObject(env, clazz, constrId, jpool, NULL, p2l(gu_variant_to_ptr(e)));+}++JNIEXPORT jlong JNICALL +Java_org_grammaticalframework_pgf_Expr_initStringLit(JNIEnv* env, jclass clazz, jstring jstr, jlong jpool)+{+ GuPool* pool = l2p(jpool);+ PgfExpr expr;++ PgfExprLit* e =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &expr, pool);++ GuString str = (*env)->GetStringUTFChars(env, jstr, 0);+ PgfLiteralStr* slit =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, strlen(str)+1,+ &e->lit, pool);+ strcpy(slit->val, str);+ (*env)->ReleaseStringUTFChars(env, jstr, str);++ return expr;+}++JNIEXPORT jlong JNICALL +Java_org_grammaticalframework_pgf_Expr_initIntLit(JNIEnv* env, jclass clazz, jint jd, jlong jpool)+{+ GuPool* pool = l2p(jpool);+ PgfExpr expr;++ PgfExprLit* e =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &expr, pool);++ PgfLiteralInt* nlit =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &e->lit, pool);+ nlit->val = jd;++ return expr;+}++JNIEXPORT jlong JNICALL +Java_org_grammaticalframework_pgf_Expr_initFloatLit(JNIEnv* env, jclass clazz, jdouble jf, jlong jpool)+{+ GuPool* pool = l2p(jpool);+ PgfExpr expr;++ PgfExprLit* e =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &expr, pool);++ PgfLiteralFlt* flit =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &e->lit, pool);+ flit->val = jf;++ return expr;+}++JNIEXPORT jlong JNICALL+Java_org_grammaticalframework_pgf_Expr_initApp__Lorg_grammaticalframework_pgf_Expr_2_3Lorg_grammaticalframework_pgf_Expr_2J+(JNIEnv* env, jclass clazz, jobject jfun, jobjectArray args, jlong jpool)+{+ GuPool* pool = l2p(jpool);+ PgfExpr expr = gu_variant_from_ptr(get_ref(env, jfun));++ size_t n_args = (*env)->GetArrayLength(env, args);+ for (size_t i = 0; i < n_args; i++) {+ PgfExpr fun = expr;+ PgfExpr arg = gu_variant_from_ptr(get_ref(env, (*env)->GetObjectArrayElement(env, args, i)));++ PgfExprApp* e =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &expr, pool);+ e->fun = fun;+ e->arg = arg;+ }++ return expr;+}++JNIEXPORT jlong JNICALL +Java_org_grammaticalframework_pgf_Expr_initApp__Ljava_lang_String_2_3Lorg_grammaticalframework_pgf_Expr_2J+(JNIEnv* env, jclass clazz, jstring jfun, jobjectArray args, jlong jpool)+{+ GuPool* pool = l2p(jpool);+ PgfExpr expr;++ GuString fun = (*env)->GetStringUTFChars(env, jfun, 0);+ PgfExprFun* e =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(fun)+1,+ &expr, pool);+ strcpy(e->fun, fun);+ (*env)->ReleaseStringUTFChars(env, jfun, fun);++ size_t n_args = (*env)->GetArrayLength(env, args);+ for (size_t i = 0; i < n_args; i++) {+ PgfExpr fun = expr;+ PgfExpr arg = gu_variant_from_ptr(get_ref(env, (*env)->GetObjectArrayElement(env, args, i)));++ PgfExprApp* e =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &expr, pool);+ e->fun = fun;+ e->arg = arg;+ }++ return expr;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_Expr_unApp(JNIEnv* env, jobject self)+{+ jclass expr_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Expr");+ if (!expr_class)+ return NULL;+ jmethodID expr_constrId = (*env)->GetMethodID(env, expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");+ jclass app_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/ExprApplication");+ if (!app_class)+ return NULL;+ jmethodID app_constrId = (*env)->GetMethodID(env, app_class, "<init>", "(Ljava/lang/String;[Lorg/grammaticalframework/pgf/Expr;)V");+ if (!app_constrId)+ return NULL;++ PgfExpr expr = gu_variant_from_ptr(get_ref(env, self));+ + GuPool* tmp_pool = gu_local_pool();+ PgfApplication* app = pgf_expr_unapply(expr, tmp_pool);+ + jobject japp = NULL;+ if (app != NULL) {+ jstring jfun = gu2j_string(env, app->fun);+ jobject jargs = (*env)->NewObjectArray(env, app->n_args, expr_class, NULL);+ for (size_t i = 0; i < app->n_args; i++) {+ jobject jarg = (*env)->NewObject(env, expr_class, expr_constrId, NULL, self, p2l(app->args[i]));+ (*env)->SetObjectArrayElement(env, jargs, i, jarg);+ (*env)->DeleteLocalRef(env, jarg);+ }+ japp = (*env)->NewObject(env, app_class, app_constrId, jfun, jargs);+ }++ gu_pool_free(tmp_pool);++ return japp;+}++JNIEXPORT jint JNICALL+Java_org_grammaticalframework_pgf_Expr_unMeta(JNIEnv* env, jobject self)+{+ PgfExpr expr = gu_variant_from_ptr(get_ref(env, self));++ PgfExprMeta* pmeta = pgf_expr_unmeta(expr);+ if (pmeta != NULL) {+ return pmeta->id;+ }++ return -1;+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_Expr_unStr(JNIEnv* env, jobject self)+{+ PgfExpr expr = gu_variant_from_ptr(get_ref(env, self));++ PgfLiteralStr* pstr = pgf_expr_unlit(expr, PGF_LITERAL_STR);+ if (pstr != NULL) {+ return gu2j_string(env, pstr->val);+ }++ return NULL;+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_pgf_Expr_visit(JNIEnv* env, jobject self, jobject visitor)+{+ PgfExpr e = gu_variant_from_ptr(l2p(get_ref(env, self)));++ GuPool* tmp_pool = gu_local_pool();++ PgfApplication* app = pgf_expr_unapply(e, tmp_pool);+ if (app != NULL) {+ char* method_name = gu_malloc(tmp_pool, strlen(app->fun)+4);+ strcpy(method_name, "on_");+ strcat(method_name, app->fun);+ + GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ gu_putc('(', out, err);+ for (size_t i = 0; i < app->n_args; i++) {+ gu_puts("Lorg/grammaticalframework/pgf/Expr;", out, err);+ }+ gu_puts(")V", out, err);+ gu_putc('\0', out, err);++ char* sig = gu_string_buf_data(sbuf);++ jclass visitor_class = (*env)->GetObjectClass(env, visitor);+ jmethodID methodID = (*env)->GetMethodID(env, visitor_class, method_name, sig);+ + if (methodID != NULL) {+ jclass expr_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Expr");+ jmethodID expr_constrId = (*env)->GetMethodID(env, expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");++ jvalue* args = gu_malloc(tmp_pool, sizeof(jvalue)*app->n_args);+ for (size_t i = 0; i < app->n_args; i++) {+ args[i].l = (*env)->NewObject(env, expr_class, expr_constrId, NULL, self, p2l(app->args[i]));+ }+ (*env)->CallVoidMethodA(env, visitor, methodID, args);+ } else {+ (*env)->ExceptionClear(env);++ methodID = (*env)->GetMethodID(env, visitor_class, "defaultCase", "(Lorg/grammaticalframework/pgf/Expr;)V");+ if (methodID != NULL) {+ (*env)->CallVoidMethod(env, visitor, methodID, self);+ } else {+ (*env)->ExceptionClear(env);+ }+ }+ }++ gu_pool_free(tmp_pool);+}++JNIEXPORT jboolean JNICALL+Java_org_grammaticalframework_pgf_Expr_equals(JNIEnv* env, jobject self, jobject other)+{+ jclass self_class = (*env)->GetObjectClass(env, self);+ jclass other_class = (*env)->GetObjectClass(env, other);++ if (!(*env)->IsAssignableFrom(env, other_class, self_class))+ return JNI_FALSE;++ PgfExpr e_self = gu_variant_from_ptr(l2p(get_ref(env, self)));+ PgfExpr e_other = gu_variant_from_ptr(l2p(get_ref(env, other)));+ + if (pgf_expr_eq(e_self, e_other))+ return JNI_TRUE;+ else+ return JNI_FALSE;+}++JNIEXPORT jint JNICALL+Java_org_grammaticalframework_pgf_Expr_hashCode(JNIEnv* env, jobject self)+{+ PgfExpr e = gu_variant_from_ptr(l2p(get_ref(env, self)));+ return pgf_expr_hash(0, e);+}++JNIEXPORT jint JNICALL+Java_org_grammaticalframework_pgf_Expr_size(JNIEnv* env, jobject self)+{+ PgfExpr e = gu_variant_from_ptr(l2p(get_ref(env, self)));+ return pgf_expr_size(e);+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_Type_getCategory(JNIEnv* env, jobject self)+{+ PgfType* tp = get_ref(env, self);+ return gu2j_string(env, tp->cid);+}++JNIEXPORT jobjectArray JNICALL+Java_org_grammaticalframework_pgf_Type_getHypos(JNIEnv* env, jobject self)+{+ PgfType* tp = get_ref(env, self);++ jclass hypo_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Hypo");+ jmethodID constrId = (*env)->GetMethodID(env, hypo_class, "<init>", "(Ljava/lang/Object;J)V");++ size_t n_hypos = gu_seq_length(tp->hypos);+ jobjectArray jhypos = (*env)->NewObjectArray(env, n_hypos, hypo_class, NULL);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo *hypo = gu_seq_index(tp->hypos, PgfHypo, i);+ jobject jhypo = (*env)->NewObject(env, hypo_class, constrId, self, p2l(hypo));+ (*env)->SetObjectArrayElement(env, jhypos, i, jhypo);+ (*env)->DeleteLocalRef(env, jhypo);+ }+ return jhypos;+}++JNIEXPORT jobject JNICALL +Java_org_grammaticalframework_pgf_Type_readType(JNIEnv* env, jclass clazz, jstring s)+{+ GuPool* pool = gu_new_pool();++ GuPool* tmp_pool = gu_local_pool();+ GuString buf = j2gu_string(env, s, tmp_pool);+ GuIn* in = gu_data_in((uint8_t*) buf, strlen(buf), tmp_pool);+ GuExn* err = gu_exn(tmp_pool);++ PgfType* ty = pgf_read_type(in, pool, tmp_pool, err);+ if (!gu_ok(err)) {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The type cannot be parsed");+ gu_pool_free(tmp_pool);+ gu_pool_free(pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jclass pool_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Pool");+ jmethodID pool_constrId = (*env)->GetMethodID(env, pool_class, "<init>", "(J)V");+ jobject jpool = (*env)->NewObject(env, pool_class, pool_constrId, p2l(pool));++ jmethodID constrId = (*env)->GetMethodID(env, clazz, "<init>", "(Ljava/lang/Object;J)V");+ return (*env)->NewObject(env, clazz, constrId, jpool, p2l(ty));+}++JNIEXPORT jstring JNICALL+Java_org_grammaticalframework_pgf_Type_toString(JNIEnv* env, jobject self)+{+ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_print_type(get_ref(env, self), NULL, 0, out, err);++ jstring jstr = gu2j_string_buf(env, sbuf);++ gu_pool_free(tmp_pool);+ return jstr;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_Hypo_getType(JNIEnv* env, jobject self)+{+ PgfHypo* hypo = get_ref(env, self);++ jclass type_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Type");+ jmethodID constrId = (*env)->GetMethodID(env, type_class, "<init>", "(Ljava/lang/Object;J)V");+ jobject jtype = (*env)->NewObject(env, type_class, constrId, self, p2l(hypo->type));++ return jtype;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_Generator_generateAll(JNIEnv* env, jclass clazz, jobject jpgf, jstring jstartCat)+{+ GuPool* pool = gu_new_pool();+ GuPool* out_pool = gu_new_pool();+ GuString startCat = j2gu_string(env, jstartCat, pool);+ GuExn* err = gu_exn(pool);++ PgfType* type = gu_new_flex(pool, PgfType, exprs, 0);+ type->hypos = gu_empty_seq();+ type->cid = startCat;+ type->n_exprs = 0;++ GuEnum* res =+ pgf_generate_all(get_ref(env, jpgf), type, err, pool, out_pool);+ if (res == NULL) {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The generation failed");+ gu_pool_free(pool);+ return NULL;+ }++ jclass expiter_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/ExprIterator");+ jmethodID constrId = (*env)->GetMethodID(env, expiter_class, "<init>", "(Lorg/grammaticalframework/pgf/PGF;JJJ)V");+ jobject jexpiter = (*env)->NewObject(env, expiter_class, constrId, jpgf, p2l(pool), p2l(out_pool), p2l(res));++ return jexpiter;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_compute(JNIEnv* env, jobject self, jobject jexpr)+{+ GuPool* pool = gu_new_pool();+ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ PgfExpr res =+ pgf_compute(get_ref(env, self), gu_variant_from_ptr((void*) get_ref(env, jexpr)), err, tmp_pool, pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be computed");+ }+ gu_pool_free(tmp_pool);+ gu_pool_free(pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jclass pool_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Pool");+ jmethodID pool_constrId = (*env)->GetMethodID(env, pool_class, "<init>", "(J)V");+ jobject jpool = (*env)->NewObject(env, pool_class, pool_constrId, p2l(pool));++ jclass expr_class = (*env)->GetObjectClass(env, jexpr);+ jmethodID constrId = (*env)->GetMethodID(env, expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");+ jexpr = (*env)->NewObject(env, expr_class, constrId, jpool, NULL, p2l(gu_variant_to_ptr(res)));++ return jexpr;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_inferExpr(JNIEnv* env, jobject self, jobject jexpr)+{+ GuPool* pool = gu_new_pool();+ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ PgfExpr expr =+ gu_variant_from_ptr((void*) get_ref(env, jexpr));+ PgfType* tp =+ pgf_infer_expr(get_ref(env, self), &expr, err, pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else if (gu_exn_caught(err, PgfTypeError)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/TypeError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The type cannot be inferred");+ }+ gu_pool_free(tmp_pool);+ gu_pool_free(pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jclass pool_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Pool");+ jmethodID pool_constrId = (*env)->GetMethodID(env, pool_class, "<init>", "(J)V");+ jobject jpool = (*env)->NewObject(env, pool_class, pool_constrId, p2l(pool));++ jclass expr_class = (*env)->GetObjectClass(env, jexpr);+ jmethodID expr_constrId = (*env)->GetMethodID(env, expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");+ jexpr = (*env)->NewObject(env, expr_class, expr_constrId, jpool, NULL, p2l(gu_variant_to_ptr(expr)));++ jclass type_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Type");+ jmethodID type_constrId = (*env)->GetMethodID(env, type_class, "<init>", "(Ljava/lang/Object;J)V");+ jobject jtype = (*env)->NewObject(env, type_class, type_constrId, jpool, p2l(tp));+ + jclass typed_expr_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/TypedExpr");+ jmethodID typed_expr_constrId = (*env)->GetMethodID(env, typed_expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Expr;Lorg/grammaticalframework/pgf/Type;)V");+ jobject jtyped_expr = (*env)->NewObject(env, typed_expr_class, typed_expr_constrId, jexpr, jtype);++ return jtyped_expr;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_pgf_PGF_checkExpr(JNIEnv* env, jobject self, jobject jexpr, jobject jtp)+{+ GuPool* pool = gu_new_pool();+ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ PgfExpr expr =+ gu_variant_from_ptr((void*) get_ref(env, jexpr));+ PgfType* tp =+ get_ref(env, jtp);+ pgf_check_expr(get_ref(env, self), &expr, tp, err, pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", msg);+ } else if (gu_exn_caught(err, PgfTypeError)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ throw_string_exception(env, "org/grammaticalframework/pgf/TypeError", msg);+ } else {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The type cannot be inferred");+ }+ gu_pool_free(tmp_pool);+ gu_pool_free(pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jclass pool_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Pool");+ jmethodID pool_constrId = (*env)->GetMethodID(env, pool_class, "<init>", "(J)V");+ jobject jpool = (*env)->NewObject(env, pool_class, pool_constrId, p2l(pool));++ jclass expr_class = (*env)->GetObjectClass(env, jexpr);+ jmethodID expr_constrId = (*env)->GetMethodID(env, expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");+ jexpr = (*env)->NewObject(env, expr_class, expr_constrId, jpool, NULL, p2l(gu_variant_to_ptr(expr)));++ return jexpr;+}
@@ -0,0 +1,339 @@+#include <jni.h>+#include <sg/sg.h>+#include <pgf/expr.h>+#include <pgf/linearizer.h>+#include "jni_utils.h"++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_sg_SG_openSG(JNIEnv *env, jclass cls, jstring path)+{+ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ const char *fpath = (*env)->GetStringUTFChars(env, path, 0); ++ // Read the PGF grammar.+ SgSG* sg = sg_open(fpath, err);++ (*env)->ReleaseStringUTFChars(env, path, fpath);++ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The database cannot be opened";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jmethodID constrId = (*env)->GetMethodID(env, cls, "<init>", "(J)V");+ return (*env)->NewObject(env, cls, constrId, p2l(sg));+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_sg_SG_close(JNIEnv *env, jobject self)+{+ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ sg_close(get_ref(env, self), err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The database cannot be closed";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(tmp_pool);+ return;+ }++ gu_pool_free(tmp_pool);+}++JNIEXPORT jobjectArray JNICALL +Java_org_grammaticalframework_sg_SG_readTriple(JNIEnv *env, jclass cls, jstring s)+{+ GuPool* pool = gu_new_pool();+ + GuPool* tmp_pool = gu_local_pool();+ GuString buf = j2gu_string(env, s, tmp_pool);+ GuIn* in = gu_data_in((uint8_t*) buf, strlen(buf), tmp_pool);+ GuExn* err = gu_exn(tmp_pool);++ const int len = 3;++ PgfExpr exprs[len];+ int res = pgf_read_expr_tuple(in, 3, exprs, pool, err);+ if (!gu_ok(err) || res == 0) {+ throw_string_exception(env, "org/grammaticalframework/pgf/PGFError", "The expression cannot be parsed");+ gu_pool_free(tmp_pool);+ gu_pool_free(pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jclass pool_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Pool");+ jmethodID pool_constrId = (*env)->GetMethodID(env, pool_class, "<init>", "(J)V");+ jobject jpool = (*env)->NewObject(env, pool_class, pool_constrId, p2l(pool));++ jclass expr_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Expr");+ jmethodID expr_constrId = (*env)->GetMethodID(env, expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");++ jobjectArray array = (*env)->NewObjectArray(env, len, expr_class, NULL);+ for (int i = 0; i < len; i++) {+ jobject obj = (*env)->NewObject(env, expr_class, expr_constrId, jpool, NULL, p2l(gu_variant_to_ptr(exprs[i])));+ (*env)->SetObjectArrayElement(env, array, i, obj);+ (*env)->DeleteLocalRef(env, obj);+ }++ return array;+}++JNIEXPORT jobject JNICALL+Java_org_grammaticalframework_sg_SG_queryTriple(JNIEnv *env, jobject self,+ jobject jsubj,+ jobject jpred,+ jobject jobj)+{+ SgSG *sg = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ SgTriple triple;+ triple[0] = (jsubj == NULL) ? gu_null_variant+ : gu_variant_from_ptr((void*) get_ref(env, jsubj));+ triple[1] = (jpred == NULL) ? gu_null_variant+ : gu_variant_from_ptr((void*) get_ref(env, jpred));+ triple[2] = (jobj == NULL) ? gu_null_variant+ : gu_variant_from_ptr((void*) get_ref(env, jobj));+ + SgTripleResult* res = sg_query_triple(sg, triple, err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The query failed";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ jclass res_class = (*env)->FindClass(env, "org/grammaticalframework/sg/TripleResult");+ jmethodID constrId = (*env)->GetMethodID(env, res_class, "<init>", "(JLorg/grammaticalframework/pgf/Expr;Lorg/grammaticalframework/pgf/Expr;Lorg/grammaticalframework/pgf/Expr;)V");+ jobject jres = (*env)->NewObject(env, res_class, constrId, p2l(res), jsubj, jpred, jobj);++ return jres;+}++JNIEXPORT jboolean JNICALL+Java_org_grammaticalframework_sg_TripleResult_hasNext(JNIEnv *env, jobject self)+{+ SgTripleResult *res = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();+ GuPool* out_pool = gu_new_pool();+ GuExn* err = gu_exn(tmp_pool);++ SgId key;+ SgTriple triple;+ int r = sg_triple_result_fetch(res, &key, triple, out_pool, err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The fetch failed";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(out_pool);+ gu_pool_free(tmp_pool);+ return JNI_FALSE;+ }++ gu_pool_free(tmp_pool);++ if (r) {+ SgTriple orig_triple;+ sg_triple_result_get_query(res, orig_triple);++ jclass pool_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Pool");+ jmethodID pool_constrId = (*env)->GetMethodID(env, pool_class, "<init>", "(J)V");+ jobject jpool = (*env)->NewObject(env, pool_class, pool_constrId, p2l(out_pool));++ jclass expr_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Expr");+ jmethodID constrId = (*env)->GetMethodID(env, expr_class, "<init>", "(Lorg/grammaticalframework/pgf/Pool;Ljava/lang/Object;J)V");++ jclass result_class = (*env)->GetObjectClass(env, self);++ jfieldID keyId = (*env)->GetFieldID(env, result_class, "key", "J");+ (*env)->SetLongField(env, self, keyId, key);++ if (triple[0] != orig_triple[0]) {+ jfieldID subjId = (*env)->GetFieldID(env, result_class, "subj", "Lorg/grammaticalframework/pgf/Expr;");+ jobject jsubj = (*env)->NewObject(env, expr_class, constrId, jpool, jpool, p2l(gu_variant_to_ptr(triple[0])));+ (*env)->SetObjectField(env, self, subjId, jsubj);+ }++ if (triple[1] != orig_triple[1]) {+ jfieldID predId = (*env)->GetFieldID(env, result_class, "pred", "Lorg/grammaticalframework/pgf/Expr;");+ jobject jpred = (*env)->NewObject(env, expr_class, constrId, jpool, jpool, p2l(gu_variant_to_ptr(triple[1])));+ (*env)->SetObjectField(env, self, predId, jpred);+ }++ if (triple[2] != orig_triple[2]) {+ jfieldID objId = (*env)->GetFieldID(env, result_class, "obj", "Lorg/grammaticalframework/pgf/Expr;");+ jobject jobj = (*env)->NewObject(env, expr_class, constrId, jpool, jpool, p2l(gu_variant_to_ptr(triple[2])));+ (*env)->SetObjectField(env, self, objId, jobj);+ }++ return JNI_TRUE;+ } else {+ gu_pool_free(out_pool);+ return JNI_FALSE;+ }+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_sg_TripleResult_close(JNIEnv *env, jobject self)+{+ SgTripleResult *res = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);+ + sg_triple_result_close(res, err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "Closing the result failed";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ }++ gu_pool_free(tmp_pool);+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_sg_SG_beginTrans(JNIEnv *env, jobject self)+{+ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ sg_begin_trans(get_ref(env, self), err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The transaction cannot be started";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(tmp_pool);+ return;+ }++ gu_pool_free(tmp_pool);+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_sg_SG_commit(JNIEnv *env, jobject self)+{+ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ sg_commit(get_ref(env, self), err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The transaction cannot be commited";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(tmp_pool);+ return;+ }++ gu_pool_free(tmp_pool);+}++JNIEXPORT void JNICALL+Java_org_grammaticalframework_sg_SG_rollback(JNIEnv *env, jobject self)+{+ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_exn(tmp_pool);++ sg_rollback(get_ref(env, self), err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The transaction cannot be rolled back";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(tmp_pool);+ return;+ }++ gu_pool_free(tmp_pool);+}++JNIEXPORT jlong JNICALL+Java_org_grammaticalframework_sg_SG_insertTriple(JNIEnv *env, jobject self,+ jobject jsubj,+ jobject jpred,+ jobject jobj)+{+ SgSG *sg = get_ref(env, self);++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ SgTriple triple;+ triple[0] = gu_variant_from_ptr((void*) get_ref(env, jsubj));+ triple[1] = gu_variant_from_ptr((void*) get_ref(env, jpred));+ triple[2] = gu_variant_from_ptr((void*) get_ref(env, jobj));++ SgId id = sg_insert_triple(sg, triple, err);+ if (!gu_ok(err)) {+ GuString msg;+ if (gu_exn_caught(err, SgError)) {+ msg = (GuString) gu_exn_caught_data(err);+ } else {+ msg = "The insertion failed";+ }+ throw_string_exception(env, "org/grammaticalframework/sg/SGError", msg);+ gu_pool_free(tmp_pool);+ return 0;+ }++ gu_pool_free(tmp_pool);++ return id;+}
@@ -0,0 +1,8 @@+package org.grammaticalframework.pgf;++public class BIND {+ private BIND() {+ }+ + public static final BIND instance = new BIND();+}
@@ -0,0 +1,31 @@+package org.grammaticalframework.pgf;++/** A bracket represents a syntactic constituent in the parse tree+ * of a sentence. */+public class Bracket {+ /** The category of this bracket */+ public final String cat;+ + /** The abstract function name for the bracket */+ public final String fun;+ + /** Every constituent has an unique id. If the constituent is+ * discontinuous then it will be represented with several brackets+ * where they all will have the same id */+ public final int fid;++ public final int lindex;+ + /** The children of the bracket. Every element is either a string+ * if this is a leaf in the parse tree, or a {@link Bracket} object.+ */+ public final Object[] children;++ public Bracket(String cat, String fun, int fid, int lindex, Object[] children) {+ this.cat = cat;+ this.fun = fun;+ this.fid = fid;+ this.lindex = lindex;+ this.children = children;+ }+}
@@ -0,0 +1,37 @@+package org.grammaticalframework.pgf;++import java.util.*;++class Completer implements Iterable<TokenProb> {+ private Concr concr;+ private String s;+ private String prefix;+ private String startCat;+ private TokenIterator iter;++ public Completer(Concr concr, String startCat, String s, String prefix) throws ParseError {+ this.concr = concr;+ this.startCat = startCat;+ this.s = s;+ this.prefix = prefix;+ this.iter = complete(concr, startCat, s, prefix);+ }++ public Iterator<TokenProb> iterator() {+ if (iter == null) {+ // If someone has asked for a second iterator over+ // the same parse results then we have to parse again.+ try {+ return complete(concr, startCat, s, prefix);+ } catch (ParseError e) {+ return null;+ }+ } else {+ TokenIterator tmp_iter = iter;+ iter = null;+ return tmp_iter;+ }+ }++ static native TokenIterator complete(Concr concr, String startCat, String s, String prefix) throws ParseError;+}
@@ -0,0 +1,126 @@+package org.grammaticalframework.pgf;++import java.io.*;+import java.util.*;++/** The class for concrete syntaxes.*/+public class Concr {++ public native String getName();++ /** Parses a string with a given start category.+ * @param startCat the start category.+ * @param s the input string+ * @return an iterable over all abstract expressions for the input+ * string. The expressions are enumerated in decreasing probability order.+ */+ public Iterable<ExprProb> parse(String startCat, String s) throws ParseError {+ return new Parser(this, startCat, s, -1, null);+ }++ /** Parses a string with a given start category and specific+ * setup of some other parameters.+ * @param startCat the start category.+ * @param s the input string+ * @param heuristics this is a number from 0.0 to 1.0. Zero means+ * slower parsing but with accurate order of the expressions. + * One means fast but potentially inaccurate ordering of the expressions.+ * @param callbacks a map which assigns a callback to each literal category+ * in the grammar. The callbacks can be used to add custom parsing+ * rules for certain categories.+ * @return an iterable over all abstract expressions for the input+ * string. The expressions are enumerated in decreasing probability order.+ */+ public Iterable<ExprProb> parseWithHeuristics(String startCat, String s, double heuristics, Map<String,LiteralCallback> callbacks) throws ParseError {+ return new Parser(this, startCat, s, heuristics, callbacks);+ }++ public Iterable<TokenProb> complete(String startCat, String s, String prefix) throws ParseError {+ return new Completer(this, startCat, s, prefix);+ }++ public Iterable<ExprProb> lookupSentence(String startCat, String s) {+ return new SentenceExtractor(this, startCat, s);+ }++ /** Computes the linearization of the abstract expression. */+ public native String linearize(Expr expr);++ /** Computes all linearizations of the abstract expression and returns an iterator over the alternatives. */+ public native Iterable<String> linearizeAll(Expr expr);++ /** Linearizes the expression as an inflection table.+ * @return a map from the name of the inflection form to its value.+ */+ public native Map<String, String> tabularLinearize(Expr expr);++ /** Computes the bracketed string for the linearization of the expression.+ * @return an array of objects where each element is either a string+ * or a {@link Bracket} object.+ */+ public native Object[] bracketedLinearize(Expr expr);++ /** Takes a word form or a multilingual expression and+ * returns a list of its possible analyses according to the lexicon+ * in the grammar. This method is doing just lexical lookup + * without parsing.+ * + * @param sentence the word form or the multilingual expression.+ */+ public native List<MorphoAnalysis> lookupMorpho(String sentence);+ + /** Creates an iterable over the full form lexicon in the grammar */+ public Iterable<FullFormEntry> fullFormLexicon() {+ return new Lexicon(this, null);+ }++ /** Returns an iterable enumerating all words in the lexicon+ * starting with a given prefix.+ * @param prefix the prefix of the word.+ */+ public Iterable<FullFormEntry> lookupWordPrefix(String prefix) {+ return new Lexicon(this, prefix);+ }++ /** returns true if a given function has linearization in this+ * concrete syntax.+ * @param fun the name of the function+ */+ public native boolean hasLinearization(String fun);++ public native String graphvizParseTree(Expr expr);++ /** returns the print name for that function or category.+ */+ public native String getPrintName(String id);++ /** If the concrete syntaxes in the grammar are stored in external+ * files then this method can be used to load the current syntax+ * in memory.+ * @param path the path to the concrete syntax file.+ */+ public native void load(String path) throws FileNotFoundException;++ /** If the concrete syntaxes in the grammar are stored in external+ * files then this method can be used to load the current syntax+ * in memory.+ * @param stream the stream from which to load the file.+ */+ public native void load(InputStream stream);++ /** When the syntax is no longer needed then this method can be+ * used to unload it.+ */+ public native void unload();++ //////////////////////////////////////////////////////////////////+ // private stuff+ + private PGF gr;+ private long ref;++ private Concr(PGF gr, long ref) {+ this.gr = gr;+ this.ref = ref;+ }+}
@@ -0,0 +1,146 @@+package org.grammaticalframework.pgf;++import java.io.IOException;+import java.io.ObjectInputStream;+import java.io.ObjectOutputStream;+import java.io.Serializable;+import java.util.Arrays;++/** This class is a representation of an abstract syntax tree.+ */+public class Expr implements Serializable {+ private static final long serialVersionUID = 1148602474802492674L;+ + private Pool pool;+ private Object master;+ private long ref;++ Expr(Pool pool, Object master, long ref) {+ this.pool = pool;+ this.master = master;+ this.ref = ref;+ }++ /** Constructs an expression which represents a string literal */+ public Expr(String s) {+ if (s == null)+ throw new IllegalArgumentException("s == null");++ this.pool = new Pool();+ this.master = null;+ this.ref = initStringLit(s, pool.ref); + }++ /** Constructs an expression which represents an integer literal */+ public Expr(int d) {+ this.pool = new Pool();+ this.master = null;+ this.ref = initIntLit(d, pool.ref); + }++ /** Constructs an expression which represents a floating point literal */+ public Expr(double f) {+ this.pool = new Pool();+ this.master = null;+ this.ref = initFloatLit(f, pool.ref); + }++ /** Constructs an expression which is a function application+ * @param fun The name of the top-level function.+ * @param args the arguments for the function.+ */+ public Expr(String fun, Expr... args) {+ if (fun == null)+ throw new IllegalArgumentException("fun == null");+ for (int i = 0; i < args.length; i++) {+ if (args[i] == null)+ throw new IllegalArgumentException("the "+(i+1)+"th argument is null");+ }++ this.pool = new Pool();+ this.master = args;+ this.ref = initApp(fun, args, pool.ref);+ }++ /** Constructs an expression which is an application+ * of the first expression to a list of arguments.+ */+ public static Expr apply(Expr fun, Expr... args) {+ if (fun == null)+ throw new IllegalArgumentException("fun == null");+ for (int i = 0; i < args.length; i++) {+ if (args[i] == null)+ throw new IllegalArgumentException("the "+(i+1)+"th argument is null");+ }++ Object[] master = new Object[args.length+1];+ master[0] = fun;+ for (int i = 0; i < args.length; i++) {+ master[i+1] = args[i].master;+ }++ Pool pool = new Pool();+ return new Expr(pool, master, initApp(fun, args, pool.ref));+ }++ /** If the method is called on an expression which is + * a function application, then it is decomposed into + * a function name and a list of arguments. If this is not + * an application then the result is null. */+ public native ExprApplication unApp();++ /** If the method is called on an expression which is + * a meta variable, then it will return the variable's id.+ * If this is not a meta variable then the result is -1. */+ public native int unMeta();+ + /** If the method is called on an expression which is + * a string literal, then it will return the string value.+ * If this is not a string literal then the result is null. */+ public native String unStr();++ /** An implementation for the visitor pattern. The method uses+ * reflection to find the relevant methods from the visitor object */+ public native void visit(Object visitor);++ /** Returns the expression as a string in the GF syntax */+ public String toString() {+ return showExpr(ref);+ }++ /** Computes the number of functions in the expression */+ public native int size();++ /** Reads a string in the GF syntax for abstract expressions+ * and returns an object representing the expression. */+ public static native Expr readExpr(String s) throws PGFError;++ /** Compares the current expression with another expression by value. + * @return True if the expressions are equal. */+ public native boolean equals(Object e);++ public native int hashCode();++ private static native String showExpr(long ref);++ private static native long initStringLit(String s, long pool);+ private static native long initIntLit(int d, long pool);+ private static native long initFloatLit(double f, long pool);+ private static native long initApp(Expr fun, Expr[] args, long pool);+ private static native long initApp(String fun, Expr[] args, long pool);++ private void writeObject(ObjectOutputStream out) throws IOException {+ out.writeObject(showExpr(ref));+ }+ + private void readObject(ObjectInputStream in) throws IOException, ClassNotFoundException {+ Expr e = readExpr((String) in.readObject());+ pool = e.pool;+ master = e.master;+ ref = e.ref;+ }+ + static { + System.loadLibrary("jpgf");+ }+}
@@ -0,0 +1,19 @@+package org.grammaticalframework.pgf;++public class ExprApplication {+ private String fun;+ private Expr[] arguments;++ public ExprApplication(String fun, Expr[] arguments) {+ this.fun = fun;+ this.arguments = arguments;+ }+ + public String getFunction() {+ return fun;+ }+ + public Expr[] getArguments() {+ return arguments;+ }+}
@@ -0,0 +1,47 @@+package org.grammaticalframework.pgf;++import java.util.*;++class ExprIterator implements Iterator<ExprProb> {+ private PGF gr;+ private Pool pool, out_pool;+ private long ref;+ private ExprProb ep;+ private boolean fetched;++ public ExprIterator(PGF gr, Pool pool, long out_pool, long ref) {+ this.gr = gr;+ this.pool = pool;+ this.out_pool = new Pool(out_pool);+ this.ref = ref;+ this.ep = null;+ this.fetched = false;+ }++ private native static ExprProb fetchExprProb(long ref, Pool pool, PGF gr);++ private void fetch() {+ if (!fetched) {+ ep = fetchExprProb(ref, out_pool, gr);+ fetched = true;+ }+ }++ public boolean hasNext() {+ fetch();+ return (ep != null);+ }++ public ExprProb next() {+ fetch();+ fetched = false;+ + if (ep == null)+ throw new NoSuchElementException();+ return ep;+ }++ public void remove() {+ throw new UnsupportedOperationException();+ }+}
@@ -0,0 +1,31 @@+package org.grammaticalframework.pgf;++import java.io.Serializable;++/** Simply a pair of an expression and a probability value. */+public class ExprProb implements Serializable {+ private static final long serialVersionUID = -3112602244416576742L;++ private Expr expr;+ private double prob;++ public ExprProb(Expr expr, double prob) {+ this.expr = expr;+ this.prob = prob;+ }+ + @SuppressWarnings("unused")+ private static ExprProb mkExprProb(Pool pool, PGF gr, long expr, double prob) {+ return new ExprProb(new Expr(pool, gr, expr), prob);+ }+ + /** Returns the expression. */+ public Expr getExpr() {+ return expr;+ }++ /** Returns the negative logarithmic probability. */+ public double getProb() {+ return prob;+ }+}
@@ -0,0 +1,31 @@+package org.grammaticalframework.pgf;++import java.util.List;++/** This is the class for entries in the full-form lexicon of the grammar*/+public class FullFormEntry {+ private String form;+ private double prob;+ private List<MorphoAnalysis> analyses;++ public FullFormEntry(String form, double prob, List<MorphoAnalysis> analyses) {+ this.form = form;+ this.prob = prob;+ this.analyses = analyses;+ }++ /** This is the word form. */+ public String getForm() {+ return form;+ }++ /** This is its negative logarithmic probability. */+ public double getProb() {+ return prob;+ }++ /** This is the list of possible morphological analyses. */+ public List<MorphoAnalysis> getAnalyses() {+ return analyses;+ }+}
@@ -0,0 +1,50 @@+package org.grammaticalframework.pgf;++import java.util.Iterator;+import java.util.NoSuchElementException;++class FullFormIterator implements Iterator<FullFormEntry> {+ private Concr concr;+ private Pool pool;+ private long ref;+ private FullFormEntry entry;+ private boolean fetched;++ public FullFormIterator(Concr concr, long pool, long ref) {+ this.concr = concr;+ this.pool = new Pool(pool);+ this.ref = ref;+ this.entry = null;+ this.fetched = false;+ }++ private native static FullFormEntry fetchFullFormEntry(long ref, Pool pool, Concr concr);++ private void fetch() {+ if (!fetched) {+ entry = fetchFullFormEntry(ref, pool, concr);+ fetched = true;+ }+ }++ @Override+ public boolean hasNext() {+ fetch();+ return (entry != null);+ }++ @Override+ public FullFormEntry next() {+ fetch();+ fetched = false;+ + if (entry == null)+ throw new NoSuchElementException();+ return entry;+ }++ @Override+ public void remove() {+ throw new UnsupportedOperationException();+ }+}
@@ -0,0 +1,29 @@+package org.grammaticalframework.pgf;++import java.util.Iterator;++class Generator implements Iterable<ExprProb> {+ private PGF gr;+ private String startCat;+ private ExprIterator iter;++ public Generator(PGF gr, String startCat) {+ this.gr = gr;+ this.startCat = startCat;+ this.iter = generateAll(gr, startCat);+ }++ public Iterator<ExprProb> iterator() {+ if (iter == null) {+ // If someone has asked for a second iterator over+ // the same results then we have to generate again.+ return generateAll(gr, startCat);+ } else {+ ExprIterator tmp_iter = iter;+ iter = null;+ return tmp_iter;+ }+ }++ private native static ExprIterator generateAll(PGF gr, String startCat);+}
@@ -0,0 +1,22 @@+package org.grammaticalframework.pgf;++public class Hypo {+ public native boolean getBindType();+ + /** The name of the bound variable or '_' if there is none */+ public native String getVariable();+ + /** The type for this hypothesis */+ public native Type getType();++ //////////////////////////////////////////////////////////////////+ // private stuff++ private Object master;+ private long ref;++ private Hypo(Object master, long ref) {+ this.master = master;+ this.ref = ref;+ }+}
@@ -0,0 +1,29 @@+package org.grammaticalframework.pgf;++import java.util.Iterator;++class Lexicon implements Iterable<FullFormEntry> {+ private Concr concr;+ private String prefix;+ private FullFormIterator iter;++ public Lexicon(Concr concr, String prefix) {+ this.concr = concr;+ this.prefix = prefix;+ this.iter = lookupWordPrefix(concr, prefix);+ }++ public Iterator<FullFormEntry> iterator() {+ if (iter == null) {+ // If someone has asked for a second iterator over+ // the same parse results then we have to parse again.+ return lookupWordPrefix(concr, prefix);+ } else {+ FullFormIterator tmp_iter = iter;+ iter = null;+ return tmp_iter;+ }+ }++ static private native FullFormIterator lookupWordPrefix(Concr concr, String prefix);+}
@@ -0,0 +1,27 @@+package org.grammaticalframework.pgf;++import java.util.Iterator;++public interface LiteralCallback {+ public CallbackResult match(int lin_idx, int start_offset);++ public Iterator<TokenProb> predict(int lin_idx, String prefix);++ public static class CallbackResult {+ private ExprProb ep;+ private int offset;+ + public CallbackResult(ExprProb ep, int offset) {+ this.ep = ep;+ this.offset = offset;+ }+ + public ExprProb getExprProb() {+ return ep;+ }+ + public int getOffset() {+ return offset;+ }+ }+}
@@ -0,0 +1,35 @@+package org.grammaticalframework.pgf;++import java.io.Serializable;++/** The class represents a possible morphological analysis of+ * a word from the lexicon in the grammar+ */+public class MorphoAnalysis implements Serializable {+ private static final long serialVersionUID = 1L;++ private String lemma;+ private String field;+ private double prob;++ public MorphoAnalysis(String lemma, String field, double prob) {+ this.lemma = lemma;+ this.field = field;+ this.prob = prob;+ }+ + /** The lemma, i.e. the abstract function name in the lexicon. */+ public String getLemma() {+ return lemma;+ }++ /** The name of the slot in the inflection table for the lemma. */+ public String getField() {+ return field;+ }++ /** Returns the negative logarithmic probability. */+ public double getProb() {+ return prob;+ }+}
@@ -0,0 +1,89 @@+package org.grammaticalframework.pgf;++import java.util.Collections;+import java.util.Iterator;++/** A callback for recognizing names. A name is a sequence of tokens+ * starting with capital letters. The callback constructs an expression+ * which is an abstract function name, if the name is in the lexicon.+ * If it is not then the result is (SymbPN (MkSymb "<name>")).+ */+public class NercLiteralCallback implements LiteralCallback {+ private PGF pgf;+ private Concr concr;+ private String sentence;++ public NercLiteralCallback(PGF pgf, Concr concr, String sentence) {+ this.pgf = pgf;+ this.concr = concr;+ this.sentence = sentence;+ }++ public CallbackResult match(int lin_idx, int offset) {+ StringBuilder sbuilder = new StringBuilder();++ int i = 0;+ int end_offset = offset;+ while (offset < sentence.length() &&+ Character.isUpperCase(sentence.charAt(offset))) {+ if (i > 0)+ sbuilder.append(' ');+ i++;++ while (offset < sentence.length() &&+ !Character.isWhitespace(sentence.charAt(offset))) {+ sbuilder.append(sentence.charAt(offset));+ offset++;+ }++ end_offset = offset;+ while (offset < sentence.length() &&+ Character.isWhitespace(sentence.charAt(offset))) {+ offset++;+ }+ }++ if (i > 0) {+ String name = sbuilder.toString();++ if (concr.getName().contains("Eng") &&+ ("I".equals(name) || "I'm".equals(name))) {+ return null;+ }++ Expr expr = null;+ double prob = 0;+ for (MorphoAnalysis an : concr.lookupMorpho(name)) {+ String cat = pgf.getFunctionType(an.getLemma()).getCategory();+ if (prob < an.getProb()) {+ if ("PN".equals(cat)) {+ expr = new Expr(an.getLemma(), new Expr[0]);+ prob = an.getProb();+ } else if ("Weekday".equals(cat)) {+ expr = new Expr(an.getLemma(), new Expr[0]);+ expr = new Expr("weekdayPN", expr);+ } else if ("Month".equals(cat)) {+ expr = new Expr(an.getLemma(), new Expr[0]);+ expr = new Expr("monthPN", expr);+ } else {+ return null;+ }+ }+ }++ if (expr == null) {+ expr = new Expr(name);+ expr = new Expr("MkSymb", expr);+ expr = new Expr("SymbPN", expr);+ }++ return new CallbackResult(new ExprProb(expr, 0), end_offset);+ }++ return null;+ }+ + public Iterator<TokenProb> predict(int lin_idx, String prefix) {+ return Collections.<TokenProb>emptyList().iterator();+ }+}
@@ -0,0 +1,90 @@+package org.grammaticalframework.pgf;++import java.io.*;+import java.util.*;++/** This is the class for PGF grammars.*/+public class PGF {+ /** Reads a grammar with the specified file path.+ * @param path The path to the file.+ * @return an object representing the grammar in memory. */+ public static native PGF readPGF(String path) throws FileNotFoundException;++ /** Reads a grammar from an input stream.+ * @param stream The stream from which to read the grammar+ * @return an object representing the grammar in memory. */+ public static native PGF readPGF(InputStream stream);++ /** Returns the name of the abstract syntax for the grammar */+ public native String getAbstractName();++ /** Returns a map from a name of a concrete syntax to + * a {@link Concr} object for the syntax. */+ public native Map<String,Concr> getLanguages();++ /** Returns a list of with all categories in the grammar */+ public native List<String> getCategories();+ + /** The name of the start category for the grammar. This is usually+ * specified with 'params startcat=<cat>'.+ */+ public native String getStartCat();+ + /** Returns a list with all functions in the grammar. */+ public native List<String> getFunctions();+ + /** Returns a list with all functions with a given return category.+ * @param cat The name of the return category. */+ public native List<String> getFunctionsByCat(String cat);+ + /** Returns the type of the function with the given name.+ * @param fun The name of the function.+ */+ public native Type getFunctionType(String fun);++ /** Returns the negative logarithmic probability of the function+ * with the given name.+ * @param fun The name of the function.+ */+ public native double getFunctionProb(String fun);++ /** Returns an iterable over the set of all expression in+ * the given category. The expressions are enumerated in decreasing+ * probability order.+ */+ public Iterable<ExprProb> generateAll(String startCat) {+ return new Generator(this, startCat);+ }++ /** Normalizes an expression to its normal form by using the 'def'+ * rules in the grammar.+ * + * @param expr the original expression.+ * @return the normalized expression.+ */+ public native Expr compute(Expr expr);++ /** Takes an expression and returns a refined version+ * of the expression together with its type */+ public native TypedExpr inferExpr(Expr expr) throws TypeError;+ + /** Takes an expression and checks it agains a type. The returned expression+ * is a possibly refined version of the original. */+ public native Expr checkExpr(Expr expr, Type ty) throws TypeError;++ public native String graphvizAbstractTree(Expr expr);++ //////////////////////////////////////////////////////////////////+ // private stuff+ private Pool pool;+ private long ref;++ private PGF(long pool, long ref) {+ this.pool = new Pool(pool);+ this.ref = ref;+ }+ + static { + System.loadLibrary("jpgf");+ }+}
@@ -0,0 +1,10 @@+package org.grammaticalframework.pgf;++/** This exception is thrown when some grammatical operation fails. */+public class PGFError extends RuntimeException {+ private static final long serialVersionUID = -5098784200043861938L;++ public PGFError(String message) {+ super(message);+ }+}
@@ -0,0 +1,29 @@+package org.grammaticalframework.pgf;++/** This exception is thrown when parsing a string fails. */+public class ParseError extends Exception {+ private static final long serialVersionUID = -6086991674218306569L;++ private String token;+ private int offset;+ private boolean incomplete;++ public ParseError(String token, int offset, boolean incomplete) {+ super(incomplete ? "The sentence is incomplete" : "Unexpected token: \""+token+"\"");+ this.token = token;+ this.offset = offset;+ this.incomplete = incomplete;+ }++ public String getToken() {+ return token;+ }++ public int getOffset() {+ return offset;+ }+ + public boolean isIncomplete() {+ return incomplete;+ }+}
@@ -0,0 +1,57 @@+package org.grammaticalframework.pgf;++import java.util.*;++class Parser implements Iterable<ExprProb> {+ private Concr concr;+ private String s;+ private String startCat;+ private double heuristics;+ private Map<String,LiteralCallback> callbacks;+ private ExprIterator iter;++ public Parser(Concr concr, String startCat, String s,+ double heuristics,+ Map<String,LiteralCallback> callbacks) throws ParseError {+ this.concr = concr;+ this.startCat = startCat;+ this.s = s;+ this.heuristics = heuristics;+ this.callbacks = callbacks;+ this.iter = doParse();+ }++ public Iterator<ExprProb> iterator() {+ if (iter == null) {+ // If someone has asked for a second iterator over+ // the same parse results then we have to parse again.+ try {+ return doParse();+ } catch (ParseError e) {+ return null;+ }+ } else {+ ExprIterator tmp_iter = iter;+ iter = null;+ return tmp_iter;+ }+ }++ private ExprIterator doParse() throws ParseError+ {+ Pool pool = new Pool();+ long callbacksRef = newCallbacksMap(concr, pool);+ if (callbacks != null) {+ for (Map.Entry<String, LiteralCallback> entry : callbacks.entrySet()) {+ addLiteralCallback(concr, callbacksRef, + entry.getKey(), entry.getValue(),+ pool);+ }+ }+ return parseWithHeuristics(concr, startCat, s, heuristics, callbacksRef, pool);+ }++ static native long newCallbacksMap(Concr concr, Pool pool);+ static native void addLiteralCallback(Concr concr, long callbacksRef, String cat, LiteralCallback callback, Pool pool);+ static native ExprIterator parseWithHeuristics(Concr concr, String startCat, String s, double heuristics, long callbacksRef, Pool pool) throws ParseError;+}
@@ -0,0 +1,20 @@+package org.grammaticalframework.pgf;++class Pool {+ final long ref;++ public Pool(long ref) {+ this.ref = ref;+ }++ public Pool() {+ this.ref = alloc();+ }++ public void finalize() {+ free(ref);+ }++ public static native long alloc();+ public static native void free(long ref);+}
@@ -0,0 +1,39 @@+package org.grammaticalframework.pgf;++import java.util.*;++class SentenceExtractor implements Iterable<ExprProb> {+ private Concr concr;+ private String s;+ private String startCat;+ private double heuristics;+ private Map<String,LiteralCallback> callbacks;+ private ExprIterator iter;++ public SentenceExtractor(Concr concr, String startCat, String s) {+ this.concr = concr;+ this.startCat = startCat;+ this.s = s;+ this.iter = doExtract();+ }++ public Iterator<ExprProb> iterator() {+ if (iter == null) {+ // If someone has asked for a second iterator over+ // the same parse results then we have to parse again.+ return doExtract();+ } else {+ ExprIterator tmp_iter = iter;+ iter = null;+ return tmp_iter;+ }+ }++ private ExprIterator doExtract()+ {+ Pool pool = new Pool();+ return lookupSentence(concr, startCat, s, pool);+ }++ static native ExprIterator lookupSentence(Concr concr, String startCat, String s, Pool pool);+}
@@ -0,0 +1,44 @@+package org.grammaticalframework.pgf;++import java.util.*;++class TokenIterator implements Iterator<TokenProb> {+ private Pool pool;+ private long ref;+ private TokenProb tp;+ private boolean fetched;++ public TokenIterator(long pool, long ref) {+ this.pool = new Pool(pool);+ this.ref = ref;+ this.tp = null;+ this.fetched = false;+ }++ private native static TokenProb fetchTokenProb(long ref, Pool pool);++ private void fetch() {+ if (!fetched) {+ tp = fetchTokenProb(ref, pool);+ fetched = true;+ }+ }++ public boolean hasNext() {+ fetch();+ return (tp != null);+ }++ public TokenProb next() {+ fetch();+ fetched = false;+ + if (tp == null)+ throw new NoSuchElementException();+ return tp;+ }++ public void remove() {+ throw new UnsupportedOperationException();+ }+}
@@ -0,0 +1,36 @@+package org.grammaticalframework.pgf;++/** Simply a pair of an expression and a probability value. */+public class TokenProb {+ private String tok;+ private String cat;+ private String fun;+ private double prob;++ public TokenProb(double prob, String tok, String cat, String fun) {+ this.prob = prob;+ this.tok = tok;+ this.cat = cat;+ this.fun = fun;+ }++ /** Returns the negative logarithmic probability. */+ public double getProb() {+ return prob;+ }++ /** Returns the token. */+ public String getToken() {+ return tok;+ }++ /** Returns the category from which this word was predicted. */+ public String getCategory() {+ return cat;+ }+ + /** Returns the function from which this word was predicted. */+ public String getFunction() {+ return fun;+ }+}
@@ -0,0 +1,30 @@+package org.grammaticalframework.pgf;++/** A class for types in the abstract syntax of a grammar */+public class Type {+ /** The category */+ public native String getCategory();+ + /** An array of arguments for the category */+ public native Expr[] getExprs();+ + /** An array of hypotheses if this is a function type. + * If the represented type is A1 -> A2 -> ... An -> B, then+ * the hypotheses represent the types in A1, A2 ... An. */+ public native Hypo[] getHypos();++ public native String toString();+ + public native static Type readType(String s);++ //////////////////////////////////////////////////////////////////+ // private stuff++ private Object master;+ private long ref;++ private Type(Object master, long ref) {+ this.master = master;+ this.ref = ref;+ }+}
@@ -0,0 +1,7 @@+package org.grammaticalframework.pgf;++public class TypeError extends Exception {+ public TypeError(String message) {+ super(message);+ }+}
@@ -0,0 +1,24 @@+package org.grammaticalframework.pgf;++/** This is just a pair of an expression and its type */+public class TypedExpr {+ private Expr expr;+ private Type type;++ public TypedExpr(Expr expr, Type type) {+ this.expr = expr;+ this.type = type;+ }++ public Expr getExpr() {+ return expr;+ }++ public Type getType() {+ return type;+ }++ public String toString() {+ return "<"+expr.toString()+" : "+type.toString()+">";+ }+}
@@ -0,0 +1,41 @@+package org.grammaticalframework.pgf;++import java.util.Collections;+import java.util.Iterator;++/** A callback for recognizing words that are not in the lexicon.+ * For such words the callback returns the expression (MkSymb "<word>").+ */+public class UnknownLiteralCallback implements LiteralCallback {+ private Concr concr;+ private String sentence;++ public UnknownLiteralCallback(Concr concr, String sentence) {+ this.concr = concr;+ this.sentence = sentence;+ }++ public CallbackResult match(int lin_idx, int offset) {+ if (offset < sentence.length() &&+ !Character.isUpperCase(sentence.charAt(offset))) {+ int start_offset = offset;+ while (offset < sentence.length() &&+ !Character.isWhitespace(sentence.charAt(offset))) {+ offset++;+ }+ int end_offset = offset;+ String word = sentence.substring(start_offset,end_offset);++ if (concr.lookupMorpho(word).size() == 0) {+ Expr expr = new Expr("MkSymb", new Expr(word));+ return new CallbackResult(new ExprProb(expr, 0), end_offset);+ }+ }++ return null;+ }+ + public Iterator<TokenProb> predict(int lin_idx, String prefix) {+ return Collections.<TokenProb>emptyList().iterator();+ }+}
@@ -0,0 +1,56 @@+package org.grammaticalframework.sg;++import java.io.Closeable;+import org.grammaticalframework.pgf.*;++/** This class represents a connection to a semantic graph database.+ * The semantic graph is a graph represented as a set of tripples+ * of abstract expressions. The graph can be used for instance to store+ * semantic information for entities in a GF grammar.+ */+public class SG implements Closeable {+ /** Opens a new database file. */+ public static native SG openSG(String path) throws SGError;+ + /** Closes an already opened database. */+ public native void close() throws SGError;++ /** Reads a triple in the format <expr,expr,expr> and returns it as an array. */+ public static native Expr[] readTriple(String s) throws PGFError;++ /** Simple triple queries.+ * Each of the arguments subj, pred and obj could be null. + * A null argument is interpreted as a wild card.+ * If one of the arguments is not null then only triples with matching values+ * will be retrieved. + * + * @return An iterator over the matching triples.+ */+ public native TripleResult queryTriple(Expr subj, Expr pred, Expr obj) throws SGError;++ /** Starts a new transaction. */+ public native void beginTrans() throws SGError;+ + /** Commits the transaction. */+ public native void commit() throws SGError;+ + /** Rollbacks all changes made in the current transaction. */+ public native void rollback() throws SGError;++ /** Inserts a new triple.+ * @return an unique id that identifies this triple in the database+ */+ public native long insertTriple(Expr subj, Expr pred, Expr obj) throws SGError;++ //////////////////////////////////////////////////////////////////+ // private stuff+ private long ref;++ private SG(long ref) {+ this.ref = ref;+ }++ static {+ System.loadLibrary("jpgf");+ }+}
@@ -0,0 +1,11 @@+package org.grammaticalframework.sg;++/** This exception is thrown if an error occurs in the semantic graph.+ */+public class SGError extends RuntimeException {+ private static final long serialVersionUID = -6098784400143861939L;++ public SGError(String message) {+ super(message);+ }+}
@@ -0,0 +1,53 @@+package org.grammaticalframework.sg;++import java.io.Closeable;+import org.grammaticalframework.pgf.Expr;++/** This class is used to iterate over a list of triples.+ * To move to the next triple, call {@link TripleResult#hasNext}.+ * When you do not need the iterator anymore then call {@link TripleResult#close}+ * to release the allocated resources.+ */+public class TripleResult implements Closeable {+ public native boolean hasNext();+ + /** Closes the iterator and releases the allocated resources. */+ public native void close();++ /** Each triple has an unique integer key. You can get the key for+ * the current triple by calling {@link TripleResult#getKey}.+ */+ public long getKey() {+ return key;+ }++ /** This is the first element of the current triple. */+ public Expr getSubject() {+ return subj;+ }++ /** This is the second element of the current triple. */+ public Expr getPredicate() {+ return pred;+ }++ /** This is the third element of the current triple. */+ public Expr getObject() {+ return obj;+ }+ + //////////////////////////////////////////////////////////////////+ // private stuff+ private long ref;+ private long key;+ private Expr subj;+ private Expr pred;+ private Expr obj;++ private TripleResult(long ref, Expr subj, Expr pred, Expr obj) {+ this.ref = ref;+ this.subj = subj;+ this.pred = pred;+ this.obj = obj;+ }+}
@@ -0,0 +1,62 @@+abstract Editor = { + +cat Adjective ; + Noun ; + Verb ; + Determiner ; + Sentence ; + +fun Available : Adjective ; + Next : Adjective ; + Previous : Adjective ; + +fun Bulgarian : Noun ; + Danish : Noun ; + English : Noun ; + Finnish : Noun ; + French : Noun ; + German : Noun ; + Italian : Noun ; + Norwegian : Noun ; + Russian : Noun ; + Spanish : Noun ; + Swedish : Noun ; + +fun Float_N : Noun ; + Integer_N : Noun ; + String_N : Noun ; + + Language : Noun ; + Node : Noun ; + Page : Noun ; + Refinement : Noun ; + Tree : Noun ; + Wrapper : Noun ; + +fun Copy : Verb ; + Cut : Verb ; + Delete : Verb ; + Enter : Verb ; + Parse : Verb ; + Paste : Verb ; + Redo : Verb ; + Refine : Verb ; + Replace : Verb ; + Select : Verb ; + Show : Verb ; + Undo : Verb ; + Wrap : Verb ; + +fun DefPlDet : Determiner ; + DefSgDet : Determiner ; + IndefPlDet : Determiner ; + IndefSgDet : Determiner ; + +fun Command : Verb -> Determiner -> Noun -> Sentence ; + CommandAdj : Verb -> Determiner -> Adjective -> Noun -> Sentence ; + ErrorMessage : Adjective -> Noun -> Sentence ; + Label : Noun -> Sentence ; + RandomlyCommand : Verb -> Determiner -> Noun -> Sentence ; + SingleWordCommand : Verb -> Sentence ; + +}
@@ -0,0 +1,63 @@+--# -path=alltenses +concrete EditorEng of Editor = open GrammarEng, ParadigmsEng in { + +lincat Adjective = A ; + Noun = N ; + Verb = V ; + Determiner = Det ; + Sentence = Utt ; + +lin Available = mkA "available" ; + Next = mkA "next" ; + Previous = mkA "previous" ; + +lin Bulgarian = mkN "Bulgarian" ; + Danish = mkN "Danish" ; + English = mkN "English" ; + Finnish = mkN "Finnish" ; + French = mkN "French" ; + German = mkN "German" ; + Italian = mkN "Italian" ; + Norwegian = mkN "Norwegian" ; + Russian = mkN "Russian" ; + Spanish = mkN "Spanish" ; + Swedish = mkN "Swedish" ; + +lin Float_N = mkN "float" ; + Integer_N = mkN "integer" ; + String_N = mkN "string" ; + + Language = mkN "language" ; + Node = mkN "node" ; + Page = mkN "page" ; + Refinement = mkN "refinement" ; + Tree = mkN "tree" ; + Wrapper = mkN "wrapper" ; + +lin Copy = mkV "copy" ; + Cut = mkV "cut" ; + Delete = mkV "delete" ; + Enter = mkV "enter" ; + Parse = mkV "parse" ; + Paste = mkV "paste" ; + Redo = mkV "redo" ; + Refine = mkV "refine" ; + Replace = mkV "replace" ; + Select = mkV "select" ; + Show = mkV "show" ; + Undo = mkV "undo" ; + Wrap = mkV "wrap" ; + +lin DefPlDet = DetQuant DefArt NumPl ; + DefSgDet = DetQuant DefArt NumSg ; + IndefPlDet = DetQuant IndefArt NumPl ; + IndefSgDet = DetQuant IndefArt NumSg ; + +lin Command v d n = UttImpSg PPos (ImpVP (ComplSlash (SlashV2a (mkV2 v)) (DetCN d (UseN n)))) ; + CommandAdj v d a n = UttImpSg PPos (ImpVP (ComplSlash (SlashV2a (mkV2 v)) (DetCN d (AdjCN (PositA a) (UseN n))))) ; + ErrorMessage a n = UttNP (DetCN (DetQuant no_Quant NumPl) (AdjCN (PositA a) (UseN n))) ; + Label n = UttNP (MassNP (UseN n)) ; + RandomlyCommand v d n = UttImpSg PPos (ImpVP (AdvVP (ComplSlash (SlashV2a (mkV2 v)) (DetCN d (UseN n))) (PrepNP (mkPrep "at") (MassNP (UseN (mkN "random")))))) ; + SingleWordCommand v = UttImpSg PPos (ImpVP (UseV v)) ; + +}
@@ -0,0 +1,17 @@+<!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> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> + <link rel="stylesheet" type="text/css" href="style.css" /> + <script type="text/javascript" src="gflib.js"></script> + <script type="text/javascript" src="editorGrammar.js"></script> + <script type="text/javascript" src="grammar.js"></script> + <script type="text/javascript" src="gfjseditor.js"></script> + <title>Web-based Syntax Editor</title> + </head> + <body onload="mkEditor('editor', Foods)" onkeydown="return hotKeys(event)"> + <div id="editor"> + </div> + </body> +</html>
@@ -0,0 +1,1 @@+var Editor = new GFGrammar(new GFAbstract("S",{Available: new Type([], "Adjective"), Bulgarian: new Type([], "Noun"), Command: new Type(["Verb", "Determiner", "Noun"], "Sentence"), CommandAdj: new Type(["Verb", "Determiner", "Adjective", "Noun"], "Sentence"), Copy: new Type([], "Verb"), Cut: new Type([], "Verb"), Danish: new Type([], "Noun"), DefPlDet: new Type([], "Determiner"), DefSgDet: new Type([], "Determiner"), Delete: new Type([], "Verb"), English: new Type([], "Noun"), Enter: new Type([], "Verb"), ErrorMessage: new Type(["Adjective", "Noun"], "Sentence"), Finnish: new Type([], "Noun"), Float_N: new Type([], "Noun"), French: new Type([], "Noun"), German: new Type([], "Noun"), IndefPlDet: new Type([], "Determiner"), IndefSgDet: new Type([], "Determiner"), Integer_N: new Type([], "Noun"), Italian: new Type([], "Noun"), Label: new Type(["Noun"], "Sentence"), Language: new Type([], "Noun"), Next: new Type([], "Adjective"), Node: new Type([], "Noun"), Norwegian: new Type([], "Noun"), Page: new Type([], "Noun"), Parse: new Type([], "Verb"), Paste: new Type([], "Verb"), Previous: new Type([], "Adjective"), RandomlyCommand: new Type(["Verb", "Determiner", "Noun"], "Sentence"), Redo: new Type([], "Verb"), Refine: new Type([], "Verb"), Refinement: new Type([], "Noun"), Replace: new Type([], "Verb"), Russian: new Type([], "Noun"), Select: new Type([], "Verb"), Show: new Type([], "Verb"), SingleWordCommand: new Type(["Verb"], "Sentence"), Spanish: new Type([], "Noun"), String_N: new Type([], "Noun"), Swedish: new Type([], "Noun"), Tree: new Type([], "Noun"), Undo: new Type([], "Verb"), Wrap: new Type([], "Verb"), Wrapper: new Type([], "Noun")}),{EditorEng: new GFConcrete({},{0:[new Apply(5,[]), new Apply(34,[]), new Apply(40,[])], 2:[new Apply(19,[]), new Apply(29,[])], 4:[new Apply(18,[]), new Apply(28,[])], 5:[new Apply(6,[]), new Apply(17,[]), new Apply(21,[]), new Apply(24,[]), new Apply(25,[]), new Apply(26,[]), new Apply(27,[]), new Apply(30,[]), new Apply(31,[]), new Apply(33,[]), new Apply(35,[]), new Apply(36,[]), new Apply(37,[]), new Apply(47,[]), new Apply(49,[]), new Apply(54,[]), new Apply(55,[]), new Apply(56,[]), new Apply(57,[]), new Apply(60,[])], 8:[new Apply(7,[new PArg(9), new PArg(12), new PArg(13)]), new Apply(8,[new PArg(10), new PArg(12), new PArg(13)]), new Apply(9,[new PArg(9), new PArg(14), new PArg(13)]), new Apply(10,[new PArg(10), new PArg(14), new PArg(13)]), new Apply(11,[new PArg(9), new PArg(12), new PArg(0), new PArg(13)]), new Apply(12,[new PArg(10), new PArg(12), new PArg(0), new PArg(13)]), new Apply(13,[new PArg(9), new PArg(14), new PArg(0), new PArg(13)]), new Apply(14,[new PArg(10), new PArg(14), new PArg(0), new PArg(13)]), new Apply(23,[new PArg(0), new PArg(13)]), new Apply(32,[new PArg(13)]), new Apply(41,[new PArg(9), new PArg(12), new PArg(13)]), new Apply(42,[new PArg(10), new PArg(12), new PArg(13)]), new Apply(43,[new PArg(9), new PArg(14), new PArg(13)]), new Apply(44,[new PArg(10), new PArg(14), new PArg(13)]), new Apply(52,[new PArg(9)]), new Apply(53,[new PArg(10)])], 10:[new Apply(15,[]), new Apply(16,[]), new Apply(20,[]), new Apply(22,[]), new Apply(38,[]), new Apply(39,[]), new Apply(45,[]), new Apply(46,[]), new Apply(48,[]), new Apply(50,[]), new Apply(51,[]), new Apply(58,[]), new Apply(59,[])], 12:[new Coerce(1), new Coerce(2)], 13:[new Coerce(5), new Coerce(6), new Coerce(7)], 14:[new Coerce(3), new Coerce(4)]},[new CncFun("lindef Adjective",[0, 0, 0, 0, 0, 0, 0]), new CncFun("lindef Determiner",[0, 0, 0, 0]), new CncFun("lindef Noun",[0, 0, 0, 0]), new CncFun("lindef Sentence",[0]), new CncFun("lindef Verb",[0, 0, 0, 0, 0]), new CncFun("Available",[1, 2, 3, 4, 5, 6, 7]), new CncFun("Bulgarian",[8, 9, 10, 11]), new CncFun("Command",[12]), new CncFun("Command",[13]), new CncFun("Command",[14]), new CncFun("Command",[15]), new CncFun("CommandAdj",[16]), new CncFun("CommandAdj",[17]), new CncFun("CommandAdj",[18]), new CncFun("CommandAdj",[19]), new CncFun("Copy",[20, 21, 22, 23, 22]), new CncFun("Cut",[24, 25, 26, 27, 26]), new CncFun("Danish",[28, 29, 30, 31]), new CncFun("DefPlDet",[32, 33, 34, 35]), new CncFun("DefSgDet",[32, 36, 37, 36]), new CncFun("Delete",[38, 39, 40, 41, 40]), new CncFun("English",[42, 43, 44, 45]), new CncFun("Enter",[46, 47, 48, 49, 48]), new CncFun("ErrorMessage",[50]), new CncFun("Finnish",[51, 52, 53, 54]), new CncFun("Float_N",[55, 56, 57, 58]), new CncFun("French",[59, 60, 61, 62]), new CncFun("German",[63, 64, 65, 66]), new CncFun("IndefPlDet",[67, 68, 69, 68]), new CncFun("IndefSgDet",[70, 71, 72, 71]), new CncFun("Integer_N",[73, 74, 75, 76]), new CncFun("Italian",[77, 78, 79, 80]), new CncFun("Label",[81]), new CncFun("Language",[82, 83, 84, 85]), new CncFun("Next",[86, 87, 88, 89, 90, 91, 92]), new CncFun("Node",[93, 94, 95, 96]), new CncFun("Norwegian",[97, 98, 99, 100]), new CncFun("Page",[101, 102, 103, 104]), new CncFun("Parse",[105, 106, 107, 108, 107]), new CncFun("Paste",[109, 110, 111, 112, 111]), new CncFun("Previous",[113, 114, 115, 116, 117, 118, 119]), new CncFun("RandomlyCommand",[120]), new CncFun("RandomlyCommand",[121]), new CncFun("RandomlyCommand",[122]), new CncFun("RandomlyCommand",[123]), new CncFun("Redo",[124, 125, 126, 127, 126]), new CncFun("Refine",[128, 129, 130, 131, 130]), new CncFun("Refinement",[132, 133, 134, 135]), new CncFun("Replace",[136, 137, 138, 139, 138]), new CncFun("Russian",[140, 141, 142, 143]), new CncFun("Select",[144, 145, 146, 147, 146]), new CncFun("Show",[148, 149, 150, 151, 150]), new CncFun("SingleWordCommand",[152]), new CncFun("SingleWordCommand",[81]), new CncFun("Spanish",[153, 154, 155, 156]), new CncFun("String_N",[157, 158, 159, 160]), new CncFun("Swedish",[161, 162, 163, 164]), new CncFun("Tree",[165, 166, 167, 168]), new CncFun("Undo",[169, 170, 171, 172, 171]), new CncFun("Wrap",[173, 174, 175, 176, 175]), new CncFun("Wrapper",[177, 178, 179, 180])],[[new SymLit(0, 0)],[new SymKS("available")],[new SymKS("available's")],[new SymKS("more", "available")],[new SymKS("more", "available's")],[new SymKS("most", "available")],[new SymKS("most", "available's")],[new SymKS("availably")],[new SymKS("Bulgarian")],[new SymKS("Bulgarian's")],[new SymKS("Bulgarians")],[new SymKS("Bulgarians'")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0), new SymKS("yourself")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0)],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 2), new SymKS("yourself")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 2)],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0), new SymCat(3, 0), new SymKS("yourself")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0), new SymCat(3, 0)],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0), new SymCat(3, 2), new SymKS("yourself")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0), new SymCat(3, 2)],[new SymKS("copy")],[new SymKS("copies")],[new SymKS("copied")],[new SymKS("copying")],[new SymKS("cut")],[new SymKS("cuts")],[new SymKS("cutted")],[new SymKS("cutting")],[new SymKS("Danish")],[new SymKS("Danish's")],[new SymKS("Danishes")],[new SymKS("Danishes'")],[new SymKS("the")],[new SymKS("they")],[new SymKS("theirs")],[new SymKS("them")],[new SymKS("it")],[new SymKS("its")],[new SymKS("delete")],[new SymKS("deletes")],[new SymKS("deleted")],[new SymKS("deleting")],[new SymKS("English")],[new SymKS("English's")],[new SymKS("Englishes")],[new SymKS("Englishes'")],[new SymKS("enter")],[new SymKS("enters")],[new SymKS("enterred")],[new SymKS("enterring")],[new SymKS("no"), new SymCat(0, 0), new SymCat(1, 2)],[new SymKS("Finnish")],[new SymKS("Finnish's")],[new SymKS("Finnishes")],[new SymKS("Finnishes'")],[new SymKS("float")],[new SymKS("float's")],[new SymKS("floats")],[new SymKS("floats'")],[new SymKS("French")],[new SymKS("French's")],[new SymKS("Frenches")],[new SymKS("Frenches'")],[new SymKS("German")],[new SymKS("German's")],[new SymKS("Germans")],[new SymKS("Germans'")],[],[new SymKS("ones")],[new SymKS("ones'")],[new SymKP(["a"],[new Alt(["a"],["eu", "Eu", "uni", "up"]), new Alt(["an"],["un"]), new Alt(["an"],["a", "e", "i", "o", "A", "E", "I", "O"]), new Alt(["an"],["SMS", "sms"])])],[new SymKS("one")],[new SymKS("one's")],[new SymKS("integer")],[new SymKS("integer's")],[new SymKS("integers")],[new SymKS("integers'")],[new SymKS("Italian")],[new SymKS("Italian's")],[new SymKS("Italians")],[new SymKS("Italians'")],[new SymCat(0, 0)],[new SymKS("language")],[new SymKS("language's")],[new SymKS("languages")],[new SymKS("languages'")],[new SymKS("next")],[new SymKS("next's")],[new SymKS("nexter")],[new SymKS("nexter's")],[new SymKS("nextest")],[new SymKS("nextest's")],[new SymKS("nextly")],[new SymKS("node")],[new SymKS("node's")],[new SymKS("nodes")],[new SymKS("nodes'")],[new SymKS("Norwegian")],[new SymKS("Norwegian's")],[new SymKS("Norwegians")],[new SymKS("Norwegians'")],[new SymKS("page")],[new SymKS("page's")],[new SymKS("pages")],[new SymKS("pages'")],[new SymKS("parse")],[new SymKS("parses")],[new SymKS("parsed")],[new SymKS("parsing")],[new SymKS("paste")],[new SymKS("pastes")],[new SymKS("pasted")],[new SymKS("pasting")],[new SymKS("previous")],[new SymKS("previous'")],[new SymKS("more", "previous")],[new SymKS("more", "previous'")],[new SymKS("most", "previous")],[new SymKS("most", "previous'")],[new SymKS("previously")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0), new SymKS("yourself", "at", "random")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 0), new SymKS("at", "random")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 2), new SymKS("yourself", "at", "random")],[new SymCat(0, 0), new SymCat(1, 0), new SymCat(2, 2), new SymKS("at", "random")],[new SymKS("redo")],[new SymKS("redoes")],[new SymKS("redoed")],[new SymKS("redoing")],[new SymKS("refine")],[new SymKS("refines")],[new SymKS("refined")],[new SymKS("refining")],[new SymKS("refinement")],[new SymKS("refinement's")],[new SymKS("refinements")],[new SymKS("refinements'")],[new SymKS("replace")],[new SymKS("replaces")],[new SymKS("replaced")],[new SymKS("replacing")],[new SymKS("Russian")],[new SymKS("Russian's")],[new SymKS("Russians")],[new SymKS("Russians'")],[new SymKS("select")],[new SymKS("selects")],[new SymKS("selected")],[new SymKS("selecting")],[new SymKS("show")],[new SymKS("shows")],[new SymKS("showed")],[new SymKS("showing")],[new SymCat(0, 0), new SymKS("yourself")],[new SymKS("Spanish")],[new SymKS("Spanish's")],[new SymKS("Spanishes")],[new SymKS("Spanishes'")],[new SymKS("string")],[new SymKS("string's")],[new SymKS("strings")],[new SymKS("strings'")],[new SymKS("Swedish")],[new SymKS("Swedish's")],[new SymKS("Swedishes")],[new SymKS("Swedishes'")],[new SymKS("tree")],[new SymKS("tree's")],[new SymKS("trees")],[new SymKS("trees'")],[new SymKS("undo")],[new SymKS("undoes")],[new SymKS("undoed")],[new SymKS("undoing")],[new SymKS("wrap")],[new SymKS("wraps")],[new SymKS("wrapped")],[new SymKS("wrapping")],[new SymKS("wrapper")],[new SymKS("wrapper's")],[new SymKS("wrappers")],[new SymKS("wrappers'")]],{Adjective:{s: 0, e: 0}, Determiner:{s: 1, e: 4}, Float:{s: -3, e: -3}, Int:{s: -2, e: -2}, Noun:{s: 5, e: 7}, Sentence:{s: 8, e: 8}, String:{s: -1, e: -1}, Verb:{s: 9, e: 10}, __gfVar:{s: -4, e: -4}}, 15)});
binary file changed (absent → 161 bytes)
@@ -0,0 +1,1310 @@+ +//Variable and Constant definitions + +var expColImg = new Array(2); +expColImg[0] = new Image(12,12); +expColImg[0].src = "minus.png"; +expColImg[1] = new Image(12,12); +expColImg[1].src = "plus.png"; +expColImg[2] = new Image(12,12); +expColImg[2].src = "empty.png"; + +// Grammars +var grammar = undefined; +var editorGrammar = Editor; + +var selectedLanguage = "EditorEng"; +var selectedNode = ""; +var collapseBuffer = new Array(); +var abstractTree = new Fun ("?"); + +var navigationControlString = new Array(); +var undoArray = new Array(); +var redoArray = new Array(); +var clipBoard; +var refPageCounter = 0; + +var stringAbstractTree = undefined; +var myTree = undefined; +var parseTrees = undefined; + +var keys = new Array(); +keys ["Z"] = function() { clickUndo('actUndo'); } +keys ["Y"] = function() { clickRedo('actRedo'); } +keys ["R"] = function() { clickRefine('actRefine'); }; +keys ["V"] = function() { clickPaste('actPaste'); }; +keys ["X"] = function() { clickCut('actCut'); }; +keys ["C"] = function() { clickCopy('actCopy'); }; +keys ["D"] = function() { clickDelete('actDelete'); }; +keys ["E"] = function() { clickReplace('actReplace'); }; +keys ["W"] = function() { clickWrap('actWrap'); }; +keys ["P"] = function() { clickParse('actParse'); }; +keys ["N"] = function() { clickRandomNode('actRandomNode'); }; +keys ["T"] = function() { clickRandomTree('actRandomTree'); }; +keys ["%"] = function() { leftArrowKey(); }; +keys ["&"] = function() { upDownArrowKey(-1); }; +keys ["'"] = function() { rightArrowKey(); }; +keys ["("] = function() { upDownArrowKey( 1); }; +keys ["27"] = function() { clickEsc(); }; + +function state(selectedNode, tree, collapseBuffer) { + this.selectedNode = selectedNode; + this.tree = grammar.abstract.copyTree(tree); + this.collapseBuffer = collapseBuffer; + return this; +} + +function treeNode(name, caption) { + this.name = name; + this.caption = caption; + this.cat = ""; + this.children = new Array(); + this.collapsed = false; + return this; +} + +treeNode.prototype.addChild = function (i, c) { + this.children[i] = c; +} + +treeNode.prototype.hasChildren = function() { + return this.children.length; +} + +/* -------------------------------------------------------------------------- */ +/* ----------------------------- GUI functions ----------------------------- */ +/* -------------------------------------------------------------------------- */ + + +// Creates an instance of the editor and stores it in the given HTML container. +// Previous content is destroyed. +function mkEditor(container, myGrammar) { + grammar = myGrammar; + myTree = treeFromAbstract(grammar.abstract.annotate(abstractTree, grammar.abstract.startcat), "0"); + var holder = document.getElementById(container); + holder.innerHTML = "<div id='wrapper'><div id='absFrame'></div><div id='conFrame'></div><div id='actFrame'></div><div id='refFrame'></div><div id='messageFrame'></div><div id='clipboardFrame'></div></div>"; + nodeClick('0', '?'); +} + +// Generates a tree from the string representation of an abstract tree contained in the element elementToParse +function parseStringTree(elementToParse) { + stringAbstractTree = elementToParse; + abstractTree = grammar.abstract.handleLiterals(grammar.abstract.parseTree(document.getElementById(elementToParse).value, grammar.abstract.startcat)); + myTree = treeFromAbstract(abstractTree, "0"); + nodeClick("0"); +} + +// If a key is pressed and a function assigned to that key, calls the function +function hotKeys(event) { + event = (event) ? event : ((window.event) ? event : null); + if (event) { + var charCode = (event.charCode) ? event.charCode : ((event.which) ? event.which : event.keyCode); + + if (document.getElementById("actParse").className == "selected" && charCode != 27) + return true; + + if (keys[String.fromCharCode(charCode).toUpperCase()] && + !event.ctrlKey && !event.altKey && !event.shiftKey && !event.metaKey) { + keys[String.fromCharCode(charCode).toUpperCase()](); + return false; + } + else if (keys["" + charCode] && + !event.ctrlKey && !event.altKey && !event.shiftKey && !event.metaKey) { + keys["" + charCode](); + return false; + } + else if (charCode >= "96" && charCode <= "105" && + !event.ctrlKey && !event.altKey && !event.shiftKey && !event.metaKey) { + keys["" + (charCode - 96)](); + return false; + } + } + + return true; +} + +// Clears "numeric" hotkeys +function clearHotKeys() { + for (var key in keys) { + if ((parseInt(key) + 1) && (key != "27")) { keys[key] = function() { }; } + } +} + +// Action to be performed when the up/down arrow key is pressed +function upDownArrowKey(pos) { + var nodePos = getNavPos(selectedNode); + if ((nodePos > 0 && pos < 0) || (nodePos < navigationControlString.length - 1 && pos > 0)) { + nodeClick(navigationControlString[nodePos + pos]); + } +} + +// Gets the position of a given node in the navigationControlString +function getNavPos(nodeName) { + for (var i = 0, j = navigationControlString.length; i < j; i++) { + if (navigationControlString[i] == nodeName) { return i; }; + } + return undefined; +} + +// Given a name and a tree, gets the node in the tree with that name +function getNode(nodeName, node) { + if (nodeName == node.name) { + return node; + } + else { + for (var i = 0, j = node.children.length; i < j; i++) { + var found = getNode(nodeName, node.children[i]); + if (found) { return found; } + } + } +} + +// Action to be performed when the left arrow key is pressed +function leftArrowKey() { + var node = getNode(selectedNode, myTree); + if (!node.collapsed && node.hasChildren()) { + signClick(node.name, node.caption); + } + else { + var parentNode = getParent(node.name, myTree); + if (parentNode) { nodeClick(parentNode.name); } + } +} + +// Gets the parent of the selected node +function getParent(nodeName, node) { + if (node.name == nodeName) { + return undefined; + } + else { + for (var i = 0, j = node.children.length; i < j; i++) { + if (node.children[i].name == nodeName) { return node; } + } + for (var i = 0, j = node.children.length; i < j; i++) { + var found = getParent(nodeName, node.children[i]); + if (found) { return found; } + } + } +} + +// Action to be performed when the right arrow key is pressed +function rightArrowKey() { + var node = getNode(selectedNode, myTree); + if (node.collapsed) { + signClick(node.name, node.caption); + } + else { + var firstDescendant = getfirstDescendant(node); + if (firstDescendant) { + nodeClick(firstDescendant.name); + } + } +} + +// Gets the first descendant child of a node +function getfirstDescendant(node) { + if (node.hasChildren() && !node.collapsed) { return node.children[0]; } + return undefined; +} + +// Produces and displays an HTML representation of the tree +function drawTree() { + var frame = document.getElementById("absFrame"); + navigationControlString = new Array(); + frame.innerHTML = "<ul id='tree'>" + getTree(myTree, 0) + "</ul>"; + document.getElementById("link" + selectedNode).scrollIntoView(false); +} + +// Produces an HTML representation of the tree +function getTree(tree, level) { + navigationControlString[navigationControlString.length] = tree.name; + var htmlTree = new Array(); + htmlTree.push("<li>"); + if (tree.hasChildren()) { + htmlTree.push("<img class='tree-menu'"); + if (tree.collapsed) + htmlTree.push(" src='plus.png'"); + else + htmlTree.push(" src='minus.png'"); + htmlTree.push(" onclick='signClick(\"", tree.name, "\", \"", tree.caption, "\")' />"); + } + else { + htmlTree.push("<img class='tree-menu' src='empty.png' />"); + } + htmlTree.push("<a id='link", tree.name, "'"); + if (document.getElementById("actRefine").className == "selected" || + document.getElementById("actReplace").className == "selected" || + document.getElementById("actWrap").className == "selected" || + document.getElementById("actParse").className == "selected") { + htmlTree.push("class='treeGray' "); } + else if (selectedNode == tree.name) { htmlTree.push("class='treeSelected' "); } + else { htmlTree.push("class='tree' "); } + htmlTree.push("href='' onclick='nodeClick(\"", tree.name, "\"); return false'>"); + if (tree.cat == "String" || tree.cat == "Int" || tree.cat == "Float") { + htmlTree.push(tree.caption.substring(tree.caption.lastIndexOf("_") + 1)); + } else { + htmlTree.push(tree.caption); + } + htmlTree.push(" : ", tree.cat, "</a></li><ul>"); + if (tree.hasChildren() && !tree.collapsed) { + for (var i = 0, j = tree.children.length; i < j; i++) { + htmlTree.push(getTree(tree.children[i], level + 1)); + } + } + htmlTree.push("</ul>"); + return htmlTree.join(""); +} + +// Linearizes and displays the abstract tree +function drawLinearizedFrame() { + var frame = document.getElementById("conFrame"); + frame.innerHTML = getLinearizedFrame(); +} + +// Linearizes the abstract tree and returns it in HTML form +function getLinearizedFrame() { + var linearizedFrame = new Array(); + for (var i in grammar.concretes) { + linearizedFrame.push("<h4>", i, "</h4>"); + linearizedFrame.push("<p id='line", i, "'>"); + var tokens = grammar.concretes[i].tagAndLinearize(abstractTree); + for (var j = 0, k = tokens.length; j < k; j++) { + linearizedFrame.push(createLinearized(tokens[j])); + } + linearizedFrame.push("</p>"); + } + linearizedFrame.push("<h4>Abstract</h4>"); + linearizedFrame.push("<p id='lineAbstract'>", createLinearizedFromAbstract(myTree, "0"), "</p>"); + return linearizedFrame.join(""); +} + +// Linearizes and displays the abstract tree +function drawEditFrame() { + var frame = document.getElementById("conFrame"); + frame.innerHTML = getEditFrame(); +} + +// Linearizes the abstract tree and returns it in HTML form +function getEditFrame() { + var editFrame = new Array(); + for (var i in grammar.concretes) { + editFrame.push("<h4>", i, "</h4>"); + editFrame.push("<p id='line", i, "'>"); + if (abstractTree.isMeta()) { + editFrame.push("<span class='edit' contenteditable=true onkeydown='return editFrameKeyDown(this,\"",i,"\",event)'> "); + isLastSelected = true; + } else { + var tokens = grammar.concretes[i].tagAndLinearize(abstractTree); + var isLastSelected = false; + for (var j = 0, k = tokens.length; j < k; j++) { + var token = tokens[j]; + var node = getNode(token.tag, myTree); + + if (node.name.substr(0, selectedNode.length) == selectedNode) { + if (!isLastSelected) { + editFrame.push("<span class='edit' contenteditable=true onkeydown='return editFrameKeyDown(this,\"",i,"\",event)'>"); + isLastSelected = true; + } + + if (token == "&-") + editFrame.push("<br/>"); + else + editFrame.push(token+" "); + } else { + if (isLastSelected) { + editFrame.push("</span>"); + isLastSelected = false; + } + + if (token == "&-") + editFrame.push("<br/>"); + else + editFrame.push("<span id='", token.tag, "' class='normal'>", token, "</span>"); + } + } + } + + if (isLastSelected) { + editFrame.push("</span>"); + isLastSelected = false; + } + + editFrame.push("</p>"); + } + editFrame.push("<h4>Abstract</h4>"); + editFrame.push("<p id='lineAbstract'>", createLinearizedFromAbstract(myTree, "0"), "</p>"); + return editFrame.join(""); +} + +function editFrameKeyDown(me,lang,event) { + event = (event) ? event : ((window.event) ? event : null); + if (event) { + var charCode = (event.charCode) ? event.charCode : ((event.which) ? event.which : event.keyCode); + + if (charCode == 13) { + refPageCounter = 0; + parseTrees = undefined; + var string = me.innerText; + if (string || string == "") { + var node = getNode(selectedNode, myTree); + switch (node.cat) { + case "String": parseTrees = [new Fun('"'+string+'"')]; break; + case "Int": if (isNaN(string) || (string && string.indexOf(".") != -1)) + parseTrees = new Array(); + else + parseTrees = [new Fun(string)]; + break; + case "Float": if (isNaN(string)) + parseTrees = new Array(); + else + parseTrees = [new Fun(string)]; + break; + default: parseTrees = grammar.concretes[lang].parseString(string, node.cat); break; + } + if (parseTrees.length == 1) { + pushUndoClearRedo(); + abstractTree = insertNode(abstractTree, selectedNode, "0", grammar.abstract.copyTree(grammar.abstract.handleLiterals(parseTrees[0], node.cat))); + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + clearHotKeys(); + concludeAction(); + } else if (parseTrees.length > 1) { + document.getElementById("refFrame").innerHTML = showTrees(); + } + } + return false; + } + } + + return true; +} + +// Creates an HTML representation of a linearization of an abstract tree +function createLinearized(token) { + var node = getNode(token.tag, myTree); + var linearized = new Array() + linearized.push("<span id='", token.tag, "' class="); + if (node.name.substr(0, selectedNode.length) == selectedNode) { + linearized.push("'selected'"); + } + else { + linearized.push("'normal'"); + } + if (token == "&-") { linearized.push("<br />"); } + else { linearized.push(" onclick='nodeClick(\"", node.name, "\");'>", token, "</span>"); } + return linearized.join(""); +} + +// Creates an HTML representation of the abstract tree +function createLinearizedFromAbstract(node, path, prec) { + var linearized = new Array(); + linearized.push("<span id='", path, "' class="); + if (node.name.substr(0, selectedNode.length) == selectedNode) { + linearized.push("'selected'"); + } + else { + linearized.push("'normal'"); + } + linearized.push(" onclick='nodeClick(\"", node.name, "\");'>"); + if (node.children.length) { linearized.push(" ("); } + if (node.cat == "String" || node.cat == "Int" || node.cat == "Float") { + linearized.push(" ", node.caption.substring(node.caption.lastIndexOf("_") + 1), " "); + } else { + linearized.push(" ", node.caption, " "); + } + for (var i = 0, j = node.children.length; i < j; i++) { + linearized.push(createLinearizedFromAbstract(node.children[i], path + "-" + i, 1)); + } + if (node.children.length) { linearized.push(") "); } + linearized.push("</span>"); + return linearized.join(""); +} + +// Expands/Collapses node +function signClick(name, caption) { + myTree = expandCollapse(myTree, name); + nodeClick(name); +} + +// Sets the "collapsed" property of a given node +function expandCollapse(node, name) { + if (node.name == name) { + if (wasCollapsed(node.name)) { removeFromCollapseBuffer(node.name); } + else { collapseBuffer[collapseBuffer.length] = node.name; } + node.collapsed ^= true; + } + else { + for (var i = 0, j = node.children.length; i < j; i++) { + expandCollapse(node.children[i], name); + } + } + return node; +} + +// Checks if a node was collapsed on the previous cycle +function wasCollapsed(nodeName) { + for (var i = 0, j = collapseBuffer.length; i < j; i++) { + if (nodeName == collapseBuffer[i]) { + return true; + } + } + return false; +} + +// Removes a node from the collapseBuffer array +function removeFromCollapseBuffer(nodeName) { + var newBuffer = new Array(); + for (var i = 0, j = collapseBuffer.length; i < j; i++) { + if (nodeName != collapseBuffer[i]) { + newBuffer[newBuffer.length] = collapseBuffer[i]; + } + } + collapseBuffer = newBuffer; +} + +// Selects a node +function nodeClick(name) { + if ((document.getElementById("actRefine") && document.getElementById("actRefine").className == "selected") || + (document.getElementById("actReplace") && document.getElementById("actReplace").className == "selected") || + (document.getElementById("actWrap") && document.getElementById("actWrap").className == "selected") || + (document.getElementById("actTree") && document.getElementById("actTree").className == "selected")) { + return; } + selectedNode = name; + if (stringAbstractTree) { + document.getElementById(stringAbstractTree).value = abstractTree.show(); + } + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + document.getElementById("messageFrame").innerHTML = showLanguages(); + document.getElementById(selectedLanguage).className = "selected"; + applyLanguage(); + drawTree(); + drawLinearizedFrame(); +} + +// Shows the available languages for the editor +function showLanguages() { + var languages = new Array(); + languages.push("<table class='language' id='languagesTable'>", + "<tr id='langs' class='language'>", + "<td class='language' id='EditorDan' title='Label Bulgarian' onclick='clickLanguage(\"\")'>Bulgarian</td>", + "<td class='language' id='EditorDan' title='Label Danish' onclick='clickLanguage(\"\")'>Danish</td>", + "<td class='language' id='EditorEng' title='Label English' onclick='clickLanguage(\"EditorEng\")'>English</td>", + "<td class='language' id='EditorFin' title='Label Finnish' onclick='clickLanguage(\"\")'>Finnish</td>", + "<td class='language' id='EditorFre' title='Label French' onclick='clickLanguage(\"EditorFre\")'>French</td>", + "<td class='language' id='EditorGer' title='Label German' onclick='clickLanguage(\"\")'>German</td>", + "<td class='language' id='EditorIta' title='Label Italian' onclick='clickLanguage(\"\")'>Italian</td>", + "<td class='language' id='EditorNor' title='Label Norwegian' onclick='clickLanguage(\"\")'>Norwegian</td>", + "<td class='language' id='EditorRus' title='Label Russian' onclick='clickLanguage(\"\")'>Russian</td>", + "<td class='language' id='EditorSpa' title='Label Spanish' onclick='clickLanguage(\"EditorSpa\")'>Spanish</td>", + "<td class='language' id='EditorSwe' title='Label Swedish' onclick='clickLanguage(\"EditorSwe\")'>Swedish</td></tr>", + "</table>"); + return languages.join(""); +} + +// Selects the language to use in the editor +function clickLanguage(lang) { + if (lang) { + var tdsToClear = document.getElementById("languagesTable").getElementsByTagName("td"); + for (var i = 0, j = tdsToClear.length; i < j; i++) { + if (tdsToClear[i].className == "selected") { tdsToClear[i].className = "language"; } + } + document.getElementById(lang).className = "selected"; + selectedLanguage = lang; + applyLanguage(); + } +} + +// Applies a language to the editor +function applyLanguage() { + var langsToLinearize = document.getElementById("languagesTable").getElementsByTagName("td"); + for (var i = 0, j = langsToLinearize.length; i < j; i++) { + var absStr = langsToLinearize[i].getAttribute("title"); + var lin = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree(absStr, editorGrammar.abstract.startcat)); + lin = lin.substring(0,1).toUpperCase().concat(lin.substring(1)) + if (!langsToLinearize[i].firstChild) { + var txt = document.createTextNode(lin); + langsToLinearize[i].appendChild(txt); + } + else { + langsToLinearize[i].firstChild.nodeValue = lin; + } + } + var actionsToLinearize = document.getElementById("actionsTable").getElementsByTagName("td"); + for (var i = 0, j = actionsToLinearize.length; i < j; i++) { + if (actionsToLinearize[i].className == "action") { + var absStr = actionsToLinearize[i].getAttribute("title"); + var lin = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree(absStr, editorGrammar.abstract.startcat)); + lin = lin.substring(0,1).toUpperCase().concat(lin.substring(1)) + if (!actionsToLinearize[i].firstChild) { + var txt = document.createTextNode(lin); + actionsToLinearize[i].appendChild(txt); + } + else { + actionsToLinearize[i].firstChild.nodeValue = lin; + } + } + } + var messageToLinearize = document.getElementById("refgenRefRandom"); + if (messageToLinearize) { + var msg = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("RandomlyCommand Select IndefSgDet Refinement", editorGrammar.abstract.startcat)); + messageToLinearize.firstChild.firstChild.nodeValue = msg.substring(0,1).toUpperCase().concat(msg.substring(1)); + } + var messageToLinearize = document.getElementById("nextRefsNext"); + if (messageToLinearize) { + var msg = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Next Page", editorGrammar.abstract.startcat)); + messageToLinearize.firstChild.firstChild.nodeValue = msg.substring(0,1).toUpperCase().concat(msg.substring(1)); + } + messageToLinearize = document.getElementById("nextRefsPrevious"); + if (messageToLinearize) { + var msg = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Previous Page", editorGrammar.abstract.startcat)); + messageToLinearize.firstChild.firstChild.nodeValue = msg.substring(0,1).toUpperCase().concat(msg.substring(1)); + } + var messageToLinearize = document.getElementById("nextWrapsNext"); + if (messageToLinearize) { + var msg = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Next Page", editorGrammar.abstract.startcat)); + messageToLinearize.firstChild.firstChild.nodeValue = msg.substring(0,1).toUpperCase().concat(msg.substring(1)); + } + messageToLinearize = document.getElementById("nextWrapsPrevious"); + if (messageToLinearize) { + var msg = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Previous Page", editorGrammar.abstract.startcat)); + messageToLinearize.firstChild.firstChild.nodeValue = msg.substring(0,1).toUpperCase().concat(msg.substring(1)); + } +} + +// Shows the available actions for a node +function showActions(caption) { + var node = getNode(selectedNode, myTree); + var abstractNode = getNodeFromAbstract(abstractTree, node.name, "0"); + var actions = new Array(); + actions.push("<table class='action' id='actionsTable'>"); + if (undoArray.length) { + actions.push(createAction("Undo", "action", "SingleWordCommand Undo", "Z")); } + else { actions.push(createAction("Undo", "unavailable", "SingleWordCommand Undo", "Z")); }; + if (redoArray.length) { + actions.push(createAction("Redo", "action", "SingleWordCommand Redo", "Y")); } + else { actions.push(createAction("Redo", "unavailable", "SingleWordCommand Redo", "Y")); } + if (node.caption == "?") { + actions.push(createAction("Cut", "unavailable", "SingleWordCommand Cut", "X")); + actions.push(createAction("Copy", "unavailable", "SingleWordCommand Copy", "C")); + var AbsNodeType = abstractNode.type; + if (clipBoard && (AbsNodeType == grammar.abstract.getCat(clipBoard.name))) { + actions.push(createAction("Paste", "action", "SingleWordCommand Paste", "V")); + } + else { actions.push(createAction("Paste", "unavailable", "SingleWordCommand Paste", "V")); } + actions.push(createAction("Delete", "unavailable", "SingleWordCommand Delete", "D")); + actions.push(createAction("Refine", "action", "SingleWordCommand Refine", "R")); + actions.push(createAction("Replace", "unavailable", "SingleWordCommand Replace", "E")); + actions.push(createAction("Wrap", "unavailable", "SingleWordCommand Wrap", "W")); + } + else if (node.caption) { + actions.push(createAction("Cut", "action", "SingleWordCommand Cut", "X")); + actions.push(createAction("Copy", "action", "SingleWordCommand Copy", "C")); + actions.push(createAction("Paste", "unavailable", "SingleWordCommand Paste", "V")); + actions.push(createAction("Delete", "action", "SingleWordCommand Delete", "D")); + actions.push(createAction("Refine", "unavailable", "SingleWordCommand Refine", "R")); + actions.push(createAction("Replace", "action", "SingleWordCommand Replace", "E")); + actions.push(createAction("Wrap", "action", "SingleWordCommand Wrap", "W")); + } + + actions.push(createAction("Parse", "action", "Command Parse IndefSgDet String_N", "P")); + + if (node && !abstractNode.isComplete()) { + actions.push(createAction("RandomNode", "action", "RandomlyCommand Refine DefSgDet Node", "N")); + } + else { + actions.push(createAction("RandomNode", "unavailable", "RandomlyCommand Refine DefSgDet Node", "N")); + } + if (!abstractTree.isComplete()) { + actions.push(createAction("RandomTree", "action", "RandomlyCommand Refine DefSgDet Tree", "T")); + } + else { + actions.push(createAction("RandomTree", "unavailable", "RandomlyCommand Refine DefSgDet Tree", "T")); + } + actions.push("</table>"); + return actions.join(""); + +} + +// Creates an action +function createAction(actionName, className, caption, hotKey) { + return "<tr id='act" + actionName + "' class='" + className +"' onclick='click" + + actionName + "(\"act" + actionName + "\")'><td class='action' title='" + + caption + "'>" + caption + "</td><td class='hotKey'>(" + hotKey + ")</td></tr>"; +} + +// When the "Refine" action is selected, gets the appropriate refinements for a node +function clickRefine(actName) { + if (document.getElementById(actName).className == "action") { + if (selectedNode) { + refPageCounter = 0; + var node = getNodeFromAbstract(abstractTree, selectedNode, "0"); + if (node.type == "String" || node.type == "Int" || node.type == "Float") { + clickParse("actParse"); + } else { + highlightSelectedAction(actName); + pushUndoClearRedo(); + document.getElementById("refFrame").innerHTML = showRefinements(selectedNode); + } + } + } +} + +// Sets the className of actName to "selected" and grays out the other selections +function highlightSelectedAction(actName) { + graySelections(actName); + document.getElementById(actName).className = "selected"; + drawTree(); +} + +// Grays out all actions except one +function graySelections(except) { + var refs = document.getElementById("actFrame").getElementsByTagName("tr"); + for (var i = 0, j = refs.length; i < j; i++) { + if (refs[i].id != except) { refs[i].className = "closed"; } + } +} + +// Pushes the abstract tree into the undo array and clears the redo array +function pushUndoClearRedo() { + undoArray.push(new state(selectedNode, abstractTree, collapseBuffer)); + redoArray.length = 0; +} + +// Gets the refinements to display +function showRefinements(nodeName) { + var refs = getAvailableRefinements(nodeName, abstractTree, grammar); + var rowsPerPage = 9; + var pages = Math.floor(refs.length / rowsPerPage); + var upperLimit; + if (pages != refPageCounter) { upperLimit = (rowsPerPage * refPageCounter) + rowsPerPage; } + else { upperLimit = refs.length; } + var refinements = new Array(); + refinements.push("<table class='refinement'>"); + var keyPos = 0; + refinements.push(ref_wrapToHtml("ref", "genRefRandom", "refinement", "", keyPos, "RandomlyCommand Select IndefSgDet Refinement")); + keys["" + keyPos] = mkRefHotKey("genRefRandom"); + keyPos++; + for (var i = (rowsPerPage * refPageCounter), j = upperLimit; i < j; i++) { + refinements.push(ref_wrapToHtml("ref", refs[i], "refinement", "", keyPos, "")); + keys["" + keyPos] = mkRefHotKey(refs[i]); + keyPos++; + } + if (((refs.length % rowsPerPage == 0) && (pages - 1) > refPageCounter) || + ((refs.length % rowsPerPage != 0) && pages > refPageCounter) ) { + refinements.push(ref_wrapNextRefsToHtml("nextRefs", "Next", "refinement", "+", editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Next Page", editorGrammar.abstract.startcat)))); + keys["107"] = mkRefNextRefsHotKey("Next"); + } + if (0 < refPageCounter) { + refinements.push(ref_wrapNextRefsToHtml("nextRefs", "Previous", "refinement", "-", editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Previous Page", editorGrammar.abstract.startcat)))); + keys["109"] = mkRefNextRefsHotKey("Previous"); + } + refinements.push("</table>"); + return refinements.join(""); +} + +// Creates an HTML representation of a Refinement/Wrap +function ref_wrapToHtml(funct, name, className, arg, hotKeyPos, caption) { + var ref_wrapHtml = new Array(); + ref_wrapHtml.push("<tr id='", funct, name, "' class=", className, " onclick='", funct, "Click(\"", name, "\"", arg, ")'><td class='", className, "'>"); + if (caption) { ref_wrapHtml.push(editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree(caption, editorGrammar.abstract.startcat))); } + else { ref_wrapHtml.push(name, " : ", refArgsToHtml(name), grammar.abstract.getCat(name)); } + ref_wrapHtml.push("</td><td class='hotKey'>(", hotKeyPos, ")</td></tr>"); + return ref_wrapHtml.join(""); +} + +// Creates the function to be used by a "numeric" hot key +function mkRefHotKey(refName) { + return function() { if (document.getElementById("ref" + refName)) { refClick(refName); } } +} + +// Creates an HTML representation of the Next/Previous Refinement/Wrap page +function ref_wrapNextRefsToHtml(funct, name, className, hotKeyPos, caption) { + var ref_wrapHtml = new Array(); + ref_wrapHtml.push("<tr id='", funct, name, "' class=", className, " onclick='", funct, "Click(\"", name, "\")'><td class='", className, "'>"); + ref_wrapHtml.push(caption); + ref_wrapHtml.push("</td><td class='hotKey'>(", hotKeyPos, ")</td></tr>"); + return ref_wrapHtml.join(""); +} + +// Creates the function to be used by a "+"/"-" hot key +function mkRefNextRefsHotKey(refName) { + return function() { if (document.getElementById("nextRefs" + refName)) { nextRefsClick(refName); } } +} + +// Creates a string representation of the arguments of a refinement +function refArgsToHtml(fun) { + var args = new Array(); + for (var i = 0, j = grammar.abstract.types[fun].args.length; i < j; i++) { + args.push(grammar.abstract.types[fun].args[i], " -> "); + } + return args.join(""); +} + +// Gets the type of a meta variable +function getMetaType(absNode, route, currRoute) { + if (route == currRoute && absNode.isMeta()) { + return absNode.type; + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + var found = getMetaType(absNode.args[i], route, currRoute + "-" + i); + if (found) { return found }; + } + } +} + +// When the "Undo" action is selected, undoes the last action +function clickUndo(actName) { + if (document.getElementById(actName).className == "action" && undoArray.length) { + highlightSelectedAction(actName); + redoArray.push(new state(selectedNode, abstractTree, collapseBuffer)); + var prevState = undoArray.pop(); + selectedNode = prevState.selectedNode; + abstractTree = grammar.abstract.copyTree(prevState.tree); + collapseBuffer = prevState.collapseBuffer; + if (abstractTree.isComplete()) { selectedNode = "0"; } + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + nodeClick(selectedNode); + } +} + +// When the "Redo" action is selected, redoes the last action +function clickRedo(actName) { + if (document.getElementById(actName).className == "action" && redoArray.length) { + highlightSelectedAction(actName); + undoArray.push(new state(selectedNode, abstractTree, collapseBuffer)); + var nextState = redoArray.pop(); + selectedNode = nextState.selectedNode; + abstractTree = grammar.abstract.copyTree(nextState.tree); + collapseBuffer = nextState.collapseBuffer; + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + nodeClick(selectedNode); + } +} + +// When the "Copy" action is selected, copies the selected node to the clipboard +function clickCopy(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + if (selectedNode) { + clipBoard = grammar.abstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0")); + document.getElementById("clipboardFrame").innerHTML = clipBoard.name + " : " + grammar.abstract.getCat(clipBoard.name); + nodeClick(selectedNode); + } + } +} + +// When the "Cut" action is selected, deletes the selected node and copies it to the clipboard +function clickCut(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + clipBoard = grammar.abstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0")); + document.getElementById("clipboardFrame").innerHTML = clipBoard.name + " : " + grammar.abstract.getCat(clipBoard.name); + abstractTree = deleteNode(abstractTree, selectedNode, "0"); + concludeAction(); + } + } +} + +// Annotates the abstract tree, creates a tree from the abstract tree and selects the next meta variable +function concludeAction() { + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + selectNextMeta(); +} + +// Selects the next meta variable available +function selectNextMeta() { + nodeClick(selectedNode); + if (!abstractTree.isComplete()) { + var pathToNextMeta = ""; + var nodePos = getNavPos(selectedNode); + while (1) { + if (nodePos == navigationControlString.length) { nodePos = 0; } + var node = getNode(navigationControlString[nodePos], myTree); + if (node.caption == "?") { pathToNextMeta = node.name; break; } + nodePos++; + } + expandAscendants(pathToNextMeta); + nodeClick(pathToNextMeta); + } +} + +// Expands the ascendants of a given node +function expandAscendants(nodeName) { + var nodePath = nodeName.split("-"); + var currAscendant = nodePath.shift(); + while (nodePath.length > 0) { + var node = getNode(currAscendant, myTree); + if (node.collapsed) { + myTree = expandCollapse(myTree, currAscendant); + } + currAscendant += "-" + nodePath.shift(); + } +} + +// When the "Paste" action is selected, pastes the contents of the clipboard into the selected node +function clickPaste(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + abstractTree = insertNode(abstractTree, selectedNode, "0", grammar.abstract.copyTree(clipBoard)); + concludeAction(); + } + } +} + +// When the "Delete" action is selected, deletes the selected node +function clickDelete(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + abstractTree = deleteNode(abstractTree, selectedNode, "0"); + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + nodeClick(selectedNode); + } + } +} + +// When the "Replace" action is selected, replaces the selected node with another refinement +function clickReplace(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + refPageCounter = 0; + abstractTree = deleteNode(abstractTree, selectedNode, "0"); + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + drawTree(); + document.getElementById("refFrame").innerHTML = showRefinements(selectedNode); + } + } +} + +// When the "Wrap" action is selected, wraps around the selected node with another refinement +function clickWrap(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + var node = getNode(selectedNode, myTree); + if (selectedNode) { + refPageCounter = 0; + var wrappers = showWrappers(node.caption); + document.getElementById("refFrame").innerHTML = wrappers; + if (wrappers.length <= 31) { + var lin = editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("ErrorMessage Available Wrapper", editorGrammar.abstract.startcat)); + alert(lin.substring(0,1).toUpperCase().concat(lin.substring(1))); + document.getElementById("actFrame").innerHTML = showActions(); + nodeClick(selectedNode); + } + } + } +} + +// Gets the wrappers to display +function showWrappers(nodeCaption) { + var nodeType = grammar.abstract.types[nodeCaption].cat; + var rowsPerPage = 10; + var availWrappers = getAvailableWrappers(nodeType, grammar, selectedNode); + var pages = Math.floor(availWrappers.length / rowsPerPage); + var upperLimit; + if (pages != refPageCounter) { upperLimit = (rowsPerPage * refPageCounter) + rowsPerPage; } + else { upperLimit = availWrappers.length; } + var wrappers = new Array(); + wrappers.push("<table class='wrapper'>"); + var keyPos = 0; + for (var i = (rowsPerPage * refPageCounter), j = upperLimit; i < j; i++) { + wrappers.push(ref_wrapToHtml("wrap", availWrappers[i][0], "wrapper", ", " + availWrappers[i][1], keyPos, "")); + keys["" + keyPos] = mkWrapHotKey(availWrappers[i][0], availWrappers[i][1]); + keyPos++; + } + if (((availWrappers.length % rowsPerPage == 0) && (pages - 1) > refPageCounter) || + ((availWrappers.length % rowsPerPage != 0) && pages > refPageCounter) ) { + wrappers.push(ref_wrapNextRefsToHtml("nextWraps", "Next", "wrapper", "+", editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Next Page", editorGrammar.abstract.startcat)))); + keys["107"] = mkWrapNextRefsHotKey("Next"); + } + if (0 < refPageCounter) { + wrappers.push(ref_wrapNextRefsToHtml("nextWraps", "Previous", "wrapper", "-", editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Previous Page", editorGrammar.abstract.startcat)))); + keys["109"] = mkWrapNextRefsHotKey("Previous"); + } + wrappers.push("</table>"); + return wrappers.join(""); +} + +// Creates the function to be used by a "numeric" hot key +function mkWrapHotKey(wrapName, argPos) { + return function() { if (document.getElementById("wrap" + wrapName)) { wrapClick(wrapName, argPos); } } +} + +// Creates the function to be used by a "+"/"-" hot key +function mkWrapNextRefsHotKey(wrapName) { + return function() { if (document.getElementById("nextWraps" + wrapName)) { nextWrapsClick(wrapName); } } +} + +// When the "Parse" action is selected, asks the user for a string and parses it +// to generate the subnode +function clickParse(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + var node = getNode(selectedNode, myTree); + if (selectedNode) { + pushUndoClearRedo(); + drawEditFrame(); + } + } +} + +// Displays the parse trees in the refinements panel +function showTrees() { + var rowsPerPage = 10; + var pages = Math.floor(parseTrees.length / rowsPerPage); + var upperLimit; + if (pages != refPageCounter) { upperLimit = (rowsPerPage * refPageCounter) + rowsPerPage; } + else { upperLimit = parseTrees.length; } + var htmlTrees = new Array(); + htmlTrees.push("<table class='tree'>"); + var keyPos = 0; + for (var i = (rowsPerPage * refPageCounter), j = upperLimit; i < j; i++) { + htmlTrees.push(treeToHtml(i, keyPos, "")); + keys["" + keyPos] = mkTreeHotKey(i, keyPos); + keyPos++; + } + if (((parseTrees.length % rowsPerPage == 0) && (pages - 1) > refPageCounter) || + ((parseTrees.length % rowsPerPage != 0) && pages > refPageCounter) ) { + htmlTrees.push(ref_wrapNextRefsToHtml("nextTrees", "Next", "tree", "+", editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Next Page", editorGrammar.abstract.startcat)))); + keys["107"] = mkTreeNextRefsHotKey("Next"); + } + if (refPageCounter > 0) { + htmlTrees.push(ref_wrapNextRefsToHtml("nextTrees", "Previous", "tree", "-", editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree("CommandAdj Show DefSgDet Previous Page", editorGrammar.abstract.startcat)))); + keys["109"] = mkTreeNextRefsHotKey("Previous"); + } + htmlTrees.push("</table>"); + return htmlTrees.join(""); +} + +// Creates an HTML representation of a parse Tree to be shown in the refinements panel +function treeToHtml(i, hotKeyPos, caption) { + var htmlTree = new Array(); + htmlTree.push("<tr id='tree", hotKeyPos, "' class='tree' onclick='treeClick(", i, ")'><td class='tree'>"); + if (caption) { htmlTree.push(editorGrammar.concretes[selectedLanguage].linearize(editorGrammar.abstract.parseTree(caption, editorGrammar.abstract.startcat))); } + else { htmlTree.push(parseTrees[i].show()); } + htmlTree.push("</td><td class='hotKey'>(", hotKeyPos, ")</td></tr>"); + return htmlTree.join(""); +} + +// Creates the function to be used by a "numeric" hot key +function mkTreeHotKey(i, keyPos) { + return function() { if (document.getElementById("tree" + keyPos)) { treeClick(i); } } +} + +// Creates the function to be used by a "+"/"-" hot key +function mkTreeNextRefsHotKey(treeName) { + return function() { if (document.getElementById("nextTrees" + treeName)) { nextTreesClick(treeName); } } +} + + +// When the "RandomNode" action is selected, refines the node at random +function clickRandomNode(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + if (selectedNode) { + var tempTree = grammar.abstract.copyTree(abstractTree); + abstractTree = insertNode(tempTree, selectedNode, "0", grammar.abstract.copyTree(fillSubTree(grammar.abstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0")), grammar))); + concludeAction(); + } + } +} + +// When the "RandomTree" action is selected, refines the tree at random +function clickRandomTree(actName) { + if (document.getElementById(actName).className == "action") { + highlightSelectedAction(actName); + pushUndoClearRedo(); + abstractTree = grammar.abstract.copyTree(fillSubTree(abstractTree, grammar)); + concludeAction(); + } +} + +// If a node is selected and is of type meta, it refines the node with a type refName +function refClick(refName) { + if (selectedNode) { + if (refName == "genRefRandom") { + var refs = getAvailableRefinements(selectedNode, abstractTree, grammar); + refName = refs[Math.floor(refs.length * Math.random())]; + } + abstractTree = refineAbstractTree(abstractTree, selectedNode, "0", refName); + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + clearHotKeys(); + concludeAction(); + } +} + +// Creates a tree from an abstract tree +function treeFromAbstract(abstractNode, name) { + var node = new treeNode(name, abstractNode.name); + if (node.caption == "?") { + node.cat = abstractNode.type; } + else { + if (grammar.abstract.types[node.caption]) { + node.cat = grammar.abstract.getCat(node.caption); + } else { + node.cat = node.caption.substring(0, node.caption.indexOf("_")); + grammar.abstract.addType(node.caption, [], node.cat); + var linStr = undefined; + if (node.cat == "String") { + linStr = node.caption.substring(node.caption.indexOf("\"") + 1, node.caption.length - 1); + } else { + linStr = node.caption.substring(node.caption.lastIndexOf("_") + 1) + } + for (var i in grammar.concretes) { + grammar.concretes[i].addRule(node.caption, function(cs){ return new Arr(new Str(linStr));}); + } + } + } + if (wasCollapsed(node.name)) { node.collapsed = true; } + for (var i = 0, j = abstractNode.args.length; i < j; i++) { + node.addChild(i, treeFromAbstract(abstractNode.args[i], name + "-" + i)); + } + return node +} + +// Wraps a refinement around a node +function wrapClick(wrapName, argPos) { + if (selectedNode) { + var tempNode = createRefinement(wrapName); + tempNode.setArg(argPos, grammar.abstract.copyTree(getNodeFromAbstract(abstractTree, selectedNode, "0"))); + abstractTree = insertNode(abstractTree, selectedNode, "0", tempNode); + var cat = grammar.abstract.getCat(tempNode.name); + if (selectedNode == "0" && cat != grammar.abstract.startcat) { + grammar.abstract.startcat = cat; + } + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + clearHotKeys(); + concludeAction(); + } +} + +// Wraps a refinement around a node +function treeClick(i) { + if (selectedNode) { + pushUndoClearRedo(); + var node = getNode(selectedNode, myTree); + var tempNode = grammar.abstract.copyTree(grammar.abstract.handleLiterals(parseTrees[i], node.cat)); + abstractTree = insertNode(abstractTree, selectedNode, "0", tempNode); + document.getElementById("actFrame").innerHTML = showActions(); + document.getElementById("refFrame").innerHTML = ""; + clearHotKeys(); + concludeAction(); + } +} + +// Handler for the escape key +function clickEsc() { + if ((document.getElementById("actRefine").className == "selected" || + document.getElementById("actReplace").className == "selected" || + document.getElementById("actWrap").className == "selected" || + document.getElementById("actParse").className == "selected") && undoArray.length) { + var prevState = undoArray.pop(); + selectedNode = prevState.selectedNode; + abstractTree = grammar.abstract.copyTree(prevState.tree); + collapseBuffer = prevState.collapseBuffer; + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + myTree = treeFromAbstract(abstractTree, "0"); + document.getElementById("actFrame").innerHTML = showActions(); + if (selectedNode) { nodeClick(selectedNode) } + } +} + +// If there are over ten refinements available shows only the selected nine +function nextRefsClick(refName) { + if (refName == "Next") { refPageCounter++; } else { refPageCounter--; } + clearHotKeys(); + document.getElementById("refFrame").innerHTML = showRefinements(selectedNode); +} + +// If there are over ten wrappers available shows only the selected nine +function nextWrapsClick(wrapName) { + if (wrapName == "Next") { refPageCounter++; } else { refPageCounter--; } + clearHotKeys(); + var node = getNode(selectedNode, myTree); + document.getElementById("refFrame").innerHTML = showWrappers(node.caption); +} + +// If there are over ten parse trees available shows only the selected nine +function nextTreesClick(treeName) { + if (treeName == "Next") { refPageCounter++; } else { refPageCounter--; } + clearHotKeys(); + document.getElementById("refFrame").innerHTML = showTrees(); +} + +/* -------------------------------------------------------------------------- */ +/* ---------- GUI independent functions to handle syntax editing ---------- */ +/* -------------------------------------------------------------------------- */ + +// Gets the node rooted at the indicated path (route) in the tree absNode +function getNodeFromAbstract(absNode, route, currRoute) { + if (route == currRoute) { + return absNode; + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + var found = getNodeFromAbstract(absNode.args[i], route, currRoute + "-" + i); + if (found) { return found; } + } + } +} + +// Gets the first metavariable from the abstract tree rooted at the path route +function getNextMetaFromAbstract(node, route) { + if (node.isMeta()) { return route; } + for (var i = 0, j = node.args.length; i < j; i++) { + var found = getNextMetaFromAbstract(node.args[i], route + "-" + i); + if (found) { return found; } + } +} + +// Inserts the node into the abstract tree absNode at the path route +function insertNode(absNode, route, currRoute, node) { + if (route == currRoute) { + return node; + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + absNode.setArg(i, insertNode(absNode.args[i], route, currRoute + "-" + i, node)); + } + return absNode; + } +} + +// Deletes the node rooted at the path route from the abstract tree absNode +function deleteNode(absNode, route, currRoute) { + if (route == currRoute) { + return new Fun("?"); + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + absNode.setArg(i, deleteNode(absNode.args[i], route, currRoute + "-" + i)); + } + return absNode; + } +} + +// Gets the available refinements for the node nodeName, which is in the tree +// abstractTree, from those found in the grammar. +function getAvailableRefinements(nodeName, abstractTree, grammar) { + var node = getNodeFromAbstract(abstractTree, nodeName, "0"); + var metaType = node.type; + var refinements = new Array(); + for (var fun in grammar.abstract.types) { + if (grammar.abstract.types[fun].cat == metaType) { + refinements[refinements.length] = fun; + } + } + return refinements; +} + +// It refines the node rooted at the path route in the abstract tree absNode +// with the refinement refName. Returns the refined abstract tree. +function refineAbstractTree(absNode, route, currRoute, refName) { + if (route == currRoute && absNode.isMeta()) { + return createRefinement(refName); + } + else { + for (var i = 0, j = absNode.args.length; i < j; i++) { + absNode.setArg(i, refineAbstractTree(absNode.args[i], route, currRoute + "-" + i, refName)); + } + return absNode; + } +} + +// Creates a node of type refName object with the appropriate number of arguments +function createRefinement(refName) { + var newRef = new Fun(refName); + for (var i = 0, j = grammar.abstract.types[refName].args.length; i < j; i++) { + newRef.setArg(i, new Fun("?")); + } + return newRef; +} + +// Gets the available wrappers for a node of type nodeType found in the grammar +function getAvailableWrappers(nodeType, grammar, top) { + var wrappers = new Array(); + for (var fun in grammar.abstract.types) { + for (var i = 0, j = grammar.abstract.types[fun].args.length; i < j; i++) { + if (top != "0") { + if (grammar.abstract.types[fun].args[i] == nodeType && grammar.abstract.types[fun].cat == nodeType) { + wrappers[wrappers.length] = new Array(fun, i); + break; + } + } else { + if (grammar.abstract.types[fun].args[i] == nodeType) { + wrappers[wrappers.length] = new Array(fun, i); + break; + } + } + } + } + return wrappers; +} + +// Instantiates metavariables found in the tree abstractTree with refinements +// selected at random from those found in the grammar +function fillSubTree(abstractTree, grammar) { + while (!abstractTree.isComplete()) { + var nodeToRefine = getNextMetaFromAbstract(abstractTree, "0"); + if (nodeToRefine) { + var refs = getAvailableRefinements(nodeToRefine, abstractTree, grammar); + if (refs.length == 0) { + var node = getNodeFromAbstract(abstractTree, nodeToRefine, "0"); + if (node.type == "String" || node.type == "Int" || node.type == "Float") { + var newType = undefined; + var newTypeCat = node.type + "_Literal_"; + switch(node.type) + { + case "String": + newType = "AutoString"; + break; + case "Int": + newType = "8"; + break; + case "Float": + newType = "8.0"; + break; + } + if (node.type == "String") { + newTypeCat += "\"" + newType + "\""; + } else { + newTypeCat += newType; + } + if (!grammar.abstract.types[newTypeCat]) { + grammar.abstract.addType(newTypeCat, [], node.type); + for (var i in grammar.concretes) { + grammar.concretes[i].addRule(newTypeCat, function(cs){ return new Arr(new Str(newType));}); + } + } + node.name = newTypeCat; + abstractTree = insertNode(abstractTree, nodeToRefine, "0", node); + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + } + } + else { + var selectedRef = refs[Math.floor(refs.length * Math.random())]; + abstractTree = refineAbstractTree(abstractTree, nodeToRefine, "0", selectedRef); + abstractTree = grammar.abstract.annotate(abstractTree, grammar.abstract.startcat); + } + } + } + return abstractTree; +}
@@ -0,0 +1,54 @@+/* Output */++function sayText(text) {+ document.voice_output_text = text;+ activateForm("voice_output");+}++/* 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 */++/* Gets the head element of the document. */+function getHeadElement() {+ var hs = document.getElementsByTagName("head");+ if (hs.length == 0) {+ var head = document.createElement("head");+ document.documentElement.insertBefore(head, document.documentElement.firstChild);+ return head;+ } else {+ return hs[0];+ }+}++/* Gets the body element of the document. */+function getBodyElement() {+ var bs = document.getElementsByTagName("body");+ if (bs.length == 0) {+ var body = document.createElement("body");+ document.documentElement.appendChild(body);+ return body;+ } else {+ return bs[0];+ }+}++/* Removes all the children of a node */+function removeChildren(node) {+ while (node.hasChildNodes()) {+ node.removeChild(node.firstChild);+ }+}++function setText(node, text) {+ removeChildren(node);+ node.appendChild(document.createTextNode(text));+}
@@ -0,0 +1,1148 @@++function GFGrammar(abstract, concretes) {+ this.abstract = abstract;+ this.concretes = concretes;+}++/* Translates a string from any concrete syntax to all concrete syntaxes. + Uses the start category of the grammar.+*/+GFGrammar.prototype.translate = function (input, fromLang, toLang) {+ var outputs = new Object();+ var fromConcs = this.concretes;+ if (fromLang) {+ fromConcs = new Object();+ fromConcs[fromLang] = this.concretes[fromLang];+ }+ var toConcs = this.concretes;+ if (toLang) {+ toConcs = new Object();+ toConcs[toLang] = this.concretes[toLang];+ }+ for (var c1 in fromConcs) {+ var concrete = this.concretes[c1];+ var trees = concrete.parseString(input, this.abstract.startcat);+ if (trees.length > 0) {+ outputs[c1] = new Array();+ for (var i in trees) {+ outputs[c1][i] = new Object();+ for (var c2 in toConcs) {+ outputs[c1][i][c2] = this.concretes[c2].linearize(trees[i]);+ }+ }+ }+ }+ return outputs;+}+++/* ------------------------------------------------------------------------- */+/* ----------------------------- LINEARIZATION ----------------------------- */+/* ------------------------------------------------------------------------- */++/* Extension to the String object */++String.prototype.tag = "";+String.prototype.setTag = function (tag) { this.tag = tag; };++/* Abstract syntax trees */+function Fun(name) {+ this.name = name;+ this.args = new Array();+ for (var i = 1; i < arguments.length; i++) {+ this.args[i-1] = arguments[i];+ }+}+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 += " " + (isUndefined(cs[i]) ? "undefined" : 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 this.args) {+ if (!this.args[i].isComplete()) {+ return false;+ }+ }+ return true;+ }+} ;+Fun.prototype.isLiteral = function() {+ return (/^[\"\-\d]/).test(this.name);+} ;+Fun.prototype.isString = function() {+ return (/^\".*\"$/).test(this.name);+} ;+Fun.prototype.isInt = function() {+ return (/^\-?\d+$/).test(this.name);+} ;+Fun.prototype.isFloat = function() {+ return (/^\-?\d*(\.\d*)?$/).test(this.name) &&+ this.name != "." &&+ this.name != "-.";+} ;+Fun.prototype.isEqual = function(obj) {+ if (this.name != obj.name)+ return false;++ for (var i in this.args) {+ if (!this.args[i].isEqual(obj.args[i]))+ return false;+ }+ + return true;+}++/* Type annotation */++function GFAbstract(startcat, types) {+ this.startcat = startcat;+ this.types = types;+}+GFAbstract.prototype.addType = function(fun, args, cat) {+ this.types[fun] = new Type(args, cat);+} ;+GFAbstract.prototype.getArgs = function(fun) {+ return this.types[fun].args;+}+GFAbstract.prototype.getCat = function(fun) {+ return this.types[fun].cat;+};+GFAbstract.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;+} ;+GFAbstract.prototype.handleLiterals = function(tree, type) {+ if (tree.name != '?') {+ if (type == "String" || type == "Int" || type == "Float") {+ tree.name = type + "_Literal_" + tree.name;+ } else {+ var typ = this.types[tree.name];+ for (var i in tree.args) {+ this.handleLiterals(tree.args[i], typ.args[i]);+ }+ }+ }+ return tree;+} ;+/* Hack to get around the fact that our SISR doesn't build real Fun objects. */+GFAbstract.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;+} ;+GFAbstract.prototype.parseTree = function(str, type) { + return this.annotate(this.parseTree_(str.match(/[\w\'\.\"]+|\(|\)|\?|\:/g), 0), type); +} ;+GFAbstract.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 == '?') {+ var tree = this.parseTree_(tokens, 0);+ 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 GFConcrete(flags, productions, functions, sequences, startCats, totalFIds) {+ this.flags = flags;+ this.productions = productions;+ this.functions = functions;+ this.sequences = sequences;+ this.startCats = startCats;+ this.totalFIds = totalFIds;++ this.pproductions = productions;+ this.lproductions = new Object();++ for (var fid in productions) {+ for (var i in productions[fid]) {+ var rule = productions[fid][i];+ + if (rule.id == "Apply") {+ var fun = this.functions[rule.fun];+ var lproductions = this.lproductions;+ + rule.fun = fun;++ var register = function (args, key, i) {+ if (i < args.length) {+ var c = 0;+ var arg = args[i].fid;+ + for (var k in productions[arg]) {+ var rule = productions[arg][k];+ if (rule.id == "Coerce") {+ register(args,key + "_" + rule.arg,i+1);+ c++;+ }+ }+ + if (c == 0)+ register(args,key + "_" + arg,i+1);+ } else {+ var set = lproductions[key];+ if (set == null) {+ set = new Array();+ lproductions[key] = set;+ }+ set.push({fun: fun, fid: fid});+ }+ }++ register(rule.args,rule.fun.name,0);+ }+ }+ }+ + for (var i in functions) {+ var fun = functions[i];+ for (var j in fun.lins) {+ fun.lins[j] = sequences[fun.lins[j]];+ }+ }+}+GFConcrete.prototype.linearizeSyms = function (tree, tag) { + var res = new Array();+ + if (tree.isString()) {+ var sym = new SymKS(tree.name);+ sym.tag = tag;+ res.push({fid: -1, table: [[sym]]});+ } else if (tree.isInt()) {+ var sym = new SymKS(tree.name);+ sym.tag = tag;+ res.push({fid: -2, table: [[sym]]});+ } else if (tree.isFloat()) {+ var sym = new SymKS(tree.name);+ sym.tag = tag;+ res.push({fid: -3, table: [[sym]]});+ } else if (tree.isMeta()) {+ // TODO: Use lindef here+ var cat = this.startCats[tree.type];+ + var sym = new SymKS(tree.name);+ sym.tag = tag;+ + for (var fid = cat.s; fid <= cat.e; fid++) {+ res.push({fid: fid, table: [[sym]]});+ }+ } else {+ var cs = new Array();+ for (var i in tree.args) {+ // TODO: we should handle the case for nondeterministic linearization+ cs.push(this.linearizeSyms(tree.args[i],tag + "-" + i)[0]);+ }+ var key = tree.name;+ for (var i in cs) {+ key = key + "_" + cs[i].fid+ }++ for (var i in this.lproductions[key]) {+ var rule = this.lproductions[key][i];+ var row = {fid: rule.fid, table: new Array()};+ for (var j in rule.fun.lins) {+ var lin = rule.fun.lins[j];+ var toks = new Array();+ row.table[j] = toks;+ + for (var k in lin) {+ var sym = lin[k];+ switch (sym.id) {+ case "Arg":+ case "Lit":+ var ts = cs[sym.i].table[sym.label];+ for (var l in ts) {+ toks.push(ts[l]);+ }+ break;+ case "KS":+ case "KP":+ toks.push(this.tagIt(sym,tag));+ break;+ }+ }+ }+ res.push(row);+ }+ }+ + return res;+};+GFConcrete.prototype.syms2toks = function (syms) {+ var ts = new Array();+ for (var i in syms) {+ var sym = syms[i];+ switch (sym.id) {+ case "KS":+ for (var j in sym.tokens) {+ ts.push(this.tagIt(sym.tokens[j],sym.tag));+ }+ break;+ case "KP":+ for (var j in sym.tokens) {+ ts.push(this.tagIt(sym.tokens[j],sym.tag));+ }+ break;+ }+ }+ return ts;+};+GFConcrete.prototype.linearizeAll = function (tree) {+ var res = this.linearizeSyms(tree,"0");+ for (var l in res) {+ res[l] = this.unlex(this.syms2toks(res[l].table[0]));+ }++ return res;+};+GFConcrete.prototype.linearize = function (tree) {+ var res = this.linearizeSyms(tree,"0");+ return this.unlex(this.syms2toks(res[0].table[0]));+}+GFConcrete.prototype.tagAndLinearize = function (tree) { + var res = this.linearizeSyms(tree,"0");+ return this.syms2toks(res[0].table[0]);+}+GFConcrete.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;+};+GFConcrete.prototype.tagIt = function (obj, tag) {+ if (isString(obj)) {+ var o = new String(obj);+ o.setTag(tag);+ return o;+ } else {+ var me = arguments.callee;+ if (arguments.length == 2) {+ me.prototype = obj;+ var o = new me();+ o.tag = tag;+ return o;+ }+ }+};++/* 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 + "}";+ }+}++/* ------------------------------------------------------------------------- */+/* -------------------------------- PARSING -------------------------------- */+/* ------------------------------------------------------------------------- */+++GFConcrete.prototype.showRules = function () {+ var ruleStr = new Array();+ ruleStr.push("");+ for (var i = 0, j = this.rules.length; i < j; i++) {+ ruleStr.push(this.rules[i].show());+ }+ return ruleStr.join("");+};+GFConcrete.prototype.tokenize = function (string) {+ var inToken = false;+ var start, end;+ var tokens = new Array();++ for (var i = 0; i < string.length; i++) {+ if ( string.charAt(i) == ' ' // space+ || string.charAt(i) == '\f' // form feed+ || string.charAt(i) == '\n' // newline+ || string.charAt(i) == '\r' // return+ || string.charAt(i) == '\t' // horizontal tab+ || string.charAt(i) == '\v' // vertical tab+ || string.charAt(i) == String.fromCharCode(160) // + ) {+ if (inToken) {+ end = i-1;+ inToken = false;+ + tokens.push(string.substr(start,end-start+1));+ }+ } else {+ if (!inToken) {+ start = i;+ inToken = true;+ }+ }+ }+ + if (inToken) {+ end = i-1;+ inToken = false;+ + tokens.push(string.substr(start,end-start+1));+ }+ return tokens;+};+GFConcrete.prototype.parseString = function (string, cat) {+ var tokens = this.tokenize(string);+ + var ps = new ParseState(this, cat);+ for (var i in tokens) {+ if (!ps.next(tokens[i]))+ return new Array();+ }+ return ps.extractTrees();+};+/**+ * Generate list of suggestions given an input string+ */+GFConcrete.prototype.complete = function (input, cat) {++ // Parameter defaults+ if (input == null) input = "";+ if (cat == null) cat = grammar.abstract.startcat;+ + // Tokenise input string & remove empty tokens+ tokens = input.trim().split(' ');+ for (var i = tokens.length - 1; i >= 0; i--) {+ if (tokens[i] == "") { tokens.splice(i, 1); }+ }+ + // Capture last token as it may be partial+ current = tokens.pop();+ if (current == null) current = "";++ // Init parse state objects.+ // ps2 is used for testing whether the final token is parsable or not.+ var ps = new ParseState(this, cat);+ var ps2 = new ParseState(this, cat);+ + // Iterate over tokens, feed one by one to parser+ for (var i = 0; i < tokens.length ; i++) {+ if (!ps.next(tokens[i])) {+ return new Array(); // Incorrect parse, nothing to suggest+ }+ ps2.next(tokens[i]); // also consume token in ps2+ }+ + // Attempt to also parse current, knowing it may be incomplete+ if (ps2.next(current)) {+ ps.next(current);+ tokens.push(current);+ current = "";+ }+ delete(ps2); // don't need this anymore+ + // Parse is successful so far, now get suggestions+ var acc = ps.complete(current);+ + // Format into just a list of strings & return+ // (I know the multiple nesting looks horrible)+ var suggs = new Array();+ if (acc.value) {+ // Iterate over all acc.value[]+ for (var v = 0; v < acc.value.length; v++) {+ // Iterate over all acc.value[].seq[]+ for (var s = 0; s < acc.value[v].seq.length; s++) {+ if (acc.value[v].seq[s].tokens == null) continue;+ // Iterate over all acc.value[].seq[].tokens+ for (var t = 0; t < acc.value[v].seq[s].tokens.length; t++) {+ suggs.push( acc.value[v].seq[s].tokens[t] );+ }+ }+ }+ }+ + // Note: return used tokens too+ return { 'consumed' : tokens, 'suggestions' : suggs };+}++// Apply Object Definition++function Apply(fun, args) {+ this.id = "Apply";+ this.fun = fun;+ this.args = args;+}+Apply.prototype.show = function (cat) {+ var recStr = new Array();+ recStr.push(cat, " -> ", fun.name, " [", this.args, "]");+ return recStr.join("");+};+Apply.prototype.isEqual = function (obj) {+ if (this.id != obj.id || this.fun != obj.fun || this.args.length != obj.args.length)+ return false;+ + for (var i in this.args) {+ if (this.args[i] != obj.args[i])+ return false;+ }++ return true;+};++function PArg() {+ this.fid = arguments[arguments.length-1];+ if (arguments.length > 1)+ this.hypos = arguments.slice(0,arguments.length-1);+}++// Coerce Object Definition++function Coerce(arg) {+ this.id = "Coerce";+ this.arg = arg;+}+Coerce.prototype.show = function (cat) {+ var recStr = new Array();+ recStr.push(cat, " -> _ [", this.args, "]");+ return recStr.join("");+};++// Const Object Definition++function Const(lit, toks) {+ this.id = "Const";+ this.lit = lit;+ this.toks = toks;+}+Const.prototype.show = function (cat) {+ var recStr = new Array();+ recStr.push(cat, " -> ", lit.print());+ return recStr.join("");+};+Const.prototype.isEqual = function (obj) {+ if (this.id != obj.id || this.lit.isEqual(obj.lit) || this.toks.length != obj.toks.length)+ return false;+ + for (var i in this.toks) {+ if (this.toks[i] != obj.toks[i])+ return false;+ }++ return true;+};++function CncFun(name,lins) {+ this.name = name;+ this.lins = lins;+}++// Definition of symbols present in linearization records++// Object to represent argument projections in grammar rules+function SymCat(i, label) {+ this.id = "Arg";+ this.i = i;+ this.label = label;+}+SymCat.prototype.getId = function () { return this.id; };+SymCat.prototype.getArgNum = function () { return this.i };+SymCat.prototype.show = function () {+ var argStr = new Array();+ argStr.push(this.i, this.label);+ return argStr.join(".");+};++// Object to represent terminals in grammar rules+function SymKS() {+ this.id = "KS";+ this.tokens = arguments;+}+SymKS.prototype.getId = function () { return this.id; };+SymKS.prototype.show = function () {+ var terminalStr = new Array();+ terminalStr.push('"', this.tokens, '"');+ return terminalStr.join("");+};++// Object to represent pre in grammar rules+function SymKP(tokens,alts) {+ this.id = "KP";+ this.tokens = tokens;+ this.alts = alts;+}+SymKP.prototype.getId = function () { return this.id; };+SymKP.prototype.show = function () {+ var terminalStr = new Array();+ terminalStr.push('"', this.tokens, '"');+ return terminalStr.join("");+};++function Alt(tokens, prefixes) {+ this.tokens = tokens;+ this.prefixes = prefixes;+}++// Object to represent pre in grammar rules+function SymLit(i,label) {+ this.id = "Lit";+ this.i = i;+ this.label = label;+}+SymLit.prototype.getId = function () { return this.id; };+SymLit.prototype.show = function () {+ var argStr = new Array();+ argStr.push(this.i, this.label);+ return argStr.join(".");+};++// Parsing++function Trie() {+ this.value = null;+ this.items = new Object();+}+Trie.prototype.insertChain = function(keys,obj) {+ var node = this;+ for (var i in keys) {+ var nnode = node.items[keys[i]];+ if (nnode == null) {+ nnode = new Trie();+ node.items[keys[i]] = nnode;+ }+ node = nnode;+ }+ node.value = obj;+}+Trie.prototype.insertChain1 = function(keys,obj) {+ var node = this;+ for (var i in keys) {+ var nnode = node.items[keys[i]];+ if (nnode == null) {+ nnode = new Trie();+ node.items[keys[i]] = nnode;+ }+ node = nnode;+ }+ if (node.value == null)+ node.value = [obj];+ else+ node.value.push(obj);+}+Trie.prototype.lookup = function(key,obj) {+ return this.items[key];+}+Trie.prototype.isEmpty = function() {+ if (this.value != null)+ return false;+ + for (var i in this.items) {+ return false;+ }+ + return true;+}++function ParseState(concrete, startCat) {+ this.concrete = concrete;+ this.startCat = startCat;+ this.items = new Trie();+ this.chart = new Chart(concrete);++ var items = new Array();+ + var fids = concrete.startCats[startCat];+ if (fids != null) {+ var fid;+ for (fid = fids.s; fid <= fids.e; fid++) {+ var exProds = this.chart.expandForest(fid);+ for (var j in exProds) {+ var rule = exProds[j];+ var fun = rule.fun;+ for (var lbl in fun.lins) {+ items.push(new ActiveItem(0,0,rule.fun,fun.lins[lbl],rule.args,fid,lbl));+ }+ }+ }+ }+ + this.items.insertChain(new Array(), items);+}+ParseState.prototype.next = function (token) {+ var acc = this.items.lookup(token);+ if (acc == null)+ acc = new Trie();++ this.process( this.items.value+ , function (fid) {+ switch (fid) {+ case -1: return new Const(new Fun('"'+token+'"'), [token]); // String+ case -2: var x = parseInt(token,10);+ if (token == "0" || (x != 0 && !isNaN(x))) // Integer+ return new Const(new Fun(token), [token]);+ else+ return null;+ case -3: var x = parseFloat(token);+ if (token == "0" || token == "0.0" || (x != 0 && !isNaN(x))) // Float+ return new Const(new Fun(token), [token]);+ else+ return null;+ }+ + return null;+ }+ , function (tokens, item) {+ if (tokens[0] == token) {+ var tokens1 = new Array();+ var i;+ for (i = 1; i < tokens.length; i++) {+ tokens1[i-1] = tokens[i];+ }+ acc.insertChain1(tokens1, item);+ }+ }+ );++ this.items = acc;+ this.chart.shift();+ + return !this.items.isEmpty();+}+/**+ * For a ParseState and a partial input, return all possible completions+ * Based closely on ParseState.next()+ * currentToken could be empty or a partial string+ */+ParseState.prototype.complete = function (currentToken) {++ // Initialise accumulator for suggestions+ var acc = this.items.lookup(currentToken);+ if (acc == null)+ acc = new Trie();+ + this.process(+ // Items+ this.items.value,+ + // Deal with literal categories+ function (fid) {+ // Always return null, as suggested by Krasimir+ return null;+ },+ + // Takes an array of tokens and populates the accumulator+ function (tokens, item) {+ if (currentToken == "" || tokens[0].indexOf(currentToken) == 0) { //if begins with...+ var tokens1 = new Array();+ for (var i = 1; i < tokens.length; i++) {+ tokens1[i-1] = tokens[i];+ }+ acc.insertChain1(tokens1, item);+ }+ }+ );+ + // Return matches+ return acc;+}+ParseState.prototype.extractTrees = function() {+ this.process( this.items.value+ , function (fid) {+ return null;+ }+ , function (tokens, item) {+ }+ );+ + + var totalFIds = this.concrete.totalFIds;+ var forest = this.chart.forest;+ + function go(fid) {+ if (fid < totalFIds) {+ return [new Fun("?")];+ } else {+ var trees = new Array();++ var rules = forest[fid];+ for (var j in rules) {+ var rule = rules[j];+ + if (rule.id == "Const") {+ trees.push(rule.lit);+ } else { + var arg_ix = new Array();+ var arg_ts = new Array();+ for (var k in rule.args) {+ arg_ix[k] = 0;+ arg_ts[k] = go(rule.args[k].fid);+ }+ + while (true) {+ var t = new Fun(rule.fun.name);+ for (var k in arg_ts) {+ t.setArg(k,arg_ts[k][arg_ix[k]]);+ }+ trees.push(t);+ + var i = 0;+ while (i < arg_ts.length) {+ arg_ix[i]++;+ if (arg_ix[i] < arg_ts[i].length)+ break;++ arg_ix[i] = 0;+ i++; + }+ + if (i >= arg_ts.length)+ break;+ }+ }+ }+ + return trees;+ }+ }++ + var trees = new Array();+ var fids = this.concrete.startCats[this.startCat];+ if (fids != null) {+ var fid0;+ for (fid0 = fids.s; fid0 <= fids.e; fid0++) {+ + var labels = new Object();+ var rules = this.chart.expandForest(fid0);+ for (var i in rules) {+ for (var lbl in rules[i].fun.lins) {+ labels[lbl] = true;+ }+ }+ + for (var lbl in labels) {+ var fid = this.chart.lookupPC(fid0,lbl,0);+ var arg_ts = go(fid);+ for (var i in arg_ts) {+ var isMember = false;+ for (var j in trees) {+ if (arg_ts[i].isEqual(trees[j])) {+ isMember = true;+ break;+ }+ }+ + if (!isMember)+ trees.push(arg_ts[i]);+ }+ }+ }+ } + + return trees;+}+ParseState.prototype.process = function (agenda,literalCallback,tokenCallback) {+ if (agenda != null) {+ while (agenda.length > 0) {+ var item = agenda.pop();+ var lin = item.seq;++ if (item.dot < lin.length) {+ var sym = lin[item.dot];+ switch (sym.id) {+ case "Arg": var fid = item.args[sym.i].fid;+ var label = sym.label;++ var items = this.chart.lookupAC(fid,label);+ if (items == null) {+ var rules = this.chart.expandForest(fid);+ for (var j in rules) {+ var rule = rules[j];+ agenda.push(new ActiveItem(this.chart.offset,0,rule.fun,rule.fun.lins[label],rule.args,fid,label));+ }+ this.chart.insertAC(fid,label,[item]);+ } else {+ var isMember = false;+ for (var j in items) {+ if (items[j].isEqual(item)) {+ isMember = true;+ break;+ }+ }+ + if (!isMember) {+ items.push(item);+ + var fid2 = this.chart.lookupPC(fid,label,this.chart.offset);+ if (fid2 != null) {+ agenda.push(item.shiftOverArg(sym.i,fid2));+ }+ }+ }+ break;+ case "KS": tokenCallback(sym.tokens, item.shiftOverTokn());+ break;+ case "KP": var pitem = item.shiftOverTokn();+ tokenCallback(sym.tokens, pitem);+ for (var i in sym.alts) {+ var alt = sym.alts[i];+ tokenCallback(alt.tokens, pitem);+ }+ break;+ case "Lit": var fid = item.args[sym.i].fid;+ var rules = this.chart.forest[fid];+ if (rules != null) {+ tokenCallback(rules[0].toks, item.shiftOverTokn());+ } else {+ var rule = literalCallback(fid);+ if (rule != null) {+ fid = this.chart.nextId++;+ this.chart.forest[fid] = [rule];+ tokenCallback(rule.toks,item.shiftOverArg(sym.i,fid));+ }+ }+ break;+ }+ } else {+ var fid = this.chart.lookupPC(item.fid,item.lbl,item.offset);+ if (fid == null) {+ fid = this.chart.nextId++;+ + var items = this.chart.lookupACo(item.offset,item.fid,item.lbl);+ if (items != null) {+ for (var j in items) {+ var pitem = items[j];+ var i = pitem.seq[pitem.dot].i;+ agenda.push(pitem.shiftOverArg(i,fid));+ }+ }+ + this.chart.insertPC(item.fid,item.lbl,item.offset,fid);+ this.chart.forest[fid] = [new Apply(item.fun,item.args)];+ } else {+ var labels = this.chart.labelsAC(fid);+ if (labels != null) {+ for (var lbl in labels) {+ agenda.push(new ActiveItem(this.chart.offset,0,item.fun,item.fun.lins[lbl],item.args,fid,lbl));+ }+ }+ + var rules = this.chart.forest[fid];+ var rule = new Apply(item.fun,item.args);+ + var isMember = false;+ for (var j in rules) {+ if (rules[j].isEqual(rule))+ isMember = true;+ }+ + if (!isMember)+ rules.push(rule);+ }+ }+ }+ }+}++function Chart(concrete) {+ this.active = new Object();+ this.actives = new Array();+ this.passive = new Object();+ this.forest = new Object();+ this.nextId = concrete.totalFIds;+ this.offset = 0;+ + for (var fid in concrete.pproductions) {+ this.forest[fid] = concrete.pproductions[fid];+ }+}+Chart.prototype.lookupAC = function (fid,label) {+ var tmp = this.active[fid];+ if (tmp == null)+ return null;+ return tmp[label];+}+Chart.prototype.lookupACo = function (offset,fid,label) {+ var tmp;+ + if (offset == this.offset)+ tmp = this.active[fid];+ else+ tmp = this.actives[offset][fid];++ if (tmp == null)+ return null;++ return tmp[label];+}+Chart.prototype.labelsAC = function (fid) {+ return this.active[fid];+}+Chart.prototype.insertAC = function (fid,label,items) {+ var tmp = this.active[fid];+ if (tmp == null) {+ tmp = new Object();+ this.active[fid] = tmp;+ }+ tmp[label] = items;+}+Chart.prototype.lookupPC = function (fid,label,offset) {+ var key = fid+"."+label+"-"+offset;+ return this.passive[key];+}+Chart.prototype.insertPC = function (fid1,label,offset,fid2) {+ var key = fid1+"."+label+"-"+offset;+ this.passive[key] = fid2;+}+Chart.prototype.shift = function () {+ this.actives.push(this.active);+ this.active = new Object();+ + this.passive = new Object();+ + this.offset++;+}+Chart.prototype.expandForest = function (fid) {+ var rules = new Array();+ var forest = this.forest;+ + var go = function (rules0) {+ for (var i in rules0) {+ var rule = rules0[i];+ switch (rule.id) {+ case "Apply": rules.push(rule); break;+ case "Coerce": go(forest[rule.arg]); break;+ }+ }+ }++ go(this.forest[fid]);+ return rules;+}++function ActiveItem(offset, dot, fun, seq, args, fid, lbl) {+ this.offset= offset;+ this.dot = dot;+ this.fun = fun;+ this.seq = seq;+ this.args = args;+ this.fid = fid;+ this.lbl = lbl;+}+ActiveItem.prototype.isEqual = function (obj) {+ return (this.offset== obj.offset &&+ this.dot == obj.dot &&+ this.fun == obj.fun &&+ this.seq == obj.seq &&+ this.args == obj.args &&+ this.fid == obj.fid &&+ this.lbl == obj.lbl);+}+ActiveItem.prototype.shiftOverArg = function (i,fid) {+ var nargs = new Array();+ for (var k in this.args) {+ nargs[k] = this.args[k];+ }+ nargs[i] = new PArg(fid);+ return new ActiveItem(this.offset,this.dot+1,this.fun,this.seq,nargs,this.fid,this.lbl);+}+ActiveItem.prototype.shiftOverTokn = function () {+ return new ActiveItem(this.offset,this.dot+1,this.fun,this.seq,this.args,this.fid,this.lbl);+}
@@ -0,0 +1,1 @@+var Foods = new GFGrammar(new GFAbstract("Phrase",{Boring: new Type([], "Quality"), Cheese: new Type([], "Kind"), Delicious: new Type([], "Quality"), Expensive: new Type([], "Quality"), Fish: new Type([], "Kind"), Fresh: new Type([], "Quality"), Is: new Type(["Item", "Quality"], "Phrase"), Italian: new Type([], "Quality"), Pizza: new Type([], "Kind"), QKind: new Type(["Quality", "Kind"], "Kind"), That: new Type(["Kind"], "Item"), These: new Type(["Kind"], "Item"), This: new Type(["Kind"], "Item"), Those: new Type(["Kind"], "Item"), Very: new Type(["Quality"], "Quality"), Warm: new Type([], "Quality"), Wine: new Type([], "Kind")}),{FoodsEng: new GFConcrete({},{0:[new Apply(15,[new PArg(2)]), new Apply(17,[new PArg(2)])], 1:[new Apply(16,[new PArg(2)]), new Apply(18,[new PArg(2)])], 2:[new Apply(5,[]), new Apply(8,[]), new Apply(13,[]), new Apply(14,[new PArg(4), new PArg(2)]), new Apply(21,[])], 3:[new Apply(10,[new PArg(0), new PArg(4)]), new Apply(11,[new PArg(1), new PArg(4)])], 4:[new Apply(4,[]), new Apply(6,[]), new Apply(7,[]), new Apply(9,[]), new Apply(12,[]), new Apply(19,[new PArg(4)]), new Apply(20,[])]},[new CncFun("lindef Item",[0]), new CncFun("lindef Kind",[0, 0]), new CncFun("lindef Phrase",[0]), new CncFun("lindef Quality",[0]), new CncFun("Boring",[1]), new CncFun("Cheese",[2, 3]), new CncFun("Delicious",[4]), new CncFun("Expensive",[5]), new CncFun("Fish",[6, 6]), new CncFun("Fresh",[7]), new CncFun("Is",[8]), new CncFun("Is",[9]), new CncFun("Italian",[10]), new CncFun("Pizza",[11, 12]), new CncFun("QKind",[13, 14]), new CncFun("That",[15]), new CncFun("These",[16]), new CncFun("This",[17]), new CncFun("Those",[18]), new CncFun("Very",[19]), new CncFun("Warm",[20]), new CncFun("Wine",[21, 22])],[[new SymLit(0, 0)],[new SymKS("boring")],[new SymKS("cheese")],[new SymKS("cheeses")],[new SymKS("delicious")],[new SymKS("expensive")],[new SymKS("fish")],[new SymKS("fresh")],[new SymCat(0, 0), new SymKS("is"), new SymCat(1, 0)],[new SymCat(0, 0), new SymKS("are"), new SymCat(1, 0)],[new SymKS("Italian")],[new SymKS("pizza")],[new SymKS("pizzas")],[new SymCat(0, 0), new SymCat(1, 0)],[new SymCat(0, 0), new SymCat(1, 1)],[new SymKS("that"), new SymCat(0, 0)],[new SymKS("these"), new SymCat(0, 1)],[new SymKS("this"), new SymCat(0, 0)],[new SymKS("those"), new SymCat(0, 1)],[new SymKS("very"), new SymCat(0, 0)],[new SymKS("warm")],[new SymKS("wine")],[new SymKS("wines")]],{Float:{s: -3, e: -3}, Int:{s: -2, e: -2}, Item:{s: 0, e: 1}, Kind:{s: 2, e: 2}, Phrase:{s: 3, e: 3}, Quality:{s: 4, e: 4}, String:{s: -1, e: -1}, __gfVar:{s: -4, e: -4}}, 6)});
binary file changed (absent → 201 bytes)
binary file changed (absent → 229 bytes)
@@ -0,0 +1,252 @@+body { + font-family:arial,helvetica,sans-serif; + font-size:12px; + background-color: white; +} + +#wrapper { + width:740px; + height:520px; + margin:auto 50px; + border:1px solid gray; + padding:10px; + +} + +#absFrame { + width:250px; + height:250px; + padding:10px; + border:1px solid gray; + float:left; + white-space: nowrap; +} + +#conFrame { + width:436px; + height:250px; + margin-left:10px; + padding:10px; + border:1px solid gray; + float:left; + white-space: normal; + overflow:auto; +} + +#actFrame { + width:250px; + height:170px; + margin-top:10px; + padding:10px; + border:1px solid gray; + float:left; + overflow:auto; +} + +#refFrame { + width:436px; + height:170px; + margin-left:10px; + margin-top:10px; + padding:10px; + border:1px solid gray; + float:left; + overflow:auto; +} + +#messageFrame { + width:506px; + height:15px; + margin-top:10px; + margin-right:10px; + padding:10px; + border:1px solid gray; + float:left; + overflow:hidden; +} + +#clipboardFrame { + width:180px; + height:15px; + margin-top:10px; + padding:10px; + border:1px solid gray; + float:left; + overflow:auto; +} + +#tree { + left: -10px; + top: -10px; + margin: 0px; + padding: 10px; + overflow: auto; +} + +ul { + position: relative; + list-style: none; + margin-left: 20px; + padding: 0px; +} + +li { + position: relative; +} + +img.tree-menu { + margin-right: 5px; +} + +a.tree:link, a.tree:visited, a.tree:active { + color: black; + background-color: white; + text-decoration: none; + margin-right:10px; +} + +a.tree:hover { + color: blue; + background-color: white; + text-decoration: underline; + margin-right:10px; +} + +a.treeSelected:link, a.treeSelected:visited, a.treeSelected:active { + color: white; + background-color: #3366CC; + text-decoration: none; + margin-right:10px; +} + +a.treeSelected:hover { + color: white; + background-color: #3366CC; + text-decoration: underline; + margin-right:10px; +} + +a.treeGray:link, a.treeGray:visited, a.treeGray:active { + color: silver; + background-color: white; + text-decoration: none; + margin-right:10px; +} + +a.treeGray:hover { + color: silver; + background-color: white; + text-decoration: none; + margin-right:10px; +} + +table.action, table.refinement, table.wrapper, table.tree, table.language { + margin: 0px; + padding: 0px; + border-style: none; + border-collapse: collapse; + border-spacing: 0px; +} + +tr.selected { + color: white; + background-color: #3366CC; +} + +tr.unavailable, tr.closed { + color: silver; + background-color: white; +} + +tr.unavailable:hover { + color: silver; + background-color: #3366CC; +} + +tr.action, tr.refinement, tr.wrapper, tr.tree { + color: black; + background-color: white; +} + +tr.action:hover, tr.refinement:hover, tr.wrapper:hover, tr.tree:hover { + color: white; + background-color: #3366CC; +} + +td.action { + width: 220px; + margin: 0px; + padding: 0px; +} + +td.refinement, td.wrapper, td.tree { + width: 515px; + margin: 0px; + padding: 0px; +} + +td.hotKey { + width: 30px; + margin: 0px; + padding: 0px; + text-align: right; +} + +td.language { + color: black; + background-color: white; + margin: 1px; + padding: 1px; +} + +td.language:hover { + color: blue; + background-color: white; + text-decoration: underline; + margin: 1px; + padding: 1px; +} + +td.selected { + color: white; + background-color: #3366CC; + margin: 1px; + padding: 1px; +} + +td.selected:hover { + color: white; + background-color: #3366CC; + text-decoration: underline; + margin: 1px; + padding: 1px; +} + +p { + margin-bottom: 40px; +} + +span.normal { + color: black; + background-color: white; + text-decoration: none; + padding-left: 2px; + padding-right: 2px; +} + +span.edit { + color: black; + background-color: white; + text-decoration: none; + border:2px inset; + padding-left: 2px; + padding-right: 2px; +} + +span.selected { + color: white; + background-color: #3366CC; + text-decoration: none; + padding-left: 2px; + padding-right: 2px; +}
@@ -0,0 +1,54 @@+body {+ color: black;+ background-color: white;+}++dl {++}++dt {+ margin: 0;+ padding: 0;+}++dl dd {+ margin: 0;+ padding: 0;+}++dl.fromLang dt {+ display: none;+}++dl.toLang {+ border-width: 1px 0 0 0;+ border-style: solid;+ border-color: #c0c0c0;+}++dl.toLang dt {+ color: #c0c0c0;+ display: block;+ float: left;+ width: 5em;+}+++dl.toLang dd {+ border-width: 0 0 1px 0;+ border-style: solid;+ border-color: #c0c0c0;+}+++ul {+ margin: 0;+ padding: 0;+}++li {+ list-style-type: none;+ margin: 0;+ padding: 0;+}
@@ -0,0 +1,48 @@+<!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>+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />+ <link rel="stylesheet" type="text/css" href="translator.css" />+ <script type="text/javascript" src="gflib.js"></script>+ <script type="text/javascript" src="grammar.js"></script>+ <script type="text/javascript" src="translator.js"></script>+ <script type="text/javascript">+ /* CHANGE ME */+ var grammar = Foods;++ function updateTranslation () {+ var input = document.getElementById('inputText').value;+ var fromLang = document.getElementById('fromLang').value;+ var toLang = document.getElementById('toLang').value;+ var output = document.getElementById('output');+ var translation = grammar.translate(input, fromLang, toLang);+ removeChildren(output);+ output.appendChild(formatTranslation(translation));+ }++ function populateLangs () {+ var f = document.getElementById('fromLang');+ var t = document.getElementById('toLang');+ for (var c in grammar.concretes) {+ addOption(f, c, c);+ addOption(t, c, c);+ }+ }+ </script>+ <title>Web-based GF Translator</title>+ </head>+ <body onload="populateLangs(Food, 'fromLang', 'toLang')">+ <form id="translate">+ <p>+ <input type="text" name="inputText" id="inputText" value="this cheese is warm" size="50" />+ </p>+ <p>+ From: <select name="fromLang" id="fromLang" onchange=""><option value="">Any language</option></select>+ To: <select name="toLang" id="toLang"><option value="">All languages</option></select>+ <input type="button" value="Translate" onclick="updateTranslation()" />+ </p>+ </form>+ <div id="output"></div>+ </body>+</html>
@@ -0,0 +1,51 @@+function formatTranslation (outputs) {+ var dl1 = document.createElement("dl");+ dl1.className = "fromLang";+ for (var fromLang in outputs) {+ var ul = document.createElement("ul");+ addDefinition(dl1, document.createTextNode(fromLang), ul);+ for (var i in outputs[fromLang]) {+ var dl2 = document.createElement("dl");+ dl2.className = "toLang";+ for (var toLang in outputs[fromLang][i]) {+ addDefinition(dl2, document.createTextNode(toLang), document.createTextNode(outputs[fromLang][i][toLang]));+ }+ addItem(ul, dl2);+ }+ }++ return dl1;+}++/* DOM utilities for specific tags */++function addDefinition (dl, t, d) {+ var dt = document.createElement("dt");+ dt.appendChild(t);+ dl.appendChild(dt);+ var dd = document.createElement("dd");+ dd.appendChild(d);+ dl.appendChild(dd);+}++function addItem (ul, i) {+ var li = document.createElement("li");+ li.appendChild(i);+ ul.appendChild(li);+}++function addOption (select, value, content) {+ var option = document.createElement("option");+ option.value = value;+ option.appendChild(document.createTextNode(content));+ select.appendChild(option);+}++/* General DOM utilities */++/* Removes all the children of a node */+function removeChildren(node) {+ while (node.hasChildNodes()) {+ node.removeChild(node.firstChild);+ }+}
@@ -0,0 +1,5 @@+You will need the python-devel package or similar.+You must have installed the PGF C runtime (see ../c/INSTALL)++$ python setup.py build+$ sudo python setup.py install
@@ -0,0 +1,167 @@+~runtime/python/examples/README++(c) Prasanth Kolachina, 22 April 2015++======================+TRANSLATION PIPELINE+======================++The module translation_pipeline.py is a Python replica of the +translation pipeline used in Wide-coverage Translation demo. +The pipeline allows for + 1. simultaneous batch translation from one language into multiple languages+ 2. K-best translations+ 3. translate both text files and sgm files. ++The module defines functions for the standard lexer used in the pipeline,+the callbacks used in robust parsing to partially deal with unknown words+and proper nouns etc. ++Basic example usage: +> python translation_pipeline.py -g TranslateEngFin.pgf -s Eng -t Fin -i <input-file> -e <exp-directory>+> python translation_pipeline.py -g TranslateEngFin.pgf -s Eng -t Fin -K 20 -i <input-file> -e <exp-directory>+> python translation_pipeline.py -g Translate11.pgf -s Eng -t Fin Swe Ger -i <input-file> -e <exp-directory>+> python translation_pipeline.py -g TranslateEngFin.pgf -s Eng -t Fin -f sgm -i <sgm-input-file> -e <exp-directory>++The full list and description of options accepted by the translation_pipeline+module can be seen using the -h option.++> python translation_pipeline.py -h+———+usage: translation_pipeline.py [-h] -g PGFFILE [-s SRCLANG]+ [-t [TGTLANGS [TGTLANGS ...]]] [-i INPUT]+ [-e EXP_DIRECTORY] [-f {txt,sgm}]+ [-p PROPSFILE] [-K BESTK]++Run the GF translation pipeline on standard test-sets++optional arguments:+ -h, --help show this help message and exit+ -g PGFFILE, --pgf PGFFILE+ PGF grammar file to run the pipeline+ -s SRCLANG, --source SRCLANG+ Source language of input sentences+ -t [TGTLANGS [TGTLANGS ...]], --target [TGTLANGS [TGTLANGS ...]]+ Target languages to linearize (default is all other+ languages)+ -i INPUT, --input INPUT+ input file (default will accept STDIN)+ -e EXP_DIRECTORY, --exp EXP_DIRECTORY+ experiement directory to write translation files+ -f {txt,sgm}, --format {txt,sgm}+ input file format (output files will be written in the+ same format)+ -p PROPSFILE, --props PROPSFILE+ properties file for the translation pipeline (specify+ the above arguments in a file)+ -K BESTK K value for K-best translation+++======================+PREREQUISITES+======================+In order to use the examples in this directory, the following components+are required: + 1. GF C runtime (~runtime/c/)+ 2. Python bindings to the C runtime (~runtime/python/)+ 3. The path to Python library is added to PYTHONPATH environment variable + (Note: by default, the setuptools installs the bindings to a location+ available for everyone, so this step is only required if you have+ done a custom installation of the Python bindings and you know what + you are doing)+> export PYTHONPATH="$GF/src/runtime/python/build/lib.*:$PYTHONPATH"+++======================+WEB GF PARSING+======================+NEW!!!+In it current state, we carry out parsing of large web texts using +GF grammars. The same functions described in gf_utils.py are used, but +we make it faster using multithreading. The multiprocessing module in+Python allows for trivial parallelization, where each batch of sentences+are parsed by different threads in the pool. ++We noticed one thing during these experiments: the GF parser can +take an unusually long time for long and ambiguous sentences. Therefore,+to avoid resource starvation, we use a `timeout' setting to raise a +PgfParseError if it takes more than 5 minutes for a single sentence. +With this simple trick, we manage to parse large corpora (Europarl +texts) in both English and Swedish. Please contact +prasanth.kolachina@cse.gu.se +if you have any questions about this. +++======================+GENERIC GF UTILITIES+======================++The module gf_utils.py contains functions to carry out four +basic tasks: +1. 1-best parsing (parse)+2. K-best parsing (kparse)+3. 1-best linearization (linearize)+4. K-best linearization (klinearize)++> usage: gf_utils.py [-h] {parse,kparse,linearize,klinearize} ...++Detailed arguments for each function can be found using the "-h" option.+An exhaustive list of options for all the functions are given below. Options+marked with (*) are required, the others are optional. ++(*) -g/--pgf <pgf-file> PGF Grammar file+(*) -s/--src-lang <lang> Source language name i.e. code used in GF (for e.g. TranslateEng, TranslateFin). For parsing, the option specifies the language of the input sentences. +(*) -t/--tgt-lang <lang> Target language name. For linearization, the option specifies the language into which they are linearized.+(*) -K <int> Prespecified K value for K-best parsing and linearization. +-i/--input <filename> Input file name, either raw text sentences or abstract trees for linearization.+-o/--output <filename> Output file name.+-p/--start-sym <sym> Start symbol used for parsing++Basic example usage: +> python gf_utils.py parse -g TranslateEng.pgf -s TranslateEng -i <input-file> -o <parse-output-file> [-p Phr]+> python gf_utils.py kparse -g TranslateEng.pgf -s TranslateEng -K 20 -i <input-file> -o <kparse-output-file> [-p Phr]+> python gf_utils.py linearize -g TranslateFin.pgf -t TranslateFin -i <parse-output-file> -o <output-file>+> python gf_utils.py klinearize -g TranslateFin.pgf -t TranslateFin -i <kparse-output-file> -o <output-file>++======================+File I/O formats+======================++1. One-sentence-per-line+The input sentences to the parser/kparser are written one sentence +per line. This is also the standard format used in the translation+pipeline. ++2. SGM format+The translation pipeline accepts SGM format file as both input +and output files. The format is specifically used by automatic+evaluation metrics used to measure quality of MT systems. The format+is primarily used in by the NIST evaluation and the WMT Shared+Task evaluations.++3. Parser output format+The parser writes four columns, seperated by the <tab>-character+for each sentence in a single line. The sentence index, time taken+by the parser, the tree probability value and the abstract syntax tree.++4. K-best parser output format+The k-best parser uses a representation that has come to be called +CJ (Charniak-Johnson) format in the parsing community. + a. The output consists of parsed blocks for each sentence. Two blocks+ are seperated by an empty line. + b. The first line in the block contains two numbers: the number + of parses in that block, and a identifier for that sentence.+ c. Each subsequent pair of lines contains the log probability of the+ abstract tree in one line followed by the actual parse tree in the + next line. ++5. K-best translations output format+The k-best linearizer and k-best translation use the same format as+Moses and other SMT toolkits to write K-best translation lists. + a. The output consists of translation blocks for each sentence.+ b. Each block consists of several translations, one per each line.+ c. Each translation (or line) consists of four columns seperated by+ '|||' string. The first column contains a sentence identifier, + the second column is the actual translation, followed by + word-alignment information between the input sentence and the+ translation and the scores from statistical models used in parsing.
@@ -0,0 +1,369 @@+#!/usr/bin/env python++# Python 2 and 3 compatible+from __future__ import print_function++"""+"""++import argparse, codecs, re, string, sys, time;+try:+ from itertools import imap as map;+ from itertools import count;+except ImportError:+ from itertools import count;+ pass;+from operator import itemgetter;++import pgf;++class Lexer(object):+ def __init__(self, lang='None', grammar=None, gflang=None):+ import translation_pipeline;+ lexers = {'None': self.lexerI, \+ 'Eng': self.lexerI, \+ 'Chi': self.lexerChi, \+ 'Translator': translation_pipeline.pipeline_lexer, \+ 'Web': self.lexerWeb+ };+ if grammar:+ self._pgf = grammar;+ self._lang = gflang;++ self.tokenize = lexers[lang];+ return;++ def lexerI(self, sentence):+ #return sentence.decode('utf-8').rstrip(string.whitespace+string.punctuation).encode('utf-8');+ return sentence.rstrip(string.whitespace+string.punctuation);+ + def lexerChi(self, sentence):+ #sentence = sentence.decode('utf-8');+ tokens, idx, n = [], 0, len(sentence);+ prev = True;+ while idx < n:+ if sentence[idx] in string.whitespace:+ prev = True;+ idx += 1;+ continue;+ if 0 < ord(sentence[idx]) < 128:+ if sentence[idx] in string.punctuation:+ prev = True;+ if prev:+ tokens.append( sentence[idx] );+ prev = False;+ else:+ tokens[-1] = tokens[-1]+sentence[idx];+ else:+ prev = True;+ tokens.append( sentence[idx] );+ idx += 1;+ return ' '.join(tokens);#.encode('utf-8');++ def lexerWeb(self, sentence):+ tokensList = re.split('\s+?', sentence.strip());+ for idx, token in enumerate(tokensList):+ if not token[0].isupper():+ continue;+ lowertoken = tokensList[idx].lower();+ count = 0;+ for analysis in self._pgf.languages[self._lang].lookupMorpho(lowertoken):+ count += 1;+ tokensList[idx] = lowertoken if count else token;+ for idx, token in enumerate(tokensList):+ if token.find('-') == -1:+ continue;+ count = 0;+ for analysis in self._pgf.languages[self._lang].lookupMorpho(token):+ count += 1;+ if count: + continue;+ token = tokensList[idx].replace('-', '');+ for analysis in self._pgf.languages[self._lang].lookupMorpho(token):+ count += 1;+ if count:+ tokensList[idx] = token;+ continue;+ token = tokensList[idx].replace('-', ' ');+ return ' '.join(tokensList);++def postprocessor(sentence):+ if sentence == None:+ return '';+ if sentence.startswith('* ') or sentence.startswith('% '):+ sentence = sentence[2:];+ sentence = sentence.replace(' &+ ', '');+ sentence = sentence.replace('<+>', ' ');+ return sentence;++def readJohnsonRerankerTrees(inputStream):+ endOfParse = False;+ while True:+ sentheader = inputStream.next();+ if sentheader == '':+ break;+ parsescount, sentidx = map(int, sentheader.strip().split());+ parsesBlock = [];+ for i in xrange(parsescount):+ parseprob = inputStream.next();+ if parseprob.strip() == '':+ endOfParse = True;+ break;+ parse = inputStream.next();+ parsesBlock.append((float(parseprob.strip()), pgf.readExpr(parse.strip())));+ yield sentidx, parsesBlock;+ if not endOfParse:+ _ = inputStream.next();+ endOfParse = False;++def readMosesNbestFormat(inputStream):+ transBlock = [];+ currentHypothesisId = 0;+ while True:+ line = inputStream.next();+ if line == '':+ break;+ fields = line.strip().split('|||');+ if str(fields[0].strip()) != str(currentHypothesisId):+ yield currentHypothesisId, transBlock;+ transBlock = [];+ currentHypothesisId = int(fields[0]);+ transBlock.append( (map(float, \+ tuple([val.strip() for val in fields[3].split()])), \+ fields[1].strip()) );++def printJohnsonRerankerFormat(gfparsesList, sentids=count(1)):+ johnsonRepr = [];+ parseHash = {};+ for parse in sorted(gfparsesList, key=itemgetter(0)):+ if parse[1] not in parseHash:+ johnsonRepr.append( str(-1*parse[0]) );+ johnsonRepr.append( str(parse[1]) );+ parseHash.setdefault(parse[1], []).append(parse[0]);+ curid = next(sentids);+ if len(gfparsesList):+ johnsonRepr.insert(0, '%d %d' %(len(parseHash.values()), curid));+ duplicateInstances = len(list(filter(lambda X: len(parseHash[X]) > 1, \+ parseHash.keys())));+ return '\n'.join(johnsonRepr)+'\n';++def printMosesNbestFormat(hypothesisList, sentids=count(1)):+ mosesRepr = [];+ sid = next(sentids);+ for hypScores, hypStr in hypothesisList:+ if not hasattr(hypScores, '__iter__'):+ hypScores = (hypScores, );+ mosesRepr.append("%d ||| %s ||| NULL ||| %s" \+ %(sid, hypStr, ' '.join('%.6f'%score for score in hypScores)) );+ return '\n'.join(mosesRepr);++def getKLinearizations(grammar, tgtlanguage, abstractParsesList, K=10):+ generator = grammar.languages[tgtlanguage].linearizeAll;+ for parsesBlock in abstractParsesList:+ kBestTrans = [];+ for parseprob, parse in parsesBlock:+ for linstring in generator(parse, n=K):+ kBestTrans.append( ((parseprob,), postprocessor(linstring)) );+ yield kBestTrans;++def getKBestParses(grammar, language, K, callbacks=[], \+ serializable=False, sentids=count(1), max_length=50):+ parser = grammar.languages[language].parse;+ import translation_pipeline;+ callbacks_PN = translation_pipeline.parseNames;+ callbacks_Symb = translation_pipeline.parseUnknown;+ def worker(sentence):+ sentence = sentence.strip();+ curid = next(sentids);+ tstart = time.time();+ kBestParses = [];+ parseScores = {};+ if len(sentence.split()) > max_length:+ # temporary hack to make sure parser does not get+ # killed for very long sentences;+ tend, err = time.time(), \+ "Sentence too long (%d tokens). Might potentially run out of memory" \+ %(len(sentence.split()));+ print('%d\t%.4f\t%s' %(curid, tend-tstart, err), file=sys.stderr);+ return tend-tstart, kBestParses;+ + # with modified API for callbacks, each callback function has to+ # be freshly created for each sentence; otherwise, they do not + # work. + try:+ callbacks = [('PN', callbacks_PN(grammar, language, sentence)),\+ ('Symb', callbacks_Symb(grammar, language, sentence))];+ for parseidx, parse in enumerate(parser(sentence, \+ heuristics=0, callbacks=callbacks)):+ parseScores[parse[0]] = True;+ kBestParses.append((parse[0], str(parse[1]) if serializable \+ else parse[1]));+ if parseidx == K-1:+ break;+ tend = time.time();+ print('%d\t%.4f' %(curid, tend-tstart), file=sys.stderr);+ return tend-tstart, kBestParses;+ except pgf.ParseError as err:+ tend = time.time();+ print('%d\t%.4f\t%s' %(curid, tend-tstart, err), file=sys.stderr);+ return tend-tstart, kBestParses;+ except UnicodeEncodeError as err:+ tend = time.time();+ print('%d\t%.4f\t%s' %(curid, tend-tstart, err), file=sys.stderr);+ return tend-tstart, kBestParses;+ return worker;++def pgf_parse(args):+ grammar = pgf.readPGF(args.pgfgrammar);+ preprocessor = Lexer().tokenize;+ #if sys.version_info < (3, 0):+ # args.inputstream = codecs.getreader('utf-8')(args.inputstream);+ inputSet = map(preprocessor, args.inputstream);+ web_preprocessor = Lexer('Web', grammar, args.srclang).tokenize;+ inputSet = map(web_preprocessor, inputSet);+ outputPrinter = lambda X: "%f\t%s" %(X[0], str(X[1]));+ parser = getKBestParses(grammar, args.srclang, 1);+ + sentidx = 0;+ for time, parsesBlock in map(parser, inputSet):+ sentidx += 1;+ print("%d\t%f\t%s" %(sentidx, time, \+ str(outputPrinter(parsesBlock[0])) if len(parsesBlock) else ''), \+ file=args.outputstream);+ return;++def pgf_kparse(args):+ grammar = pgf.readPGF(args.pgfgrammar);+ preprocessor = Lexer().tokenize;+ #if sys.version_info < (3, 0):+ # args.inputstream = codecs.getreader('utf-8')(args.inputstream);+ inputSet = map(preprocessor, args.inputstream);+ web_preprocessor = Lexer('Web', grammar, args.srclang).tokenize;+ inputSet = map(web_preprocessor, inputSet);+ outputPrinter = printJohnsonRerankerFormat;+ parser = getKBestParses(grammar, args.srclang, args.K);+ + sentidx = 0;+ for time, parsesBlock in map(parser, inputSet):+ sentidx += 1;+ strParses = str(outputPrinter(parsesBlock));+ if not (strParses == '\n'):+ print(strParses, file=args.outputstream);+ return;++def pgf_linearize(args):+ grammar = pgf.readPGF(args.pgfgrammar);+ def parse_line(line):+ try:+ sentid, parsetime, parserepr = line.strip('\n').split('\t', 2);+ except ValueError:+ print("Line not in proper format: %s" %(line), file=stderr);+ parseprob, abstree = parserepr.split('\t') if parserepr.strip() \+ else (0, '');+ return ((int(sentid), float(parsetime), float(parseprob), \+ pgf.readExpr(abstree) if abstree else None));++ #if sys.version_info < (3, 0):+ # args.inputstream = codecs.getreader('utf-8')(args.inputstream);+ inputSet = map(parse_line, (line for line in args.inputstream));+ outputPrinter = postprocessor;+ linearizer = grammar.languages[args.tgtlang].linearize;+ for sentid, _, _, abstree in inputSet:+ if abstree:+ print(str(outputPrinter(linearizer(abstree))), \+ file=args.outputstream);+ else:+ print("", file=args.outputstream);+ return;++def pgf_klinearize(args):+ grammar = pgf.readPGF(args.pgfgrammar);+ #if sys.version_info < (3, 0):+ # args.inputstream = codecs.getreader('utf-8')(args.inputstream);+ inputSet = [(sentid, parsesBlock) \+ for sentid, parsesBlock in readJohnsonRerankerTrees(args.inputstream)];+ outputPrinter = printMosesNbestFormat;+ sentIdsList = map(itemgetter(0), inputSet);+ parsesBlocks = map(itemgetter(1), inputSet);+ + for transBlock in getKLinearizations(grammar, args.tgtlang, parsesBlocks, args.K):+ strTrans = str(outputPrinter(transBlock, sentIdsList));+ if strTrans:+ print(strTrans, file=args.outputstream);+ return;++def cmdLineParser():+ argparser = argparse.ArgumentParser(prog='gf_utils.py', \+ description='Examples for carrying out (K-best) parsing, \+ translation and linearization using GF C runtime.');+ + subparsers = argparser.add_subparsers();+ parser = subparsers.add_parser('parse', help='GF parsing of sentences');+ kparser = subparsers.add_parser('kparse', help='K-best GF parsing of sentences');+ linearizer = subparsers.add_parser('linearize', help='Linearize GF abstract syntax treess');+ klinearizer = subparsers.add_parser('klinearize', help='Linearize K-variants of GF abstract syntax trees');+ + parser.set_defaults(func=pgf_parse);+ parser.add_argument('-g', '--pgf', dest='pgfgrammar', required=True, \+ help='PGF Grammar file');+ parser.add_argument('-p', '--start-sym', dest='startcat', required=False, \+ help='Start symbol in the grammar');+ parser.add_argument('-s', '--src-lang', dest='srclang', required=True, \+ help='Source language');+ parser.add_argument('-i', '--input', dest='inputstream', nargs='?', \+ type=argparse.FileType(mode='r'), default=sys.stdin, \+ help='Input file') ;+ parser.add_argument('-o', '--output', dest='outputstream', nargs='?', \+ type=argparse.FileType(mode='w'), default=sys.stdout, \+ help='Output file');+ + kparser.set_defaults(func=pgf_kparse);+ kparser.add_argument('-g', '--pgf', dest='pgfgrammar', required=True, \+ help='PGF Grammar file');+ kparser.add_argument('-p', '--start-sym', dest='startcat', required=False, \+ help='Start symbol in the grammar');+ kparser.add_argument('-s', '--src-lang', dest='srclang', required=True, \+ help='Source language');+ kparser.add_argument('-K', dest='K', required=True, \+ type=int, \+ help='K value for multiple parses');+ kparser.add_argument('-i', '--input', dest='inputstream', nargs='?', \+ type=argparse.FileType(mode='r'), default=sys.stdin, \+ help='Input file');+ kparser.add_argument('-o', '--output', dest='outputstream', nargs='?', \+ type=argparse.FileType(mode='w'), default=sys.stdout, \+ help='Output file');+ + linearizer.set_defaults(func=pgf_linearize);+ linearizer.add_argument('-g', '--pgf', dest='pgfgrammar', required=True, \+ help='PGF Grammar file');+ linearizer.add_argument('-t', '--tgt-lang', dest='tgtlang', required=True, \+ help='Target language');+ linearizer.add_argument('-i', '--input', dest='inputstream', nargs='?', \+ type=argparse.FileType(mode='r'), default=sys.stdin, \+ help='Input file');+ linearizer.add_argument('-o', '--output', dest='outputstream', nargs='?', \+ type=argparse.FileType(mode='w'), default=sys.stdout, \+ help='Output file'); + + klinearizer.set_defaults(func=pgf_klinearize);+ klinearizer.add_argument('-g', '--pgf', dest='pgfgrammar', required=True, \+ help='PGF Grammar file');+ klinearizer.add_argument('-t', '--tgt-lang', dest='tgtlang', required=True, \+ help='Target language');+ klinearizer.add_argument('-K', '--kbest', dest='K', required=True, \+ type=int, \+ help='K value for multiple linearizations');+ klinearizer.add_argument('-i', '--input', dest='inputstream', nargs='?', \+ type=argparse.FileType(mode='r'), default=sys.stdin, \+ help='Input file');+ klinearizer.add_argument('-o', '--output', dest='outputstream', nargs='?', \+ type=argparse.FileType(mode='w'), default=sys.stdout, \+ help='Output file');+ + return argparser;+++if __name__ == '__main__':+ args = cmdLineParser().parse_args(sys.argv[1:]);+ args.func(args);
@@ -0,0 +1,421 @@+#!/usr/bin/env python++# Python 2 and 3 compatible+from __future__ import print_function++"""+"""++import argparse, codecs, copy, itertools, logging, math, operator, os, os.path, re, string, sys, time;+try:+ from itertools import imap as map;+ from itertools import ifilter as filter;+except ImportError:+ pass;++import xml.etree.ElementTree as etree;++import pgf;+import gf_utils;++# http://snipplr.com/view/25657/indent-xml-using-elementtree/+def indentXMLNodes(elem, level=0):+ i = "\n" + level*" "+ if len(elem):+ if not elem.text or not elem.text.strip():+ elem.text = i + " "+ if not elem.tail or not elem.tail.strip():+ elem.tail = i+ for elem in elem:+ indentXMLNodes(elem, level+1)+ if not elem.tail or not elem.tail.strip():+ elem.tail = i+ else:+ if level and (not elem.tail or not elem.tail.strip()):+ elem.tail = i++def readTranslationPipelineOptions(propsfile, default_namespace):+ with codecs.open(propsfile, 'r', 'utf-8') as infile:+ for line in infile:+ if not line.strip():+ continue;+ key, value = line.strip().split('=', 1);+ key, value = key.strip(), value.strip();+ if key == 'srclang':+ default_namespace.srclang = value;+ elif key == 'tgtlangs': + default_namespace.tgtlangs = [val.strip() for val in ','.split(value)];+ elif key == 'input':+ default_namespace.input = value;+ elif key == 'format':+ default_namespace.format = value;+ elif key == 'exp_directory':+ default_namespace.exp_directory = value;+ else:+ logging.warning("Unknown option-%s found in props file. Ignoring and proceeding." %(key));+ continue;+ return default_namespace;++def sgmReader(sgmDoc):+ root = sgmDoc.getroot();+ for element in root.iter():+ if element.text is not None and element.text.strip():+ yield element.text.strip().encode('utf-8');++def addToSgm(sgmDoc, strItem):+ for node in sgmDoc.findall('.//seg'):+ if not node.text.strip():+ strItem = strItem.decode('utf-8');+ node.text = ' %s ' %(strItem if strItem.strip() else 'EMPTY');+ return;+ logging.error("No more nodes available for adding content");+ return;++def sgmWriter(sgmDoc):+ indentXMLNodes( sgmDoc.getroot() );+ return etree.tostring(sgmDoc.getroot(), encoding='utf-8', method='xml');++def getXMLSkeleton(sgmDoc, tgtlang):+ skeletonDoc = copy.deepcopy(sgmDoc);+ root = skeletonDoc.getroot();+ root.tag = 'tstset';+ root.attrib['trlang'] = tgtlang[-3:];+ root.find('doc').attrib['sysid'] = tgtlang[:-3];+ for node in root.findall('.//seg'):+ node.text = '';+ return skeletonDoc;++def pipeline_lexer(sentence):+ tokens = sentence.strip().split();+ #tokens = filter(None, re.split('(\W+)', sentence.strip()));+ n = len(tokens);+ idx = len(tokens)-1;+ while idx >= 0:+ if tokens[idx] in ".?!)":+ idx -= 1;+ else:+ break;+ tokens = tokens[:idx+1];+ idx = 0;+ while idx < len(tokens):+ if tokens[idx] in "'\"(":+ idx += 1;+ else:+ break;+ tokens = tokens[idx:];+ return ' '.join(tokens);++def clean_gfstrings(sentence):+ absFuncName = re.compile('\[[^]]+?\]');+ untranslatedEntries = {};+ for entry in re.findall(absFuncName, sentence):+ untranslatedEntries[entry] = untranslatedEntries.setdefault(entry, 0)+1;+ for entry in untranslatedEntries:+ while untranslatedEntries[entry] > 1:+ sentence = sentence.replace(entry, '', 1);+ untranslatedEntries[entry] -= 1;+ sentence = sentence.replace(entry, \+ ' '.join(entry[1:-1].split('_')[:-1]) if entry.find('_') != -1 \+ else '');+ return ' '.join( sentence.split() );++def parseNames(grammar, language, sentence):+ def callback(lin_idx, start):+ moving_start, end, eot = start, len(sentence), True;+ if moving_start < end and (not sentence[moving_start].isupper()):+ return None;+ while moving_start < end:+ if sentence[moving_start] in string.whitespace:+ eot = True;+ elif eot and sentence[moving_start].isupper():+ eot = False;+ elif eot and (not sentence[moving_start].isupper()):+ end = moving_start-1;+ break;+ moving_start += 1;+ possible_name = sentence[start:end].strip();+ if possible_name:+ if language.endswith('Eng') and \+ (possible_name == "I" or possible_name == "I'm"):+ return None;+ elif language.endswith('Eng') and possible_name.endswith("'s"):+ end_idx = possible_name.rfind("'s");+ if end_idx != -1:+ possible_name = possible_name[:end_idx].strip();+ end -= 2;+ if not possible_name:+ return None;+ expr, prob = None, None;+ for analysis in grammar.languages[language].lookupMorpho(possible_name):+ category = grammar.functionType(analysis[0]).cat;+ if prob < analysis[-1]:+ if category == "PN":+ expr, prob = pgf.Expr(analysis[0], []), analysis[-1];+ elif category == "Weekday":+ expr, prob = pgf.Expr("weekdayPN", \+ [pgf.Expr(analysis[0], [])]), analysis[-1];+ elif category == "Month":+ expr, prob = pgf.Expr("monthPN", \+ [pgf.Expr(analysis[0], [])]), analysis[-1];+ elif category == "Language":+ return None;+ # generic named entity+ if expr == None:+ expr = pgf.Expr(possible_name);+ expr = pgf.Expr("MkSymb", [expr]);+ expr = pgf.Expr("SymbPN", [expr]);+ return (expr, 0, end);+ return None;+ return callback;++def parseUnknown(grammar, language, sentence):+ def callback(lin_idx, start):+ moving_start, end, eot = start, len(sentence), True;+ # -- added to deal with segmentation errors like may => ma_N + Symb y+ isNewToken = (moving_start == 0) or \+ (moving_start > 1 and sentence[moving_start-1].isspace()) + if moving_start < end and (not sentence[moving_start].isupper()):+ while moving_start < end:+ if sentence[moving_start] in string.whitespace:+ end = moving_start;+ break;+ moving_start += 1;+ unknown_word = sentence[start:end].strip();+ if unknown_word and isNewToken:+ count = 0;+ for analysis in grammar.languages[language].lookupMorpho(unknown_word):+ count += 1;+ if not count:+ expr = pgf.Expr("MkSymb", [pgf.Expr(unknown_word)]);+ return (expr, 0, end);+ return None;+ return callback;++def parseTester(grammar, language, sentence):+ def callback(lin_idx, start):+ if start < len(sentence):+ return (pgf.Expr(sentence[start]), 0, start+1);+ return None;+ return callback;++def translateWordsAsChunks(grammar, language, tgtlanguages, word):+ parser = grammar.languages[language].parse;+ linearizersList = dict((lang, grammar.languages[lang].linearize) \+ for lang in tgtlanguages);+ translations = [];+ try:+ for parseidx, parse in enumerate( parser(word) ):+ for lang in tgtlanguages:+ trans = linearizersList[lang](parse[1]);+ translations.append((lang, gf_utils.postprocessor(\+ trans.strip() if trans else '')));+ break;+ except pgf.ParseError as err:+ return [];+ return translations;++def translateWord(grammar, language, tgtlanguages, word):+ possible_translations = translateWordsAsChunks(grammar, language, \+ tgtlanguages, word);+ if len(possible_translations):+ return possible_translations;+ lowerword = word.lower();+ try:+ partialExprList = grammar.languages[language].parse(word, cat='Chunk');+ for expr in partialExprList:+ return [(lang, gf_utils.gf_postprocessor(\+ grammar.languages[lang].linearize(expr[1]))) \+ for lang in tgtlanguages];+ except pgf.ParseError:+ morphAnalysis = grammar.languages[language].lookupMorpho(word) +\+ grammar.languages[language].lookupMorpho(lowerword);+ for morph in morphAnalysis:+ countPositiveLanguages = list(filter(None, \+ [grammar.languages[lang].hasLinearization(morph[0]) \+ for lang in tgtlanguages]));+ if len(countPositiveLanguages) > 0.5*len(tgtlanguages):+ return [(lang, \+ gf_utils.gf_postprocessor(grammar.languages[lang].linearize(pgf.readExpr(morph[0])))) \+ for lang in tgtlanguages];+ return [(lang, word) for lang in tgtlanguages];++def translationByLookup(grammar, language, tgtlanguages, sentence):+ parser = grammar.languages[language].parse;+ linearizersList = dict([(lang, grammar.languages[lang].linearize) \+ for lang in tgtlanguages]);+ queue = [sentence.strip().split()];+ transChunks = {};+ while len(queue):+ head = queue[0];+ if not len(head):+ pass;+ elif len(head) == 1 and head[0].strip():+ for lang, wordchoice in translateWord(grammar, language, \+ tgtlanguages, head[0]):+ transChunks.setdefault(lang, []).append(\+ gf_utils.postprocessor(wordchoice));+ else:+ try:+ for parseidx, parse in enumerate(parser(' '.join(head))):+ for lang in tgtlanguages:+ if linearizersList[lang](parse[1]) == None:+ transChunks.setdefault(lang, []).append(' ');+ else:+ transChunks.setdefault(lang, []).append(\+ gf_utils.postprocessor(linearizersList[lang](parse[1]).strip()));+ break;+ except pgf.ParseError as err:+ #unseenToken = re.findall('"[^"]+?"', err.message)[0][1:-1];+ unseenToken = err.message.strip().split()[-1][1:-1];+ idx = head.index(unseenToken);+ queue.insert(1, head[:idx] );+ queue.insert(2, [head[idx]] );+ queue.insert(3, head[idx+1:] );+ del queue[0];+ for lang in tgtlanguages:+ yield (lang, ' '.join(transChunks[lang]));++def pipelineParsing(grammar, language, sentences, K=20):+ #buf = [sent for sent in sentences];+ buf, sentences = itertools.tee(sentences, 2);+ parser = gf_utils.getKBestParses(grammar, language, K);+ for sent, (time, parsesBlock) in zip(buf, map(parser, sentences)):+ yield (sent, parsesBlock);++def translation_pipeline(props):+ if props.propsfile:+ props = readTranslationPipelineOptions(props.propsfile, props);+ + # UGLY HACK FOR K-best translation: if K-best translation output format is only txt+ if props.bestK != 1:+ props.format = 'txt';+ + if not os.path.isdir( props.exp_directory ):+ logging.info("Creating output directory: %s" %(props.exp_directory));+ os.makedirs(props.exp_directory);+ + if not props.srclang:+ logging.critical("Mandatory option source-lang missing. Can not determine source language.");+ sys.exit(1);+ + grammar = pgf.readPGF(props.pgffile);+ + sourceLanguage = filter(None, [lang if lang[-3:] == props.srclang else '' for lang in grammar.languages.keys()]);+ sourceLanguage = list(sourceLanguage)[0];+ logging.info("Translating from %s" %(sourceLanguage));+ + if len(props.tgtlangs):+ target_langs = props.tgtlangs;+ else:+ target_langs = filter(None, [lang[-3:] if lang != sourceLanguage \+ else '' for lang in grammar.languages.keys()]);+ targetLanguages = filter(None, [lang if lang[-3:] in target_langs \+ else '' for lang in grammar.languages.keys()]);+ targetLanguages = list(targetLanguages);+ logging.info("Translating into the following languages: %s" %(','.join(targetLanguages)));+ + K = props.bestK if props.bestK != 1 else 20; # by default we look for 20 best parses+ bestK = props.bestK;+ + if not props.input:+ logging.info( "Input file name missing. Reading input from stdin." );+ inputStream = sys.stdin;+ outputPrefix = os.getpid();+ else:+ inputStream = codecs.open(props.input, 'r');+ outputPrefix = os.path.splitext( os.path.split(props.input)[1] )[0];+ + if props.format == 'sgm':+ inputDoc = etree.parse(inputStream);+ reader = sgmReader;+ skeletonDoc = getXMLSkeleton;+ addItem = addToSgm;+ writer = sgmWriter;+ elif props.format == 'txt':+ logging.info("Input format is txt. Assuming one-sentence-per-line format.");+ inputDoc = inputStream;+ reader = lambda X: X;+ skeletonDoc = lambda X, lang: list();+ addItem = lambda X, y: list.append(X, y); + writer = lambda X: ('\n'.join(X) if bestK == 1 else \+ '\n'.join(map(gf_utils.printMosesNbestFormat, X)));+ + translationBlocks = {};+ for tgtlang in targetLanguages+['abstract']:+ translationBlocks[tgtlang] = skeletonDoc(inputDoc, tgtlang);+ + preprocessor = pipeline_lexer;+ postprocessor = clean_gfstrings;+ + logging.info( "Parsing text in %s" %(sourceLanguage) );+ # 1. Get Abstract Trees for sentences in source language.+ tokenized_sentences = map(preprocessor, reader(inputDoc));+ web_lexer = gf_utils.Lexer('Web', grammar, sourceLanguage).tokenize; + absParses = [parsesBlock for parsesBlock in \+ pipelineParsing(grammar, sourceLanguage, \+ map(web_lexer, tokenized_sentences), K)];+ + logging.info( "Linearizing into %s" %(','.join(targetLanguages)) );+ # 2. Linearize in all target Languages+ for idx, parsesBlock in enumerate( map(operator.itemgetter(1), absParses) ):+ translationBuffer = {};+ if not len(parsesBlock):+ # failed to parse;+ # translate using lookup+ for tgtlang, translation in translationByLookup(grammar, sourceLanguage,\+ targetLanguages, absParses[idx][0]):+ if bestK == 1:+ addItem(translationBlocks[tgtlang], postprocessor(translation));+ else:+ addItem(translationBlocks[tgtlang], [((0,), postprocessor(translation))]);+ addItem(translationBlocks['abstract'], '');+ else:+ bestTranslationIdx = 0;+ for tgtlang in targetLanguages:+ translationBuffer[tgtlang] = next(gf_utils.getKLinearizations(grammar, \+ tgtlang, [parsesBlock], K=bestK));+ if bestK == 1:+ for tidx, translation in enumerate(translationBuffer[tgtlang]):+ if postprocessor(translation[1]).strip():+ if tidx > bestTranslationIdx:+ bestTranslationIdx = tidx;+ break;+ for tgtlang in targetLanguages:+ if bestK == 1:+ translation = postprocessor(translationBuffer[tgtlang][bestTranslationIdx][1]) \+ if len(translationBuffer[tgtlang]) > bestTranslationIdx \+ else ((None,), '');+ abstract = str(parsesBlock[bestTranslationIdx][1]);+ else:+ translation = translationBuffer[tgtlang] \+ if len(translationBuffer[tgtlang]) \+ else [];+ abstract = parsesBlock;+ addItem(translationBlocks[tgtlang], translation);+ addItem(translationBlocks['abstract'], abstract);+ + for tgtlang in targetLanguages+['abstract']:+ outputFile = os.path.join( props.exp_directory, '%s-%s.%s' %(outputPrefix, tgtlang[-3:] \+ if tgtlang!='abstract' \+ else 'abstract', props.format) );+ logging.info( "Writing translations for %s to %s" %(tgtlang, outputFile) );+ with codecs.open(outputFile, 'w', encoding='utf-8') as outputStream:+ print(writer(translationBlocks[tgtlang]), file=outputStream);+ return;++def cmdLineParser():+ argparser = argparse.ArgumentParser(prog='translation_pipeline.py', description='Run the GF translation pipeline on standard test-sets');+ argparser.add_argument('-g', '--pgf', dest='pgffile', required=True, help='PGF grammar file to run the pipeline');+ argparser.add_argument('-s', '--source', dest='srclang', default='', help='Source language of input sentences');+ argparser.add_argument('-t', '--target', dest='tgtlangs', nargs='*', default=[], help='Target languages to linearize (default is all other languages)');+ argparser.add_argument('-i', '--input', dest='input', default='', help='input file (default will accept STDIN)');+ argparser.add_argument('-e', '--exp', dest='exp_directory', default=os.getcwd(), help='experiement directory to write translation files');+ argparser.add_argument('-f', '--format', dest='format', default='txt', choices=['txt', 'sgm'], help='input file format (output files will be written in the same format)');+ argparser.add_argument('-p', '--props', dest='propsfile', default='', help='properties file for the translation pipeline (specify the above arguments in a file)');+ argparser.add_argument('-K', dest='bestK', type=int, default=1, help='K value for K-best translation');+ return argparser;++if __name__ == '__main__':+ logging.basicConfig(level='INFO');+ pipelineEnv = cmdLineParser().parse_args(sys.argv[1:]);+ translation_pipeline(pipelineEnv);
@@ -0,0 +1,3457 @@+#define PY_SSIZE_T_CLEAN+#include <Python.h>+#include "structmember.h"++#include <gu/mem.h>+#include <gu/map.h>+#include <gu/file.h>+#include <pgf/pgf.h>+#include <pgf/linearizer.h>++#if PY_MAJOR_VERSION >= 3+ #define PyIntObject PyLongObject+ #define PyInt_Type PyLong_Type+ #define PyInt_Check(op) PyLong_Check(op)+ #define PyInt_CheckExact(op) PyLong_CheckExact(op)+ #define PyInt_FromString PyLong_FromString+ #define PyInt_FromUnicode PyLong_FromUnicode+ #define PyInt_FromLong PyLong_FromLong+ #define PyInt_FromSize_t PyLong_FromSize_t+ #define PyInt_FromSsize_t PyLong_FromSsize_t+ #define PyInt_AsLong PyLong_AsLong+ #define PyInt_AS_LONG PyLong_AS_LONG+ #define PyInt_AsSsize_t PyLong_AsSsize_t+ #define PyInt_AsUnsignedLongMask PyLong_AsUnsignedLongMask+ #define PyInt_AsUnsignedLongLongMask PyLong_AsUnsignedLongLongMask+#endif++#if PY_MAJOR_VERSION >= 3+ #define PyString_Check PyUnicode_Check+ #define PyString_FromString PyUnicode_FromString+ #define PyString_FromStringAndSize PyUnicode_FromStringAndSize+ #define PyString_FromFormat PyUnicode_FromFormat+ #define PyString_Concat(ps,s) {PyObject* tmp = *(ps); *(ps) = PyUnicode_Concat(tmp,s); Py_DECREF(tmp);}+#endif++static PyObject* PGFError;++static PyObject* ParseError;++static PyObject* TypeError;++typedef struct {+ PyObject_HEAD+ GuPool* pool;+ PgfPGF* pgf;+} PGFObject;++typedef struct {+ PyObject_HEAD+ PyObject* master;+ GuPool* pool;+ PgfExpr expr;+} ExprObject;++static ExprObject*+Expr_new(PyTypeObject *type, PyObject *args, PyObject *kwds)+{+ ExprObject* self = (ExprObject *)type->tp_alloc(type, 0);+ if (self != NULL) {+ self->master = NULL;+ self->pool = NULL;+ self->expr = gu_null_variant;+ }++ return self;+}++static void+Expr_dealloc(ExprObject* self)+{+ if (self->master != NULL) {+ Py_DECREF(self->master);+ }+ if (self->pool != NULL) {+ gu_pool_free(self->pool);+ }++ Py_TYPE(self)->tp_free((PyObject*)self);+}++static PyObject*+Expr_getattro(ExprObject *self, PyObject *attr_name);++static int+Expr_initMeta(ExprObject *self);++static int+Expr_initLiteral(ExprObject *self, PyObject *lit);++static int+Expr_initApp(ExprObject *self, const char* fname, PyObject *args);++static ExprObject*+Expr_call(ExprObject* e, PyObject* args, PyObject* kw);++static PyObject*+Expr_unpack(ExprObject* self, PyObject *args);++static PyObject*+Expr_visit(ExprObject* self, PyObject *args);++static PyObject*+Expr_reduce_ex(ExprObject* self, PyObject *args);++static int+Expr_init(ExprObject *self, PyObject *args, PyObject *kwds)+{+ Py_ssize_t tuple_size = PyTuple_Size(args);++ if (tuple_size == 0) {+ return Expr_initMeta(self);+ } else if (tuple_size == 1) {+ PyObject* lit = NULL;+ if (!PyArg_ParseTuple(args, "O", &lit))+ return -1;+ return Expr_initLiteral(self, lit);+ } else if (tuple_size == 2) {+ const char* fname;+ PyObject* list = NULL;+ if (!PyArg_ParseTuple(args, "sO!", &fname, &PyList_Type, &list))+ return -1;+ return Expr_initApp(self, fname, list);+ } else {+ PyErr_Format(PyExc_TypeError, "function takes 0, 1 or 2 arguments (%d given)", (int) tuple_size);+ return -1;+ }+ + return 0;+}++static PyObject *+Expr_repr(ExprObject *self)+{+ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_print_expr(self->expr, NULL, 0, out, err);++ PyObject* pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));+ + gu_pool_free(tmp_pool);+ return pystr;+}++static PyObject *+Expr_richcompare(ExprObject *e1, ExprObject *e2, int op)+{+ bool cmp = pgf_expr_eq(e1->expr,e2->expr);+ + if (op == Py_EQ) {+ if (cmp) Py_RETURN_TRUE; else Py_RETURN_FALSE;+ } else if (op == Py_NE) {+ if (cmp) Py_RETURN_FALSE; else Py_RETURN_TRUE;+ } else {+ PyErr_SetString(PyExc_TypeError, "the operation is not supported");+ return NULL;+ }+}++static long+Expr_hash(ExprObject *e)+{+ return (long) pgf_expr_hash(0, e->expr);+}++static PyMethodDef Expr_methods[] = {+ {"unpack", (PyCFunction)Expr_unpack, METH_VARARGS,+ "Decomposes an expression into its components"+ },+ {"visit", (PyCFunction)Expr_visit, METH_VARARGS,+ "Implementation of the visitor pattern for abstract syntax trees. "+ "If e is an expression equal to f a1 .. an then "+ "e.visit(self) calls method self.on_f(a1,..an). "+ "If the method doesn't exist then the method self.default(e) "+ "is called."+ },+ {"__reduce_ex__", (PyCFunction)Expr_reduce_ex, METH_VARARGS,+ "This method allows for transparent pickling/unpickling of expressions."+ },+ {NULL} /* Sentinel */+};++static PyGetSetDef Expr_getseters[] = {+ {"fun", + NULL, NULL,+ "this is the function in a function application",+ NULL},+ {"arg", + NULL, NULL,+ "this is the argument in a function application",+ NULL},+ {"val", + NULL, NULL,+ "this is the value of a literal",+ NULL},+ {"id", + NULL, NULL,+ "this is the id of a meta variable",+ NULL},+ {"name", + NULL, NULL,+ "this is the name of a function",+ NULL},+ {"index", + NULL, NULL,+ "this is the de Bruijn index of a variable",+ NULL},+ {NULL} /* Sentinel */+};++static PyTypeObject pgf_ExprType = {+ PyVarObject_HEAD_INIT(NULL, 0)+ //0, /*ob_size*/+ "pgf.Expr", /*tp_name*/+ sizeof(ExprObject), /*tp_basicsize*/+ 0, /*tp_itemsize*/+ (destructor)Expr_dealloc, /*tp_dealloc*/+ 0, /*tp_print*/+ 0, /*tp_getattr*/+ 0, /*tp_setattr*/+ 0, /*tp_compare*/+ 0, /*tp_repr*/+ 0, /*tp_as_number*/+ 0, /*tp_as_sequence*/+ 0, /*tp_as_mapping*/+ (hashfunc) Expr_hash, /*tp_hash */+ (ternaryfunc) Expr_call, /*tp_call*/+ (reprfunc) Expr_repr, /*tp_str*/+ (getattrofunc) Expr_getattro,/*tp_getattro*/+ 0, /*tp_setattro*/+ 0, /*tp_as_buffer*/+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/+ "abstract syntax tree", /*tp_doc*/+ 0, /*tp_traverse */+ 0, /*tp_clear */+ (richcmpfunc) Expr_richcompare, /*tp_richcompare */+ 0, /*tp_weaklistoffset */+ 0, /*tp_iter */+ 0, /*tp_iternext */+ Expr_methods, /*tp_methods */+ 0, /*tp_members */+ Expr_getseters, /*tp_getset */+ 0, /*tp_base */+ 0, /*tp_dict */+ 0, /*tp_descr_get */+ 0, /*tp_descr_set */+ 0, /*tp_dictoffset */+ (initproc)Expr_init, /*tp_init */+ 0, /*tp_alloc */+ (newfunc) Expr_new, /*tp_new */+};++static int+Expr_initMeta(ExprObject *self)+{+ self->master = NULL;+ self->pool = gu_new_pool();+ PgfExprMeta* e =+ gu_new_variant(PGF_EXPR_META,+ PgfExprMeta,+ &self->expr, self->pool);+ e->id = 0;+ return 0;+}++static int+Expr_initLiteral(ExprObject *self, PyObject *lit)+{+ self->master = NULL;+ self->pool = gu_new_pool();+ PgfExprLit* e =+ gu_new_variant(PGF_EXPR_LIT,+ PgfExprLit,+ &self->expr, self->pool);+ e->lit = gu_null_variant;++ if (PyString_Check(lit)) {+ char* s;+ Py_ssize_t len;++#if PY_MAJOR_VERSION >= 3+ PyObject* bytes = PyUnicode_AsUTF8String(lit);+ if (bytes == NULL)+ return -1;+ if (PyBytes_AsStringAndSize(bytes,&s,&len) < 0)+ return -1;+#else+ if (PyString_AsStringAndSize(lit,&s,&len) < 0)+ return -1;+#endif++ PgfLiteralStr* slit =+ gu_new_flex_variant(PGF_LITERAL_STR,+ PgfLiteralStr,+ val, len+1,+ &e->lit, self->pool);+ memcpy(slit->val, s, len+1);++#if PY_MAJOR_VERSION >= 3+ Py_DECREF(bytes);+#endif+ } else if (PyInt_Check(lit)) {+ PgfLiteralInt* ilit =+ gu_new_variant(PGF_LITERAL_INT,+ PgfLiteralInt,+ &e->lit, self->pool);+ ilit->val = PyInt_AsLong(lit);+ } else if (PyFloat_Check(lit)) {+ PgfLiteralFlt* flit =+ gu_new_variant(PGF_LITERAL_FLT,+ PgfLiteralFlt,+ &e->lit, self->pool);+ flit->val = PyFloat_AsDouble(lit);+ } else {+ PyErr_SetString(PyExc_TypeError, "the literal must be a string, an integer, or a float");+ return -1;+ }+ return 0;+}++static int+Expr_initApp(ExprObject *self, const char* fname, PyObject *args)+{+ Py_ssize_t n_args = PyList_Size(args);++ self->master = PyTuple_New(n_args);+ if (self->master == NULL)+ return -1;++ self->pool = gu_new_pool();+ PgfExprFun* e =+ gu_new_flex_variant(PGF_EXPR_FUN,+ PgfExprFun,+ fun, strlen(fname)+1,+ &self->expr, self->pool);+ strcpy(e->fun, fname);++ for (Py_ssize_t i = 0; i < n_args; i++) {+ PyObject* obj = PyList_GetItem(args, i);+ if (obj->ob_type != &pgf_ExprType) {+ PyErr_SetString(PyExc_TypeError, "the arguments in the list must be expressions");+ return -1;+ }++ PyTuple_SetItem(self->master, i, obj);+ Py_INCREF(obj);++ PgfExpr fun = self->expr;+ PgfExpr arg = ((ExprObject*) obj)->expr;++ PgfExprApp* e =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &self->expr, self->pool);+ e->fun = fun;+ e->arg = arg;+ }+ + return 0;+}++static ExprObject*+Expr_call(ExprObject* self, PyObject* args, PyObject* kw)+{+ ExprObject* pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (pyexpr == NULL)+ return NULL;++ size_t n_args = PyTuple_Size(args);++ pyexpr->master = PyTuple_New(n_args+1);+ if (pyexpr->master == NULL) {+ Py_DECREF(pyexpr);+ return NULL;+ }++ PyTuple_SetItem(pyexpr->master, 0, (PyObject*) self);+ Py_INCREF(self);++ pyexpr->pool = gu_new_pool();+ pyexpr->expr = self->expr;++ for (Py_ssize_t i = 0; i < n_args; i++) {+ PyObject* obj = PyTuple_GetItem(args, i);+ if (obj->ob_type != &pgf_ExprType) {+ PyErr_SetString(PyExc_TypeError, "the arguments must be expressions");+ return NULL;+ }++ PyTuple_SetItem(pyexpr->master, i+1, obj);+ Py_INCREF(obj);++ PgfExpr fun = pyexpr->expr;+ PgfExpr arg = ((ExprObject*) obj)->expr;++ PgfExprApp* e =+ gu_new_variant(PGF_EXPR_APP,+ PgfExprApp,+ &pyexpr->expr, pyexpr->pool);+ e->fun = fun;+ e->arg = arg;+ }++ return pyexpr;+}++static PyObject*+Expr_unpack(ExprObject* self, PyObject *fargs)+{+ PgfExpr expr = self->expr;+ PyObject* args = PyList_New(0);++ for (;;) {+ GuVariantInfo i = gu_variant_open(expr);+ switch (i.tag) {+ case PGF_EXPR_ABS: {+ PgfExprAbs* eabs = i.data;++ ExprObject* py_body = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (py_body == NULL) {+ Py_DECREF(args);+ return NULL;+ }+ py_body->pool = NULL;+ py_body->master = (self->master) ? self->master : (PyObject*) self;+ py_body->expr = eabs->body;+ Py_INCREF(py_body->master);++ PyObject* py_bindtype = + (eabs->bind_type == PGF_BIND_TYPE_EXPLICIT) ? Py_True+ : Py_False;+ PyObject* py_var = PyString_FromString(eabs->id);+ PyObject* res = + Py_BuildValue("OOOO", py_bindtype, py_var, py_body, args);+ Py_DECREF(py_var);+ Py_DECREF(py_body);+ Py_DECREF(args);+ return res;+ }+ case PGF_EXPR_APP: {+ PgfExprApp* eapp = i.data;+ + ExprObject* pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (pyexpr == NULL) {+ Py_DECREF(args);+ return NULL;+ }+ pyexpr->pool = NULL;+ pyexpr->master = (self->master) ? self->master : (PyObject*) self;+ pyexpr->expr = eapp->arg;+ Py_INCREF(pyexpr->master);++ if (PyList_Insert(args, 0, (PyObject*) pyexpr) == -1) {+ Py_DECREF(args);+ return NULL;+ }++ Py_DECREF((PyObject*) pyexpr);++ expr = eapp->fun;+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = i.data;++ Py_DECREF(args);+ + GuVariantInfo i = gu_variant_open(elit->lit);+ switch (i.tag) {+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = i.data;+ return PyString_FromString(lstr->val);+ }+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = i.data;+ return PyInt_FromLong(lint->val);+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = i.data;+ return PyFloat_FromDouble(lflt->val);+ }+ default:+ gu_impossible();+ return NULL;+ }+ }+ case PGF_EXPR_META: {+ PyObject* res = Py_BuildValue("OO", Py_None, args);+ Py_DECREF(args);+ return res;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* efun = i.data;+ PyObject* fun = PyString_FromString(efun->fun);+ PyObject* res = Py_BuildValue("OO", fun, args);+ Py_DECREF(fun);+ Py_DECREF(args);+ return res;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* evar = i.data;+ PyObject* res = Py_BuildValue("iO", evar->var, args);+ Py_DECREF(args);+ return res;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = i.data;+ expr = etyped->expr;+ break;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = i.data;+ expr = eimpl->expr;+ break;+ }+ default:+ gu_impossible();+ return NULL;+ }+ }+ return NULL;+}++static PyObject*+Expr_visit(ExprObject* self, PyObject *args)+{+ PyObject* py_visitor = NULL;+ PgfExpr expr = self->expr;+ if (!PyArg_ParseTuple(args, "O", &py_visitor))+ return NULL;++ GuPool* tmp_pool = gu_local_pool();++ PgfApplication* app = pgf_expr_unapply(expr, tmp_pool);+ if (app != NULL) {+ char* method_name = gu_malloc(tmp_pool, strlen(app->fun)+4);+ strcpy(method_name, "on_");+ strcat(method_name, app->fun);++ if (PyObject_HasAttrString(py_visitor, method_name)) {+ PyObject* method_args = PyTuple_New(app->n_args);+ if (method_args == NULL) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ for (size_t i = 0; i < app->n_args; i++) {+ ExprObject* pyarg = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (pyarg == NULL) {+ Py_DECREF(args);+ gu_pool_free(tmp_pool);+ return NULL;+ }+ pyarg->pool = NULL;+ pyarg->master = (self->master) ? self->master : (PyObject*) self;+ pyarg->expr = app->args[i];+ Py_INCREF(pyarg->master);++ if (PyTuple_SetItem(method_args, i, (PyObject*) pyarg) == -1) {+ Py_DECREF(args);+ gu_pool_free(tmp_pool);+ return NULL;+ }+ }+ + PyObject* method =+ PyObject_GetAttrString(py_visitor, method_name);+ if (method == NULL) {+ Py_DECREF(args);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ return PyObject_CallObject(method, method_args);+ }+ }++ gu_pool_free(tmp_pool);++ return PyObject_CallMethod(py_visitor, "default", "O", self);+}++static PyObject*+Expr_reduce_ex(ExprObject* self, PyObject *args)+{+ int protocol;+ if (!PyArg_ParseTuple(args, "i", &protocol))+ return NULL;++ PyObject* myModule = PyImport_ImportModule("pgf");+ if (myModule == NULL)+ return NULL;+ PyObject* py_readExpr = PyObject_GetAttrString(myModule, "readExpr");+ Py_DECREF(myModule);+ if (py_readExpr == NULL)+ return NULL;++ PyObject* py_str = Expr_repr(self);+ if (py_str == NULL) {+ Py_DECREF(py_readExpr);+ return NULL;+ }++ PyObject* py_tuple =+ Py_BuildValue("O(O)", py_readExpr, py_str);++ Py_DECREF(py_str);+ Py_DECREF(py_readExpr);++ return py_tuple;+}++static PyObject*+Expr_getattro(ExprObject *self, PyObject *attr_name) {+#if PY_MAJOR_VERSION >= 3+#define IS_ATTR(attr) (PyUnicode_CompareWithASCIIString(attr_name,attr) == 0)+#else+ const char* name = PyString_AsString(attr_name);+#define IS_ATTR(attr) (strcmp(name, attr) == 0)+#endif++ PgfExpr expr = self->expr;+ +redo:;+ GuVariantInfo i = gu_variant_open(expr);+ switch (i.tag) {+ case PGF_EXPR_APP: {+ PgfExprApp* eapp = i.data;+ + ExprObject* pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (pyexpr == NULL)+ return NULL;+ pyexpr->pool = NULL;+ pyexpr->master = (self->master) ? self->master : (PyObject*) self;+ pyexpr->expr = gu_null_variant;+ Py_INCREF(pyexpr->master);++ if (IS_ATTR("fun")) {+ pyexpr->expr = eapp->fun;+ return ((PyObject*) pyexpr);+ } else if (IS_ATTR("arg")) {+ pyexpr->expr = eapp->arg;+ return ((PyObject*) pyexpr);+ } else {+ Py_DECREF(pyexpr);+ }+ break;+ }+ case PGF_EXPR_LIT: {+ PgfExprLit* elit = i.data;+ + if (IS_ATTR("val")) {+ GuVariantInfo i = gu_variant_open(elit->lit);+ switch (i.tag) {+ case PGF_LITERAL_INT: {+ PgfLiteralInt* lint = i.data;+ return PyInt_FromLong(lint->val);+ }+ case PGF_LITERAL_FLT: {+ PgfLiteralFlt* lflt = i.data;+ return PyFloat_FromDouble(lflt->val);+ }+ case PGF_LITERAL_STR: {+ PgfLiteralStr* lstr = i.data;+ return PyString_FromString(lstr->val);+ }+ }+ }+ break;+ }+ case PGF_EXPR_META: {+ PgfExprMeta* emeta = i.data;+ if (IS_ATTR("id"))+ return PyInt_FromLong(emeta->id);+ break;+ }+ case PGF_EXPR_FUN: {+ PgfExprFun* efun = i.data;+ if (IS_ATTR("name")) {+ return PyString_FromString(efun->fun);+ }+ break;+ }+ case PGF_EXPR_VAR: {+ PgfExprVar* evar = i.data;+ if (IS_ATTR("index")) {+ return PyInt_FromLong(evar->var);+ }+ break;+ }+ case PGF_EXPR_TYPED: {+ PgfExprTyped* etyped = i.data;+ expr = etyped->expr;+ goto redo;+ }+ case PGF_EXPR_IMPL_ARG: {+ PgfExprImplArg* eimpl = i.data;+ expr = eimpl->expr;+ goto redo;+ }+ default:+ gu_impossible();+ }++ return PyObject_GenericGetAttr((PyObject*)self, attr_name);+}++typedef struct {+ PyObject_HEAD+ PyObject* master;+ GuPool* pool;+ PgfType* type;+} TypeObject;++static PyTypeObject pgf_TypeType;++static TypeObject*+Type_new(PyTypeObject *type, PyObject *args, PyObject *kwds)+{+ TypeObject* self = (TypeObject *)type->tp_alloc(type, 0);+ if (self != NULL) {+ self->master = NULL;+ self->pool = NULL;+ self->type = NULL;+ }++ return self;+}++static void+Type_dealloc(TypeObject* self)+{+ if (self->master != NULL) {+ Py_DECREF(self->master);+ }+ if (self->pool != NULL) {+ gu_pool_free(self->pool);+ }++ Py_TYPE(self)->tp_free((PyObject*)self);+}++static int+Type_init(TypeObject *self, PyObject *args, PyObject *kwds)+{+ PyObject* py_hypos;+ const char* catname_s;+ PyObject* py_exprs;+ size_t n_exprs;+ size_t n_hypos;++ if (PyTuple_Size(args) == 1) {+ py_hypos = NULL;+ py_exprs = NULL;+ n_exprs = 0;+ n_hypos = 0;+ if (!PyArg_ParseTuple(args, "s", &catname_s))+ return -1;+ } else {+ if (!PyArg_ParseTuple(args, "O!sO!", + &PyList_Type, &py_hypos, + &catname_s, + &PyList_Type, &py_exprs))+ return -1;+ + n_exprs = PyList_Size(py_exprs);+ n_hypos = PyList_Size(py_hypos);+ }++ self->pool = gu_new_pool();+ self->master =+ (n_exprs+n_hypos > 0) ? PyTuple_New(n_exprs+n_hypos) : NULL;++ self->type = gu_new_flex(self->pool, PgfType, exprs, n_exprs);++ self->type->hypos =+ gu_new_seq(PgfHypo, n_hypos, self->pool);++ for (size_t i = 0; i < n_hypos; i++) {+ PyObject* obj = PyList_GetItem(py_hypos, i);+ PyObject* py_bindtype;+ PgfCId cid;+ PyObject* py_type;++ if (Py_TYPE(obj) == &pgf_TypeType) {+ py_bindtype = Py_True;+ cid = "_";+ py_type = obj;+ } else {+ if (!PyTuple_Check(obj) ||+ PyTuple_GET_SIZE(obj) != 3) {+ PyErr_SetString(PyExc_TypeError, "the arguments in the first list must be triples of (boolean,string,pgf.Type)");+ return -1;+ }++ py_bindtype = PyTuple_GetItem(obj, 0);+ if (!PyBool_Check(py_bindtype)) {+ PyErr_SetString(PyExc_TypeError, "the arguments in the first list must be triples of (boolean,string,pgf.Type)");+ return -1;+ }++ PyObject* py_var = PyTuple_GetItem(obj, 1);+ if (!PyString_Check(py_var)) {+ PyErr_SetString(PyExc_TypeError, "the arguments in the first list must be triples of (boolean,string,pgf.Type)");+ return -1;+ }++ {+ char* s;+ Py_ssize_t len;++#if PY_MAJOR_VERSION >= 3+ PyObject* bytes = PyUnicode_AsUTF8String(py_var);+ if (bytes == NULL)+ return -1;+ if (PyBytes_AsStringAndSize(bytes,&s,&len) < 0)+ return -1;+#else+ if (PyString_AsStringAndSize(py_var,&s,&len) < 0)+ return -1;+#endif++ cid = gu_malloc(self->pool, len+1);+ memcpy((char*)cid, s, len+1);++#if PY_MAJOR_VERSION >= 3+ Py_DECREF(bytes);+#endif+ }++ py_type = PyTuple_GetItem(obj, 2);+ if (Py_TYPE(py_type) != &pgf_TypeType) {+ PyErr_SetString(PyExc_TypeError, "the arguments in the first list must be triples of (boolean,string,pgf.Type)");+ return -1;+ }+ }++ PgfHypo* hypo = gu_seq_index(self->type->hypos, PgfHypo, i);+ hypo->bind_type = + (py_bindtype == Py_True) ? PGF_BIND_TYPE_EXPLICIT+ : PGF_BIND_TYPE_IMPLICIT;+ hypo->cid = cid;+ hypo->type = ((TypeObject*) py_type)->type;++ PyTuple_SetItem(self->master, i, py_type);+ Py_INCREF(py_type);+ }++ self->type->cid = gu_string_copy(catname_s, self->pool);++ self->type->n_exprs = n_exprs;+ for (Py_ssize_t i = 0; i < n_exprs; i++) {+ PyObject* obj = PyList_GetItem(py_exprs, i);+ if (Py_TYPE(obj) != &pgf_ExprType) {+ PyErr_SetString(PyExc_TypeError, "the arguments in the second list must be expressions");+ return -1;+ }++ PyTuple_SetItem(self->master, n_hypos+i, obj);+ Py_INCREF(obj);++ self->type->exprs[i] = ((ExprObject*) obj)->expr;+ }++ return 0;+}++static PyObject *+Type_repr(TypeObject *self)+{+ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_print_type(self->type, NULL, 0, out, err);++ PyObject* pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));++ gu_pool_free(tmp_pool);+ return pystr;+}++static PyObject *+Type_richcompare(TypeObject *t1, TypeObject *t2, int op)+{+ bool cmp = pgf_type_eq(t1->type,t2->type);++ if (op == Py_EQ) {+ if (cmp) Py_RETURN_TRUE; else Py_RETURN_FALSE;+ } else if (op == Py_NE) {+ if (cmp) Py_RETURN_FALSE; else Py_RETURN_TRUE;+ } else {+ PyErr_SetString(PyExc_TypeError, "the operation is not supported");+ return NULL;+ }+}++static PyObject*+Type_getHypos(TypeObject *self, void *closure)+{+ PgfType* type = self->type;++ PyObject* py_hypos = PyList_New(0);+ if (py_hypos == NULL)+ return NULL;++ size_t n_hypos = gu_seq_length(type->hypos);+ for (size_t i = 0; i < n_hypos; i++) {+ PgfHypo* hypo = gu_seq_index(type->hypos, PgfHypo, i);++ PyObject* py_bindtype = + (hypo->bind_type == PGF_BIND_TYPE_EXPLICIT) ? Py_True+ : Py_False;++ PyObject* py_var = PyString_FromString(hypo->cid);+ if (py_var == NULL)+ goto fail;++ TypeObject* py_type = (TypeObject*) pgf_TypeType.tp_alloc(&pgf_TypeType, 0);+ if (py_type == NULL) {+ Py_DECREF(py_var);+ goto fail;+ }++ py_type->pool = NULL;+ py_type->master = (PyObject*) self;+ py_type->type = hypo->type;+ Py_INCREF(self);++ PyObject* py_hypo = + Py_BuildValue("OOO", py_bindtype, py_var, py_type);+ Py_DECREF(py_var);+ Py_DECREF(py_type);++ if (py_hypo == NULL)+ goto fail;++ if (PyList_Append(py_hypos, (PyObject*) py_hypo) == -1)+ goto fail;++ Py_DECREF(py_hypo);+ }++ return py_hypos;+ +fail:+ Py_DECREF(py_hypos);+ return NULL;+}++static PyObject*+Type_getCat(TypeObject *self, void *closure)+{+ return PyString_FromString(self->type->cid);+}++static PyObject*+Type_getExprs(TypeObject *self, void *closure)+{+ PgfType* type = self->type;++ PyObject* py_exprs = PyList_New(0);+ if (py_exprs == NULL)+ return NULL;++ for (size_t i = 0; i < type->n_exprs; i++) {+ ExprObject* py_expr = + (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (py_expr == NULL)+ goto fail;+ py_expr->pool = NULL;+ py_expr->master = (PyObject*) self;+ py_expr->expr = type->exprs[i];+ Py_INCREF(py_expr->master);++ if (PyList_Append(py_exprs, (PyObject*) py_expr) == -1)+ goto fail;++ Py_DECREF((PyObject*) py_expr);+ }++ return py_exprs;++fail:+ Py_DECREF(py_exprs);+ return NULL;+}++static PyObject*+Type_unpack(TypeObject* self, PyObject *fargs)+{+ PyObject* res = NULL;+ PyObject* py_hypos = NULL;+ PyObject* py_cat = NULL;+ PyObject* py_exprs = NULL;++ py_hypos = Type_getHypos(self, NULL);+ if (py_hypos == NULL)+ goto fail;++ py_cat = Type_getCat(self, NULL);+ if (py_cat == NULL)+ goto fail;++ py_exprs = Type_getExprs(self, NULL);+ if (py_exprs == NULL)+ goto fail;++ res = Py_BuildValue("OOO", py_hypos, py_cat, py_exprs);++fail:+ Py_XDECREF(py_hypos);+ Py_XDECREF(py_cat);+ Py_XDECREF(py_exprs);+ return res;+}++static PyObject*+Type_reduce_ex(TypeObject* self, PyObject *args)+{+ int protocol;+ if (!PyArg_ParseTuple(args, "i", &protocol))+ return NULL;++ PyObject* myModule = PyImport_ImportModule("pgf");+ if (myModule == NULL)+ return NULL;+ PyObject* py_readType = PyObject_GetAttrString(myModule, "readType");+ Py_DECREF(myModule);+ if (py_readType == NULL)+ return NULL;++ PyObject* py_str = Type_repr(self);+ if (py_str == NULL) {+ Py_DECREF(py_readType);+ return NULL;+ }++ PyObject* py_tuple =+ Py_BuildValue("O(O)", py_readType, py_str);++ Py_DECREF(py_str);+ Py_DECREF(py_readType);++ return py_tuple;+}++static PyMethodDef Type_methods[] = {+ {"unpack", (PyCFunction)Type_unpack, METH_VARARGS,+ "Decomposes a type into its components"+ },+ {"__reduce_ex__", (PyCFunction)Type_reduce_ex, METH_VARARGS,+ "This method allows for transparent pickling/unpickling of types."+ },+ {NULL} /* Sentinel */+};++static PyGetSetDef Type_getseters[] = {+ {"hypos", + (getter)Type_getHypos, NULL,+ "this is the list of hypotheses in the type signature",+ NULL},+ {"cat", + (getter)Type_getCat, NULL,+ "this is the name of the category",+ NULL},+ {"exprs", + (getter)Type_getExprs, NULL,+ "this is the list of indices for the category",+ NULL},+ {NULL} /* Sentinel */+};++static PyTypeObject pgf_TypeType = {+ PyVarObject_HEAD_INIT(NULL, 0)+ //0, /*ob_size*/+ "pgf.Type", /*tp_name*/+ sizeof(TypeObject), /*tp_basicsize*/+ 0, /*tp_itemsize*/+ (destructor)Type_dealloc, /*tp_dealloc*/+ 0, /*tp_print*/+ 0, /*tp_getattr*/+ 0, /*tp_setattr*/+ 0, /*tp_compare*/+ 0, /*tp_repr*/+ 0, /*tp_as_number*/+ 0, /*tp_as_sequence*/+ 0, /*tp_as_mapping*/+ 0, /*tp_hash */+ 0, /*tp_call*/+ (reprfunc) Type_repr, /*tp_str*/+ 0, /*tp_getattro*/+ 0, /*tp_setattro*/+ 0, /*tp_as_buffer*/+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/+ "abstract syntax type", /*tp_doc*/+ 0, /*tp_traverse */+ 0, /*tp_clear */+ (richcmpfunc) Type_richcompare, /*tp_richcompare */+ 0, /*tp_weaklistoffset */+ 0, /*tp_iter */+ 0, /*tp_iternext */+ Type_methods, /*tp_methods */+ 0, /*tp_members */+ Type_getseters, /*tp_getset */+ 0, /*tp_base */+ 0, /*tp_dict */+ 0, /*tp_descr_get */+ 0, /*tp_descr_set */+ 0, /*tp_dictoffset */+ (initproc)Type_init, /*tp_init */+ 0, /*tp_alloc */+ (newfunc) Type_new, /*tp_new */+};++typedef struct IterObject {+ PyObject_HEAD+ PyObject* source;+ PyObject* container;+ GuPool* pool;+ int max_count;+ int counter;+ GuEnum* res;+ PyObject* (*fetch)(struct IterObject* self);+} IterObject;++static PyObject*+Iter_fetch_expr(IterObject* self)+{+ PgfExprProb* ep = gu_next(self->res, PgfExprProb*, self->pool);+ if (ep == NULL)+ return NULL;++ ExprObject* pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (pyexpr == NULL)+ return NULL;+ pyexpr->pool = NULL;+ pyexpr->expr = ep->expr;+ pyexpr->master = self->container;+ Py_XINCREF(self->container);++ PyObject* res = Py_BuildValue("(f,O)", ep->prob, pyexpr);+ Py_DECREF(pyexpr);++ return res;+}++static PyObject*+Iter_fetch_token(IterObject* self)+{+ PgfTokenProb* tp = gu_next(self->res, PgfTokenProb*, self->pool);+ if (tp == NULL)+ return NULL;++ PyObject* py_tok = PyString_FromString(tp->tok);+ PyObject* py_cat = PyString_FromString(tp->cat);+ PyObject* py_fun = PyString_FromString(tp->fun);+ PyObject* res = Py_BuildValue("(f,O,O,O)", tp->prob, py_tok, py_cat, py_fun);+ Py_DECREF(py_fun);+ Py_DECREF(py_cat);+ Py_DECREF(py_tok);++ return res;+}+++static IterObject*+Iter_new(PyTypeObject *type, PyObject *args, PyObject *kwds)+{+ IterObject* self = (IterObject *)type->tp_alloc(type, 0);+ if (self != NULL) {+ self->source = NULL;+ self->container = NULL;+ self->pool = NULL;+ self->max_count = -1;+ self->counter = 0;+ self->res = NULL;+ }++ return self;+}++static void+Iter_dealloc(IterObject* self)+{+ if (self->pool != NULL)+ gu_pool_free(self->pool);++ Py_XDECREF(self->source);+ + Py_XDECREF(self->container);++ Py_TYPE(self)->tp_free((PyObject*)self);+}++static int+Iter_init(IterObject *self, PyObject *args, PyObject *kwds)+{+ return -1;+}++static PyObject*+Iter_iter(IterObject *self)+{+ Py_INCREF(self);+ return (PyObject*) self;+}++static PyObject*+Iter_iternext(IterObject *self)+{+ if (self->max_count >= 0 && self->counter >= self->max_count) {+ return NULL;+ }+ self->counter++;++ return self->fetch(self);+}++static PyMethodDef Iter_methods[] = {+ {NULL} /* Sentinel */+};++static PyTypeObject pgf_IterType = {+ PyVarObject_HEAD_INIT(NULL, 0)+ //0, /*ob_size*/+ "pgf.Iter", /*tp_name*/+ sizeof(IterObject), /*tp_basicsize*/+ 0, /*tp_itemsize*/+ (destructor)Iter_dealloc, /*tp_dealloc*/+ 0, /*tp_print*/+ 0, /*tp_getattr*/+ 0, /*tp_setattr*/+ 0, /*tp_compare*/+ 0, /*tp_repr*/+ 0, /*tp_as_number*/+ 0, /*tp_as_sequence*/+ 0, /*tp_as_mapping*/+ 0, /*tp_hash */+ 0, /*tp_call*/+ 0, /*tp_str*/+ 0, /*tp_getattro*/+ 0, /*tp_setattro*/+ 0, /*tp_as_buffer*/+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/+ "an iterator over a sequence of expressions",/*tp_doc*/+ 0, /*tp_traverse */+ 0, /*tp_clear */+ 0, /*tp_richcompare */+ 0, /*tp_weaklistoffset */+ (getiterfunc) Iter_iter, /*tp_iter */+ (iternextfunc) Iter_iternext, /*tp_iternext */+ Iter_methods, /*tp_methods */+ 0, /*tp_members */+ 0, /*tp_getset */+ 0, /*tp_base */+ 0, /*tp_dict */+ 0, /*tp_descr_get */+ 0, /*tp_descr_set */+ 0, /*tp_dictoffset */+ (initproc)Iter_init, /*tp_init */+ 0, /*tp_alloc */+ (newfunc) Iter_new, /*tp_new */+};++typedef struct {+ PyObject_HEAD+ PGFObject* grammar;+ PgfConcr* concr;+} ConcrObject;++static ConcrObject*+Concr_new(PyTypeObject *type, PyObject *args, PyObject *kwds)+{+ ConcrObject* self = (ConcrObject *)type->tp_alloc(type, 0);+ if (self != NULL) {+ self->grammar = NULL;+ self->concr = NULL;+ }++ return self;+}++static void+Concr_dealloc(ConcrObject* self)+{+ Py_XDECREF(self->grammar);+ Py_TYPE(self)->tp_free((PyObject*)self);+}++static int+Concr_init(ConcrObject *self, PyObject *args, PyObject *kwds)+{+ return -1;+}++static PyObject*+Concr_printName(ConcrObject* self, PyObject *args)+{+ GuString id;+ if (!PyArg_ParseTuple(args, "s", &id))+ return NULL;++ GuString name = pgf_print_name(self->concr, id);+ if (name == NULL)+ Py_RETURN_NONE;++ return PyString_FromString(name);+}++#if ( (PY_VERSION_HEX < 0x02070000) \+ || ((PY_VERSION_HEX >= 0x03000000) \+ && (PY_VERSION_HEX < 0x03010000)) )++#define PyPool_New(pool) \+ PyCObject_FromVoidPtr(pool, gu_pool_free)++#else++#define PGF_CONTAINER_NAME "pgf.Container"++static void pypgf_container_descructor(PyObject *capsule)+{+ GuPool* pool = PyCapsule_GetPointer(capsule, PGF_CONTAINER_NAME);+ gu_pool_free(pool);+}++#define PyPool_New(pool) \+ PyCapsule_New(pool, PGF_CONTAINER_NAME, \+ pypgf_container_descructor)++#endif++typedef struct {+ PgfLiteralCallback callback;+ PyObject* pycallback;+ GuFinalizer fin;+} PyPgfLiteralCallback;++static PgfExprProb*+pypgf_literal_callback_match(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString sentence, size_t* poffset,+ GuPool *out_pool)+{+ PyPgfLiteralCallback* callback = + gu_container(self, PyPgfLiteralCallback, callback);++ PyObject* result =+ PyObject_CallFunction(callback->pycallback, "ii",+ lin_idx, *poffset);+ if (result == NULL)+ return NULL;++ if (result == Py_None) {+ Py_DECREF(result);+ return NULL;+ }++ PgfExprProb* ep = gu_new(PgfExprProb, out_pool);++ ExprObject* pyexpr;+ if (!PyArg_ParseTuple(result, "Ofi", &pyexpr, &ep->prob, poffset))+ return NULL;++ ep->expr = pyexpr->expr;++ {+ // This is an uggly hack. We first show the expression ep->expr+ // and then we read it back but in out_pool. The whole purpose+ // of this is to copy the expression from the temporary pool+ // that was created in the Java binding to the parser pool.+ // There should be a real copying function or even better+ // there must be a way to avoid copying at all.++ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_print_expr(ep->expr, NULL, 0, out, err);++ GuIn* in = gu_data_in((uint8_t*) gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf),+ tmp_pool);++ ep->expr = pgf_read_expr(in, out_pool, tmp_pool, err);+ if (!gu_ok(err) || gu_variant_is_null(ep->expr)) {+ PyErr_SetString(PGFError, "The expression cannot be parsed");+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ }++ Py_DECREF(result);++ return ep;+}++static GuEnum*+pypgf_literal_callback_predict(PgfLiteralCallback* self, PgfConcr* concr,+ size_t lin_idx,+ GuString prefix,+ GuPool *out_pool)+{+ return NULL;+}++static void +pypgf_literal_callback_fin(GuFinalizer* self)+{+ PyPgfLiteralCallback* callback = + gu_container(self, PyPgfLiteralCallback, fin);++ Py_XDECREF(callback->pycallback);+}++static PgfCallbacksMap*+pypgf_new_callbacks_map(PgfConcr* concr, PyObject *py_callbacks,+ GuPool* pool)+{+ PgfCallbacksMap* callbacks =+ pgf_new_callbacks_map(concr, pool);++ if (py_callbacks == NULL)+ return callbacks;++ size_t n_callbacks = PyList_Size(py_callbacks);+ for (size_t i = 0; i < n_callbacks; i++) {+ PyObject* item =+ PyList_GetItem(py_callbacks, i);++ PyObject* pycallback = NULL;+ const char* cat = NULL;+ if (!PyArg_ParseTuple(item, "sO", &cat, &pycallback))+ return NULL;++ PyPgfLiteralCallback* callback = gu_new(PyPgfLiteralCallback, pool);+ callback->callback.match = pypgf_literal_callback_match;+ callback->callback.predict = pypgf_literal_callback_predict;+ callback->pycallback = pycallback;+ callback->fin.fn = pypgf_literal_callback_fin;++ Py_XINCREF(callback->pycallback);+ + gu_pool_finally(pool, &callback->fin);++ pgf_callbacks_map_add_literal(concr, callbacks,+ cat, &callback->callback);+ }+ + return callbacks;+}++static PgfType*+pgf_type_from_object(PyObject* obj, GuPool* pool) {+ if (PyString_Check(obj)) {+ PgfType* type = gu_new_flex(pool, PgfType, exprs, 0);+ type->hypos = gu_empty_seq();+ type->cid = "";+ type->n_exprs = 0;+ return type;+ } else if (obj->ob_type == &pgf_TypeType) {+ return ((TypeObject*) obj)->type;+ } else {+ PyErr_SetString(PyExc_TypeError, "the start category should be a string or a type");+ return NULL;+ }+}++static IterObject*+Concr_parse(ConcrObject* self, PyObject *args, PyObject *keywds)+{+ static char *kwlist[] = {"sentence", "cat", "n", "heuristics", "callbacks", NULL};++ const char *sentence = NULL;+ PyObject* start = NULL;+ int max_count = -1;+ double heuristics = -1;+ PyObject* py_callbacks = NULL;+ if (!PyArg_ParseTupleAndKeywords(args, keywds, "s|OidO!", kwlist,+ &sentence, &start, &max_count,+ &heuristics,+ &PyList_Type, &py_callbacks))+ return NULL;++ IterObject* pyres = (IterObject*) + pgf_IterType.tp_alloc(&pgf_IterType, 0);+ if (pyres == NULL) {+ return NULL;+ }++ pyres->source = (PyObject*) self->grammar;+ Py_XINCREF(pyres->source);++ GuPool* out_pool = gu_new_pool();++ PyObject* py_pool = PyPool_New(out_pool);+ pyres->container = PyTuple_Pack(2, pyres->source, py_pool);+ Py_DECREF(py_pool);++ pyres->pool = gu_new_pool();+ pyres->max_count = max_count;+ pyres->counter = 0;+ pyres->fetch = Iter_fetch_expr;++ GuExn* parse_err = gu_exn(pyres->pool);++ PgfCallbacksMap* callbacks =+ pypgf_new_callbacks_map(self->concr, py_callbacks, pyres->pool);+ if (callbacks == NULL) {+ Py_DECREF(pyres);+ return NULL;+ }++ sentence = gu_string_copy(sentence, pyres->pool);++ PgfType* type;+ if (start == NULL) {+ type = pgf_start_cat(self->grammar->pgf, pyres->pool);+ } else {+ type = pgf_type_from_object(start, pyres->pool);+ }+ if (type == NULL) {+ Py_DECREF(pyres);+ return NULL;+ }++ pyres->res =+ pgf_parse_with_heuristics(self->concr, type, sentence, + heuristics, callbacks, parse_err,+ pyres->pool, out_pool);++ if (!gu_ok(parse_err)) {+ if (gu_exn_caught(parse_err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(parse_err);+ PyErr_SetString(PGFError, msg);+ } else if (gu_exn_caught(parse_err, PgfParseError)) {+ PgfParseError* err = (PgfParseError*) gu_exn_caught_data(parse_err);+ PyObject* py_offset = PyInt_FromLong(err->offset);+ if (err->incomplete) {+ PyObject_SetAttrString(ParseError, "incomplete", Py_True);+ PyObject_SetAttrString(ParseError, "offset", py_offset);+ PyErr_Format(ParseError, "The sentence is incomplete");+ } else {+ PyObject* py_tok = PyString_FromStringAndSize(err->token_ptr,+ err->token_len);+ PyObject_SetAttrString(ParseError, "incomplete", Py_False);+ PyObject_SetAttrString(ParseError, "offset", py_offset);+ PyObject_SetAttrString(ParseError, "token", py_tok);+#if PY_MAJOR_VERSION >= 3+ PyErr_Format(ParseError, "Unexpected token: \"%U\"", py_tok);+#else+ PyErr_Format(ParseError, "Unexpected token: \"%s\"", PyString_AsString(py_tok));+#endif+ Py_DECREF(py_tok);+ }+ Py_DECREF(py_offset);+ }++ Py_DECREF(pyres);+ pyres = NULL;+ }++ return pyres;+}++static IterObject*+Concr_complete(ConcrObject* self, PyObject *args, PyObject *keywds)+{+ static char *kwlist[] = {"sentence", "cat", "prefix", "n", NULL};++ const char *sentence = NULL;+ PyObject* start = NULL;+ GuString prefix = "";+ int max_count = -1;+ if (!PyArg_ParseTupleAndKeywords(args, keywds, "s|Osi", kwlist,+ &sentence, &start,+ &prefix, &max_count))+ return NULL;++ IterObject* pyres = (IterObject*) + pgf_IterType.tp_alloc(&pgf_IterType, 0);+ if (pyres == NULL) {+ return NULL;+ }++ pyres->source = (PyObject*) self->grammar;+ Py_XINCREF(pyres->source);+ + pyres->container = NULL;++ pyres->pool = gu_new_pool();+ pyres->max_count = max_count;+ pyres->counter = 0;+ pyres->fetch = Iter_fetch_token;++ GuPool *tmp_pool = gu_local_pool();++ GuExn* parse_err = gu_new_exn(tmp_pool);++ PgfType* type;+ if (start == NULL) {+ type = pgf_start_cat(self->grammar->pgf, pyres->pool);+ } else {+ type = pgf_type_from_object(start, pyres->pool);+ }+ if (type == NULL) {+ Py_DECREF(pyres);+ return NULL;+ }++ pyres->res =+ pgf_complete(self->concr, type, sentence, prefix, parse_err, pyres->pool);++ if (!gu_ok(parse_err)) {+ Py_DECREF(pyres);+ pyres = NULL;++ if (gu_exn_caught(parse_err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(parse_err);+ PyErr_SetString(PGFError, msg);+ } else if (gu_exn_caught(parse_err, PgfParseError)) {+ GuString tok = (GuString) gu_exn_caught_data(parse_err);+ PyObject* py_tok = PyString_FromString(tok);+ PyObject_SetAttrString(ParseError, "token", py_tok);+ PyErr_Format(ParseError, "Unexpected token: \"%s\"", tok);+ Py_DECREF(py_tok);+ }+ }++ gu_pool_free(tmp_pool);++ return pyres;+}++static PyObject*+Concr_parseval(ConcrObject* self, PyObject *args) {+ ExprObject* pyexpr = NULL;+ PyObject* start = NULL;+ if (!PyArg_ParseTuple(args, "O!s", &pgf_ExprType, &pyexpr, &start))+ return NULL;+ + GuPool* tmp_pool = gu_local_pool();++ double precision = 0;+ double recall = 0;+ double exact = 0;++ PgfType* type = pgf_type_from_object(start, tmp_pool);+ if (type == NULL) {+ return NULL;+ }++ if (!pgf_parseval(self->concr, pyexpr->expr, type, + &precision, &recall, &exact))+ return NULL;++ gu_pool_free(tmp_pool);++ return Py_BuildValue("ddd", precision, recall, exact);+}++static IterObject*+Concr_lookupSentence(ConcrObject* self, PyObject *args, PyObject *keywds)+{+ static char *kwlist[] = {"sentence", "cat", NULL};++ const char *sentence = NULL;+ PyObject* start = NULL;+ int max_count = -1;+ if (!PyArg_ParseTupleAndKeywords(args, keywds, "s|O", kwlist,+ &sentence, &start, &max_count))+ return NULL;++ IterObject* pyres = (IterObject*) + pgf_IterType.tp_alloc(&pgf_IterType, 0);+ if (pyres == NULL) {+ return NULL;+ }++ pyres->source = (PyObject*) self->grammar;+ Py_XINCREF(pyres->source);++ GuPool* out_pool = gu_new_pool();++ PyObject* py_pool = PyPool_New(out_pool);+ pyres->container = PyTuple_Pack(2, pyres->source, py_pool);+ Py_DECREF(py_pool);++ pyres->pool = gu_new_pool();+ pyres->max_count = max_count;+ pyres->counter = 0;+ pyres->fetch = Iter_fetch_expr;++ sentence = gu_string_copy(sentence, pyres->pool);++ PgfType* type;+ if (start == NULL) {+ type = pgf_start_cat(self->grammar->pgf, pyres->pool);+ } else {+ type = pgf_type_from_object(start, pyres->pool);+ }+ if (type == NULL) {+ Py_DECREF(pyres);+ return NULL;+ }++ pyres->res =+ pgf_lookup_sentence(self->concr, type, sentence,+ pyres->pool, out_pool);++ return pyres;+}++static PyObject*+Concr_linearize(ConcrObject* self, PyObject *args)+{+ ExprObject* pyexpr;+ if (!PyArg_ParseTuple(args, "O!", &pgf_ExprType, &pyexpr))+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ + pgf_linearize(self->concr, pyexpr->expr, out, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfLinNonExist)) {+ gu_pool_free(tmp_pool);+ Py_RETURN_NONE;+ }+ else if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ gu_pool_free(tmp_pool);+ return NULL;+ } else {+ PyErr_SetString(PGFError, "The abstract tree cannot be linearized");+ gu_pool_free(tmp_pool);+ return NULL;+ }+ }++ PyObject* pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));++ gu_pool_free(tmp_pool);+ return pystr;+}++static PyObject*+Iter_fetch_linearization(IterObject* self)+{+ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_new_exn(tmp_pool);++restart:;+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ ++ PgfCncTree ctree = gu_next(self->res, PgfCncTree, tmp_pool);+ if (gu_variant_is_null(ctree)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }+ ctree = pgf_lzr_wrap_linref(ctree, tmp_pool); // to reduce tuple of strings to a single string;++ // Linearize the concrete tree as a simple sequence of strings.+ ConcrObject* pyconcr = (ConcrObject*)self->container;+ pgf_lzr_linearize_simple(pyconcr->concr, ctree, 0, out, err, tmp_pool);++ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfLinNonExist)) {+ // encountered nonExist. Unfortunately there+ // might be some output printed already. The+ // right solution should be to use GuStringBuf.+ gu_exn_clear(err);+ goto restart;+ }+ else if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ gu_pool_free(tmp_pool);+ return NULL;+ } else {+ PyErr_SetString(PGFError, "The abstract tree cannot be linearized");+ gu_pool_free(tmp_pool);+ return NULL;+ }+ }++ PyObject* pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));+ gu_pool_free(tmp_pool);+ return pystr;+}++static PyObject*+Concr_linearizeAll(ConcrObject* self, PyObject *args, PyObject *keywds)+{+ static char *kwlist[] = {"expression", "n", NULL};+ ExprObject* pyexpr = NULL;+ int max_count = -1;+ if (!PyArg_ParseTupleAndKeywords(args, keywds, "O!|i", kwlist,+ &pgf_ExprType, &pyexpr, &max_count))+ return NULL;++ GuPool* pool = gu_new_pool();+ + GuExn* err = gu_exn(pool);+ GuEnum* cts = pgf_lzr_concretize(self->concr, pyexpr->expr, err, pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ gu_pool_free(pool);+ return NULL;+ } else {+ PyErr_SetString(PGFError, "The abstract tree cannot be linearized");+ gu_pool_free(pool);+ return NULL;+ }+ }++ IterObject* pyres = (IterObject*) pgf_IterType.tp_alloc(&pgf_IterType, 0);+ if (pyres == NULL) {+ gu_pool_free(pool);+ return NULL;+ }++ pyres->source = (PyObject*)pyexpr;+ Py_INCREF(pyres->source);+ pyres->container = (PyObject*)self;+ Py_INCREF(pyres->container);+ pyres->pool = pool;+ pyres->max_count = max_count;+ pyres->counter = 0;+ pyres->fetch = Iter_fetch_linearization;+ pyres->res = cts;++ return (PyObject*)pyres;+}++static PyObject*+Concr_tabularLinearize(ConcrObject* self, PyObject *args)+{+ ExprObject* pyexpr;+ if (!PyArg_ParseTuple(args, "O!", &pgf_ExprType, &pyexpr))+ return NULL;++ PyObject* table = PyDict_New();+ if (table == NULL)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ GuEnum* cts = + pgf_lzr_concretize(self->concr,+ pyexpr->expr,+ err,+ tmp_pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfLinNonExist))+ Py_RETURN_NONE;+ else if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ return NULL;+ } else {+ PyErr_SetString(PGFError, "The abstract tree cannot be linearized");+ return NULL;+ }+ }++ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (gu_variant_is_null(ctree)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ size_t n_lins;+ GuString* labels;+ pgf_lzr_get_table(self->concr, ctree, &n_lins, &labels);++ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ for (size_t lin_idx = 0; lin_idx < n_lins; lin_idx++) {+ ++ pgf_lzr_linearize_simple(self->concr, ctree, lin_idx, out, err, tmp_pool);++ PyObject* pystr = NULL;+ if (gu_ok(err)) {+ pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));+ } else {+ gu_exn_clear(err);+ pystr = Py_None;+ Py_INCREF(pystr);+ }++ gu_string_buf_flush(sbuf);++ if (PyDict_SetItemString(table, labels[lin_idx], pystr) < 0)+ return NULL;++ Py_XDECREF(pystr);+ }++ gu_pool_free(tmp_pool);++ return table;+}+++typedef struct {+ PyObject_HEAD+ PyObject* cat;+ int fid;+ int lindex;+ PyObject* fun;+ PyObject* children;+} BracketObject;++static void+Bracket_dealloc(BracketObject* self)+{+ Py_XDECREF(self->cat);+ Py_XDECREF(self->fun);+ Py_XDECREF(self->children);+ Py_TYPE(self)->tp_free((PyObject*)self);+}++static PyObject *+Bracket_repr(BracketObject *self)+{+ PyObject *repr =+#if PY_MAJOR_VERSION >= 3+ PyString_FromFormat("(%U:%d", self->cat, self->fid);+#else+ PyString_FromFormat("(%s:%d", PyString_AsString(self->cat), self->fid);+#endif+ if (repr == NULL) {+ return NULL;+ }++ PyObject *space = PyString_FromString(" ");++ size_t len = PyList_Size(self->children);+ for (size_t i = 0; i < len; i++) {+ PyObject *child = PyList_GetItem(self->children, i);++ PyString_Concat(&repr, space);+ if (repr == NULL) {+ Py_DECREF(space);+ return NULL;+ }++ PyObject *child_str = Py_TYPE(child)->tp_str(child);+ if (child_str == NULL) {+ Py_DECREF(repr);+ Py_DECREF(space);+ return NULL;+ }++ PyString_Concat(&repr, child_str);+ if (repr == NULL) {+ Py_DECREF(space);+ return NULL;+ }++ Py_DECREF(child_str);+ }++ Py_DECREF(space);++ PyObject *str = PyString_FromString(")");+ PyString_Concat(&repr, str);+ if (repr == NULL) {+ Py_DECREF(str);+ return NULL;+ }+ Py_DECREF(str);++ return repr;+}++static PyMemberDef Bracket_members[] = {+ {"cat", T_OBJECT_EX, offsetof(BracketObject, cat), 0,+ "the syntactic category for this bracket"},+ {"fun", T_OBJECT_EX, offsetof(BracketObject, fun), 0,+ "the abstract function for this bracket"},+ {"fid", T_INT, offsetof(BracketObject, fid), 0,+ "an id which identifies this bracket in the bracketed string. If there are discontinuous phrases this id will be shared for all brackets belonging to the same phrase."},+ {"lindex", T_INT, offsetof(BracketObject, lindex), 0,+ "the constituent index"},+ {"children", T_OBJECT_EX, offsetof(BracketObject, children), 0,+ "a list with the children of this bracket"},+ {NULL} /* Sentinel */+};++static PyTypeObject pgf_BracketType = {+ PyVarObject_HEAD_INIT(NULL, 0)+ //0, /*ob_size*/+ "pgf.Bracket", /*tp_name*/+ sizeof(BracketObject), /*tp_basicsize*/+ 0, /*tp_itemsize*/+ (destructor)Bracket_dealloc,/*tp_dealloc*/+ 0, /*tp_print*/+ 0, /*tp_getattr*/+ 0, /*tp_setattr*/+ 0, /*tp_compare*/+ 0, /*tp_repr*/+ 0, /*tp_as_number*/+ 0, /*tp_as_sequence*/+ 0, /*tp_as_mapping*/+ 0, /*tp_hash */+ 0, /*tp_call*/+ (reprfunc) Bracket_repr, /*tp_str*/+ 0, /*tp_getattro*/+ 0, /*tp_setattro*/+ 0, /*tp_as_buffer*/+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/+ "a linearization bracket", /*tp_doc*/+ 0, /*tp_traverse */+ 0, /*tp_clear */+ 0, /*tp_richcompare */+ 0, /*tp_weaklistoffset */+ 0, /*tp_iter */+ 0, /*tp_iternext */+ 0, /*tp_methods */+ Bracket_members, /*tp_members */+ 0, /*tp_getset */+ 0, /*tp_base */+ 0, /*tp_dict */+ 0, /*tp_descr_get */+ 0, /*tp_descr_set */+ 0, /*tp_dictoffset */+ 0, /*tp_init */+ 0, /*tp_alloc */+ 0, /*tp_new */+};++typedef struct {+ PgfLinFuncs* funcs;+ GuBuf* stack;+ PyObject* list;+} PgfBracketLznState;++static void+pgf_bracket_lzn_symbol_token(PgfLinFuncs** funcs, PgfToken tok)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);++ PyObject* str = PyString_FromString(tok);+ PyList_Append(state->list, str);+ Py_DECREF(str);+}++static void+pgf_bracket_lzn_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);+ + gu_buf_push(state->stack, PyObject*, state->list);+ state->list = PyList_New(0);+}++static void+pgf_bracket_lzn_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)+{+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);++ PyObject* parent = gu_buf_pop(state->stack, PyObject*);++ if (PyList_Size(state->list) > 0) {+ BracketObject* bracket = (BracketObject *)+ pgf_BracketType.tp_alloc(&pgf_BracketType, 0);+ if (bracket != NULL) {+ bracket->cat = PyString_FromString(cat);+ bracket->fid = fid;+ bracket->lindex = lindex;+ bracket->fun = PyString_FromString(fun);+ bracket->children = state->list;+ PyList_Append(parent, (PyObject*) bracket);+ Py_DECREF(bracket);+ }+ } else {+ Py_DECREF(state->list);+ }++ state->list = parent;+}++static void+pgf_bracket_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId meta_id)+{+ pgf_bracket_lzn_symbol_token(funcs, "?");+}++static PgfLinFuncs pgf_bracket_lin_funcs = {+ .symbol_token = pgf_bracket_lzn_symbol_token,+ .begin_phrase = pgf_bracket_lzn_begin_phrase,+ .end_phrase = pgf_bracket_lzn_end_phrase,+ .symbol_ne = NULL,+ .symbol_bind = NULL,+ .symbol_capit = NULL,+ .symbol_meta = pgf_bracket_lzn_symbol_meta+};++static PyObject*+Concr_bracketedLinearize(ConcrObject* self, PyObject *args)+{+ ExprObject* pyexpr;+ if (!PyArg_ParseTuple(args, "O!", &pgf_ExprType, &pyexpr))+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);+ + GuEnum* cts = + pgf_lzr_concretize(self->concr, pyexpr->expr, err, tmp_pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ return NULL;+ } else {+ PyErr_SetString(PGFError, "The abstract tree cannot be concretized");+ }+ }++ PgfCncTree ctree = gu_next(cts, PgfCncTree, tmp_pool);+ if (gu_variant_is_null(ctree)) {+ PyErr_SetString(PGFError, "The abstract tree cannot be concretized");+ gu_pool_free(tmp_pool);+ return NULL;+ }+ + PyObject* list = PyList_New(0);++ ctree = pgf_lzr_wrap_linref(ctree, tmp_pool);++ PgfBracketLznState state;+ state.funcs = &pgf_bracket_lin_funcs;+ state.stack = gu_new_buf(PyObject*, tmp_pool);+ state.list = list;+ pgf_lzr_linearize(self->concr, ctree, 0, &state.funcs, tmp_pool);++ gu_pool_free(tmp_pool);++ return list;+}++static PyObject*+Iter_fetch_bracketedLinearization(IterObject* self)+{+ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++restart:;++ PgfCncTree ctree = gu_next(self->res, PgfCncTree, tmp_pool); + if (gu_variant_is_null(ctree)) {+ gu_pool_free(tmp_pool);+ return NULL;+ }++ PyObject* list = PyList_New(0);+ ctree = pgf_lzr_wrap_linref(ctree, tmp_pool);++ ConcrObject* pyconcr = (ConcrObject*) self->container; ++ PgfBracketLznState state;+ state.funcs = &pgf_bracket_lin_funcs;+ state.stack = gu_new_buf(PyObject*, tmp_pool);+ state.list = list;+ pgf_lzr_linearize(pyconcr->concr, ctree, 0, &state.funcs, tmp_pool);++ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfLinNonExist)) {+ // encountered nonExist. Unfortunately there+ // might be some output printed already. The+ // right solution should be to use GuStringBuf.+ gu_exn_clear(err);+ goto restart;+ }+ else if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ gu_pool_free(tmp_pool);+ return NULL;+ } else {+ PyErr_SetString(PGFError, "The abstract tree cannot be linearized");+ gu_pool_free(tmp_pool);+ return NULL;+ }+ }++ gu_pool_free(tmp_pool);+ return list;+}+ +static PyObject*+Concr_bracketedLinearizeAll(ConcrObject* self, PyObject *args, PyObject *keywds)+{+ static char *kwlist[] = {"expression", "n", NULL};+ ExprObject* pyexpr = NULL;+ int max_count = -1;++ if (!PyArg_ParseTupleAndKeywords(args, keywds, "O!|i", kwlist,+ &pgf_ExprType, &pyexpr, &max_count))+ return NULL;++ GuPool* pool = gu_new_pool();+ GuExn* err = gu_exn(pool);+ + GuEnum* cts = + pgf_lzr_concretize(self->concr, pyexpr->expr, err, pool);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ } else {+ PyErr_SetString(PGFError, "The abstract tree cannot be concretized");+ }+ return NULL;+ }++ IterObject* pyres = (IterObject*) pgf_IterType.tp_alloc(&pgf_IterType, 0);+ if (pyres == NULL) {+ gu_pool_free(pool);+ return NULL;+ }++ pyres->source = (PyObject*)pyexpr;+ Py_INCREF(pyres->source);+ pyres->container = (PyObject*)self;+ Py_INCREF(pyres->container);+ pyres->pool = pool;+ pyres->max_count = max_count;+ pyres->counter = 0;+ pyres->fetch = Iter_fetch_bracketedLinearization;+ pyres->res = cts;++ return (PyObject*)pyres;+}++static PyObject*+Concr_hasLinearization(ConcrObject* self, PyObject *args)+{+ PgfCId id;+ if (!PyArg_ParseTuple(args, "s", &id))+ return NULL;++ if (pgf_has_linearization(self->concr, id))+ Py_RETURN_TRUE;+ else+ Py_RETURN_FALSE;+}++static PyObject*+Concr_getName(ConcrObject *self, void *closure)+{+ return PyString_FromString(pgf_concrete_name(self->concr));+}++static PyObject*+Concr_getLanguageCode(ConcrObject *self, void *closure)+{+ return PyString_FromString(pgf_language_code(self->concr));+}++static PyObject*+Concr_graphvizParseTree(ConcrObject* self, PyObject *args) {+ ExprObject* pyexpr;+ if (!PyArg_ParseTuple(args, "O!", &pgf_ExprType, &pyexpr))+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ + pgf_graphviz_parse_tree(self->concr, pyexpr->expr, pgf_default_graphviz_options, out, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ } else {+ PyErr_SetString(PGFError, "The parse tree cannot be visualized");+ }+ return NULL;+ }++ PyObject* pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));++ gu_pool_free(tmp_pool);+ return pystr;+}++typedef struct {+ PgfMorphoCallback fn;+ PyObject* analyses;+} PyMorphoCallback;++static void+pypgf_collect_morpho(PgfMorphoCallback* self,+ PgfCId lemma, GuString analysis, prob_t prob,+ GuExn* err)+{+ PyMorphoCallback* callback = (PyMorphoCallback*) self;++ PyObject* py_lemma = PyString_FromString(lemma);+ PyObject* py_analysis = PyString_FromString(analysis);+ PyObject* res = + Py_BuildValue("OOf", py_lemma, py_analysis, prob);++ if (PyList_Append(callback->analyses, res) != 0) {+ gu_raise(err, PgfExn);+ }+ + Py_DECREF(py_lemma);+ Py_DECREF(py_analysis);+ Py_DECREF(res);+}++static PyObject*+Concr_lookupMorpho(ConcrObject* self, PyObject *args) {+ GuString sent;+ if (!PyArg_ParseTuple(args, "s", &sent))+ return NULL;++ GuPool *tmp_pool = gu_local_pool();+ GuExn* err = gu_exn(tmp_pool);++ PyObject* analyses = PyList_New(0);++ PyMorphoCallback callback = { { pypgf_collect_morpho }, analyses };+ pgf_lookup_morpho(self->concr, sent, &callback.fn, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ } else {+ PyErr_SetString(PGFError, "The lookup failed");+ }+ Py_DECREF(analyses);+ analyses = NULL;+ }++ gu_pool_free(tmp_pool);++ return analyses;+}++static PyObject*+Iter_fetch_fullform(IterObject* self)+{+ PgfFullFormEntry* entry = + gu_next(self->res, PgfFullFormEntry*, self->pool);+ if (entry == NULL)+ return NULL;++ PyObject* res = NULL;+ PyObject* py_tokens = NULL;+ PyObject* py_analyses = NULL;++ GuString tokens =+ pgf_fullform_get_string(entry);+ + py_tokens = PyString_FromString(tokens);+ if (py_tokens == NULL)+ goto done;++ py_analyses = PyList_New(0);+ if (py_analyses == NULL)+ goto done;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_new_exn(tmp_pool);++ PyMorphoCallback callback = { { pypgf_collect_morpho }, py_analyses };+ pgf_fullform_get_analyses(entry, &callback.fn, err);+ + if (!gu_ok(err))+ goto done;++ res = Py_BuildValue("OO", py_tokens, py_analyses);++done:+ Py_XDECREF(py_tokens);+ Py_XDECREF(py_analyses);++ return res;+}++static PyObject*+Concr_fullFormLexicon(ConcrObject* self, PyObject *args)+{+ IterObject* pyres = (IterObject*) + pgf_IterType.tp_alloc(&pgf_IterType, 0);+ if (pyres == NULL)+ return NULL;++ pyres->source = (PyObject*) self->grammar;+ Py_XINCREF(pyres->source);++ pyres->container = NULL;+ pyres->pool = gu_new_pool();+ pyres->max_count = -1;+ pyres->counter = 0;+ pyres->fetch = Iter_fetch_fullform;++ pyres->res = pgf_fullform_lexicon(self->concr, pyres->pool);+ if (pyres->res == NULL) {+ Py_DECREF(pyres);+ return NULL;+ }++ return (PyObject*) pyres;+}++static PyObject*+Concr_load(ConcrObject* self, PyObject *args)+{+ const char *fpath;+ if (!PyArg_ParseTuple(args, "s", &fpath))+ return NULL;++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(tmp_pool);++ FILE* infile = fopen(fpath, "rb");+ if (infile == NULL) {+ PyErr_SetFromErrnoWithFilename(PyExc_IOError, fpath);+ return NULL;+ }++ // Create an input stream from the input file+ GuIn* in = gu_file_in(infile, tmp_pool);++ // Read the PGF grammar.+ pgf_concrete_load(self->concr, in, err);+ if (!gu_ok(err)) {+ fclose(infile);+ if (gu_exn_caught(err, GuErrno)) {+ errno = *((GuErrno*) gu_exn_caught_data(err));+ PyErr_SetFromErrnoWithFilename(PyExc_IOError, fpath);+ } else if (gu_exn_caught(err, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);+ } else {+ PyErr_SetString(PGFError, "The language cannot be loaded");+ }+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ fclose(infile);++ Py_RETURN_NONE;+}++static PyObject*+Concr_unload(ConcrObject* self, PyObject *args)+{+ if (!PyArg_ParseTuple(args, ""))+ return NULL;++ pgf_concrete_unload(self->concr);++ Py_RETURN_NONE;+}++static PyGetSetDef Concr_getseters[] = {+ {"name", + (getter)Concr_getName, NULL,+ "the name of the concrete syntax",+ },+ {"languageCode", + (getter)Concr_getLanguageCode, NULL,+ "the language code for this concrete syntax",+ },+ {NULL} /* Sentinel */+};++static PyMethodDef Concr_methods[] = {+ {"printName", (PyCFunction)Concr_printName, METH_VARARGS,+ "Returns the print name of a function or category"+ },+ {"parse", (PyCFunction)Concr_parse, METH_VARARGS | METH_KEYWORDS,+ "Parses a string and returns an iterator over the abstract trees for this sentence\n\n"+ "Named arguments:\n"+ "- sentence (string) or tokens (list of strings)\n"+ "- cat (string); OPTIONAL, default: the startcat of the grammar\n"+ "- n (int), max. trees; OPTIONAL, default: extract all trees\n"+ "- heuristics (double >= 0.0); OPTIONAL, default: taken from the flags in the grammar\n"+ "- callbacks (list of category and callback); OPTIONAL, default: built-in callbacks only for Int, String and Float"+ },+ {"complete", (PyCFunction)Concr_complete, METH_VARARGS | METH_KEYWORDS,+ "Parses a partial string and returns a list with the top n possible next tokens"+ },+ {"parseval", (PyCFunction)Concr_parseval, METH_VARARGS,+ "Computes precision, recall and exact match for the parser on a given abstract tree"+ },+ {"lookupSentence", (PyCFunction)Concr_lookupSentence, METH_VARARGS | METH_KEYWORDS,+ "Looks up a sentence from the grammar by a sequence of keywords\n\n"+ "Named arguments:\n"+ "- sentence (string) or tokens (list of strings)\n"+ "- cat (string); OPTIONAL, default: the startcat of the grammar\n"+ "- n (int), max. trees; OPTIONAL, default: extract all trees"+ },+ {"linearize", (PyCFunction)Concr_linearize, METH_VARARGS,+ "Takes an abstract tree and linearizes it to a string"+ },+ {"linearizeAll", (PyCFunction)Concr_linearizeAll, METH_VARARGS | METH_KEYWORDS,+ "Takes an abstract tree and linearizes with all variants"+ },+ {"tabularLinearize", (PyCFunction)Concr_tabularLinearize, METH_VARARGS,+ "Takes an abstract tree and linearizes it to a table containing all fields"+ },+ {"bracketedLinearize", (PyCFunction)Concr_bracketedLinearize, METH_VARARGS,+ "Takes an abstract tree and linearizes it to a bracketed string"+ },+ {"bracketedLinearizeAll", (PyCFunction)Concr_bracketedLinearizeAll, METH_VARARGS | METH_KEYWORDS,+ "Takes an abstract tree and linearizes all variants into bracketed strings"+ },+ {"hasLinearization", (PyCFunction)Concr_hasLinearization, METH_VARARGS,+ "hasLinearization(f) returns true if the function f has linearization in the concrete syntax"+ },+ {"graphvizParseTree", (PyCFunction)Concr_graphvizParseTree, METH_VARARGS,+ "Renders an abstract syntax tree as a parse tree in Graphviz format"+ },+ {"lookupMorpho", (PyCFunction)Concr_lookupMorpho, METH_VARARGS,+ "Looks up a word in the lexicon of the grammar"+ },+ {"fullFormLexicon", (PyCFunction)Concr_fullFormLexicon, METH_VARARGS,+ "Enumerates all words in the lexicon (useful for extracting full form lexicons)"+ },+ {"load", (PyCFunction)Concr_load, METH_VARARGS,+ "Loads the concrete syntax from a .pgf_c file"+ },+ {"unload", (PyCFunction)Concr_unload, METH_VARARGS,+ "Unloads the concrete syntax"+ },+ {NULL} /* Sentinel */+};++static PyTypeObject pgf_ConcrType = {+ PyVarObject_HEAD_INIT(NULL, 0)+ //0, /*ob_size*/+ "pgf.Concr", /*tp_name*/+ sizeof(ConcrObject), /*tp_basicsize*/+ 0, /*tp_itemsize*/+ (destructor)Concr_dealloc, /*tp_dealloc*/+ 0, /*tp_print*/+ 0, /*tp_getattr*/+ 0, /*tp_setattr*/+ 0, /*tp_compare*/+ 0, /*tp_repr*/+ 0, /*tp_as_number*/+ 0, /*tp_as_sequence*/+ 0, /*tp_as_mapping*/+ 0, /*tp_hash */+ 0, /*tp_call*/+ 0, /*tp_str*/+ 0, /*tp_getattro*/+ 0, /*tp_setattro*/+ 0, /*tp_as_buffer*/+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/+ "concrete syntax", /*tp_doc*/+ 0, /*tp_traverse */+ 0, /*tp_clear */+ 0, /*tp_richcompare */+ 0, /*tp_weaklistoffset */+ 0, /*tp_iter */+ 0, /*tp_iternext */+ Concr_methods, /*tp_methods */+ 0, /*tp_members */+ Concr_getseters, /*tp_getset */+ 0, /*tp_base */+ 0, /*tp_dict */+ 0, /*tp_descr_get */+ 0, /*tp_descr_set */+ 0, /*tp_dictoffset */+ (initproc)Concr_init, /*tp_init */+ 0, /*tp_alloc */+ (newfunc)Concr_new, /*tp_new */+};++static void+PGF_dealloc(PGFObject* self)+{+ if (self->pool != NULL)+ gu_pool_free(self->pool);+ Py_TYPE(self)->tp_free((PyObject*)self);+}++static PyObject *+PGF_repr(PGFObject *self)+{+ GuPool* tmp_pool = gu_local_pool();++ GuExn* err = gu_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);++ pgf_print(self->pgf, out, err);++ PyObject* pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));++ gu_pool_free(tmp_pool);+ return pystr;+}++static PyObject*+PGF_getAbstractName(PGFObject *self, void *closure)+{+ return PyString_FromString(pgf_abstract_name(self->pgf));+}++typedef struct {+ GuMapItor fn;+ PGFObject* grammar;+ PyObject* object;+} PyPGFClosure;++static void+pgf_collect_langs(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ PgfCId name = (PgfCId) key;+ PgfConcr* concr = *((PgfConcr**) value);+ PyPGFClosure* clo = (PyPGFClosure*) fn;+ + PyObject* py_name = NULL;+ PyObject* py_lang = NULL;+ + py_name = PyString_FromString(name);+ if (py_name == NULL) {+ gu_raise(err, PgfExn);+ goto end;+ }++ py_lang = pgf_ConcrType.tp_alloc(&pgf_ConcrType, 0);+ if (py_lang == NULL) {+ gu_raise(err, PgfExn);+ goto end;+ }++ ((ConcrObject *) py_lang)->concr = concr;+ ((ConcrObject *) py_lang)->grammar = clo->grammar;+ Py_INCREF(clo->grammar);++ if (PyDict_SetItem(clo->object, py_name, py_lang) != 0) {+ gu_raise(err, PgfExn);+ goto end;+ }++end:+ Py_XDECREF(py_lang);+ Py_XDECREF(py_name);+}++static PyObject*+PGF_getLanguages(PGFObject *self, void *closure)+{+ PyObject* languages = PyDict_New();+ if (languages == NULL)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(tmp_pool);++ PyPGFClosure clo = { { pgf_collect_langs }, self, languages };+ pgf_iter_languages(self->pgf, &clo.fn, err);+ if (!gu_ok(err)) {+ Py_DECREF(languages);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ PyObject* proxy = PyDictProxy_New(languages);+ + Py_DECREF(languages);+ gu_pool_free(tmp_pool);++ return proxy;+}++static void+pgf_collect_cats(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ PgfCId name = (PgfCId) key;+ PyPGFClosure* clo = (PyPGFClosure*) fn;+ + PyObject* py_name = NULL;+ + py_name = PyString_FromString(name);+ if (py_name == NULL) {+ gu_raise(err, PgfExn);+ goto end;+ }++ if (PyList_Append(clo->object, py_name) != 0) {+ gu_raise(err, PgfExn);+ goto end;+ }++end:+ Py_XDECREF(py_name);+}++static PyObject*+PGF_getCategories(PGFObject *self, void *closure)+{+ PyObject* categories = PyList_New(0);+ if (categories == NULL)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(tmp_pool);++ PyPGFClosure clo = { { pgf_collect_cats }, self, categories };+ pgf_iter_categories(self->pgf, &clo.fn, err);+ if (!gu_ok(err)) {+ Py_DECREF(categories);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ return categories;+}++static TypeObject*+PGF_getStartCat(PGFObject *self, void *closure)+{+ TypeObject* pytype = (TypeObject*) pgf_TypeType.tp_alloc(&pgf_TypeType, 0);+ if (pytype == NULL)+ return NULL;++ pytype->pool = gu_new_pool();+ pytype->type = pgf_start_cat(self->pgf, pytype->pool);+ pytype->master = NULL;++ if (pytype->type == NULL) {+ PyErr_SetString(PGFError, "The start category cannot be found");+ Py_DECREF(pytype);+ return NULL;+ }++ return pytype;+}++static void+pgf_collect_funs(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ PgfCId name = (PgfCId) key;+ PyPGFClosure* clo = (PyPGFClosure*) fn;+ + PyObject* py_name = NULL;+ + py_name = PyString_FromString(name);+ if (py_name == NULL) {+ gu_raise(err, PgfExn);+ goto end;+ }++ if (PyList_Append(clo->object, py_name) != 0) {+ gu_raise(err, PgfExn);+ goto end;+ }++end:+ Py_XDECREF(py_name);+}++static PyObject*+PGF_getFunctions(PGFObject *self, void *closure)+{+ PyObject* functions = PyList_New(0);+ if (functions == NULL)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(tmp_pool);++ PyPGFClosure clo = { { pgf_collect_funs }, self, functions };+ pgf_iter_functions(self->pgf, &clo.fn, err);+ if (!gu_ok(err)) {+ Py_DECREF(functions);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ return functions;+}++static PyObject*+PGF_functionsByCat(PGFObject* self, PyObject *args)+{+ PgfCId catname;+ if (!PyArg_ParseTuple(args, "s", &catname))+ return NULL;++ PyObject* functions = PyList_New(0);+ if (functions == NULL) {+ return NULL;+ }++ GuPool *tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(tmp_pool);++ PyPGFClosure clo = { { pgf_collect_funs }, self, functions };+ pgf_iter_functions_by_cat(self->pgf, catname, &clo.fn, err);+ if (!gu_ok(err)) {+ Py_DECREF(functions);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ return functions;+}++static TypeObject*+PGF_functionType(PGFObject* self, PyObject *args)+{+ PgfCId funname;+ if (!PyArg_ParseTuple(args, "s", &funname))+ return NULL;++ PgfType* type =+ pgf_function_type(self->pgf, funname);+ if (type == NULL) {+ PyErr_Format(PyExc_KeyError, "Function '%s' is not defined", funname);+ return NULL;+ }++ TypeObject* pytype = (TypeObject*) pgf_TypeType.tp_alloc(&pgf_TypeType, 0);+ if (pytype == NULL)+ return NULL;+ pytype->pool = NULL;+ pytype->type = type;+ pytype->master = (PyObject*) self;+ Py_XINCREF(self);++ return pytype;+}++static IterObject*+PGF_generateAll(PGFObject* self, PyObject *args, PyObject *keywds)+{+ static char *kwlist[] = {"cat", "n", NULL};++ PyObject* start = NULL;+ int max_count = -1;+ if (!PyArg_ParseTupleAndKeywords(args, keywds, "O|i", kwlist,+ &start, &max_count))+ return NULL;++ IterObject* pyres = (IterObject*)+ pgf_IterType.tp_alloc(&pgf_IterType, 0);+ if (pyres == NULL) {+ return NULL;+ }++ pyres->source = (PyObject*) self;+ Py_INCREF(self);++ GuPool* out_pool = gu_new_pool();++ PyObject* py_pool = PyPool_New(out_pool);+ pyres->container = PyTuple_Pack(2, pyres->source, py_pool);+ Py_DECREF(py_pool);++ pyres->pool = gu_new_pool();+ pyres->max_count = max_count;+ pyres->counter = 0;+ pyres->fetch = Iter_fetch_expr;++ GuExn* err = gu_exn(pyres->pool);++ PgfType* type = pgf_type_from_object(start, pyres->pool);+ if (type == NULL) {+ Py_DECREF(pyres);+ return NULL;+ }++ pyres->res =+ pgf_generate_all(self->pgf, type, err, pyres->pool, out_pool);+ if (pyres->res == NULL) {+ Py_DECREF(pyres);+ return NULL;+ }++ return pyres;+}++static ExprObject*+PGF_compute(PGFObject* self, PyObject *args)+{+ ExprObject* py_expr = NULL;+ if (!PyArg_ParseTuple(args, "O!", &pgf_ExprType, &py_expr))+ return NULL;++ ExprObject* py_expr_res = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (py_expr_res == NULL)+ return NULL;++ GuPool* tmp_pool = gu_new_pool();+ GuExn* err = gu_new_exn(tmp_pool);++ py_expr_res->pool = gu_new_pool();+ py_expr_res->expr = pgf_compute(self->pgf, py_expr->expr, err, + tmp_pool, py_expr_res->pool);+ py_expr_res->master = (PyObject*) self;+ Py_INCREF(py_expr_res->master);++ if (!gu_ok(err)) {+ GuString msg = (GuString) gu_exn_caught_data(err);+ PyErr_SetString(PGFError, msg);++ Py_DECREF(py_expr_res);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ return py_expr_res;+}++static ExprObject*+PGF_checkExpr(PGFObject* self, PyObject *args)+{+ ExprObject* py_expr = NULL;+ TypeObject* py_type = NULL;+ if (!PyArg_ParseTuple(args, "O!O!", &pgf_ExprType, &py_expr, &pgf_TypeType, &py_type))+ return NULL;++ ExprObject* new_pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (new_pyexpr == NULL)+ return NULL;++ new_pyexpr->pool = gu_new_pool();+ new_pyexpr->expr = py_expr->expr;+ new_pyexpr->master = NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* exn = gu_new_exn(tmp_pool);++ pgf_check_expr(self->pgf, &new_pyexpr->expr, py_type->type,+ exn, new_pyexpr->pool);+ if (!gu_ok(exn)) {+ if (gu_exn_caught(exn, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(exn);+ PyErr_SetString(PGFError, msg);+ } else if (gu_exn_caught(exn, PgfTypeError)) {+ GuString msg = (GuString) gu_exn_caught_data(exn);+ PyErr_SetString(TypeError, msg);+ }++ Py_DECREF(new_pyexpr);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ return new_pyexpr;+}++static PyObject*+PGF_inferExpr(PGFObject* self, PyObject *args)+{+ ExprObject* py_expr = NULL;+ if (!PyArg_ParseTuple(args, "O!", &pgf_ExprType, &py_expr))+ return NULL;++ ExprObject* new_pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (new_pyexpr == NULL)+ return NULL;++ new_pyexpr->pool = gu_new_pool();+ new_pyexpr->expr = py_expr->expr;+ new_pyexpr->master = NULL;++ TypeObject* new_pytype = (TypeObject*) pgf_TypeType.tp_alloc(&pgf_TypeType, 0);+ if (new_pytype == NULL) {+ Py_DECREF(new_pyexpr);+ return NULL;+ }++ new_pytype->pool = NULL;+ new_pytype->type = NULL;+ new_pytype->master = (PyObject*) new_pyexpr;+ Py_INCREF(new_pyexpr);++ GuPool* tmp_pool = gu_local_pool();+ GuExn* exn = gu_new_exn(tmp_pool);++ new_pytype->type =+ pgf_infer_expr(self->pgf, &new_pyexpr->expr,+ exn, new_pyexpr->pool);+ if (!gu_ok(exn)) {+ if (gu_exn_caught(exn, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(exn);+ PyErr_SetString(PGFError, msg);+ } else if (gu_exn_caught(exn, PgfTypeError)) {+ GuString msg = (GuString) gu_exn_caught_data(exn);+ PyErr_SetString(TypeError, msg);+ }++ Py_DECREF(new_pyexpr);+ Py_DECREF(new_pytype);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ PyObject* res =+ Py_BuildValue("OO", new_pyexpr, new_pytype);++ Py_DECREF(new_pyexpr);+ Py_DECREF(new_pytype);++ return res;+}++static TypeObject*+PGF_checkType(PGFObject* self, PyObject *args)+{+ TypeObject* py_type = NULL;+ if (!PyArg_ParseTuple(args, "O!", &pgf_TypeType, &py_type))+ return NULL;++ TypeObject* new_pytype = (TypeObject*) pgf_TypeType.tp_alloc(&pgf_TypeType, 0);+ if (new_pytype == NULL) {+ return NULL;+ }++ new_pytype->pool = gu_new_pool();+ new_pytype->type = py_type->type;+ new_pytype->master = NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* exn = gu_new_exn(tmp_pool);++ pgf_check_type(self->pgf, &new_pytype->type,+ exn, new_pytype->pool);+ if (!gu_ok(exn)) {+ if (gu_exn_caught(exn, PgfExn)) {+ GuString msg = (GuString) gu_exn_caught_data(exn);+ PyErr_SetString(PGFError, msg);+ } else if (gu_exn_caught(exn, PgfTypeError)) {+ GuString msg = (GuString) gu_exn_caught_data(exn);+ PyErr_SetString(TypeError, msg);+ }++ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);++ return new_pytype;+}++static PyObject*+PGF_graphvizAbstractTree(PGFObject* self, PyObject *args) {+ ExprObject* pyexpr;+ if (!PyArg_ParseTuple(args, "O!", &pgf_ExprType, &pyexpr))+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuExn* err = gu_new_exn(tmp_pool);+ GuStringBuf* sbuf = gu_new_string_buf(tmp_pool);+ GuOut* out = gu_string_buf_out(sbuf);+ + pgf_graphviz_abstract_tree(self->pgf, pyexpr->expr, pgf_default_graphviz_options, out, err);+ if (!gu_ok(err)) {+ PyErr_SetString(PGFError, "The abstract tree cannot be visualized");+ return NULL;+ }++ PyObject* pystr = PyString_FromStringAndSize(gu_string_buf_data(sbuf),+ gu_string_buf_length(sbuf));++ gu_pool_free(tmp_pool);+ return pystr;+}++static void+pgf_embed_funs(GuMapItor* fn, const void* key, void* value, GuExn* err)+{+ PyPGFClosure* clo = (PyPGFClosure*) fn;+ + PgfCId name = (PgfCId) key;++ ExprObject* pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (pyexpr == NULL) {+ gu_raise(err, PgfExn);+ return;+ }++ pyexpr->master = (PyObject*) clo->grammar;+ pyexpr->expr = pgf_fun_get_ep(value)->expr;++ Py_INCREF(pyexpr->master);++ if (PyModule_AddObject(clo->object, name, (PyObject*) pyexpr) != 0) {+ Py_DECREF(pyexpr);+ gu_raise(err, PgfExn);+ }+}++static PyObject*+PGF_embed(PGFObject* self, PyObject *args)+{+ PgfCId modname;+ if (!PyArg_ParseTuple(args, "s", &modname))+ return NULL;++ PyObject *m = PyImport_AddModule(modname);+ if (m == NULL)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(tmp_pool);++ PyPGFClosure clo = { { pgf_embed_funs }, self, m };+ pgf_iter_functions(self->pgf, &clo.fn, err);+ if (!gu_ok(err)) {+ Py_DECREF(m);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ + Py_INCREF(m);+ return m;+}++static PyGetSetDef PGF_getseters[] = {+ {"abstractName", + (getter)PGF_getAbstractName, NULL,+ "the abstract syntax name",+ NULL},+ {"languages", + (getter)PGF_getLanguages, NULL,+ "a map containing all concrete languages in the grammar",+ NULL},+ {"categories", + (getter)PGF_getCategories, NULL,+ "a list containing all categories in the grammar",+ NULL},+ {"startCat", + (getter)PGF_getStartCat, NULL,+ "the start category for the grammar",+ NULL},+ {"functions", + (getter)PGF_getFunctions, NULL,+ "a list containing all functions in the grammar",+ NULL},+ {NULL} /* Sentinel */+};++static PyMemberDef PGF_members[] = {+ {NULL} /* Sentinel */+};++static PyMethodDef PGF_methods[] = {+ {"functionsByCat", (PyCFunction)PGF_functionsByCat, METH_VARARGS,+ "Returns the list of functions for a given category"+ },+ {"functionType", (PyCFunction)PGF_functionType, METH_VARARGS,+ "Returns the type of a function"+ },+ {"generateAll", (PyCFunction)PGF_generateAll, METH_VARARGS | METH_KEYWORDS,+ "Generates abstract syntax trees of given category in decreasing probability order"+ },+ {"compute", (PyCFunction)PGF_compute, METH_VARARGS,+ "Computes the normal form of an abstract syntax tree"+ },+ {"checkExpr", (PyCFunction)PGF_checkExpr, METH_VARARGS,+ "Type checks an abstract syntax expression and returns the updated expression"+ },+ {"inferExpr", (PyCFunction)PGF_inferExpr, METH_VARARGS,+ "Type checks an abstract syntax expression and returns the updated expression"+ },+ {"checkType", (PyCFunction)PGF_checkType, METH_VARARGS,+ "Type checks an abstract syntax type and returns the updated type"+ },+ {"graphvizAbstractTree", (PyCFunction)PGF_graphvizAbstractTree, METH_VARARGS,+ "Renders an abstract syntax tree in a Graphviz format"+ },+ {"embed", (PyCFunction)PGF_embed, METH_VARARGS,+ "embed(mod_name) creates a Python module with name mod_name, which "+ "contains one Python object for every abstract function in the grammar. "+ "The module can be imported to make it easier to construct abstract "+ "syntax trees."+ },+ {NULL} /* Sentinel */+};++static PyTypeObject pgf_PGFType = {+ PyVarObject_HEAD_INIT(NULL, 0)+ //0, /*ob_size*/+ "pgf.PGF", /*tp_name*/+ sizeof(PGFObject), /*tp_basicsize*/+ 0, /*tp_itemsize*/+ (destructor)PGF_dealloc, /*tp_dealloc*/+ 0, /*tp_print*/+ 0, /*tp_getattr*/+ 0, /*tp_setattr*/+ 0, /*tp_compare*/+ 0, /*tp_repr*/+ 0, /*tp_as_number*/+ 0, /*tp_as_sequence*/+ 0, /*tp_as_mapping*/+ 0, /*tp_hash */+ 0, /*tp_call*/+ (reprfunc) PGF_repr, /*tp_str*/+ 0, /*tp_getattro*/+ 0, /*tp_setattro*/+ 0, /*tp_as_buffer*/+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/+ "PGF object", /*tp_doc*/+ 0, /*tp_traverse */+ 0, /*tp_clear */+ 0, /*tp_richcompare */+ 0, /*tp_weaklistoffset */+ 0, /*tp_iter */+ 0, /*tp_iternext */+ PGF_methods, /*tp_methods */+ PGF_members, /*tp_members */+ PGF_getseters, /*tp_getset */+ 0, /*tp_base */+ 0, /*tp_dict */+ 0, /*tp_descr_get */+ 0, /*tp_descr_set */+ 0, /*tp_dictoffset */+ 0, /*tp_init */+ 0, /*tp_alloc */+ 0, /*tp_new */+};++static PGFObject*+pgf_readPGF(PyObject *self, PyObject *args)+{+ const char *fpath;+ if (!PyArg_ParseTuple(args, "s", &fpath))+ return NULL;++ PGFObject* py_pgf = (PGFObject*) pgf_PGFType.tp_alloc(&pgf_PGFType, 0);+ py_pgf->pool = gu_new_pool();++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(tmp_pool);++ // Read the PGF grammar.+ py_pgf->pgf = pgf_read(fpath, py_pgf->pool, err);+ if (!gu_ok(err)) {+ if (gu_exn_caught(err, GuErrno)) {+ errno = *((GuErrno*) gu_exn_caught_data(err));+ PyErr_SetFromErrnoWithFilename(PyExc_IOError, fpath);+ } else {+ PyErr_SetString(PGFError, "The grammar cannot be loaded");+ }+ Py_DECREF(py_pgf);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ return py_pgf;+}++static ExprObject*+pgf_readExpr(PyObject *self, PyObject *args) {+ Py_ssize_t len;+ const uint8_t *buf;+ if (!PyArg_ParseTuple(args, "s#", &buf, &len))+ return NULL;++ ExprObject* pyexpr = (ExprObject*) pgf_ExprType.tp_alloc(&pgf_ExprType, 0);+ if (pyexpr == NULL)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuIn* in = gu_data_in(buf, len, tmp_pool);+ GuExn* err = gu_new_exn(tmp_pool);++ pyexpr->pool = gu_new_pool();+ pyexpr->expr = pgf_read_expr(in, pyexpr->pool, tmp_pool, err);+ pyexpr->master = NULL;+ + if (!gu_ok(err) || gu_variant_is_null(pyexpr->expr)) {+ PyErr_SetString(PGFError, "The expression cannot be parsed");+ Py_DECREF(pyexpr);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ return pyexpr;+}++static TypeObject*+pgf_readType(PyObject *self, PyObject *args) {+ Py_ssize_t len;+ const uint8_t *buf;+ if (!PyArg_ParseTuple(args, "s#", &buf, &len))+ return NULL;++ TypeObject* pytype = (TypeObject*) pgf_TypeType.tp_alloc(&pgf_TypeType, 0);+ if (pytype == NULL)+ return NULL;++ GuPool* tmp_pool = gu_local_pool();+ GuIn* in = gu_data_in(buf, len, tmp_pool);+ GuExn* err = gu_new_exn(tmp_pool);++ pytype->pool = gu_new_pool();+ pytype->type = pgf_read_type(in, pytype->pool, tmp_pool, err);+ pytype->master = NULL;++ if (!gu_ok(err) || pytype->type == NULL) {+ PyErr_SetString(PGFError, "The type cannot be parsed");+ Py_DECREF(pytype);+ gu_pool_free(tmp_pool);+ return NULL;+ }++ gu_pool_free(tmp_pool);+ return pytype;+}++static PyMethodDef module_methods[] = {+ {"readPGF", (void*)pgf_readPGF, METH_VARARGS,+ "Reads a PGF file in memory"},+ {"readExpr", (void*)pgf_readExpr, METH_VARARGS,+ "Parses a string as an abstract tree"},+ {"readType", (void*)pgf_readType, METH_VARARGS,+ "Parses a string as an abstract type"},+ {NULL, NULL, 0, NULL} /* Sentinel */+};++#if PY_MAJOR_VERSION >= 3+ #define MOD_ERROR_VAL NULL+ #define MOD_SUCCESS_VAL(val) val+ #define MOD_INIT(name) PyMODINIT_FUNC PyInit_##name(void)+ #define MOD_DEF(ob, name, doc, methods) \+ static struct PyModuleDef moduledef = { \+ PyModuleDef_HEAD_INIT, name, doc, -1, methods, }; \+ ob = PyModule_Create(&moduledef);+#else+ #define MOD_ERROR_VAL+ #define MOD_SUCCESS_VAL(val)+ #define MOD_INIT(name) void init##name(void)+ #define MOD_DEF(ob, name, doc, methods) \+ ob = Py_InitModule3(name, methods, doc);+#endif++MOD_INIT(pgf)+{+ PyObject *m;++ if (PyType_Ready(&pgf_PGFType) < 0)+ return MOD_ERROR_VAL;++ if (PyType_Ready(&pgf_ConcrType) < 0)+ return MOD_ERROR_VAL;++ if (PyType_Ready(&pgf_BracketType) < 0)+ return MOD_ERROR_VAL;++ if (PyType_Ready(&pgf_ExprType) < 0)+ return MOD_ERROR_VAL;++ if (PyType_Ready(&pgf_TypeType) < 0)+ return MOD_ERROR_VAL;++ if (PyType_Ready(&pgf_IterType) < 0)+ return MOD_ERROR_VAL;++ MOD_DEF(m, "pgf", "The Runtime for Portable Grammar Format in Python",+ module_methods);+ if (m == NULL)+ return MOD_ERROR_VAL;+ + PGFError = PyErr_NewException("pgf.PGFError", NULL, NULL);+ PyModule_AddObject(m, "PGFError", PGFError);+ Py_INCREF(PGFError);+ + PyObject *dict = PyDict_New();+ PyDict_SetItemString(dict, "token", PyString_FromString("")); + ParseError = PyErr_NewException("pgf.ParseError", NULL, dict);+ PyModule_AddObject(m, "ParseError", ParseError);+ Py_INCREF(ParseError);++ TypeError = PyErr_NewException("pgf.TypeError", NULL, NULL);+ PyModule_AddObject(m, "TypeError", TypeError);+ Py_INCREF(TypeError);++ PyModule_AddObject(m, "Expr", (PyObject *) &pgf_ExprType);+ Py_INCREF(&pgf_ExprType);++ PyModule_AddObject(m, "Type", (PyObject *) &pgf_TypeType);+ Py_INCREF(&pgf_TypeType);++ Py_INCREF(&pgf_PGFType);+ Py_INCREF(&pgf_ConcrType);+ Py_INCREF(&pgf_IterType);+ Py_INCREF(&pgf_BracketType);++ return MOD_SUCCESS_VAL(m);+}
@@ -0,0 +1,24 @@+from distutils.core import setup, Extension+import os++includes = os.getenv('EXTRA_INCLUDE_DIRS','').split(':')+if includes==['']:+ includes=[]+libraries = os.getenv('EXTRA_LIB_DIRS','').split(':')+if libraries==['']:+ libraries=[]++pgf_module = Extension('pgf',+ sources = ['pypgf.c'],+ extra_compile_args = ['-std=c99'],+ include_dirs = includes,+ library_dirs = libraries,+ libraries = ['gu', 'pgf'])++setup (name = 'pgf',+ version = '1.0',+ description = 'A binding to the PGF engine',+ author='Krasimir Angelov',+ author_email='kr.angelov@gmail.com',+ license='BSD',+ ext_modules = [pgf_module])
@@ -0,0 +1,65 @@+import pgf+import sys+import sets+import readline+import locale++sys.stdout.write("loading...")+sys.stdout.flush();+gr = pgf.readPGF("../../../treebanks/PennTreebank/ParseEngAbs.pgf")+sys.stdout.write("\n")++source_lang = gr.languages["ParseEng"]+target_lang = gr.languages["ParseBul"]++we = pgf.readExpr("UttImpSg PPos (ImpVP (UseV try_V))")+print source_lang.linearize(we)++sys.stdout.write("start cat: "+gr.startCat+"\n\n")++class Completer():+ def __init__(self, lang):+ self.gr = lang+ + def complete(self, prefix, state):+ if state == 0:+ line = readline.get_line_buffer()+ line = line[0:readline.get_begidx()]+ self.i = source_lang.complete(line, prefix=prefix)+ self.tokens = sets.Set()++ if len(self.tokens) > 50:+ return None++ while True:+ try:+ (p,t,c) = self.i.next()+ if t not in self.tokens:+ self.tokens.add(t)+ return t+ except StopIteration:+ return None++completer = Completer(source_lang)+readline.set_completer(completer.complete)+readline.parse_and_bind("tab: complete")+locale.setlocale(locale.LC_CTYPE, "")++while True:+ try:+ line = raw_input("> ");+ except EOFError:+ sys.stdout.write("\n")+ readline.set_completer(None)+ break+ except KeyboardInterrupt:+ sys.stdout.write("\n")+ readline.set_completer(None)+ break++ try:+ for (p,e) in source_lang.parse(line, n=1):+ sys.stdout.write("["+str(p)+"] "+str(e)+"\n")+ print target_lang.linearize(e)+ except pgf.ParseError as e:+ print e.message
@@ -0,0 +1,2 @@+all:+ swipl-ld -cc-options,-std=c99 -lgu -lpgf -shared swipgf.c -o swipgf.so
@@ -0,0 +1,2 @@+:- module(pgf, [ readPGF/2, language/3 ]).+:- use_foreign_library(foreign('./swipgf.so')).
@@ -0,0 +1,82 @@+#include <SWI-Prolog.h>+#include <pgf/pgf.h>++typedef struct {+ GuPool* pool;+ PgfPGF* pgf;+} PlPGF;++static PL_blob_t pgf_blob = {+ PL_BLOB_MAGIC,+ PL_BLOB_UNIQUE,+ "PGF",+ NULL,+ NULL,+ NULL,+ NULL+};++static foreign_t+pl_readPGF(term_t a1, term_t a2)+{+ char *fpath;++ if (!PL_get_atom_chars(a1, &fpath) )+ PL_fail;+ + PlPGF pl_pgf;+ pl_pgf.pool = gu_new_pool();++ GuPool* tmp_pool = gu_local_pool();++ // Create an exception frame that catches all errors.+ GuExn* err = gu_new_exn(NULL, gu_kind(type), tmp_pool);++ // Read the PGF grammar.+ pl_pgf.pgf = pgf_read(fpath, pl_pgf.pool, err);+ if (!gu_ok(err)) {+ int res;+ if (gu_exn_caught(err) == gu_type(GuErrno)) {+ errno = *((GuErrno*) gu_exn_caught_data(err));+ res = PL_existence_error("source_sink", a1);+ } else {+ res = PL_raise_exception(a1);+ }+ gu_pool_free(pl_pgf.pool);+ gu_pool_free(tmp_pool);+ return res;+ }++ gu_pool_free(tmp_pool);++ if (!PL_unify_blob(a2, &pl_pgf, sizeof(pl_pgf), &pgf_blob)) {+ gu_pool_free(pl_pgf.pool);+ PL_fail;+ }++ PL_succeed;+}++static foreign_t+pl_language(term_t a1, term_t a2, term_t a3, control_t handle)+{+ switch (PL_foreign_control(handle)) {+ case PL_FIRST_CALL:+ //ctxt = malloc(sizeof(struct context));+ PL_retry_address(NULL/*ctxt*/);+ case PL_REDO:+ //ctxt = PL_foreign_context_address(handle);+ PL_retry_address(NULL/*ctxt*/);+ case PL_PRUNED:+ //ctxt = PL_foreign_context_address(handle);+ //free(ctxt);+ PL_succeed;+ }+ PL_succeed;+}++install_t+install_swipgf()+{ PL_register_foreign("readPGF", 2, pl_readPGF, 0);+ PL_register_foreign("language", 3, pl_language, PL_FA_NONDETERMINISTIC);+}
@@ -0,0 +1,337 @@+/**+ * gflib.dt.s+ *+ * by John J. Camilleri+ *+ * TypeScript type definitions for the "original" JS GF runtime (GF:src/runtime/javascript/gflib.js)+ */++// Note: the String prototype is extended with:+// String.prototype.tag = "";+// String.prototype.setTag = function (tag) { this.tag = tag; };++/**+ * A GF grammar is one abstract and multiple concretes+ */+declare class GFGrammar {+ abstract: GFAbstract+ concretes: {[key: string]: GFConcrete}++ constructor(abstract: GFAbstract, concretes: {[key: string]: GFConcrete})++ translate(+ input: string,+ fromLang: string,+ toLang: string+ ): {[key: string]: {[key: string]: string}}+}++/**+ * Abstract Syntax Tree+ */+declare class Fun {+ name: string+ args: Fun[]++ constructor(name: string, ...args: Fun[])++ print(): string+ show(): string+ getArg(i: number): Fun+ setArg(i: number, c: Fun): void+ isMeta(): boolean+ isComplete(): boolean+ isLiteral(): boolean+ isString(): boolean+ isInt(): boolean+ isFloat(): boolean+ isEqual(obj: any): boolean+}++/**+ * Abstract syntax+ */+declare class GFAbstract {+ startcat: string+ types: {[key: string]: Type} // key is function name++ constructor(startcat: string, types: {[key: string]: Type})++ addType(fun: string, args: string[], cat: string): void+ getArgs(fun: string): string[]+ getCat(fun: string): string+ annotate(tree: Fun, type: string): Fun+ handleLiterals(tree: Fun, type: Type): Fun+ copyTree(x: Fun): Fun+ parseTree(str: string, type: string): Fun+ parseTree_(tokens: string[], prec: number): Fun+}++/**+ * Type+ */+declare class Type {+ args: string[]+ cat: string++ constructor(args: string[], cat: string)+}++type ApplyOrCoerce = Apply | Coerce++/**+ * Concrete syntax+ */+declare class GFConcrete {+ flags: {[key: string]: string}+ productions: {[key: number]: ApplyOrCoerce[]}+ functions: CncFun[]+ sequences: Array<Array<Sym>>+ startCats: {[key: string]: {s: number, e: number}}+ totalFIds: number+ pproductions: {[key: number]: ApplyOrCoerce[]}+ lproductions: {[key: string]: {fid: FId, fun: CncFun}}++ constructor(+ flags: {[key: string]: string},+ productions: {[key: number]: ApplyOrCoerce[]},+ functions: CncFun[],+ sequences: Array<Array<Sym>>,+ startCats: {[key: string]: {s: number, e: number}},+ totalFIds: number+ )++ linearizeSyms(tree: Fun, tag: string): Array<{fid: FId, table: any}>+ syms2toks(syms: Sym[]): string[]+ linearizeAll(tree: Fun): string[]+ linearize(tree: Fun): string+ tagAndLinearize(tree: Fun): string[]+ unlex(ts: string): string+ tagIt(obj: any, tag: string): any+ // showRules(): string // Uncaught TypeError: Cannot read property 'length' of undefined at gflib.js:451+ tokenize(string: string): string[]+ parseString(string: string, cat: string): Fun[]+ complete(+ input: string,+ cat: string+ ): {consumed: string[], suggestions: string[]}+}++/**+ * Function ID+ */+type FId = number++/**+ * Apply+ */+declare class Apply {+ id: string+ fun: FId+ args: PArg[]++ constructor(fun: FId, args: PArg[])++ show(cat: string): string+ isEqual(obj: any): boolean+}++/**+ * PArg+ */+declare class PArg {+ fid: FId+ hypos: any[]++ constructor(fid: FId, ...hypos: any[])+}++/**+ * Coerce+ */+declare class Coerce {+ id: string+ arg: FId++ constructor(arg: FId)++ show(cat: string): string+}++/**+ * Const+ */+declare class Const {+ id: string+ lit: Fun+ toks: any[]++ constructor(lit: Fun, toks: any[])++ show(cat: string): string+ isEqual(obj: any): boolean+}++/**+ * CncFun+ */+declare class CncFun {+ name: string+ lins: FId[]++ constructor(name: string, lins: FId[])+}++type Sym = SymCat | SymKS | SymKP | SymLit++/**+ * SymCat+ */+declare class SymCat {+ id: string+ i: number+ label: number++ constructor(i: number, label: number)++ getId(): string+ getArgNum(): number+ show(): string+}++/**+ * SymKS+ */+declare class SymKS {+ id: string+ tokens: string[]++ constructor(...tokens: string[])++ getId(): string+ show(): string+}++/**+ * SymKP+ */+declare class SymKP {+ id: string+ tokens: string[]+ alts: Alt[]++ constructor(tokens: string[], alts: Alt[])++ getId(): string+ show(): string+}++/**+ * Alt+ */+declare class Alt {+ tokens: string[]+ prefixes: string[]++ constructor(tokens: string[], prefixes: string[])+}++/**+ * SymLit+ */+declare class SymLit {+ id: string+ i: number+ label: number++ constructor(i: number, label: number)++ getId(): string+ show(): string+}++/**+ * Trie+ */+declare class Trie {+ value: any+ items: Trie[]++ insertChain(keys, obj): void+ insertChain1(keys, obj): void+ lookup(key, obj): any+ isEmpty(): boolean+}++/**+ * ParseState+ */+declare class ParseState {+ concrete: GFConcrete+ startCat: string+ items: Trie+ chart: Chart++ constructor(concrete: GFConcrete, startCat: string)++ next(token: string): boolean+ complete(correntToken: string): Trie+ extractTrees(): any[]+ process(+ agenda,+ literalCallback: (fid: FId) => any,+ tokenCallback: (tokens: string[], item: any) => any+ ): void+}++/**+ * Chart+ */+declare class Chart {+ active: any+ actives: {[key: number]: any}+ passive: any+ forest: {[key: number]: ApplyOrCoerce[]}+ nextId: number+ offset: number++ constructor(concrete: GFConcrete)++ lookupAC(fid: FId,label)+ lookupACo(offset, fid: FId, label)++ labelsAC(fid: FId)+ insertAC(fid: FId, label, items): void++ lookupPC(fid: FId, label, offset)+ insertPC(fid1: FId, label, offset, fid2: FId): void+ shift(): void+ expandForest(fid: FId): any[]+}++/**+ * ActiveItem+ */+declare class ActiveItem {+ offset: number+ dot: number+ fun: CncFun+ seq: Array<Sym>+ args: PArg[]+ fid: FId+ lbl: number++ constructor(+ offset: number,+ dot: number,+ fun: CncFun,+ seq: Array<Sym>,+ args: PArg[],+ fid: FId,+ lbl: number+ )++ isEqual(obj: any): boolean+ shiftOverArg(i: number, fid: FId): ActiveItem+ shiftOverTokn(): ActiveItem+}
@@ -0,0 +1,11 @@+-- | Isolate dependencies on the problematic cgi package to this module+module CGI(module C) where+import Network.CGI as C(+ CGI,ContentType(..),Accept(..),Language(..),+ getVarWithDefault,readInput,negotiate,requestAcceptLanguage,getInput,+ setHeader,output,outputFPS,outputError,+ handleErrors,catchCGI,throwCGI,+ liftIO)+import Network.CGI.Protocol as C(CGIResult(..),CGIRequest(..),Input(..),+ Headers,HeaderName(..))+import Network.CGI.Monad as C(runCGIT)
@@ -0,0 +1,105 @@+{-# LANGUAGE DeriveDataTypeable, CPP #-}+-- | CGI utility functions for output, error handling and logging+module CGIUtils (throwCGIError, handleCGIErrors,+ stderrToFile,logError,+ outputJSONP,outputEncodedJSONP,+ outputPNG,outputBinary,outputBinary',+ outputHTML,outputPlain,outputText) where++import Control.Exception(Exception(..),SomeException(..),throw)+import Data.Typeable(Typeable,cast)+import Prelude hiding (catch)+import System.IO(hPutStrLn,stderr)+#ifndef mingw32_HOST_OS+import System.Posix+#endif++import CGI(CGI,CGIResult,setHeader,output,outputFPS,outputError,+ getInput,catchCGI,throwCGI)++import Text.JSON+import qualified Codec.Binary.UTF8.String as UTF8 (encodeString)+import qualified Data.ByteString.Lazy as BS++-- * Logging++#ifndef mingw32_HOST_OS+logError :: String -> IO ()+logError s = hPutStrLn stderr s++stderrToFile :: FilePath -> IO ()+stderrToFile file =+ do let mode = ownerReadMode<>ownerWriteMode<>groupReadMode<>otherReadMode+ (<>) = unionFileModes+ flags = defaultFileFlags { append = True }+ fileFd <- openFd file WriteOnly (Just mode) flags+ dupTo fileFd stdError+ return ()+#else+logError :: String -> IO ()+logError s = return ()++stderrToFile :: FilePath -> IO ()+stderrToFile s = return ()+#endif++-- * General CGI Error exception mechanism++data CGIError = CGIError { cgiErrorCode :: Int, cgiErrorMessage :: String, cgiErrorText :: [String] }+ deriving (Show,Typeable)++instance Exception CGIError where+ toException e = SomeException e+ fromException (SomeException e) = cast e++throwCGIError :: Int -> String -> [String] -> CGI a+throwCGIError c m t = throwCGI $ toException $ CGIError c m t++handleCGIErrors :: CGI CGIResult -> CGI CGIResult+handleCGIErrors x =+ x `catchCGI` \e -> case fromException e of+ Nothing -> throw e+ Just (CGIError c m t) -> do setXO; outputError c m t++-- * General CGI and JSON stuff++outputJSONP :: JSON a => a -> CGI CGIResult+outputJSONP = outputEncodedJSONP . encode++outputEncodedJSONP :: String -> CGI CGIResult+outputEncodedJSONP json = + do mc <- getInput "jsonp"+ let (ty,str) = case mc of+ Nothing -> ("json",json)+ Just c -> ("javascript",c ++ "(" ++ json ++ ")")+ ct = "application/"++ty++"; charset=utf-8"+ outputText ct str++outputPNG :: BS.ByteString -> CGI CGIResult+outputPNG = outputBinary' "image/png"++outputBinary :: BS.ByteString -> CGI CGIResult+outputBinary = outputBinary' "application/binary"++outputBinary' :: String -> BS.ByteString -> CGI CGIResult+outputBinary' ct x = do+ setHeader "Content-Type" ct+ setXO+ outputFPS x++outputHTML :: String -> CGI CGIResult+outputHTML = outputText "text/html; charset=utf-8"++outputPlain :: String -> CGI CGIResult+outputPlain = outputText "text/plain; charset=utf-8"++outputText ct = outputStrict ct . UTF8.encodeString++outputStrict :: String -> String -> CGI CGIResult+outputStrict ct x | x == x = do setHeader "Content-Type" ct+ setXO+ output x+ | otherwise = fail "I am the pope."++setXO = setHeader "Access-Control-Allow-Origin" "*"+ -- https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS
@@ -0,0 +1,71 @@+-- | A file cache to avoid reading and parsing the same file many times+module Cache (Cache,newCache,flushCache,expireCache,listCache,readCache,readCache') where++import Control.Concurrent.MVar+import Data.Map (Map)+import qualified Data.Map as Map +import Data.Foldable as T(mapM_)+import Data.Maybe(mapMaybe)+import System.Directory (getModificationTime)+import System.Mem(performGC)+import Data.Time (UTCTime,getCurrentTime,diffUTCTime)+import Data.Time.Compat (toUTCTime)++data Cache a = Cache {+ cacheLoad :: FilePath -> IO a,+ cacheObjects :: MVar (Map FilePath (MVar (Maybe (FileInfo a))))+ }++type FileInfo a = (UTCTime,UTCTime,a) -- modification time, access time, contents++-- | Create a new cache that uses the given function to read and parse files+newCache :: (FilePath -> IO a) -> IO (Cache a)+newCache load = + do objs <- newMVar Map.empty+ return $ Cache { cacheLoad = load, cacheObjects = objs }++-- | Forget all cached objects+flushCache :: Cache a -> IO ()+flushCache c = do modifyMVar_ (cacheObjects c) (const (return Map.empty))+ performGC++-- | Forget cached objects that have been unused for longer than the given time+expireCache age c =+ do now <- getCurrentTime+ let expire object@(Just (_,t,_)) | diffUTCTime now t>age = return Nothing+ expire object = return object+ withMVar (cacheObjects c) (T.mapM_ (flip modifyMVar_ expire))+ performGC++-- | List currently cached files+listCache :: Cache a -> IO [(FilePath,UTCTime)]+listCache c =+ fmap (mapMaybe id) . mapM check . Map.toList =<< readMVar (cacheObjects c)+ where+ check (path,v) = maybe Nothing (Just . (,) path . fst3) `fmap` readMVar v++fst3 (x,y,z) = x++-- | Lookup a cached object (or read the file if it is not in the cache or if+-- it has been modified)+readCache :: Cache a -> FilePath -> IO a+readCache c file = snd `fmap` readCache' c file++-- | Like 'readCache', but also return the last modification time of the file+readCache' :: Cache a -> FilePath -> IO (UTCTime,a)+readCache' c file =+ do v <- modifyMVar (cacheObjects c) findEntry+ modifyMVar v readObject+ where+ -- Find the cache entry, inserting a new one if neccessary.+ findEntry objs = case Map.lookup file objs of+ Just v -> return (objs,v)+ Nothing -> do v <- newMVar Nothing+ return (Map.insert file v objs, v)+ -- Check time stamp, and reload if different than the cache entry+ readObject m = do t' <- toUTCTime `fmap` getModificationTime file+ now <- getCurrentTime+ x' <- case m of+ Just (t,_,x) | t' == t -> return x+ _ -> cacheLoad c file+ return (Just (t',now,x'), (t',x'))
@@ -0,0 +1,110 @@+{-# LANGUAGE CPP #-}+module FastCGIUtils(initFastCGI,loopFastCGI) where++import Control.Concurrent(ThreadId,myThreadId)+import Control.Exception(ErrorCall(..),throw,throwTo,catch)+import Control.Monad(when,liftM,liftM2)+import Data.IORef(IORef,newIORef,readIORef,writeIORef)+import Prelude hiding (catch)+import System.Environment(getArgs,getProgName)+import System.Exit(ExitCode(..),exitWith)+import System.IO(hPutStrLn,stderr)+import System.IO.Unsafe(unsafePerformIO)+#ifndef mingw32_HOST_OS+import System.Posix+#endif++import Network.FastCGI++import CGIUtils(logError)++ -- There are used in MorphoService.hs, but not in PGFService.hs+initFastCGI :: IO ()+initFastCGI = installSignalHandlers++loopFastCGI :: CGI CGIResult -> IO ()+loopFastCGI f = + do (do runOneFastCGI f+ exitIfToldTo+ restartIfModified) + `catchAborted` logError "Request aborted"+ loopFastCGI f++-- Signal handling for FastCGI programs.++#ifndef mingw32_HOST_OS+installSignalHandlers :: IO ()+installSignalHandlers =+ do t <- myThreadId+ installHandler sigUSR1 (Catch gracefulExit) Nothing+ installHandler sigTERM (Catch gracelessExit) Nothing+ installHandler sigPIPE (Catch (requestAborted t)) Nothing+ return ()++requestAborted :: ThreadId -> IO ()+requestAborted t = throwTo t (ErrorCall "**aborted**")+ +gracelessExit :: IO ()+gracelessExit = do logError "Graceless exit"+ exitWith ExitSuccess++gracefulExit :: IO ()+gracefulExit = + do logError "Graceful exit"+ writeIORef shouldExit True+#else+installSignalHandlers :: IO ()+installSignalHandlers = return ()+#endif++exitIfToldTo :: IO ()+exitIfToldTo = + do b <- readIORef shouldExit+ when b $ do logError "Exiting..."+ exitWith ExitSuccess++{-# NOINLINE shouldExit #-}+shouldExit :: IORef Bool+shouldExit = unsafePerformIO $ newIORef False++catchAborted :: IO a -> IO a -> IO a+catchAborted x y = x `catch` \e -> case e of+ ErrorCall "**aborted**" -> y+ _ -> throw e++-- Restart handling for FastCGI programs.++#ifndef mingw32_HOST_OS+{-# NOINLINE myModTimeRef #-}+myModTimeRef :: IORef EpochTime+myModTimeRef = unsafePerformIO (getProgModTime >>= newIORef)++-- FIXME: doesn't get directory+myProgPath :: IO FilePath+myProgPath = getProgName++getProgModTime :: IO EpochTime+getProgModTime = liftM modificationTime (myProgPath >>= getFileStatus)++needsRestart :: IO Bool+needsRestart = liftM2 (/=) (readIORef myModTimeRef) getProgModTime++exitIfModified :: IO ()+exitIfModified = + do restart <- needsRestart+ when restart $ exitWith ExitSuccess++restartIfModified :: IO ()+restartIfModified = + do restart <- needsRestart+ when restart $ do prog <- myProgPath+ args <- getArgs+ hPutStrLn stderr $ prog ++ " has been modified, restarting ..."+ -- FIXME: setCurrentDirectory?+ executeFile prog False args Nothing++#else+restartIfModified :: IO ()+restartIfModified = return ()+#endif+
@@ -0,0 +1,340 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
@@ -0,0 +1,1049 @@+{-# LANGUAGE CPP #-}+module PGFService(cgiMain,cgiMain',getPath,+ logFile,stderrToFile,+ Caches,pgfCache,newPGFCache,flushPGFCache,listPGFCache) where++import PGF (PGF,Labels,CncLabels)+import GF.Text.Lexing+import qualified PGF+import Cache+import CGIUtils(outputJSONP,outputPlain,outputHTML,outputText,+ outputBinary,outputBinary',+ logError,handleCGIErrors,throwCGIError,stderrToFile)+import CGI(CGI,readInput,getInput,getVarWithDefault,+ CGIResult,requestAcceptLanguage,handleErrors,setHeader,+ Accept(..),Language(..),negotiate,liftIO)+import URLEncoding++#if C_RUNTIME+import qualified PGF2 as C+--import Data.Time.Clock(getCurrentTime,diffUTCTime)+#endif++import Data.Time.Clock(UTCTime)+import Data.Time.Format(formatTime)+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format(defaultTimeLocale,rfc822DateFormat)+#else+import System.Locale(defaultTimeLocale,rfc822DateFormat)+#endif+import Text.JSON+import Text.PrettyPrint as PP(render, text, (<+>))+import qualified Codec.Binary.UTF8.String as UTF8 (decodeString)+import qualified Data.ByteString.Lazy as BS++import Control.Concurrent+import qualified Control.Exception as E+import Control.Monad+import Control.Monad.State(State,evalState,get,put)+import Control.Monad.Catch(bracket_)+import Data.Char+--import Data.Function (on)+import Data.List ({-sortBy,-}intersperse,mapAccumL,nub,isSuffixOf,nubBy)+import qualified Data.Map as Map+import Data.Maybe+import System.Random+import System.Process+import System.Exit+import System.IO+import System.IO.Error(isDoesNotExistError)+import System.Directory(removeFile)+import System.FilePath(dropExtension,takeDirectory,(</>),(<.>))+import System.Mem(performGC)+import Fold(fold) -- transfer function for OpenMath LaTeX++catchIOE :: IO a -> (E.IOException -> IO a) -> IO a+catchIOE = E.catch++withQSem qsem = bracket_ (liftIO $ waitQSem qsem) (liftIO $ signalQSem qsem)++logFile :: FilePath+logFile = "pgf-error.log"++#ifdef C_RUNTIME+data Caches = Caches { pgfCache::Cache PGF,+ labelsCache::Cache Labels,+ cncLabelsCache::Cache CncLabels,+ cpgfCache::(Cache (C.PGF,({-MVar ParseCache-})),QSem) }+--type Caches = (Cache PGF,Cache (C.PGF,({-MVar ParseCache-})))+--type ParseCache = Map.Map (String,String) (ParseResult,UTCTime)+--type ParseResult = Either String [(C.Expr,Float)]++newPGFCache jobs = do pgfCache <- newCache' PGF.readPGF+ lblCache <- newCache' (fmap PGF.getDepLabels . readFile)+ clblCache <- newCache'(fmap PGF.getCncDepLabels .readFile)+ let n = maybe 4 id jobs+ qsem <- newQSem n+ cCache <- newCache' $ \ path -> do pgf <- C.readPGF path+ --pc <- newMVar Map.empty+ return (pgf,({-pc-}))+ return $ Caches pgfCache lblCache clblCache (cCache,qsem)+flushPGFCache c = do flushCache (pgfCache c)+ flushCache (labelsCache c)+ flushCache (fst (cpgfCache c))+listPGFCache c = (,) # listCache (pgfCache c) % listCache (fst (cpgfCache c))+#else+data Caches = Caches { pgfCache::Cache PGF,+ labelsCache::Cache Labels,+ cncLabelsCache::Cache CncLabels }+newPGFCache _ = do pgfCache <- newCache' PGF.readPGF+ lblCache <- newCache' (fmap PGF.getDepLabels . readFile)+ clblCache <- newCache'(fmap PGF.getCncDepLabels .readFile)+ return $ Caches pgfCache lblCache clblCache+flushPGFCache c = flushCache (pgfCache c)++listPGFCache :: Caches -> IO ([(FilePath,UTCTime)],[(FilePath,UTCTime)])+listPGFCache c = (,) # listCache (pgfCache c) % return []+#endif++labelsCaches c = (labelsCache c,cncLabelsCache c)++newCache' rd = do c <- newCache rd+ forkIO $ forever $ clean c+ return c+ where+ clean c = do threadDelay 2000000000 -- 2000 seconds, i.e. ~33 minutes+ expireCache (24*60*60) c -- 24 hours++getPath =+ do path <- getVarWithDefault "PATH_TRANSLATED" "" -- apache mod_fastcgi+ if null path+ then getVarWithDefault "SCRIPT_FILENAME" "" -- lighttpd+ else return path++cgiMain :: Caches -> CGI CGIResult+cgiMain cache = handleErrors . handleCGIErrors $+ cgiMain' cache =<< getPath++cgiMain' :: Caches -> FilePath -> CGI CGIResult+cgiMain' cache path =+ do command <- liftM (maybe "grammar" (urlDecodeUnicode . UTF8.decodeString))+ (getInput "command")+ case command of+ "download" -> outputBinary =<< getFile BS.readFile path+ 'c':'-':_ -> optionalCpgfMain cache path command+ _ -> do tpgf <- getFile (readCache' (pgfCache cache)) path+ pgfMain (labelsCaches cache) path command tpgf++optionalCpgfMain cache path command =+#ifdef C_RUNTIME+ cpgfMain (snd (cpgfCache cache)) command+ =<< getFile (readCache' (fst (cpgfCache cache))) path+#else+ serverError "Server configured without C run-time support" ""++serverError = throw 500++#endif++getFile get path =+ either failed return =<< liftIO (E.try (get path))+ where+ failed e = if isDoesNotExistError e+ then notFound path+ else liftIO $ ioError e++--------------------------------------------------------------------------------+-- * C run-time functionality++#ifdef C_RUNTIME+--cpgfMain :: String -> (C.PGF,MVar ParseCache) -> CGI CGIResult+cpgfMain qsem command (t,(pgf,pc)) =+ case command of+ "c-parse" -> withQSem qsem $+ out t=<< join (parse # input % start % limit % treeopts)+ "c-linearize" -> out t=<< lin # tree % to+ "c-linearizeAll"-> out t=<< linAll # tree % to+ "c-translate" -> withQSem qsem $+ out t=<<join(trans # input % to % start % limit%treeopts)+ "c-lookupmorpho"-> out t=<< morpho # from1 % textInput+ "c-flush" -> out t=<< flush+ "c-grammar" -> out t grammar+ "c-abstrtree" -> outputGraphviz=<< C.graphvizAbstractTree pgf C.graphvizDefaults # tree+ "c-parsetree" -> outputGraphviz=<< (\cnc -> C.graphvizParseTree cnc C.graphvizDefaults) . snd # from1 %tree+ "c-wordforword" -> out t =<< wordforword # input % to+ _ -> badRequest "Unknown command" command+ where+ flush = liftIO $ do --modifyMVar_ pc $ const $ return Map.empty+ performGC+ return $ showJSON ()++ cat = C.startCat pgf+ langs = C.languages pgf++ grammar = showJSON $ makeObj+ ["name".=C.abstractName pgf,+ "lastmodified".=show t,+ "startcat".=C.showType [] (C.startCat pgf),+ "languages".=languages]+ where+ languages = [makeObj ["name".= l] | (l,_)<-Map.toList langs]++ parse input@((from,_),_) start mlimit (trie,json) =+ do r <- parse' start mlimit input+ return $ showJSON [makeObj ("from".=from:jsonParseResult json r)]++ jsonParseResult json = either bad good+ where+ bad err = ["parseFailed".=err]+ good trees = "trees".=map tp trees :[] -- :addTrie trie trees+ tp (tree,prob) = makeObj (addTree json tree++["prob".=prob])++ -- Without caching parse results:+ parse' start mlimit ((from,concr),input) =+ case C.parseWithHeuristics concr cat input (-1) callbacks of+ C.ParseOk ts -> return (Right (maybe id take mlimit (drop start ts)))+ C.ParseFailed _ tok -> return (Left tok)+ C.ParseIncomplete -> return (Left "")+ where+ callbacks = maybe [] cb $ lookup (C.abstractName pgf) C.literalCallbacks+ cb fs = [(cat,f pgf (from,concr) input)|(cat,f)<-fs]+{-+ -- Caching parse results:+ parse' start mlimit ((from,concr),input) = + liftIO $ do t <- getCurrentTime+ fmap (maybe id take mlimit . drop start)+ # modifyMVar pc (parse'' t)+ where+ key = (from,input)+ parse'' t pc = maybe new old $ Map.lookup key pc+ where+ new = return (update (res,t) pc,res)+ where res = C.parse concr cat input+ old (res,_) = return (update (res,t) pc,res)+ update r = Map.mapMaybe purge . Map.insert key r+ purge r@(_,t') = if diffUTCTime t t'<120 then Just r else Nothing+ -- remove unused parse results after 2 minutes+-}+ linAll tree to = showJSON (linAll' tree to)+ linAll' tree (tos,unlex) =+ [makeObj ["to".=to,+ "texts".=map unlex (C.linearizeAll c tree)]|(to,c)<-tos]++ lin tree to = showJSON (lin' tree to)+ lin' tree (tos,unlex) =+ [makeObj ["to".=to,"text".=unlex (C.linearize c tree)]|(to,c)<-tos]++ trans input@((from,_),_) to start mlimit (trie,jsontree) =+ do parses <- parse' start mlimit input+ return $+ showJSON [ makeObj ["from".=from,+ "translations".= jsonParses parses]]+ where+ jsonParses = either bad good+ where+ bad err = [makeObj ["error".=err]]+ good parses = [makeObj (addTree jsontree tree+++ ["prob".=prob,+ "linearizations".=lin' tree to])+ | (tree,prob) <- parses]++ morpho (from,concr) input =+ showJSON [makeObj ["lemma".=l,"analysis".=a,"prob".=p]|(l,a,p)<-ms]+ where ms = C.lookupMorpho concr input+++ wordforword input@((from,_),_) = jsonWFW from . wordforword' input++ jsonWFW from rs =+ showJSON+ [makeObj+ ["from".=from,+ "translations".=[makeObj ["linearizations".=+ [makeObj["to".=to,"text".=text]+ | (to,text)<-rs]]]]]++ wordforword' inp@((from,concr),input) (tos,unlex) =+ [(to,unlex . unwords $ map (lin_word' c) pws)+ |let pws=map parse_word' (words input),(to,c)<-tos]+ where+ lin_word' c = either id (lin1 c)++ lin1 c = dropq . C.linearize c+ where+ dropq (q:' ':s) | q `elem` "+*" = s+ dropq s = s++ parse_word' w = if all (\c->isSpace c||isPunctuation c) w+ then Left w+ else parse_word w+++ parse_word w =+ maybe (Left ("["++w++"]")) Right $+ msum [parse1 w,parse1 ow,morph w,morph ow]+ where+ ow = case w of+ c:cs | isLower c -> toUpper c : cs+ | isUpper c -> toLower c : cs+ s -> s++ parse1 s = case C.parse concr cat s of+ C.ParseOk ((t,_):ts) -> Just t+ _ -> Nothing+ morph w = listToMaybe+ [t | (f,a,p)<-C.lookupMorpho concr w,+ t<-maybeToList (C.readExpr f)]++ ---++ input = lexit # from % textInput+ where+ lexit (from,lex) input = (from,lex input)++ from = maybe (missing "from") getlexer =<< from'+ where+ getlexer f@(_,concr) = (,) f # c_lexer concr++ from1 = maybe (missing "from") return =<< from'+ from' = getLang "from"++ to = (,) # getLangs "to" % unlexer (const False)++ getLangs = getLangs' readLang+ getLang = getLang' readLang++ readLang :: String -> CGI (String,C.Concr)+ readLang lang =+ case Map.lookup lang langs of+ Nothing -> badRequest "Bad language" lang+ Just c -> return (lang,c)++ tree = do s <- maybe (missing "tree") return =<< getInput1 "tree"+ let t = C.readExpr s+ maybe (badRequest "bad tree" s) return t++ c_lexer concr = lexer (not . null . C.lookupMorpho concr)++--------------------------------------------------------------------------------++{-+instance JSON C.CId where+ readJSON x = readJSON x >>= maybe (fail "Bad language.") return . C.readCId+ showJSON = showJSON . C.showCId+-}+instance JSON C.Expr where+ readJSON x = readJSON x >>= maybe (fail "Bad expression.") return . C.readExpr+ showJSON = showJSON . C.showExpr []+++-- | Convert a 'Tree' to an 'ATree'+cToATree :: C.Expr -> PGF.ATree C.Expr+cToATree e = maybe (PGF.Other e) app (C.unApp e)+ where+ app (f,es) = PGF.App (read f) (map cToATree es)++instance ToATree C.Expr where+ showTree = show+ toATree = cToATree++#endif++--------------------------------------------------------------------------------+-- * Lexing++-- | Standard lexers+lexer good = maybe (return id) lexerfun =<< getInput "lexer" + where+ lexerfun name =+ case stringOp good ("lex"++name) of+ Just fn -> return fn+ Nothing -> badRequest "Unknown lexer" name+++type Unlexer = String->String++-- | Unlexing for the C runtime system, &+ is already applied+unlexer :: (String -> Bool) -> CGI Unlexer+unlexer good = maybe (return id) unlexerfun =<< getInput "unlexer"+ where+ unlexerfun name =+ case stringOp good ("unlex"++name) of+ Just fn -> return (fn . cleanMarker)+ Nothing -> badRequest "Unknown unlexer" name+ + cleanMarker ('+':cs) = cs+ cleanMarker ('*':cs) = cs+ cleanMarker cs = cs++--------------------------------------------------------------------------------+-- * Haskell run-time functionality++--pgfMain :: Cache Labels -> FilePath -> String -> PGF -> CGI CGIResult+pgfMain lcs@(alc,clc) path command tpgf@(t,pgf) =+ case command of+ "parse" -> o =<< doParse pgf # input % cat % limit % treeopts+ "complete" -> o =<< doComplete pgf # input % cat % limit % full+ "linearize" -> o =<< doLinearize pgf # tree % to+ "linearizeAll" -> o =<< doLinearizes pgf # tree % to+ "linearizeTable" -> o =<< doLinearizeTabular pgf # tree % to+ "random" -> o =<< join (doRandom pgf # cat % depth % limit % to)+ "generate" -> o =<< doGenerate pgf # cat % depth % limit % to+ "translate" -> o =<< doTranslate pgf # input % cat %to%limit%treeopts+ "translategroup" -> o =<< doTranslateGroup pgf # input % cat % to % limit+ "lookupmorpho" -> o =<< doLookupMorpho pgf # from1 % textInput+ "grammar" -> join $ doGrammar tpgf+ # liftIO (E.try (getLabels alc path pgf))+ % requestAcceptLanguage+ "abstrtree" -> outputGraphviz =<< abstrTree pgf # graphvizOptions % tree+ "alignment" -> outputGraphviz =<< alignment pgf # tree % to+ "parsetree" -> outputGraphviz =<< parseTree pgf # from1 % graphvizOptions % tree+ "deptree" -> join $ doDepTree lcs path pgf # format "dot" % to1 % tree+ "abstrjson" -> o . jsonExpr =<< tree+ "browse" -> join $ doBrowse pgf # optId % cssClass % href % format "html" % getIncludePrintNames+ "external" -> do cmd <- getInput "external"+ doExternal cmd =<< textInput+ _ -> badRequest "Unknown command" command+ where+ o x = out t x++ input = do fr <- from+ lex <- mlexer fr+ inp <- textInput+ return (fr,lex inp)++ mlexer Nothing = lexer (const False)+ mlexer (Just lang) = lexer (PGF.isInMorpho morpho)+ where morpho = PGF.buildMorpho pgf lang++ tree :: CGI PGF.Tree+ tree = do ms <- getInput "tree"+ s <- maybe (badRequest "No tree given" "") return ms+ t <- maybe (badRequest "Bad tree" s) return (PGF.readExpr s)+ t <- either (\err -> badRequest "Type incorrect tree"+ (unlines $+ [PGF.showExpr [] t+ ,render (PP.text "error:" <+> PGF.ppTcError err)+ ]))+ (return . fst)+ (PGF.inferExpr pgf t)+ return t++ cat :: CGI (Maybe PGF.Type)+ cat =+ do mcat <- getInput1 "cat"+ case mcat of+ Nothing -> return Nothing+ Just cat -> case PGF.readType cat of+ Nothing -> badRequest "Bad category" cat+ Just typ -> return $ Just typ -- typecheck the category++ optId :: CGI (Maybe PGF.CId)+ optId = maybe (return Nothing) rd =<< getInput "id"+ where+ rd = maybe err (return . Just) . PGF.readCId+ err = badRequest "Bad identifier" []++ cssClass, href :: CGI (Maybe String)+ cssClass = getInput "css-class"+ href = getInput "href"+ + getIncludePrintNames :: CGI Bool+ getIncludePrintNames = maybe False (const True) # getInput "printnames"++ graphvizOptions =+ PGF.GraphvizOptions # bool "noleaves"+ % bool "nofun"+ % bool "nocat"+ % bool "nodep"+ % string "nodefont"+ % string "leaffont"+ % string "nodecolor"+ % string "leafcolor"+ % string "nodeedgestyle"+ % string "leafedgestyle"+ where+ string name = maybe "" id # getInput name+ bool name = maybe False toBool # getInput name++ from1 = maybe (missing "from") return =<< from+ from = getLang "from"++ to1 = maybe (missing "to") return =<< getLang "to"+ to = (,) # getLangs "to" % unlexer (const False)++ getLangs = getLangs' readLang+ getLang = getLang' readLang++ readLang :: String -> CGI PGF.Language+ readLang l =+ case PGF.readLanguage l of+ Nothing -> badRequest "Bad language" l+ Just lang | lang `elem` PGF.languages pgf -> return lang+ | otherwise -> badRequest "Unknown language" l++ full :: CGI Bool+ full = maybe False toBool # getInput "full"++-- * Request parameter access and related auxiliary functions++--out = outputJSONP+out t r = do let fmt = formatTime defaultTimeLocale rfc822DateFormat t+ setHeader "Last-Modified" fmt+ outputJSONP r++getInput1 x = nonEmpty # getInput x+nonEmpty (Just "") = Nothing+nonEmpty r = r++textInput :: CGI String+textInput = liftM (maybe "" (urlDecodeUnicode . UTF8.decodeString)) $ getInput "input"++getLangs' readLang i = mapM readLang . maybe [] words =<< getInput i++getLang' readLang i =+ do mlang <- getInput i+ case mlang of+ Just l@(_:_) -> Just # readLang l+ _ -> return Nothing+++limit, depth :: CGI (Maybe Int)+limit = readInput "limit"+depth = readInput "depth"++start :: CGI Int+start = maybe 0 id # readInput "start"++treeopts :: CGI TreeOpts+treeopts = (,) # getBool "trie" % getBool "jsontree"++getBool x = maybe False toBool # getInput x+toBool s = s `elem` ["","yes","true","True"]++missing = badRequest "Missing parameter"+errorMissingId = badRequest "Missing identifier" ""++notFound = throw 404 "Not found"+badRequest = throw 400++throw code msg extra =+ throwCGIError code msg [msg ++(if null extra then "" else ": "++extra)]++format def = maybe def id # getInput "format"++-- * Request implementations++-- Hook for simple extensions of the PGF service+doExternal Nothing input = badRequest "Unknown external command" ""+doExternal (Just cmd) input =+ do liftIO $ logError ("External command: "++cmd)+ cmds <- liftIO $ (fmap lines $ readFile "external_services")+ `catchIOE` const (return [])+ liftIO $ logError ("External services: "++show cmds)+ if cmd `elem` cmds then ok else err+ where+ err = badRequest "Unknown external command" cmd+ ok =+ do let tmpfile1 = "external_input.txt"+ tmpfile2 = "external_output.txt"+ liftIO $ writeFile "external_input.txt" input+ liftIO $ system $ cmd ++ " " ++ tmpfile1 ++ " > " ++ tmpfile2+ liftIO $ removeFile tmpfile1+ r <- outputJSONP =<< liftIO (readFile tmpfile2)+ liftIO $ removeFile tmpfile2+ return r++doLookupMorpho :: PGF -> PGF.Language -> String -> JSValue+doLookupMorpho pgf from input =+ showJSON [makeObj ["lemma".=l,"analysis".=a]|(l,a)<-ms]+ where+ ms = PGF.lookupMorpho (PGF.buildMorpho pgf from) input+++type From = (Maybe PGF.Language,String)+type To = ([PGF.Language],Unlexer)+type TreeOpts = (Bool,Bool) -- (trie,jsontree)++doTranslate :: PGF -> From -> Maybe PGF.Type -> To -> Maybe Int -> TreeOpts -> JSValue+doTranslate pgf (mfrom,input) mcat tos mlimit (trie,jsontree) =+ showJSON+ [makeObj ("from".=from : "brackets".=bs : jsonTranslateOutput po)+ | (from,po,bs) <- parse' pgf input mcat mfrom]+ where+ jsonTranslateOutput output =+ case output of+ PGF.ParseOk trees ->+ addTrie trie trees+++ ["translations".=+ [makeObj (addTree jsontree tree+++ ["linearizations".=+ [makeObj ["to".=to, "text".=text,+ "brackets".=bs]+ | (to,text,bs)<- linearizeAndUnlex pgf tos tree]])+ | tree <- maybe id take mlimit trees]]+ PGF.ParseIncomplete -> ["incomplete".=True]+ PGF.ParseFailed n -> ["parseFailed".=n]+ PGF.TypeError errs -> jsonTypeErrors errs++jsonTypeErrors errs = + ["typeErrors".= [makeObj ["fid".=fid, "msg".=show (PGF.ppTcError err)]+ | (fid,err) <- errs]]++-- used in phrasebook+doTranslateGroup :: PGF -> From -> Maybe PGF.Type -> To -> Maybe Int -> JSValue+doTranslateGroup pgf (mfrom,input) mcat tos mlimit =+ showJSON+ [makeObj ["from".=langOnly (PGF.showLanguage from),+ "to".=langOnly (PGF.showLanguage to),+ "linearizations".=+ [toJSObject (("text",alt) : disamb lg from ts)+ | let lg = length output, (ts,alt) <- output]+ ]+ | + (from,po,bs) <- parse' pgf input mcat mfrom,+ (to,output) <- groupResults [(t, linearizeAndUnlex pgf tos t) | t <- case po of {PGF.ParseOk ts -> maybe id take mlimit ts; _ -> []}]+ ]+ where+ groupResults = Map.toList . foldr more Map.empty . start . collect+ where+ collect tls = [(t,(l,s)) | (t,ls) <- tls, (l,s,_) <- ls, notDisamb l]+ start ls = [(l,[([t],s)]) | (t,(l,s)) <- ls]+ more (l,s) = Map.insertWith (\ [([t],x)] xs -> insertAlt t x xs) l s++ insertAlt t x xs = case xs of+ (ts,y):xs2 -> if x==y then (t:ts,y):xs2 -- if string is there add only tree+ else (ts,y) : insertAlt t x xs2+ _ -> [([t],x)]++ langOnly = reverse . take 3 . reverse++ disamb lg from ts = + if lg < 2 + then [] + else [("tree", "-- " ++ groupDisambs [disambLang from t | t <- ts])]++ groupDisambs = unwords . intersperse "/"++ disambLang f t = + let + disfl lang = PGF.mkCId ("Disamb" ++ lang) + disf = disfl (PGF.showLanguage f) + disfEng = disfl (reverse (drop 3 (reverse (PGF.showLanguage f))) ++ "Eng") + in+ if elem disf (PGF.languages pgf) -- if Disamb f exists use it+ then PGF.linearize pgf disf t + else if elem disfEng (PGF.languages pgf) -- else try DisambEng+ then PGF.linearize pgf disfEng t + else "AST " ++ PGF.showExpr [] t -- else show abstract tree++ notDisamb = (/="Disamb") . take 6 . PGF.showLanguage++doParse :: PGF -> From -> Maybe PGF.Type -> Maybe Int -> TreeOpts -> JSValue+doParse pgf (mfrom,input) mcat mlimit (trie,jsontree) = showJSON $ map makeObj+ ["from".=from : "brackets".=bs : jsonParseOutput po+ | (from,po,bs) <- parse' pgf input mcat mfrom]+ where+ jsonParseOutput output =+ case output of+ PGF.ParseOk trees -> ["trees".=trees']+ ++["jsontrees".=map jsonExpr trees'|jsontree]+ ++addTrie trie trees+ where trees' = maybe id take mlimit trees+ PGF.TypeError errs -> jsonTypeErrors errs+ PGF.ParseIncomplete -> ["incomplete".=True]+ PGF.ParseFailed n -> ["parseFailed".=n]++addTrie trie trees =+ ["trie".=map head (PGF.toTrie (map PGF.toATree trees))|trie]++addTree json tree = "tree".=showTree tree:+ ["jsontree".= jsonExpr tree | json]++doComplete :: PGF -> From -> Maybe PGF.Type -> Maybe Int -> Bool -> JSValue+doComplete pgf (mfrom,input) mcat mlimit full = showJSON+ [makeObj (+ ["from".=from, "brackets".=bs, "text".=s] +++ if full+ then [ "completions" .= Map.elems (Map.mapWithKey (completionInfo pgf) cs) ]+ else [ "completions" .= Map.keys cs ]+ )+ | from <- froms, let (bs,s,cs) = complete' pgf from cat mlimit input]+ where+ froms = maybe (PGF.languages pgf) (:[]) mfrom+ cat = fromMaybe (PGF.startCat pgf) mcat++completionInfo :: PGF -> PGF.Token -> [PGF.CId] -> JSValue+completionInfo pgf token funs =+ makeObj+ ["token".= token+ ,"funs" .= map mkFun (nub funs)+ ]+ where+ mkFun cid = case PGF.functionType pgf cid of+ Just typ ->+ makeObj [ {-"fid".=funid,-} "fun".=cid, "hyps".=hyps', "cat".=cat ]+ where+ (hyps,cat,_es) = PGF.unType typ+ hyps' = [ PGF.showType [] typ | (_,_,typ) <- hyps ]+ Nothing -> makeObj [ "error".=("Function "++show cid++" not found") ] -- shouldn't happen++doLinearize :: PGF -> PGF.Tree -> To -> JSValue+doLinearize pgf tree tos = showJSON+ [makeObj ["to".=to, "text".=text,"brackets".=bs]+ | (to,text,bs) <- linearizeAndUnlex pgf tos tree]++doLinearizes :: PGF -> PGF.Tree -> To -> JSValue+doLinearizes pgf tree (tos,unlex) = showJSON+ [makeObj ["to".=to, "texts".=map unlex texts]+ | (to,texts) <- linearizes' pgf tos tree]+ where+ linearizes' pgf tos tree =+ [(to,lins to (transfer to tree)) | to <- langs]+ where+ langs = if null tos then PGF.languages pgf else tos+ lins to = nub . concatMap (map snd) . PGF.tabularLinearizes pgf to++doLinearizeTabular :: PGF -> PGF.Tree -> To -> JSValue+doLinearizeTabular pgf tree tos = showJSON+ [makeObj ["to".=to,+ "table".=[makeObj ["params".=ps,"texts".=ts]+ | (ps,ts)<-texts]]+ | (to,texts) <- linearizeTabular pgf tos tree]++doRandom :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> To -> CGI JSValue+doRandom pgf mcat mdepth mlimit to =+ liftIO $+ do g <- newStdGen+ let trees = PGF.generateRandomDepth g pgf cat (Just depth)+ return $ showJSON+ [makeObj ["tree".=PGF.showExpr [] tree,+ "linearizations".= doLinearizes pgf tree to]+ | tree <- limit trees]+ where cat = fromMaybe (PGF.startCat pgf) mcat+ limit = take (fromMaybe 1 mlimit)+ depth = fromMaybe 4 mdepth++doGenerate :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> To -> JSValue+doGenerate pgf mcat mdepth mlimit tos =+ showJSON [makeObj ["tree".=PGF.showExpr [] tree,+ "linearizations".=+ [makeObj ["to".=to, "text".=text]+ | (to,text,bs) <- linearizeAndUnlex pgf tos tree]]+ | tree <- limit trees]+ where+ trees = PGF.generateAllDepth pgf cat (Just depth)+ cat = fromMaybe (PGF.startCat pgf) mcat+ limit = take (fromMaybe 1 mlimit)+ depth = fromMaybe 4 mdepth++doGrammar :: (UTCTime,PGF) -> Either IOError (UTCTime,l) -> Maybe (Accept Language) -> CGI CGIResult+doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj+ ["name".=PGF.abstractName pgf,+ "lastmodified".=show t,+ "hasDependencyLabels".=either (const False) (const True) elbls,+ "userLanguage".=selectLanguage pgf macc,+ "startcat".=PGF.showType [] (PGF.startCat pgf),+ "categories".=categories,+ "functions".=functions,+ "languages".=languages]+ where+ t = either (const t1) (max t1 . fst) elbls+ languages =+ [makeObj ["name".= l, + "languageCode".= fromMaybe "" (PGF.languageCode pgf l)]+ | l <- PGF.languages pgf]+ categories = [PGF.showCId cat | cat <- PGF.categories pgf]+ functions = [PGF.showCId fun | fun <- PGF.functions pgf]++outputGraphviz code =+ do fmt <- format "png"+ case fmt of+ "gv" -> outputPlain code+ _ -> outputFPS' fmt =<< liftIO (pipeIt2graphviz fmt code)+ where+ outputFPS' = outputBinary' . mimeType++ mimeType fmt =+ case fmt of+ "png" -> "image/png"+ "gif" -> "image/gif"+ "svg" -> "image/svg+xml"+ -- ...+ _ -> "application/binary"++abstrTree pgf opts tree = PGF.graphvizAbstractTree pgf opts' tree+ where opts' = (not (PGF.noFun opts),not (PGF.noCat opts))++parseTree pgf lang opts tree = PGF.graphvizParseTree pgf lang opts tree++doDepTree (alc,clc) path pgf fmt lang tree =+ do (_,lbls) <- liftIO $ getLabels alc path pgf+ clbls <- liftIO $ getCncLabels clc path pgf lang+ let vis = PGF.graphvizDependencyTree fmt False (Just lbls) clbls pgf lang tree+ if fmt `elem` ["png","gif","gv"]+ then outputGraphviz vis+ else if fmt=="svg"+ then outputText "image/svg+xml" vis+ else outputPlain vis++getLabels lc path pgf =+ msum [readCache' lc path | path<-[{-path1,-}path2,path3]]+ where+ dir = takeDirectory path+ --path1 = dir</> ...labels flag from abstract syntax...+ path2 = dir</>PGF.showCId (PGF.abstractName pgf)<.>"labels"+ path3 = dropExtension path <.> "labels"++getCncLabels lc path pgf lang =+ either fail ok =<< tryIO (readCache lc path2)+ where+ ok ls = do logError ("Found "++show (length ls)++" CncLabels for "++show lang++" in "++path2)+ return (Just ls)+ fail _ = do logError ("No CncLabels for "++show lang++" in "++path2)+ return Nothing+ dir = takeDirectory path+ --path1 = dir</> ...labels flag from concrete syntax...+ path2 = dir</>PGF.showCId lang<.>"labels"+ --path3 = ...++tryIO :: IO a -> IO (Either IOError a)+tryIO = E.try++alignment pgf tree (tos,unlex) = PGF.graphvizAlignment pgf tos' tree+ where tos' = if null tos then PGF.languages pgf else tos++pipeIt2graphviz :: String -> String -> IO BS.ByteString+pipeIt2graphviz fmt code = do+ (Just inh, Just outh, _, pid) <-+ createProcess (proc "dot" ["-T",fmt])+ { std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = Inherit }++ hSetBinaryMode outh True+ hSetEncoding inh utf8++ -- fork off a thread to start consuming the output+ output <- BS.hGetContents outh+ outMVar <- newEmptyMVar+ _ <- forkIO $ E.evaluate (BS.length output) >> putMVar outMVar ()++ -- now write and flush any input+ hPutStr inh code+ hFlush inh+ hClose inh -- done with stdin++ -- wait on the output+ takeMVar outMVar+ hClose outh++ -- wait on the process+ ex <- waitForProcess pid++ case ex of+ ExitSuccess -> return output+ ExitFailure r -> fail ("pipeIt2graphviz: (exit " ++ show r ++ ")")++browse1json pgf id pn = makeObj . maybe [] obj $ PGF.browse pgf id+ where+ obj (def,ps,cs) = if pn then (baseobj ++ pnames) else baseobj+ where+ baseobj = ["def".=def, "producers".=ps, "consumers".=cs]+ pnames = ["printnames".=makeObj [(show lang).=PGF.showPrintName pgf lang id | lang <- PGF.languages pgf]]+++doBrowse pgf (Just id) _ _ "json" pn = outputJSONP $ browse1json pgf id pn+doBrowse pgf Nothing _ _ "json" pn =+ outputJSONP $ makeObj ["cats".=all (PGF.categories pgf),+ "funs".=all (PGF.functions pgf)]+ where+ all = makeObj . map one+ one id = PGF.showCId id.=browse1json pgf id pn++doBrowse pgf Nothing cssClass href _ pn = errorMissingId+doBrowse pgf (Just id) cssClass href _ pn = -- default to "html" format+ outputHTML $+ case PGF.browse pgf id of+ Just (def,ps,cs) -> "<PRE>"++annotate def++"</PRE>\n"+++ syntax+++ (if not (null ps)+ then "<BR/>"+++ "<H3>Producers</H3>"+++ "<P>"++annotateCIds ps++"</P>\n"+ else "")+++ (if not (null cs)+ then "<BR/>"+++ "<H3>Consumers</H3>"+++ "<P>"++annotateCIds cs++"</P>\n"+ else "")+++ (if pn+ then "<BR/>"+++ "<H3>Print Names</H3>"+++ "<P>"++annotatePrintNames++"</P>\n"+ else "")+ Nothing -> ""+ where+ syntax = + case PGF.functionType pgf id of+ Just ty -> let (hypos,_,_) = PGF.unType ty+ e = PGF.mkApp id (snd $ mapAccumL mkArg (1,1) hypos)+ rows = ["<TR class=\"my-SyntaxRow\">"+++ "<TD class=\"my-SyntaxLang\">"++PGF.showCId lang++"</TD>"+++ "<TD class=\"my-SyntaxLin\">"++PGF.linearize pgf lang e++"</TD>"+++ "</TR>"+ | lang <- PGF.languages pgf]+ in "<BR/>"+++ "<H3>Syntax</H3>"+++ "<TABLE class=\"my-SyntaxTable\">\n"+++ "<TR class=\"my-SyntaxRow\">"+++ "<TD class=\"my-SyntaxLang\">"++PGF.showCId (PGF.abstractName pgf)++"</TD>"+++ "<TD class=\"my-SyntaxLin\">"++PGF.showExpr [] e++"</TD>"+++ "</TR>\n"+++ unlines rows++"\n</TABLE>"+ Nothing -> ""++ mkArg (i,j) (_,_,ty) = ((i+1,j+length hypos),e)+ where+ e = foldr (\(j,(bt,_,_)) -> PGF.mkAbs bt (PGF.mkCId ('X':show j))) (PGF.mkMeta i) (zip [j..] hypos)+ (hypos,_,_) = PGF.unType ty++ identifiers = PGF.functions pgf ++ PGF.categories pgf++ annotate [] = []+ annotate (c:cs)+ | isIdentInitial c = let (id,cs') = break (not . isIdentChar) (c:cs)+ in (if PGF.mkCId id `elem` identifiers+ then mkLink id+ else if id == "fun" || id == "data" || id == "cat" || id == "def"+ then "<B>"++id++"</B>"+ else id) +++ annotate cs'+ | otherwise = c : annotate cs++ annotateCIds ids = unwords (map (mkLink . PGF.showCId) ids)+ + isIdentInitial c = isAlpha c || c == '_'+ isIdentChar c = isAlphaNum c || c == '_' || c == '\''++ hrefAttr id =+ case href of+ Nothing -> ""+ Just s -> "href=\""++substId id s++"\""++ substId id [] = []+ substId id ('$':'I':'D':cs) = id ++ cs+ substId id (c:cs) = c : substId id cs++ classAttr =+ case cssClass of+ Nothing -> ""+ Just s -> "class=\""++s++"\""++ mkLink s = "<A "++hrefAttr s++" "++classAttr++">"++s++"</A>"+ + annotatePrintNames = "<DL>"++(unwords pns)++"</DL>"+ where pns = ["<DT>"++(show lang)++"</DT><DD>"++(PGF.showPrintName pgf lang id)++"</DD>" | lang <- PGF.languages pgf ]++class ToATree a where + showTree :: a -> String+ toATree :: a -> PGF.ATree a++instance ToATree PGF.Expr where+ showTree = PGF.showExpr []+ toATree = PGF.toATree++-- | Render trees as JSON with numbered functions+jsonExpr e = evalState (expr (toATree e)) 0+ where+ expr e =+ case e of+ PGF.Other e -> return (makeObj ["other".=e])+ PGF.App f es ->+ do js <- mapM expr es+ let children=["children".=js | not (null js)]+ i<-inc+ return $ makeObj (["fun".=f,"fid".=i]++children)++ inc :: State Int Int+ inc = do i <- get; put (i+1); return i++instance JSON PGF.Trie where+ showJSON (PGF.Oth e) = makeObj ["other".=e]+ showJSON (PGF.Ap f [[]]) = makeObj ["fun".=f] -- leaf+-- showJSON (PGF.Ap f [es]) = makeObj ["fun".=f,"children".=es] -- one alternative+ showJSON (PGF.Ap f alts) = makeObj ["fun".=f,"alts".=alts]++instance JSON PGF.CId where+ readJSON x = readJSON x >>= maybe (fail "Bad language.") return . PGF.readLanguage+ showJSON = showJSON . PGF.showLanguage++instance JSON PGF.Expr where+ readJSON x = readJSON x >>= maybe (fail "Bad expression.") return . PGF.readExpr+ showJSON = showJSON . PGF.showExpr []++instance JSON PGF.BracketedString where+ readJSON x = return (PGF.Leaf "")+ showJSON (PGF.Bracket cat fid index fun _ bs) =+ makeObj ["cat".=cat, "fid".=fid, "index".=index, "fun".=fun, "children".=bs]+ showJSON (PGF.Leaf s) = makeObj ["token".=s]++-- * PGF utilities+{-+cat :: PGF -> Maybe PGF.Type -> PGF.Type+cat pgf mcat = fromMaybe (PGF.startCat pgf) mcat+-}+parse' :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> [(PGF.Language,PGF.ParseOutput,PGF.BracketedString)]+parse' pgf input mcat mfrom = + [(from,po,bs) | from <- froms, (po,bs) <- [PGF.parse_ pgf from cat Nothing input]]+ where froms = maybe (PGF.languages pgf) (:[]) mfrom+ cat = fromMaybe (PGF.startCat pgf) mcat++complete' :: PGF -> PGF.Language -> PGF.Type -> Maybe Int -> String+ -> (PGF.BracketedString, String, Map.Map PGF.Token [PGF.CId])+complete' pgf from typ mlimit input =+ let (ws,prefix) = tokensAndPrefix input+ in PGF.complete pgf from typ (unwords ws) prefix+ where+ tokensAndPrefix :: String -> ([String],String)+ tokensAndPrefix s | not (null s) && isSpace (last s) = (ws, "")+ | null ws = ([],"")+ | otherwise = (init ws, last ws)+ where ws = words s+++transfer lang = if "LaTeX" `isSuffixOf` show lang+ then fold -- OpenMath LaTeX transfer+ else id++-- | tabulate all variants and their forms+linearizeTabular+ :: PGF -> To -> PGF.Tree -> [(PGF.Language,[(String,[String])])]+linearizeTabular pgf (tos,unlex) tree =+ [(to,lintab to (transfer to tree)) | to <- langs]+ where+ langs = if null tos then PGF.languages pgf else tos+ lintab to t = [(p,map unlex (nub [t|(p',t)<-vs,p'==p]))|p<-ps]+ where+ ps = nub (map fst vs)+ vs = concat (PGF.tabularLinearizes pgf to t)++linearizeAndUnlex pgf (mto,unlex) tree =+ [(to,s,bss) | to<-langs,+ let bss = PGF.bracketedLinearize pgf to (transfer to tree)+ s = unlex . unwords $ concatMap PGF.flattenBracketedString bss]+ where+ langs = if null mto then PGF.languages pgf else mto++selectLanguage :: PGF -> Maybe (Accept Language) -> PGF.Language+selectLanguage pgf macc = case acceptable of+ [] -> case PGF.languages pgf of+ [] -> error "No concrete syntaxes in PGF grammar."+ l:_ -> l+ Language c:_ -> fromJust (langCodeLanguage pgf c)+ where langCodes = mapMaybe (PGF.languageCode pgf) (PGF.languages pgf)+ acceptable = negotiate (map Language langCodes) macc++langCodeLanguage :: PGF -> String -> Maybe PGF.Language+langCodeLanguage pgf code = listToMaybe [l | l <- PGF.languages pgf, PGF.languageCode pgf l == Just code]++-- * General utilities++infixl 2 #,%++f .= v = (f,showJSON v)+f # x = fmap f x+f % x = ap f x++--cleanFilePath :: FilePath -> FilePath+--cleanFilePath = takeFileName
@@ -0,0 +1,51 @@+module RunHTTP(runHTTP,Options(..),cgiHandler) where+import Network.URI(uriPath,uriQuery)+import CGI(ContentType(..))+import CGI(CGIResult(..),CGIRequest(..),Input(..),+ Headers,HeaderName(..))+import CGI(runCGIT)+import Network.Shed.Httpd(initServer,Request(..),Response(..))+import qualified Data.ByteString.Lazy.Char8 as BS(pack,unpack)+import qualified Data.Map as M(fromList)+import URLEncoding(decodeQuery)++data Options = Options { documentRoot :: String, port :: Int } deriving Show++runHTTP (Options root port) = initServer port . cgiHandler root++cgiHandler root h = fmap httpResp . runCGIT h . cgiReq root++httpResp :: (Headers,CGIResult) -> Response+httpResp (hdrs,r) = Response code (map name hdrs) (body r)+ where+ code = maybe 200 (read.head.words) (lookup (HeaderName "Status") hdrs)+ body CGINothing = ""+ body (CGIOutput s) = BS.unpack s++ name (HeaderName n,v) = (n,v)++cgiReq :: String -> Request -> CGIRequest+cgiReq root (Request method uri hdrs body) = CGIRequest vars inputs body'+ where+ vars = M.fromList [("REQUEST_METHOD",method),+ ("REQUEST_URI",show uri),+ ("SCRIPT_FILENAME",root++uriPath uri),+ ("QUERY_STRING",qs),+ ("HTTP_ACCEPT_LANGUAGE",al)]+ qs = case uriQuery uri of+ '?':'&':s -> s -- httpd-shed bug workaround+ '?':s -> s+ s -> s+ al = maybe "" id $ lookup "Accept-Language" hdrs+-- inputs = map input $ queryToArguments $ fixplus qs -- assumes method=="GET"+ inputs = map input $ decodeQuery qs -- assumes method=="GET"+ body' = BS.pack body++ input (name,val) = (name,Input (BS.pack val) Nothing plaintext)+ plaintext = ContentType "text" "plain" []+{-+ fixplus = concatMap decode+ where+ decode '+' = "%20" -- httpd-shed bug workaround+ decode c = [c]+-}
@@ -0,0 +1,26 @@+module ServeStaticFile where+import System.FilePath+import System.Directory(doesDirectoryExist)+import CGI(setHeader,outputFPS,liftIO)+import qualified Data.ByteString.Lazy.Char8 as BS++serveStaticFile path =+ do b <- liftIO $ doesDirectoryExist path+ let path' = if b then path </> "index.html" else path+ serveStaticFile' path'++serveStaticFile' path =+ do setHeader "Content-Type" (contentTypeFromExt (takeExtension path))+ outputFPS =<< liftIO (BS.readFile path)++contentTypeFromExt ext =+ case ext of+ ".html" -> "text/html"+ ".htm" -> "text/html"+ ".xml" -> "text/xml"+ ".txt" -> "text/plain"+ ".css" -> "text/css"+ ".js" -> "text/javascript"+ ".png" -> "image/png"+ ".jpg" -> "image/jpg"+ _ -> "application/octet-stream"
@@ -0,0 +1,91 @@+{-# OPTIONS_GHC -fwarn-unused-imports #-}++import Control.Monad(when)+import System.Directory(createDirectoryIfMissing,doesFileExist,+ getDirectoryContents,copyFile,removeFile)+import System.FilePath((</>))+import System.Process(system)+import System.Exit(ExitCode(..))++import Distribution.Simple+import Distribution.Simple.Setup+import Distribution.Simple.LocalBuildInfo(datadir,buildDir,absoluteInstallDirs)++main :: IO ()+main = defaultMainWithHooks simpleUserHooks{ postInst = instWWW+ , postCopy = copyWWW+ }+--------------------------------------------------------------------------------+-- To test the GF web service and minibar, use "cabal install" (or+-- "runhaskell Setup.hs install") to install the program pgf-http, the+-- example grammars listed below, and the minibar. Then start the server with+-- the command "pgf-http" and open http://localhost:41296/minibar/minibar.html+-- in your web browser (Firefox, Safari, Opera or Chrome).++example_grammars =+ -- (pgf, tmp, src)+ [("Foods.pgf","foods",+ ".."</>".."</>"contrib"</>"summerschool"</>"foods"</>"Foods???.gf"),+ ("Letter.pgf","letter",+ ".."</>".."</>"examples"</>"letter"</>"Letter???.gf")]++minibar_src = ".."</>"www"</>"minibar"++--------------------------------------------------------------------------------+instWWW args flags pki lbi = setupWWW args dest pki lbi+ where+ dest = NoCopyDest++copyWWW args flags pki lbi = setupWWW args dest pki lbi+ where+ dest = case copyDest flags of+ NoFlag -> NoCopyDest+ Flag d -> d++setupWWW args dest pkg lbi =+ do mapM_ (createDirectoryIfMissing True) [grammars_dir,minibar_dir]+ mapM_ build_pgf example_grammars+ copy_minibar+ create_root_index+ where+ grammars_dir = www_dir </> "grammars"+ minibar_dir = www_dir </> "minibar"+ www_dir = datadir (absoluteInstallDirs pkg lbi dest) </> "www"+ gfo_dir = buildDir lbi </> "gfo"++ build_pgf (pgf,tmp,src) =+ do createDirectoryIfMissing True tmp_dir+ execute cmd+ copyFile pgf (grammars_dir</>pgf)+ removeFile pgf+ where+ tmp_dir = gfo_dir</>tmp+ cmd = "gf -make -s -optimize-pgf --gfo-dir="++tmp_dir+++ -- " --output-dir="++grammars_dir++ -- has no effect?!+ " "++src++ copy_minibar =+ do files <- getDirectoryContents minibar_src+ mapM_ copy files+ where+ copy file =+ do isFile <- doesFileExist src + when isFile $ copyFile src (minibar_dir</>file)+ where+ src = minibar_src</>file++ create_root_index = writeFile (www_dir</>"index.html") index_html++ index_html = "<h1>PGF service</h1>\n<h2>Available demos</h2>\n"+ ++"<ul><li><a href=\"minibar/minibar.html\">Minibar</a></ul>"+ ++"Additional grammars can be installed in"+ ++"<blockquote><code>"++grammars_dir++"</code></blockquote>"+ ++"<a href=\"http://www.grammaticalframework.org/\">"+ ++"Grammatical Framework</a>"+execute command =+ do putStrLn command+ e <- system command+ case e of+ ExitSuccess -> return ()+ _ -> fail "Command failed"+ return ()
@@ -0,0 +1,61 @@+module URLEncoding(urlDecodeUnicode,decodeQuery) where++import Data.Bits (shiftL, (.|.))+import Data.Char (chr,digitToInt,isHexDigit)++-- | Decode hexadecimal escapes+urlDecodeUnicode :: String -> String+urlDecodeUnicode [] = ""+urlDecodeUnicode ('%':'u':x1:x2:x3:x4:s) + | all isHexDigit [x1,x2,x3,x4] =+ chr ( digitToInt x1 `shiftL` 12 + .|. digitToInt x2 `shiftL` 8+ .|. digitToInt x3 `shiftL` 4+ .|. digitToInt x4) : urlDecodeUnicode s+urlDecodeUnicode ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 =+ chr ( digitToInt x1 `shiftL` 4+ .|. digitToInt x2) : urlDecodeUnicode s+urlDecodeUnicode (c:s) = c : urlDecodeUnicode s++--------------------------------------------------------------------------------++type Query = [(String,String)]++-- | Decode application/x-www-form-urlencoded+decodeQuery :: String -> Query+decodeQuery = map (aboth decode . breakAt '=') . chopList (breakAt '&')++aboth f (x,y) = (f x,f y)++-- | Decode "+" and hexadecimal escapes+decode [] = []+decode ('%':'u':d1:d2:d3:d4:cs)+ | all isHexDigit [d1,d2,d3,d4] = chr(fromhex4 d1 d2 d3 d4):decode cs+decode ('%':d1:d2:cs)+ | all isHexDigit [d1,d2] = chr(fromhex2 d1 d2):decode cs+decode ('+':cs) = ' ':decode cs+decode (c:cs) = c:decode cs++fromhex4 d1 d2 d3 d4 = 256*fromhex2 d1 d2+fromhex2 d3 d4+fromhex2 d1 d2 = 16*digitToInt d1+digitToInt d2+++-- From hbc-library ListUtil ---------------------------------------------------++-- Repeatedly extract (and transform) values until a predicate hold. Return the list of values.+unfoldr :: (a -> (b, a)) -> (a -> Bool) -> a -> [b]+unfoldr f p x | p x = []+ | otherwise = y:unfoldr f p x'+ where (y, x') = f x++chopList :: ([a] -> (b, [a])) -> [a] -> [b]+chopList f l = unfoldr f null l++breakAt :: (Eq a) => a -> [a] -> ([a], [a])+breakAt _ [] = ([], [])+breakAt x (x':xs) =+ if x == x' then+ ([], xs)+ else+ let (ys, zs) = breakAt x xs+ in (x':ys, zs)
@@ -0,0 +1,357 @@+{-# LANGUAGE DeriveDataTypeable, CPP #-}++import PGF (PGF)+import qualified PGF+import Cache+import FastCGIUtils+import URLEncoding++import Data.Maybe+import Network.FastCGI+import Text.JSON+import qualified Data.ByteString.Lazy as BS+import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString)++import Control.Monad+import Control.Exception+import Control.Concurrent(forkIO)+import System.Environment(getArgs)+import System.Time+import System.Locale+import System.FilePath+import Database.HSQL.MySQL+import Database.HSQL.Types(toSqlValue)++logFile :: FilePath+logFile = "content-error.log"+++main :: IO ()+main = do+ args <- getArgs+ case args of+ [] -> do stderrToFile logFile+ cache <- newCache dbConnect++#ifndef mingw32_HOST_OS+ runFastCGIConcurrent' forkIO 100 (cgiMain cache)+#else+ runFastCGI (cgiMain cache)+#endif+ [fpath] -> do c <- dbConnect fpath+ dbInit c++getPath = getVarWithDefault "SCRIPT_FILENAME" ""++cgiMain :: Cache Connection -> CGI CGIResult+cgiMain cache = handleErrors . handleCGIErrors $+ cgiMain' cache =<< getPath++cgiMain' :: Cache Connection -> FilePath -> CGI CGIResult+cgiMain' cache path =+ do c <- liftIO $ readCache cache path+ mb_command <- liftM (liftM (urlDecodeUnicode . UTF8.decodeString)) (getInput "command")+ case mb_command of+ Just "update_grammar"+ -> do mb_pgf <- getFile+ id <- getGrammarId+ name <- getFileName+ descr <- getDescription+ userId <- getUserId+ doUpdateGrammar c mb_pgf id name descr userId+ Just "delete_grammar"+ -> do id <- getGrammarId+ userId <- getUserId+ doDeleteGrammar c id userId+ Just "grammars"+ -> do userId <- getUserId+ doGrammars c userId+ Just "save" -> doSave c =<< getId+ Just "load" -> doLoad c =<< getId+ Just "search" -> doSearch c =<< getQuery+ Just "delete" -> doDelete c =<< getIds+ Just cmd -> throwCGIError 400 "Unknown command" ["Unknown command: " ++ show cmd]+ Nothing -> do mb_uri <- getIdentity+ mb_email <- getEMail+ doLogin c mb_uri mb_email+ where+ getUserId :: CGI (Maybe String)+ getUserId = getInput "userId"++ getId :: CGI (Maybe Int)+ getId = readInput "id"++ getIds :: CGI [Int]+ getIds = fmap (map read) (getMultiInput "id")++ getQuery :: CGI String+ getQuery = fmap (fromMaybe "") (getInput "query")++ getGrammarId :: CGI String+ getGrammarId = do + mb_url <- getInput "url"+ return (maybe "null" (reverse . takeWhile (/='/') . drop 4 . reverse) mb_url)++ getFile :: CGI (Maybe BS.ByteString)+ getFile = do+ getInputFPS "file"++ getFileName :: CGI String+ getFileName = do+ mb_name0 <- getInput "name"+ let mb_name | mb_name0 == Just "" = Nothing+ | otherwise = mb_name0+ mb_file <- getInputFilename "file"+ return (fromMaybe "" (mb_name `mplus` mb_file))++ getDescription :: CGI String+ getDescription = fmap (fromMaybe "") (getInput "description")++ getIdentity :: CGI (Maybe String)+ getIdentity = getInput "openid.identity"++ getEMail :: CGI (Maybe String)+ getEMail = getInput "openid.ext1.value.email"+++doLogin c mb_uri mb_email = do+ path <- scriptName+ r <- liftIO $ handleSql (return . Left) $ do+ s <- query c ("call getUserId("++toSqlValue mb_uri++","++toSqlValue mb_email++")")+ [id] <- collectRows getUserId s+ return (Right id)+ case r of+ Right mb_id -> outputHTML (startupHTML mb_id mb_uri mb_email (Just path))+ Left e -> throwCGIError 400 "Login failed" (lines (show e))+ where+ getUserId s = do+ id <- getFieldValueMB s "userId"+ return (id :: Maybe Int)++doGrammars c mb_userId = do+ path <- scriptName+ r <- liftIO $ handleSql (return . Left) $ do+ s <- query c ("call getGrammars("++toSqlValue mb_userId++")")+ rows <- collectRows (getGrammar path) s+ return (Right rows)+ case r of+ Right rows -> outputJSONP rows+ Left e -> throwCGIError 400 "Loading failed" (lines (show e))+ where+ getGrammar path s = do+ id <- getFieldValue s "id"+ name <- getFieldValue s "name"+ description <- getFieldValue s "description"+ return $ toJSObject [ ("url", showJSON (dropExtension path ++ '/':addExtension (show (id :: Int)) "pgf"))+ , ("name", showJSON (name :: String))+ , ("description", showJSON (description :: String))+ ]++doUpdateGrammar c mb_pgf id name descr mb_userId = do+ r <- liftIO $ handleSql (return . Left) $ do+ s <- query c ("call updateGrammar("++id++","++toSqlValue name++","++toSqlValue descr++","++toSqlValue mb_userId++")")+ [id] <- collectRows (\s -> getFieldValue s "id") s+ return (Right id)+ nid <- case r of+ Right id -> return (id :: Int)+ Left e -> throwCGIError 400 "Saving failed" (lines (show e))+ path <- pathTranslated+ case mb_pgf of+ Just pgf -> if pgf /= BS.empty+ then liftIO (BS.writeFile (dropExtension path </> addExtension (show nid) "pgf") pgf)+ else if id == "null"+ then throwCGIError 400 "Grammar update failed" []+ else return ()+ Nothing -> return ()+ outputHTML ""++doDeleteGrammar c id mb_userId = do+ r <- liftIO $ handleSql (return . Left) $ do+ execute c ("call deleteGrammar("++id++","++toSqlValue mb_userId++")")+ return (Right "")+ case r of+ Right x -> outputJSONP ([] :: [(String,String)])+ Left e -> throwCGIError 400 "Saving failed" (lines (show e))++doSave c mb_id = do+ body <- getBody+ r <- liftIO $ handleSql (return . Left) $ do+ s <- query c ("call saveDocument("++toSqlValue mb_id++","++toSqlValue body++")")+ [id] <- collectRows (\s -> getFieldValue s "id") s+ return (Right id)+ case r of+ Right id -> outputJSONP (toJSObject [("id", id :: Int)])+ Left e -> throwCGIError 400 "Saving failed" (lines (show e))++doLoad c Nothing = throwCGIError 400 "Loading failed" ["Missing ID"]+doLoad c (Just id) = do+ r <- liftIO $ handleSql (return . Left) $ do+ s <- query c ("SELECT id,title,created,modified,content\n"+++ "FROM Documents\n"+++ "WHERE id="++toSqlValue id)+ rows <- collectRows getDocument s+ return (Right rows)+ case r of+ Right [row] -> outputJSONP row+ Right _ -> throwCGIError 400 "Missing document" ["ID="++show id]+ Left e -> throwCGIError 400 "Loading failed" (lines (show e))+ where+ getDocument s = do+ id <- getFieldValue s "id"+ title <- getFieldValue s "title"+ created <- getFieldValue s "created" >>= pt+ modified <- getFieldValue s "modified" >>= pt+ content <- getFieldValue s "content"+ return $ toJSObject [ ("id", showJSON (id :: Int))+ , ("title", showJSON (title :: String))+ , ("created", showJSON (created :: String))+ , ("modified", showJSON (modified :: String))+ , ("content", showJSON (content :: String))+ ]++doSearch c q = do+ r <- liftIO $ handleSql (return . Left) $ do+ s <- query c ("SELECT id,title,created,modified\n"+++ "FROM Documents"+++ if null q+ then ""+ else "\nWHERE MATCH(content) AGAINST ("++toSqlValue q++" IN BOOLEAN MODE)")+ rows <- collectRows getDocument s+ return (Right rows)+ case r of+ Right rows -> outputJSONP rows+ Left e -> throwCGIError 400 "Saving failed" (lines (show e))+ where+ getDocument s = do+ id <- getFieldValue s "id"+ title <- getFieldValue s "title"+ created <- getFieldValue s "created" >>= pt+ modified <- getFieldValue s "modified" >>= pt+ return $ toJSObject [ ("id", showJSON (id :: Int))+ , ("title", showJSON (title :: String))+ , ("created", showJSON (created :: String))+ , ("modified", showJSON (modified :: String))+ ]+ +pt ct = liftM (formatCalendarTime defaultTimeLocale "%d %b %Y") (toCalendarTime ct)++doDelete c ids = do+ liftIO $+ inTransaction c $ \c ->+ mapM_ (\id -> execute c ("DELETE FROM Documents WHERE id = "++toSqlValue id)) ids+ outputJSONP (toJSObject ([] :: [(String,String)]))++dbConnect fpath = do+ [host,db,user,pwd] <- fmap words $ readFile fpath+ connect host db user pwd++startupHTML mb_id mb_uri mb_email mb_path = unlines [+ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">",+ "<html>",+ " <head>",+ " <meta http-equiv=\"content-type\" content=\"text/html; charset=UTF-8\">",+ " <title>Editor</title>",+ " <script type=\"text/javascript\" language=\"javascript\" src=\"org.grammaticalframework.ui.gwt.EditorApp/org.grammaticalframework.ui.gwt.EditorApp.nocache.js\"></script>",+ " </head>",+ " <body onload=\"window.__gfInit = new Object(); "+++ maybe "" (\id -> "window.__gfInit.userId = "++show id++"; ") mb_id+++ maybe "" (\uri -> "window.__gfInit.userURI = '"++uri++"'; ") mb_uri+++ maybe "" (\email -> "window.__gfInit.userEMail = '"++email++"'; ") mb_email+++ maybe "" (\path -> "window.__gfInit.contentURL = '"++path++"'; ") mb_path+++ "\">",+ " <iframe src=\"javascript:''\" id=\"__gwt_historyFrame\" tabIndex='-1' style=\"position:absolute;width:0;height:0;border:0\"></iframe>",+ " </body>",+ "</html>"]++dbInit c = + handleSql (fail . show) $ do+ inTransaction c $ \c -> do+ execute c "DROP TABLE IF EXISTS GrammarUsers"+ execute c "DROP TABLE IF EXISTS Users"+ execute c "DROP TABLE IF EXISTS Grammars"+ execute c "DROP TABLE IF EXISTS Documents"+ execute c ("CREATE TABLE Users"+++ " (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY,\n"+++ " identity VARCHAR(256) NOT NULL,\n"+++ " email VARCHAR(128) NOT NULL,\n"+++ " UNIQUE INDEX (identity))")+ execute c ("CREATE TABLE Grammars"+++ " (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY,"+++ " name VARCHAR(64) NOT NULL,\n"+++ " description VARCHAR(512) NOT NULL,\n"+++ " created TIMESTAMP NOT NULL DEFAULT 0,\n"+++ " modified TIMESTAMP NOT NULL DEFAULT 0)")+ execute c ("CREATE TABLE Documents"+++ " (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY,"+++ " title VARCHAR(256) NOT NULL,\n"+++ " created TIMESTAMP NOT NULL DEFAULT 0,\n"+++ " modified TIMESTAMP NOT NULL DEFAULT 0,\n"+++ " content TEXT NOT NULL,\n"+++ " FULLTEXT INDEX (content)) TYPE=MyISAM")+ execute c ("CREATE TABLE GrammarUsers"+++ " (userId INTEGER NOT NULL,\n"+++ " grammarId INTEGER NOT NULL,\n"+++ " flags INTEGER NOT NULL,\n"+++ " PRIMARY KEY (userId, grammarId),\n"+++ " FOREIGN KEY (userId) REFERENCES Users(id) ON DELETE CASCADE,\n"+++ " FOREIGN KEY (grammarId) REFERENCES Grammars(id) ON DELETE RESTRICT)")+ execute c "DROP PROCEDURE IF EXISTS saveDocument"+ execute c ("CREATE PROCEDURE saveDocument(IN id INTEGER, content TEXT)\n"+++ "BEGIN\n"+++ " IF id IS NULL THEN\n"+++ " INSERT INTO Documents(title,content,created,modified) VALUES (content,content,NOW(),NOW());\n"+++ " SELECT LAST_INSERT_ID() as id;\n"+++ " ELSE\n"+++ " UPDATE Documents d SET content = content, modified=NOW() WHERE d.id = id;\n"+++ " select id;\n"+++ " END IF;\n"+++ "END")+ execute c "DROP PROCEDURE IF EXISTS updateGrammar"+ execute c ("CREATE PROCEDURE updateGrammar(IN id INTEGER, name VARCHAR(64), description VARCHAR(512), userId INTEGER)\n"+++ "BEGIN\n"+++ " IF id IS NULL THEN\n"+++ " INSERT INTO Grammars(name,description,created,modified) VALUES (name,description,NOW(),NOW());\n"+++ " SET id = LAST_INSERT_ID();\n"+++ " INSERT INTO GrammarUsers(grammarId,userId,flags) VALUES (id,userId,0);\n"+++ " ELSE\n"+++ " UPDATE Grammars gr SET name = name, description=description, modified=NOW() WHERE gr.id = id;\n"+++ " END IF;\n"+++ " SELECT id;\n"+++ "END")+ execute c "DROP PROCEDURE IF EXISTS deleteGrammar"+ execute c ("CREATE PROCEDURE deleteGrammar(IN aGrammarId INTEGER, aUserId INTEGER)\n"+++ "BEGIN\n"+++ " DECLARE deleted INTEGER;\n"+++ " DELETE FROM GrammarUsers\n"+++ " WHERE grammarId = aGrammarId AND userId = aUserId;\n"+++ " IF NOT EXISTS(SELECT * FROM GrammarUsers gu WHERE gu.grammarId = aGrammarId) THEN\n"+++ " DELETE FROM Grammars WHERE id = aGrammarId;\n"+++ " SET deleted = 1;\n"+++ " ELSE\n"+++ " SET deleted = 0;\n"+++ " END IF;\n"+++ " SELECT deleted;\n"+++ "END")+ execute c "DROP PROCEDURE IF EXISTS getGrammars"+ execute c ("CREATE PROCEDURE getGrammars(IN userId INTEGER)\n"+++ "BEGIN\n"+++ " SELECT g.id,g.name,g.description\n"+++ " FROM Grammars g JOIN GrammarUsers gu ON g.id = gu.grammarId\n"+++ " WHERE gu.userId = userId\n"+++ " ORDER BY g.name;\n"+++ "END")+ execute c "DROP PROCEDURE IF EXISTS getUserId"+ execute c ("CREATE PROCEDURE getUserId(identity VARCHAR(256), email VARCHAR(128))\n"+++ "BEGIN\n"+++ " DECLARE userId INTEGER;\n"+++ " IF identity IS NULL OR email IS NULL THEN\n"+++ " SET userId = NULL;\n"+++ " ELSE\n"+++ " SELECT id INTO userId FROM Users u WHERE u.identity = identity;\n"+++ " IF userId IS NULL THEN\n"+++ " INSERT INTO Users(identity, email) VALUES (identity, email);\n"+++ " SET userId = LAST_INSERT_ID();\n"+++ " END IF;\n"+++ " END IF;\n"+++ " SELECT userId;\n"+++ "END")
@@ -0,0 +1,88 @@+import GF.Compile+import GF.Compile.Rename (renameSourceTerm)+import GF.Compile.Concrete.Compute (computeConcrete)+import GF.Compile.Concrete.TypeCheck (inferLType)+import GF.Data.Operations+import GF.Grammar+import GF.Grammar.Parser+import GF.Infra.Option+import GF.Infra.UseIO+import GF.Infra.Modules (greatestResource)+import GF.Infra.CheckM+import GF.Text.UTF8++import Network.FastCGI+import Text.JSON+import Text.PrettyPrint+import qualified Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString)+import Data.ByteString.Char8 as BS++import Control.Monad+import System.Environment+import System.FilePath++import Cache+import FastCGIUtils+import URLEncoding++-- FIXME !!!!!!+grammarFile :: FilePath+grammarFile = "/usr/local/share/gf-3.1/lib/alltenses/ParadigmsFin.gfo"++grammarPath :: FilePath+grammarPath = "/usr/local/share/gf-3.1/lib/prelude"++main :: IO ()+main = do initFastCGI+ r <- newCache readGrammar+ loopFastCGI (handleErrors (handleCGIErrors (fcgiMain r)))++fcgiMain :: Cache SourceGrammar -> CGI CGIResult+fcgiMain cache = liftIO (readCache cache grammarFile) >>= cgiMain++readGrammar :: FilePath -> IO SourceGrammar+readGrammar file = + do let opts = concatOptions [modifyFlags $ \fs -> fs { optVerbosity = Quiet },+ modifyFlags $ \fs -> fs { optLibraryPath = [grammarPath] }]+ mgr <- appIOE $ batchCompile opts [file]+ err (fail "Grammar loading error") return mgr++cgiMain :: SourceGrammar -> CGI CGIResult+cgiMain sgr =+ do path <- pathInfo+ json <- case path of+ "/eval" -> do mjson <- return (doEval sgr) `ap` getTerm+ err (throwCGIError 400 "Evaluation error" . (:[])) return mjson+ _ -> throwCGIError 404 "Not Found" ["Resource not found: " ++ path]+ outputJSON json+ where+ getTerm :: CGI String+ getTerm = do mt <- getInput "term"+ maybe (throwCGIError 400 "No term given" ["No term given"]) (return . urlDecodeUnicode . UTF8.decodeString) mt++doEval :: SourceGrammar -> String -> Err JSValue+doEval sgr t = liftM termToJSValue $ eval sgr t ++termToJSValue :: Term -> JSValue+termToJSValue t =+ showJSON [toJSObject [("name", render name), ("value",render value)] | (name,value) <- ppTermTabular Unqualified t]++eval :: SourceGrammar -> String -> Err Term+eval sgr t = + case runP pExp (BS.pack t) of+ Right t -> do mo <- maybe (Bad "no source grammar in scope") return $ greatestResource sgr+ (t,_) <- runCheck (renameSourceTerm sgr mo t)+ ((t,_),_) <- runCheck (inferLType sgr [] t)+ computeConcrete sgr t+ Left (_,msg) -> fail msg++-- * General CGI and JSON stuff++outputJSON :: JSON a => a -> CGI CGIResult+outputJSON x = do setHeader "Content-Type" "text/json; charset=utf-8"+ outputStrict $ UTF8.encodeString $ encode x++outputStrict :: String -> CGI CGIResult+outputStrict x | x == x = output x+ | otherwise = fail "I am the pope."+
@@ -0,0 +1,16 @@+{-# LANGUAGE CPP #-}+import Control.Concurrent(forkIO)+import Network.FastCGI(runFastCGI,runFastCGIConcurrent')++import PGFService(cgiMain,newPGFCache,stderrToFile,logFile)++main = do stderrToFile logFile+ fcgiMain =<< newPGFCache Nothing+++fcgiMain cache =+#ifndef mingw32_HOST_OS+ runFastCGIConcurrent' forkIO 100 (cgiMain cache)+#else+ runFastCGI (cgiMain cache)+#endif
@@ -0,0 +1,49 @@++import Network.CGI(requestMethod,getVarWithDefault,logCGI,handleErrors,liftIO)+import System.Environment(getArgs)+import System.Directory(getDirectoryContents)+import System.FilePath(takeExtension,takeFileName,takeDirectory,(</>))+ +import RunHTTP(runHTTP,Options(..))+import ServeStaticFile(serveStaticFile)+import PGFService(cgiMain',getPath,stderrToFile,logFile,newPGFCache)+import FastCGIUtils(outputJSONP,handleCGIErrors)++import Paths_gf_server(getDataDir)++main :: IO ()+main = do datadir <- getDataDir+ let defaults = Options { documentRoot = datadir</>"www",+ port = 41296 }+ cache <- newPGFCache+ args <- getArgs+ options <- case args of+ [] -> return defaults+ [port] -> do p <- readIO port+ return defaults{port=p} + putStrLn $ "Starting HTTP server, open http://localhost:"+ ++show (port options)++"/ in your web browser.\n"+ print options+ putStrLn $ "logFile="++logFile+ stderrToFile logFile+ httpMain cache options+++httpMain cache options = runHTTP options (do log ; serve =<< getPath)+ where+ log = do method <- requestMethod+ uri <- getVarWithDefault "REQUEST_URI" "-"+ logCGI $ method++" "++uri++ serve path =+ handleErrors . handleCGIErrors $+ if takeExtension path==".pgf"+ then cgiMain' cache path+ else if takeFileName path=="grammars.cgi"+ then grammarList (takeDirectory path)+ else serveStaticFile path++ grammarList dir =+ do paths <- liftIO $ getDirectoryContents dir+ let pgfs = [path|path<-paths, takeExtension path==".pgf"]+ outputJSONP pgfs
@@ -0,0 +1,122 @@+var gf = new Object();+var pgf_base_url = "pgf";++gf.grammars = function (callback) {+ gf.httpGetJSONP(pgf_base_url, callback);+};++gf.grammar = function (grammar, callback) {+ gf.callFunction(grammar, "", [], callback);+};++gf.parse = function (grammar,input,from,cat,callback) {+ var args = [];+ args["input"] = input;+ args["from"] = from;+ args["cat"] = cat;+ gf.callFunction(grammar, "parse", args, callback);+};++gf.complete = function (grammar,input,from,cat,callback) {+ var args = [];+ args["input"] = input;+ args["from"] = from;+ args["cat"] = cat;+ gf.callFunction(grammar, "complete", args, callback);+};++gf.linearize = function (grammar,tree,to,callback) {+ var args = [];+ args["tree"] = tree;+ args["to"] = to;+ gf.callFunction(grammar, "linearize", args, callback);+};++gf.random = function (grammar,cat,limit,callback) {+ var args = [];+ args["cat"] = cat;+ args["limit"] = limit;+ gf.callFunction(grammar, "random", args, callback);+};++gf.translate = function (grammar,input,from,to,cat,callback) {+ var args = [];+ args["input"] = input;+ args["from"] = from;+ args["to"] = to;+ args["cat"] = cat;+ gf.callFunction(grammar, "translate", args, callback);+};++gf.callFunction = function (grammar, fun, args, callback) {+ var query = "";+ for (var i in args) {+ query += (query == "") ? "?" : "&";+ query += i + "=" + encodeURIComponent(args[i]);+ }+ var url = pgf_base_url + "/" + grammar +"/" + fun + query;++ // FIXME: if same domain, use gf.httpGetText+ gf.httpGetJSONP(url, callback);+}++gf.httpGetJSONP = function (url, callback) { + var script = document.createElement("script");++ if (!window.jsonCallbacks) {+ window.jsonCallbacks = new Array();+ }+ var callbackIndex = window.jsonCallbacks.length;+ window.jsonCallbacks.push(function (output) { + // get rid of the script tag+ document.getElementsByTagName("head")[0].removeChild(script);+ // let this function be garbage-collected+ window.jsonCallbacks[callbackIndex] = null;+ // shrink the array if possible+ while (window.jsonCallbacks.length > 0 && window.jsonCallbacks[window.jsonCallbacks.length-1] == null) {+ window.jsonCallbacks.pop();+ }+ callback(output);+ });+ var callbackName = "jsonCallbacks[" + callbackIndex + "]";++ var questionMarkPos = url.indexOf("?");+ if (questionMarkPos > -1) {+ url += (questionMarkPos < url.length-1) ? "&" : "";+ } else {+ url += "?";+ }+ url += "jsonp=" + callbackName;+ script.setAttribute("src", url);+ script.setAttribute("type", "text/javascript");+ document.getElementsByTagName("head")[0].appendChild(script);+};++gf.httpGetText = function (url, callback) { + var XMLHttpRequestObject = false; ++ if (window.XMLHttpRequest) {+ XMLHttpRequestObject = new XMLHttpRequest();+ } else if (window.ActiveXObject) {+ XMLHttpRequestObject = new ActiveXObject("Microsoft.XMLHTTP");+ }++ if (XMLHttpRequestObject) {+ XMLHttpRequestObject.open("GET", url); ++ XMLHttpRequestObject.onreadystatechange = function () { + if (XMLHttpRequestObject.readyState == 4 && XMLHttpRequestObject.status == 200) { + callback(XMLHttpRequestObject.responseText); + delete XMLHttpRequestObject;+ XMLHttpRequestObject = null;+ } + } ++ XMLHttpRequestObject.send(null); ++ }+};++gf.readJSON = function (text) {+ return eval("("+text+")");+};
@@ -0,0 +1,99 @@+# Run with (with -D for no-daemon)+# /usr/sbin/lighttpd -f lighttpd.conf -D+#++server.modules = (+ "mod_access",+ "mod_fastcgi",+ "mod_accesslog",+ "mod_redirect",+ "mod_cgi"+ )++var.basedir = var.CWD++# John: no longer valid after removing `src/ui` 2018-11-15+server.document-root = basedir + "/../ui/gwt/www"++server.errorlog = basedir + "/error.log"++cgi.assign = ( ".cgi" => "" )+cgi.execute-x-only = "enable"++index-file.names = ( "index.html" )++## set the event-handler (read the performance section in the manual)+# server.event-handler = "freebsd-kqueue" # needed on OS X # Crashes on osx+#server.event-handler = "poll"+server.event-handler = "select"++# mimetype mapping+mimetype.assign = (+ ".gif" => "image/gif",+ ".jpg" => "image/jpeg",+ ".jpeg" => "image/jpeg",+ ".png" => "image/png",+ ".css" => "text/css",+ ".html" => "text/html",+ ".htm" => "text/html",+ ".js" => "text/javascript",+ # default mime type+ "" => "application/octet-stream",+ )++accesslog.filename = basedir + "/access.log"++debug.log-request-header = "disable"+debug.log-response-header = "disable"+debug.log-request-handling = "disable"++$HTTP["host"] =~ "^(.*)$" {+ url.redirect = ( "^/$" => "http://%1/translate/" )+}++fastcgi.debug = 0+fastcgi.server = (".pgf" =>+ ((+ "socket" => basedir + "/" + var.PID + "-pgf.socket",+ "bin-path" => basedir + "/dist/build/pgf-service/pgf-service",+ # Use 2 OS threads (to be able to use 2 cores).+ # Limit heap size to 512 MB.+ "bin-environment" => ("GHCRTS" => "-N2 -M512M"),+ "min-procs" => 1,+ "max-procs" => 1,+ "broken-scriptfilename" => "disable",+ "check-local" => "disable"+ )),+ ".fcgi" =>+ ((+ "socket" => basedir + "/" + var.PID + "-morpho.socket",+# "bin-path" => basedir + "/dist/build/morpho-server/morpho-server",+ "bin-environment" => ("GHCRTS" => "-M512M"),+ "min-procs" => 1,+ "max-procs" => 1,+ "broken-scriptfilename" => "disable",+ "check-local" => "disable"+ ))+ )++## deny access the file-extensions+#+# ~ is for backupfiles from vi, emacs, joe, ...+# .inc is often used for code includes which should in general not be part+# of the document-root+url.access-deny = ( "~", ".inc" )++$HTTP["url"] =~ "\.pdf$" {+ server.range-requests = "disable"+}++##+# which extensions should not be handle via static-file transfer+#+# .php, .pl, .fcgi are most often handled by mod_fastcgi or mod_cgi+static-file.exclude-extensions = ( ".php", ".pl", ".fcgi" )++######### Options that are good to be but not neccesary to be changed #######++## bind to port (default: 80)+server.port = 41296
@@ -0,0 +1,111 @@+<!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>+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />+ <meta name="viewport" content="initial-scale=2.3" />+ <meta name="viewport" content="width=320; initial-scale=1.0; maximum-scale=1.0;" />+ <link rel="stylesheet" type="text/css" href="translator.css" />+ <script type="text/javascript" src="gf-server-jsapi.js"></script>+ <script type="text/javascript" src="translator.js"></script>+ <script type="text/javascript">+ function getGrammar () {+ return document.getElementById('grammar').value;+ }++ function updateTranslation () {+ var input = document.getElementById('inputText').value;+ var fromLang = document.getElementById('fromLang').value;+ var toLang = document.getElementById('toLang').value;+ var output = document.getElementById('translation');++ var callback = function(translation) {+ clearTranslation();+ output.appendChild(formatTranslation(translation));+ };+ gf.translate(getGrammar(), input, fromLang, toLang, '', callback);+ }++ function updateGrammars () {+ gf.grammars(populateGrammars);+ }++ function populateGrammars (grammars) {+ var l = document.getElementById('grammar');+ var langs = grammar.languages;+ for (var i in grammars) {+ addOption(l, grammars[i].name, grammars[i].name);+ }+ updateLanguages();+ }++ function updateLanguages () {+ gf.grammar(getGrammar(), populateLangs);+ }++ function populateLangs (grammar) {+ var f = document.getElementById('fromLang');+ var t = document.getElementById('toLang');+ var langs = grammar.languages;+ for (var i in langs) {+ if (langs[i].canParse) {+ addOption(f, langs[i].name, langs[i].name);+ }+ addOption(t, langs[i].name, langs[i].name);+ }+ }++ function updateCompletion() {+ var input = document.getElementById('inputText').value;+ var fromLang = document.getElementById('fromLang').value;+ var completions = document.getElementById('completion');++// if (document.getElementById('enableCompletion').checked) {+ var callback = function(output) {+ clearCompletion();+ completions.appendChild(formatCompletions(output));+ };+ gf.complete(getGrammar(), input, fromLang, '', callback);+// }+ }++ function update() {+// updateCompletion();+ updateTranslation();+ }++ function clearTranslation() {+ var output = document.getElementById('translation');+ removeChildren(output);+ }++ function clearCompletion() {+ var completions = document.getElementById('completion');+ removeChildren(completions);+ }++ function initialize() {+ updateGrammars();+ }+ </script>+ <title>AJAX GF Translator</title>+ </head>+ <body onload="initialize()">+ <div id="translator">+ <form onsubmit="update(); return false;">+ <p>+ <input type="text" id="inputText" value="" size="50" />+ </p>+ <p>+ <label>Grammar: <select id="grammar" onchange="updateLanguages()"></select></label>+ <label>From: <select id="fromLang" onchange="update()"><option value="" selected="selected">Any language</option></select></label>+ <label>To: <select id="toLang" onchange="update()"><option value="" selected="selected">All languages</option></select></label>+ <input type="button" value="Completions" onclick="updateCompletion()" />+ <input type="submit" value="Translate" />+ </p>+ </form>+ <div id="completion"></div>+ <div id="translation"></div>+ </div>+ </body>+</html>
@@ -0,0 +1,26 @@+module Fold where+import PGF+import Data.Map as M (lookup, fromList)++--import Debug.Trace+++foldable = fromList [(mkCId c, mkCId ("bin_" ++ c)) | c <- ops]+ where ops = words "plus times and or xor cartesian_product intersect union"++fold :: Tree -> Tree+fold t =+ case unApp t of+ Just (i,[x]) ->+ case M.lookup i foldable of+ Just j -> appFold j x+ _ -> mkApp i [fold x]+ Just (i,xs) -> mkApp i $ map fold xs+ _ -> t++appFold :: CId -> Tree -> Tree+appFold j t = + case unApp t of+ Just (i,[t,ts]) | isPre i "Cons" -> mkApp j [fold t, appFold j ts]+ Just (i,[t,s]) | isPre i "Base" -> mkApp j [fold t, fold s]+ where isPre i s = take 4 (show i) == s
@@ -0,0 +1,76 @@+body {+ color: black;+ background-color: white;+ font-family: sans-serif;+}++dl {+ margin: 0;+ padding: 0;+}++dt {+ margin: 0;+ padding: 0;+}++dl dd {+ margin: 0;+ padding: 0;+}++ul {+ margin: 0;+ padding: 0;+}++li {+ list-style-type: none;+ margin: 0;+ padding: 0;+}++/* Translator widget */++#translator {++}++/* Translations */++#translation {+ clear: both; +}++#translation dl {+ border-width: 0 0 1px 0;+ border-style: solid;+ border-color: #c0c0c0;+}++#translation dt {+ display: none;+}+ +#translation dd {+ border-width: 1px 0 0 0;+ border-style: solid;+ border-color: #c0c0c0;+}+++/* Completions */++#completion {+ font-size: 80%;+ color: #c0c0c0;+ white-space: nowrap;+ width: 100%;+ overflow: hidden;+}++#completion li {+ display: inline;+ padding: 0 0.1em;+}+
@@ -0,0 +1,51 @@+function formatTranslation (outputs) {+ var dl1 = document.createElement("dl");+ for (var i in outputs) {+ var o = outputs[i];+ addDefinition(dl1, document.createTextNode(o.to), document.createTextNode(o.text));+ }++ return dl1;+}++function formatCompletions (compls) {+ var ul = document.createElement("ul");+ for (var i in compls) {+ var c = compls[i];+ addItem(ul, document.createTextNode(c.text));+ }+ return ul;+}++/* DOM utilities for specific tags */++function addDefinition (dl, t, d) {+ var dt = document.createElement("dt");+ dt.appendChild(t);+ dl.appendChild(dt);+ var dd = document.createElement("dd");+ dd.appendChild(d);+ dl.appendChild(dd);+}++function addItem (ul, i) {+ var li = document.createElement("li");+ li.appendChild(i);+ ul.appendChild(li);+}++function addOption (select, value, content) {+ var option = document.createElement("option");+ option.value = value;+ option.appendChild(document.createTextNode(content));+ select.appendChild(option);+}++/* General DOM utilities */++/* Removes all the children of a node */+function removeChildren(node) {+ while (node.hasChildNodes()) {+ node.removeChild(node.firstChild);+ }+}
@@ -0,0 +1,43 @@+----------------------------------------------------------------------+-- |+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/16 05:40:50 $ +-- > CVS $Author: peb $+-- > CVS $Revision: 1.4 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module Main (main) where++import LexGF+import Alex+import System++main :: IO ()+main = do+ file1:file2:_ <- getArgs+ s <- readFile file1+ ts <- tokens s+ if file1==file2 then print (length ts) else return () -- make sure file1 is in mem+ writeFile file2 [] -- create file2 or remove its old contents+ alphaConv file2 ts (Pn 1 1 1)++alphaConv :: FilePath -> [Token] -> Posn -> IO ()+alphaConv file (t:ts) p0 = case t of+ PT p (TV s) -> changeId file p0 p s ts+ _ -> putToken file p0 t >>= alphaConv file ts+alphaConv _ _ = putStrLn "Ready."++putToken :: FilePath -> Posn -> Token -> IO Posn+putToken file (Pn _ l0 c0) t@(PT (Pn a l c) _) = do+ let s = prToken t + ns = l - l0+ ls = length s+ replicate ns $ appendFile file '\n'+ replicate (if ns == 0 then c - c0 else c-1) $ putChar ' '+ putStr s + return $ Pn (a + ls) l (c + ls) ts
@@ -0,0 +1,373 @@+----------------------------------------------------------------------+-- |+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/16 05:40:50 $ +-- > CVS $Author: peb $+-- > CVS $Revision: 1.7 $+--+-- produce a HTML document from a list of GF grammar files. AR 6\/10\/2002+--+-- Added @--!@ (NewPage) and @--*@ (Item) 21\/11\/2003+-----------------------------------------------------------------------------++module Main (main) where+++import Data.Char+import Data.List+import System.Process+import System.Directory -- from package directory>=1.2+import System.Environment+import Data.Time -- from package time>=1.5+--import System.Locale -- from package old-locale+--import System.Time -- from package old-time++-- to read files and write a file++main :: IO ()+main = do+ xx <- getArgs+ let + (typ,format,names) = case xx of+ "-latex" : xs -> (0,doc2latex,xs)+ "-htmls" : xs -> (2,doc2html,xs)+ "-txt" : xs -> (3,doc2txt,xs)+ "-txt2" : xs -> (3,doc2txt2,xs)+ "-txthtml": xs -> (4,doc2txt,xs)+ xs -> (1,doc2html,xs)+ if null xx+ then do+ putStrLn welcome+ putStrLn help+ else flip mapM_ names (\name -> do + ss <- readFile name+ time <- modTime name+ let outfile = fileFormat typ name+ writeFile outfile $ format $ pDoc time ss)+ case typ of+ 2 -> + mapM_ (\name -> system $ "htmls " ++ (fileFormat typ name)) names+ 4 ->+ mapM_ (\name -> + system $ "txt2tags -thtml --toc " ++ (fileFormat typ name)) names+ _ -> return ()+ return ()++modTime :: FilePath -> IO ModTime+-- Works with directory>=1.2, time>=1.5+modTime name =+ do zt <- utcToLocalZonedTime =<< getModificationTime name+ let timeFmt = "%Y-%m-%d %H:%M:%S %Z"+ return $ formatTime defaultTimeLocale timeFmt zt+{-+-- Works with directory<1.2, old-time, old-locale+modTime name =+ do+ t <- getModificationTime name+ ct <- toCalendarTime t+ let timeFmt = "%Y-%m-%d %H:%M:%S %Z"+ return $ formatCalendarTime defaultTimeLocale timeFmt ct+-}++welcome = unlines [+ "",+ "gfdoc - a rudimentary GF document generator.",+ "(c) Aarne Ranta (aarne@cs.chalmers.se) 2002 under GNU GPL."+ ]++help = unlines $ [+ "",+ "Usage: gfdoc (-latex|-htmls|-txt|-txthtml) <file>+",+ "",+ "The program operates with lines in GF code, treating them into LaTeX",+ "(flag -latex), to a set of HTML documents (flag -htmls), to a txt2tags file",+ "(flag -txt), to HTML via txt (flag -txthtml), or to one",+ "HTML file (by default). The output is written in a file",+ "whose name is formed from the input file name by replacing its suffix",+ "with html or tex; in case of set of HTML files, the names are prefixed",+ "by 01-, 02-, etc, and each file has navigation links.",+ "",+ "The translation is line by line",+ "depending as follows on how the line begins",+ "",+ " --[Int] heading of level Int", + " -- new paragraph",+ " --! new page (in HTML, recognized by the htmls program)",+ " --. end of document",+ " --*[Text] Text paragraph starting with a bullet",+ " --[Text] Text belongs to text paragraph",+ " [Text] Text belongs to code paragraph",+ " --% (in the end of a line): ignore this line",+ "",+ "Within a text paragraph, text enclosed between certain characters",+ "is treated specially:",+ "",+ " *[Text]* emphasized (boldface)",+ " \"[Text]\" example string (italics)",+ " $[Text]$ example code (courier)",+ "",+ "For other formatting and links, we recommend the txt2tags format."+ ]++fileFormat typ x = body ++ suff where+ body = reverse $ dropWhile (/='.') $ reverse x+ suff = case typ of+ 0 -> "tex"+ _ | typ < 3 -> "html"+ _ -> "txt"++-- the document datatype++data Doc = Doc Title ModTime [Paragraph]++type ModTime = String++type Title = [TextItem]++data Paragraph = + Text [TextItem] -- text line starting with --+ | List [[TextItem]] -- + | Code String -- other text line+ | Item [TextItem] -- bulleted item: line prefixed by --*+ | New -- new paragraph: line consisting of --+ | NewPage -- new parage: line consisting of --!+ | Heading Int [TextItem] -- text line starting with --n where n = 1,2,3,4++data TextItem =+ Str String+ | Emp String -- emphasized, *...*+ | Lit String -- string literal, "..."+ | Inl String -- inlined code, '...'+++-- parse document++pDoc :: ModTime -> String -> Doc+pDoc time s = case dropWhile emptyOrPragma (lines s) of+ ('-':'-':'1':title) : paras -> Doc (pItems title) time (map pPara (grp paras))+ paras -> Doc [] time (map pPara (grp paras))+ where+ grp ss = case ss of+ s : rest | ignore s -> grp rest+ | isEnd s -> []+ | begComment s -> let (s1,s2) = getComment (drop 2 s : rest) + in map ("-- " ++) s1 ++ grp s2 + | isComment s -> s : grp rest+ | all isSpace s -> grp rest+ [] -> []+ _ -> unlines code : grp rest where (code,rest) = span (not . isComment) ss + pPara s = case s of+ '-':'-':d:text | isDigit d -> Heading (read [d]) (pItems text)+ '-':'-':'!':[] -> NewPage+ '-':'-':[] -> New+ '-':'-':'*':text -> Item (pItems (dropWhile isSpace text))+ '-':'-':text -> Text (pItems (dropWhile isSpace text))+ _ -> Code s+ pItems s = case s of+ '*' : cs -> get 1 Emp (=='*') cs+ '"' : cs -> get 1 Lit (=='"') cs+ '$' : cs -> get 1 Inl (=='$') cs+ [] -> []+ _ -> get 0 Str (flip elem "*\"$") s++ get _ _ _ [] = []+ get k con isEnd cs = con beg : pItems (drop k rest) + where (beg,rest) = span (not . isEnd) cs+ + isEnd s = case s of+ '-':'-':'.':_ -> True+ _ -> False++ emptyOrPragma s = all isSpace s || "--#" `isPrefixOf` s++ignore s = case reverse s of+ '%':'-':'-':_ -> True+ _ -> False++-- render in html++doc2html :: Doc -> String+doc2html (Doc title time paras) = unlines $+ tagXML "html" $+ tagXML "body" $+ unwords (tagXML "i" ["Produced by " ++ welcome]) :+ mkTagXML "p" :+ concat (tagXML "h1" [concat (map item2html title)]) :+ empty :+ map para2html paras++para2html :: Paragraph -> String+para2html p = case p of+ Text its -> concat (map item2html its)+ Item its -> mkTagXML "li" ++ concat (map item2html its)+ Code s -> unlines $ tagXML "pre" $ map (indent 2) $ filter (not . ignore) $ + remEmptyLines $ lines $ spec s+ New -> mkTagXML "p"+ NewPage -> mkTagXML "p" ++ "\n" ++ mkTagXML "!-- NEW --"+ Heading i its -> concat $ tagXML ('h':show i) [concat (map item2html its)]++item2html :: TextItem -> String+item2html i = case i of+ Str s -> spec s+ Emp s -> concat $ tagXML "b" [spec s]+ Lit s -> concat $ tagXML "i" [spec s]+ Inl s -> concat $ tagXML "tt" [spec s]++mkTagXML t = '<':t ++ ">"+mkEndTagXML t = mkTagXML ('/':t)+tagXML t ss = mkTagXML t : ss ++ [mkEndTagXML t]++spec = elimLt++elimLt s = case s of+ '<':cs -> "<" ++ elimLt cs+ c :cs -> c : elimLt cs+ _ -> s+++-- render in latex++doc2latex :: Doc -> String+doc2latex (Doc title time paras) = unlines $+ preludeLatex :+ funLatex "title" [concat (map item2latex title)] :+ funLatex "author" [fontLatex "footnotesize" (welcome)] :+ envLatex "document" (+ funLatex "maketitle" [] :+ map para2latex paras) ++para2latex :: Paragraph -> String+para2latex p = case p of+ Text its -> concat (map item2latex its)+ Item its -> "\n\n$\\bullet$" ++ concat (map item2latex its) ++ "\n\n"+ Code s -> unlines $ envLatex "verbatim" $ map (indent 2) $ + remEmptyLines $ lines $ s+ New -> "\n"+ NewPage -> "\\newpage"+ Heading i its -> headingLatex i (concat (map item2latex its))++item2latex :: TextItem -> String+item2latex i = case i of+ Str s -> specl s+ Emp s -> fontLatex "bf" (specl s)+ Lit s -> fontLatex "it" (specl s)+ Inl s -> fontLatex "tt" (specl s)++funLatex :: String -> [String] -> String+funLatex f xs = "\\" ++ f ++ concat ["{" ++ x ++ "}" | x <- xs]++envLatex :: String -> [String] -> [String]+envLatex e ss = + funLatex "begin" [e] :+ ss +++ [funLatex "end" [e]]++headingLatex :: Int -> String -> String+-- for slides+-- headingLatex _ s = funLatex "newone" [] ++ "\n" ++ funLatex "heading" [s] +headingLatex i s = funLatex t [s] where + t = case i of+ 2 -> "section"+ 3 -> "subsection"+ _ -> "subsubsection"++fontLatex :: String -> String -> String+fontLatex f s = "{\\" ++ f ++ " " ++ s ++ "}"++specl = eliml++eliml s = case s of+ '|':cs -> mmath "mid" ++ elimLt cs+ '{':cs -> mmath "\\{" ++ elimLt cs+ '}':cs -> mmath "\\}" ++ elimLt cs+ _ -> s++mmath s = funLatex "mbox" ["$" ++ s ++ "$"]++preludeLatex = unlines $ [+ "\\documentclass[12pt]{article}",+ "\\usepackage{isolatin1}",+ "\\setlength{\\oddsidemargin}{0mm}",+ "\\setlength{\\evensidemargin}{-2mm}",+ "\\setlength{\\topmargin}{-16mm}",+ "\\setlength{\\textheight}{240mm}",+ "\\setlength{\\textwidth}{158mm}",+ "\\setlength{\\parskip}{2mm}",+ "\\setlength{\\parindent}{0mm}"+ ]++-- render in txt2tags+-- as main document (welcome, top-level subtitles)+-- as chapter (no welcome, subtitle level + i)++doc2txt :: Doc -> String+doc2txt (Doc title time paras) = unlines $+ let tit = concat (map item2txt title) in+ tit:+ ("Last update: " ++ time):+ "":+ "% NOTE: this is a txt2tags file.":+ "% Create an html file from this file using:":+ ("% txt2tags " ++ tit):+ "\n":+ concat (["Produced by " ++ welcome]) :+ "\n" :+ empty :+ map (para2txt 0) paras++doc2txt2 :: Doc -> String+doc2txt2 (Doc title time paras) = unlines $+ let tit = concat (map item2txt title) in+ tit:+ "":+ concat (tagTxt (replicate 2 '=') [tit]):+ "\n":+ empty :+ map (para2txt 2) paras++para2txt :: Int -> Paragraph -> String+para2txt j p = case p of+ Text its -> concat (map item2txt its)+ Item its -> "- " ++ concat (map item2txt its)+ Code s -> unlines $ tagTxt "```" $ map (indent 2) $ + remEmptyLines $ lines s+ New -> "\n"+ NewPage -> "\n" ++ "!-- NEW --"+ Heading i its -> + concat $ tagTxt (replicate (i + j) '=') [concat (map item2txt its)]++item2txt :: TextItem -> String+item2txt i = case i of+ Str s -> s+ Emp s -> concat $ tagTxt "**" [spec s]+ Lit s -> concat $ tagTxt "//" [spec s]+ Inl s -> concat $ tagTxt "``" [spec s]++tagTxt t ss = t : ss ++ [t]++++-- auxiliaries++empty = ""++isComment = (== "--") . take 2++begComment = (== "{-") . take 2++getComment ss = case ss of+ "-}":ls -> ([],ls)+ l:ls -> (l : s1, s2) where (s1,s2) = getComment ls+ _ -> ([],[])++indent n = (replicate n ' ' ++)++remEmptyLines = rem False where+ rem prevGood ls = case span empty ls of+ (_ :_, ss@(_ : _)) -> (if prevGood then ("":) else id) $ rem False ss+ (_, []) -> []+ (_, s:ss) -> s : rem True ss + empty = all isSpace
@@ -0,0 +1,61 @@+----------------------------------------------------------------------+-- |+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/05/12 10:03:34 $ +-- > CVS $Author: aarne $+-- > CVS $Revision: 1.9 $+--+-- Compile @HelpFile.hs@ from the text file @HelpFile@.+-----------------------------------------------------------------------------++module Main (main) where++main = do+ s <- readFile "HelpFile"+ let s' = mkHsFile (lines s)+ writeFile "GF/Shell/HelpFile.hs" s'++mkHsFile ss =+ helpHeader +++ "module GF.Shell.HelpFile where\n\n" +++ "import GF.Data.Operations\n\n" +++ "txtHelpFileSummary =\n" +++ " unlines $ map (concat . take 1 . lines) $ paragraphs txtHelpFile\n\n" +++ "txtHelpCommand c =\n" ++ + " case lookup c [(takeWhile (/=',') p,p) | p <- paragraphs txtHelpFile] of\n" +++ " Just s -> s\n" +++ " _ -> \"Command not found.\"\n\n" +++ "txtHelpFile =\n" +++ unlines (map mkOne ss) +++ " []"++mkOne s = " \"" ++ pref s ++ (escs s) ++ "\" ++"+ where + pref (' ':_) = "\\n"+ pref _ = "\\n" ---+ escs [] = []+ escs (c:cs) | elem c "\"\\" = '\\':c:escs cs+ | fromEnum c > 127 = "\\" ++show (fromEnum c)++escs cs+ escs (c:cs) = c:escs cs++helpHeader = unlines [+ "----------------------------------------------------------------------",+ "-- |",+ "-- Module : GF.Shell.HelpFile",+ "-- Maintainer : Aarne Ranta",+ "-- Stability : (stable)",+ "-- Portability : (portable)",+ "--",+ "-- > CVS $Date: 2005/05/12 10:03:34 $", + "-- > CVS $Author: aarne $",+ "-- > CVS $Revision: 1.9 $",+ "--",+ "-- Help on shell commands. Generated from HelpFile by 'make help'.",+ "-- PLEASE DON'T EDIT THIS FILE.",+ "-----------------------------------------------------------------------------",+ "",+ ""+ ]
@@ -0,0 +1,70 @@+----------------------------------------------------------------------+-- |+-- Maintainer : AR+-- Stability : (stable)+-- Portability : (portable)+--+-- > CVS $Date: 2005/04/16 05:40:51 $ +-- > CVS $Author: peb $+-- > CVS $Revision: 1.4 $+--+-- (Description of the module)+-----------------------------------------------------------------------------++module Main (main) where+import Fudgets+import System++import Operations++import Greek (mkGreek)+import Arabic (mkArabic)+import Hebrew (mkHebrew)+import Russian (mkRussian)++-- AR 12/4/2000++main = do+ xx <- getArgs+ (case xx of+ "HELP" : _ -> putStrLn usageWriteF+ "FILE" : file : _ -> do+ str <- readFileIf file+ fudlogueWrite (Just str)+ w:_ -> fudlogueWrite (Just (unwords xx)) + _ -> fudlogueWrite Nothing)++usageWriteF =+ "Usage: WriteF [-H20Mg -A5M] [FILE <filename> | <inputstring> | HELP]" +++++ "Without arguments, an interactive display is opened." +++++ "Prefix your string with / for Greek, - for Arabic, + for Hebrew, _ for Russian."++fudlogueWrite mbstr = + fudlogue $+ shellF "Unicode Output" (writeF mbstr >+< quitButtonF)++writeF Nothing = writeOutputF >==< writeInputF+writeF (Just str) = startupF [str] writeOutputF ++displaySizeP = placerF (spacerP (sizeS (Point 440 500)) verticalP)++writeOutputF = + displaySizeP (moreF' (setFont myFont))+--- displaySizeP (scrollF (displayF' (setFont myFont)))+--- >=^<+--- vboxD' 0 . map g + >==< + mapF (map mkUnicode . lines)++writeInputF = stringInputF' (setShowString mkUnicode . setFont myFont)++mkUnicode s = case s of+ '/':cs -> mkGreek cs+ '+':cs -> mkHebrew cs+ '-':cs -> mkArabic cs+ '_':cs -> mkRussian cs+ _ -> s++myFont = "-mutt-clearlyu-medium-r-normal--17-120-100-100-p-101-iso10646-1"+--- myFont = "-arabic-newspaper-medium-r-normal--32-246-100-100-p-137-iso10646-1"+--- myFont = "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1"
@@ -0,0 +1,21 @@+Aarne Ranta 21/9/2006++Interpreter for ready-made translation lists. Supports+translation, random generation, and translation quiz.++To compile:++ g++ -o gfex gfex.cpp++To use:++ ./gfex peace.gft++To produce a gft file in GF: ++ gt | tb -unlexer=unwords -compact | wf foo.gft++The format uses encoding of words as integers, which+gives a memory-efficient run-time program. Also the+treebank file size is about 1/3 of sentences stored+in words.
@@ -0,0 +1,20 @@+14 3 4 2+English Swedish German++I Sie du ich ihr jag ni schlafe schlafen schlafst schlaft sleep sover you++1 12 +14 12 +14 12 +14 12 ++6 13 +3 13 +7 13 +7 13 ++4 8 +3 10 +5 11 +2 9 +
@@ -0,0 +1,340 @@+#include <algorithm>+#include <cctype>+#include <cstdlib>+#include <fstream>+#include <iomanip>+#include <ios>+#include <iostream>+#include <iterator>+#include <map>+#include <set>+#include <stdexcept>+#include <string>+#include <vector>+#include <list>+#include <time.h>+#include <stdio.h>+ +using std::cin ;+using std::cout ;+using std::endl ;+using std::equal ;+using std::find_if ;+using std::getline ;+using std::istream ;+using std::logic_error ;+using std::map ;+using std::max ;+using std::multimap ;+using std::rand ;+using std::set ;+using std::setw ;+using std::sort ;+using std::streamsize ;+using std::string ;+using std::vector ;+using std::list ;+++typedef vector<string> Wordlist ;+typedef map<string,int> Lexicon ;+typedef vector<int> Sentence ;+typedef int Tree ;+typedef vector<Sentence> Linearizer ;+typedef map<Sentence,vector<Tree> > Parser ;++// interpreter of compact translation lists, generated in GF by+// tb -compact. AR 22/9/2006++// map words to indices+Sentence getSentence(Lexicon& lexicon, const vector<string>& ws, int mx)+{++ Sentence sent ;+ int wc = 0 ;+ for (vector<string>::const_iterator i = ws.begin() ; i != ws.end() ; ++i) {+ sent.push_back(lexicon[*i]) ;+ ++ wc ;+ }+ for (int i = wc ; i != mx ; ++i) sent.push_back(0) ;++ //debug+ // for (Sentence::const_iterator i = sent.begin() ; i != sent.end() ; ++i)+ // cout << *i << " " ; + cout << endl ;++ return sent ;+}++// render a sentence in words+void putSentence(const Wordlist& wlist, const Sentence sent)+{+ for (Sentence::const_iterator i = sent.begin() ; i != sent.end() ; ++i) {+ if (*i != 0) + cout << wlist[*i-1] << " " ;+ }+ cout << endl ;++}+++// Haskell words+bool space(char c) +{+ return isspace(c) ;+}+bool not_space(char c) +{+ return !space(c) ;+}++vector<string> words(const string& s) +{+ typedef string::const_iterator iter ;+ vector<string> ws ;+ iter i = s.begin() ;+ while (i != s.end()) {+ // ignore space+ i = find_if(i, s.end(), not_space) ;+ // collect characters until space+ iter j = find_if(i, s.end(), space) ;++ // add the string to the vector+ if (i != s.end())+ ws.push_back(string(i,j)) ;+ i = j ;+ }+ return ws ;+}+++// the run-time grammar structure+struct Grammar {+ vector<string> langnames ;+ int nwords ;+ int nlangs ;+ int nsents ;+ int smaxlen ;+ Wordlist wlist ;+ Lexicon lexicon ;+ vector<Linearizer> lin ;+ vector<Parser> parser ;+} ;+++// read grammar from file or stdio+Grammar readGrammar (istream& in)+{+ Grammar g ;++ in >> g.nwords >> g.nlangs >> g.nsents >> g.smaxlen ;++ string tok ;++ for (int ls = 0 ; ls != g.nlangs ; ++ls) {+ in >> tok ;+ g.langnames.push_back(tok) ;+ }++ for (int ls = 0 ; ls != g.nwords ; ++ls) {+ in >> tok ;+ g.lexicon[tok] = ls + 1 ;+ g.wlist.push_back(tok) ;+ }++ g.lin = vector<Linearizer>(g.nlangs) ;+ g.parser = vector<Parser>(g.nlangs) ;++ int w ;+ Sentence temp ;++ for (int ls = 0 ; ls != g.nlangs ; ++ls) {+ for (int ss = 0 ; ss != g.nsents ; ++ss) {+ temp = vector<int>() ;+ for (int ws = 0 ; ws != g.smaxlen ; ++ws) {++ in >> w ;+ temp.push_back(w) ; + } ++ g.lin[ls].push_back(temp) ;+ g.parser[ls][temp].push_back(ss) ;+ }+ }++ cout << "Grammar ready with languages " ;+ for (int i = 0 ; i != g.nlangs ; ++i) cout << g.langnames[i] << " " ; + cout << endl << endl ;++ return g ;+}++// translate string from any language to all other languages+void translate (Grammar& g, const string input)+{+ Sentence s ; // source++ s = getSentence(g.lexicon,words(input),g.smaxlen) ;++ Sentence t ; // target++ for (int k = 0 ; k != g.nlangs ; ++k) {+ if (!g.parser[k][s].empty()) {+ for (int m = 0 ; m != g.nlangs ; ++m) {+ if (m != k) cout << "** " << g.langnames[m] << ":" << endl ;+ for (vector<Tree>::const_iterator i = g.parser[k][s].begin() ; + i != g.parser[k][s].end() ; ++i){+ if (m != k) cout << "tree #" << *i << ": " ; // debug+ if (m != k) putSentence (g.wlist, g.lin[m][*i]) ;+ }+ }+ }+ }+}++// balanced random generator+inline int nrand(int n)+{+ /// if (n <= 0 || n > RAND_MAX)+ const int bucket_size = RAND_MAX / n ;+ int r ;++ // randomness from clock+ srand(time(NULL)) ;+ do r = (rand() + clock())/ bucket_size ;+ while (r >= n) ;++ return r ;++}++// generate random sentence and show it in all languages+void genRandom (const Grammar& g)+{+ Tree t = nrand(g.nsents) ;++ for (int k = 0 ; k != g.nlangs ; ++k) {+ cout << "** " << g.langnames[k] << ":" << endl ;+ putSentence (g.wlist, g.lin[k][t]) ;+ }+}++// quiz of ten translation examples+void quiz (Grammar& g, int src, int trg)+{+ int score = 0 ;++ for (int q = 0 ; q != 10 ; ++q) {+ Tree t = nrand(g.nsents) ;+ Sentence question = g.lin[src][t] ;+ putSentence (g.wlist, question) ;+ cout << "Translation:" << endl ;+ cout.flush() ;+ string answer ;+ /// if (q == 0) {string foo ; cin >> foo ; cin.clear() ;} ;+ getline (cin, answer) ;+ Sentence s = getSentence(g.lexicon,words(answer),g.smaxlen) ;++ bool result = false ;+ vector<Sentence> corrects ;+ for (vector<Tree>::const_iterator i = g.parser[src][question].begin() ; + i != g.parser[src][question].end() ; ++i){+ if (equal(s.begin(), s.end(), g.lin[trg][*i].begin())){+ result = true ;+ break ;+ } else {+ corrects.push_back(g.lin[trg][*i]) ;+ }+ }+ if (result) {+ ++ score ;+ cout << "Correct." << endl ;+ } else {+ cout << "Incorrect. Correct answers are:" << endl ;+ for (int c = 0 ; c != corrects.size() ; ++c) + putSentence(g.wlist, corrects[c]) ;+ }+ cout << "Score: " << score << "/" << q+1 << endl << endl ;+ }+}++// generate all sentences in one language+void genAll(const Grammar& g, int lang)+{+ for (int i = 0 ; i != g.nsents ; ++i)+ putSentence(g.wlist, g.lin[lang][i]) ;+}++// translate language name to index in language vector+int getLang(const Grammar& g, const string lang)+{+ int res = 0 ;+ for (vector<string>::const_iterator i = g.langnames.begin() ;+ i != g.langnames.end() ; ++i)+ if (*i == lang)+ return res ;+ else+ ++res ;++}++void help ()+{+ cout << "Commands:" << endl ;+ cout << " h print this help" << endl ;+ cout << " . quit" << endl ;+ cout << " ! generate random example" << endl ;+ cout << " ? <Lang1> <Lang2> translation quiz from Lang1 to Lang2" << endl ;+ cout << " * <Lang> generate all sentences of Lang" << endl ;+ cout << " <other sentence> translate" << endl ;+ cout << endl ;+}++int main (int argc, char* argv[])+{++ if (argc != 2) {+ cout << "usage: gfex <grammarfile>" << endl ;+ return 1 ;+ }++ std::ifstream from(argv[1]) ;++ Grammar g = readGrammar (from) ;++ help() ;++ string input ;++ while (getline (cin,input)){++ if (input == ".") {+ cout << "bye" << endl ;+ return 0 ;+ }+ else if (input == "h")+ help() ;+ else if (input == "!")+ genRandom(g) ;+ else if (input[0] == '?') {+ string src = words(input)[1] ;+ string trg = words(input)[2] ;+ quiz(g,getLang(g,src), getLang(g,trg)) ;+ }+ else if (input[0] == '*') {+ string src = words(input)[1] ;+ genAll(g,getLang(g,src)) ;+ }+ else+ translate(g,input) ;++ cin.clear() ;++ // cout << clock()/10000 ;++ cout << endl ;+ }++ return 0 ;+}+
@@ -0,0 +1,8021 @@+149 2 4008 8+Peace_Swe Peace_Eng+I air am andas are behöver black blod blood blue blå blåa blått breathe breathes cold cooperate cooperates cough coughs dangerous de dead dem det dig dricker drink drinks drop drops du där död döda dött eat eats er farlig farliga farligt food ger give gives green grön gröna grönt gul gula gult går gör han har has have he here het heta hett him honom hostar hot hungrig hungriga hungrigt hungry hurt hurts här is jag kall kalla kallt large liten litet luft mat me med medicin medicine mig need needs ni ont oss own owns red röd röda rött samarbetar see sees ser show shows sick sjuk sjuka sjukt skin skinn sleep sleeps släpper small små sover stor stora stort svart svarta that them there they this till to us vatten vi visar vit vita vitt walk walks water we white with yellow you äger är äter+++25 33 148 123 0 0 0 0+25 75 148 123 0 0 0 0+25 33 148 13 0 0 0 0+25 75 148 13 0 0 0 0+25 33 148 80 0 0 0 0+25 75 148 80 0 0 0 0+25 33 148 50 0 0 0 0+25 75 148 50 0 0 0 0+25 33 148 64 0 0 0 0+25 75 148 64 0 0 0 0+25 33 148 101 0 0 0 0+25 75 148 101 0 0 0 0+25 33 148 83 0 0 0 0+25 75 148 83 0 0 0 0+25 33 148 138 0 0 0 0+25 75 148 138 0 0 0 0+25 33 148 53 0 0 0 0+25 75 148 53 0 0 0 0+25 33 148 42 0 0 0 0+25 75 148 42 0 0 0 0+25 33 148 36 0 0 0 0+25 75 148 36 0 0 0 0+25 33 148 71 0 0 0 0+25 75 148 71 0 0 0 0+25 33 148 122 0 0 0 0+25 75 148 122 0 0 0 0+25 33 148 111 0 0 0 0+25 75 148 111 0 0 0 0+25 33 4 75 0 0 0 0+25 33 4 33 0 0 0 0+25 75 4 75 0 0 0 0+25 75 4 33 0 0 0 0+25 33 119 75 0 0 0 0+25 33 119 33 0 0 0 0+25 75 119 75 0 0 0 0+25 75 119 33 0 0 0 0+25 33 54 75 0 0 0 0+25 33 54 33 0 0 0 0+25 75 54 75 0 0 0 0+25 75 54 33 0 0 0 0+25 33 67 75 0 0 0 0+25 33 67 33 0 0 0 0+25 75 67 75 0 0 0 0+25 75 67 33 0 0 0 0+25 33 55 94 75 0 0 0+25 33 55 94 33 0 0 0+25 75 55 94 75 0 0 0+25 75 55 94 33 0 0 0+25 33 27 25 33 75 0 0+25 33 27 25 33 33 0 0+25 33 27 25 75 75 0 0+25 33 27 25 75 33 0 0+25 75 27 25 33 75 0 0+25 75 27 25 33 33 0 0+25 75 27 25 75 75 0 0+25 75 27 25 75 33 0 0+25 33 149 25 33 75 0 0+25 33 149 25 33 33 0 0+25 33 149 25 75 75 0 0+25 33 149 25 75 33 0 0+25 75 149 25 33 75 0 0+25 75 149 25 33 33 0 0+25 75 149 25 75 75 0 0+25 75 149 25 75 33 0 0+25 33 57 25 33 75 0 0+25 33 57 25 33 33 0 0+25 33 57 25 75 75 0 0+25 33 57 25 75 33 0 0+25 75 57 25 33 75 0 0+25 75 57 25 33 33 0 0+25 75 57 25 75 75 0 0+25 75 57 25 75 33 0 0+25 33 105 25 33 75 0 0+25 33 105 25 33 33 0 0+25 33 105 25 75 75 0 0+25 33 105 25 75 33 0 0+25 75 105 25 33 75 0 0+25 75 105 25 33 33 0 0+25 75 105 25 75 75 0 0+25 75 105 25 75 33 0 0+25 33 102 87 25 33 75 0+25 33 102 87 25 33 33 0+25 33 102 87 25 75 75 0+25 33 102 87 25 75 33 0+25 75 102 87 25 33 75 0+25 75 102 87 25 33 33 0+25 75 102 87 25 75 75 0+25 75 102 87 25 75 33 0+25 33 116 25 33 75 0 0+25 33 116 25 33 33 0 0+25 33 116 25 75 75 0 0+25 33 116 25 75 33 0 0+25 75 116 25 33 75 0 0+25 75 116 25 33 33 0 0+25 75 116 25 75 75 0 0+25 75 116 25 75 33 0 0+25 33 6 25 33 75 0 0+25 33 6 25 33 33 0 0+25 33 6 25 75 75 0 0+25 33 6 25 75 33 0 0+25 75 6 25 33 75 0 0+25 75 6 25 33 33 0 0+25 75 6 25 75 75 0 0+25 75 6 25 75 33 0 0+25 33 147 25 33 75 0 0+25 33 147 25 33 33 0 0+25 33 147 25 75 75 0 0+25 33 147 25 75 33 0 0+25 75 147 25 33 75 0 0+25 75 147 25 33 33 0 0+25 75 147 25 75 75 0 0+25 75 147 25 75 33 0 0+25 33 148 25 33 0 0 0+25 75 148 25 33 0 0 0+25 33 148 25 75 0 0 0+25 75 148 25 75 0 0 0+25 33 4 0 0 0 0 0+25 75 4 0 0 0 0 0+25 33 119 0 0 0 0 0+25 75 119 0 0 0 0 0+25 33 54 0 0 0 0 0+25 75 54 0 0 0 0 0+25 33 67 0 0 0 0 0+25 75 67 0 0 0 0 0+25 33 55 94 0 0 0 0+25 75 55 94 0 0 0 0+25 33 27 25 33 0 0 0+25 33 27 25 75 0 0 0+25 75 27 25 33 0 0 0+25 75 27 25 75 0 0 0+25 33 149 25 33 0 0 0+25 33 149 25 75 0 0 0+25 75 149 25 33 0 0 0+25 75 149 25 75 0 0 0+25 33 57 25 33 0 0 0+25 33 57 25 75 0 0 0+25 75 57 25 33 0 0 0+25 75 57 25 75 0 0 0+25 33 105 25 33 0 0 0+25 33 105 25 75 0 0 0+25 75 105 25 33 0 0 0+25 75 105 25 75 0 0 0+25 33 102 87 25 33 0 0+25 33 102 87 25 75 0 0+25 75 102 87 25 33 0 0+25 75 102 87 25 75 0 0+25 33 116 25 33 0 0 0+25 33 116 25 75 0 0 0+25 75 116 25 33 0 0 0+25 75 116 25 75 0 0 0+25 33 6 25 33 0 0 0+25 33 6 25 75 0 0 0+25 75 6 25 33 0 0 0+25 75 6 25 75 0 0 0+25 33 147 25 33 0 0 0+25 33 147 25 75 0 0 0+25 75 147 25 33 0 0 0+25 75 147 25 75 0 0 0+25 33 44 25 33 130 25 33+25 33 44 25 33 130 25 75+25 33 44 25 75 130 25 33+25 33 44 25 75 130 25 75+25 75 44 25 33 130 25 33+25 75 44 25 33 130 25 75+25 75 44 25 75 130 25 33+25 75 44 25 75 130 25 75+25 33 135 25 33 25 33 0+25 33 135 25 33 25 75 0+25 33 135 25 75 25 33 0+25 33 135 25 75 25 75 0+25 75 135 25 33 25 33 0+25 75 135 25 33 25 75 0+25 75 135 25 75 25 33 0+25 75 135 25 75 25 75 0+56 148 123 0 0 0 0 0+77 148 123 0 0 0 0 0+22 148 124 0 0 0 0 0+134 148 124 0 0 0 0 0+93 148 124 0 0 0 0 0+32 148 123 0 0 0 0 0+56 148 11 0 0 0 0 0+77 148 11 0 0 0 0 0+22 148 12 0 0 0 0 0+134 148 12 0 0 0 0 0+93 148 12 0 0 0 0 0+32 148 11 0 0 0 0 0+56 148 78 0 0 0 0 0+77 148 78 0 0 0 0 0+22 148 79 0 0 0 0 0+134 148 79 0 0 0 0 0+93 148 79 0 0 0 0 0+32 148 78 0 0 0 0 0+56 148 48 0 0 0 0 0+77 148 48 0 0 0 0 0+22 148 49 0 0 0 0 0+134 148 49 0 0 0 0 0+93 148 49 0 0 0 0 0+32 148 48 0 0 0 0 0+56 148 62 0 0 0 0 0+77 148 62 0 0 0 0 0+22 148 63 0 0 0 0 0+134 148 63 0 0 0 0 0+93 148 63 0 0 0 0 0+32 148 62 0 0 0 0 0+56 148 99 0 0 0 0 0+77 148 99 0 0 0 0 0+22 148 100 0 0 0 0 0+134 148 100 0 0 0 0 0+93 148 100 0 0 0 0 0+32 148 99 0 0 0 0 0+56 148 82 0 0 0 0 0+77 148 82 0 0 0 0 0+22 148 118 0 0 0 0 0+134 148 118 0 0 0 0 0+93 148 118 0 0 0 0 0+32 148 82 0 0 0 0 0+56 148 136 0 0 0 0 0+77 148 136 0 0 0 0 0+22 148 137 0 0 0 0 0+134 148 137 0 0 0 0 0+93 148 137 0 0 0 0 0+32 148 136 0 0 0 0 0+56 148 51 0 0 0 0 0+77 148 51 0 0 0 0 0+22 148 52 0 0 0 0 0+134 148 52 0 0 0 0 0+93 148 52 0 0 0 0 0+32 148 51 0 0 0 0 0+56 148 40 0 0 0 0 0+77 148 40 0 0 0 0 0+22 148 41 0 0 0 0 0+134 148 41 0 0 0 0 0+93 148 41 0 0 0 0 0+32 148 40 0 0 0 0 0+56 148 34 0 0 0 0 0+77 148 34 0 0 0 0 0+22 148 35 0 0 0 0 0+134 148 35 0 0 0 0 0+93 148 35 0 0 0 0 0+32 148 34 0 0 0 0 0+56 148 69 0 0 0 0 0+77 148 69 0 0 0 0 0+22 148 70 0 0 0 0 0+134 148 70 0 0 0 0 0+93 148 70 0 0 0 0 0+32 148 69 0 0 0 0 0+56 148 120 0 0 0 0 0+77 148 120 0 0 0 0 0+22 148 121 0 0 0 0 0+134 148 121 0 0 0 0 0+93 148 121 0 0 0 0 0+32 148 120 0 0 0 0 0+56 148 109 0 0 0 0 0+77 148 109 0 0 0 0 0+22 148 110 0 0 0 0 0+134 148 110 0 0 0 0 0+93 148 110 0 0 0 0 0+32 148 109 0 0 0 0 0+56 4 75 0 0 0 0 0+56 4 33 0 0 0 0 0+77 4 75 0 0 0 0 0+77 4 33 0 0 0 0 0+22 4 75 0 0 0 0 0+22 4 33 0 0 0 0 0+134 4 75 0 0 0 0 0+134 4 33 0 0 0 0 0+93 4 75 0 0 0 0 0+93 4 33 0 0 0 0 0+32 4 75 0 0 0 0 0+32 4 33 0 0 0 0 0+56 119 75 0 0 0 0 0+56 119 33 0 0 0 0 0+77 119 75 0 0 0 0 0+77 119 33 0 0 0 0 0+22 119 75 0 0 0 0 0+22 119 33 0 0 0 0 0+134 119 75 0 0 0 0 0+134 119 33 0 0 0 0 0+93 119 75 0 0 0 0 0+93 119 33 0 0 0 0 0+32 119 75 0 0 0 0 0+32 119 33 0 0 0 0 0+56 54 75 0 0 0 0 0+56 54 33 0 0 0 0 0+77 54 75 0 0 0 0 0+77 54 33 0 0 0 0 0+22 54 75 0 0 0 0 0+22 54 33 0 0 0 0 0+134 54 75 0 0 0 0 0+134 54 33 0 0 0 0 0+93 54 75 0 0 0 0 0+93 54 33 0 0 0 0 0+32 54 75 0 0 0 0 0+32 54 33 0 0 0 0 0+56 67 75 0 0 0 0 0+56 67 33 0 0 0 0 0+77 67 75 0 0 0 0 0+77 67 33 0 0 0 0 0+22 67 75 0 0 0 0 0+22 67 33 0 0 0 0 0+134 67 75 0 0 0 0 0+134 67 33 0 0 0 0 0+93 67 75 0 0 0 0 0+93 67 33 0 0 0 0 0+32 67 75 0 0 0 0 0+32 67 33 0 0 0 0 0+56 55 94 75 0 0 0 0+56 55 94 33 0 0 0 0+77 55 94 75 0 0 0 0+77 55 94 33 0 0 0 0+22 55 94 75 0 0 0 0+22 55 94 33 0 0 0 0+134 55 94 75 0 0 0 0+134 55 94 33 0 0 0 0+93 55 94 75 0 0 0 0+93 55 94 33 0 0 0 0+32 55 94 75 0 0 0 0+32 55 94 33 0 0 0 0+56 27 66 75 0 0 0 0+56 27 66 33 0 0 0 0+56 27 90 75 0 0 0 0+56 27 90 33 0 0 0 0+56 27 24 75 0 0 0 0+56 27 24 33 0 0 0 0+56 27 95 75 0 0 0 0+56 27 95 33 0 0 0 0+56 27 39 75 0 0 0 0+56 27 39 33 0 0 0 0+56 27 26 75 0 0 0 0+56 27 26 33 0 0 0 0+56 27 25 33 75 0 0 0+56 27 25 33 33 0 0 0+56 27 25 75 75 0 0 0+56 27 25 75 33 0 0 0+77 27 66 75 0 0 0 0+77 27 66 33 0 0 0 0+77 27 90 75 0 0 0 0+77 27 90 33 0 0 0 0+77 27 24 75 0 0 0 0+77 27 24 33 0 0 0 0+77 27 95 75 0 0 0 0+77 27 95 33 0 0 0 0+77 27 39 75 0 0 0 0+77 27 39 33 0 0 0 0+77 27 26 75 0 0 0 0+77 27 26 33 0 0 0 0+77 27 25 33 75 0 0 0+77 27 25 33 33 0 0 0+77 27 25 75 75 0 0 0+77 27 25 75 33 0 0 0+22 27 66 75 0 0 0 0+22 27 66 33 0 0 0 0+22 27 90 75 0 0 0 0+22 27 90 33 0 0 0 0+22 27 24 75 0 0 0 0+22 27 24 33 0 0 0 0+22 27 95 75 0 0 0 0+22 27 95 33 0 0 0 0+22 27 39 75 0 0 0 0+22 27 39 33 0 0 0 0+22 27 26 75 0 0 0 0+22 27 26 33 0 0 0 0+22 27 25 33 75 0 0 0+22 27 25 33 33 0 0 0+22 27 25 75 75 0 0 0+22 27 25 75 33 0 0 0+134 27 66 75 0 0 0 0+134 27 66 33 0 0 0 0+134 27 90 75 0 0 0 0+134 27 90 33 0 0 0 0+134 27 24 75 0 0 0 0+134 27 24 33 0 0 0 0+134 27 95 75 0 0 0 0+134 27 95 33 0 0 0 0+134 27 39 75 0 0 0 0+134 27 39 33 0 0 0 0+134 27 26 75 0 0 0 0+134 27 26 33 0 0 0 0+134 27 25 33 75 0 0 0+134 27 25 33 33 0 0 0+134 27 25 75 75 0 0 0+134 27 25 75 33 0 0 0+93 27 66 75 0 0 0 0+93 27 66 33 0 0 0 0+93 27 90 75 0 0 0 0+93 27 90 33 0 0 0 0+93 27 24 75 0 0 0 0+93 27 24 33 0 0 0 0+93 27 95 75 0 0 0 0+93 27 95 33 0 0 0 0+93 27 39 75 0 0 0 0+93 27 39 33 0 0 0 0+93 27 26 75 0 0 0 0+93 27 26 33 0 0 0 0+93 27 25 33 75 0 0 0+93 27 25 33 33 0 0 0+93 27 25 75 75 0 0 0+93 27 25 75 33 0 0 0+32 27 66 75 0 0 0 0+32 27 66 33 0 0 0 0+32 27 90 75 0 0 0 0+32 27 90 33 0 0 0 0+32 27 24 75 0 0 0 0+32 27 24 33 0 0 0 0+32 27 95 75 0 0 0 0+32 27 95 33 0 0 0 0+32 27 39 75 0 0 0 0+32 27 39 33 0 0 0 0+32 27 26 75 0 0 0 0+32 27 26 33 0 0 0 0+32 27 25 33 75 0 0 0+32 27 25 33 33 0 0 0+32 27 25 75 75 0 0 0+32 27 25 75 33 0 0 0+25 33 27 66 75 0 0 0+25 33 27 66 33 0 0 0+25 33 27 90 75 0 0 0+25 33 27 90 33 0 0 0+25 33 27 24 75 0 0 0+25 33 27 24 33 0 0 0+25 33 27 95 75 0 0 0+25 33 27 95 33 0 0 0+25 33 27 39 75 0 0 0+25 33 27 39 33 0 0 0+25 33 27 26 75 0 0 0+25 33 27 26 33 0 0 0+25 75 27 66 75 0 0 0+25 75 27 66 33 0 0 0+25 75 27 90 75 0 0 0+25 75 27 90 33 0 0 0+25 75 27 24 75 0 0 0+25 75 27 24 33 0 0 0+25 75 27 95 75 0 0 0+25 75 27 95 33 0 0 0+25 75 27 39 75 0 0 0+25 75 27 39 33 0 0 0+25 75 27 26 75 0 0 0+25 75 27 26 33 0 0 0+56 149 66 75 0 0 0 0+56 149 66 33 0 0 0 0+56 149 90 75 0 0 0 0+56 149 90 33 0 0 0 0+56 149 24 75 0 0 0 0+56 149 24 33 0 0 0 0+56 149 95 75 0 0 0 0+56 149 95 33 0 0 0 0+56 149 39 75 0 0 0 0+56 149 39 33 0 0 0 0+56 149 26 75 0 0 0 0+56 149 26 33 0 0 0 0+56 149 25 33 75 0 0 0+56 149 25 33 33 0 0 0+56 149 25 75 75 0 0 0+56 149 25 75 33 0 0 0+77 149 66 75 0 0 0 0+77 149 66 33 0 0 0 0+77 149 90 75 0 0 0 0+77 149 90 33 0 0 0 0+77 149 24 75 0 0 0 0+77 149 24 33 0 0 0 0+77 149 95 75 0 0 0 0+77 149 95 33 0 0 0 0+77 149 39 75 0 0 0 0+77 149 39 33 0 0 0 0+77 149 26 75 0 0 0 0+77 149 26 33 0 0 0 0+77 149 25 33 75 0 0 0+77 149 25 33 33 0 0 0+77 149 25 75 75 0 0 0+77 149 25 75 33 0 0 0+22 149 66 75 0 0 0 0+22 149 66 33 0 0 0 0+22 149 90 75 0 0 0 0+22 149 90 33 0 0 0 0+22 149 24 75 0 0 0 0+22 149 24 33 0 0 0 0+22 149 95 75 0 0 0 0+22 149 95 33 0 0 0 0+22 149 39 75 0 0 0 0+22 149 39 33 0 0 0 0+22 149 26 75 0 0 0 0+22 149 26 33 0 0 0 0+22 149 25 33 75 0 0 0+22 149 25 33 33 0 0 0+22 149 25 75 75 0 0 0+22 149 25 75 33 0 0 0+134 149 66 75 0 0 0 0+134 149 66 33 0 0 0 0+134 149 90 75 0 0 0 0+134 149 90 33 0 0 0 0+134 149 24 75 0 0 0 0+134 149 24 33 0 0 0 0+134 149 95 75 0 0 0 0+134 149 95 33 0 0 0 0+134 149 39 75 0 0 0 0+134 149 39 33 0 0 0 0+134 149 26 75 0 0 0 0+134 149 26 33 0 0 0 0+134 149 25 33 75 0 0 0+134 149 25 33 33 0 0 0+134 149 25 75 75 0 0 0+134 149 25 75 33 0 0 0+93 149 66 75 0 0 0 0+93 149 66 33 0 0 0 0+93 149 90 75 0 0 0 0+93 149 90 33 0 0 0 0+93 149 24 75 0 0 0 0+93 149 24 33 0 0 0 0+93 149 95 75 0 0 0 0+93 149 95 33 0 0 0 0+93 149 39 75 0 0 0 0+93 149 39 33 0 0 0 0+93 149 26 75 0 0 0 0+93 149 26 33 0 0 0 0+93 149 25 33 75 0 0 0+93 149 25 33 33 0 0 0+93 149 25 75 75 0 0 0+93 149 25 75 33 0 0 0+32 149 66 75 0 0 0 0+32 149 66 33 0 0 0 0+32 149 90 75 0 0 0 0+32 149 90 33 0 0 0 0+32 149 24 75 0 0 0 0+32 149 24 33 0 0 0 0+32 149 95 75 0 0 0 0+32 149 95 33 0 0 0 0+32 149 39 75 0 0 0 0+32 149 39 33 0 0 0 0+32 149 26 75 0 0 0 0+32 149 26 33 0 0 0 0+32 149 25 33 75 0 0 0+32 149 25 33 33 0 0 0+32 149 25 75 75 0 0 0+32 149 25 75 33 0 0 0+25 33 149 66 75 0 0 0+25 33 149 66 33 0 0 0+25 33 149 90 75 0 0 0+25 33 149 90 33 0 0 0+25 33 149 24 75 0 0 0+25 33 149 24 33 0 0 0+25 33 149 95 75 0 0 0+25 33 149 95 33 0 0 0+25 33 149 39 75 0 0 0+25 33 149 39 33 0 0 0+25 33 149 26 75 0 0 0+25 33 149 26 33 0 0 0+25 75 149 66 75 0 0 0+25 75 149 66 33 0 0 0+25 75 149 90 75 0 0 0+25 75 149 90 33 0 0 0+25 75 149 24 75 0 0 0+25 75 149 24 33 0 0 0+25 75 149 95 75 0 0 0+25 75 149 95 33 0 0 0+25 75 149 39 75 0 0 0+25 75 149 39 33 0 0 0+25 75 149 26 75 0 0 0+25 75 149 26 33 0 0 0+56 57 66 75 0 0 0 0+56 57 66 33 0 0 0 0+56 57 90 75 0 0 0 0+56 57 90 33 0 0 0 0+56 57 24 75 0 0 0 0+56 57 24 33 0 0 0 0+56 57 95 75 0 0 0 0+56 57 95 33 0 0 0 0+56 57 39 75 0 0 0 0+56 57 39 33 0 0 0 0+56 57 26 75 0 0 0 0+56 57 26 33 0 0 0 0+56 57 25 33 75 0 0 0+56 57 25 33 33 0 0 0+56 57 25 75 75 0 0 0+56 57 25 75 33 0 0 0+77 57 66 75 0 0 0 0+77 57 66 33 0 0 0 0+77 57 90 75 0 0 0 0+77 57 90 33 0 0 0 0+77 57 24 75 0 0 0 0+77 57 24 33 0 0 0 0+77 57 95 75 0 0 0 0+77 57 95 33 0 0 0 0+77 57 39 75 0 0 0 0+77 57 39 33 0 0 0 0+77 57 26 75 0 0 0 0+77 57 26 33 0 0 0 0+77 57 25 33 75 0 0 0+77 57 25 33 33 0 0 0+77 57 25 75 75 0 0 0+77 57 25 75 33 0 0 0+22 57 66 75 0 0 0 0+22 57 66 33 0 0 0 0+22 57 90 75 0 0 0 0+22 57 90 33 0 0 0 0+22 57 24 75 0 0 0 0+22 57 24 33 0 0 0 0+22 57 95 75 0 0 0 0+22 57 95 33 0 0 0 0+22 57 39 75 0 0 0 0+22 57 39 33 0 0 0 0+22 57 26 75 0 0 0 0+22 57 26 33 0 0 0 0+22 57 25 33 75 0 0 0+22 57 25 33 33 0 0 0+22 57 25 75 75 0 0 0+22 57 25 75 33 0 0 0+134 57 66 75 0 0 0 0+134 57 66 33 0 0 0 0+134 57 90 75 0 0 0 0+134 57 90 33 0 0 0 0+134 57 24 75 0 0 0 0+134 57 24 33 0 0 0 0+134 57 95 75 0 0 0 0+134 57 95 33 0 0 0 0+134 57 39 75 0 0 0 0+134 57 39 33 0 0 0 0+134 57 26 75 0 0 0 0+134 57 26 33 0 0 0 0+134 57 25 33 75 0 0 0+134 57 25 33 33 0 0 0+134 57 25 75 75 0 0 0+134 57 25 75 33 0 0 0+93 57 66 75 0 0 0 0+93 57 66 33 0 0 0 0+93 57 90 75 0 0 0 0+93 57 90 33 0 0 0 0+93 57 24 75 0 0 0 0+93 57 24 33 0 0 0 0+93 57 95 75 0 0 0 0+93 57 95 33 0 0 0 0+93 57 39 75 0 0 0 0+93 57 39 33 0 0 0 0+93 57 26 75 0 0 0 0+93 57 26 33 0 0 0 0+93 57 25 33 75 0 0 0+93 57 25 33 33 0 0 0+93 57 25 75 75 0 0 0+93 57 25 75 33 0 0 0+32 57 66 75 0 0 0 0+32 57 66 33 0 0 0 0+32 57 90 75 0 0 0 0+32 57 90 33 0 0 0 0+32 57 24 75 0 0 0 0+32 57 24 33 0 0 0 0+32 57 95 75 0 0 0 0+32 57 95 33 0 0 0 0+32 57 39 75 0 0 0 0+32 57 39 33 0 0 0 0+32 57 26 75 0 0 0 0+32 57 26 33 0 0 0 0+32 57 25 33 75 0 0 0+32 57 25 33 33 0 0 0+32 57 25 75 75 0 0 0+32 57 25 75 33 0 0 0+25 33 57 66 75 0 0 0+25 33 57 66 33 0 0 0+25 33 57 90 75 0 0 0+25 33 57 90 33 0 0 0+25 33 57 24 75 0 0 0+25 33 57 24 33 0 0 0+25 33 57 95 75 0 0 0+25 33 57 95 33 0 0 0+25 33 57 39 75 0 0 0+25 33 57 39 33 0 0 0+25 33 57 26 75 0 0 0+25 33 57 26 33 0 0 0+25 75 57 66 75 0 0 0+25 75 57 66 33 0 0 0+25 75 57 90 75 0 0 0+25 75 57 90 33 0 0 0+25 75 57 24 75 0 0 0+25 75 57 24 33 0 0 0+25 75 57 95 75 0 0 0+25 75 57 95 33 0 0 0+25 75 57 39 75 0 0 0+25 75 57 39 33 0 0 0+25 75 57 26 75 0 0 0+25 75 57 26 33 0 0 0+56 105 66 75 0 0 0 0+56 105 66 33 0 0 0 0+56 105 90 75 0 0 0 0+56 105 90 33 0 0 0 0+56 105 24 75 0 0 0 0+56 105 24 33 0 0 0 0+56 105 95 75 0 0 0 0+56 105 95 33 0 0 0 0+56 105 39 75 0 0 0 0+56 105 39 33 0 0 0 0+56 105 26 75 0 0 0 0+56 105 26 33 0 0 0 0+56 105 25 33 75 0 0 0+56 105 25 33 33 0 0 0+56 105 25 75 75 0 0 0+56 105 25 75 33 0 0 0+77 105 66 75 0 0 0 0+77 105 66 33 0 0 0 0+77 105 90 75 0 0 0 0+77 105 90 33 0 0 0 0+77 105 24 75 0 0 0 0+77 105 24 33 0 0 0 0+77 105 95 75 0 0 0 0+77 105 95 33 0 0 0 0+77 105 39 75 0 0 0 0+77 105 39 33 0 0 0 0+77 105 26 75 0 0 0 0+77 105 26 33 0 0 0 0+77 105 25 33 75 0 0 0+77 105 25 33 33 0 0 0+77 105 25 75 75 0 0 0+77 105 25 75 33 0 0 0+22 105 66 75 0 0 0 0+22 105 66 33 0 0 0 0+22 105 90 75 0 0 0 0+22 105 90 33 0 0 0 0+22 105 24 75 0 0 0 0+22 105 24 33 0 0 0 0+22 105 95 75 0 0 0 0+22 105 95 33 0 0 0 0+22 105 39 75 0 0 0 0+22 105 39 33 0 0 0 0+22 105 26 75 0 0 0 0+22 105 26 33 0 0 0 0+22 105 25 33 75 0 0 0+22 105 25 33 33 0 0 0+22 105 25 75 75 0 0 0+22 105 25 75 33 0 0 0+134 105 66 75 0 0 0 0+134 105 66 33 0 0 0 0+134 105 90 75 0 0 0 0+134 105 90 33 0 0 0 0+134 105 24 75 0 0 0 0+134 105 24 33 0 0 0 0+134 105 95 75 0 0 0 0+134 105 95 33 0 0 0 0+134 105 39 75 0 0 0 0+134 105 39 33 0 0 0 0+134 105 26 75 0 0 0 0+134 105 26 33 0 0 0 0+134 105 25 33 75 0 0 0+134 105 25 33 33 0 0 0+134 105 25 75 75 0 0 0+134 105 25 75 33 0 0 0+93 105 66 75 0 0 0 0+93 105 66 33 0 0 0 0+93 105 90 75 0 0 0 0+93 105 90 33 0 0 0 0+93 105 24 75 0 0 0 0+93 105 24 33 0 0 0 0+93 105 95 75 0 0 0 0+93 105 95 33 0 0 0 0+93 105 39 75 0 0 0 0+93 105 39 33 0 0 0 0+93 105 26 75 0 0 0 0+93 105 26 33 0 0 0 0+93 105 25 33 75 0 0 0+93 105 25 33 33 0 0 0+93 105 25 75 75 0 0 0+93 105 25 75 33 0 0 0+32 105 66 75 0 0 0 0+32 105 66 33 0 0 0 0+32 105 90 75 0 0 0 0+32 105 90 33 0 0 0 0+32 105 24 75 0 0 0 0+32 105 24 33 0 0 0 0+32 105 95 75 0 0 0 0+32 105 95 33 0 0 0 0+32 105 39 75 0 0 0 0+32 105 39 33 0 0 0 0+32 105 26 75 0 0 0 0+32 105 26 33 0 0 0 0+32 105 25 33 75 0 0 0+32 105 25 33 33 0 0 0+32 105 25 75 75 0 0 0+32 105 25 75 33 0 0 0+25 33 105 66 75 0 0 0+25 33 105 66 33 0 0 0+25 33 105 90 75 0 0 0+25 33 105 90 33 0 0 0+25 33 105 24 75 0 0 0+25 33 105 24 33 0 0 0+25 33 105 95 75 0 0 0+25 33 105 95 33 0 0 0+25 33 105 39 75 0 0 0+25 33 105 39 33 0 0 0+25 33 105 26 75 0 0 0+25 33 105 26 33 0 0 0+25 75 105 66 75 0 0 0+25 75 105 66 33 0 0 0+25 75 105 90 75 0 0 0+25 75 105 90 33 0 0 0+25 75 105 24 75 0 0 0+25 75 105 24 33 0 0 0+25 75 105 95 75 0 0 0+25 75 105 95 33 0 0 0+25 75 105 39 75 0 0 0+25 75 105 39 33 0 0 0+25 75 105 26 75 0 0 0+25 75 105 26 33 0 0 0+56 102 87 66 75 0 0 0+56 102 87 66 33 0 0 0+56 102 87 90 75 0 0 0+56 102 87 90 33 0 0 0+56 102 87 24 75 0 0 0+56 102 87 24 33 0 0 0+56 102 87 95 75 0 0 0+56 102 87 95 33 0 0 0+56 102 87 39 75 0 0 0+56 102 87 39 33 0 0 0+56 102 87 26 75 0 0 0+56 102 87 26 33 0 0 0+56 102 87 25 33 75 0 0+56 102 87 25 33 33 0 0+56 102 87 25 75 75 0 0+56 102 87 25 75 33 0 0+77 102 87 66 75 0 0 0+77 102 87 66 33 0 0 0+77 102 87 90 75 0 0 0+77 102 87 90 33 0 0 0+77 102 87 24 75 0 0 0+77 102 87 24 33 0 0 0+77 102 87 95 75 0 0 0+77 102 87 95 33 0 0 0+77 102 87 39 75 0 0 0+77 102 87 39 33 0 0 0+77 102 87 26 75 0 0 0+77 102 87 26 33 0 0 0+77 102 87 25 33 75 0 0+77 102 87 25 33 33 0 0+77 102 87 25 75 75 0 0+77 102 87 25 75 33 0 0+22 102 87 66 75 0 0 0+22 102 87 66 33 0 0 0+22 102 87 90 75 0 0 0+22 102 87 90 33 0 0 0+22 102 87 24 75 0 0 0+22 102 87 24 33 0 0 0+22 102 87 95 75 0 0 0+22 102 87 95 33 0 0 0+22 102 87 39 75 0 0 0+22 102 87 39 33 0 0 0+22 102 87 26 75 0 0 0+22 102 87 26 33 0 0 0+22 102 87 25 33 75 0 0+22 102 87 25 33 33 0 0+22 102 87 25 75 75 0 0+22 102 87 25 75 33 0 0+134 102 87 66 75 0 0 0+134 102 87 66 33 0 0 0+134 102 87 90 75 0 0 0+134 102 87 90 33 0 0 0+134 102 87 24 75 0 0 0+134 102 87 24 33 0 0 0+134 102 87 95 75 0 0 0+134 102 87 95 33 0 0 0+134 102 87 39 75 0 0 0+134 102 87 39 33 0 0 0+134 102 87 26 75 0 0 0+134 102 87 26 33 0 0 0+134 102 87 25 33 75 0 0+134 102 87 25 33 33 0 0+134 102 87 25 75 75 0 0+134 102 87 25 75 33 0 0+93 102 87 66 75 0 0 0+93 102 87 66 33 0 0 0+93 102 87 90 75 0 0 0+93 102 87 90 33 0 0 0+93 102 87 24 75 0 0 0+93 102 87 24 33 0 0 0+93 102 87 95 75 0 0 0+93 102 87 95 33 0 0 0+93 102 87 39 75 0 0 0+93 102 87 39 33 0 0 0+93 102 87 26 75 0 0 0+93 102 87 26 33 0 0 0+93 102 87 25 33 75 0 0+93 102 87 25 33 33 0 0+93 102 87 25 75 75 0 0+93 102 87 25 75 33 0 0+32 102 87 66 75 0 0 0+32 102 87 66 33 0 0 0+32 102 87 90 75 0 0 0+32 102 87 90 33 0 0 0+32 102 87 24 75 0 0 0+32 102 87 24 33 0 0 0+32 102 87 95 75 0 0 0+32 102 87 95 33 0 0 0+32 102 87 39 75 0 0 0+32 102 87 39 33 0 0 0+32 102 87 26 75 0 0 0+32 102 87 26 33 0 0 0+32 102 87 25 33 75 0 0+32 102 87 25 33 33 0 0+32 102 87 25 75 75 0 0+32 102 87 25 75 33 0 0+25 33 102 87 66 75 0 0+25 33 102 87 66 33 0 0+25 33 102 87 90 75 0 0+25 33 102 87 90 33 0 0+25 33 102 87 24 75 0 0+25 33 102 87 24 33 0 0+25 33 102 87 95 75 0 0+25 33 102 87 95 33 0 0+25 33 102 87 39 75 0 0+25 33 102 87 39 33 0 0+25 33 102 87 26 75 0 0+25 33 102 87 26 33 0 0+25 75 102 87 66 75 0 0+25 75 102 87 66 33 0 0+25 75 102 87 90 75 0 0+25 75 102 87 90 33 0 0+25 75 102 87 24 75 0 0+25 75 102 87 24 33 0 0+25 75 102 87 95 75 0 0+25 75 102 87 95 33 0 0+25 75 102 87 39 75 0 0+25 75 102 87 39 33 0 0+25 75 102 87 26 75 0 0+25 75 102 87 26 33 0 0+56 116 66 75 0 0 0 0+56 116 66 33 0 0 0 0+56 116 90 75 0 0 0 0+56 116 90 33 0 0 0 0+56 116 24 75 0 0 0 0+56 116 24 33 0 0 0 0+56 116 95 75 0 0 0 0+56 116 95 33 0 0 0 0+56 116 39 75 0 0 0 0+56 116 39 33 0 0 0 0+56 116 26 75 0 0 0 0+56 116 26 33 0 0 0 0+56 116 25 33 75 0 0 0+56 116 25 33 33 0 0 0+56 116 25 75 75 0 0 0+56 116 25 75 33 0 0 0+77 116 66 75 0 0 0 0+77 116 66 33 0 0 0 0+77 116 90 75 0 0 0 0+77 116 90 33 0 0 0 0+77 116 24 75 0 0 0 0+77 116 24 33 0 0 0 0+77 116 95 75 0 0 0 0+77 116 95 33 0 0 0 0+77 116 39 75 0 0 0 0+77 116 39 33 0 0 0 0+77 116 26 75 0 0 0 0+77 116 26 33 0 0 0 0+77 116 25 33 75 0 0 0+77 116 25 33 33 0 0 0+77 116 25 75 75 0 0 0+77 116 25 75 33 0 0 0+22 116 66 75 0 0 0 0+22 116 66 33 0 0 0 0+22 116 90 75 0 0 0 0+22 116 90 33 0 0 0 0+22 116 24 75 0 0 0 0+22 116 24 33 0 0 0 0+22 116 95 75 0 0 0 0+22 116 95 33 0 0 0 0+22 116 39 75 0 0 0 0+22 116 39 33 0 0 0 0+22 116 26 75 0 0 0 0+22 116 26 33 0 0 0 0+22 116 25 33 75 0 0 0+22 116 25 33 33 0 0 0+22 116 25 75 75 0 0 0+22 116 25 75 33 0 0 0+134 116 66 75 0 0 0 0+134 116 66 33 0 0 0 0+134 116 90 75 0 0 0 0+134 116 90 33 0 0 0 0+134 116 24 75 0 0 0 0+134 116 24 33 0 0 0 0+134 116 95 75 0 0 0 0+134 116 95 33 0 0 0 0+134 116 39 75 0 0 0 0+134 116 39 33 0 0 0 0+134 116 26 75 0 0 0 0+134 116 26 33 0 0 0 0+134 116 25 33 75 0 0 0+134 116 25 33 33 0 0 0+134 116 25 75 75 0 0 0+134 116 25 75 33 0 0 0+93 116 66 75 0 0 0 0+93 116 66 33 0 0 0 0+93 116 90 75 0 0 0 0+93 116 90 33 0 0 0 0+93 116 24 75 0 0 0 0+93 116 24 33 0 0 0 0+93 116 95 75 0 0 0 0+93 116 95 33 0 0 0 0+93 116 39 75 0 0 0 0+93 116 39 33 0 0 0 0+93 116 26 75 0 0 0 0+93 116 26 33 0 0 0 0+93 116 25 33 75 0 0 0+93 116 25 33 33 0 0 0+93 116 25 75 75 0 0 0+93 116 25 75 33 0 0 0+32 116 66 75 0 0 0 0+32 116 66 33 0 0 0 0+32 116 90 75 0 0 0 0+32 116 90 33 0 0 0 0+32 116 24 75 0 0 0 0+32 116 24 33 0 0 0 0+32 116 95 75 0 0 0 0+32 116 95 33 0 0 0 0+32 116 39 75 0 0 0 0+32 116 39 33 0 0 0 0+32 116 26 75 0 0 0 0+32 116 26 33 0 0 0 0+32 116 25 33 75 0 0 0+32 116 25 33 33 0 0 0+32 116 25 75 75 0 0 0+32 116 25 75 33 0 0 0+25 33 116 66 75 0 0 0+25 33 116 66 33 0 0 0+25 33 116 90 75 0 0 0+25 33 116 90 33 0 0 0+25 33 116 24 75 0 0 0+25 33 116 24 33 0 0 0+25 33 116 95 75 0 0 0+25 33 116 95 33 0 0 0+25 33 116 39 75 0 0 0+25 33 116 39 33 0 0 0+25 33 116 26 75 0 0 0+25 33 116 26 33 0 0 0+25 75 116 66 75 0 0 0+25 75 116 66 33 0 0 0+25 75 116 90 75 0 0 0+25 75 116 90 33 0 0 0+25 75 116 24 75 0 0 0+25 75 116 24 33 0 0 0+25 75 116 95 75 0 0 0+25 75 116 95 33 0 0 0+25 75 116 39 75 0 0 0+25 75 116 39 33 0 0 0+25 75 116 26 75 0 0 0+25 75 116 26 33 0 0 0+56 6 66 75 0 0 0 0+56 6 66 33 0 0 0 0+56 6 90 75 0 0 0 0+56 6 90 33 0 0 0 0+56 6 24 75 0 0 0 0+56 6 24 33 0 0 0 0+56 6 95 75 0 0 0 0+56 6 95 33 0 0 0 0+56 6 39 75 0 0 0 0+56 6 39 33 0 0 0 0+56 6 26 75 0 0 0 0+56 6 26 33 0 0 0 0+56 6 25 33 75 0 0 0+56 6 25 33 33 0 0 0+56 6 25 75 75 0 0 0+56 6 25 75 33 0 0 0+77 6 66 75 0 0 0 0+77 6 66 33 0 0 0 0+77 6 90 75 0 0 0 0+77 6 90 33 0 0 0 0+77 6 24 75 0 0 0 0+77 6 24 33 0 0 0 0+77 6 95 75 0 0 0 0+77 6 95 33 0 0 0 0+77 6 39 75 0 0 0 0+77 6 39 33 0 0 0 0+77 6 26 75 0 0 0 0+77 6 26 33 0 0 0 0+77 6 25 33 75 0 0 0+77 6 25 33 33 0 0 0+77 6 25 75 75 0 0 0+77 6 25 75 33 0 0 0+22 6 66 75 0 0 0 0+22 6 66 33 0 0 0 0+22 6 90 75 0 0 0 0+22 6 90 33 0 0 0 0+22 6 24 75 0 0 0 0+22 6 24 33 0 0 0 0+22 6 95 75 0 0 0 0+22 6 95 33 0 0 0 0+22 6 39 75 0 0 0 0+22 6 39 33 0 0 0 0+22 6 26 75 0 0 0 0+22 6 26 33 0 0 0 0+22 6 25 33 75 0 0 0+22 6 25 33 33 0 0 0+22 6 25 75 75 0 0 0+22 6 25 75 33 0 0 0+134 6 66 75 0 0 0 0+134 6 66 33 0 0 0 0+134 6 90 75 0 0 0 0+134 6 90 33 0 0 0 0+134 6 24 75 0 0 0 0+134 6 24 33 0 0 0 0+134 6 95 75 0 0 0 0+134 6 95 33 0 0 0 0+134 6 39 75 0 0 0 0+134 6 39 33 0 0 0 0+134 6 26 75 0 0 0 0+134 6 26 33 0 0 0 0+134 6 25 33 75 0 0 0+134 6 25 33 33 0 0 0+134 6 25 75 75 0 0 0+134 6 25 75 33 0 0 0+93 6 66 75 0 0 0 0+93 6 66 33 0 0 0 0+93 6 90 75 0 0 0 0+93 6 90 33 0 0 0 0+93 6 24 75 0 0 0 0+93 6 24 33 0 0 0 0+93 6 95 75 0 0 0 0+93 6 95 33 0 0 0 0+93 6 39 75 0 0 0 0+93 6 39 33 0 0 0 0+93 6 26 75 0 0 0 0+93 6 26 33 0 0 0 0+93 6 25 33 75 0 0 0+93 6 25 33 33 0 0 0+93 6 25 75 75 0 0 0+93 6 25 75 33 0 0 0+32 6 66 75 0 0 0 0+32 6 66 33 0 0 0 0+32 6 90 75 0 0 0 0+32 6 90 33 0 0 0 0+32 6 24 75 0 0 0 0+32 6 24 33 0 0 0 0+32 6 95 75 0 0 0 0+32 6 95 33 0 0 0 0+32 6 39 75 0 0 0 0+32 6 39 33 0 0 0 0+32 6 26 75 0 0 0 0+32 6 26 33 0 0 0 0+32 6 25 33 75 0 0 0+32 6 25 33 33 0 0 0+32 6 25 75 75 0 0 0+32 6 25 75 33 0 0 0+25 33 6 66 75 0 0 0+25 33 6 66 33 0 0 0+25 33 6 90 75 0 0 0+25 33 6 90 33 0 0 0+25 33 6 24 75 0 0 0+25 33 6 24 33 0 0 0+25 33 6 95 75 0 0 0+25 33 6 95 33 0 0 0+25 33 6 39 75 0 0 0+25 33 6 39 33 0 0 0+25 33 6 26 75 0 0 0+25 33 6 26 33 0 0 0+25 75 6 66 75 0 0 0+25 75 6 66 33 0 0 0+25 75 6 90 75 0 0 0+25 75 6 90 33 0 0 0+25 75 6 24 75 0 0 0+25 75 6 24 33 0 0 0+25 75 6 95 75 0 0 0+25 75 6 95 33 0 0 0+25 75 6 39 75 0 0 0+25 75 6 39 33 0 0 0+25 75 6 26 75 0 0 0+25 75 6 26 33 0 0 0+56 147 66 75 0 0 0 0+56 147 66 33 0 0 0 0+56 147 90 75 0 0 0 0+56 147 90 33 0 0 0 0+56 147 24 75 0 0 0 0+56 147 24 33 0 0 0 0+56 147 95 75 0 0 0 0+56 147 95 33 0 0 0 0+56 147 39 75 0 0 0 0+56 147 39 33 0 0 0 0+56 147 26 75 0 0 0 0+56 147 26 33 0 0 0 0+56 147 25 33 75 0 0 0+56 147 25 33 33 0 0 0+56 147 25 75 75 0 0 0+56 147 25 75 33 0 0 0+77 147 66 75 0 0 0 0+77 147 66 33 0 0 0 0+77 147 90 75 0 0 0 0+77 147 90 33 0 0 0 0+77 147 24 75 0 0 0 0+77 147 24 33 0 0 0 0+77 147 95 75 0 0 0 0+77 147 95 33 0 0 0 0+77 147 39 75 0 0 0 0+77 147 39 33 0 0 0 0+77 147 26 75 0 0 0 0+77 147 26 33 0 0 0 0+77 147 25 33 75 0 0 0+77 147 25 33 33 0 0 0+77 147 25 75 75 0 0 0+77 147 25 75 33 0 0 0+22 147 66 75 0 0 0 0+22 147 66 33 0 0 0 0+22 147 90 75 0 0 0 0+22 147 90 33 0 0 0 0+22 147 24 75 0 0 0 0+22 147 24 33 0 0 0 0+22 147 95 75 0 0 0 0+22 147 95 33 0 0 0 0+22 147 39 75 0 0 0 0+22 147 39 33 0 0 0 0+22 147 26 75 0 0 0 0+22 147 26 33 0 0 0 0+22 147 25 33 75 0 0 0+22 147 25 33 33 0 0 0+22 147 25 75 75 0 0 0+22 147 25 75 33 0 0 0+134 147 66 75 0 0 0 0+134 147 66 33 0 0 0 0+134 147 90 75 0 0 0 0+134 147 90 33 0 0 0 0+134 147 24 75 0 0 0 0+134 147 24 33 0 0 0 0+134 147 95 75 0 0 0 0+134 147 95 33 0 0 0 0+134 147 39 75 0 0 0 0+134 147 39 33 0 0 0 0+134 147 26 75 0 0 0 0+134 147 26 33 0 0 0 0+134 147 25 33 75 0 0 0+134 147 25 33 33 0 0 0+134 147 25 75 75 0 0 0+134 147 25 75 33 0 0 0+93 147 66 75 0 0 0 0+93 147 66 33 0 0 0 0+93 147 90 75 0 0 0 0+93 147 90 33 0 0 0 0+93 147 24 75 0 0 0 0+93 147 24 33 0 0 0 0+93 147 95 75 0 0 0 0+93 147 95 33 0 0 0 0+93 147 39 75 0 0 0 0+93 147 39 33 0 0 0 0+93 147 26 75 0 0 0 0+93 147 26 33 0 0 0 0+93 147 25 33 75 0 0 0+93 147 25 33 33 0 0 0+93 147 25 75 75 0 0 0+93 147 25 75 33 0 0 0+32 147 66 75 0 0 0 0+32 147 66 33 0 0 0 0+32 147 90 75 0 0 0 0+32 147 90 33 0 0 0 0+32 147 24 75 0 0 0 0+32 147 24 33 0 0 0 0+32 147 95 75 0 0 0 0+32 147 95 33 0 0 0 0+32 147 39 75 0 0 0 0+32 147 39 33 0 0 0 0+32 147 26 75 0 0 0 0+32 147 26 33 0 0 0 0+32 147 25 33 75 0 0 0+32 147 25 33 33 0 0 0+32 147 25 75 75 0 0 0+32 147 25 75 33 0 0 0+25 33 147 66 75 0 0 0+25 33 147 66 33 0 0 0+25 33 147 90 75 0 0 0+25 33 147 90 33 0 0 0+25 33 147 24 75 0 0 0+25 33 147 24 33 0 0 0+25 33 147 95 75 0 0 0+25 33 147 95 33 0 0 0+25 33 147 39 75 0 0 0+25 33 147 39 33 0 0 0+25 33 147 26 75 0 0 0+25 33 147 26 33 0 0 0+25 75 147 66 75 0 0 0+25 75 147 66 33 0 0 0+25 75 147 90 75 0 0 0+25 75 147 90 33 0 0 0+25 75 147 24 75 0 0 0+25 75 147 24 33 0 0 0+25 75 147 95 75 0 0 0+25 75 147 95 33 0 0 0+25 75 147 39 75 0 0 0+25 75 147 39 33 0 0 0+25 75 147 26 75 0 0 0+25 75 147 26 33 0 0 0+56 148 66 0 0 0 0 0+77 148 66 0 0 0 0 0+22 148 66 0 0 0 0 0+134 148 66 0 0 0 0 0+93 148 66 0 0 0 0 0+32 148 66 0 0 0 0 0+25 33 148 66 0 0 0 0+25 75 148 66 0 0 0 0+56 148 90 0 0 0 0 0+77 148 90 0 0 0 0 0+22 148 90 0 0 0 0 0+134 148 90 0 0 0 0 0+93 148 90 0 0 0 0 0+32 148 90 0 0 0 0 0+25 33 148 90 0 0 0 0+25 75 148 90 0 0 0 0+56 148 24 0 0 0 0 0+77 148 24 0 0 0 0 0+22 148 24 0 0 0 0 0+134 148 24 0 0 0 0 0+93 148 24 0 0 0 0 0+32 148 24 0 0 0 0 0+25 33 148 24 0 0 0 0+25 75 148 24 0 0 0 0+56 148 95 0 0 0 0 0+77 148 95 0 0 0 0 0+22 148 95 0 0 0 0 0+134 148 95 0 0 0 0 0+93 148 95 0 0 0 0 0+32 148 95 0 0 0 0 0+25 33 148 95 0 0 0 0+25 75 148 95 0 0 0 0+56 148 39 0 0 0 0 0+77 148 39 0 0 0 0 0+22 148 39 0 0 0 0 0+134 148 39 0 0 0 0 0+93 148 39 0 0 0 0 0+32 148 39 0 0 0 0 0+25 33 148 39 0 0 0 0+25 75 148 39 0 0 0 0+56 148 26 0 0 0 0 0+77 148 26 0 0 0 0 0+22 148 26 0 0 0 0 0+134 148 26 0 0 0 0 0+93 148 26 0 0 0 0 0+32 148 26 0 0 0 0 0+25 33 148 26 0 0 0 0+25 75 148 26 0 0 0 0+56 148 25 33 0 0 0 0+77 148 25 33 0 0 0 0+22 148 25 33 0 0 0 0+134 148 25 33 0 0 0 0+93 148 25 33 0 0 0 0+32 148 25 33 0 0 0 0+56 148 25 75 0 0 0 0+77 148 25 75 0 0 0 0+22 148 25 75 0 0 0 0+134 148 25 75 0 0 0 0+93 148 25 75 0 0 0 0+32 148 25 75 0 0 0 0+56 4 0 0 0 0 0 0+77 4 0 0 0 0 0 0+22 4 0 0 0 0 0 0+134 4 0 0 0 0 0 0+93 4 0 0 0 0 0 0+32 4 0 0 0 0 0 0+56 119 0 0 0 0 0 0+77 119 0 0 0 0 0 0+22 119 0 0 0 0 0 0+134 119 0 0 0 0 0 0+93 119 0 0 0 0 0 0+32 119 0 0 0 0 0 0+56 54 0 0 0 0 0 0+77 54 0 0 0 0 0 0+22 54 0 0 0 0 0 0+134 54 0 0 0 0 0 0+93 54 0 0 0 0 0 0+32 54 0 0 0 0 0 0+56 67 0 0 0 0 0 0+77 67 0 0 0 0 0 0+22 67 0 0 0 0 0 0+134 67 0 0 0 0 0 0+93 67 0 0 0 0 0 0+32 67 0 0 0 0 0 0+56 55 94 0 0 0 0 0+77 55 94 0 0 0 0 0+22 55 94 0 0 0 0 0+134 55 94 0 0 0 0 0+93 55 94 0 0 0 0 0+32 55 94 0 0 0 0 0+56 27 66 0 0 0 0 0+56 27 90 0 0 0 0 0+56 27 24 0 0 0 0 0+56 27 95 0 0 0 0 0+56 27 39 0 0 0 0 0+56 27 26 0 0 0 0 0+56 27 25 33 0 0 0 0+56 27 25 75 0 0 0 0+77 27 66 0 0 0 0 0+77 27 90 0 0 0 0 0+77 27 24 0 0 0 0 0+77 27 95 0 0 0 0 0+77 27 39 0 0 0 0 0+77 27 26 0 0 0 0 0+77 27 25 33 0 0 0 0+77 27 25 75 0 0 0 0+22 27 66 0 0 0 0 0+22 27 90 0 0 0 0 0+22 27 24 0 0 0 0 0+22 27 95 0 0 0 0 0+22 27 39 0 0 0 0 0+22 27 26 0 0 0 0 0+22 27 25 33 0 0 0 0+22 27 25 75 0 0 0 0+134 27 66 0 0 0 0 0+134 27 90 0 0 0 0 0+134 27 24 0 0 0 0 0+134 27 95 0 0 0 0 0+134 27 39 0 0 0 0 0+134 27 26 0 0 0 0 0+134 27 25 33 0 0 0 0+134 27 25 75 0 0 0 0+93 27 66 0 0 0 0 0+93 27 90 0 0 0 0 0+93 27 24 0 0 0 0 0+93 27 95 0 0 0 0 0+93 27 39 0 0 0 0 0+93 27 26 0 0 0 0 0+93 27 25 33 0 0 0 0+93 27 25 75 0 0 0 0+32 27 66 0 0 0 0 0+32 27 90 0 0 0 0 0+32 27 24 0 0 0 0 0+32 27 95 0 0 0 0 0+32 27 39 0 0 0 0 0+32 27 26 0 0 0 0 0+32 27 25 33 0 0 0 0+32 27 25 75 0 0 0 0+25 33 27 66 0 0 0 0+25 33 27 90 0 0 0 0+25 33 27 24 0 0 0 0+25 33 27 95 0 0 0 0+25 33 27 39 0 0 0 0+25 33 27 26 0 0 0 0+25 75 27 66 0 0 0 0+25 75 27 90 0 0 0 0+25 75 27 24 0 0 0 0+25 75 27 95 0 0 0 0+25 75 27 39 0 0 0 0+25 75 27 26 0 0 0 0+56 149 66 0 0 0 0 0+56 149 90 0 0 0 0 0+56 149 24 0 0 0 0 0+56 149 95 0 0 0 0 0+56 149 39 0 0 0 0 0+56 149 26 0 0 0 0 0+56 149 25 33 0 0 0 0+56 149 25 75 0 0 0 0+77 149 66 0 0 0 0 0+77 149 90 0 0 0 0 0+77 149 24 0 0 0 0 0+77 149 95 0 0 0 0 0+77 149 39 0 0 0 0 0+77 149 26 0 0 0 0 0+77 149 25 33 0 0 0 0+77 149 25 75 0 0 0 0+22 149 66 0 0 0 0 0+22 149 90 0 0 0 0 0+22 149 24 0 0 0 0 0+22 149 95 0 0 0 0 0+22 149 39 0 0 0 0 0+22 149 26 0 0 0 0 0+22 149 25 33 0 0 0 0+22 149 25 75 0 0 0 0+134 149 66 0 0 0 0 0+134 149 90 0 0 0 0 0+134 149 24 0 0 0 0 0+134 149 95 0 0 0 0 0+134 149 39 0 0 0 0 0+134 149 26 0 0 0 0 0+134 149 25 33 0 0 0 0+134 149 25 75 0 0 0 0+93 149 66 0 0 0 0 0+93 149 90 0 0 0 0 0+93 149 24 0 0 0 0 0+93 149 95 0 0 0 0 0+93 149 39 0 0 0 0 0+93 149 26 0 0 0 0 0+93 149 25 33 0 0 0 0+93 149 25 75 0 0 0 0+32 149 66 0 0 0 0 0+32 149 90 0 0 0 0 0+32 149 24 0 0 0 0 0+32 149 95 0 0 0 0 0+32 149 39 0 0 0 0 0+32 149 26 0 0 0 0 0+32 149 25 33 0 0 0 0+32 149 25 75 0 0 0 0+25 33 149 66 0 0 0 0+25 33 149 90 0 0 0 0+25 33 149 24 0 0 0 0+25 33 149 95 0 0 0 0+25 33 149 39 0 0 0 0+25 33 149 26 0 0 0 0+25 75 149 66 0 0 0 0+25 75 149 90 0 0 0 0+25 75 149 24 0 0 0 0+25 75 149 95 0 0 0 0+25 75 149 39 0 0 0 0+25 75 149 26 0 0 0 0+56 57 66 0 0 0 0 0+56 57 90 0 0 0 0 0+56 57 24 0 0 0 0 0+56 57 95 0 0 0 0 0+56 57 39 0 0 0 0 0+56 57 26 0 0 0 0 0+56 57 25 33 0 0 0 0+56 57 25 75 0 0 0 0+77 57 66 0 0 0 0 0+77 57 90 0 0 0 0 0+77 57 24 0 0 0 0 0+77 57 95 0 0 0 0 0+77 57 39 0 0 0 0 0+77 57 26 0 0 0 0 0+77 57 25 33 0 0 0 0+77 57 25 75 0 0 0 0+22 57 66 0 0 0 0 0+22 57 90 0 0 0 0 0+22 57 24 0 0 0 0 0+22 57 95 0 0 0 0 0+22 57 39 0 0 0 0 0+22 57 26 0 0 0 0 0+22 57 25 33 0 0 0 0+22 57 25 75 0 0 0 0+134 57 66 0 0 0 0 0+134 57 90 0 0 0 0 0+134 57 24 0 0 0 0 0+134 57 95 0 0 0 0 0+134 57 39 0 0 0 0 0+134 57 26 0 0 0 0 0+134 57 25 33 0 0 0 0+134 57 25 75 0 0 0 0+93 57 66 0 0 0 0 0+93 57 90 0 0 0 0 0+93 57 24 0 0 0 0 0+93 57 95 0 0 0 0 0+93 57 39 0 0 0 0 0+93 57 26 0 0 0 0 0+93 57 25 33 0 0 0 0+93 57 25 75 0 0 0 0+32 57 66 0 0 0 0 0+32 57 90 0 0 0 0 0+32 57 24 0 0 0 0 0+32 57 95 0 0 0 0 0+32 57 39 0 0 0 0 0+32 57 26 0 0 0 0 0+32 57 25 33 0 0 0 0+32 57 25 75 0 0 0 0+25 33 57 66 0 0 0 0+25 33 57 90 0 0 0 0+25 33 57 24 0 0 0 0+25 33 57 95 0 0 0 0+25 33 57 39 0 0 0 0+25 33 57 26 0 0 0 0+25 75 57 66 0 0 0 0+25 75 57 90 0 0 0 0+25 75 57 24 0 0 0 0+25 75 57 95 0 0 0 0+25 75 57 39 0 0 0 0+25 75 57 26 0 0 0 0+56 105 66 0 0 0 0 0+56 105 90 0 0 0 0 0+56 105 24 0 0 0 0 0+56 105 95 0 0 0 0 0+56 105 39 0 0 0 0 0+56 105 26 0 0 0 0 0+56 105 25 33 0 0 0 0+56 105 25 75 0 0 0 0+77 105 66 0 0 0 0 0+77 105 90 0 0 0 0 0+77 105 24 0 0 0 0 0+77 105 95 0 0 0 0 0+77 105 39 0 0 0 0 0+77 105 26 0 0 0 0 0+77 105 25 33 0 0 0 0+77 105 25 75 0 0 0 0+22 105 66 0 0 0 0 0+22 105 90 0 0 0 0 0+22 105 24 0 0 0 0 0+22 105 95 0 0 0 0 0+22 105 39 0 0 0 0 0+22 105 26 0 0 0 0 0+22 105 25 33 0 0 0 0+22 105 25 75 0 0 0 0+134 105 66 0 0 0 0 0+134 105 90 0 0 0 0 0+134 105 24 0 0 0 0 0+134 105 95 0 0 0 0 0+134 105 39 0 0 0 0 0+134 105 26 0 0 0 0 0+134 105 25 33 0 0 0 0+134 105 25 75 0 0 0 0+93 105 66 0 0 0 0 0+93 105 90 0 0 0 0 0+93 105 24 0 0 0 0 0+93 105 95 0 0 0 0 0+93 105 39 0 0 0 0 0+93 105 26 0 0 0 0 0+93 105 25 33 0 0 0 0+93 105 25 75 0 0 0 0+32 105 66 0 0 0 0 0+32 105 90 0 0 0 0 0+32 105 24 0 0 0 0 0+32 105 95 0 0 0 0 0+32 105 39 0 0 0 0 0+32 105 26 0 0 0 0 0+32 105 25 33 0 0 0 0+32 105 25 75 0 0 0 0+25 33 105 66 0 0 0 0+25 33 105 90 0 0 0 0+25 33 105 24 0 0 0 0+25 33 105 95 0 0 0 0+25 33 105 39 0 0 0 0+25 33 105 26 0 0 0 0+25 75 105 66 0 0 0 0+25 75 105 90 0 0 0 0+25 75 105 24 0 0 0 0+25 75 105 95 0 0 0 0+25 75 105 39 0 0 0 0+25 75 105 26 0 0 0 0+56 102 87 66 0 0 0 0+56 102 87 90 0 0 0 0+56 102 87 24 0 0 0 0+56 102 87 95 0 0 0 0+56 102 87 39 0 0 0 0+56 102 87 26 0 0 0 0+56 102 87 25 33 0 0 0+56 102 87 25 75 0 0 0+77 102 87 66 0 0 0 0+77 102 87 90 0 0 0 0+77 102 87 24 0 0 0 0+77 102 87 95 0 0 0 0+77 102 87 39 0 0 0 0+77 102 87 26 0 0 0 0+77 102 87 25 33 0 0 0+77 102 87 25 75 0 0 0+22 102 87 66 0 0 0 0+22 102 87 90 0 0 0 0+22 102 87 24 0 0 0 0+22 102 87 95 0 0 0 0+22 102 87 39 0 0 0 0+22 102 87 26 0 0 0 0+22 102 87 25 33 0 0 0+22 102 87 25 75 0 0 0+134 102 87 66 0 0 0 0+134 102 87 90 0 0 0 0+134 102 87 24 0 0 0 0+134 102 87 95 0 0 0 0+134 102 87 39 0 0 0 0+134 102 87 26 0 0 0 0+134 102 87 25 33 0 0 0+134 102 87 25 75 0 0 0+93 102 87 66 0 0 0 0+93 102 87 90 0 0 0 0+93 102 87 24 0 0 0 0+93 102 87 95 0 0 0 0+93 102 87 39 0 0 0 0+93 102 87 26 0 0 0 0+93 102 87 25 33 0 0 0+93 102 87 25 75 0 0 0+32 102 87 66 0 0 0 0+32 102 87 90 0 0 0 0+32 102 87 24 0 0 0 0+32 102 87 95 0 0 0 0+32 102 87 39 0 0 0 0+32 102 87 26 0 0 0 0+32 102 87 25 33 0 0 0+32 102 87 25 75 0 0 0+25 33 102 87 66 0 0 0+25 33 102 87 90 0 0 0+25 33 102 87 24 0 0 0+25 33 102 87 95 0 0 0+25 33 102 87 39 0 0 0+25 33 102 87 26 0 0 0+25 75 102 87 66 0 0 0+25 75 102 87 90 0 0 0+25 75 102 87 24 0 0 0+25 75 102 87 95 0 0 0+25 75 102 87 39 0 0 0+25 75 102 87 26 0 0 0+56 116 66 0 0 0 0 0+56 116 90 0 0 0 0 0+56 116 24 0 0 0 0 0+56 116 95 0 0 0 0 0+56 116 39 0 0 0 0 0+56 116 26 0 0 0 0 0+56 116 25 33 0 0 0 0+56 116 25 75 0 0 0 0+77 116 66 0 0 0 0 0+77 116 90 0 0 0 0 0+77 116 24 0 0 0 0 0+77 116 95 0 0 0 0 0+77 116 39 0 0 0 0 0+77 116 26 0 0 0 0 0+77 116 25 33 0 0 0 0+77 116 25 75 0 0 0 0+22 116 66 0 0 0 0 0+22 116 90 0 0 0 0 0+22 116 24 0 0 0 0 0+22 116 95 0 0 0 0 0+22 116 39 0 0 0 0 0+22 116 26 0 0 0 0 0+22 116 25 33 0 0 0 0+22 116 25 75 0 0 0 0+134 116 66 0 0 0 0 0+134 116 90 0 0 0 0 0+134 116 24 0 0 0 0 0+134 116 95 0 0 0 0 0+134 116 39 0 0 0 0 0+134 116 26 0 0 0 0 0+134 116 25 33 0 0 0 0+134 116 25 75 0 0 0 0+93 116 66 0 0 0 0 0+93 116 90 0 0 0 0 0+93 116 24 0 0 0 0 0+93 116 95 0 0 0 0 0+93 116 39 0 0 0 0 0+93 116 26 0 0 0 0 0+93 116 25 33 0 0 0 0+93 116 25 75 0 0 0 0+32 116 66 0 0 0 0 0+32 116 90 0 0 0 0 0+32 116 24 0 0 0 0 0+32 116 95 0 0 0 0 0+32 116 39 0 0 0 0 0+32 116 26 0 0 0 0 0+32 116 25 33 0 0 0 0+32 116 25 75 0 0 0 0+25 33 116 66 0 0 0 0+25 33 116 90 0 0 0 0+25 33 116 24 0 0 0 0+25 33 116 95 0 0 0 0+25 33 116 39 0 0 0 0+25 33 116 26 0 0 0 0+25 75 116 66 0 0 0 0+25 75 116 90 0 0 0 0+25 75 116 24 0 0 0 0+25 75 116 95 0 0 0 0+25 75 116 39 0 0 0 0+25 75 116 26 0 0 0 0+56 6 66 0 0 0 0 0+56 6 90 0 0 0 0 0+56 6 24 0 0 0 0 0+56 6 95 0 0 0 0 0+56 6 39 0 0 0 0 0+56 6 26 0 0 0 0 0+56 6 25 33 0 0 0 0+56 6 25 75 0 0 0 0+77 6 66 0 0 0 0 0+77 6 90 0 0 0 0 0+77 6 24 0 0 0 0 0+77 6 95 0 0 0 0 0+77 6 39 0 0 0 0 0+77 6 26 0 0 0 0 0+77 6 25 33 0 0 0 0+77 6 25 75 0 0 0 0+22 6 66 0 0 0 0 0+22 6 90 0 0 0 0 0+22 6 24 0 0 0 0 0+22 6 95 0 0 0 0 0+22 6 39 0 0 0 0 0+22 6 26 0 0 0 0 0+22 6 25 33 0 0 0 0+22 6 25 75 0 0 0 0+134 6 66 0 0 0 0 0+134 6 90 0 0 0 0 0+134 6 24 0 0 0 0 0+134 6 95 0 0 0 0 0+134 6 39 0 0 0 0 0+134 6 26 0 0 0 0 0+134 6 25 33 0 0 0 0+134 6 25 75 0 0 0 0+93 6 66 0 0 0 0 0+93 6 90 0 0 0 0 0+93 6 24 0 0 0 0 0+93 6 95 0 0 0 0 0+93 6 39 0 0 0 0 0+93 6 26 0 0 0 0 0+93 6 25 33 0 0 0 0+93 6 25 75 0 0 0 0+32 6 66 0 0 0 0 0+32 6 90 0 0 0 0 0+32 6 24 0 0 0 0 0+32 6 95 0 0 0 0 0+32 6 39 0 0 0 0 0+32 6 26 0 0 0 0 0+32 6 25 33 0 0 0 0+32 6 25 75 0 0 0 0+25 33 6 66 0 0 0 0+25 33 6 90 0 0 0 0+25 33 6 24 0 0 0 0+25 33 6 95 0 0 0 0+25 33 6 39 0 0 0 0+25 33 6 26 0 0 0 0+25 75 6 66 0 0 0 0+25 75 6 90 0 0 0 0+25 75 6 24 0 0 0 0+25 75 6 95 0 0 0 0+25 75 6 39 0 0 0 0+25 75 6 26 0 0 0 0+56 147 66 0 0 0 0 0+56 147 90 0 0 0 0 0+56 147 24 0 0 0 0 0+56 147 95 0 0 0 0 0+56 147 39 0 0 0 0 0+56 147 26 0 0 0 0 0+56 147 25 33 0 0 0 0+56 147 25 75 0 0 0 0+77 147 66 0 0 0 0 0+77 147 90 0 0 0 0 0+77 147 24 0 0 0 0 0+77 147 95 0 0 0 0 0+77 147 39 0 0 0 0 0+77 147 26 0 0 0 0 0+77 147 25 33 0 0 0 0+77 147 25 75 0 0 0 0+22 147 66 0 0 0 0 0+22 147 90 0 0 0 0 0+22 147 24 0 0 0 0 0+22 147 95 0 0 0 0 0+22 147 39 0 0 0 0 0+22 147 26 0 0 0 0 0+22 147 25 33 0 0 0 0+22 147 25 75 0 0 0 0+134 147 66 0 0 0 0 0+134 147 90 0 0 0 0 0+134 147 24 0 0 0 0 0+134 147 95 0 0 0 0 0+134 147 39 0 0 0 0 0+134 147 26 0 0 0 0 0+134 147 25 33 0 0 0 0+134 147 25 75 0 0 0 0+93 147 66 0 0 0 0 0+93 147 90 0 0 0 0 0+93 147 24 0 0 0 0 0+93 147 95 0 0 0 0 0+93 147 39 0 0 0 0 0+93 147 26 0 0 0 0 0+93 147 25 33 0 0 0 0+93 147 25 75 0 0 0 0+32 147 66 0 0 0 0 0+32 147 90 0 0 0 0 0+32 147 24 0 0 0 0 0+32 147 95 0 0 0 0 0+32 147 39 0 0 0 0 0+32 147 26 0 0 0 0 0+32 147 25 33 0 0 0 0+32 147 25 75 0 0 0 0+25 33 147 66 0 0 0 0+25 33 147 90 0 0 0 0+25 33 147 24 0 0 0 0+25 33 147 95 0 0 0 0+25 33 147 39 0 0 0 0+25 33 147 26 0 0 0 0+25 75 147 66 0 0 0 0+25 75 147 90 0 0 0 0+25 75 147 24 0 0 0 0+25 75 147 95 0 0 0 0+25 75 147 39 0 0 0 0+25 75 147 26 0 0 0 0+56 27 8 0 0 0 0 0+56 27 133 0 0 0 0 0+56 27 84 0 0 0 0 0+56 27 85 0 0 0 0 0+56 27 88 0 0 0 0 0+56 27 113 0 0 0 0 0+77 27 8 0 0 0 0 0+77 27 133 0 0 0 0 0+77 27 84 0 0 0 0 0+77 27 85 0 0 0 0 0+77 27 88 0 0 0 0 0+77 27 113 0 0 0 0 0+22 27 8 0 0 0 0 0+22 27 133 0 0 0 0 0+22 27 84 0 0 0 0 0+22 27 85 0 0 0 0 0+22 27 88 0 0 0 0 0+22 27 113 0 0 0 0 0+134 27 8 0 0 0 0 0+134 27 133 0 0 0 0 0+134 27 84 0 0 0 0 0+134 27 85 0 0 0 0 0+134 27 88 0 0 0 0 0+134 27 113 0 0 0 0 0+93 27 8 0 0 0 0 0+93 27 133 0 0 0 0 0+93 27 84 0 0 0 0 0+93 27 85 0 0 0 0 0+93 27 88 0 0 0 0 0+93 27 113 0 0 0 0 0+32 27 8 0 0 0 0 0+32 27 133 0 0 0 0 0+32 27 84 0 0 0 0 0+32 27 85 0 0 0 0 0+32 27 88 0 0 0 0 0+32 27 113 0 0 0 0 0+25 33 27 8 0 0 0 0+25 33 27 133 0 0 0 0+25 33 27 84 0 0 0 0+25 33 27 85 0 0 0 0+25 33 27 88 0 0 0 0+25 33 27 113 0 0 0 0+25 75 27 8 0 0 0 0+25 75 27 133 0 0 0 0+25 75 27 84 0 0 0 0+25 75 27 85 0 0 0 0+25 75 27 88 0 0 0 0+25 75 27 113 0 0 0 0+56 149 8 0 0 0 0 0+56 149 133 0 0 0 0 0+56 149 84 0 0 0 0 0+56 149 85 0 0 0 0 0+56 149 88 0 0 0 0 0+56 149 113 0 0 0 0 0+77 149 8 0 0 0 0 0+77 149 133 0 0 0 0 0+77 149 84 0 0 0 0 0+77 149 85 0 0 0 0 0+77 149 88 0 0 0 0 0+77 149 113 0 0 0 0 0+22 149 8 0 0 0 0 0+22 149 133 0 0 0 0 0+22 149 84 0 0 0 0 0+22 149 85 0 0 0 0 0+22 149 88 0 0 0 0 0+22 149 113 0 0 0 0 0+134 149 8 0 0 0 0 0+134 149 133 0 0 0 0 0+134 149 84 0 0 0 0 0+134 149 85 0 0 0 0 0+134 149 88 0 0 0 0 0+134 149 113 0 0 0 0 0+93 149 8 0 0 0 0 0+93 149 133 0 0 0 0 0+93 149 84 0 0 0 0 0+93 149 85 0 0 0 0 0+93 149 88 0 0 0 0 0+93 149 113 0 0 0 0 0+32 149 8 0 0 0 0 0+32 149 133 0 0 0 0 0+32 149 84 0 0 0 0 0+32 149 85 0 0 0 0 0+32 149 88 0 0 0 0 0+32 149 113 0 0 0 0 0+25 33 149 8 0 0 0 0+25 33 149 133 0 0 0 0+25 33 149 84 0 0 0 0+25 33 149 85 0 0 0 0+25 33 149 88 0 0 0 0+25 33 149 113 0 0 0 0+25 75 149 8 0 0 0 0+25 75 149 133 0 0 0 0+25 75 149 84 0 0 0 0+25 75 149 85 0 0 0 0+25 75 149 88 0 0 0 0+25 75 149 113 0 0 0 0+56 57 8 0 0 0 0 0+56 57 133 0 0 0 0 0+56 57 84 0 0 0 0 0+56 57 85 0 0 0 0 0+56 57 88 0 0 0 0 0+56 57 113 0 0 0 0 0+77 57 8 0 0 0 0 0+77 57 133 0 0 0 0 0+77 57 84 0 0 0 0 0+77 57 85 0 0 0 0 0+77 57 88 0 0 0 0 0+77 57 113 0 0 0 0 0+22 57 8 0 0 0 0 0+22 57 133 0 0 0 0 0+22 57 84 0 0 0 0 0+22 57 85 0 0 0 0 0+22 57 88 0 0 0 0 0+22 57 113 0 0 0 0 0+134 57 8 0 0 0 0 0+134 57 133 0 0 0 0 0+134 57 84 0 0 0 0 0+134 57 85 0 0 0 0 0+134 57 88 0 0 0 0 0+134 57 113 0 0 0 0 0+93 57 8 0 0 0 0 0+93 57 133 0 0 0 0 0+93 57 84 0 0 0 0 0+93 57 85 0 0 0 0 0+93 57 88 0 0 0 0 0+93 57 113 0 0 0 0 0+32 57 8 0 0 0 0 0+32 57 133 0 0 0 0 0+32 57 84 0 0 0 0 0+32 57 85 0 0 0 0 0+32 57 88 0 0 0 0 0+32 57 113 0 0 0 0 0+25 33 57 8 0 0 0 0+25 33 57 133 0 0 0 0+25 33 57 84 0 0 0 0+25 33 57 85 0 0 0 0+25 33 57 88 0 0 0 0+25 33 57 113 0 0 0 0+25 75 57 8 0 0 0 0+25 75 57 133 0 0 0 0+25 75 57 84 0 0 0 0+25 75 57 85 0 0 0 0+25 75 57 88 0 0 0 0+25 75 57 113 0 0 0 0+56 105 8 0 0 0 0 0+56 105 133 0 0 0 0 0+56 105 84 0 0 0 0 0+56 105 85 0 0 0 0 0+56 105 88 0 0 0 0 0+56 105 113 0 0 0 0 0+77 105 8 0 0 0 0 0+77 105 133 0 0 0 0 0+77 105 84 0 0 0 0 0+77 105 85 0 0 0 0 0+77 105 88 0 0 0 0 0+77 105 113 0 0 0 0 0+22 105 8 0 0 0 0 0+22 105 133 0 0 0 0 0+22 105 84 0 0 0 0 0+22 105 85 0 0 0 0 0+22 105 88 0 0 0 0 0+22 105 113 0 0 0 0 0+134 105 8 0 0 0 0 0+134 105 133 0 0 0 0 0+134 105 84 0 0 0 0 0+134 105 85 0 0 0 0 0+134 105 88 0 0 0 0 0+134 105 113 0 0 0 0 0+93 105 8 0 0 0 0 0+93 105 133 0 0 0 0 0+93 105 84 0 0 0 0 0+93 105 85 0 0 0 0 0+93 105 88 0 0 0 0 0+93 105 113 0 0 0 0 0+32 105 8 0 0 0 0 0+32 105 133 0 0 0 0 0+32 105 84 0 0 0 0 0+32 105 85 0 0 0 0 0+32 105 88 0 0 0 0 0+32 105 113 0 0 0 0 0+25 33 105 8 0 0 0 0+25 33 105 133 0 0 0 0+25 33 105 84 0 0 0 0+25 33 105 85 0 0 0 0+25 33 105 88 0 0 0 0+25 33 105 113 0 0 0 0+25 75 105 8 0 0 0 0+25 75 105 133 0 0 0 0+25 75 105 84 0 0 0 0+25 75 105 85 0 0 0 0+25 75 105 88 0 0 0 0+25 75 105 113 0 0 0 0+56 102 87 8 0 0 0 0+56 102 87 133 0 0 0 0+56 102 87 84 0 0 0 0+56 102 87 85 0 0 0 0+56 102 87 88 0 0 0 0+56 102 87 113 0 0 0 0+77 102 87 8 0 0 0 0+77 102 87 133 0 0 0 0+77 102 87 84 0 0 0 0+77 102 87 85 0 0 0 0+77 102 87 88 0 0 0 0+77 102 87 113 0 0 0 0+22 102 87 8 0 0 0 0+22 102 87 133 0 0 0 0+22 102 87 84 0 0 0 0+22 102 87 85 0 0 0 0+22 102 87 88 0 0 0 0+22 102 87 113 0 0 0 0+134 102 87 8 0 0 0 0+134 102 87 133 0 0 0 0+134 102 87 84 0 0 0 0+134 102 87 85 0 0 0 0+134 102 87 88 0 0 0 0+134 102 87 113 0 0 0 0+93 102 87 8 0 0 0 0+93 102 87 133 0 0 0 0+93 102 87 84 0 0 0 0+93 102 87 85 0 0 0 0+93 102 87 88 0 0 0 0+93 102 87 113 0 0 0 0+32 102 87 8 0 0 0 0+32 102 87 133 0 0 0 0+32 102 87 84 0 0 0 0+32 102 87 85 0 0 0 0+32 102 87 88 0 0 0 0+32 102 87 113 0 0 0 0+25 33 102 87 8 0 0 0+25 33 102 87 133 0 0 0+25 33 102 87 84 0 0 0+25 33 102 87 85 0 0 0+25 33 102 87 88 0 0 0+25 33 102 87 113 0 0 0+25 75 102 87 8 0 0 0+25 75 102 87 133 0 0 0+25 75 102 87 84 0 0 0+25 75 102 87 85 0 0 0+25 75 102 87 88 0 0 0+25 75 102 87 113 0 0 0+56 116 8 0 0 0 0 0+56 116 133 0 0 0 0 0+56 116 84 0 0 0 0 0+56 116 85 0 0 0 0 0+56 116 88 0 0 0 0 0+56 116 113 0 0 0 0 0+77 116 8 0 0 0 0 0+77 116 133 0 0 0 0 0+77 116 84 0 0 0 0 0+77 116 85 0 0 0 0 0+77 116 88 0 0 0 0 0+77 116 113 0 0 0 0 0+22 116 8 0 0 0 0 0+22 116 133 0 0 0 0 0+22 116 84 0 0 0 0 0+22 116 85 0 0 0 0 0+22 116 88 0 0 0 0 0+22 116 113 0 0 0 0 0+134 116 8 0 0 0 0 0+134 116 133 0 0 0 0 0+134 116 84 0 0 0 0 0+134 116 85 0 0 0 0 0+134 116 88 0 0 0 0 0+134 116 113 0 0 0 0 0+93 116 8 0 0 0 0 0+93 116 133 0 0 0 0 0+93 116 84 0 0 0 0 0+93 116 85 0 0 0 0 0+93 116 88 0 0 0 0 0+93 116 113 0 0 0 0 0+32 116 8 0 0 0 0 0+32 116 133 0 0 0 0 0+32 116 84 0 0 0 0 0+32 116 85 0 0 0 0 0+32 116 88 0 0 0 0 0+32 116 113 0 0 0 0 0+25 33 116 8 0 0 0 0+25 33 116 133 0 0 0 0+25 33 116 84 0 0 0 0+25 33 116 85 0 0 0 0+25 33 116 88 0 0 0 0+25 33 116 113 0 0 0 0+25 75 116 8 0 0 0 0+25 75 116 133 0 0 0 0+25 75 116 84 0 0 0 0+25 75 116 85 0 0 0 0+25 75 116 88 0 0 0 0+25 75 116 113 0 0 0 0+56 6 8 0 0 0 0 0+56 6 133 0 0 0 0 0+56 6 84 0 0 0 0 0+56 6 85 0 0 0 0 0+56 6 88 0 0 0 0 0+56 6 113 0 0 0 0 0+77 6 8 0 0 0 0 0+77 6 133 0 0 0 0 0+77 6 84 0 0 0 0 0+77 6 85 0 0 0 0 0+77 6 88 0 0 0 0 0+77 6 113 0 0 0 0 0+22 6 8 0 0 0 0 0+22 6 133 0 0 0 0 0+22 6 84 0 0 0 0 0+22 6 85 0 0 0 0 0+22 6 88 0 0 0 0 0+22 6 113 0 0 0 0 0+134 6 8 0 0 0 0 0+134 6 133 0 0 0 0 0+134 6 84 0 0 0 0 0+134 6 85 0 0 0 0 0+134 6 88 0 0 0 0 0+134 6 113 0 0 0 0 0+93 6 8 0 0 0 0 0+93 6 133 0 0 0 0 0+93 6 84 0 0 0 0 0+93 6 85 0 0 0 0 0+93 6 88 0 0 0 0 0+93 6 113 0 0 0 0 0+32 6 8 0 0 0 0 0+32 6 133 0 0 0 0 0+32 6 84 0 0 0 0 0+32 6 85 0 0 0 0 0+32 6 88 0 0 0 0 0+32 6 113 0 0 0 0 0+25 33 6 8 0 0 0 0+25 33 6 133 0 0 0 0+25 33 6 84 0 0 0 0+25 33 6 85 0 0 0 0+25 33 6 88 0 0 0 0+25 33 6 113 0 0 0 0+25 75 6 8 0 0 0 0+25 75 6 133 0 0 0 0+25 75 6 84 0 0 0 0+25 75 6 85 0 0 0 0+25 75 6 88 0 0 0 0+25 75 6 113 0 0 0 0+56 147 8 0 0 0 0 0+56 147 133 0 0 0 0 0+56 147 84 0 0 0 0 0+56 147 85 0 0 0 0 0+56 147 88 0 0 0 0 0+56 147 113 0 0 0 0 0+77 147 8 0 0 0 0 0+77 147 133 0 0 0 0 0+77 147 84 0 0 0 0 0+77 147 85 0 0 0 0 0+77 147 88 0 0 0 0 0+77 147 113 0 0 0 0 0+22 147 8 0 0 0 0 0+22 147 133 0 0 0 0 0+22 147 84 0 0 0 0 0+22 147 85 0 0 0 0 0+22 147 88 0 0 0 0 0+22 147 113 0 0 0 0 0+134 147 8 0 0 0 0 0+134 147 133 0 0 0 0 0+134 147 84 0 0 0 0 0+134 147 85 0 0 0 0 0+134 147 88 0 0 0 0 0+134 147 113 0 0 0 0 0+93 147 8 0 0 0 0 0+93 147 133 0 0 0 0 0+93 147 84 0 0 0 0 0+93 147 85 0 0 0 0 0+93 147 88 0 0 0 0 0+93 147 113 0 0 0 0 0+32 147 8 0 0 0 0 0+32 147 133 0 0 0 0 0+32 147 84 0 0 0 0 0+32 147 85 0 0 0 0 0+32 147 88 0 0 0 0 0+32 147 113 0 0 0 0 0+25 33 147 8 0 0 0 0+25 33 147 133 0 0 0 0+25 33 147 84 0 0 0 0+25 33 147 85 0 0 0 0+25 33 147 88 0 0 0 0+25 33 147 113 0 0 0 0+25 75 147 8 0 0 0 0+25 75 147 133 0 0 0 0+25 75 147 84 0 0 0 0+25 75 147 85 0 0 0 0+25 75 147 88 0 0 0 0+25 75 147 113 0 0 0 0+56 44 66 130 66 0 0 0+56 44 66 130 90 0 0 0+56 44 66 130 24 0 0 0+56 44 66 130 95 0 0 0+56 44 66 130 39 0 0 0+56 44 66 130 26 0 0 0+56 44 66 130 25 33 0 0+56 44 66 130 25 75 0 0+56 44 90 130 66 0 0 0+56 44 90 130 90 0 0 0+56 44 90 130 24 0 0 0+56 44 90 130 95 0 0 0+56 44 90 130 39 0 0 0+56 44 90 130 26 0 0 0+56 44 90 130 25 33 0 0+56 44 90 130 25 75 0 0+56 44 24 130 66 0 0 0+56 44 24 130 90 0 0 0+56 44 24 130 24 0 0 0+56 44 24 130 95 0 0 0+56 44 24 130 39 0 0 0+56 44 24 130 26 0 0 0+56 44 24 130 25 33 0 0+56 44 24 130 25 75 0 0+56 44 95 130 66 0 0 0+56 44 95 130 90 0 0 0+56 44 95 130 24 0 0 0+56 44 95 130 95 0 0 0+56 44 95 130 39 0 0 0+56 44 95 130 26 0 0 0+56 44 95 130 25 33 0 0+56 44 95 130 25 75 0 0+56 44 39 130 66 0 0 0+56 44 39 130 90 0 0 0+56 44 39 130 24 0 0 0+56 44 39 130 95 0 0 0+56 44 39 130 39 0 0 0+56 44 39 130 26 0 0 0+56 44 39 130 25 33 0 0+56 44 39 130 25 75 0 0+56 44 26 130 66 0 0 0+56 44 26 130 90 0 0 0+56 44 26 130 24 0 0 0+56 44 26 130 95 0 0 0+56 44 26 130 39 0 0 0+56 44 26 130 26 0 0 0+56 44 26 130 25 33 0 0+56 44 26 130 25 75 0 0+56 44 25 33 130 66 0 0+56 44 25 33 130 90 0 0+56 44 25 33 130 24 0 0+56 44 25 33 130 95 0 0+56 44 25 33 130 39 0 0+56 44 25 33 130 26 0 0+56 44 25 33 130 25 33 0+56 44 25 33 130 25 75 0+56 44 25 75 130 66 0 0+56 44 25 75 130 90 0 0+56 44 25 75 130 24 0 0+56 44 25 75 130 95 0 0+56 44 25 75 130 39 0 0+56 44 25 75 130 26 0 0+56 44 25 75 130 25 33 0+56 44 25 75 130 25 75 0+77 44 66 130 66 0 0 0+77 44 66 130 90 0 0 0+77 44 66 130 24 0 0 0+77 44 66 130 95 0 0 0+77 44 66 130 39 0 0 0+77 44 66 130 26 0 0 0+77 44 66 130 25 33 0 0+77 44 66 130 25 75 0 0+77 44 90 130 66 0 0 0+77 44 90 130 90 0 0 0+77 44 90 130 24 0 0 0+77 44 90 130 95 0 0 0+77 44 90 130 39 0 0 0+77 44 90 130 26 0 0 0+77 44 90 130 25 33 0 0+77 44 90 130 25 75 0 0+77 44 24 130 66 0 0 0+77 44 24 130 90 0 0 0+77 44 24 130 24 0 0 0+77 44 24 130 95 0 0 0+77 44 24 130 39 0 0 0+77 44 24 130 26 0 0 0+77 44 24 130 25 33 0 0+77 44 24 130 25 75 0 0+77 44 95 130 66 0 0 0+77 44 95 130 90 0 0 0+77 44 95 130 24 0 0 0+77 44 95 130 95 0 0 0+77 44 95 130 39 0 0 0+77 44 95 130 26 0 0 0+77 44 95 130 25 33 0 0+77 44 95 130 25 75 0 0+77 44 39 130 66 0 0 0+77 44 39 130 90 0 0 0+77 44 39 130 24 0 0 0+77 44 39 130 95 0 0 0+77 44 39 130 39 0 0 0+77 44 39 130 26 0 0 0+77 44 39 130 25 33 0 0+77 44 39 130 25 75 0 0+77 44 26 130 66 0 0 0+77 44 26 130 90 0 0 0+77 44 26 130 24 0 0 0+77 44 26 130 95 0 0 0+77 44 26 130 39 0 0 0+77 44 26 130 26 0 0 0+77 44 26 130 25 33 0 0+77 44 26 130 25 75 0 0+77 44 25 33 130 66 0 0+77 44 25 33 130 90 0 0+77 44 25 33 130 24 0 0+77 44 25 33 130 95 0 0+77 44 25 33 130 39 0 0+77 44 25 33 130 26 0 0+77 44 25 33 130 25 33 0+77 44 25 33 130 25 75 0+77 44 25 75 130 66 0 0+77 44 25 75 130 90 0 0+77 44 25 75 130 24 0 0+77 44 25 75 130 95 0 0+77 44 25 75 130 39 0 0+77 44 25 75 130 26 0 0+77 44 25 75 130 25 33 0+77 44 25 75 130 25 75 0+22 44 66 130 66 0 0 0+22 44 66 130 90 0 0 0+22 44 66 130 24 0 0 0+22 44 66 130 95 0 0 0+22 44 66 130 39 0 0 0+22 44 66 130 26 0 0 0+22 44 66 130 25 33 0 0+22 44 66 130 25 75 0 0+22 44 90 130 66 0 0 0+22 44 90 130 90 0 0 0+22 44 90 130 24 0 0 0+22 44 90 130 95 0 0 0+22 44 90 130 39 0 0 0+22 44 90 130 26 0 0 0+22 44 90 130 25 33 0 0+22 44 90 130 25 75 0 0+22 44 24 130 66 0 0 0+22 44 24 130 90 0 0 0+22 44 24 130 24 0 0 0+22 44 24 130 95 0 0 0+22 44 24 130 39 0 0 0+22 44 24 130 26 0 0 0+22 44 24 130 25 33 0 0+22 44 24 130 25 75 0 0+22 44 95 130 66 0 0 0+22 44 95 130 90 0 0 0+22 44 95 130 24 0 0 0+22 44 95 130 95 0 0 0+22 44 95 130 39 0 0 0+22 44 95 130 26 0 0 0+22 44 95 130 25 33 0 0+22 44 95 130 25 75 0 0+22 44 39 130 66 0 0 0+22 44 39 130 90 0 0 0+22 44 39 130 24 0 0 0+22 44 39 130 95 0 0 0+22 44 39 130 39 0 0 0+22 44 39 130 26 0 0 0+22 44 39 130 25 33 0 0+22 44 39 130 25 75 0 0+22 44 26 130 66 0 0 0+22 44 26 130 90 0 0 0+22 44 26 130 24 0 0 0+22 44 26 130 95 0 0 0+22 44 26 130 39 0 0 0+22 44 26 130 26 0 0 0+22 44 26 130 25 33 0 0+22 44 26 130 25 75 0 0+22 44 25 33 130 66 0 0+22 44 25 33 130 90 0 0+22 44 25 33 130 24 0 0+22 44 25 33 130 95 0 0+22 44 25 33 130 39 0 0+22 44 25 33 130 26 0 0+22 44 25 33 130 25 33 0+22 44 25 33 130 25 75 0+22 44 25 75 130 66 0 0+22 44 25 75 130 90 0 0+22 44 25 75 130 24 0 0+22 44 25 75 130 95 0 0+22 44 25 75 130 39 0 0+22 44 25 75 130 26 0 0+22 44 25 75 130 25 33 0+22 44 25 75 130 25 75 0+134 44 66 130 66 0 0 0+134 44 66 130 90 0 0 0+134 44 66 130 24 0 0 0+134 44 66 130 95 0 0 0+134 44 66 130 39 0 0 0+134 44 66 130 26 0 0 0+134 44 66 130 25 33 0 0+134 44 66 130 25 75 0 0+134 44 90 130 66 0 0 0+134 44 90 130 90 0 0 0+134 44 90 130 24 0 0 0+134 44 90 130 95 0 0 0+134 44 90 130 39 0 0 0+134 44 90 130 26 0 0 0+134 44 90 130 25 33 0 0+134 44 90 130 25 75 0 0+134 44 24 130 66 0 0 0+134 44 24 130 90 0 0 0+134 44 24 130 24 0 0 0+134 44 24 130 95 0 0 0+134 44 24 130 39 0 0 0+134 44 24 130 26 0 0 0+134 44 24 130 25 33 0 0+134 44 24 130 25 75 0 0+134 44 95 130 66 0 0 0+134 44 95 130 90 0 0 0+134 44 95 130 24 0 0 0+134 44 95 130 95 0 0 0+134 44 95 130 39 0 0 0+134 44 95 130 26 0 0 0+134 44 95 130 25 33 0 0+134 44 95 130 25 75 0 0+134 44 39 130 66 0 0 0+134 44 39 130 90 0 0 0+134 44 39 130 24 0 0 0+134 44 39 130 95 0 0 0+134 44 39 130 39 0 0 0+134 44 39 130 26 0 0 0+134 44 39 130 25 33 0 0+134 44 39 130 25 75 0 0+134 44 26 130 66 0 0 0+134 44 26 130 90 0 0 0+134 44 26 130 24 0 0 0+134 44 26 130 95 0 0 0+134 44 26 130 39 0 0 0+134 44 26 130 26 0 0 0+134 44 26 130 25 33 0 0+134 44 26 130 25 75 0 0+134 44 25 33 130 66 0 0+134 44 25 33 130 90 0 0+134 44 25 33 130 24 0 0+134 44 25 33 130 95 0 0+134 44 25 33 130 39 0 0+134 44 25 33 130 26 0 0+134 44 25 33 130 25 33 0+134 44 25 33 130 25 75 0+134 44 25 75 130 66 0 0+134 44 25 75 130 90 0 0+134 44 25 75 130 24 0 0+134 44 25 75 130 95 0 0+134 44 25 75 130 39 0 0+134 44 25 75 130 26 0 0+134 44 25 75 130 25 33 0+134 44 25 75 130 25 75 0+93 44 66 130 66 0 0 0+93 44 66 130 90 0 0 0+93 44 66 130 24 0 0 0+93 44 66 130 95 0 0 0+93 44 66 130 39 0 0 0+93 44 66 130 26 0 0 0+93 44 66 130 25 33 0 0+93 44 66 130 25 75 0 0+93 44 90 130 66 0 0 0+93 44 90 130 90 0 0 0+93 44 90 130 24 0 0 0+93 44 90 130 95 0 0 0+93 44 90 130 39 0 0 0+93 44 90 130 26 0 0 0+93 44 90 130 25 33 0 0+93 44 90 130 25 75 0 0+93 44 24 130 66 0 0 0+93 44 24 130 90 0 0 0+93 44 24 130 24 0 0 0+93 44 24 130 95 0 0 0+93 44 24 130 39 0 0 0+93 44 24 130 26 0 0 0+93 44 24 130 25 33 0 0+93 44 24 130 25 75 0 0+93 44 95 130 66 0 0 0+93 44 95 130 90 0 0 0+93 44 95 130 24 0 0 0+93 44 95 130 95 0 0 0+93 44 95 130 39 0 0 0+93 44 95 130 26 0 0 0+93 44 95 130 25 33 0 0+93 44 95 130 25 75 0 0+93 44 39 130 66 0 0 0+93 44 39 130 90 0 0 0+93 44 39 130 24 0 0 0+93 44 39 130 95 0 0 0+93 44 39 130 39 0 0 0+93 44 39 130 26 0 0 0+93 44 39 130 25 33 0 0+93 44 39 130 25 75 0 0+93 44 26 130 66 0 0 0+93 44 26 130 90 0 0 0+93 44 26 130 24 0 0 0+93 44 26 130 95 0 0 0+93 44 26 130 39 0 0 0+93 44 26 130 26 0 0 0+93 44 26 130 25 33 0 0+93 44 26 130 25 75 0 0+93 44 25 33 130 66 0 0+93 44 25 33 130 90 0 0+93 44 25 33 130 24 0 0+93 44 25 33 130 95 0 0+93 44 25 33 130 39 0 0+93 44 25 33 130 26 0 0+93 44 25 33 130 25 33 0+93 44 25 33 130 25 75 0+93 44 25 75 130 66 0 0+93 44 25 75 130 90 0 0+93 44 25 75 130 24 0 0+93 44 25 75 130 95 0 0+93 44 25 75 130 39 0 0+93 44 25 75 130 26 0 0+93 44 25 75 130 25 33 0+93 44 25 75 130 25 75 0+32 44 66 130 66 0 0 0+32 44 66 130 90 0 0 0+32 44 66 130 24 0 0 0+32 44 66 130 95 0 0 0+32 44 66 130 39 0 0 0+32 44 66 130 26 0 0 0+32 44 66 130 25 33 0 0+32 44 66 130 25 75 0 0+32 44 90 130 66 0 0 0+32 44 90 130 90 0 0 0+32 44 90 130 24 0 0 0+32 44 90 130 95 0 0 0+32 44 90 130 39 0 0 0+32 44 90 130 26 0 0 0+32 44 90 130 25 33 0 0+32 44 90 130 25 75 0 0+32 44 24 130 66 0 0 0+32 44 24 130 90 0 0 0+32 44 24 130 24 0 0 0+32 44 24 130 95 0 0 0+32 44 24 130 39 0 0 0+32 44 24 130 26 0 0 0+32 44 24 130 25 33 0 0+32 44 24 130 25 75 0 0+32 44 95 130 66 0 0 0+32 44 95 130 90 0 0 0+32 44 95 130 24 0 0 0+32 44 95 130 95 0 0 0+32 44 95 130 39 0 0 0+32 44 95 130 26 0 0 0+32 44 95 130 25 33 0 0+32 44 95 130 25 75 0 0+32 44 39 130 66 0 0 0+32 44 39 130 90 0 0 0+32 44 39 130 24 0 0 0+32 44 39 130 95 0 0 0+32 44 39 130 39 0 0 0+32 44 39 130 26 0 0 0+32 44 39 130 25 33 0 0+32 44 39 130 25 75 0 0+32 44 26 130 66 0 0 0+32 44 26 130 90 0 0 0+32 44 26 130 24 0 0 0+32 44 26 130 95 0 0 0+32 44 26 130 39 0 0 0+32 44 26 130 26 0 0 0+32 44 26 130 25 33 0 0+32 44 26 130 25 75 0 0+32 44 25 33 130 66 0 0+32 44 25 33 130 90 0 0+32 44 25 33 130 24 0 0+32 44 25 33 130 95 0 0+32 44 25 33 130 39 0 0+32 44 25 33 130 26 0 0+32 44 25 33 130 25 33 0+32 44 25 33 130 25 75 0+32 44 25 75 130 66 0 0+32 44 25 75 130 90 0 0+32 44 25 75 130 24 0 0+32 44 25 75 130 95 0 0+32 44 25 75 130 39 0 0+32 44 25 75 130 26 0 0+32 44 25 75 130 25 33 0+32 44 25 75 130 25 75 0+25 33 44 66 130 66 0 0+25 33 44 66 130 90 0 0+25 33 44 66 130 24 0 0+25 33 44 66 130 95 0 0+25 33 44 66 130 39 0 0+25 33 44 66 130 26 0 0+25 33 44 66 130 25 33 0+25 33 44 66 130 25 75 0+25 33 44 90 130 66 0 0+25 33 44 90 130 90 0 0+25 33 44 90 130 24 0 0+25 33 44 90 130 95 0 0+25 33 44 90 130 39 0 0+25 33 44 90 130 26 0 0+25 33 44 90 130 25 33 0+25 33 44 90 130 25 75 0+25 33 44 24 130 66 0 0+25 33 44 24 130 90 0 0+25 33 44 24 130 24 0 0+25 33 44 24 130 95 0 0+25 33 44 24 130 39 0 0+25 33 44 24 130 26 0 0+25 33 44 24 130 25 33 0+25 33 44 24 130 25 75 0+25 33 44 95 130 66 0 0+25 33 44 95 130 90 0 0+25 33 44 95 130 24 0 0+25 33 44 95 130 95 0 0+25 33 44 95 130 39 0 0+25 33 44 95 130 26 0 0+25 33 44 95 130 25 33 0+25 33 44 95 130 25 75 0+25 33 44 39 130 66 0 0+25 33 44 39 130 90 0 0+25 33 44 39 130 24 0 0+25 33 44 39 130 95 0 0+25 33 44 39 130 39 0 0+25 33 44 39 130 26 0 0+25 33 44 39 130 25 33 0+25 33 44 39 130 25 75 0+25 33 44 26 130 66 0 0+25 33 44 26 130 90 0 0+25 33 44 26 130 24 0 0+25 33 44 26 130 95 0 0+25 33 44 26 130 39 0 0+25 33 44 26 130 26 0 0+25 33 44 26 130 25 33 0+25 33 44 26 130 25 75 0+25 33 44 25 33 130 66 0+25 33 44 25 33 130 90 0+25 33 44 25 33 130 24 0+25 33 44 25 33 130 95 0+25 33 44 25 33 130 39 0+25 33 44 25 33 130 26 0+25 33 44 25 75 130 66 0+25 33 44 25 75 130 90 0+25 33 44 25 75 130 24 0+25 33 44 25 75 130 95 0+25 33 44 25 75 130 39 0+25 33 44 25 75 130 26 0+25 75 44 66 130 66 0 0+25 75 44 66 130 90 0 0+25 75 44 66 130 24 0 0+25 75 44 66 130 95 0 0+25 75 44 66 130 39 0 0+25 75 44 66 130 26 0 0+25 75 44 66 130 25 33 0+25 75 44 66 130 25 75 0+25 75 44 90 130 66 0 0+25 75 44 90 130 90 0 0+25 75 44 90 130 24 0 0+25 75 44 90 130 95 0 0+25 75 44 90 130 39 0 0+25 75 44 90 130 26 0 0+25 75 44 90 130 25 33 0+25 75 44 90 130 25 75 0+25 75 44 24 130 66 0 0+25 75 44 24 130 90 0 0+25 75 44 24 130 24 0 0+25 75 44 24 130 95 0 0+25 75 44 24 130 39 0 0+25 75 44 24 130 26 0 0+25 75 44 24 130 25 33 0+25 75 44 24 130 25 75 0+25 75 44 95 130 66 0 0+25 75 44 95 130 90 0 0+25 75 44 95 130 24 0 0+25 75 44 95 130 95 0 0+25 75 44 95 130 39 0 0+25 75 44 95 130 26 0 0+25 75 44 95 130 25 33 0+25 75 44 95 130 25 75 0+25 75 44 39 130 66 0 0+25 75 44 39 130 90 0 0+25 75 44 39 130 24 0 0+25 75 44 39 130 95 0 0+25 75 44 39 130 39 0 0+25 75 44 39 130 26 0 0+25 75 44 39 130 25 33 0+25 75 44 39 130 25 75 0+25 75 44 26 130 66 0 0+25 75 44 26 130 90 0 0+25 75 44 26 130 24 0 0+25 75 44 26 130 95 0 0+25 75 44 26 130 39 0 0+25 75 44 26 130 26 0 0+25 75 44 26 130 25 33 0+25 75 44 26 130 25 75 0+25 75 44 25 33 130 66 0+25 75 44 25 33 130 90 0+25 75 44 25 33 130 24 0+25 75 44 25 33 130 95 0+25 75 44 25 33 130 39 0+25 75 44 25 33 130 26 0+25 75 44 25 75 130 66 0+25 75 44 25 75 130 90 0+25 75 44 25 75 130 24 0+25 75 44 25 75 130 95 0+25 75 44 25 75 130 39 0+25 75 44 25 75 130 26 0+56 135 66 66 0 0 0 0+56 135 66 90 0 0 0 0+56 135 66 24 0 0 0 0+56 135 66 95 0 0 0 0+56 135 66 39 0 0 0 0+56 135 66 26 0 0 0 0+56 135 66 25 33 0 0 0+56 135 66 25 75 0 0 0+56 135 90 66 0 0 0 0+56 135 90 90 0 0 0 0+56 135 90 24 0 0 0 0+56 135 90 95 0 0 0 0+56 135 90 39 0 0 0 0+56 135 90 26 0 0 0 0+56 135 90 25 33 0 0 0+56 135 90 25 75 0 0 0+56 135 24 66 0 0 0 0+56 135 24 90 0 0 0 0+56 135 24 24 0 0 0 0+56 135 24 95 0 0 0 0+56 135 24 39 0 0 0 0+56 135 24 26 0 0 0 0+56 135 24 25 33 0 0 0+56 135 24 25 75 0 0 0+56 135 95 66 0 0 0 0+56 135 95 90 0 0 0 0+56 135 95 24 0 0 0 0+56 135 95 95 0 0 0 0+56 135 95 39 0 0 0 0+56 135 95 26 0 0 0 0+56 135 95 25 33 0 0 0+56 135 95 25 75 0 0 0+56 135 39 66 0 0 0 0+56 135 39 90 0 0 0 0+56 135 39 24 0 0 0 0+56 135 39 95 0 0 0 0+56 135 39 39 0 0 0 0+56 135 39 26 0 0 0 0+56 135 39 25 33 0 0 0+56 135 39 25 75 0 0 0+56 135 26 66 0 0 0 0+56 135 26 90 0 0 0 0+56 135 26 24 0 0 0 0+56 135 26 95 0 0 0 0+56 135 26 39 0 0 0 0+56 135 26 26 0 0 0 0+56 135 26 25 33 0 0 0+56 135 26 25 75 0 0 0+56 135 25 33 66 0 0 0+56 135 25 33 90 0 0 0+56 135 25 33 24 0 0 0+56 135 25 33 95 0 0 0+56 135 25 33 39 0 0 0+56 135 25 33 26 0 0 0+56 135 25 33 25 33 0 0+56 135 25 33 25 75 0 0+56 135 25 75 66 0 0 0+56 135 25 75 90 0 0 0+56 135 25 75 24 0 0 0+56 135 25 75 95 0 0 0+56 135 25 75 39 0 0 0+56 135 25 75 26 0 0 0+56 135 25 75 25 33 0 0+56 135 25 75 25 75 0 0+77 135 66 66 0 0 0 0+77 135 66 90 0 0 0 0+77 135 66 24 0 0 0 0+77 135 66 95 0 0 0 0+77 135 66 39 0 0 0 0+77 135 66 26 0 0 0 0+77 135 66 25 33 0 0 0+77 135 66 25 75 0 0 0+77 135 90 66 0 0 0 0+77 135 90 90 0 0 0 0+77 135 90 24 0 0 0 0+77 135 90 95 0 0 0 0+77 135 90 39 0 0 0 0+77 135 90 26 0 0 0 0+77 135 90 25 33 0 0 0+77 135 90 25 75 0 0 0+77 135 24 66 0 0 0 0+77 135 24 90 0 0 0 0+77 135 24 24 0 0 0 0+77 135 24 95 0 0 0 0+77 135 24 39 0 0 0 0+77 135 24 26 0 0 0 0+77 135 24 25 33 0 0 0+77 135 24 25 75 0 0 0+77 135 95 66 0 0 0 0+77 135 95 90 0 0 0 0+77 135 95 24 0 0 0 0+77 135 95 95 0 0 0 0+77 135 95 39 0 0 0 0+77 135 95 26 0 0 0 0+77 135 95 25 33 0 0 0+77 135 95 25 75 0 0 0+77 135 39 66 0 0 0 0+77 135 39 90 0 0 0 0+77 135 39 24 0 0 0 0+77 135 39 95 0 0 0 0+77 135 39 39 0 0 0 0+77 135 39 26 0 0 0 0+77 135 39 25 33 0 0 0+77 135 39 25 75 0 0 0+77 135 26 66 0 0 0 0+77 135 26 90 0 0 0 0+77 135 26 24 0 0 0 0+77 135 26 95 0 0 0 0+77 135 26 39 0 0 0 0+77 135 26 26 0 0 0 0+77 135 26 25 33 0 0 0+77 135 26 25 75 0 0 0+77 135 25 33 66 0 0 0+77 135 25 33 90 0 0 0+77 135 25 33 24 0 0 0+77 135 25 33 95 0 0 0+77 135 25 33 39 0 0 0+77 135 25 33 26 0 0 0+77 135 25 33 25 33 0 0+77 135 25 33 25 75 0 0+77 135 25 75 66 0 0 0+77 135 25 75 90 0 0 0+77 135 25 75 24 0 0 0+77 135 25 75 95 0 0 0+77 135 25 75 39 0 0 0+77 135 25 75 26 0 0 0+77 135 25 75 25 33 0 0+77 135 25 75 25 75 0 0+22 135 66 66 0 0 0 0+22 135 66 90 0 0 0 0+22 135 66 24 0 0 0 0+22 135 66 95 0 0 0 0+22 135 66 39 0 0 0 0+22 135 66 26 0 0 0 0+22 135 66 25 33 0 0 0+22 135 66 25 75 0 0 0+22 135 90 66 0 0 0 0+22 135 90 90 0 0 0 0+22 135 90 24 0 0 0 0+22 135 90 95 0 0 0 0+22 135 90 39 0 0 0 0+22 135 90 26 0 0 0 0+22 135 90 25 33 0 0 0+22 135 90 25 75 0 0 0+22 135 24 66 0 0 0 0+22 135 24 90 0 0 0 0+22 135 24 24 0 0 0 0+22 135 24 95 0 0 0 0+22 135 24 39 0 0 0 0+22 135 24 26 0 0 0 0+22 135 24 25 33 0 0 0+22 135 24 25 75 0 0 0+22 135 95 66 0 0 0 0+22 135 95 90 0 0 0 0+22 135 95 24 0 0 0 0+22 135 95 95 0 0 0 0+22 135 95 39 0 0 0 0+22 135 95 26 0 0 0 0+22 135 95 25 33 0 0 0+22 135 95 25 75 0 0 0+22 135 39 66 0 0 0 0+22 135 39 90 0 0 0 0+22 135 39 24 0 0 0 0+22 135 39 95 0 0 0 0+22 135 39 39 0 0 0 0+22 135 39 26 0 0 0 0+22 135 39 25 33 0 0 0+22 135 39 25 75 0 0 0+22 135 26 66 0 0 0 0+22 135 26 90 0 0 0 0+22 135 26 24 0 0 0 0+22 135 26 95 0 0 0 0+22 135 26 39 0 0 0 0+22 135 26 26 0 0 0 0+22 135 26 25 33 0 0 0+22 135 26 25 75 0 0 0+22 135 25 33 66 0 0 0+22 135 25 33 90 0 0 0+22 135 25 33 24 0 0 0+22 135 25 33 95 0 0 0+22 135 25 33 39 0 0 0+22 135 25 33 26 0 0 0+22 135 25 33 25 33 0 0+22 135 25 33 25 75 0 0+22 135 25 75 66 0 0 0+22 135 25 75 90 0 0 0+22 135 25 75 24 0 0 0+22 135 25 75 95 0 0 0+22 135 25 75 39 0 0 0+22 135 25 75 26 0 0 0+22 135 25 75 25 33 0 0+22 135 25 75 25 75 0 0+134 135 66 66 0 0 0 0+134 135 66 90 0 0 0 0+134 135 66 24 0 0 0 0+134 135 66 95 0 0 0 0+134 135 66 39 0 0 0 0+134 135 66 26 0 0 0 0+134 135 66 25 33 0 0 0+134 135 66 25 75 0 0 0+134 135 90 66 0 0 0 0+134 135 90 90 0 0 0 0+134 135 90 24 0 0 0 0+134 135 90 95 0 0 0 0+134 135 90 39 0 0 0 0+134 135 90 26 0 0 0 0+134 135 90 25 33 0 0 0+134 135 90 25 75 0 0 0+134 135 24 66 0 0 0 0+134 135 24 90 0 0 0 0+134 135 24 24 0 0 0 0+134 135 24 95 0 0 0 0+134 135 24 39 0 0 0 0+134 135 24 26 0 0 0 0+134 135 24 25 33 0 0 0+134 135 24 25 75 0 0 0+134 135 95 66 0 0 0 0+134 135 95 90 0 0 0 0+134 135 95 24 0 0 0 0+134 135 95 95 0 0 0 0+134 135 95 39 0 0 0 0+134 135 95 26 0 0 0 0+134 135 95 25 33 0 0 0+134 135 95 25 75 0 0 0+134 135 39 66 0 0 0 0+134 135 39 90 0 0 0 0+134 135 39 24 0 0 0 0+134 135 39 95 0 0 0 0+134 135 39 39 0 0 0 0+134 135 39 26 0 0 0 0+134 135 39 25 33 0 0 0+134 135 39 25 75 0 0 0+134 135 26 66 0 0 0 0+134 135 26 90 0 0 0 0+134 135 26 24 0 0 0 0+134 135 26 95 0 0 0 0+134 135 26 39 0 0 0 0+134 135 26 26 0 0 0 0+134 135 26 25 33 0 0 0+134 135 26 25 75 0 0 0+134 135 25 33 66 0 0 0+134 135 25 33 90 0 0 0+134 135 25 33 24 0 0 0+134 135 25 33 95 0 0 0+134 135 25 33 39 0 0 0+134 135 25 33 26 0 0 0+134 135 25 33 25 33 0 0+134 135 25 33 25 75 0 0+134 135 25 75 66 0 0 0+134 135 25 75 90 0 0 0+134 135 25 75 24 0 0 0+134 135 25 75 95 0 0 0+134 135 25 75 39 0 0 0+134 135 25 75 26 0 0 0+134 135 25 75 25 33 0 0+134 135 25 75 25 75 0 0+93 135 66 66 0 0 0 0+93 135 66 90 0 0 0 0+93 135 66 24 0 0 0 0+93 135 66 95 0 0 0 0+93 135 66 39 0 0 0 0+93 135 66 26 0 0 0 0+93 135 66 25 33 0 0 0+93 135 66 25 75 0 0 0+93 135 90 66 0 0 0 0+93 135 90 90 0 0 0 0+93 135 90 24 0 0 0 0+93 135 90 95 0 0 0 0+93 135 90 39 0 0 0 0+93 135 90 26 0 0 0 0+93 135 90 25 33 0 0 0+93 135 90 25 75 0 0 0+93 135 24 66 0 0 0 0+93 135 24 90 0 0 0 0+93 135 24 24 0 0 0 0+93 135 24 95 0 0 0 0+93 135 24 39 0 0 0 0+93 135 24 26 0 0 0 0+93 135 24 25 33 0 0 0+93 135 24 25 75 0 0 0+93 135 95 66 0 0 0 0+93 135 95 90 0 0 0 0+93 135 95 24 0 0 0 0+93 135 95 95 0 0 0 0+93 135 95 39 0 0 0 0+93 135 95 26 0 0 0 0+93 135 95 25 33 0 0 0+93 135 95 25 75 0 0 0+93 135 39 66 0 0 0 0+93 135 39 90 0 0 0 0+93 135 39 24 0 0 0 0+93 135 39 95 0 0 0 0+93 135 39 39 0 0 0 0+93 135 39 26 0 0 0 0+93 135 39 25 33 0 0 0+93 135 39 25 75 0 0 0+93 135 26 66 0 0 0 0+93 135 26 90 0 0 0 0+93 135 26 24 0 0 0 0+93 135 26 95 0 0 0 0+93 135 26 39 0 0 0 0+93 135 26 26 0 0 0 0+93 135 26 25 33 0 0 0+93 135 26 25 75 0 0 0+93 135 25 33 66 0 0 0+93 135 25 33 90 0 0 0+93 135 25 33 24 0 0 0+93 135 25 33 95 0 0 0+93 135 25 33 39 0 0 0+93 135 25 33 26 0 0 0+93 135 25 33 25 33 0 0+93 135 25 33 25 75 0 0+93 135 25 75 66 0 0 0+93 135 25 75 90 0 0 0+93 135 25 75 24 0 0 0+93 135 25 75 95 0 0 0+93 135 25 75 39 0 0 0+93 135 25 75 26 0 0 0+93 135 25 75 25 33 0 0+93 135 25 75 25 75 0 0+32 135 66 66 0 0 0 0+32 135 66 90 0 0 0 0+32 135 66 24 0 0 0 0+32 135 66 95 0 0 0 0+32 135 66 39 0 0 0 0+32 135 66 26 0 0 0 0+32 135 66 25 33 0 0 0+32 135 66 25 75 0 0 0+32 135 90 66 0 0 0 0+32 135 90 90 0 0 0 0+32 135 90 24 0 0 0 0+32 135 90 95 0 0 0 0+32 135 90 39 0 0 0 0+32 135 90 26 0 0 0 0+32 135 90 25 33 0 0 0+32 135 90 25 75 0 0 0+32 135 24 66 0 0 0 0+32 135 24 90 0 0 0 0+32 135 24 24 0 0 0 0+32 135 24 95 0 0 0 0+32 135 24 39 0 0 0 0+32 135 24 26 0 0 0 0+32 135 24 25 33 0 0 0+32 135 24 25 75 0 0 0+32 135 95 66 0 0 0 0+32 135 95 90 0 0 0 0+32 135 95 24 0 0 0 0+32 135 95 95 0 0 0 0+32 135 95 39 0 0 0 0+32 135 95 26 0 0 0 0+32 135 95 25 33 0 0 0+32 135 95 25 75 0 0 0+32 135 39 66 0 0 0 0+32 135 39 90 0 0 0 0+32 135 39 24 0 0 0 0+32 135 39 95 0 0 0 0+32 135 39 39 0 0 0 0+32 135 39 26 0 0 0 0+32 135 39 25 33 0 0 0+32 135 39 25 75 0 0 0+32 135 26 66 0 0 0 0+32 135 26 90 0 0 0 0+32 135 26 24 0 0 0 0+32 135 26 95 0 0 0 0+32 135 26 39 0 0 0 0+32 135 26 26 0 0 0 0+32 135 26 25 33 0 0 0+32 135 26 25 75 0 0 0+32 135 25 33 66 0 0 0+32 135 25 33 90 0 0 0+32 135 25 33 24 0 0 0+32 135 25 33 95 0 0 0+32 135 25 33 39 0 0 0+32 135 25 33 26 0 0 0+32 135 25 33 25 33 0 0+32 135 25 33 25 75 0 0+32 135 25 75 66 0 0 0+32 135 25 75 90 0 0 0+32 135 25 75 24 0 0 0+32 135 25 75 95 0 0 0+32 135 25 75 39 0 0 0+32 135 25 75 26 0 0 0+32 135 25 75 25 33 0 0+32 135 25 75 25 75 0 0+25 33 135 66 66 0 0 0+25 33 135 66 90 0 0 0+25 33 135 66 24 0 0 0+25 33 135 66 95 0 0 0+25 33 135 66 39 0 0 0+25 33 135 66 26 0 0 0+25 33 135 66 25 33 0 0+25 33 135 66 25 75 0 0+25 33 135 90 66 0 0 0+25 33 135 90 90 0 0 0+25 33 135 90 24 0 0 0+25 33 135 90 95 0 0 0+25 33 135 90 39 0 0 0+25 33 135 90 26 0 0 0+25 33 135 90 25 33 0 0+25 33 135 90 25 75 0 0+25 33 135 24 66 0 0 0+25 33 135 24 90 0 0 0+25 33 135 24 24 0 0 0+25 33 135 24 95 0 0 0+25 33 135 24 39 0 0 0+25 33 135 24 26 0 0 0+25 33 135 24 25 33 0 0+25 33 135 24 25 75 0 0+25 33 135 95 66 0 0 0+25 33 135 95 90 0 0 0+25 33 135 95 24 0 0 0+25 33 135 95 95 0 0 0+25 33 135 95 39 0 0 0+25 33 135 95 26 0 0 0+25 33 135 95 25 33 0 0+25 33 135 95 25 75 0 0+25 33 135 39 66 0 0 0+25 33 135 39 90 0 0 0+25 33 135 39 24 0 0 0+25 33 135 39 95 0 0 0+25 33 135 39 39 0 0 0+25 33 135 39 26 0 0 0+25 33 135 39 25 33 0 0+25 33 135 39 25 75 0 0+25 33 135 26 66 0 0 0+25 33 135 26 90 0 0 0+25 33 135 26 24 0 0 0+25 33 135 26 95 0 0 0+25 33 135 26 39 0 0 0+25 33 135 26 26 0 0 0+25 33 135 26 25 33 0 0+25 33 135 26 25 75 0 0+25 33 135 25 33 66 0 0+25 33 135 25 33 90 0 0+25 33 135 25 33 24 0 0+25 33 135 25 33 95 0 0+25 33 135 25 33 39 0 0+25 33 135 25 33 26 0 0+25 33 135 25 75 66 0 0+25 33 135 25 75 90 0 0+25 33 135 25 75 24 0 0+25 33 135 25 75 95 0 0+25 33 135 25 75 39 0 0+25 33 135 25 75 26 0 0+25 75 135 66 66 0 0 0+25 75 135 66 90 0 0 0+25 75 135 66 24 0 0 0+25 75 135 66 95 0 0 0+25 75 135 66 39 0 0 0+25 75 135 66 26 0 0 0+25 75 135 66 25 33 0 0+25 75 135 66 25 75 0 0+25 75 135 90 66 0 0 0+25 75 135 90 90 0 0 0+25 75 135 90 24 0 0 0+25 75 135 90 95 0 0 0+25 75 135 90 39 0 0 0+25 75 135 90 26 0 0 0+25 75 135 90 25 33 0 0+25 75 135 90 25 75 0 0+25 75 135 24 66 0 0 0+25 75 135 24 90 0 0 0+25 75 135 24 24 0 0 0+25 75 135 24 95 0 0 0+25 75 135 24 39 0 0 0+25 75 135 24 26 0 0 0+25 75 135 24 25 33 0 0+25 75 135 24 25 75 0 0+25 75 135 95 66 0 0 0+25 75 135 95 90 0 0 0+25 75 135 95 24 0 0 0+25 75 135 95 95 0 0 0+25 75 135 95 39 0 0 0+25 75 135 95 26 0 0 0+25 75 135 95 25 33 0 0+25 75 135 95 25 75 0 0+25 75 135 39 66 0 0 0+25 75 135 39 90 0 0 0+25 75 135 39 24 0 0 0+25 75 135 39 95 0 0 0+25 75 135 39 39 0 0 0+25 75 135 39 26 0 0 0+25 75 135 39 25 33 0 0+25 75 135 39 25 75 0 0+25 75 135 26 66 0 0 0+25 75 135 26 90 0 0 0+25 75 135 26 24 0 0 0+25 75 135 26 95 0 0 0+25 75 135 26 39 0 0 0+25 75 135 26 26 0 0 0+25 75 135 26 25 33 0 0+25 75 135 26 25 75 0 0+25 75 135 25 33 66 0 0+25 75 135 25 33 90 0 0+25 75 135 25 33 24 0 0+25 75 135 25 33 95 0 0+25 75 135 25 33 39 0 0+25 75 135 25 33 26 0 0+25 75 135 25 75 66 0 0+25 75 135 25 75 90 0 0+25 75 135 25 75 24 0 0+25 75 135 25 75 95 0 0+25 75 135 25 75 39 0 0+25 75 135 25 75 26 0 0+56 44 8 130 66 0 0 0+56 44 8 130 90 0 0 0+56 44 8 130 24 0 0 0+56 44 8 130 95 0 0 0+56 44 8 130 39 0 0 0+56 44 8 130 26 0 0 0+56 44 8 130 25 33 0 0+56 44 8 130 25 75 0 0+56 44 133 130 66 0 0 0+56 44 133 130 90 0 0 0+56 44 133 130 24 0 0 0+56 44 133 130 95 0 0 0+56 44 133 130 39 0 0 0+56 44 133 130 26 0 0 0+56 44 133 130 25 33 0 0+56 44 133 130 25 75 0 0+56 44 84 130 66 0 0 0+56 44 84 130 90 0 0 0+56 44 84 130 24 0 0 0+56 44 84 130 95 0 0 0+56 44 84 130 39 0 0 0+56 44 84 130 26 0 0 0+56 44 84 130 25 33 0 0+56 44 84 130 25 75 0 0+56 44 85 130 66 0 0 0+56 44 85 130 90 0 0 0+56 44 85 130 24 0 0 0+56 44 85 130 95 0 0 0+56 44 85 130 39 0 0 0+56 44 85 130 26 0 0 0+56 44 85 130 25 33 0 0+56 44 85 130 25 75 0 0+56 44 88 130 66 0 0 0+56 44 88 130 90 0 0 0+56 44 88 130 24 0 0 0+56 44 88 130 95 0 0 0+56 44 88 130 39 0 0 0+56 44 88 130 26 0 0 0+56 44 88 130 25 33 0 0+56 44 88 130 25 75 0 0+56 44 113 130 66 0 0 0+56 44 113 130 90 0 0 0+56 44 113 130 24 0 0 0+56 44 113 130 95 0 0 0+56 44 113 130 39 0 0 0+56 44 113 130 26 0 0 0+56 44 113 130 25 33 0 0+56 44 113 130 25 75 0 0+77 44 8 130 66 0 0 0+77 44 8 130 90 0 0 0+77 44 8 130 24 0 0 0+77 44 8 130 95 0 0 0+77 44 8 130 39 0 0 0+77 44 8 130 26 0 0 0+77 44 8 130 25 33 0 0+77 44 8 130 25 75 0 0+77 44 133 130 66 0 0 0+77 44 133 130 90 0 0 0+77 44 133 130 24 0 0 0+77 44 133 130 95 0 0 0+77 44 133 130 39 0 0 0+77 44 133 130 26 0 0 0+77 44 133 130 25 33 0 0+77 44 133 130 25 75 0 0+77 44 84 130 66 0 0 0+77 44 84 130 90 0 0 0+77 44 84 130 24 0 0 0+77 44 84 130 95 0 0 0+77 44 84 130 39 0 0 0+77 44 84 130 26 0 0 0+77 44 84 130 25 33 0 0+77 44 84 130 25 75 0 0+77 44 85 130 66 0 0 0+77 44 85 130 90 0 0 0+77 44 85 130 24 0 0 0+77 44 85 130 95 0 0 0+77 44 85 130 39 0 0 0+77 44 85 130 26 0 0 0+77 44 85 130 25 33 0 0+77 44 85 130 25 75 0 0+77 44 88 130 66 0 0 0+77 44 88 130 90 0 0 0+77 44 88 130 24 0 0 0+77 44 88 130 95 0 0 0+77 44 88 130 39 0 0 0+77 44 88 130 26 0 0 0+77 44 88 130 25 33 0 0+77 44 88 130 25 75 0 0+77 44 113 130 66 0 0 0+77 44 113 130 90 0 0 0+77 44 113 130 24 0 0 0+77 44 113 130 95 0 0 0+77 44 113 130 39 0 0 0+77 44 113 130 26 0 0 0+77 44 113 130 25 33 0 0+77 44 113 130 25 75 0 0+22 44 8 130 66 0 0 0+22 44 8 130 90 0 0 0+22 44 8 130 24 0 0 0+22 44 8 130 95 0 0 0+22 44 8 130 39 0 0 0+22 44 8 130 26 0 0 0+22 44 8 130 25 33 0 0+22 44 8 130 25 75 0 0+22 44 133 130 66 0 0 0+22 44 133 130 90 0 0 0+22 44 133 130 24 0 0 0+22 44 133 130 95 0 0 0+22 44 133 130 39 0 0 0+22 44 133 130 26 0 0 0+22 44 133 130 25 33 0 0+22 44 133 130 25 75 0 0+22 44 84 130 66 0 0 0+22 44 84 130 90 0 0 0+22 44 84 130 24 0 0 0+22 44 84 130 95 0 0 0+22 44 84 130 39 0 0 0+22 44 84 130 26 0 0 0+22 44 84 130 25 33 0 0+22 44 84 130 25 75 0 0+22 44 85 130 66 0 0 0+22 44 85 130 90 0 0 0+22 44 85 130 24 0 0 0+22 44 85 130 95 0 0 0+22 44 85 130 39 0 0 0+22 44 85 130 26 0 0 0+22 44 85 130 25 33 0 0+22 44 85 130 25 75 0 0+22 44 88 130 66 0 0 0+22 44 88 130 90 0 0 0+22 44 88 130 24 0 0 0+22 44 88 130 95 0 0 0+22 44 88 130 39 0 0 0+22 44 88 130 26 0 0 0+22 44 88 130 25 33 0 0+22 44 88 130 25 75 0 0+22 44 113 130 66 0 0 0+22 44 113 130 90 0 0 0+22 44 113 130 24 0 0 0+22 44 113 130 95 0 0 0+22 44 113 130 39 0 0 0+22 44 113 130 26 0 0 0+22 44 113 130 25 33 0 0+22 44 113 130 25 75 0 0+134 44 8 130 66 0 0 0+134 44 8 130 90 0 0 0+134 44 8 130 24 0 0 0+134 44 8 130 95 0 0 0+134 44 8 130 39 0 0 0+134 44 8 130 26 0 0 0+134 44 8 130 25 33 0 0+134 44 8 130 25 75 0 0+134 44 133 130 66 0 0 0+134 44 133 130 90 0 0 0+134 44 133 130 24 0 0 0+134 44 133 130 95 0 0 0+134 44 133 130 39 0 0 0+134 44 133 130 26 0 0 0+134 44 133 130 25 33 0 0+134 44 133 130 25 75 0 0+134 44 84 130 66 0 0 0+134 44 84 130 90 0 0 0+134 44 84 130 24 0 0 0+134 44 84 130 95 0 0 0+134 44 84 130 39 0 0 0+134 44 84 130 26 0 0 0+134 44 84 130 25 33 0 0+134 44 84 130 25 75 0 0+134 44 85 130 66 0 0 0+134 44 85 130 90 0 0 0+134 44 85 130 24 0 0 0+134 44 85 130 95 0 0 0+134 44 85 130 39 0 0 0+134 44 85 130 26 0 0 0+134 44 85 130 25 33 0 0+134 44 85 130 25 75 0 0+134 44 88 130 66 0 0 0+134 44 88 130 90 0 0 0+134 44 88 130 24 0 0 0+134 44 88 130 95 0 0 0+134 44 88 130 39 0 0 0+134 44 88 130 26 0 0 0+134 44 88 130 25 33 0 0+134 44 88 130 25 75 0 0+134 44 113 130 66 0 0 0+134 44 113 130 90 0 0 0+134 44 113 130 24 0 0 0+134 44 113 130 95 0 0 0+134 44 113 130 39 0 0 0+134 44 113 130 26 0 0 0+134 44 113 130 25 33 0 0+134 44 113 130 25 75 0 0+93 44 8 130 66 0 0 0+93 44 8 130 90 0 0 0+93 44 8 130 24 0 0 0+93 44 8 130 95 0 0 0+93 44 8 130 39 0 0 0+93 44 8 130 26 0 0 0+93 44 8 130 25 33 0 0+93 44 8 130 25 75 0 0+93 44 133 130 66 0 0 0+93 44 133 130 90 0 0 0+93 44 133 130 24 0 0 0+93 44 133 130 95 0 0 0+93 44 133 130 39 0 0 0+93 44 133 130 26 0 0 0+93 44 133 130 25 33 0 0+93 44 133 130 25 75 0 0+93 44 84 130 66 0 0 0+93 44 84 130 90 0 0 0+93 44 84 130 24 0 0 0+93 44 84 130 95 0 0 0+93 44 84 130 39 0 0 0+93 44 84 130 26 0 0 0+93 44 84 130 25 33 0 0+93 44 84 130 25 75 0 0+93 44 85 130 66 0 0 0+93 44 85 130 90 0 0 0+93 44 85 130 24 0 0 0+93 44 85 130 95 0 0 0+93 44 85 130 39 0 0 0+93 44 85 130 26 0 0 0+93 44 85 130 25 33 0 0+93 44 85 130 25 75 0 0+93 44 88 130 66 0 0 0+93 44 88 130 90 0 0 0+93 44 88 130 24 0 0 0+93 44 88 130 95 0 0 0+93 44 88 130 39 0 0 0+93 44 88 130 26 0 0 0+93 44 88 130 25 33 0 0+93 44 88 130 25 75 0 0+93 44 113 130 66 0 0 0+93 44 113 130 90 0 0 0+93 44 113 130 24 0 0 0+93 44 113 130 95 0 0 0+93 44 113 130 39 0 0 0+93 44 113 130 26 0 0 0+93 44 113 130 25 33 0 0+93 44 113 130 25 75 0 0+32 44 8 130 66 0 0 0+32 44 8 130 90 0 0 0+32 44 8 130 24 0 0 0+32 44 8 130 95 0 0 0+32 44 8 130 39 0 0 0+32 44 8 130 26 0 0 0+32 44 8 130 25 33 0 0+32 44 8 130 25 75 0 0+32 44 133 130 66 0 0 0+32 44 133 130 90 0 0 0+32 44 133 130 24 0 0 0+32 44 133 130 95 0 0 0+32 44 133 130 39 0 0 0+32 44 133 130 26 0 0 0+32 44 133 130 25 33 0 0+32 44 133 130 25 75 0 0+32 44 84 130 66 0 0 0+32 44 84 130 90 0 0 0+32 44 84 130 24 0 0 0+32 44 84 130 95 0 0 0+32 44 84 130 39 0 0 0+32 44 84 130 26 0 0 0+32 44 84 130 25 33 0 0+32 44 84 130 25 75 0 0+32 44 85 130 66 0 0 0+32 44 85 130 90 0 0 0+32 44 85 130 24 0 0 0+32 44 85 130 95 0 0 0+32 44 85 130 39 0 0 0+32 44 85 130 26 0 0 0+32 44 85 130 25 33 0 0+32 44 85 130 25 75 0 0+32 44 88 130 66 0 0 0+32 44 88 130 90 0 0 0+32 44 88 130 24 0 0 0+32 44 88 130 95 0 0 0+32 44 88 130 39 0 0 0+32 44 88 130 26 0 0 0+32 44 88 130 25 33 0 0+32 44 88 130 25 75 0 0+32 44 113 130 66 0 0 0+32 44 113 130 90 0 0 0+32 44 113 130 24 0 0 0+32 44 113 130 95 0 0 0+32 44 113 130 39 0 0 0+32 44 113 130 26 0 0 0+32 44 113 130 25 33 0 0+32 44 113 130 25 75 0 0+25 33 44 8 130 66 0 0+25 33 44 8 130 90 0 0+25 33 44 8 130 24 0 0+25 33 44 8 130 95 0 0+25 33 44 8 130 39 0 0+25 33 44 8 130 26 0 0+25 33 44 8 130 25 33 0+25 33 44 8 130 25 75 0+25 33 44 133 130 66 0 0+25 33 44 133 130 90 0 0+25 33 44 133 130 24 0 0+25 33 44 133 130 95 0 0+25 33 44 133 130 39 0 0+25 33 44 133 130 26 0 0+25 33 44 133 130 25 33 0+25 33 44 133 130 25 75 0+25 33 44 84 130 66 0 0+25 33 44 84 130 90 0 0+25 33 44 84 130 24 0 0+25 33 44 84 130 95 0 0+25 33 44 84 130 39 0 0+25 33 44 84 130 26 0 0+25 33 44 84 130 25 33 0+25 33 44 84 130 25 75 0+25 33 44 85 130 66 0 0+25 33 44 85 130 90 0 0+25 33 44 85 130 24 0 0+25 33 44 85 130 95 0 0+25 33 44 85 130 39 0 0+25 33 44 85 130 26 0 0+25 33 44 85 130 25 33 0+25 33 44 85 130 25 75 0+25 33 44 88 130 66 0 0+25 33 44 88 130 90 0 0+25 33 44 88 130 24 0 0+25 33 44 88 130 95 0 0+25 33 44 88 130 39 0 0+25 33 44 88 130 26 0 0+25 33 44 88 130 25 33 0+25 33 44 88 130 25 75 0+25 33 44 113 130 66 0 0+25 33 44 113 130 90 0 0+25 33 44 113 130 24 0 0+25 33 44 113 130 95 0 0+25 33 44 113 130 39 0 0+25 33 44 113 130 26 0 0+25 33 44 113 130 25 33 0+25 33 44 113 130 25 75 0+25 75 44 8 130 66 0 0+25 75 44 8 130 90 0 0+25 75 44 8 130 24 0 0+25 75 44 8 130 95 0 0+25 75 44 8 130 39 0 0+25 75 44 8 130 26 0 0+25 75 44 8 130 25 33 0+25 75 44 8 130 25 75 0+25 75 44 133 130 66 0 0+25 75 44 133 130 90 0 0+25 75 44 133 130 24 0 0+25 75 44 133 130 95 0 0+25 75 44 133 130 39 0 0+25 75 44 133 130 26 0 0+25 75 44 133 130 25 33 0+25 75 44 133 130 25 75 0+25 75 44 84 130 66 0 0+25 75 44 84 130 90 0 0+25 75 44 84 130 24 0 0+25 75 44 84 130 95 0 0+25 75 44 84 130 39 0 0+25 75 44 84 130 26 0 0+25 75 44 84 130 25 33 0+25 75 44 84 130 25 75 0+25 75 44 85 130 66 0 0+25 75 44 85 130 90 0 0+25 75 44 85 130 24 0 0+25 75 44 85 130 95 0 0+25 75 44 85 130 39 0 0+25 75 44 85 130 26 0 0+25 75 44 85 130 25 33 0+25 75 44 85 130 25 75 0+25 75 44 88 130 66 0 0+25 75 44 88 130 90 0 0+25 75 44 88 130 24 0 0+25 75 44 88 130 95 0 0+25 75 44 88 130 39 0 0+25 75 44 88 130 26 0 0+25 75 44 88 130 25 33 0+25 75 44 88 130 25 75 0+25 75 44 113 130 66 0 0+25 75 44 113 130 90 0 0+25 75 44 113 130 24 0 0+25 75 44 113 130 95 0 0+25 75 44 113 130 39 0 0+25 75 44 113 130 26 0 0+25 75 44 113 130 25 33 0+25 75 44 113 130 25 75 0+56 135 8 66 0 0 0 0+56 135 8 90 0 0 0 0+56 135 8 24 0 0 0 0+56 135 8 95 0 0 0 0+56 135 8 39 0 0 0 0+56 135 8 26 0 0 0 0+56 135 8 25 33 0 0 0+56 135 8 25 75 0 0 0+56 135 133 66 0 0 0 0+56 135 133 90 0 0 0 0+56 135 133 24 0 0 0 0+56 135 133 95 0 0 0 0+56 135 133 39 0 0 0 0+56 135 133 26 0 0 0 0+56 135 133 25 33 0 0 0+56 135 133 25 75 0 0 0+56 135 84 66 0 0 0 0+56 135 84 90 0 0 0 0+56 135 84 24 0 0 0 0+56 135 84 95 0 0 0 0+56 135 84 39 0 0 0 0+56 135 84 26 0 0 0 0+56 135 84 25 33 0 0 0+56 135 84 25 75 0 0 0+56 135 85 66 0 0 0 0+56 135 85 90 0 0 0 0+56 135 85 24 0 0 0 0+56 135 85 95 0 0 0 0+56 135 85 39 0 0 0 0+56 135 85 26 0 0 0 0+56 135 85 25 33 0 0 0+56 135 85 25 75 0 0 0+56 135 88 66 0 0 0 0+56 135 88 90 0 0 0 0+56 135 88 24 0 0 0 0+56 135 88 95 0 0 0 0+56 135 88 39 0 0 0 0+56 135 88 26 0 0 0 0+56 135 88 25 33 0 0 0+56 135 88 25 75 0 0 0+56 135 113 66 0 0 0 0+56 135 113 90 0 0 0 0+56 135 113 24 0 0 0 0+56 135 113 95 0 0 0 0+56 135 113 39 0 0 0 0+56 135 113 26 0 0 0 0+56 135 113 25 33 0 0 0+56 135 113 25 75 0 0 0+77 135 8 66 0 0 0 0+77 135 8 90 0 0 0 0+77 135 8 24 0 0 0 0+77 135 8 95 0 0 0 0+77 135 8 39 0 0 0 0+77 135 8 26 0 0 0 0+77 135 8 25 33 0 0 0+77 135 8 25 75 0 0 0+77 135 133 66 0 0 0 0+77 135 133 90 0 0 0 0+77 135 133 24 0 0 0 0+77 135 133 95 0 0 0 0+77 135 133 39 0 0 0 0+77 135 133 26 0 0 0 0+77 135 133 25 33 0 0 0+77 135 133 25 75 0 0 0+77 135 84 66 0 0 0 0+77 135 84 90 0 0 0 0+77 135 84 24 0 0 0 0+77 135 84 95 0 0 0 0+77 135 84 39 0 0 0 0+77 135 84 26 0 0 0 0+77 135 84 25 33 0 0 0+77 135 84 25 75 0 0 0+77 135 85 66 0 0 0 0+77 135 85 90 0 0 0 0+77 135 85 24 0 0 0 0+77 135 85 95 0 0 0 0+77 135 85 39 0 0 0 0+77 135 85 26 0 0 0 0+77 135 85 25 33 0 0 0+77 135 85 25 75 0 0 0+77 135 88 66 0 0 0 0+77 135 88 90 0 0 0 0+77 135 88 24 0 0 0 0+77 135 88 95 0 0 0 0+77 135 88 39 0 0 0 0+77 135 88 26 0 0 0 0+77 135 88 25 33 0 0 0+77 135 88 25 75 0 0 0+77 135 113 66 0 0 0 0+77 135 113 90 0 0 0 0+77 135 113 24 0 0 0 0+77 135 113 95 0 0 0 0+77 135 113 39 0 0 0 0+77 135 113 26 0 0 0 0+77 135 113 25 33 0 0 0+77 135 113 25 75 0 0 0+22 135 8 66 0 0 0 0+22 135 8 90 0 0 0 0+22 135 8 24 0 0 0 0+22 135 8 95 0 0 0 0+22 135 8 39 0 0 0 0+22 135 8 26 0 0 0 0+22 135 8 25 33 0 0 0+22 135 8 25 75 0 0 0+22 135 133 66 0 0 0 0+22 135 133 90 0 0 0 0+22 135 133 24 0 0 0 0+22 135 133 95 0 0 0 0+22 135 133 39 0 0 0 0+22 135 133 26 0 0 0 0+22 135 133 25 33 0 0 0+22 135 133 25 75 0 0 0+22 135 84 66 0 0 0 0+22 135 84 90 0 0 0 0+22 135 84 24 0 0 0 0+22 135 84 95 0 0 0 0+22 135 84 39 0 0 0 0+22 135 84 26 0 0 0 0+22 135 84 25 33 0 0 0+22 135 84 25 75 0 0 0+22 135 85 66 0 0 0 0+22 135 85 90 0 0 0 0+22 135 85 24 0 0 0 0+22 135 85 95 0 0 0 0+22 135 85 39 0 0 0 0+22 135 85 26 0 0 0 0+22 135 85 25 33 0 0 0+22 135 85 25 75 0 0 0+22 135 88 66 0 0 0 0+22 135 88 90 0 0 0 0+22 135 88 24 0 0 0 0+22 135 88 95 0 0 0 0+22 135 88 39 0 0 0 0+22 135 88 26 0 0 0 0+22 135 88 25 33 0 0 0+22 135 88 25 75 0 0 0+22 135 113 66 0 0 0 0+22 135 113 90 0 0 0 0+22 135 113 24 0 0 0 0+22 135 113 95 0 0 0 0+22 135 113 39 0 0 0 0+22 135 113 26 0 0 0 0+22 135 113 25 33 0 0 0+22 135 113 25 75 0 0 0+134 135 8 66 0 0 0 0+134 135 8 90 0 0 0 0+134 135 8 24 0 0 0 0+134 135 8 95 0 0 0 0+134 135 8 39 0 0 0 0+134 135 8 26 0 0 0 0+134 135 8 25 33 0 0 0+134 135 8 25 75 0 0 0+134 135 133 66 0 0 0 0+134 135 133 90 0 0 0 0+134 135 133 24 0 0 0 0+134 135 133 95 0 0 0 0+134 135 133 39 0 0 0 0+134 135 133 26 0 0 0 0+134 135 133 25 33 0 0 0+134 135 133 25 75 0 0 0+134 135 84 66 0 0 0 0+134 135 84 90 0 0 0 0+134 135 84 24 0 0 0 0+134 135 84 95 0 0 0 0+134 135 84 39 0 0 0 0+134 135 84 26 0 0 0 0+134 135 84 25 33 0 0 0+134 135 84 25 75 0 0 0+134 135 85 66 0 0 0 0+134 135 85 90 0 0 0 0+134 135 85 24 0 0 0 0+134 135 85 95 0 0 0 0+134 135 85 39 0 0 0 0+134 135 85 26 0 0 0 0+134 135 85 25 33 0 0 0+134 135 85 25 75 0 0 0+134 135 88 66 0 0 0 0+134 135 88 90 0 0 0 0+134 135 88 24 0 0 0 0+134 135 88 95 0 0 0 0+134 135 88 39 0 0 0 0+134 135 88 26 0 0 0 0+134 135 88 25 33 0 0 0+134 135 88 25 75 0 0 0+134 135 113 66 0 0 0 0+134 135 113 90 0 0 0 0+134 135 113 24 0 0 0 0+134 135 113 95 0 0 0 0+134 135 113 39 0 0 0 0+134 135 113 26 0 0 0 0+134 135 113 25 33 0 0 0+134 135 113 25 75 0 0 0+93 135 8 66 0 0 0 0+93 135 8 90 0 0 0 0+93 135 8 24 0 0 0 0+93 135 8 95 0 0 0 0+93 135 8 39 0 0 0 0+93 135 8 26 0 0 0 0+93 135 8 25 33 0 0 0+93 135 8 25 75 0 0 0+93 135 133 66 0 0 0 0+93 135 133 90 0 0 0 0+93 135 133 24 0 0 0 0+93 135 133 95 0 0 0 0+93 135 133 39 0 0 0 0+93 135 133 26 0 0 0 0+93 135 133 25 33 0 0 0+93 135 133 25 75 0 0 0+93 135 84 66 0 0 0 0+93 135 84 90 0 0 0 0+93 135 84 24 0 0 0 0+93 135 84 95 0 0 0 0+93 135 84 39 0 0 0 0+93 135 84 26 0 0 0 0+93 135 84 25 33 0 0 0+93 135 84 25 75 0 0 0+93 135 85 66 0 0 0 0+93 135 85 90 0 0 0 0+93 135 85 24 0 0 0 0+93 135 85 95 0 0 0 0+93 135 85 39 0 0 0 0+93 135 85 26 0 0 0 0+93 135 85 25 33 0 0 0+93 135 85 25 75 0 0 0+93 135 88 66 0 0 0 0+93 135 88 90 0 0 0 0+93 135 88 24 0 0 0 0+93 135 88 95 0 0 0 0+93 135 88 39 0 0 0 0+93 135 88 26 0 0 0 0+93 135 88 25 33 0 0 0+93 135 88 25 75 0 0 0+93 135 113 66 0 0 0 0+93 135 113 90 0 0 0 0+93 135 113 24 0 0 0 0+93 135 113 95 0 0 0 0+93 135 113 39 0 0 0 0+93 135 113 26 0 0 0 0+93 135 113 25 33 0 0 0+93 135 113 25 75 0 0 0+32 135 8 66 0 0 0 0+32 135 8 90 0 0 0 0+32 135 8 24 0 0 0 0+32 135 8 95 0 0 0 0+32 135 8 39 0 0 0 0+32 135 8 26 0 0 0 0+32 135 8 25 33 0 0 0+32 135 8 25 75 0 0 0+32 135 133 66 0 0 0 0+32 135 133 90 0 0 0 0+32 135 133 24 0 0 0 0+32 135 133 95 0 0 0 0+32 135 133 39 0 0 0 0+32 135 133 26 0 0 0 0+32 135 133 25 33 0 0 0+32 135 133 25 75 0 0 0+32 135 84 66 0 0 0 0+32 135 84 90 0 0 0 0+32 135 84 24 0 0 0 0+32 135 84 95 0 0 0 0+32 135 84 39 0 0 0 0+32 135 84 26 0 0 0 0+32 135 84 25 33 0 0 0+32 135 84 25 75 0 0 0+32 135 85 66 0 0 0 0+32 135 85 90 0 0 0 0+32 135 85 24 0 0 0 0+32 135 85 95 0 0 0 0+32 135 85 39 0 0 0 0+32 135 85 26 0 0 0 0+32 135 85 25 33 0 0 0+32 135 85 25 75 0 0 0+32 135 88 66 0 0 0 0+32 135 88 90 0 0 0 0+32 135 88 24 0 0 0 0+32 135 88 95 0 0 0 0+32 135 88 39 0 0 0 0+32 135 88 26 0 0 0 0+32 135 88 25 33 0 0 0+32 135 88 25 75 0 0 0+32 135 113 66 0 0 0 0+32 135 113 90 0 0 0 0+32 135 113 24 0 0 0 0+32 135 113 95 0 0 0 0+32 135 113 39 0 0 0 0+32 135 113 26 0 0 0 0+32 135 113 25 33 0 0 0+32 135 113 25 75 0 0 0+25 33 135 8 66 0 0 0+25 33 135 8 90 0 0 0+25 33 135 8 24 0 0 0+25 33 135 8 95 0 0 0+25 33 135 8 39 0 0 0+25 33 135 8 26 0 0 0+25 33 135 8 25 33 0 0+25 33 135 8 25 75 0 0+25 33 135 133 66 0 0 0+25 33 135 133 90 0 0 0+25 33 135 133 24 0 0 0+25 33 135 133 95 0 0 0+25 33 135 133 39 0 0 0+25 33 135 133 26 0 0 0+25 33 135 133 25 33 0 0+25 33 135 133 25 75 0 0+25 33 135 84 66 0 0 0+25 33 135 84 90 0 0 0+25 33 135 84 24 0 0 0+25 33 135 84 95 0 0 0+25 33 135 84 39 0 0 0+25 33 135 84 26 0 0 0+25 33 135 84 25 33 0 0+25 33 135 84 25 75 0 0+25 33 135 85 66 0 0 0+25 33 135 85 90 0 0 0+25 33 135 85 24 0 0 0+25 33 135 85 95 0 0 0+25 33 135 85 39 0 0 0+25 33 135 85 26 0 0 0+25 33 135 85 25 33 0 0+25 33 135 85 25 75 0 0+25 33 135 88 66 0 0 0+25 33 135 88 90 0 0 0+25 33 135 88 24 0 0 0+25 33 135 88 95 0 0 0+25 33 135 88 39 0 0 0+25 33 135 88 26 0 0 0+25 33 135 88 25 33 0 0+25 33 135 88 25 75 0 0+25 33 135 113 66 0 0 0+25 33 135 113 90 0 0 0+25 33 135 113 24 0 0 0+25 33 135 113 95 0 0 0+25 33 135 113 39 0 0 0+25 33 135 113 26 0 0 0+25 33 135 113 25 33 0 0+25 33 135 113 25 75 0 0+25 75 135 8 66 0 0 0+25 75 135 8 90 0 0 0+25 75 135 8 24 0 0 0+25 75 135 8 95 0 0 0+25 75 135 8 39 0 0 0+25 75 135 8 26 0 0 0+25 75 135 8 25 33 0 0+25 75 135 8 25 75 0 0+25 75 135 133 66 0 0 0+25 75 135 133 90 0 0 0+25 75 135 133 24 0 0 0+25 75 135 133 95 0 0 0+25 75 135 133 39 0 0 0+25 75 135 133 26 0 0 0+25 75 135 133 25 33 0 0+25 75 135 133 25 75 0 0+25 75 135 84 66 0 0 0+25 75 135 84 90 0 0 0+25 75 135 84 24 0 0 0+25 75 135 84 95 0 0 0+25 75 135 84 39 0 0 0+25 75 135 84 26 0 0 0+25 75 135 84 25 33 0 0+25 75 135 84 25 75 0 0+25 75 135 85 66 0 0 0+25 75 135 85 90 0 0 0+25 75 135 85 24 0 0 0+25 75 135 85 95 0 0 0+25 75 135 85 39 0 0 0+25 75 135 85 26 0 0 0+25 75 135 85 25 33 0 0+25 75 135 85 25 75 0 0+25 75 135 88 66 0 0 0+25 75 135 88 90 0 0 0+25 75 135 88 24 0 0 0+25 75 135 88 95 0 0 0+25 75 135 88 39 0 0 0+25 75 135 88 26 0 0 0+25 75 135 88 25 33 0 0+25 75 135 88 25 75 0 0+25 75 135 113 66 0 0 0+25 75 135 113 90 0 0 0+25 75 135 113 24 0 0 0+25 75 135 113 95 0 0 0+25 75 135 113 39 0 0 0+25 75 135 113 26 0 0 0+25 75 135 113 25 33 0 0+25 75 135 113 25 75 0 0+125 76 7 0 0 0 0 0+129 76 7 0 0 0 0 0+125 76 10 0 0 0 0 0+129 76 10 0 0 0 0 0+125 76 16 0 0 0 0 0+129 76 16 0 0 0 0 0+125 76 47 0 0 0 0 0+129 76 47 0 0 0 0 0+125 76 68 0 0 0 0 0+129 76 68 0 0 0 0 0+125 76 98 0 0 0 0 0+129 76 98 0 0 0 0 0+125 76 117 0 0 0 0 0+129 76 117 0 0 0 0 0+125 76 143 0 0 0 0 0+129 76 143 0 0 0 0 0+125 76 145 0 0 0 0 0+129 76 145 0 0 0 0 0+125 76 21 0 0 0 0 0+129 76 21 0 0 0 0 0+125 76 23 0 0 0 0 0+129 76 23 0 0 0 0 0+125 76 72 0 0 0 0 0+129 76 72 0 0 0 0 0+125 76 81 0 0 0 0 0+129 76 81 0 0 0 0 0+125 76 108 0 0 0 0 0+129 76 108 0 0 0 0 0+125 15 61 0 0 0 0 0+125 15 127 0 0 0 0 0+129 15 61 0 0 0 0 0+129 15 127 0 0 0 0 0+125 115 61 0 0 0 0 0+125 115 127 0 0 0 0 0+129 115 61 0 0 0 0 0+129 115 127 0 0 0 0 0+125 140 61 0 0 0 0 0+125 140 127 0 0 0 0 0+129 140 61 0 0 0 0 0+129 140 127 0 0 0 0 0+125 20 61 0 0 0 0 0+125 20 127 0 0 0 0 0+129 20 61 0 0 0 0 0+129 20 127 0 0 0 0 0+125 74 61 0 0 0 0 0+125 74 127 0 0 0 0 0+129 74 61 0 0 0 0 0+129 74 127 0 0 0 0 0+125 29 125 61 0 0 0 0+125 29 125 127 0 0 0 0+125 29 129 61 0 0 0 0+125 29 129 127 0 0 0 0+129 29 125 61 0 0 0 0+129 29 125 127 0 0 0 0+129 29 129 61 0 0 0 0+129 29 129 127 0 0 0 0+125 38 125 61 0 0 0 0+125 38 125 127 0 0 0 0+125 38 129 61 0 0 0 0+125 38 129 127 0 0 0 0+129 38 125 61 0 0 0 0+129 38 125 127 0 0 0 0+129 38 129 61 0 0 0 0+129 38 129 127 0 0 0 0+125 58 125 61 0 0 0 0+125 58 125 127 0 0 0 0+125 58 129 61 0 0 0 0+125 58 129 127 0 0 0 0+129 58 125 61 0 0 0 0+129 58 125 127 0 0 0 0+129 58 129 61 0 0 0 0+129 58 129 127 0 0 0 0+125 104 125 61 0 0 0 0+125 104 125 127 0 0 0 0+125 104 129 61 0 0 0 0+125 104 129 127 0 0 0 0+129 104 125 61 0 0 0 0+129 104 125 127 0 0 0 0+129 104 129 61 0 0 0 0+129 104 129 127 0 0 0 0+125 18 144 125 61 0 0 0+125 18 144 125 127 0 0 0+125 18 144 129 61 0 0 0+125 18 144 129 127 0 0 0+129 18 144 125 61 0 0 0+129 18 144 125 127 0 0 0+129 18 144 129 61 0 0 0+129 18 144 129 127 0 0 0+125 31 125 61 0 0 0 0+125 31 125 127 0 0 0 0+125 31 129 61 0 0 0 0+125 31 129 127 0 0 0 0+129 31 125 61 0 0 0 0+129 31 125 127 0 0 0 0+129 31 129 61 0 0 0 0+129 31 129 127 0 0 0 0+125 92 125 61 0 0 0 0+125 92 125 127 0 0 0 0+125 92 129 61 0 0 0 0+125 92 129 127 0 0 0 0+129 92 125 61 0 0 0 0+129 92 125 127 0 0 0 0+129 92 129 61 0 0 0 0+129 92 129 127 0 0 0 0+125 97 125 61 0 0 0 0+125 97 125 127 0 0 0 0+125 97 129 61 0 0 0 0+125 97 129 127 0 0 0 0+129 97 125 61 0 0 0 0+129 97 125 127 0 0 0 0+129 97 129 61 0 0 0 0+129 97 129 127 0 0 0 0+125 76 125 0 0 0 0 0+129 76 125 0 0 0 0 0+125 76 129 0 0 0 0 0+129 76 129 0 0 0 0 0+125 15 0 0 0 0 0 0+129 15 0 0 0 0 0 0+125 115 0 0 0 0 0 0+129 115 0 0 0 0 0 0+125 140 0 0 0 0 0 0+129 140 0 0 0 0 0 0+125 20 0 0 0 0 0 0+129 20 0 0 0 0 0 0+125 74 0 0 0 0 0 0+129 74 0 0 0 0 0 0+125 29 125 0 0 0 0 0+125 29 129 0 0 0 0 0+129 29 125 0 0 0 0 0+129 29 129 0 0 0 0 0+125 38 125 0 0 0 0 0+125 38 129 0 0 0 0 0+129 38 125 0 0 0 0 0+129 38 129 0 0 0 0 0+125 58 125 0 0 0 0 0+125 58 129 0 0 0 0 0+129 58 125 0 0 0 0 0+129 58 129 0 0 0 0 0+125 104 125 0 0 0 0 0+125 104 129 0 0 0 0 0+129 104 125 0 0 0 0 0+129 104 129 0 0 0 0 0+125 18 144 125 0 0 0 0+125 18 144 129 0 0 0 0+129 18 144 125 0 0 0 0+129 18 144 129 0 0 0 0+125 31 125 0 0 0 0 0+125 31 129 0 0 0 0 0+129 31 125 0 0 0 0 0+129 31 129 0 0 0 0 0+125 92 125 0 0 0 0 0+125 92 129 0 0 0 0 0+129 92 125 0 0 0 0 0+129 92 129 0 0 0 0 0+125 97 125 0 0 0 0 0+125 97 129 0 0 0 0 0+129 97 125 0 0 0 0 0+129 97 129 0 0 0 0 0+125 46 125 131 125 0 0 0+125 46 125 131 129 0 0 0+125 46 129 131 125 0 0 0+125 46 129 131 129 0 0 0+129 46 125 131 125 0 0 0+129 46 125 131 129 0 0 0+129 46 129 131 125 0 0 0+129 46 129 131 129 0 0 0+125 107 125 125 0 0 0 0+125 107 125 129 0 0 0 0+125 107 129 125 0 0 0 0+125 107 129 129 0 0 0 0+129 107 125 125 0 0 0 0+129 107 125 129 0 0 0 0+129 107 129 125 0 0 0 0+129 107 129 129 0 0 0 0+60 76 7 0 0 0 0 0+1 3 7 0 0 0 0 0+128 5 7 0 0 0 0 0+142 5 7 0 0 0 0 0+146 5 7 0 0 0 0 0+146 5 7 0 0 0 0 0+60 76 10 0 0 0 0 0+1 3 10 0 0 0 0 0+128 5 10 0 0 0 0 0+142 5 10 0 0 0 0 0+146 5 10 0 0 0 0 0+146 5 10 0 0 0 0 0+60 76 16 0 0 0 0 0+1 3 16 0 0 0 0 0+128 5 16 0 0 0 0 0+142 5 16 0 0 0 0 0+146 5 16 0 0 0 0 0+146 5 16 0 0 0 0 0+60 76 47 0 0 0 0 0+1 3 47 0 0 0 0 0+128 5 47 0 0 0 0 0+142 5 47 0 0 0 0 0+146 5 47 0 0 0 0 0+146 5 47 0 0 0 0 0+60 76 68 0 0 0 0 0+1 3 68 0 0 0 0 0+128 5 68 0 0 0 0 0+142 5 68 0 0 0 0 0+146 5 68 0 0 0 0 0+146 5 68 0 0 0 0 0+60 76 98 0 0 0 0 0+1 3 98 0 0 0 0 0+128 5 98 0 0 0 0 0+142 5 98 0 0 0 0 0+146 5 98 0 0 0 0 0+146 5 98 0 0 0 0 0+60 76 117 0 0 0 0 0+1 3 117 0 0 0 0 0+128 5 117 0 0 0 0 0+142 5 117 0 0 0 0 0+146 5 117 0 0 0 0 0+146 5 117 0 0 0 0 0+60 76 143 0 0 0 0 0+1 3 143 0 0 0 0 0+128 5 143 0 0 0 0 0+142 5 143 0 0 0 0 0+146 5 143 0 0 0 0 0+146 5 143 0 0 0 0 0+60 76 145 0 0 0 0 0+1 3 145 0 0 0 0 0+128 5 145 0 0 0 0 0+142 5 145 0 0 0 0 0+146 5 145 0 0 0 0 0+146 5 145 0 0 0 0 0+60 76 21 0 0 0 0 0+1 3 21 0 0 0 0 0+128 5 21 0 0 0 0 0+142 5 21 0 0 0 0 0+146 5 21 0 0 0 0 0+146 5 21 0 0 0 0 0+60 76 23 0 0 0 0 0+1 3 23 0 0 0 0 0+128 5 23 0 0 0 0 0+142 5 23 0 0 0 0 0+146 5 23 0 0 0 0 0+146 5 23 0 0 0 0 0+60 76 72 0 0 0 0 0+1 3 72 0 0 0 0 0+128 5 72 0 0 0 0 0+142 5 72 0 0 0 0 0+146 5 72 0 0 0 0 0+146 5 72 0 0 0 0 0+60 76 81 0 0 0 0 0+1 3 81 0 0 0 0 0+128 5 81 0 0 0 0 0+142 5 81 0 0 0 0 0+146 5 81 0 0 0 0 0+146 5 81 0 0 0 0 0+60 76 108 0 0 0 0 0+1 3 108 0 0 0 0 0+128 5 108 0 0 0 0 0+142 5 108 0 0 0 0 0+146 5 108 0 0 0 0 0+146 5 108 0 0 0 0 0+60 15 61 0 0 0 0 0+60 15 127 0 0 0 0 0+1 14 61 0 0 0 0 0+1 14 127 0 0 0 0 0+128 14 61 0 0 0 0 0+128 14 127 0 0 0 0 0+142 14 61 0 0 0 0 0+142 14 127 0 0 0 0 0+146 14 61 0 0 0 0 0+146 14 127 0 0 0 0 0+146 14 61 0 0 0 0 0+146 14 127 0 0 0 0 0+60 115 61 0 0 0 0 0+60 115 127 0 0 0 0 0+1 114 61 0 0 0 0 0+1 114 127 0 0 0 0 0+128 114 61 0 0 0 0 0+128 114 127 0 0 0 0 0+142 114 61 0 0 0 0 0+142 114 127 0 0 0 0 0+146 114 61 0 0 0 0 0+146 114 127 0 0 0 0 0+146 114 61 0 0 0 0 0+146 114 127 0 0 0 0 0+60 140 61 0 0 0 0 0+60 140 127 0 0 0 0 0+1 139 61 0 0 0 0 0+1 139 127 0 0 0 0 0+128 139 61 0 0 0 0 0+128 139 127 0 0 0 0 0+142 139 61 0 0 0 0 0+142 139 127 0 0 0 0 0+146 139 61 0 0 0 0 0+146 139 127 0 0 0 0 0+146 139 61 0 0 0 0 0+146 139 127 0 0 0 0 0+60 20 61 0 0 0 0 0+60 20 127 0 0 0 0 0+1 19 61 0 0 0 0 0+1 19 127 0 0 0 0 0+128 19 61 0 0 0 0 0+128 19 127 0 0 0 0 0+142 19 61 0 0 0 0 0+142 19 127 0 0 0 0 0+146 19 61 0 0 0 0 0+146 19 127 0 0 0 0 0+146 19 61 0 0 0 0 0+146 19 127 0 0 0 0 0+60 74 61 0 0 0 0 0+60 74 127 0 0 0 0 0+1 73 61 0 0 0 0 0+1 73 127 0 0 0 0 0+128 73 61 0 0 0 0 0+128 73 127 0 0 0 0 0+142 73 61 0 0 0 0 0+142 73 127 0 0 0 0 0+146 73 61 0 0 0 0 0+146 73 127 0 0 0 0 0+146 73 61 0 0 0 0 0+146 73 127 0 0 0 0 0+60 29 65 61 0 0 0 0+60 29 65 127 0 0 0 0+60 29 86 61 0 0 0 0+60 29 86 127 0 0 0 0+60 29 126 61 0 0 0 0+60 29 126 127 0 0 0 0+60 29 132 61 0 0 0 0+60 29 132 127 0 0 0 0+60 29 146 61 0 0 0 0+60 29 146 127 0 0 0 0+60 29 146 61 0 0 0 0+60 29 146 127 0 0 0 0+60 29 125 61 0 0 0 0+60 29 125 127 0 0 0 0+60 29 129 61 0 0 0 0+60 29 129 127 0 0 0 0+1 28 65 61 0 0 0 0+1 28 65 127 0 0 0 0+1 28 86 61 0 0 0 0+1 28 86 127 0 0 0 0+1 28 126 61 0 0 0 0+1 28 126 127 0 0 0 0+1 28 132 61 0 0 0 0+1 28 132 127 0 0 0 0+1 28 146 61 0 0 0 0+1 28 146 127 0 0 0 0+1 28 146 61 0 0 0 0+1 28 146 127 0 0 0 0+1 28 125 61 0 0 0 0+1 28 125 127 0 0 0 0+1 28 129 61 0 0 0 0+1 28 129 127 0 0 0 0+128 28 65 61 0 0 0 0+128 28 65 127 0 0 0 0+128 28 86 61 0 0 0 0+128 28 86 127 0 0 0 0+128 28 126 61 0 0 0 0+128 28 126 127 0 0 0 0+128 28 132 61 0 0 0 0+128 28 132 127 0 0 0 0+128 28 146 61 0 0 0 0+128 28 146 127 0 0 0 0+128 28 146 61 0 0 0 0+128 28 146 127 0 0 0 0+128 28 125 61 0 0 0 0+128 28 125 127 0 0 0 0+128 28 129 61 0 0 0 0+128 28 129 127 0 0 0 0+142 28 65 61 0 0 0 0+142 28 65 127 0 0 0 0+142 28 86 61 0 0 0 0+142 28 86 127 0 0 0 0+142 28 126 61 0 0 0 0+142 28 126 127 0 0 0 0+142 28 132 61 0 0 0 0+142 28 132 127 0 0 0 0+142 28 146 61 0 0 0 0+142 28 146 127 0 0 0 0+142 28 146 61 0 0 0 0+142 28 146 127 0 0 0 0+142 28 125 61 0 0 0 0+142 28 125 127 0 0 0 0+142 28 129 61 0 0 0 0+142 28 129 127 0 0 0 0+146 28 65 61 0 0 0 0+146 28 65 127 0 0 0 0+146 28 86 61 0 0 0 0+146 28 86 127 0 0 0 0+146 28 126 61 0 0 0 0+146 28 126 127 0 0 0 0+146 28 132 61 0 0 0 0+146 28 132 127 0 0 0 0+146 28 146 61 0 0 0 0+146 28 146 127 0 0 0 0+146 28 146 61 0 0 0 0+146 28 146 127 0 0 0 0+146 28 125 61 0 0 0 0+146 28 125 127 0 0 0 0+146 28 129 61 0 0 0 0+146 28 129 127 0 0 0 0+146 28 65 61 0 0 0 0+146 28 65 127 0 0 0 0+146 28 86 61 0 0 0 0+146 28 86 127 0 0 0 0+146 28 126 61 0 0 0 0+146 28 126 127 0 0 0 0+146 28 132 61 0 0 0 0+146 28 132 127 0 0 0 0+146 28 146 61 0 0 0 0+146 28 146 127 0 0 0 0+146 28 146 61 0 0 0 0+146 28 146 127 0 0 0 0+146 28 125 61 0 0 0 0+146 28 125 127 0 0 0 0+146 28 129 61 0 0 0 0+146 28 129 127 0 0 0 0+125 29 65 61 0 0 0 0+125 29 65 127 0 0 0 0+125 29 86 61 0 0 0 0+125 29 86 127 0 0 0 0+125 29 126 61 0 0 0 0+125 29 126 127 0 0 0 0+125 29 132 61 0 0 0 0+125 29 132 127 0 0 0 0+125 29 146 61 0 0 0 0+125 29 146 127 0 0 0 0+125 29 146 61 0 0 0 0+125 29 146 127 0 0 0 0+129 29 65 61 0 0 0 0+129 29 65 127 0 0 0 0+129 29 86 61 0 0 0 0+129 29 86 127 0 0 0 0+129 29 126 61 0 0 0 0+129 29 126 127 0 0 0 0+129 29 132 61 0 0 0 0+129 29 132 127 0 0 0 0+129 29 146 61 0 0 0 0+129 29 146 127 0 0 0 0+129 29 146 61 0 0 0 0+129 29 146 127 0 0 0 0+60 38 65 61 0 0 0 0+60 38 65 127 0 0 0 0+60 38 86 61 0 0 0 0+60 38 86 127 0 0 0 0+60 38 126 61 0 0 0 0+60 38 126 127 0 0 0 0+60 38 132 61 0 0 0 0+60 38 132 127 0 0 0 0+60 38 146 61 0 0 0 0+60 38 146 127 0 0 0 0+60 38 146 61 0 0 0 0+60 38 146 127 0 0 0 0+60 38 125 61 0 0 0 0+60 38 125 127 0 0 0 0+60 38 129 61 0 0 0 0+60 38 129 127 0 0 0 0+1 37 65 61 0 0 0 0+1 37 65 127 0 0 0 0+1 37 86 61 0 0 0 0+1 37 86 127 0 0 0 0+1 37 126 61 0 0 0 0+1 37 126 127 0 0 0 0+1 37 132 61 0 0 0 0+1 37 132 127 0 0 0 0+1 37 146 61 0 0 0 0+1 37 146 127 0 0 0 0+1 37 146 61 0 0 0 0+1 37 146 127 0 0 0 0+1 37 125 61 0 0 0 0+1 37 125 127 0 0 0 0+1 37 129 61 0 0 0 0+1 37 129 127 0 0 0 0+128 37 65 61 0 0 0 0+128 37 65 127 0 0 0 0+128 37 86 61 0 0 0 0+128 37 86 127 0 0 0 0+128 37 126 61 0 0 0 0+128 37 126 127 0 0 0 0+128 37 132 61 0 0 0 0+128 37 132 127 0 0 0 0+128 37 146 61 0 0 0 0+128 37 146 127 0 0 0 0+128 37 146 61 0 0 0 0+128 37 146 127 0 0 0 0+128 37 125 61 0 0 0 0+128 37 125 127 0 0 0 0+128 37 129 61 0 0 0 0+128 37 129 127 0 0 0 0+142 37 65 61 0 0 0 0+142 37 65 127 0 0 0 0+142 37 86 61 0 0 0 0+142 37 86 127 0 0 0 0+142 37 126 61 0 0 0 0+142 37 126 127 0 0 0 0+142 37 132 61 0 0 0 0+142 37 132 127 0 0 0 0+142 37 146 61 0 0 0 0+142 37 146 127 0 0 0 0+142 37 146 61 0 0 0 0+142 37 146 127 0 0 0 0+142 37 125 61 0 0 0 0+142 37 125 127 0 0 0 0+142 37 129 61 0 0 0 0+142 37 129 127 0 0 0 0+146 37 65 61 0 0 0 0+146 37 65 127 0 0 0 0+146 37 86 61 0 0 0 0+146 37 86 127 0 0 0 0+146 37 126 61 0 0 0 0+146 37 126 127 0 0 0 0+146 37 132 61 0 0 0 0+146 37 132 127 0 0 0 0+146 37 146 61 0 0 0 0+146 37 146 127 0 0 0 0+146 37 146 61 0 0 0 0+146 37 146 127 0 0 0 0+146 37 125 61 0 0 0 0+146 37 125 127 0 0 0 0+146 37 129 61 0 0 0 0+146 37 129 127 0 0 0 0+146 37 65 61 0 0 0 0+146 37 65 127 0 0 0 0+146 37 86 61 0 0 0 0+146 37 86 127 0 0 0 0+146 37 126 61 0 0 0 0+146 37 126 127 0 0 0 0+146 37 132 61 0 0 0 0+146 37 132 127 0 0 0 0+146 37 146 61 0 0 0 0+146 37 146 127 0 0 0 0+146 37 146 61 0 0 0 0+146 37 146 127 0 0 0 0+146 37 125 61 0 0 0 0+146 37 125 127 0 0 0 0+146 37 129 61 0 0 0 0+146 37 129 127 0 0 0 0+125 38 65 61 0 0 0 0+125 38 65 127 0 0 0 0+125 38 86 61 0 0 0 0+125 38 86 127 0 0 0 0+125 38 126 61 0 0 0 0+125 38 126 127 0 0 0 0+125 38 132 61 0 0 0 0+125 38 132 127 0 0 0 0+125 38 146 61 0 0 0 0+125 38 146 127 0 0 0 0+125 38 146 61 0 0 0 0+125 38 146 127 0 0 0 0+129 38 65 61 0 0 0 0+129 38 65 127 0 0 0 0+129 38 86 61 0 0 0 0+129 38 86 127 0 0 0 0+129 38 126 61 0 0 0 0+129 38 126 127 0 0 0 0+129 38 132 61 0 0 0 0+129 38 132 127 0 0 0 0+129 38 146 61 0 0 0 0+129 38 146 127 0 0 0 0+129 38 146 61 0 0 0 0+129 38 146 127 0 0 0 0+60 58 65 61 0 0 0 0+60 58 65 127 0 0 0 0+60 58 86 61 0 0 0 0+60 58 86 127 0 0 0 0+60 58 126 61 0 0 0 0+60 58 126 127 0 0 0 0+60 58 132 61 0 0 0 0+60 58 132 127 0 0 0 0+60 58 146 61 0 0 0 0+60 58 146 127 0 0 0 0+60 58 146 61 0 0 0 0+60 58 146 127 0 0 0 0+60 58 125 61 0 0 0 0+60 58 125 127 0 0 0 0+60 58 129 61 0 0 0 0+60 58 129 127 0 0 0 0+1 59 65 61 0 0 0 0+1 59 65 127 0 0 0 0+1 59 86 61 0 0 0 0+1 59 86 127 0 0 0 0+1 59 126 61 0 0 0 0+1 59 126 127 0 0 0 0+1 59 132 61 0 0 0 0+1 59 132 127 0 0 0 0+1 59 146 61 0 0 0 0+1 59 146 127 0 0 0 0+1 59 146 61 0 0 0 0+1 59 146 127 0 0 0 0+1 59 125 61 0 0 0 0+1 59 125 127 0 0 0 0+1 59 129 61 0 0 0 0+1 59 129 127 0 0 0 0+128 59 65 61 0 0 0 0+128 59 65 127 0 0 0 0+128 59 86 61 0 0 0 0+128 59 86 127 0 0 0 0+128 59 126 61 0 0 0 0+128 59 126 127 0 0 0 0+128 59 132 61 0 0 0 0+128 59 132 127 0 0 0 0+128 59 146 61 0 0 0 0+128 59 146 127 0 0 0 0+128 59 146 61 0 0 0 0+128 59 146 127 0 0 0 0+128 59 125 61 0 0 0 0+128 59 125 127 0 0 0 0+128 59 129 61 0 0 0 0+128 59 129 127 0 0 0 0+142 59 65 61 0 0 0 0+142 59 65 127 0 0 0 0+142 59 86 61 0 0 0 0+142 59 86 127 0 0 0 0+142 59 126 61 0 0 0 0+142 59 126 127 0 0 0 0+142 59 132 61 0 0 0 0+142 59 132 127 0 0 0 0+142 59 146 61 0 0 0 0+142 59 146 127 0 0 0 0+142 59 146 61 0 0 0 0+142 59 146 127 0 0 0 0+142 59 125 61 0 0 0 0+142 59 125 127 0 0 0 0+142 59 129 61 0 0 0 0+142 59 129 127 0 0 0 0+146 59 65 61 0 0 0 0+146 59 65 127 0 0 0 0+146 59 86 61 0 0 0 0+146 59 86 127 0 0 0 0+146 59 126 61 0 0 0 0+146 59 126 127 0 0 0 0+146 59 132 61 0 0 0 0+146 59 132 127 0 0 0 0+146 59 146 61 0 0 0 0+146 59 146 127 0 0 0 0+146 59 146 61 0 0 0 0+146 59 146 127 0 0 0 0+146 59 125 61 0 0 0 0+146 59 125 127 0 0 0 0+146 59 129 61 0 0 0 0+146 59 129 127 0 0 0 0+146 59 65 61 0 0 0 0+146 59 65 127 0 0 0 0+146 59 86 61 0 0 0 0+146 59 86 127 0 0 0 0+146 59 126 61 0 0 0 0+146 59 126 127 0 0 0 0+146 59 132 61 0 0 0 0+146 59 132 127 0 0 0 0+146 59 146 61 0 0 0 0+146 59 146 127 0 0 0 0+146 59 146 61 0 0 0 0+146 59 146 127 0 0 0 0+146 59 125 61 0 0 0 0+146 59 125 127 0 0 0 0+146 59 129 61 0 0 0 0+146 59 129 127 0 0 0 0+125 58 65 61 0 0 0 0+125 58 65 127 0 0 0 0+125 58 86 61 0 0 0 0+125 58 86 127 0 0 0 0+125 58 126 61 0 0 0 0+125 58 126 127 0 0 0 0+125 58 132 61 0 0 0 0+125 58 132 127 0 0 0 0+125 58 146 61 0 0 0 0+125 58 146 127 0 0 0 0+125 58 146 61 0 0 0 0+125 58 146 127 0 0 0 0+129 58 65 61 0 0 0 0+129 58 65 127 0 0 0 0+129 58 86 61 0 0 0 0+129 58 86 127 0 0 0 0+129 58 126 61 0 0 0 0+129 58 126 127 0 0 0 0+129 58 132 61 0 0 0 0+129 58 132 127 0 0 0 0+129 58 146 61 0 0 0 0+129 58 146 127 0 0 0 0+129 58 146 61 0 0 0 0+129 58 146 127 0 0 0 0+60 104 65 61 0 0 0 0+60 104 65 127 0 0 0 0+60 104 86 61 0 0 0 0+60 104 86 127 0 0 0 0+60 104 126 61 0 0 0 0+60 104 126 127 0 0 0 0+60 104 132 61 0 0 0 0+60 104 132 127 0 0 0 0+60 104 146 61 0 0 0 0+60 104 146 127 0 0 0 0+60 104 146 61 0 0 0 0+60 104 146 127 0 0 0 0+60 104 125 61 0 0 0 0+60 104 125 127 0 0 0 0+60 104 129 61 0 0 0 0+60 104 129 127 0 0 0 0+1 103 65 61 0 0 0 0+1 103 65 127 0 0 0 0+1 103 86 61 0 0 0 0+1 103 86 127 0 0 0 0+1 103 126 61 0 0 0 0+1 103 126 127 0 0 0 0+1 103 132 61 0 0 0 0+1 103 132 127 0 0 0 0+1 103 146 61 0 0 0 0+1 103 146 127 0 0 0 0+1 103 146 61 0 0 0 0+1 103 146 127 0 0 0 0+1 103 125 61 0 0 0 0+1 103 125 127 0 0 0 0+1 103 129 61 0 0 0 0+1 103 129 127 0 0 0 0+128 103 65 61 0 0 0 0+128 103 65 127 0 0 0 0+128 103 86 61 0 0 0 0+128 103 86 127 0 0 0 0+128 103 126 61 0 0 0 0+128 103 126 127 0 0 0 0+128 103 132 61 0 0 0 0+128 103 132 127 0 0 0 0+128 103 146 61 0 0 0 0+128 103 146 127 0 0 0 0+128 103 146 61 0 0 0 0+128 103 146 127 0 0 0 0+128 103 125 61 0 0 0 0+128 103 125 127 0 0 0 0+128 103 129 61 0 0 0 0+128 103 129 127 0 0 0 0+142 103 65 61 0 0 0 0+142 103 65 127 0 0 0 0+142 103 86 61 0 0 0 0+142 103 86 127 0 0 0 0+142 103 126 61 0 0 0 0+142 103 126 127 0 0 0 0+142 103 132 61 0 0 0 0+142 103 132 127 0 0 0 0+142 103 146 61 0 0 0 0+142 103 146 127 0 0 0 0+142 103 146 61 0 0 0 0+142 103 146 127 0 0 0 0+142 103 125 61 0 0 0 0+142 103 125 127 0 0 0 0+142 103 129 61 0 0 0 0+142 103 129 127 0 0 0 0+146 103 65 61 0 0 0 0+146 103 65 127 0 0 0 0+146 103 86 61 0 0 0 0+146 103 86 127 0 0 0 0+146 103 126 61 0 0 0 0+146 103 126 127 0 0 0 0+146 103 132 61 0 0 0 0+146 103 132 127 0 0 0 0+146 103 146 61 0 0 0 0+146 103 146 127 0 0 0 0+146 103 146 61 0 0 0 0+146 103 146 127 0 0 0 0+146 103 125 61 0 0 0 0+146 103 125 127 0 0 0 0+146 103 129 61 0 0 0 0+146 103 129 127 0 0 0 0+146 103 65 61 0 0 0 0+146 103 65 127 0 0 0 0+146 103 86 61 0 0 0 0+146 103 86 127 0 0 0 0+146 103 126 61 0 0 0 0+146 103 126 127 0 0 0 0+146 103 132 61 0 0 0 0+146 103 132 127 0 0 0 0+146 103 146 61 0 0 0 0+146 103 146 127 0 0 0 0+146 103 146 61 0 0 0 0+146 103 146 127 0 0 0 0+146 103 125 61 0 0 0 0+146 103 125 127 0 0 0 0+146 103 129 61 0 0 0 0+146 103 129 127 0 0 0 0+125 104 65 61 0 0 0 0+125 104 65 127 0 0 0 0+125 104 86 61 0 0 0 0+125 104 86 127 0 0 0 0+125 104 126 61 0 0 0 0+125 104 126 127 0 0 0 0+125 104 132 61 0 0 0 0+125 104 132 127 0 0 0 0+125 104 146 61 0 0 0 0+125 104 146 127 0 0 0 0+125 104 146 61 0 0 0 0+125 104 146 127 0 0 0 0+129 104 65 61 0 0 0 0+129 104 65 127 0 0 0 0+129 104 86 61 0 0 0 0+129 104 86 127 0 0 0 0+129 104 126 61 0 0 0 0+129 104 126 127 0 0 0 0+129 104 132 61 0 0 0 0+129 104 132 127 0 0 0 0+129 104 146 61 0 0 0 0+129 104 146 127 0 0 0 0+129 104 146 61 0 0 0 0+129 104 146 127 0 0 0 0+60 18 144 65 61 0 0 0+60 18 144 65 127 0 0 0+60 18 144 86 61 0 0 0+60 18 144 86 127 0 0 0+60 18 144 126 61 0 0 0+60 18 144 126 127 0 0 0+60 18 144 132 61 0 0 0+60 18 144 132 127 0 0 0+60 18 144 146 61 0 0 0+60 18 144 146 127 0 0 0+60 18 144 146 61 0 0 0+60 18 144 146 127 0 0 0+60 18 144 125 61 0 0 0+60 18 144 125 127 0 0 0+60 18 144 129 61 0 0 0+60 18 144 129 127 0 0 0+1 17 144 65 61 0 0 0+1 17 144 65 127 0 0 0+1 17 144 86 61 0 0 0+1 17 144 86 127 0 0 0+1 17 144 126 61 0 0 0+1 17 144 126 127 0 0 0+1 17 144 132 61 0 0 0+1 17 144 132 127 0 0 0+1 17 144 146 61 0 0 0+1 17 144 146 127 0 0 0+1 17 144 146 61 0 0 0+1 17 144 146 127 0 0 0+1 17 144 125 61 0 0 0+1 17 144 125 127 0 0 0+1 17 144 129 61 0 0 0+1 17 144 129 127 0 0 0+128 17 144 65 61 0 0 0+128 17 144 65 127 0 0 0+128 17 144 86 61 0 0 0+128 17 144 86 127 0 0 0+128 17 144 126 61 0 0 0+128 17 144 126 127 0 0 0+128 17 144 132 61 0 0 0+128 17 144 132 127 0 0 0+128 17 144 146 61 0 0 0+128 17 144 146 127 0 0 0+128 17 144 146 61 0 0 0+128 17 144 146 127 0 0 0+128 17 144 125 61 0 0 0+128 17 144 125 127 0 0 0+128 17 144 129 61 0 0 0+128 17 144 129 127 0 0 0+142 17 144 65 61 0 0 0+142 17 144 65 127 0 0 0+142 17 144 86 61 0 0 0+142 17 144 86 127 0 0 0+142 17 144 126 61 0 0 0+142 17 144 126 127 0 0 0+142 17 144 132 61 0 0 0+142 17 144 132 127 0 0 0+142 17 144 146 61 0 0 0+142 17 144 146 127 0 0 0+142 17 144 146 61 0 0 0+142 17 144 146 127 0 0 0+142 17 144 125 61 0 0 0+142 17 144 125 127 0 0 0+142 17 144 129 61 0 0 0+142 17 144 129 127 0 0 0+146 17 144 65 61 0 0 0+146 17 144 65 127 0 0 0+146 17 144 86 61 0 0 0+146 17 144 86 127 0 0 0+146 17 144 126 61 0 0 0+146 17 144 126 127 0 0 0+146 17 144 132 61 0 0 0+146 17 144 132 127 0 0 0+146 17 144 146 61 0 0 0+146 17 144 146 127 0 0 0+146 17 144 146 61 0 0 0+146 17 144 146 127 0 0 0+146 17 144 125 61 0 0 0+146 17 144 125 127 0 0 0+146 17 144 129 61 0 0 0+146 17 144 129 127 0 0 0+146 17 144 65 61 0 0 0+146 17 144 65 127 0 0 0+146 17 144 86 61 0 0 0+146 17 144 86 127 0 0 0+146 17 144 126 61 0 0 0+146 17 144 126 127 0 0 0+146 17 144 132 61 0 0 0+146 17 144 132 127 0 0 0+146 17 144 146 61 0 0 0+146 17 144 146 127 0 0 0+146 17 144 146 61 0 0 0+146 17 144 146 127 0 0 0+146 17 144 125 61 0 0 0+146 17 144 125 127 0 0 0+146 17 144 129 61 0 0 0+146 17 144 129 127 0 0 0+125 18 144 65 61 0 0 0+125 18 144 65 127 0 0 0+125 18 144 86 61 0 0 0+125 18 144 86 127 0 0 0+125 18 144 126 61 0 0 0+125 18 144 126 127 0 0 0+125 18 144 132 61 0 0 0+125 18 144 132 127 0 0 0+125 18 144 146 61 0 0 0+125 18 144 146 127 0 0 0+125 18 144 146 61 0 0 0+125 18 144 146 127 0 0 0+129 18 144 65 61 0 0 0+129 18 144 65 127 0 0 0+129 18 144 86 61 0 0 0+129 18 144 86 127 0 0 0+129 18 144 126 61 0 0 0+129 18 144 126 127 0 0 0+129 18 144 132 61 0 0 0+129 18 144 132 127 0 0 0+129 18 144 146 61 0 0 0+129 18 144 146 127 0 0 0+129 18 144 146 61 0 0 0+129 18 144 146 127 0 0 0+60 31 65 61 0 0 0 0+60 31 65 127 0 0 0 0+60 31 86 61 0 0 0 0+60 31 86 127 0 0 0 0+60 31 126 61 0 0 0 0+60 31 126 127 0 0 0 0+60 31 132 61 0 0 0 0+60 31 132 127 0 0 0 0+60 31 146 61 0 0 0 0+60 31 146 127 0 0 0 0+60 31 146 61 0 0 0 0+60 31 146 127 0 0 0 0+60 31 125 61 0 0 0 0+60 31 125 127 0 0 0 0+60 31 129 61 0 0 0 0+60 31 129 127 0 0 0 0+1 30 65 61 0 0 0 0+1 30 65 127 0 0 0 0+1 30 86 61 0 0 0 0+1 30 86 127 0 0 0 0+1 30 126 61 0 0 0 0+1 30 126 127 0 0 0 0+1 30 132 61 0 0 0 0+1 30 132 127 0 0 0 0+1 30 146 61 0 0 0 0+1 30 146 127 0 0 0 0+1 30 146 61 0 0 0 0+1 30 146 127 0 0 0 0+1 30 125 61 0 0 0 0+1 30 125 127 0 0 0 0+1 30 129 61 0 0 0 0+1 30 129 127 0 0 0 0+128 30 65 61 0 0 0 0+128 30 65 127 0 0 0 0+128 30 86 61 0 0 0 0+128 30 86 127 0 0 0 0+128 30 126 61 0 0 0 0+128 30 126 127 0 0 0 0+128 30 132 61 0 0 0 0+128 30 132 127 0 0 0 0+128 30 146 61 0 0 0 0+128 30 146 127 0 0 0 0+128 30 146 61 0 0 0 0+128 30 146 127 0 0 0 0+128 30 125 61 0 0 0 0+128 30 125 127 0 0 0 0+128 30 129 61 0 0 0 0+128 30 129 127 0 0 0 0+142 30 65 61 0 0 0 0+142 30 65 127 0 0 0 0+142 30 86 61 0 0 0 0+142 30 86 127 0 0 0 0+142 30 126 61 0 0 0 0+142 30 126 127 0 0 0 0+142 30 132 61 0 0 0 0+142 30 132 127 0 0 0 0+142 30 146 61 0 0 0 0+142 30 146 127 0 0 0 0+142 30 146 61 0 0 0 0+142 30 146 127 0 0 0 0+142 30 125 61 0 0 0 0+142 30 125 127 0 0 0 0+142 30 129 61 0 0 0 0+142 30 129 127 0 0 0 0+146 30 65 61 0 0 0 0+146 30 65 127 0 0 0 0+146 30 86 61 0 0 0 0+146 30 86 127 0 0 0 0+146 30 126 61 0 0 0 0+146 30 126 127 0 0 0 0+146 30 132 61 0 0 0 0+146 30 132 127 0 0 0 0+146 30 146 61 0 0 0 0+146 30 146 127 0 0 0 0+146 30 146 61 0 0 0 0+146 30 146 127 0 0 0 0+146 30 125 61 0 0 0 0+146 30 125 127 0 0 0 0+146 30 129 61 0 0 0 0+146 30 129 127 0 0 0 0+146 30 65 61 0 0 0 0+146 30 65 127 0 0 0 0+146 30 86 61 0 0 0 0+146 30 86 127 0 0 0 0+146 30 126 61 0 0 0 0+146 30 126 127 0 0 0 0+146 30 132 61 0 0 0 0+146 30 132 127 0 0 0 0+146 30 146 61 0 0 0 0+146 30 146 127 0 0 0 0+146 30 146 61 0 0 0 0+146 30 146 127 0 0 0 0+146 30 125 61 0 0 0 0+146 30 125 127 0 0 0 0+146 30 129 61 0 0 0 0+146 30 129 127 0 0 0 0+125 31 65 61 0 0 0 0+125 31 65 127 0 0 0 0+125 31 86 61 0 0 0 0+125 31 86 127 0 0 0 0+125 31 126 61 0 0 0 0+125 31 126 127 0 0 0 0+125 31 132 61 0 0 0 0+125 31 132 127 0 0 0 0+125 31 146 61 0 0 0 0+125 31 146 127 0 0 0 0+125 31 146 61 0 0 0 0+125 31 146 127 0 0 0 0+129 31 65 61 0 0 0 0+129 31 65 127 0 0 0 0+129 31 86 61 0 0 0 0+129 31 86 127 0 0 0 0+129 31 126 61 0 0 0 0+129 31 126 127 0 0 0 0+129 31 132 61 0 0 0 0+129 31 132 127 0 0 0 0+129 31 146 61 0 0 0 0+129 31 146 127 0 0 0 0+129 31 146 61 0 0 0 0+129 31 146 127 0 0 0 0+60 92 65 61 0 0 0 0+60 92 65 127 0 0 0 0+60 92 86 61 0 0 0 0+60 92 86 127 0 0 0 0+60 92 126 61 0 0 0 0+60 92 126 127 0 0 0 0+60 92 132 61 0 0 0 0+60 92 132 127 0 0 0 0+60 92 146 61 0 0 0 0+60 92 146 127 0 0 0 0+60 92 146 61 0 0 0 0+60 92 146 127 0 0 0 0+60 92 125 61 0 0 0 0+60 92 125 127 0 0 0 0+60 92 129 61 0 0 0 0+60 92 129 127 0 0 0 0+1 91 65 61 0 0 0 0+1 91 65 127 0 0 0 0+1 91 86 61 0 0 0 0+1 91 86 127 0 0 0 0+1 91 126 61 0 0 0 0+1 91 126 127 0 0 0 0+1 91 132 61 0 0 0 0+1 91 132 127 0 0 0 0+1 91 146 61 0 0 0 0+1 91 146 127 0 0 0 0+1 91 146 61 0 0 0 0+1 91 146 127 0 0 0 0+1 91 125 61 0 0 0 0+1 91 125 127 0 0 0 0+1 91 129 61 0 0 0 0+1 91 129 127 0 0 0 0+128 91 65 61 0 0 0 0+128 91 65 127 0 0 0 0+128 91 86 61 0 0 0 0+128 91 86 127 0 0 0 0+128 91 126 61 0 0 0 0+128 91 126 127 0 0 0 0+128 91 132 61 0 0 0 0+128 91 132 127 0 0 0 0+128 91 146 61 0 0 0 0+128 91 146 127 0 0 0 0+128 91 146 61 0 0 0 0+128 91 146 127 0 0 0 0+128 91 125 61 0 0 0 0+128 91 125 127 0 0 0 0+128 91 129 61 0 0 0 0+128 91 129 127 0 0 0 0+142 91 65 61 0 0 0 0+142 91 65 127 0 0 0 0+142 91 86 61 0 0 0 0+142 91 86 127 0 0 0 0+142 91 126 61 0 0 0 0+142 91 126 127 0 0 0 0+142 91 132 61 0 0 0 0+142 91 132 127 0 0 0 0+142 91 146 61 0 0 0 0+142 91 146 127 0 0 0 0+142 91 146 61 0 0 0 0+142 91 146 127 0 0 0 0+142 91 125 61 0 0 0 0+142 91 125 127 0 0 0 0+142 91 129 61 0 0 0 0+142 91 129 127 0 0 0 0+146 91 65 61 0 0 0 0+146 91 65 127 0 0 0 0+146 91 86 61 0 0 0 0+146 91 86 127 0 0 0 0+146 91 126 61 0 0 0 0+146 91 126 127 0 0 0 0+146 91 132 61 0 0 0 0+146 91 132 127 0 0 0 0+146 91 146 61 0 0 0 0+146 91 146 127 0 0 0 0+146 91 146 61 0 0 0 0+146 91 146 127 0 0 0 0+146 91 125 61 0 0 0 0+146 91 125 127 0 0 0 0+146 91 129 61 0 0 0 0+146 91 129 127 0 0 0 0+146 91 65 61 0 0 0 0+146 91 65 127 0 0 0 0+146 91 86 61 0 0 0 0+146 91 86 127 0 0 0 0+146 91 126 61 0 0 0 0+146 91 126 127 0 0 0 0+146 91 132 61 0 0 0 0+146 91 132 127 0 0 0 0+146 91 146 61 0 0 0 0+146 91 146 127 0 0 0 0+146 91 146 61 0 0 0 0+146 91 146 127 0 0 0 0+146 91 125 61 0 0 0 0+146 91 125 127 0 0 0 0+146 91 129 61 0 0 0 0+146 91 129 127 0 0 0 0+125 92 65 61 0 0 0 0+125 92 65 127 0 0 0 0+125 92 86 61 0 0 0 0+125 92 86 127 0 0 0 0+125 92 126 61 0 0 0 0+125 92 126 127 0 0 0 0+125 92 132 61 0 0 0 0+125 92 132 127 0 0 0 0+125 92 146 61 0 0 0 0+125 92 146 127 0 0 0 0+125 92 146 61 0 0 0 0+125 92 146 127 0 0 0 0+129 92 65 61 0 0 0 0+129 92 65 127 0 0 0 0+129 92 86 61 0 0 0 0+129 92 86 127 0 0 0 0+129 92 126 61 0 0 0 0+129 92 126 127 0 0 0 0+129 92 132 61 0 0 0 0+129 92 132 127 0 0 0 0+129 92 146 61 0 0 0 0+129 92 146 127 0 0 0 0+129 92 146 61 0 0 0 0+129 92 146 127 0 0 0 0+60 97 65 61 0 0 0 0+60 97 65 127 0 0 0 0+60 97 86 61 0 0 0 0+60 97 86 127 0 0 0 0+60 97 126 61 0 0 0 0+60 97 126 127 0 0 0 0+60 97 132 61 0 0 0 0+60 97 132 127 0 0 0 0+60 97 146 61 0 0 0 0+60 97 146 127 0 0 0 0+60 97 146 61 0 0 0 0+60 97 146 127 0 0 0 0+60 97 125 61 0 0 0 0+60 97 125 127 0 0 0 0+60 97 129 61 0 0 0 0+60 97 129 127 0 0 0 0+1 96 65 61 0 0 0 0+1 96 65 127 0 0 0 0+1 96 86 61 0 0 0 0+1 96 86 127 0 0 0 0+1 96 126 61 0 0 0 0+1 96 126 127 0 0 0 0+1 96 132 61 0 0 0 0+1 96 132 127 0 0 0 0+1 96 146 61 0 0 0 0+1 96 146 127 0 0 0 0+1 96 146 61 0 0 0 0+1 96 146 127 0 0 0 0+1 96 125 61 0 0 0 0+1 96 125 127 0 0 0 0+1 96 129 61 0 0 0 0+1 96 129 127 0 0 0 0+128 96 65 61 0 0 0 0+128 96 65 127 0 0 0 0+128 96 86 61 0 0 0 0+128 96 86 127 0 0 0 0+128 96 126 61 0 0 0 0+128 96 126 127 0 0 0 0+128 96 132 61 0 0 0 0+128 96 132 127 0 0 0 0+128 96 146 61 0 0 0 0+128 96 146 127 0 0 0 0+128 96 146 61 0 0 0 0+128 96 146 127 0 0 0 0+128 96 125 61 0 0 0 0+128 96 125 127 0 0 0 0+128 96 129 61 0 0 0 0+128 96 129 127 0 0 0 0+142 96 65 61 0 0 0 0+142 96 65 127 0 0 0 0+142 96 86 61 0 0 0 0+142 96 86 127 0 0 0 0+142 96 126 61 0 0 0 0+142 96 126 127 0 0 0 0+142 96 132 61 0 0 0 0+142 96 132 127 0 0 0 0+142 96 146 61 0 0 0 0+142 96 146 127 0 0 0 0+142 96 146 61 0 0 0 0+142 96 146 127 0 0 0 0+142 96 125 61 0 0 0 0+142 96 125 127 0 0 0 0+142 96 129 61 0 0 0 0+142 96 129 127 0 0 0 0+146 96 65 61 0 0 0 0+146 96 65 127 0 0 0 0+146 96 86 61 0 0 0 0+146 96 86 127 0 0 0 0+146 96 126 61 0 0 0 0+146 96 126 127 0 0 0 0+146 96 132 61 0 0 0 0+146 96 132 127 0 0 0 0+146 96 146 61 0 0 0 0+146 96 146 127 0 0 0 0+146 96 146 61 0 0 0 0+146 96 146 127 0 0 0 0+146 96 125 61 0 0 0 0+146 96 125 127 0 0 0 0+146 96 129 61 0 0 0 0+146 96 129 127 0 0 0 0+146 96 65 61 0 0 0 0+146 96 65 127 0 0 0 0+146 96 86 61 0 0 0 0+146 96 86 127 0 0 0 0+146 96 126 61 0 0 0 0+146 96 126 127 0 0 0 0+146 96 132 61 0 0 0 0+146 96 132 127 0 0 0 0+146 96 146 61 0 0 0 0+146 96 146 127 0 0 0 0+146 96 146 61 0 0 0 0+146 96 146 127 0 0 0 0+146 96 125 61 0 0 0 0+146 96 125 127 0 0 0 0+146 96 129 61 0 0 0 0+146 96 129 127 0 0 0 0+125 97 65 61 0 0 0 0+125 97 65 127 0 0 0 0+125 97 86 61 0 0 0 0+125 97 86 127 0 0 0 0+125 97 126 61 0 0 0 0+125 97 126 127 0 0 0 0+125 97 132 61 0 0 0 0+125 97 132 127 0 0 0 0+125 97 146 61 0 0 0 0+125 97 146 127 0 0 0 0+125 97 146 61 0 0 0 0+125 97 146 127 0 0 0 0+129 97 65 61 0 0 0 0+129 97 65 127 0 0 0 0+129 97 86 61 0 0 0 0+129 97 86 127 0 0 0 0+129 97 126 61 0 0 0 0+129 97 126 127 0 0 0 0+129 97 132 61 0 0 0 0+129 97 132 127 0 0 0 0+129 97 146 61 0 0 0 0+129 97 146 127 0 0 0 0+129 97 146 61 0 0 0 0+129 97 146 127 0 0 0 0+60 76 65 0 0 0 0 0+1 3 65 0 0 0 0 0+128 5 65 0 0 0 0 0+142 5 65 0 0 0 0 0+146 5 65 0 0 0 0 0+146 5 65 0 0 0 0 0+125 76 65 0 0 0 0 0+129 76 65 0 0 0 0 0+60 76 86 0 0 0 0 0+1 3 86 0 0 0 0 0+128 5 86 0 0 0 0 0+142 5 86 0 0 0 0 0+146 5 86 0 0 0 0 0+146 5 86 0 0 0 0 0+125 76 86 0 0 0 0 0+129 76 86 0 0 0 0 0+60 76 126 0 0 0 0 0+1 3 126 0 0 0 0 0+128 5 126 0 0 0 0 0+142 5 126 0 0 0 0 0+146 5 126 0 0 0 0 0+146 5 126 0 0 0 0 0+125 76 126 0 0 0 0 0+129 76 126 0 0 0 0 0+60 76 132 0 0 0 0 0+1 3 132 0 0 0 0 0+128 5 132 0 0 0 0 0+142 5 132 0 0 0 0 0+146 5 132 0 0 0 0 0+146 5 132 0 0 0 0 0+125 76 132 0 0 0 0 0+129 76 132 0 0 0 0 0+60 76 146 0 0 0 0 0+1 3 146 0 0 0 0 0+128 5 146 0 0 0 0 0+142 5 146 0 0 0 0 0+146 5 146 0 0 0 0 0+146 5 146 0 0 0 0 0+125 76 146 0 0 0 0 0+129 76 146 0 0 0 0 0+60 76 146 0 0 0 0 0+1 3 146 0 0 0 0 0+128 5 146 0 0 0 0 0+142 5 146 0 0 0 0 0+146 5 146 0 0 0 0 0+146 5 146 0 0 0 0 0+125 76 146 0 0 0 0 0+129 76 146 0 0 0 0 0+60 76 125 0 0 0 0 0+1 3 125 0 0 0 0 0+128 5 125 0 0 0 0 0+142 5 125 0 0 0 0 0+146 5 125 0 0 0 0 0+146 5 125 0 0 0 0 0+60 76 129 0 0 0 0 0+1 3 129 0 0 0 0 0+128 5 129 0 0 0 0 0+142 5 129 0 0 0 0 0+146 5 129 0 0 0 0 0+146 5 129 0 0 0 0 0+60 15 0 0 0 0 0 0+1 14 0 0 0 0 0 0+128 14 0 0 0 0 0 0+142 14 0 0 0 0 0 0+146 14 0 0 0 0 0 0+146 14 0 0 0 0 0 0+60 115 0 0 0 0 0 0+1 114 0 0 0 0 0 0+128 114 0 0 0 0 0 0+142 114 0 0 0 0 0 0+146 114 0 0 0 0 0 0+146 114 0 0 0 0 0 0+60 140 0 0 0 0 0 0+1 139 0 0 0 0 0 0+128 139 0 0 0 0 0 0+142 139 0 0 0 0 0 0+146 139 0 0 0 0 0 0+146 139 0 0 0 0 0 0+60 20 0 0 0 0 0 0+1 19 0 0 0 0 0 0+128 19 0 0 0 0 0 0+142 19 0 0 0 0 0 0+146 19 0 0 0 0 0 0+146 19 0 0 0 0 0 0+60 74 0 0 0 0 0 0+1 73 0 0 0 0 0 0+128 73 0 0 0 0 0 0+142 73 0 0 0 0 0 0+146 73 0 0 0 0 0 0+146 73 0 0 0 0 0 0+60 29 65 0 0 0 0 0+60 29 86 0 0 0 0 0+60 29 126 0 0 0 0 0+60 29 132 0 0 0 0 0+60 29 146 0 0 0 0 0+60 29 146 0 0 0 0 0+60 29 125 0 0 0 0 0+60 29 129 0 0 0 0 0+1 28 65 0 0 0 0 0+1 28 86 0 0 0 0 0+1 28 126 0 0 0 0 0+1 28 132 0 0 0 0 0+1 28 146 0 0 0 0 0+1 28 146 0 0 0 0 0+1 28 125 0 0 0 0 0+1 28 129 0 0 0 0 0+128 28 65 0 0 0 0 0+128 28 86 0 0 0 0 0+128 28 126 0 0 0 0 0+128 28 132 0 0 0 0 0+128 28 146 0 0 0 0 0+128 28 146 0 0 0 0 0+128 28 125 0 0 0 0 0+128 28 129 0 0 0 0 0+142 28 65 0 0 0 0 0+142 28 86 0 0 0 0 0+142 28 126 0 0 0 0 0+142 28 132 0 0 0 0 0+142 28 146 0 0 0 0 0+142 28 146 0 0 0 0 0+142 28 125 0 0 0 0 0+142 28 129 0 0 0 0 0+146 28 65 0 0 0 0 0+146 28 86 0 0 0 0 0+146 28 126 0 0 0 0 0+146 28 132 0 0 0 0 0+146 28 146 0 0 0 0 0+146 28 146 0 0 0 0 0+146 28 125 0 0 0 0 0+146 28 129 0 0 0 0 0+146 28 65 0 0 0 0 0+146 28 86 0 0 0 0 0+146 28 126 0 0 0 0 0+146 28 132 0 0 0 0 0+146 28 146 0 0 0 0 0+146 28 146 0 0 0 0 0+146 28 125 0 0 0 0 0+146 28 129 0 0 0 0 0+125 29 65 0 0 0 0 0+125 29 86 0 0 0 0 0+125 29 126 0 0 0 0 0+125 29 132 0 0 0 0 0+125 29 146 0 0 0 0 0+125 29 146 0 0 0 0 0+129 29 65 0 0 0 0 0+129 29 86 0 0 0 0 0+129 29 126 0 0 0 0 0+129 29 132 0 0 0 0 0+129 29 146 0 0 0 0 0+129 29 146 0 0 0 0 0+60 38 65 0 0 0 0 0+60 38 86 0 0 0 0 0+60 38 126 0 0 0 0 0+60 38 132 0 0 0 0 0+60 38 146 0 0 0 0 0+60 38 146 0 0 0 0 0+60 38 125 0 0 0 0 0+60 38 129 0 0 0 0 0+1 37 65 0 0 0 0 0+1 37 86 0 0 0 0 0+1 37 126 0 0 0 0 0+1 37 132 0 0 0 0 0+1 37 146 0 0 0 0 0+1 37 146 0 0 0 0 0+1 37 125 0 0 0 0 0+1 37 129 0 0 0 0 0+128 37 65 0 0 0 0 0+128 37 86 0 0 0 0 0+128 37 126 0 0 0 0 0+128 37 132 0 0 0 0 0+128 37 146 0 0 0 0 0+128 37 146 0 0 0 0 0+128 37 125 0 0 0 0 0+128 37 129 0 0 0 0 0+142 37 65 0 0 0 0 0+142 37 86 0 0 0 0 0+142 37 126 0 0 0 0 0+142 37 132 0 0 0 0 0+142 37 146 0 0 0 0 0+142 37 146 0 0 0 0 0+142 37 125 0 0 0 0 0+142 37 129 0 0 0 0 0+146 37 65 0 0 0 0 0+146 37 86 0 0 0 0 0+146 37 126 0 0 0 0 0+146 37 132 0 0 0 0 0+146 37 146 0 0 0 0 0+146 37 146 0 0 0 0 0+146 37 125 0 0 0 0 0+146 37 129 0 0 0 0 0+146 37 65 0 0 0 0 0+146 37 86 0 0 0 0 0+146 37 126 0 0 0 0 0+146 37 132 0 0 0 0 0+146 37 146 0 0 0 0 0+146 37 146 0 0 0 0 0+146 37 125 0 0 0 0 0+146 37 129 0 0 0 0 0+125 38 65 0 0 0 0 0+125 38 86 0 0 0 0 0+125 38 126 0 0 0 0 0+125 38 132 0 0 0 0 0+125 38 146 0 0 0 0 0+125 38 146 0 0 0 0 0+129 38 65 0 0 0 0 0+129 38 86 0 0 0 0 0+129 38 126 0 0 0 0 0+129 38 132 0 0 0 0 0+129 38 146 0 0 0 0 0+129 38 146 0 0 0 0 0+60 58 65 0 0 0 0 0+60 58 86 0 0 0 0 0+60 58 126 0 0 0 0 0+60 58 132 0 0 0 0 0+60 58 146 0 0 0 0 0+60 58 146 0 0 0 0 0+60 58 125 0 0 0 0 0+60 58 129 0 0 0 0 0+1 59 65 0 0 0 0 0+1 59 86 0 0 0 0 0+1 59 126 0 0 0 0 0+1 59 132 0 0 0 0 0+1 59 146 0 0 0 0 0+1 59 146 0 0 0 0 0+1 59 125 0 0 0 0 0+1 59 129 0 0 0 0 0+128 59 65 0 0 0 0 0+128 59 86 0 0 0 0 0+128 59 126 0 0 0 0 0+128 59 132 0 0 0 0 0+128 59 146 0 0 0 0 0+128 59 146 0 0 0 0 0+128 59 125 0 0 0 0 0+128 59 129 0 0 0 0 0+142 59 65 0 0 0 0 0+142 59 86 0 0 0 0 0+142 59 126 0 0 0 0 0+142 59 132 0 0 0 0 0+142 59 146 0 0 0 0 0+142 59 146 0 0 0 0 0+142 59 125 0 0 0 0 0+142 59 129 0 0 0 0 0+146 59 65 0 0 0 0 0+146 59 86 0 0 0 0 0+146 59 126 0 0 0 0 0+146 59 132 0 0 0 0 0+146 59 146 0 0 0 0 0+146 59 146 0 0 0 0 0+146 59 125 0 0 0 0 0+146 59 129 0 0 0 0 0+146 59 65 0 0 0 0 0+146 59 86 0 0 0 0 0+146 59 126 0 0 0 0 0+146 59 132 0 0 0 0 0+146 59 146 0 0 0 0 0+146 59 146 0 0 0 0 0+146 59 125 0 0 0 0 0+146 59 129 0 0 0 0 0+125 58 65 0 0 0 0 0+125 58 86 0 0 0 0 0+125 58 126 0 0 0 0 0+125 58 132 0 0 0 0 0+125 58 146 0 0 0 0 0+125 58 146 0 0 0 0 0+129 58 65 0 0 0 0 0+129 58 86 0 0 0 0 0+129 58 126 0 0 0 0 0+129 58 132 0 0 0 0 0+129 58 146 0 0 0 0 0+129 58 146 0 0 0 0 0+60 104 65 0 0 0 0 0+60 104 86 0 0 0 0 0+60 104 126 0 0 0 0 0+60 104 132 0 0 0 0 0+60 104 146 0 0 0 0 0+60 104 146 0 0 0 0 0+60 104 125 0 0 0 0 0+60 104 129 0 0 0 0 0+1 103 65 0 0 0 0 0+1 103 86 0 0 0 0 0+1 103 126 0 0 0 0 0+1 103 132 0 0 0 0 0+1 103 146 0 0 0 0 0+1 103 146 0 0 0 0 0+1 103 125 0 0 0 0 0+1 103 129 0 0 0 0 0+128 103 65 0 0 0 0 0+128 103 86 0 0 0 0 0+128 103 126 0 0 0 0 0+128 103 132 0 0 0 0 0+128 103 146 0 0 0 0 0+128 103 146 0 0 0 0 0+128 103 125 0 0 0 0 0+128 103 129 0 0 0 0 0+142 103 65 0 0 0 0 0+142 103 86 0 0 0 0 0+142 103 126 0 0 0 0 0+142 103 132 0 0 0 0 0+142 103 146 0 0 0 0 0+142 103 146 0 0 0 0 0+142 103 125 0 0 0 0 0+142 103 129 0 0 0 0 0+146 103 65 0 0 0 0 0+146 103 86 0 0 0 0 0+146 103 126 0 0 0 0 0+146 103 132 0 0 0 0 0+146 103 146 0 0 0 0 0+146 103 146 0 0 0 0 0+146 103 125 0 0 0 0 0+146 103 129 0 0 0 0 0+146 103 65 0 0 0 0 0+146 103 86 0 0 0 0 0+146 103 126 0 0 0 0 0+146 103 132 0 0 0 0 0+146 103 146 0 0 0 0 0+146 103 146 0 0 0 0 0+146 103 125 0 0 0 0 0+146 103 129 0 0 0 0 0+125 104 65 0 0 0 0 0+125 104 86 0 0 0 0 0+125 104 126 0 0 0 0 0+125 104 132 0 0 0 0 0+125 104 146 0 0 0 0 0+125 104 146 0 0 0 0 0+129 104 65 0 0 0 0 0+129 104 86 0 0 0 0 0+129 104 126 0 0 0 0 0+129 104 132 0 0 0 0 0+129 104 146 0 0 0 0 0+129 104 146 0 0 0 0 0+60 18 144 65 0 0 0 0+60 18 144 86 0 0 0 0+60 18 144 126 0 0 0 0+60 18 144 132 0 0 0 0+60 18 144 146 0 0 0 0+60 18 144 146 0 0 0 0+60 18 144 125 0 0 0 0+60 18 144 129 0 0 0 0+1 17 144 65 0 0 0 0+1 17 144 86 0 0 0 0+1 17 144 126 0 0 0 0+1 17 144 132 0 0 0 0+1 17 144 146 0 0 0 0+1 17 144 146 0 0 0 0+1 17 144 125 0 0 0 0+1 17 144 129 0 0 0 0+128 17 144 65 0 0 0 0+128 17 144 86 0 0 0 0+128 17 144 126 0 0 0 0+128 17 144 132 0 0 0 0+128 17 144 146 0 0 0 0+128 17 144 146 0 0 0 0+128 17 144 125 0 0 0 0+128 17 144 129 0 0 0 0+142 17 144 65 0 0 0 0+142 17 144 86 0 0 0 0+142 17 144 126 0 0 0 0+142 17 144 132 0 0 0 0+142 17 144 146 0 0 0 0+142 17 144 146 0 0 0 0+142 17 144 125 0 0 0 0+142 17 144 129 0 0 0 0+146 17 144 65 0 0 0 0+146 17 144 86 0 0 0 0+146 17 144 126 0 0 0 0+146 17 144 132 0 0 0 0+146 17 144 146 0 0 0 0+146 17 144 146 0 0 0 0+146 17 144 125 0 0 0 0+146 17 144 129 0 0 0 0+146 17 144 65 0 0 0 0+146 17 144 86 0 0 0 0+146 17 144 126 0 0 0 0+146 17 144 132 0 0 0 0+146 17 144 146 0 0 0 0+146 17 144 146 0 0 0 0+146 17 144 125 0 0 0 0+146 17 144 129 0 0 0 0+125 18 144 65 0 0 0 0+125 18 144 86 0 0 0 0+125 18 144 126 0 0 0 0+125 18 144 132 0 0 0 0+125 18 144 146 0 0 0 0+125 18 144 146 0 0 0 0+129 18 144 65 0 0 0 0+129 18 144 86 0 0 0 0+129 18 144 126 0 0 0 0+129 18 144 132 0 0 0 0+129 18 144 146 0 0 0 0+129 18 144 146 0 0 0 0+60 31 65 0 0 0 0 0+60 31 86 0 0 0 0 0+60 31 126 0 0 0 0 0+60 31 132 0 0 0 0 0+60 31 146 0 0 0 0 0+60 31 146 0 0 0 0 0+60 31 125 0 0 0 0 0+60 31 129 0 0 0 0 0+1 30 65 0 0 0 0 0+1 30 86 0 0 0 0 0+1 30 126 0 0 0 0 0+1 30 132 0 0 0 0 0+1 30 146 0 0 0 0 0+1 30 146 0 0 0 0 0+1 30 125 0 0 0 0 0+1 30 129 0 0 0 0 0+128 30 65 0 0 0 0 0+128 30 86 0 0 0 0 0+128 30 126 0 0 0 0 0+128 30 132 0 0 0 0 0+128 30 146 0 0 0 0 0+128 30 146 0 0 0 0 0+128 30 125 0 0 0 0 0+128 30 129 0 0 0 0 0+142 30 65 0 0 0 0 0+142 30 86 0 0 0 0 0+142 30 126 0 0 0 0 0+142 30 132 0 0 0 0 0+142 30 146 0 0 0 0 0+142 30 146 0 0 0 0 0+142 30 125 0 0 0 0 0+142 30 129 0 0 0 0 0+146 30 65 0 0 0 0 0+146 30 86 0 0 0 0 0+146 30 126 0 0 0 0 0+146 30 132 0 0 0 0 0+146 30 146 0 0 0 0 0+146 30 146 0 0 0 0 0+146 30 125 0 0 0 0 0+146 30 129 0 0 0 0 0+146 30 65 0 0 0 0 0+146 30 86 0 0 0 0 0+146 30 126 0 0 0 0 0+146 30 132 0 0 0 0 0+146 30 146 0 0 0 0 0+146 30 146 0 0 0 0 0+146 30 125 0 0 0 0 0+146 30 129 0 0 0 0 0+125 31 65 0 0 0 0 0+125 31 86 0 0 0 0 0+125 31 126 0 0 0 0 0+125 31 132 0 0 0 0 0+125 31 146 0 0 0 0 0+125 31 146 0 0 0 0 0+129 31 65 0 0 0 0 0+129 31 86 0 0 0 0 0+129 31 126 0 0 0 0 0+129 31 132 0 0 0 0 0+129 31 146 0 0 0 0 0+129 31 146 0 0 0 0 0+60 92 65 0 0 0 0 0+60 92 86 0 0 0 0 0+60 92 126 0 0 0 0 0+60 92 132 0 0 0 0 0+60 92 146 0 0 0 0 0+60 92 146 0 0 0 0 0+60 92 125 0 0 0 0 0+60 92 129 0 0 0 0 0+1 91 65 0 0 0 0 0+1 91 86 0 0 0 0 0+1 91 126 0 0 0 0 0+1 91 132 0 0 0 0 0+1 91 146 0 0 0 0 0+1 91 146 0 0 0 0 0+1 91 125 0 0 0 0 0+1 91 129 0 0 0 0 0+128 91 65 0 0 0 0 0+128 91 86 0 0 0 0 0+128 91 126 0 0 0 0 0+128 91 132 0 0 0 0 0+128 91 146 0 0 0 0 0+128 91 146 0 0 0 0 0+128 91 125 0 0 0 0 0+128 91 129 0 0 0 0 0+142 91 65 0 0 0 0 0+142 91 86 0 0 0 0 0+142 91 126 0 0 0 0 0+142 91 132 0 0 0 0 0+142 91 146 0 0 0 0 0+142 91 146 0 0 0 0 0+142 91 125 0 0 0 0 0+142 91 129 0 0 0 0 0+146 91 65 0 0 0 0 0+146 91 86 0 0 0 0 0+146 91 126 0 0 0 0 0+146 91 132 0 0 0 0 0+146 91 146 0 0 0 0 0+146 91 146 0 0 0 0 0+146 91 125 0 0 0 0 0+146 91 129 0 0 0 0 0+146 91 65 0 0 0 0 0+146 91 86 0 0 0 0 0+146 91 126 0 0 0 0 0+146 91 132 0 0 0 0 0+146 91 146 0 0 0 0 0+146 91 146 0 0 0 0 0+146 91 125 0 0 0 0 0+146 91 129 0 0 0 0 0+125 92 65 0 0 0 0 0+125 92 86 0 0 0 0 0+125 92 126 0 0 0 0 0+125 92 132 0 0 0 0 0+125 92 146 0 0 0 0 0+125 92 146 0 0 0 0 0+129 92 65 0 0 0 0 0+129 92 86 0 0 0 0 0+129 92 126 0 0 0 0 0+129 92 132 0 0 0 0 0+129 92 146 0 0 0 0 0+129 92 146 0 0 0 0 0+60 97 65 0 0 0 0 0+60 97 86 0 0 0 0 0+60 97 126 0 0 0 0 0+60 97 132 0 0 0 0 0+60 97 146 0 0 0 0 0+60 97 146 0 0 0 0 0+60 97 125 0 0 0 0 0+60 97 129 0 0 0 0 0+1 96 65 0 0 0 0 0+1 96 86 0 0 0 0 0+1 96 126 0 0 0 0 0+1 96 132 0 0 0 0 0+1 96 146 0 0 0 0 0+1 96 146 0 0 0 0 0+1 96 125 0 0 0 0 0+1 96 129 0 0 0 0 0+128 96 65 0 0 0 0 0+128 96 86 0 0 0 0 0+128 96 126 0 0 0 0 0+128 96 132 0 0 0 0 0+128 96 146 0 0 0 0 0+128 96 146 0 0 0 0 0+128 96 125 0 0 0 0 0+128 96 129 0 0 0 0 0+142 96 65 0 0 0 0 0+142 96 86 0 0 0 0 0+142 96 126 0 0 0 0 0+142 96 132 0 0 0 0 0+142 96 146 0 0 0 0 0+142 96 146 0 0 0 0 0+142 96 125 0 0 0 0 0+142 96 129 0 0 0 0 0+146 96 65 0 0 0 0 0+146 96 86 0 0 0 0 0+146 96 126 0 0 0 0 0+146 96 132 0 0 0 0 0+146 96 146 0 0 0 0 0+146 96 146 0 0 0 0 0+146 96 125 0 0 0 0 0+146 96 129 0 0 0 0 0+146 96 65 0 0 0 0 0+146 96 86 0 0 0 0 0+146 96 126 0 0 0 0 0+146 96 132 0 0 0 0 0+146 96 146 0 0 0 0 0+146 96 146 0 0 0 0 0+146 96 125 0 0 0 0 0+146 96 129 0 0 0 0 0+125 97 65 0 0 0 0 0+125 97 86 0 0 0 0 0+125 97 126 0 0 0 0 0+125 97 132 0 0 0 0 0+125 97 146 0 0 0 0 0+125 97 146 0 0 0 0 0+129 97 65 0 0 0 0 0+129 97 86 0 0 0 0 0+129 97 126 0 0 0 0 0+129 97 132 0 0 0 0 0+129 97 146 0 0 0 0 0+129 97 146 0 0 0 0 0+60 29 9 0 0 0 0 0+60 29 141 0 0 0 0 0+60 29 2 0 0 0 0 0+60 29 43 0 0 0 0 0+60 29 89 0 0 0 0 0+60 29 112 0 0 0 0 0+1 28 9 0 0 0 0 0+1 28 141 0 0 0 0 0+1 28 2 0 0 0 0 0+1 28 43 0 0 0 0 0+1 28 89 0 0 0 0 0+1 28 112 0 0 0 0 0+128 28 9 0 0 0 0 0+128 28 141 0 0 0 0 0+128 28 2 0 0 0 0 0+128 28 43 0 0 0 0 0+128 28 89 0 0 0 0 0+128 28 112 0 0 0 0 0+142 28 9 0 0 0 0 0+142 28 141 0 0 0 0 0+142 28 2 0 0 0 0 0+142 28 43 0 0 0 0 0+142 28 89 0 0 0 0 0+142 28 112 0 0 0 0 0+146 28 9 0 0 0 0 0+146 28 141 0 0 0 0 0+146 28 2 0 0 0 0 0+146 28 43 0 0 0 0 0+146 28 89 0 0 0 0 0+146 28 112 0 0 0 0 0+146 28 9 0 0 0 0 0+146 28 141 0 0 0 0 0+146 28 2 0 0 0 0 0+146 28 43 0 0 0 0 0+146 28 89 0 0 0 0 0+146 28 112 0 0 0 0 0+125 29 9 0 0 0 0 0+125 29 141 0 0 0 0 0+125 29 2 0 0 0 0 0+125 29 43 0 0 0 0 0+125 29 89 0 0 0 0 0+125 29 112 0 0 0 0 0+129 29 9 0 0 0 0 0+129 29 141 0 0 0 0 0+129 29 2 0 0 0 0 0+129 29 43 0 0 0 0 0+129 29 89 0 0 0 0 0+129 29 112 0 0 0 0 0+60 38 9 0 0 0 0 0+60 38 141 0 0 0 0 0+60 38 2 0 0 0 0 0+60 38 43 0 0 0 0 0+60 38 89 0 0 0 0 0+60 38 112 0 0 0 0 0+1 37 9 0 0 0 0 0+1 37 141 0 0 0 0 0+1 37 2 0 0 0 0 0+1 37 43 0 0 0 0 0+1 37 89 0 0 0 0 0+1 37 112 0 0 0 0 0+128 37 9 0 0 0 0 0+128 37 141 0 0 0 0 0+128 37 2 0 0 0 0 0+128 37 43 0 0 0 0 0+128 37 89 0 0 0 0 0+128 37 112 0 0 0 0 0+142 37 9 0 0 0 0 0+142 37 141 0 0 0 0 0+142 37 2 0 0 0 0 0+142 37 43 0 0 0 0 0+142 37 89 0 0 0 0 0+142 37 112 0 0 0 0 0+146 37 9 0 0 0 0 0+146 37 141 0 0 0 0 0+146 37 2 0 0 0 0 0+146 37 43 0 0 0 0 0+146 37 89 0 0 0 0 0+146 37 112 0 0 0 0 0+146 37 9 0 0 0 0 0+146 37 141 0 0 0 0 0+146 37 2 0 0 0 0 0+146 37 43 0 0 0 0 0+146 37 89 0 0 0 0 0+146 37 112 0 0 0 0 0+125 38 9 0 0 0 0 0+125 38 141 0 0 0 0 0+125 38 2 0 0 0 0 0+125 38 43 0 0 0 0 0+125 38 89 0 0 0 0 0+125 38 112 0 0 0 0 0+129 38 9 0 0 0 0 0+129 38 141 0 0 0 0 0+129 38 2 0 0 0 0 0+129 38 43 0 0 0 0 0+129 38 89 0 0 0 0 0+129 38 112 0 0 0 0 0+60 58 9 0 0 0 0 0+60 58 141 0 0 0 0 0+60 58 2 0 0 0 0 0+60 58 43 0 0 0 0 0+60 58 89 0 0 0 0 0+60 58 112 0 0 0 0 0+1 59 9 0 0 0 0 0+1 59 141 0 0 0 0 0+1 59 2 0 0 0 0 0+1 59 43 0 0 0 0 0+1 59 89 0 0 0 0 0+1 59 112 0 0 0 0 0+128 59 9 0 0 0 0 0+128 59 141 0 0 0 0 0+128 59 2 0 0 0 0 0+128 59 43 0 0 0 0 0+128 59 89 0 0 0 0 0+128 59 112 0 0 0 0 0+142 59 9 0 0 0 0 0+142 59 141 0 0 0 0 0+142 59 2 0 0 0 0 0+142 59 43 0 0 0 0 0+142 59 89 0 0 0 0 0+142 59 112 0 0 0 0 0+146 59 9 0 0 0 0 0+146 59 141 0 0 0 0 0+146 59 2 0 0 0 0 0+146 59 43 0 0 0 0 0+146 59 89 0 0 0 0 0+146 59 112 0 0 0 0 0+146 59 9 0 0 0 0 0+146 59 141 0 0 0 0 0+146 59 2 0 0 0 0 0+146 59 43 0 0 0 0 0+146 59 89 0 0 0 0 0+146 59 112 0 0 0 0 0+125 58 9 0 0 0 0 0+125 58 141 0 0 0 0 0+125 58 2 0 0 0 0 0+125 58 43 0 0 0 0 0+125 58 89 0 0 0 0 0+125 58 112 0 0 0 0 0+129 58 9 0 0 0 0 0+129 58 141 0 0 0 0 0+129 58 2 0 0 0 0 0+129 58 43 0 0 0 0 0+129 58 89 0 0 0 0 0+129 58 112 0 0 0 0 0+60 104 9 0 0 0 0 0+60 104 141 0 0 0 0 0+60 104 2 0 0 0 0 0+60 104 43 0 0 0 0 0+60 104 89 0 0 0 0 0+60 104 112 0 0 0 0 0+1 103 9 0 0 0 0 0+1 103 141 0 0 0 0 0+1 103 2 0 0 0 0 0+1 103 43 0 0 0 0 0+1 103 89 0 0 0 0 0+1 103 112 0 0 0 0 0+128 103 9 0 0 0 0 0+128 103 141 0 0 0 0 0+128 103 2 0 0 0 0 0+128 103 43 0 0 0 0 0+128 103 89 0 0 0 0 0+128 103 112 0 0 0 0 0+142 103 9 0 0 0 0 0+142 103 141 0 0 0 0 0+142 103 2 0 0 0 0 0+142 103 43 0 0 0 0 0+142 103 89 0 0 0 0 0+142 103 112 0 0 0 0 0+146 103 9 0 0 0 0 0+146 103 141 0 0 0 0 0+146 103 2 0 0 0 0 0+146 103 43 0 0 0 0 0+146 103 89 0 0 0 0 0+146 103 112 0 0 0 0 0+146 103 9 0 0 0 0 0+146 103 141 0 0 0 0 0+146 103 2 0 0 0 0 0+146 103 43 0 0 0 0 0+146 103 89 0 0 0 0 0+146 103 112 0 0 0 0 0+125 104 9 0 0 0 0 0+125 104 141 0 0 0 0 0+125 104 2 0 0 0 0 0+125 104 43 0 0 0 0 0+125 104 89 0 0 0 0 0+125 104 112 0 0 0 0 0+129 104 9 0 0 0 0 0+129 104 141 0 0 0 0 0+129 104 2 0 0 0 0 0+129 104 43 0 0 0 0 0+129 104 89 0 0 0 0 0+129 104 112 0 0 0 0 0+60 18 144 9 0 0 0 0+60 18 144 141 0 0 0 0+60 18 144 2 0 0 0 0+60 18 144 43 0 0 0 0+60 18 144 89 0 0 0 0+60 18 144 112 0 0 0 0+1 17 144 9 0 0 0 0+1 17 144 141 0 0 0 0+1 17 144 2 0 0 0 0+1 17 144 43 0 0 0 0+1 17 144 89 0 0 0 0+1 17 144 112 0 0 0 0+128 17 144 9 0 0 0 0+128 17 144 141 0 0 0 0+128 17 144 2 0 0 0 0+128 17 144 43 0 0 0 0+128 17 144 89 0 0 0 0+128 17 144 112 0 0 0 0+142 17 144 9 0 0 0 0+142 17 144 141 0 0 0 0+142 17 144 2 0 0 0 0+142 17 144 43 0 0 0 0+142 17 144 89 0 0 0 0+142 17 144 112 0 0 0 0+146 17 144 9 0 0 0 0+146 17 144 141 0 0 0 0+146 17 144 2 0 0 0 0+146 17 144 43 0 0 0 0+146 17 144 89 0 0 0 0+146 17 144 112 0 0 0 0+146 17 144 9 0 0 0 0+146 17 144 141 0 0 0 0+146 17 144 2 0 0 0 0+146 17 144 43 0 0 0 0+146 17 144 89 0 0 0 0+146 17 144 112 0 0 0 0+125 18 144 9 0 0 0 0+125 18 144 141 0 0 0 0+125 18 144 2 0 0 0 0+125 18 144 43 0 0 0 0+125 18 144 89 0 0 0 0+125 18 144 112 0 0 0 0+129 18 144 9 0 0 0 0+129 18 144 141 0 0 0 0+129 18 144 2 0 0 0 0+129 18 144 43 0 0 0 0+129 18 144 89 0 0 0 0+129 18 144 112 0 0 0 0+60 31 9 0 0 0 0 0+60 31 141 0 0 0 0 0+60 31 2 0 0 0 0 0+60 31 43 0 0 0 0 0+60 31 89 0 0 0 0 0+60 31 112 0 0 0 0 0+1 30 9 0 0 0 0 0+1 30 141 0 0 0 0 0+1 30 2 0 0 0 0 0+1 30 43 0 0 0 0 0+1 30 89 0 0 0 0 0+1 30 112 0 0 0 0 0+128 30 9 0 0 0 0 0+128 30 141 0 0 0 0 0+128 30 2 0 0 0 0 0+128 30 43 0 0 0 0 0+128 30 89 0 0 0 0 0+128 30 112 0 0 0 0 0+142 30 9 0 0 0 0 0+142 30 141 0 0 0 0 0+142 30 2 0 0 0 0 0+142 30 43 0 0 0 0 0+142 30 89 0 0 0 0 0+142 30 112 0 0 0 0 0+146 30 9 0 0 0 0 0+146 30 141 0 0 0 0 0+146 30 2 0 0 0 0 0+146 30 43 0 0 0 0 0+146 30 89 0 0 0 0 0+146 30 112 0 0 0 0 0+146 30 9 0 0 0 0 0+146 30 141 0 0 0 0 0+146 30 2 0 0 0 0 0+146 30 43 0 0 0 0 0+146 30 89 0 0 0 0 0+146 30 112 0 0 0 0 0+125 31 9 0 0 0 0 0+125 31 141 0 0 0 0 0+125 31 2 0 0 0 0 0+125 31 43 0 0 0 0 0+125 31 89 0 0 0 0 0+125 31 112 0 0 0 0 0+129 31 9 0 0 0 0 0+129 31 141 0 0 0 0 0+129 31 2 0 0 0 0 0+129 31 43 0 0 0 0 0+129 31 89 0 0 0 0 0+129 31 112 0 0 0 0 0+60 92 9 0 0 0 0 0+60 92 141 0 0 0 0 0+60 92 2 0 0 0 0 0+60 92 43 0 0 0 0 0+60 92 89 0 0 0 0 0+60 92 112 0 0 0 0 0+1 91 9 0 0 0 0 0+1 91 141 0 0 0 0 0+1 91 2 0 0 0 0 0+1 91 43 0 0 0 0 0+1 91 89 0 0 0 0 0+1 91 112 0 0 0 0 0+128 91 9 0 0 0 0 0+128 91 141 0 0 0 0 0+128 91 2 0 0 0 0 0+128 91 43 0 0 0 0 0+128 91 89 0 0 0 0 0+128 91 112 0 0 0 0 0+142 91 9 0 0 0 0 0+142 91 141 0 0 0 0 0+142 91 2 0 0 0 0 0+142 91 43 0 0 0 0 0+142 91 89 0 0 0 0 0+142 91 112 0 0 0 0 0+146 91 9 0 0 0 0 0+146 91 141 0 0 0 0 0+146 91 2 0 0 0 0 0+146 91 43 0 0 0 0 0+146 91 89 0 0 0 0 0+146 91 112 0 0 0 0 0+146 91 9 0 0 0 0 0+146 91 141 0 0 0 0 0+146 91 2 0 0 0 0 0+146 91 43 0 0 0 0 0+146 91 89 0 0 0 0 0+146 91 112 0 0 0 0 0+125 92 9 0 0 0 0 0+125 92 141 0 0 0 0 0+125 92 2 0 0 0 0 0+125 92 43 0 0 0 0 0+125 92 89 0 0 0 0 0+125 92 112 0 0 0 0 0+129 92 9 0 0 0 0 0+129 92 141 0 0 0 0 0+129 92 2 0 0 0 0 0+129 92 43 0 0 0 0 0+129 92 89 0 0 0 0 0+129 92 112 0 0 0 0 0+60 97 9 0 0 0 0 0+60 97 141 0 0 0 0 0+60 97 2 0 0 0 0 0+60 97 43 0 0 0 0 0+60 97 89 0 0 0 0 0+60 97 112 0 0 0 0 0+1 96 9 0 0 0 0 0+1 96 141 0 0 0 0 0+1 96 2 0 0 0 0 0+1 96 43 0 0 0 0 0+1 96 89 0 0 0 0 0+1 96 112 0 0 0 0 0+128 96 9 0 0 0 0 0+128 96 141 0 0 0 0 0+128 96 2 0 0 0 0 0+128 96 43 0 0 0 0 0+128 96 89 0 0 0 0 0+128 96 112 0 0 0 0 0+142 96 9 0 0 0 0 0+142 96 141 0 0 0 0 0+142 96 2 0 0 0 0 0+142 96 43 0 0 0 0 0+142 96 89 0 0 0 0 0+142 96 112 0 0 0 0 0+146 96 9 0 0 0 0 0+146 96 141 0 0 0 0 0+146 96 2 0 0 0 0 0+146 96 43 0 0 0 0 0+146 96 89 0 0 0 0 0+146 96 112 0 0 0 0 0+146 96 9 0 0 0 0 0+146 96 141 0 0 0 0 0+146 96 2 0 0 0 0 0+146 96 43 0 0 0 0 0+146 96 89 0 0 0 0 0+146 96 112 0 0 0 0 0+125 97 9 0 0 0 0 0+125 97 141 0 0 0 0 0+125 97 2 0 0 0 0 0+125 97 43 0 0 0 0 0+125 97 89 0 0 0 0 0+125 97 112 0 0 0 0 0+129 97 9 0 0 0 0 0+129 97 141 0 0 0 0 0+129 97 2 0 0 0 0 0+129 97 43 0 0 0 0 0+129 97 89 0 0 0 0 0+129 97 112 0 0 0 0 0+60 46 65 131 65 0 0 0+60 46 65 131 86 0 0 0+60 46 65 131 126 0 0 0+60 46 65 131 132 0 0 0+60 46 65 131 146 0 0 0+60 46 65 131 146 0 0 0+60 46 65 131 125 0 0 0+60 46 65 131 129 0 0 0+60 46 86 131 65 0 0 0+60 46 86 131 86 0 0 0+60 46 86 131 126 0 0 0+60 46 86 131 132 0 0 0+60 46 86 131 146 0 0 0+60 46 86 131 146 0 0 0+60 46 86 131 125 0 0 0+60 46 86 131 129 0 0 0+60 46 126 131 65 0 0 0+60 46 126 131 86 0 0 0+60 46 126 131 126 0 0 0+60 46 126 131 132 0 0 0+60 46 126 131 146 0 0 0+60 46 126 131 146 0 0 0+60 46 126 131 125 0 0 0+60 46 126 131 129 0 0 0+60 46 132 131 65 0 0 0+60 46 132 131 86 0 0 0+60 46 132 131 126 0 0 0+60 46 132 131 132 0 0 0+60 46 132 131 146 0 0 0+60 46 132 131 146 0 0 0+60 46 132 131 125 0 0 0+60 46 132 131 129 0 0 0+60 46 146 131 65 0 0 0+60 46 146 131 86 0 0 0+60 46 146 131 126 0 0 0+60 46 146 131 132 0 0 0+60 46 146 131 146 0 0 0+60 46 146 131 146 0 0 0+60 46 146 131 125 0 0 0+60 46 146 131 129 0 0 0+60 46 146 131 65 0 0 0+60 46 146 131 86 0 0 0+60 46 146 131 126 0 0 0+60 46 146 131 132 0 0 0+60 46 146 131 146 0 0 0+60 46 146 131 146 0 0 0+60 46 146 131 125 0 0 0+60 46 146 131 129 0 0 0+60 46 125 131 65 0 0 0+60 46 125 131 86 0 0 0+60 46 125 131 126 0 0 0+60 46 125 131 132 0 0 0+60 46 125 131 146 0 0 0+60 46 125 131 146 0 0 0+60 46 125 131 125 0 0 0+60 46 125 131 129 0 0 0+60 46 129 131 65 0 0 0+60 46 129 131 86 0 0 0+60 46 129 131 126 0 0 0+60 46 129 131 132 0 0 0+60 46 129 131 146 0 0 0+60 46 129 131 146 0 0 0+60 46 129 131 125 0 0 0+60 46 129 131 129 0 0 0+1 45 65 131 65 0 0 0+1 45 65 131 86 0 0 0+1 45 65 131 126 0 0 0+1 45 65 131 132 0 0 0+1 45 65 131 146 0 0 0+1 45 65 131 146 0 0 0+1 45 65 131 125 0 0 0+1 45 65 131 129 0 0 0+1 45 86 131 65 0 0 0+1 45 86 131 86 0 0 0+1 45 86 131 126 0 0 0+1 45 86 131 132 0 0 0+1 45 86 131 146 0 0 0+1 45 86 131 146 0 0 0+1 45 86 131 125 0 0 0+1 45 86 131 129 0 0 0+1 45 126 131 65 0 0 0+1 45 126 131 86 0 0 0+1 45 126 131 126 0 0 0+1 45 126 131 132 0 0 0+1 45 126 131 146 0 0 0+1 45 126 131 146 0 0 0+1 45 126 131 125 0 0 0+1 45 126 131 129 0 0 0+1 45 132 131 65 0 0 0+1 45 132 131 86 0 0 0+1 45 132 131 126 0 0 0+1 45 132 131 132 0 0 0+1 45 132 131 146 0 0 0+1 45 132 131 146 0 0 0+1 45 132 131 125 0 0 0+1 45 132 131 129 0 0 0+1 45 146 131 65 0 0 0+1 45 146 131 86 0 0 0+1 45 146 131 126 0 0 0+1 45 146 131 132 0 0 0+1 45 146 131 146 0 0 0+1 45 146 131 146 0 0 0+1 45 146 131 125 0 0 0+1 45 146 131 129 0 0 0+1 45 146 131 65 0 0 0+1 45 146 131 86 0 0 0+1 45 146 131 126 0 0 0+1 45 146 131 132 0 0 0+1 45 146 131 146 0 0 0+1 45 146 131 146 0 0 0+1 45 146 131 125 0 0 0+1 45 146 131 129 0 0 0+1 45 125 131 65 0 0 0+1 45 125 131 86 0 0 0+1 45 125 131 126 0 0 0+1 45 125 131 132 0 0 0+1 45 125 131 146 0 0 0+1 45 125 131 146 0 0 0+1 45 125 131 125 0 0 0+1 45 125 131 129 0 0 0+1 45 129 131 65 0 0 0+1 45 129 131 86 0 0 0+1 45 129 131 126 0 0 0+1 45 129 131 132 0 0 0+1 45 129 131 146 0 0 0+1 45 129 131 146 0 0 0+1 45 129 131 125 0 0 0+1 45 129 131 129 0 0 0+128 45 65 131 65 0 0 0+128 45 65 131 86 0 0 0+128 45 65 131 126 0 0 0+128 45 65 131 132 0 0 0+128 45 65 131 146 0 0 0+128 45 65 131 146 0 0 0+128 45 65 131 125 0 0 0+128 45 65 131 129 0 0 0+128 45 86 131 65 0 0 0+128 45 86 131 86 0 0 0+128 45 86 131 126 0 0 0+128 45 86 131 132 0 0 0+128 45 86 131 146 0 0 0+128 45 86 131 146 0 0 0+128 45 86 131 125 0 0 0+128 45 86 131 129 0 0 0+128 45 126 131 65 0 0 0+128 45 126 131 86 0 0 0+128 45 126 131 126 0 0 0+128 45 126 131 132 0 0 0+128 45 126 131 146 0 0 0+128 45 126 131 146 0 0 0+128 45 126 131 125 0 0 0+128 45 126 131 129 0 0 0+128 45 132 131 65 0 0 0+128 45 132 131 86 0 0 0+128 45 132 131 126 0 0 0+128 45 132 131 132 0 0 0+128 45 132 131 146 0 0 0+128 45 132 131 146 0 0 0+128 45 132 131 125 0 0 0+128 45 132 131 129 0 0 0+128 45 146 131 65 0 0 0+128 45 146 131 86 0 0 0+128 45 146 131 126 0 0 0+128 45 146 131 132 0 0 0+128 45 146 131 146 0 0 0+128 45 146 131 146 0 0 0+128 45 146 131 125 0 0 0+128 45 146 131 129 0 0 0+128 45 146 131 65 0 0 0+128 45 146 131 86 0 0 0+128 45 146 131 126 0 0 0+128 45 146 131 132 0 0 0+128 45 146 131 146 0 0 0+128 45 146 131 146 0 0 0+128 45 146 131 125 0 0 0+128 45 146 131 129 0 0 0+128 45 125 131 65 0 0 0+128 45 125 131 86 0 0 0+128 45 125 131 126 0 0 0+128 45 125 131 132 0 0 0+128 45 125 131 146 0 0 0+128 45 125 131 146 0 0 0+128 45 125 131 125 0 0 0+128 45 125 131 129 0 0 0+128 45 129 131 65 0 0 0+128 45 129 131 86 0 0 0+128 45 129 131 126 0 0 0+128 45 129 131 132 0 0 0+128 45 129 131 146 0 0 0+128 45 129 131 146 0 0 0+128 45 129 131 125 0 0 0+128 45 129 131 129 0 0 0+142 45 65 131 65 0 0 0+142 45 65 131 86 0 0 0+142 45 65 131 126 0 0 0+142 45 65 131 132 0 0 0+142 45 65 131 146 0 0 0+142 45 65 131 146 0 0 0+142 45 65 131 125 0 0 0+142 45 65 131 129 0 0 0+142 45 86 131 65 0 0 0+142 45 86 131 86 0 0 0+142 45 86 131 126 0 0 0+142 45 86 131 132 0 0 0+142 45 86 131 146 0 0 0+142 45 86 131 146 0 0 0+142 45 86 131 125 0 0 0+142 45 86 131 129 0 0 0+142 45 126 131 65 0 0 0+142 45 126 131 86 0 0 0+142 45 126 131 126 0 0 0+142 45 126 131 132 0 0 0+142 45 126 131 146 0 0 0+142 45 126 131 146 0 0 0+142 45 126 131 125 0 0 0+142 45 126 131 129 0 0 0+142 45 132 131 65 0 0 0+142 45 132 131 86 0 0 0+142 45 132 131 126 0 0 0+142 45 132 131 132 0 0 0+142 45 132 131 146 0 0 0+142 45 132 131 146 0 0 0+142 45 132 131 125 0 0 0+142 45 132 131 129 0 0 0+142 45 146 131 65 0 0 0+142 45 146 131 86 0 0 0+142 45 146 131 126 0 0 0+142 45 146 131 132 0 0 0+142 45 146 131 146 0 0 0+142 45 146 131 146 0 0 0+142 45 146 131 125 0 0 0+142 45 146 131 129 0 0 0+142 45 146 131 65 0 0 0+142 45 146 131 86 0 0 0+142 45 146 131 126 0 0 0+142 45 146 131 132 0 0 0+142 45 146 131 146 0 0 0+142 45 146 131 146 0 0 0+142 45 146 131 125 0 0 0+142 45 146 131 129 0 0 0+142 45 125 131 65 0 0 0+142 45 125 131 86 0 0 0+142 45 125 131 126 0 0 0+142 45 125 131 132 0 0 0+142 45 125 131 146 0 0 0+142 45 125 131 146 0 0 0+142 45 125 131 125 0 0 0+142 45 125 131 129 0 0 0+142 45 129 131 65 0 0 0+142 45 129 131 86 0 0 0+142 45 129 131 126 0 0 0+142 45 129 131 132 0 0 0+142 45 129 131 146 0 0 0+142 45 129 131 146 0 0 0+142 45 129 131 125 0 0 0+142 45 129 131 129 0 0 0+146 45 65 131 65 0 0 0+146 45 65 131 86 0 0 0+146 45 65 131 126 0 0 0+146 45 65 131 132 0 0 0+146 45 65 131 146 0 0 0+146 45 65 131 146 0 0 0+146 45 65 131 125 0 0 0+146 45 65 131 129 0 0 0+146 45 86 131 65 0 0 0+146 45 86 131 86 0 0 0+146 45 86 131 126 0 0 0+146 45 86 131 132 0 0 0+146 45 86 131 146 0 0 0+146 45 86 131 146 0 0 0+146 45 86 131 125 0 0 0+146 45 86 131 129 0 0 0+146 45 126 131 65 0 0 0+146 45 126 131 86 0 0 0+146 45 126 131 126 0 0 0+146 45 126 131 132 0 0 0+146 45 126 131 146 0 0 0+146 45 126 131 146 0 0 0+146 45 126 131 125 0 0 0+146 45 126 131 129 0 0 0+146 45 132 131 65 0 0 0+146 45 132 131 86 0 0 0+146 45 132 131 126 0 0 0+146 45 132 131 132 0 0 0+146 45 132 131 146 0 0 0+146 45 132 131 146 0 0 0+146 45 132 131 125 0 0 0+146 45 132 131 129 0 0 0+146 45 146 131 65 0 0 0+146 45 146 131 86 0 0 0+146 45 146 131 126 0 0 0+146 45 146 131 132 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 125 0 0 0+146 45 146 131 129 0 0 0+146 45 146 131 65 0 0 0+146 45 146 131 86 0 0 0+146 45 146 131 126 0 0 0+146 45 146 131 132 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 125 0 0 0+146 45 146 131 129 0 0 0+146 45 125 131 65 0 0 0+146 45 125 131 86 0 0 0+146 45 125 131 126 0 0 0+146 45 125 131 132 0 0 0+146 45 125 131 146 0 0 0+146 45 125 131 146 0 0 0+146 45 125 131 125 0 0 0+146 45 125 131 129 0 0 0+146 45 129 131 65 0 0 0+146 45 129 131 86 0 0 0+146 45 129 131 126 0 0 0+146 45 129 131 132 0 0 0+146 45 129 131 146 0 0 0+146 45 129 131 146 0 0 0+146 45 129 131 125 0 0 0+146 45 129 131 129 0 0 0+146 45 65 131 65 0 0 0+146 45 65 131 86 0 0 0+146 45 65 131 126 0 0 0+146 45 65 131 132 0 0 0+146 45 65 131 146 0 0 0+146 45 65 131 146 0 0 0+146 45 65 131 125 0 0 0+146 45 65 131 129 0 0 0+146 45 86 131 65 0 0 0+146 45 86 131 86 0 0 0+146 45 86 131 126 0 0 0+146 45 86 131 132 0 0 0+146 45 86 131 146 0 0 0+146 45 86 131 146 0 0 0+146 45 86 131 125 0 0 0+146 45 86 131 129 0 0 0+146 45 126 131 65 0 0 0+146 45 126 131 86 0 0 0+146 45 126 131 126 0 0 0+146 45 126 131 132 0 0 0+146 45 126 131 146 0 0 0+146 45 126 131 146 0 0 0+146 45 126 131 125 0 0 0+146 45 126 131 129 0 0 0+146 45 132 131 65 0 0 0+146 45 132 131 86 0 0 0+146 45 132 131 126 0 0 0+146 45 132 131 132 0 0 0+146 45 132 131 146 0 0 0+146 45 132 131 146 0 0 0+146 45 132 131 125 0 0 0+146 45 132 131 129 0 0 0+146 45 146 131 65 0 0 0+146 45 146 131 86 0 0 0+146 45 146 131 126 0 0 0+146 45 146 131 132 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 125 0 0 0+146 45 146 131 129 0 0 0+146 45 146 131 65 0 0 0+146 45 146 131 86 0 0 0+146 45 146 131 126 0 0 0+146 45 146 131 132 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 146 0 0 0+146 45 146 131 125 0 0 0+146 45 146 131 129 0 0 0+146 45 125 131 65 0 0 0+146 45 125 131 86 0 0 0+146 45 125 131 126 0 0 0+146 45 125 131 132 0 0 0+146 45 125 131 146 0 0 0+146 45 125 131 146 0 0 0+146 45 125 131 125 0 0 0+146 45 125 131 129 0 0 0+146 45 129 131 65 0 0 0+146 45 129 131 86 0 0 0+146 45 129 131 126 0 0 0+146 45 129 131 132 0 0 0+146 45 129 131 146 0 0 0+146 45 129 131 146 0 0 0+146 45 129 131 125 0 0 0+146 45 129 131 129 0 0 0+125 46 65 131 65 0 0 0+125 46 65 131 86 0 0 0+125 46 65 131 126 0 0 0+125 46 65 131 132 0 0 0+125 46 65 131 146 0 0 0+125 46 65 131 146 0 0 0+125 46 65 131 125 0 0 0+125 46 65 131 129 0 0 0+125 46 86 131 65 0 0 0+125 46 86 131 86 0 0 0+125 46 86 131 126 0 0 0+125 46 86 131 132 0 0 0+125 46 86 131 146 0 0 0+125 46 86 131 146 0 0 0+125 46 86 131 125 0 0 0+125 46 86 131 129 0 0 0+125 46 126 131 65 0 0 0+125 46 126 131 86 0 0 0+125 46 126 131 126 0 0 0+125 46 126 131 132 0 0 0+125 46 126 131 146 0 0 0+125 46 126 131 146 0 0 0+125 46 126 131 125 0 0 0+125 46 126 131 129 0 0 0+125 46 132 131 65 0 0 0+125 46 132 131 86 0 0 0+125 46 132 131 126 0 0 0+125 46 132 131 132 0 0 0+125 46 132 131 146 0 0 0+125 46 132 131 146 0 0 0+125 46 132 131 125 0 0 0+125 46 132 131 129 0 0 0+125 46 146 131 65 0 0 0+125 46 146 131 86 0 0 0+125 46 146 131 126 0 0 0+125 46 146 131 132 0 0 0+125 46 146 131 146 0 0 0+125 46 146 131 146 0 0 0+125 46 146 131 125 0 0 0+125 46 146 131 129 0 0 0+125 46 146 131 65 0 0 0+125 46 146 131 86 0 0 0+125 46 146 131 126 0 0 0+125 46 146 131 132 0 0 0+125 46 146 131 146 0 0 0+125 46 146 131 146 0 0 0+125 46 146 131 125 0 0 0+125 46 146 131 129 0 0 0+125 46 125 131 65 0 0 0+125 46 125 131 86 0 0 0+125 46 125 131 126 0 0 0+125 46 125 131 132 0 0 0+125 46 125 131 146 0 0 0+125 46 125 131 146 0 0 0+125 46 129 131 65 0 0 0+125 46 129 131 86 0 0 0+125 46 129 131 126 0 0 0+125 46 129 131 132 0 0 0+125 46 129 131 146 0 0 0+125 46 129 131 146 0 0 0+129 46 65 131 65 0 0 0+129 46 65 131 86 0 0 0+129 46 65 131 126 0 0 0+129 46 65 131 132 0 0 0+129 46 65 131 146 0 0 0+129 46 65 131 146 0 0 0+129 46 65 131 125 0 0 0+129 46 65 131 129 0 0 0+129 46 86 131 65 0 0 0+129 46 86 131 86 0 0 0+129 46 86 131 126 0 0 0+129 46 86 131 132 0 0 0+129 46 86 131 146 0 0 0+129 46 86 131 146 0 0 0+129 46 86 131 125 0 0 0+129 46 86 131 129 0 0 0+129 46 126 131 65 0 0 0+129 46 126 131 86 0 0 0+129 46 126 131 126 0 0 0+129 46 126 131 132 0 0 0+129 46 126 131 146 0 0 0+129 46 126 131 146 0 0 0+129 46 126 131 125 0 0 0+129 46 126 131 129 0 0 0+129 46 132 131 65 0 0 0+129 46 132 131 86 0 0 0+129 46 132 131 126 0 0 0+129 46 132 131 132 0 0 0+129 46 132 131 146 0 0 0+129 46 132 131 146 0 0 0+129 46 132 131 125 0 0 0+129 46 132 131 129 0 0 0+129 46 146 131 65 0 0 0+129 46 146 131 86 0 0 0+129 46 146 131 126 0 0 0+129 46 146 131 132 0 0 0+129 46 146 131 146 0 0 0+129 46 146 131 146 0 0 0+129 46 146 131 125 0 0 0+129 46 146 131 129 0 0 0+129 46 146 131 65 0 0 0+129 46 146 131 86 0 0 0+129 46 146 131 126 0 0 0+129 46 146 131 132 0 0 0+129 46 146 131 146 0 0 0+129 46 146 131 146 0 0 0+129 46 146 131 125 0 0 0+129 46 146 131 129 0 0 0+129 46 125 131 65 0 0 0+129 46 125 131 86 0 0 0+129 46 125 131 126 0 0 0+129 46 125 131 132 0 0 0+129 46 125 131 146 0 0 0+129 46 125 131 146 0 0 0+129 46 129 131 65 0 0 0+129 46 129 131 86 0 0 0+129 46 129 131 126 0 0 0+129 46 129 131 132 0 0 0+129 46 129 131 146 0 0 0+129 46 129 131 146 0 0 0+60 107 65 65 0 0 0 0+60 107 65 86 0 0 0 0+60 107 65 126 0 0 0 0+60 107 65 132 0 0 0 0+60 107 65 146 0 0 0 0+60 107 65 146 0 0 0 0+60 107 65 125 0 0 0 0+60 107 65 129 0 0 0 0+60 107 86 65 0 0 0 0+60 107 86 86 0 0 0 0+60 107 86 126 0 0 0 0+60 107 86 132 0 0 0 0+60 107 86 146 0 0 0 0+60 107 86 146 0 0 0 0+60 107 86 125 0 0 0 0+60 107 86 129 0 0 0 0+60 107 126 65 0 0 0 0+60 107 126 86 0 0 0 0+60 107 126 126 0 0 0 0+60 107 126 132 0 0 0 0+60 107 126 146 0 0 0 0+60 107 126 146 0 0 0 0+60 107 126 125 0 0 0 0+60 107 126 129 0 0 0 0+60 107 132 65 0 0 0 0+60 107 132 86 0 0 0 0+60 107 132 126 0 0 0 0+60 107 132 132 0 0 0 0+60 107 132 146 0 0 0 0+60 107 132 146 0 0 0 0+60 107 132 125 0 0 0 0+60 107 132 129 0 0 0 0+60 107 146 65 0 0 0 0+60 107 146 86 0 0 0 0+60 107 146 126 0 0 0 0+60 107 146 132 0 0 0 0+60 107 146 146 0 0 0 0+60 107 146 146 0 0 0 0+60 107 146 125 0 0 0 0+60 107 146 129 0 0 0 0+60 107 146 65 0 0 0 0+60 107 146 86 0 0 0 0+60 107 146 126 0 0 0 0+60 107 146 132 0 0 0 0+60 107 146 146 0 0 0 0+60 107 146 146 0 0 0 0+60 107 146 125 0 0 0 0+60 107 146 129 0 0 0 0+60 107 125 65 0 0 0 0+60 107 125 86 0 0 0 0+60 107 125 126 0 0 0 0+60 107 125 132 0 0 0 0+60 107 125 146 0 0 0 0+60 107 125 146 0 0 0 0+60 107 125 125 0 0 0 0+60 107 125 129 0 0 0 0+60 107 129 65 0 0 0 0+60 107 129 86 0 0 0 0+60 107 129 126 0 0 0 0+60 107 129 132 0 0 0 0+60 107 129 146 0 0 0 0+60 107 129 146 0 0 0 0+60 107 129 125 0 0 0 0+60 107 129 129 0 0 0 0+1 106 65 65 0 0 0 0+1 106 65 86 0 0 0 0+1 106 65 126 0 0 0 0+1 106 65 132 0 0 0 0+1 106 65 146 0 0 0 0+1 106 65 146 0 0 0 0+1 106 65 125 0 0 0 0+1 106 65 129 0 0 0 0+1 106 86 65 0 0 0 0+1 106 86 86 0 0 0 0+1 106 86 126 0 0 0 0+1 106 86 132 0 0 0 0+1 106 86 146 0 0 0 0+1 106 86 146 0 0 0 0+1 106 86 125 0 0 0 0+1 106 86 129 0 0 0 0+1 106 126 65 0 0 0 0+1 106 126 86 0 0 0 0+1 106 126 126 0 0 0 0+1 106 126 132 0 0 0 0+1 106 126 146 0 0 0 0+1 106 126 146 0 0 0 0+1 106 126 125 0 0 0 0+1 106 126 129 0 0 0 0+1 106 132 65 0 0 0 0+1 106 132 86 0 0 0 0+1 106 132 126 0 0 0 0+1 106 132 132 0 0 0 0+1 106 132 146 0 0 0 0+1 106 132 146 0 0 0 0+1 106 132 125 0 0 0 0+1 106 132 129 0 0 0 0+1 106 146 65 0 0 0 0+1 106 146 86 0 0 0 0+1 106 146 126 0 0 0 0+1 106 146 132 0 0 0 0+1 106 146 146 0 0 0 0+1 106 146 146 0 0 0 0+1 106 146 125 0 0 0 0+1 106 146 129 0 0 0 0+1 106 146 65 0 0 0 0+1 106 146 86 0 0 0 0+1 106 146 126 0 0 0 0+1 106 146 132 0 0 0 0+1 106 146 146 0 0 0 0+1 106 146 146 0 0 0 0+1 106 146 125 0 0 0 0+1 106 146 129 0 0 0 0+1 106 125 65 0 0 0 0+1 106 125 86 0 0 0 0+1 106 125 126 0 0 0 0+1 106 125 132 0 0 0 0+1 106 125 146 0 0 0 0+1 106 125 146 0 0 0 0+1 106 125 125 0 0 0 0+1 106 125 129 0 0 0 0+1 106 129 65 0 0 0 0+1 106 129 86 0 0 0 0+1 106 129 126 0 0 0 0+1 106 129 132 0 0 0 0+1 106 129 146 0 0 0 0+1 106 129 146 0 0 0 0+1 106 129 125 0 0 0 0+1 106 129 129 0 0 0 0+128 106 65 65 0 0 0 0+128 106 65 86 0 0 0 0+128 106 65 126 0 0 0 0+128 106 65 132 0 0 0 0+128 106 65 146 0 0 0 0+128 106 65 146 0 0 0 0+128 106 65 125 0 0 0 0+128 106 65 129 0 0 0 0+128 106 86 65 0 0 0 0+128 106 86 86 0 0 0 0+128 106 86 126 0 0 0 0+128 106 86 132 0 0 0 0+128 106 86 146 0 0 0 0+128 106 86 146 0 0 0 0+128 106 86 125 0 0 0 0+128 106 86 129 0 0 0 0+128 106 126 65 0 0 0 0+128 106 126 86 0 0 0 0+128 106 126 126 0 0 0 0+128 106 126 132 0 0 0 0+128 106 126 146 0 0 0 0+128 106 126 146 0 0 0 0+128 106 126 125 0 0 0 0+128 106 126 129 0 0 0 0+128 106 132 65 0 0 0 0+128 106 132 86 0 0 0 0+128 106 132 126 0 0 0 0+128 106 132 132 0 0 0 0+128 106 132 146 0 0 0 0+128 106 132 146 0 0 0 0+128 106 132 125 0 0 0 0+128 106 132 129 0 0 0 0+128 106 146 65 0 0 0 0+128 106 146 86 0 0 0 0+128 106 146 126 0 0 0 0+128 106 146 132 0 0 0 0+128 106 146 146 0 0 0 0+128 106 146 146 0 0 0 0+128 106 146 125 0 0 0 0+128 106 146 129 0 0 0 0+128 106 146 65 0 0 0 0+128 106 146 86 0 0 0 0+128 106 146 126 0 0 0 0+128 106 146 132 0 0 0 0+128 106 146 146 0 0 0 0+128 106 146 146 0 0 0 0+128 106 146 125 0 0 0 0+128 106 146 129 0 0 0 0+128 106 125 65 0 0 0 0+128 106 125 86 0 0 0 0+128 106 125 126 0 0 0 0+128 106 125 132 0 0 0 0+128 106 125 146 0 0 0 0+128 106 125 146 0 0 0 0+128 106 125 125 0 0 0 0+128 106 125 129 0 0 0 0+128 106 129 65 0 0 0 0+128 106 129 86 0 0 0 0+128 106 129 126 0 0 0 0+128 106 129 132 0 0 0 0+128 106 129 146 0 0 0 0+128 106 129 146 0 0 0 0+128 106 129 125 0 0 0 0+128 106 129 129 0 0 0 0+142 106 65 65 0 0 0 0+142 106 65 86 0 0 0 0+142 106 65 126 0 0 0 0+142 106 65 132 0 0 0 0+142 106 65 146 0 0 0 0+142 106 65 146 0 0 0 0+142 106 65 125 0 0 0 0+142 106 65 129 0 0 0 0+142 106 86 65 0 0 0 0+142 106 86 86 0 0 0 0+142 106 86 126 0 0 0 0+142 106 86 132 0 0 0 0+142 106 86 146 0 0 0 0+142 106 86 146 0 0 0 0+142 106 86 125 0 0 0 0+142 106 86 129 0 0 0 0+142 106 126 65 0 0 0 0+142 106 126 86 0 0 0 0+142 106 126 126 0 0 0 0+142 106 126 132 0 0 0 0+142 106 126 146 0 0 0 0+142 106 126 146 0 0 0 0+142 106 126 125 0 0 0 0+142 106 126 129 0 0 0 0+142 106 132 65 0 0 0 0+142 106 132 86 0 0 0 0+142 106 132 126 0 0 0 0+142 106 132 132 0 0 0 0+142 106 132 146 0 0 0 0+142 106 132 146 0 0 0 0+142 106 132 125 0 0 0 0+142 106 132 129 0 0 0 0+142 106 146 65 0 0 0 0+142 106 146 86 0 0 0 0+142 106 146 126 0 0 0 0+142 106 146 132 0 0 0 0+142 106 146 146 0 0 0 0+142 106 146 146 0 0 0 0+142 106 146 125 0 0 0 0+142 106 146 129 0 0 0 0+142 106 146 65 0 0 0 0+142 106 146 86 0 0 0 0+142 106 146 126 0 0 0 0+142 106 146 132 0 0 0 0+142 106 146 146 0 0 0 0+142 106 146 146 0 0 0 0+142 106 146 125 0 0 0 0+142 106 146 129 0 0 0 0+142 106 125 65 0 0 0 0+142 106 125 86 0 0 0 0+142 106 125 126 0 0 0 0+142 106 125 132 0 0 0 0+142 106 125 146 0 0 0 0+142 106 125 146 0 0 0 0+142 106 125 125 0 0 0 0+142 106 125 129 0 0 0 0+142 106 129 65 0 0 0 0+142 106 129 86 0 0 0 0+142 106 129 126 0 0 0 0+142 106 129 132 0 0 0 0+142 106 129 146 0 0 0 0+142 106 129 146 0 0 0 0+142 106 129 125 0 0 0 0+142 106 129 129 0 0 0 0+146 106 65 65 0 0 0 0+146 106 65 86 0 0 0 0+146 106 65 126 0 0 0 0+146 106 65 132 0 0 0 0+146 106 65 146 0 0 0 0+146 106 65 146 0 0 0 0+146 106 65 125 0 0 0 0+146 106 65 129 0 0 0 0+146 106 86 65 0 0 0 0+146 106 86 86 0 0 0 0+146 106 86 126 0 0 0 0+146 106 86 132 0 0 0 0+146 106 86 146 0 0 0 0+146 106 86 146 0 0 0 0+146 106 86 125 0 0 0 0+146 106 86 129 0 0 0 0+146 106 126 65 0 0 0 0+146 106 126 86 0 0 0 0+146 106 126 126 0 0 0 0+146 106 126 132 0 0 0 0+146 106 126 146 0 0 0 0+146 106 126 146 0 0 0 0+146 106 126 125 0 0 0 0+146 106 126 129 0 0 0 0+146 106 132 65 0 0 0 0+146 106 132 86 0 0 0 0+146 106 132 126 0 0 0 0+146 106 132 132 0 0 0 0+146 106 132 146 0 0 0 0+146 106 132 146 0 0 0 0+146 106 132 125 0 0 0 0+146 106 132 129 0 0 0 0+146 106 146 65 0 0 0 0+146 106 146 86 0 0 0 0+146 106 146 126 0 0 0 0+146 106 146 132 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 125 0 0 0 0+146 106 146 129 0 0 0 0+146 106 146 65 0 0 0 0+146 106 146 86 0 0 0 0+146 106 146 126 0 0 0 0+146 106 146 132 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 125 0 0 0 0+146 106 146 129 0 0 0 0+146 106 125 65 0 0 0 0+146 106 125 86 0 0 0 0+146 106 125 126 0 0 0 0+146 106 125 132 0 0 0 0+146 106 125 146 0 0 0 0+146 106 125 146 0 0 0 0+146 106 125 125 0 0 0 0+146 106 125 129 0 0 0 0+146 106 129 65 0 0 0 0+146 106 129 86 0 0 0 0+146 106 129 126 0 0 0 0+146 106 129 132 0 0 0 0+146 106 129 146 0 0 0 0+146 106 129 146 0 0 0 0+146 106 129 125 0 0 0 0+146 106 129 129 0 0 0 0+146 106 65 65 0 0 0 0+146 106 65 86 0 0 0 0+146 106 65 126 0 0 0 0+146 106 65 132 0 0 0 0+146 106 65 146 0 0 0 0+146 106 65 146 0 0 0 0+146 106 65 125 0 0 0 0+146 106 65 129 0 0 0 0+146 106 86 65 0 0 0 0+146 106 86 86 0 0 0 0+146 106 86 126 0 0 0 0+146 106 86 132 0 0 0 0+146 106 86 146 0 0 0 0+146 106 86 146 0 0 0 0+146 106 86 125 0 0 0 0+146 106 86 129 0 0 0 0+146 106 126 65 0 0 0 0+146 106 126 86 0 0 0 0+146 106 126 126 0 0 0 0+146 106 126 132 0 0 0 0+146 106 126 146 0 0 0 0+146 106 126 146 0 0 0 0+146 106 126 125 0 0 0 0+146 106 126 129 0 0 0 0+146 106 132 65 0 0 0 0+146 106 132 86 0 0 0 0+146 106 132 126 0 0 0 0+146 106 132 132 0 0 0 0+146 106 132 146 0 0 0 0+146 106 132 146 0 0 0 0+146 106 132 125 0 0 0 0+146 106 132 129 0 0 0 0+146 106 146 65 0 0 0 0+146 106 146 86 0 0 0 0+146 106 146 126 0 0 0 0+146 106 146 132 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 125 0 0 0 0+146 106 146 129 0 0 0 0+146 106 146 65 0 0 0 0+146 106 146 86 0 0 0 0+146 106 146 126 0 0 0 0+146 106 146 132 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 146 0 0 0 0+146 106 146 125 0 0 0 0+146 106 146 129 0 0 0 0+146 106 125 65 0 0 0 0+146 106 125 86 0 0 0 0+146 106 125 126 0 0 0 0+146 106 125 132 0 0 0 0+146 106 125 146 0 0 0 0+146 106 125 146 0 0 0 0+146 106 125 125 0 0 0 0+146 106 125 129 0 0 0 0+146 106 129 65 0 0 0 0+146 106 129 86 0 0 0 0+146 106 129 126 0 0 0 0+146 106 129 132 0 0 0 0+146 106 129 146 0 0 0 0+146 106 129 146 0 0 0 0+146 106 129 125 0 0 0 0+146 106 129 129 0 0 0 0+125 107 65 65 0 0 0 0+125 107 65 86 0 0 0 0+125 107 65 126 0 0 0 0+125 107 65 132 0 0 0 0+125 107 65 146 0 0 0 0+125 107 65 146 0 0 0 0+125 107 65 125 0 0 0 0+125 107 65 129 0 0 0 0+125 107 86 65 0 0 0 0+125 107 86 86 0 0 0 0+125 107 86 126 0 0 0 0+125 107 86 132 0 0 0 0+125 107 86 146 0 0 0 0+125 107 86 146 0 0 0 0+125 107 86 125 0 0 0 0+125 107 86 129 0 0 0 0+125 107 126 65 0 0 0 0+125 107 126 86 0 0 0 0+125 107 126 126 0 0 0 0+125 107 126 132 0 0 0 0+125 107 126 146 0 0 0 0+125 107 126 146 0 0 0 0+125 107 126 125 0 0 0 0+125 107 126 129 0 0 0 0+125 107 132 65 0 0 0 0+125 107 132 86 0 0 0 0+125 107 132 126 0 0 0 0+125 107 132 132 0 0 0 0+125 107 132 146 0 0 0 0+125 107 132 146 0 0 0 0+125 107 132 125 0 0 0 0+125 107 132 129 0 0 0 0+125 107 146 65 0 0 0 0+125 107 146 86 0 0 0 0+125 107 146 126 0 0 0 0+125 107 146 132 0 0 0 0+125 107 146 146 0 0 0 0+125 107 146 146 0 0 0 0+125 107 146 125 0 0 0 0+125 107 146 129 0 0 0 0+125 107 146 65 0 0 0 0+125 107 146 86 0 0 0 0+125 107 146 126 0 0 0 0+125 107 146 132 0 0 0 0+125 107 146 146 0 0 0 0+125 107 146 146 0 0 0 0+125 107 146 125 0 0 0 0+125 107 146 129 0 0 0 0+125 107 125 65 0 0 0 0+125 107 125 86 0 0 0 0+125 107 125 126 0 0 0 0+125 107 125 132 0 0 0 0+125 107 125 146 0 0 0 0+125 107 125 146 0 0 0 0+125 107 129 65 0 0 0 0+125 107 129 86 0 0 0 0+125 107 129 126 0 0 0 0+125 107 129 132 0 0 0 0+125 107 129 146 0 0 0 0+125 107 129 146 0 0 0 0+129 107 65 65 0 0 0 0+129 107 65 86 0 0 0 0+129 107 65 126 0 0 0 0+129 107 65 132 0 0 0 0+129 107 65 146 0 0 0 0+129 107 65 146 0 0 0 0+129 107 65 125 0 0 0 0+129 107 65 129 0 0 0 0+129 107 86 65 0 0 0 0+129 107 86 86 0 0 0 0+129 107 86 126 0 0 0 0+129 107 86 132 0 0 0 0+129 107 86 146 0 0 0 0+129 107 86 146 0 0 0 0+129 107 86 125 0 0 0 0+129 107 86 129 0 0 0 0+129 107 126 65 0 0 0 0+129 107 126 86 0 0 0 0+129 107 126 126 0 0 0 0+129 107 126 132 0 0 0 0+129 107 126 146 0 0 0 0+129 107 126 146 0 0 0 0+129 107 126 125 0 0 0 0+129 107 126 129 0 0 0 0+129 107 132 65 0 0 0 0+129 107 132 86 0 0 0 0+129 107 132 126 0 0 0 0+129 107 132 132 0 0 0 0+129 107 132 146 0 0 0 0+129 107 132 146 0 0 0 0+129 107 132 125 0 0 0 0+129 107 132 129 0 0 0 0+129 107 146 65 0 0 0 0+129 107 146 86 0 0 0 0+129 107 146 126 0 0 0 0+129 107 146 132 0 0 0 0+129 107 146 146 0 0 0 0+129 107 146 146 0 0 0 0+129 107 146 125 0 0 0 0+129 107 146 129 0 0 0 0+129 107 146 65 0 0 0 0+129 107 146 86 0 0 0 0+129 107 146 126 0 0 0 0+129 107 146 132 0 0 0 0+129 107 146 146 0 0 0 0+129 107 146 146 0 0 0 0+129 107 146 125 0 0 0 0+129 107 146 129 0 0 0 0+129 107 125 65 0 0 0 0+129 107 125 86 0 0 0 0+129 107 125 126 0 0 0 0+129 107 125 132 0 0 0 0+129 107 125 146 0 0 0 0+129 107 125 146 0 0 0 0+129 107 129 65 0 0 0 0+129 107 129 86 0 0 0 0+129 107 129 126 0 0 0 0+129 107 129 132 0 0 0 0+129 107 129 146 0 0 0 0+129 107 129 146 0 0 0 0+60 46 9 131 65 0 0 0+60 46 9 131 86 0 0 0+60 46 9 131 126 0 0 0+60 46 9 131 132 0 0 0+60 46 9 131 146 0 0 0+60 46 9 131 146 0 0 0+60 46 9 131 125 0 0 0+60 46 9 131 129 0 0 0+60 46 141 131 65 0 0 0+60 46 141 131 86 0 0 0+60 46 141 131 126 0 0 0+60 46 141 131 132 0 0 0+60 46 141 131 146 0 0 0+60 46 141 131 146 0 0 0+60 46 141 131 125 0 0 0+60 46 141 131 129 0 0 0+60 46 2 131 65 0 0 0+60 46 2 131 86 0 0 0+60 46 2 131 126 0 0 0+60 46 2 131 132 0 0 0+60 46 2 131 146 0 0 0+60 46 2 131 146 0 0 0+60 46 2 131 125 0 0 0+60 46 2 131 129 0 0 0+60 46 43 131 65 0 0 0+60 46 43 131 86 0 0 0+60 46 43 131 126 0 0 0+60 46 43 131 132 0 0 0+60 46 43 131 146 0 0 0+60 46 43 131 146 0 0 0+60 46 43 131 125 0 0 0+60 46 43 131 129 0 0 0+60 46 89 131 65 0 0 0+60 46 89 131 86 0 0 0+60 46 89 131 126 0 0 0+60 46 89 131 132 0 0 0+60 46 89 131 146 0 0 0+60 46 89 131 146 0 0 0+60 46 89 131 125 0 0 0+60 46 89 131 129 0 0 0+60 46 112 131 65 0 0 0+60 46 112 131 86 0 0 0+60 46 112 131 126 0 0 0+60 46 112 131 132 0 0 0+60 46 112 131 146 0 0 0+60 46 112 131 146 0 0 0+60 46 112 131 125 0 0 0+60 46 112 131 129 0 0 0+1 45 9 131 65 0 0 0+1 45 9 131 86 0 0 0+1 45 9 131 126 0 0 0+1 45 9 131 132 0 0 0+1 45 9 131 146 0 0 0+1 45 9 131 146 0 0 0+1 45 9 131 125 0 0 0+1 45 9 131 129 0 0 0+1 45 141 131 65 0 0 0+1 45 141 131 86 0 0 0+1 45 141 131 126 0 0 0+1 45 141 131 132 0 0 0+1 45 141 131 146 0 0 0+1 45 141 131 146 0 0 0+1 45 141 131 125 0 0 0+1 45 141 131 129 0 0 0+1 45 2 131 65 0 0 0+1 45 2 131 86 0 0 0+1 45 2 131 126 0 0 0+1 45 2 131 132 0 0 0+1 45 2 131 146 0 0 0+1 45 2 131 146 0 0 0+1 45 2 131 125 0 0 0+1 45 2 131 129 0 0 0+1 45 43 131 65 0 0 0+1 45 43 131 86 0 0 0+1 45 43 131 126 0 0 0+1 45 43 131 132 0 0 0+1 45 43 131 146 0 0 0+1 45 43 131 146 0 0 0+1 45 43 131 125 0 0 0+1 45 43 131 129 0 0 0+1 45 89 131 65 0 0 0+1 45 89 131 86 0 0 0+1 45 89 131 126 0 0 0+1 45 89 131 132 0 0 0+1 45 89 131 146 0 0 0+1 45 89 131 146 0 0 0+1 45 89 131 125 0 0 0+1 45 89 131 129 0 0 0+1 45 112 131 65 0 0 0+1 45 112 131 86 0 0 0+1 45 112 131 126 0 0 0+1 45 112 131 132 0 0 0+1 45 112 131 146 0 0 0+1 45 112 131 146 0 0 0+1 45 112 131 125 0 0 0+1 45 112 131 129 0 0 0+128 45 9 131 65 0 0 0+128 45 9 131 86 0 0 0+128 45 9 131 126 0 0 0+128 45 9 131 132 0 0 0+128 45 9 131 146 0 0 0+128 45 9 131 146 0 0 0+128 45 9 131 125 0 0 0+128 45 9 131 129 0 0 0+128 45 141 131 65 0 0 0+128 45 141 131 86 0 0 0+128 45 141 131 126 0 0 0+128 45 141 131 132 0 0 0+128 45 141 131 146 0 0 0+128 45 141 131 146 0 0 0+128 45 141 131 125 0 0 0+128 45 141 131 129 0 0 0+128 45 2 131 65 0 0 0+128 45 2 131 86 0 0 0+128 45 2 131 126 0 0 0+128 45 2 131 132 0 0 0+128 45 2 131 146 0 0 0+128 45 2 131 146 0 0 0+128 45 2 131 125 0 0 0+128 45 2 131 129 0 0 0+128 45 43 131 65 0 0 0+128 45 43 131 86 0 0 0+128 45 43 131 126 0 0 0+128 45 43 131 132 0 0 0+128 45 43 131 146 0 0 0+128 45 43 131 146 0 0 0+128 45 43 131 125 0 0 0+128 45 43 131 129 0 0 0+128 45 89 131 65 0 0 0+128 45 89 131 86 0 0 0+128 45 89 131 126 0 0 0+128 45 89 131 132 0 0 0+128 45 89 131 146 0 0 0+128 45 89 131 146 0 0 0+128 45 89 131 125 0 0 0+128 45 89 131 129 0 0 0+128 45 112 131 65 0 0 0+128 45 112 131 86 0 0 0+128 45 112 131 126 0 0 0+128 45 112 131 132 0 0 0+128 45 112 131 146 0 0 0+128 45 112 131 146 0 0 0+128 45 112 131 125 0 0 0+128 45 112 131 129 0 0 0+142 45 9 131 65 0 0 0+142 45 9 131 86 0 0 0+142 45 9 131 126 0 0 0+142 45 9 131 132 0 0 0+142 45 9 131 146 0 0 0+142 45 9 131 146 0 0 0+142 45 9 131 125 0 0 0+142 45 9 131 129 0 0 0+142 45 141 131 65 0 0 0+142 45 141 131 86 0 0 0+142 45 141 131 126 0 0 0+142 45 141 131 132 0 0 0+142 45 141 131 146 0 0 0+142 45 141 131 146 0 0 0+142 45 141 131 125 0 0 0+142 45 141 131 129 0 0 0+142 45 2 131 65 0 0 0+142 45 2 131 86 0 0 0+142 45 2 131 126 0 0 0+142 45 2 131 132 0 0 0+142 45 2 131 146 0 0 0+142 45 2 131 146 0 0 0+142 45 2 131 125 0 0 0+142 45 2 131 129 0 0 0+142 45 43 131 65 0 0 0+142 45 43 131 86 0 0 0+142 45 43 131 126 0 0 0+142 45 43 131 132 0 0 0+142 45 43 131 146 0 0 0+142 45 43 131 146 0 0 0+142 45 43 131 125 0 0 0+142 45 43 131 129 0 0 0+142 45 89 131 65 0 0 0+142 45 89 131 86 0 0 0+142 45 89 131 126 0 0 0+142 45 89 131 132 0 0 0+142 45 89 131 146 0 0 0+142 45 89 131 146 0 0 0+142 45 89 131 125 0 0 0+142 45 89 131 129 0 0 0+142 45 112 131 65 0 0 0+142 45 112 131 86 0 0 0+142 45 112 131 126 0 0 0+142 45 112 131 132 0 0 0+142 45 112 131 146 0 0 0+142 45 112 131 146 0 0 0+142 45 112 131 125 0 0 0+142 45 112 131 129 0 0 0+146 45 9 131 65 0 0 0+146 45 9 131 86 0 0 0+146 45 9 131 126 0 0 0+146 45 9 131 132 0 0 0+146 45 9 131 146 0 0 0+146 45 9 131 146 0 0 0+146 45 9 131 125 0 0 0+146 45 9 131 129 0 0 0+146 45 141 131 65 0 0 0+146 45 141 131 86 0 0 0+146 45 141 131 126 0 0 0+146 45 141 131 132 0 0 0+146 45 141 131 146 0 0 0+146 45 141 131 146 0 0 0+146 45 141 131 125 0 0 0+146 45 141 131 129 0 0 0+146 45 2 131 65 0 0 0+146 45 2 131 86 0 0 0+146 45 2 131 126 0 0 0+146 45 2 131 132 0 0 0+146 45 2 131 146 0 0 0+146 45 2 131 146 0 0 0+146 45 2 131 125 0 0 0+146 45 2 131 129 0 0 0+146 45 43 131 65 0 0 0+146 45 43 131 86 0 0 0+146 45 43 131 126 0 0 0+146 45 43 131 132 0 0 0+146 45 43 131 146 0 0 0+146 45 43 131 146 0 0 0+146 45 43 131 125 0 0 0+146 45 43 131 129 0 0 0+146 45 89 131 65 0 0 0+146 45 89 131 86 0 0 0+146 45 89 131 126 0 0 0+146 45 89 131 132 0 0 0+146 45 89 131 146 0 0 0+146 45 89 131 146 0 0 0+146 45 89 131 125 0 0 0+146 45 89 131 129 0 0 0+146 45 112 131 65 0 0 0+146 45 112 131 86 0 0 0+146 45 112 131 126 0 0 0+146 45 112 131 132 0 0 0+146 45 112 131 146 0 0 0+146 45 112 131 146 0 0 0+146 45 112 131 125 0 0 0+146 45 112 131 129 0 0 0+146 45 9 131 65 0 0 0+146 45 9 131 86 0 0 0+146 45 9 131 126 0 0 0+146 45 9 131 132 0 0 0+146 45 9 131 146 0 0 0+146 45 9 131 146 0 0 0+146 45 9 131 125 0 0 0+146 45 9 131 129 0 0 0+146 45 141 131 65 0 0 0+146 45 141 131 86 0 0 0+146 45 141 131 126 0 0 0+146 45 141 131 132 0 0 0+146 45 141 131 146 0 0 0+146 45 141 131 146 0 0 0+146 45 141 131 125 0 0 0+146 45 141 131 129 0 0 0+146 45 2 131 65 0 0 0+146 45 2 131 86 0 0 0+146 45 2 131 126 0 0 0+146 45 2 131 132 0 0 0+146 45 2 131 146 0 0 0+146 45 2 131 146 0 0 0+146 45 2 131 125 0 0 0+146 45 2 131 129 0 0 0+146 45 43 131 65 0 0 0+146 45 43 131 86 0 0 0+146 45 43 131 126 0 0 0+146 45 43 131 132 0 0 0+146 45 43 131 146 0 0 0+146 45 43 131 146 0 0 0+146 45 43 131 125 0 0 0+146 45 43 131 129 0 0 0+146 45 89 131 65 0 0 0+146 45 89 131 86 0 0 0+146 45 89 131 126 0 0 0+146 45 89 131 132 0 0 0+146 45 89 131 146 0 0 0+146 45 89 131 146 0 0 0+146 45 89 131 125 0 0 0+146 45 89 131 129 0 0 0+146 45 112 131 65 0 0 0+146 45 112 131 86 0 0 0+146 45 112 131 126 0 0 0+146 45 112 131 132 0 0 0+146 45 112 131 146 0 0 0+146 45 112 131 146 0 0 0+146 45 112 131 125 0 0 0+146 45 112 131 129 0 0 0+125 46 9 131 65 0 0 0+125 46 9 131 86 0 0 0+125 46 9 131 126 0 0 0+125 46 9 131 132 0 0 0+125 46 9 131 146 0 0 0+125 46 9 131 146 0 0 0+125 46 9 131 125 0 0 0+125 46 9 131 129 0 0 0+125 46 141 131 65 0 0 0+125 46 141 131 86 0 0 0+125 46 141 131 126 0 0 0+125 46 141 131 132 0 0 0+125 46 141 131 146 0 0 0+125 46 141 131 146 0 0 0+125 46 141 131 125 0 0 0+125 46 141 131 129 0 0 0+125 46 2 131 65 0 0 0+125 46 2 131 86 0 0 0+125 46 2 131 126 0 0 0+125 46 2 131 132 0 0 0+125 46 2 131 146 0 0 0+125 46 2 131 146 0 0 0+125 46 2 131 125 0 0 0+125 46 2 131 129 0 0 0+125 46 43 131 65 0 0 0+125 46 43 131 86 0 0 0+125 46 43 131 126 0 0 0+125 46 43 131 132 0 0 0+125 46 43 131 146 0 0 0+125 46 43 131 146 0 0 0+125 46 43 131 125 0 0 0+125 46 43 131 129 0 0 0+125 46 89 131 65 0 0 0+125 46 89 131 86 0 0 0+125 46 89 131 126 0 0 0+125 46 89 131 132 0 0 0+125 46 89 131 146 0 0 0+125 46 89 131 146 0 0 0+125 46 89 131 125 0 0 0+125 46 89 131 129 0 0 0+125 46 112 131 65 0 0 0+125 46 112 131 86 0 0 0+125 46 112 131 126 0 0 0+125 46 112 131 132 0 0 0+125 46 112 131 146 0 0 0+125 46 112 131 146 0 0 0+125 46 112 131 125 0 0 0+125 46 112 131 129 0 0 0+129 46 9 131 65 0 0 0+129 46 9 131 86 0 0 0+129 46 9 131 126 0 0 0+129 46 9 131 132 0 0 0+129 46 9 131 146 0 0 0+129 46 9 131 146 0 0 0+129 46 9 131 125 0 0 0+129 46 9 131 129 0 0 0+129 46 141 131 65 0 0 0+129 46 141 131 86 0 0 0+129 46 141 131 126 0 0 0+129 46 141 131 132 0 0 0+129 46 141 131 146 0 0 0+129 46 141 131 146 0 0 0+129 46 141 131 125 0 0 0+129 46 141 131 129 0 0 0+129 46 2 131 65 0 0 0+129 46 2 131 86 0 0 0+129 46 2 131 126 0 0 0+129 46 2 131 132 0 0 0+129 46 2 131 146 0 0 0+129 46 2 131 146 0 0 0+129 46 2 131 125 0 0 0+129 46 2 131 129 0 0 0+129 46 43 131 65 0 0 0+129 46 43 131 86 0 0 0+129 46 43 131 126 0 0 0+129 46 43 131 132 0 0 0+129 46 43 131 146 0 0 0+129 46 43 131 146 0 0 0+129 46 43 131 125 0 0 0+129 46 43 131 129 0 0 0+129 46 89 131 65 0 0 0+129 46 89 131 86 0 0 0+129 46 89 131 126 0 0 0+129 46 89 131 132 0 0 0+129 46 89 131 146 0 0 0+129 46 89 131 146 0 0 0+129 46 89 131 125 0 0 0+129 46 89 131 129 0 0 0+129 46 112 131 65 0 0 0+129 46 112 131 86 0 0 0+129 46 112 131 126 0 0 0+129 46 112 131 132 0 0 0+129 46 112 131 146 0 0 0+129 46 112 131 146 0 0 0+129 46 112 131 125 0 0 0+129 46 112 131 129 0 0 0+60 107 9 65 0 0 0 0+60 107 9 86 0 0 0 0+60 107 9 126 0 0 0 0+60 107 9 132 0 0 0 0+60 107 9 146 0 0 0 0+60 107 9 146 0 0 0 0+60 107 9 125 0 0 0 0+60 107 9 129 0 0 0 0+60 107 141 65 0 0 0 0+60 107 141 86 0 0 0 0+60 107 141 126 0 0 0 0+60 107 141 132 0 0 0 0+60 107 141 146 0 0 0 0+60 107 141 146 0 0 0 0+60 107 141 125 0 0 0 0+60 107 141 129 0 0 0 0+60 107 2 65 0 0 0 0+60 107 2 86 0 0 0 0+60 107 2 126 0 0 0 0+60 107 2 132 0 0 0 0+60 107 2 146 0 0 0 0+60 107 2 146 0 0 0 0+60 107 2 125 0 0 0 0+60 107 2 129 0 0 0 0+60 107 43 65 0 0 0 0+60 107 43 86 0 0 0 0+60 107 43 126 0 0 0 0+60 107 43 132 0 0 0 0+60 107 43 146 0 0 0 0+60 107 43 146 0 0 0 0+60 107 43 125 0 0 0 0+60 107 43 129 0 0 0 0+60 107 89 65 0 0 0 0+60 107 89 86 0 0 0 0+60 107 89 126 0 0 0 0+60 107 89 132 0 0 0 0+60 107 89 146 0 0 0 0+60 107 89 146 0 0 0 0+60 107 89 125 0 0 0 0+60 107 89 129 0 0 0 0+60 107 112 65 0 0 0 0+60 107 112 86 0 0 0 0+60 107 112 126 0 0 0 0+60 107 112 132 0 0 0 0+60 107 112 146 0 0 0 0+60 107 112 146 0 0 0 0+60 107 112 125 0 0 0 0+60 107 112 129 0 0 0 0+1 106 9 65 0 0 0 0+1 106 9 86 0 0 0 0+1 106 9 126 0 0 0 0+1 106 9 132 0 0 0 0+1 106 9 146 0 0 0 0+1 106 9 146 0 0 0 0+1 106 9 125 0 0 0 0+1 106 9 129 0 0 0 0+1 106 141 65 0 0 0 0+1 106 141 86 0 0 0 0+1 106 141 126 0 0 0 0+1 106 141 132 0 0 0 0+1 106 141 146 0 0 0 0+1 106 141 146 0 0 0 0+1 106 141 125 0 0 0 0+1 106 141 129 0 0 0 0+1 106 2 65 0 0 0 0+1 106 2 86 0 0 0 0+1 106 2 126 0 0 0 0+1 106 2 132 0 0 0 0+1 106 2 146 0 0 0 0+1 106 2 146 0 0 0 0+1 106 2 125 0 0 0 0+1 106 2 129 0 0 0 0+1 106 43 65 0 0 0 0+1 106 43 86 0 0 0 0+1 106 43 126 0 0 0 0+1 106 43 132 0 0 0 0+1 106 43 146 0 0 0 0+1 106 43 146 0 0 0 0+1 106 43 125 0 0 0 0+1 106 43 129 0 0 0 0+1 106 89 65 0 0 0 0+1 106 89 86 0 0 0 0+1 106 89 126 0 0 0 0+1 106 89 132 0 0 0 0+1 106 89 146 0 0 0 0+1 106 89 146 0 0 0 0+1 106 89 125 0 0 0 0+1 106 89 129 0 0 0 0+1 106 112 65 0 0 0 0+1 106 112 86 0 0 0 0+1 106 112 126 0 0 0 0+1 106 112 132 0 0 0 0+1 106 112 146 0 0 0 0+1 106 112 146 0 0 0 0+1 106 112 125 0 0 0 0+1 106 112 129 0 0 0 0+128 106 9 65 0 0 0 0+128 106 9 86 0 0 0 0+128 106 9 126 0 0 0 0+128 106 9 132 0 0 0 0+128 106 9 146 0 0 0 0+128 106 9 146 0 0 0 0+128 106 9 125 0 0 0 0+128 106 9 129 0 0 0 0+128 106 141 65 0 0 0 0+128 106 141 86 0 0 0 0+128 106 141 126 0 0 0 0+128 106 141 132 0 0 0 0+128 106 141 146 0 0 0 0+128 106 141 146 0 0 0 0+128 106 141 125 0 0 0 0+128 106 141 129 0 0 0 0+128 106 2 65 0 0 0 0+128 106 2 86 0 0 0 0+128 106 2 126 0 0 0 0+128 106 2 132 0 0 0 0+128 106 2 146 0 0 0 0+128 106 2 146 0 0 0 0+128 106 2 125 0 0 0 0+128 106 2 129 0 0 0 0+128 106 43 65 0 0 0 0+128 106 43 86 0 0 0 0+128 106 43 126 0 0 0 0+128 106 43 132 0 0 0 0+128 106 43 146 0 0 0 0+128 106 43 146 0 0 0 0+128 106 43 125 0 0 0 0+128 106 43 129 0 0 0 0+128 106 89 65 0 0 0 0+128 106 89 86 0 0 0 0+128 106 89 126 0 0 0 0+128 106 89 132 0 0 0 0+128 106 89 146 0 0 0 0+128 106 89 146 0 0 0 0+128 106 89 125 0 0 0 0+128 106 89 129 0 0 0 0+128 106 112 65 0 0 0 0+128 106 112 86 0 0 0 0+128 106 112 126 0 0 0 0+128 106 112 132 0 0 0 0+128 106 112 146 0 0 0 0+128 106 112 146 0 0 0 0+128 106 112 125 0 0 0 0+128 106 112 129 0 0 0 0+142 106 9 65 0 0 0 0+142 106 9 86 0 0 0 0+142 106 9 126 0 0 0 0+142 106 9 132 0 0 0 0+142 106 9 146 0 0 0 0+142 106 9 146 0 0 0 0+142 106 9 125 0 0 0 0+142 106 9 129 0 0 0 0+142 106 141 65 0 0 0 0+142 106 141 86 0 0 0 0+142 106 141 126 0 0 0 0+142 106 141 132 0 0 0 0+142 106 141 146 0 0 0 0+142 106 141 146 0 0 0 0+142 106 141 125 0 0 0 0+142 106 141 129 0 0 0 0+142 106 2 65 0 0 0 0+142 106 2 86 0 0 0 0+142 106 2 126 0 0 0 0+142 106 2 132 0 0 0 0+142 106 2 146 0 0 0 0+142 106 2 146 0 0 0 0+142 106 2 125 0 0 0 0+142 106 2 129 0 0 0 0+142 106 43 65 0 0 0 0+142 106 43 86 0 0 0 0+142 106 43 126 0 0 0 0+142 106 43 132 0 0 0 0+142 106 43 146 0 0 0 0+142 106 43 146 0 0 0 0+142 106 43 125 0 0 0 0+142 106 43 129 0 0 0 0+142 106 89 65 0 0 0 0+142 106 89 86 0 0 0 0+142 106 89 126 0 0 0 0+142 106 89 132 0 0 0 0+142 106 89 146 0 0 0 0+142 106 89 146 0 0 0 0+142 106 89 125 0 0 0 0+142 106 89 129 0 0 0 0+142 106 112 65 0 0 0 0+142 106 112 86 0 0 0 0+142 106 112 126 0 0 0 0+142 106 112 132 0 0 0 0+142 106 112 146 0 0 0 0+142 106 112 146 0 0 0 0+142 106 112 125 0 0 0 0+142 106 112 129 0 0 0 0+146 106 9 65 0 0 0 0+146 106 9 86 0 0 0 0+146 106 9 126 0 0 0 0+146 106 9 132 0 0 0 0+146 106 9 146 0 0 0 0+146 106 9 146 0 0 0 0+146 106 9 125 0 0 0 0+146 106 9 129 0 0 0 0+146 106 141 65 0 0 0 0+146 106 141 86 0 0 0 0+146 106 141 126 0 0 0 0+146 106 141 132 0 0 0 0+146 106 141 146 0 0 0 0+146 106 141 146 0 0 0 0+146 106 141 125 0 0 0 0+146 106 141 129 0 0 0 0+146 106 2 65 0 0 0 0+146 106 2 86 0 0 0 0+146 106 2 126 0 0 0 0+146 106 2 132 0 0 0 0+146 106 2 146 0 0 0 0+146 106 2 146 0 0 0 0+146 106 2 125 0 0 0 0+146 106 2 129 0 0 0 0+146 106 43 65 0 0 0 0+146 106 43 86 0 0 0 0+146 106 43 126 0 0 0 0+146 106 43 132 0 0 0 0+146 106 43 146 0 0 0 0+146 106 43 146 0 0 0 0+146 106 43 125 0 0 0 0+146 106 43 129 0 0 0 0+146 106 89 65 0 0 0 0+146 106 89 86 0 0 0 0+146 106 89 126 0 0 0 0+146 106 89 132 0 0 0 0+146 106 89 146 0 0 0 0+146 106 89 146 0 0 0 0+146 106 89 125 0 0 0 0+146 106 89 129 0 0 0 0+146 106 112 65 0 0 0 0+146 106 112 86 0 0 0 0+146 106 112 126 0 0 0 0+146 106 112 132 0 0 0 0+146 106 112 146 0 0 0 0+146 106 112 146 0 0 0 0+146 106 112 125 0 0 0 0+146 106 112 129 0 0 0 0+146 106 9 65 0 0 0 0+146 106 9 86 0 0 0 0+146 106 9 126 0 0 0 0+146 106 9 132 0 0 0 0+146 106 9 146 0 0 0 0+146 106 9 146 0 0 0 0+146 106 9 125 0 0 0 0+146 106 9 129 0 0 0 0+146 106 141 65 0 0 0 0+146 106 141 86 0 0 0 0+146 106 141 126 0 0 0 0+146 106 141 132 0 0 0 0+146 106 141 146 0 0 0 0+146 106 141 146 0 0 0 0+146 106 141 125 0 0 0 0+146 106 141 129 0 0 0 0+146 106 2 65 0 0 0 0+146 106 2 86 0 0 0 0+146 106 2 126 0 0 0 0+146 106 2 132 0 0 0 0+146 106 2 146 0 0 0 0+146 106 2 146 0 0 0 0+146 106 2 125 0 0 0 0+146 106 2 129 0 0 0 0+146 106 43 65 0 0 0 0+146 106 43 86 0 0 0 0+146 106 43 126 0 0 0 0+146 106 43 132 0 0 0 0+146 106 43 146 0 0 0 0+146 106 43 146 0 0 0 0+146 106 43 125 0 0 0 0+146 106 43 129 0 0 0 0+146 106 89 65 0 0 0 0+146 106 89 86 0 0 0 0+146 106 89 126 0 0 0 0+146 106 89 132 0 0 0 0+146 106 89 146 0 0 0 0+146 106 89 146 0 0 0 0+146 106 89 125 0 0 0 0+146 106 89 129 0 0 0 0+146 106 112 65 0 0 0 0+146 106 112 86 0 0 0 0+146 106 112 126 0 0 0 0+146 106 112 132 0 0 0 0+146 106 112 146 0 0 0 0+146 106 112 146 0 0 0 0+146 106 112 125 0 0 0 0+146 106 112 129 0 0 0 0+125 107 9 65 0 0 0 0+125 107 9 86 0 0 0 0+125 107 9 126 0 0 0 0+125 107 9 132 0 0 0 0+125 107 9 146 0 0 0 0+125 107 9 146 0 0 0 0+125 107 9 125 0 0 0 0+125 107 9 129 0 0 0 0+125 107 141 65 0 0 0 0+125 107 141 86 0 0 0 0+125 107 141 126 0 0 0 0+125 107 141 132 0 0 0 0+125 107 141 146 0 0 0 0+125 107 141 146 0 0 0 0+125 107 141 125 0 0 0 0+125 107 141 129 0 0 0 0+125 107 2 65 0 0 0 0+125 107 2 86 0 0 0 0+125 107 2 126 0 0 0 0+125 107 2 132 0 0 0 0+125 107 2 146 0 0 0 0+125 107 2 146 0 0 0 0+125 107 2 125 0 0 0 0+125 107 2 129 0 0 0 0+125 107 43 65 0 0 0 0+125 107 43 86 0 0 0 0+125 107 43 126 0 0 0 0+125 107 43 132 0 0 0 0+125 107 43 146 0 0 0 0+125 107 43 146 0 0 0 0+125 107 43 125 0 0 0 0+125 107 43 129 0 0 0 0+125 107 89 65 0 0 0 0+125 107 89 86 0 0 0 0+125 107 89 126 0 0 0 0+125 107 89 132 0 0 0 0+125 107 89 146 0 0 0 0+125 107 89 146 0 0 0 0+125 107 89 125 0 0 0 0+125 107 89 129 0 0 0 0+125 107 112 65 0 0 0 0+125 107 112 86 0 0 0 0+125 107 112 126 0 0 0 0+125 107 112 132 0 0 0 0+125 107 112 146 0 0 0 0+125 107 112 146 0 0 0 0+125 107 112 125 0 0 0 0+125 107 112 129 0 0 0 0+129 107 9 65 0 0 0 0+129 107 9 86 0 0 0 0+129 107 9 126 0 0 0 0+129 107 9 132 0 0 0 0+129 107 9 146 0 0 0 0+129 107 9 146 0 0 0 0+129 107 9 125 0 0 0 0+129 107 9 129 0 0 0 0+129 107 141 65 0 0 0 0+129 107 141 86 0 0 0 0+129 107 141 126 0 0 0 0+129 107 141 132 0 0 0 0+129 107 141 146 0 0 0 0+129 107 141 146 0 0 0 0+129 107 141 125 0 0 0 0+129 107 141 129 0 0 0 0+129 107 2 65 0 0 0 0+129 107 2 86 0 0 0 0+129 107 2 126 0 0 0 0+129 107 2 132 0 0 0 0+129 107 2 146 0 0 0 0+129 107 2 146 0 0 0 0+129 107 2 125 0 0 0 0+129 107 2 129 0 0 0 0+129 107 43 65 0 0 0 0+129 107 43 86 0 0 0 0+129 107 43 126 0 0 0 0+129 107 43 132 0 0 0 0+129 107 43 146 0 0 0 0+129 107 43 146 0 0 0 0+129 107 43 125 0 0 0 0+129 107 43 129 0 0 0 0+129 107 89 65 0 0 0 0+129 107 89 86 0 0 0 0+129 107 89 126 0 0 0 0+129 107 89 132 0 0 0 0+129 107 89 146 0 0 0 0+129 107 89 146 0 0 0 0+129 107 89 125 0 0 0 0+129 107 89 129 0 0 0 0+129 107 112 65 0 0 0 0+129 107 112 86 0 0 0 0+129 107 112 126 0 0 0 0+129 107 112 132 0 0 0 0+129 107 112 146 0 0 0 0+129 107 112 146 0 0 0 0+129 107 112 125 0 0 0 0+129 107 112 129 0 0 0 0
@@ -0,0 +1,227 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+module GFCC.Abs (Tree(..), Grammar, Header, Abstract, Concrete, AbsDef, CncDef, Type, Exp, Atom, Term, Tokn, Variant, CId, johnMajorEq, module GFCC.ComposOp) where++import GFCC.ComposOp++import Data.Monoid++-- Haskell module generated by the BNF converter++data Grammar_+type Grammar = Tree Grammar_+data Header_+type Header = Tree Header_+data Abstract_+type Abstract = Tree Abstract_+data Concrete_+type Concrete = Tree Concrete_+data AbsDef_+type AbsDef = Tree AbsDef_+data CncDef_+type CncDef = Tree CncDef_+data Type_+type Type = Tree Type_+data Exp_+type Exp = Tree Exp_+data Atom_+type Atom = Tree Atom_+data Term_+type Term = Tree Term_+data Tokn_+type Tokn = Tree Tokn_+data Variant_+type Variant = Tree Variant_+data CId_+type CId = Tree CId_++data Tree :: * -> * where+ Grm :: Header -> Abstract -> [Concrete] -> Tree Grammar_+ Hdr :: CId -> [CId] -> Tree Header_+ Abs :: [AbsDef] -> Tree Abstract_+ Cnc :: CId -> [CncDef] -> Tree Concrete_+ Fun :: CId -> Type -> Exp -> Tree AbsDef_+ Lin :: CId -> Term -> Tree CncDef_+ Typ :: [CId] -> CId -> Tree Type_+ Tr :: Atom -> [Exp] -> Tree Exp_+ AC :: CId -> Tree Atom_+ AS :: String -> Tree Atom_+ AI :: Integer -> Tree Atom_+ AF :: Double -> Tree Atom_+ AM :: Tree Atom_+ R :: [Term] -> Tree Term_+ P :: Term -> Term -> Tree Term_+ S :: [Term] -> Tree Term_+ K :: Tokn -> Tree Term_+ V :: Integer -> Tree Term_+ C :: Integer -> Tree Term_+ F :: CId -> Tree Term_+ FV :: [Term] -> Tree Term_+ W :: String -> Term -> Tree Term_+ RP :: Term -> Term -> Tree Term_+ TM :: Tree Term_+ L :: CId -> Term -> Tree Term_+ BV :: CId -> Tree Term_+ KS :: String -> Tree Tokn_+ KP :: [String] -> [Variant] -> Tree Tokn_+ Var :: [String] -> [String] -> Tree Variant_+ CId :: String -> Tree CId_++instance Compos Tree where+ compos r a f t = case t of+ Grm header abstract concretes -> r Grm `a` f header `a` f abstract `a` foldr (a . a (r (:)) . f) (r []) concretes+ Hdr cid cids -> r Hdr `a` f cid `a` foldr (a . a (r (:)) . f) (r []) cids+ Abs absdefs -> r Abs `a` foldr (a . a (r (:)) . f) (r []) absdefs+ Cnc cid cncdefs -> r Cnc `a` f cid `a` foldr (a . a (r (:)) . f) (r []) cncdefs+ Fun cid type' exp -> r Fun `a` f cid `a` f type' `a` f exp+ Lin cid term -> r Lin `a` f cid `a` f term+ Typ cids cid -> r Typ `a` foldr (a . a (r (:)) . f) (r []) cids `a` f cid+ Tr atom exps -> r Tr `a` f atom `a` foldr (a . a (r (:)) . f) (r []) exps+ AC cid -> r AC `a` f cid+ R terms -> r R `a` foldr (a . a (r (:)) . f) (r []) terms+ P term0 term1 -> r P `a` f term0 `a` f term1+ S terms -> r S `a` foldr (a . a (r (:)) . f) (r []) terms+ K tokn -> r K `a` f tokn+ F cid -> r F `a` f cid+ FV terms -> r FV `a` foldr (a . a (r (:)) . f) (r []) terms+ W str term -> r W `a` r str `a` f term+ RP term0 term1 -> r RP `a` f term0 `a` f term1+ L cid term -> r L `a` f cid `a` f term+ BV cid -> r BV `a` f cid+ KP strs variants -> r KP `a` r strs `a` foldr (a . a (r (:)) . f) (r []) variants+ _ -> r t++instance Show (Tree c) where+ showsPrec n t = case t of+ Grm header abstract concretes -> opar n . showString "Grm" . showChar ' ' . showsPrec 1 header . showChar ' ' . showsPrec 1 abstract . showChar ' ' . showsPrec 1 concretes . cpar n+ Hdr cid cids -> opar n . showString "Hdr" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 cids . cpar n+ Abs absdefs -> opar n . showString "Abs" . showChar ' ' . showsPrec 1 absdefs . cpar n+ Cnc cid cncdefs -> opar n . showString "Cnc" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 cncdefs . cpar n+ Fun cid type' exp -> opar n . showString "Fun" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 type' . showChar ' ' . showsPrec 1 exp . cpar n+ Lin cid term -> opar n . showString "Lin" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 term . cpar n+ Typ cids cid -> opar n . showString "Typ" . showChar ' ' . showsPrec 1 cids . showChar ' ' . showsPrec 1 cid . cpar n+ Tr atom exps -> opar n . showString "Tr" . showChar ' ' . showsPrec 1 atom . showChar ' ' . showsPrec 1 exps . cpar n+ AC cid -> opar n . showString "AC" . showChar ' ' . showsPrec 1 cid . cpar n+ AS str -> opar n . showString "AS" . showChar ' ' . showsPrec 1 str . cpar n+ AI n -> opar n . showString "AI" . showChar ' ' . showsPrec 1 n . cpar n+ AF d -> opar n . showString "AF" . showChar ' ' . showsPrec 1 d . cpar n+ AM -> showString "AM"+ R terms -> opar n . showString "R" . showChar ' ' . showsPrec 1 terms . cpar n+ P term0 term1 -> opar n . showString "P" . showChar ' ' . showsPrec 1 term0 . showChar ' ' . showsPrec 1 term1 . cpar n+ S terms -> opar n . showString "S" . showChar ' ' . showsPrec 1 terms . cpar n+ K tokn -> opar n . showString "K" . showChar ' ' . showsPrec 1 tokn . cpar n+ V n -> opar n . showString "V" . showChar ' ' . showsPrec 1 n . cpar n+ C n -> opar n . showString "C" . showChar ' ' . showsPrec 1 n . cpar n+ F cid -> opar n . showString "F" . showChar ' ' . showsPrec 1 cid . cpar n+ FV terms -> opar n . showString "FV" . showChar ' ' . showsPrec 1 terms . cpar n+ W str term -> opar n . showString "W" . showChar ' ' . showsPrec 1 str . showChar ' ' . showsPrec 1 term . cpar n+ RP term0 term1 -> opar n . showString "RP" . showChar ' ' . showsPrec 1 term0 . showChar ' ' . showsPrec 1 term1 . cpar n+ TM -> showString "TM"+ L cid term -> opar n . showString "L" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 term . cpar n+ BV cid -> opar n . showString "BV" . showChar ' ' . showsPrec 1 cid . cpar n+ KS str -> opar n . showString "KS" . showChar ' ' . showsPrec 1 str . cpar n+ KP strs variants -> opar n . showString "KP" . showChar ' ' . showsPrec 1 strs . showChar ' ' . showsPrec 1 variants . cpar n+ Var strs0 strs1 -> opar n . showString "Var" . showChar ' ' . showsPrec 1 strs0 . showChar ' ' . showsPrec 1 strs1 . cpar n+ CId str -> opar n . showString "CId" . showChar ' ' . showsPrec 1 str . cpar n+ where opar n = if n > 0 then showChar '(' else id+ cpar n = if n > 0 then showChar ')' else id++instance Eq (Tree c) where (==) = johnMajorEq++johnMajorEq :: Tree a -> Tree b -> Bool+johnMajorEq (Grm header abstract concretes) (Grm header_ abstract_ concretes_) = header == header_ && abstract == abstract_ && concretes == concretes_+johnMajorEq (Hdr cid cids) (Hdr cid_ cids_) = cid == cid_ && cids == cids_+johnMajorEq (Abs absdefs) (Abs absdefs_) = absdefs == absdefs_+johnMajorEq (Cnc cid cncdefs) (Cnc cid_ cncdefs_) = cid == cid_ && cncdefs == cncdefs_+johnMajorEq (Fun cid type' exp) (Fun cid_ type'_ exp_) = cid == cid_ && type' == type'_ && exp == exp_+johnMajorEq (Lin cid term) (Lin cid_ term_) = cid == cid_ && term == term_+johnMajorEq (Typ cids cid) (Typ cids_ cid_) = cids == cids_ && cid == cid_+johnMajorEq (Tr atom exps) (Tr atom_ exps_) = atom == atom_ && exps == exps_+johnMajorEq (AC cid) (AC cid_) = cid == cid_+johnMajorEq (AS str) (AS str_) = str == str_+johnMajorEq (AI n) (AI n_) = n == n_+johnMajorEq (AF d) (AF d_) = d == d_+johnMajorEq AM AM = True+johnMajorEq (R terms) (R terms_) = terms == terms_+johnMajorEq (P term0 term1) (P term0_ term1_) = term0 == term0_ && term1 == term1_+johnMajorEq (S terms) (S terms_) = terms == terms_+johnMajorEq (K tokn) (K tokn_) = tokn == tokn_+johnMajorEq (V n) (V n_) = n == n_+johnMajorEq (C n) (C n_) = n == n_+johnMajorEq (F cid) (F cid_) = cid == cid_+johnMajorEq (FV terms) (FV terms_) = terms == terms_+johnMajorEq (W str term) (W str_ term_) = str == str_ && term == term_+johnMajorEq (RP term0 term1) (RP term0_ term1_) = term0 == term0_ && term1 == term1_+johnMajorEq TM TM = True+johnMajorEq (L cid term) (L cid_ term_) = cid == cid_ && term == term_+johnMajorEq (BV cid) (BV cid_) = cid == cid_+johnMajorEq (KS str) (KS str_) = str == str_+johnMajorEq (KP strs variants) (KP strs_ variants_) = strs == strs_ && variants == variants_+johnMajorEq (Var strs0 strs1) (Var strs0_ strs1_) = strs0 == strs0_ && strs1 == strs1_+johnMajorEq (CId str) (CId str_) = str == str_+johnMajorEq _ _ = False++instance Ord (Tree c) where+ compare x y = compare (index x) (index y) `mappend` compareSame x y+index :: Tree c -> Int+index (Grm _ _ _) = 0+index (Hdr _ _) = 1+index (Abs _) = 2+index (Cnc _ _) = 3+index (Fun _ _ _) = 4+index (Lin _ _) = 5+index (Typ _ _) = 6+index (Tr _ _) = 7+index (AC _) = 8+index (AS _) = 9+index (AI _) = 10+index (AF _) = 11+index (AM ) = 12+index (R _) = 13+index (P _ _) = 14+index (S _) = 15+index (K _) = 16+index (V _) = 17+index (C _) = 18+index (F _) = 19+index (FV _) = 20+index (W _ _) = 21+index (RP _ _) = 22+index (TM ) = 23+index (L _ _) = 24+index (BV _) = 25+index (KS _) = 26+index (KP _ _) = 27+index (Var _ _) = 28+index (CId _) = 29+compareSame :: Tree c -> Tree c -> Ordering+compareSame (Grm header abstract concretes) (Grm header_ abstract_ concretes_) = mappend (compare header header_) (mappend (compare abstract abstract_) (compare concretes concretes_))+compareSame (Hdr cid cids) (Hdr cid_ cids_) = mappend (compare cid cid_) (compare cids cids_)+compareSame (Abs absdefs) (Abs absdefs_) = compare absdefs absdefs_+compareSame (Cnc cid cncdefs) (Cnc cid_ cncdefs_) = mappend (compare cid cid_) (compare cncdefs cncdefs_)+compareSame (Fun cid type' exp) (Fun cid_ type'_ exp_) = mappend (compare cid cid_) (mappend (compare type' type'_) (compare exp exp_))+compareSame (Lin cid term) (Lin cid_ term_) = mappend (compare cid cid_) (compare term term_)+compareSame (Typ cids cid) (Typ cids_ cid_) = mappend (compare cids cids_) (compare cid cid_)+compareSame (Tr atom exps) (Tr atom_ exps_) = mappend (compare atom atom_) (compare exps exps_)+compareSame (AC cid) (AC cid_) = compare cid cid_+compareSame (AS str) (AS str_) = compare str str_+compareSame (AI n) (AI n_) = compare n n_+compareSame (AF d) (AF d_) = compare d d_+compareSame AM AM = EQ+compareSame (R terms) (R terms_) = compare terms terms_+compareSame (P term0 term1) (P term0_ term1_) = mappend (compare term0 term0_) (compare term1 term1_)+compareSame (S terms) (S terms_) = compare terms terms_+compareSame (K tokn) (K tokn_) = compare tokn tokn_+compareSame (V n) (V n_) = compare n n_+compareSame (C n) (C n_) = compare n n_+compareSame (F cid) (F cid_) = compare cid cid_+compareSame (FV terms) (FV terms_) = compare terms terms_+compareSame (W str term) (W str_ term_) = mappend (compare str str_) (compare term term_)+compareSame (RP term0 term1) (RP term0_ term1_) = mappend (compare term0 term0_) (compare term1 term1_)+compareSame TM TM = EQ+compareSame (L cid term) (L cid_ term_) = mappend (compare cid cid_) (compare term term_)+compareSame (BV cid) (BV cid_) = compare cid cid_+compareSame (KS str) (KS str_) = compare str str_+compareSame (KP strs variants) (KP strs_ variants_) = mappend (compare strs strs_) (compare variants variants_)+compareSame (Var strs0 strs1) (Var strs0_ strs1_) = mappend (compare strs0 strs0_) (compare strs1 strs1_)+compareSame (CId str) (CId str_) = compare str str_+compareSame x y = error "BNFC error:" compareSame
@@ -0,0 +1,30 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+module GFCC.ComposOp (Compos(..),composOp,composOpM,composOpM_,composOpMonoid,+ composOpMPlus,composOpFold) where++import Control.Monad.Identity+import Data.Monoid++class Compos t where+ compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)+ -> (forall a. t a -> m (t a)) -> t c -> m (t c)++composOp :: Compos t => (forall a. t a -> t a) -> t c -> t c+composOp f = runIdentity . composOpM (Identity . f)++composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t c -> m (t c)+composOpM = compos return ap++composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t c -> m ()+composOpM_ = composOpFold (return ()) (>>)++composOpMonoid :: (Compos t, Monoid m) => (forall a. t a -> m) -> t c -> m+composOpMonoid = composOpFold mempty mappend++composOpMPlus :: (Compos t, MonadPlus m) => (forall a. t a -> m b) -> t c -> m b+composOpMPlus = composOpFold mzero mplus++composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b+composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)++newtype C b a = C { unC :: b }
@@ -0,0 +1,16 @@+-- BNF Converter: Error Monad+-- Copyright (C) 2004 Author: Aarne Ranta++-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.+module GFCC.ErrM where++-- the Error monad: like Maybe type with error msgs++data Err a = Ok a | Bad String+ deriving (Read, Show, Eq)++instance Monad Err where+ return = Ok+ fail = Bad+ Ok a >>= f = f a+ Bad s >>= f = Bad s
@@ -0,0 +1,340 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# LINE 3 "GFCC/Lex.x" #-}+{-# OPTIONS -fno-warn-incomplete-patterns #-}+module GFCC.Lex where++++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#else+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Char (ord)+import Data.Array.Base (unsafeAt)+#else+import Array+import Char (ord)+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif+alex_base :: AlexAddr+alex_base = AlexA# "\x01\x00\x00\x00\x39\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\xcb\xff\xff\xff\x0a\x00\x00\x00\xec\xff\xff\xff\x9a\x00\x00\x00\x6a\x01\x00\x00\x00\x00\x00\x00\x15\x01\x00\x00\xd3\x00\x00\x00\x35\x00\x00\x00\xe5\x00\x00\x00\x3f\x00\x00\x00\xf0\x00\x00\x00\x1b\x01\x00\x00\xb8\x01\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x03\x00\x0a\x00\x03\x00\x03\x00\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\xff\xff\x03\x00\x03\x00\x05\x00\xff\xff\x03\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x03\x00\x03\x00\xff\xff\x03\x00\xff\xff\x03\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x03\x00\x03\x00\x03\x00\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x04\x00\xff\xff\x03\x00\xff\xff\x07\x00\xff\xff\x02\x00\x0f\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x03\x00\x06\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0a\x00\x00\x00\x00\x00\xff\xff\x07\x00\x0a\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\xff\xff\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x11\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0b\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x08\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x10\x00\x00\x00\x00\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++alex_check :: AlexAddr+alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7c\x00\x3e\x00\x5d\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x20\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd7\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x22\x00\xff\xff\xff\xff\xf7\x00\x5f\x00\x27\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\x65\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++alex_deflt :: AlexAddr+alex_deflt = AlexA# "\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++alex_accept = listArray (0::Int,17) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_4))],[],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[],[],[]]+{-# LINE 33 "GFCC/Lex.x" #-}++tok f p s = f p s++share :: String -> String+share = id++data Tok =+ TS !String -- reserved words and symbols+ | TL !String -- string literals+ | TI !String -- integer literals+ | TV !String -- identifiers+ | TD !String -- double precision float literals+ | TC !String -- character literals+ | T_CId !String++ deriving (Eq,Show,Ord)++data Token = + PT Posn Tok+ | Err Posn+ deriving (Eq,Show,Ord)++tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l+tokenPos _ = "end of file"++posLineCol (Pn _ l c) = (l,c)+mkPosToken t@(PT p _) = (posLineCol p, prToken t)++prToken t = case t of+ PT _ (TS s) -> s+ PT _ (TI s) -> s+ PT _ (TV s) -> s+ PT _ (TD s) -> s+ PT _ (TC s) -> s+ PT _ (T_CId s) -> s++ _ -> show t++data BTree = N | B String Tok BTree BTree deriving (Show)++eitherResIdent :: (String -> Tok) -> String -> Tok+eitherResIdent tv s = treeFind resWords+ where+ treeFind N = tv s+ treeFind (B a t left right) | s < a = treeFind left+ | s > a = treeFind right+ | s == a = t++resWords = b "grammar" (b "concrete" (b "abstract" N N) N) (b "pre" N N)+ where b s = B s (TS s)++unescapeInitTail :: String -> String+unescapeInitTail = unesc . tail where+ unesc s = case s of+ '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs+ '\\':'n':cs -> '\n' : unesc cs+ '\\':'t':cs -> '\t' : unesc cs+ '"':[] -> []+ c:cs -> c : unesc cs+ _ -> []++-------------------------------------------------------------------+-- Alex wrapper code.+-- A modified "posn" wrapper.+-------------------------------------------------------------------++data Posn = Pn !Int !Int !Int+ deriving (Eq, Show,Ord)++alexStartPos :: Posn+alexStartPos = Pn 0 1 1++alexMove :: Posn -> Char -> Posn+alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1+alexMove (Pn a l c) _ = Pn (a+1) l (c+1)++type AlexInput = (Posn, -- current position,+ Char, -- previous char+ String) -- current input string++tokens :: String -> [Token]+tokens str = go (alexStartPos, '\n', str)+ where+ go :: (Posn, Char, String) -> [Token]+ go inp@(pos, _, str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError (pos, _, _) -> [Err pos]+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act pos (take len str) : (go inp')++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p, c, []) = Nothing+alexGetChar (p, _, (c:s)) =+ let p' = alexMove p c+ in p' `seq` Just (c, (p', c, s))++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p, c, s) = c++alex_action_1 = tok (\p s -> PT p (TS $ share s)) +alex_action_2 = tok (\p s -> PT p (eitherResIdent (T_CId . share) s)) +alex_action_3 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_4 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_5 = tok (\p s -> PT p (TI $ share s)) +alex_action_6 = tok (\p s -> PT p (TD $ share s)) +{-# LINE 1 "GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++{-# LINE 35 "GenericTemplate.hs" #-}++{-# LINE 45 "GenericTemplate.hs" #-}+++data AlexAddr = AlexA# Addr#++#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+ narrow16Int# i+ where+ i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+ high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ low = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 2#+#else+ indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN+ narrow32Int# i+ where+ i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+ (b2 `uncheckedShiftL#` 16#) `or#`+ (b1 `uncheckedShiftL#` 8#) `or#` b0)+ b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+ b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+ b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ b0 = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 4#+#else+ indexInt32OffAddr# arr off+#endif++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+ = AlexEOF+ | AlexError !AlexInput+ | AlexSkip !AlexInput !Int+ | AlexToken !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act)+alexScan input (I# (sc))+ = alexScanUser undefined input (I# (sc))++alexScanUser user input (I# (sc))+ = case alex_scan_tkn user input 0# input sc AlexNone of+ (AlexNone, input') ->+ case alexGetChar input of+ Nothing -> ++++ AlexEOF+ Just _ ->++++ AlexError input'++ (AlexLastSkip input len, _) ->++++ AlexSkip input len++ (AlexLastAcc k input len, _) ->++++ AlexToken input len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+ input `seq` -- strict in the input+ case s of + -1# -> (last_acc, input)+ _ -> alex_scan_tkn' user orig_input len input s last_acc++alex_scan_tkn' user orig_input len input s last_acc =+ let + new_acc = check_accs (alex_accept `quickIndex` (I# (s)))+ in+ new_acc `seq`+ case alexGetChar input of+ Nothing -> (new_acc, input)+ Just (c, new_input) -> ++++ let+ base = alexIndexInt32OffAddr alex_base s+ (I# (ord_c)) = ord c+ offset = (base +# ord_c)+ check = alexIndexInt16OffAddr alex_check offset+ + new_s = if (offset >=# 0#) && (check ==# ord_c)+ then alexIndexInt16OffAddr alex_table offset+ else alexIndexInt16OffAddr alex_deflt s+ in+ alex_scan_tkn user orig_input (len +# 1#) new_input new_s new_acc++ where+ check_accs [] = last_acc+ check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))+ check_accs (AlexAccPred a pred : rest)+ | pred user orig_input (I# (len)) input+ = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkipPred pred : rest)+ | pred user orig_input (I# (len)) input+ = AlexLastSkip input (I# (len))+ check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+ = AlexNone+ | AlexLastAcc a !AlexInput !Int+ | AlexLastSkip !AlexInput !Int++data AlexAcc a user+ = AlexAcc a+ | AlexAccSkip+ | AlexAccPred a (AlexAccPred user)+ | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+ = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of+ (AlexNone, _) -> False+ _ -> True+ -- TODO: there's no need to find the longest+ -- match when checking the right context, just+ -- the first match will do.++-- used by wrappers+iUnbox (I# (i)) = i
@@ -0,0 +1,135 @@+-- -*- haskell -*-+-- This Alex file was machine-generated by the BNF converter+{+{-# OPTIONS -fno-warn-incomplete-patterns #-}+module GFCC.Lex where+++}+++$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME+$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME+$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME+$d = [0-9] -- digit+$i = [$l $d _ '] -- identifier character+$u = [\0-\255] -- universal: any character++@rsyms = -- symbols and non-identifier-like reserved words+ \; | \( | \) | \{ | \} | \: | \= | \- \> | \? | \[ | \] | \! | \$ | \[ \| | \| \] | \+ | \@ | \# | \/ | \,++:-++$white+ ;+@rsyms { tok (\p s -> PT p (TS $ share s)) }+(\_ | $l)($l | $d | \' | \_)* { tok (\p s -> PT p (eitherResIdent (T_CId . share) s)) }++$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }++$d+ { tok (\p s -> PT p (TI $ share s)) }+$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }++{++tok f p s = f p s++share :: String -> String+share = id++data Tok =+ TS !String -- reserved words and symbols+ | TL !String -- string literals+ | TI !String -- integer literals+ | TV !String -- identifiers+ | TD !String -- double precision float literals+ | TC !String -- character literals+ | T_CId !String++ deriving (Eq,Show,Ord)++data Token = + PT Posn Tok+ | Err Posn+ deriving (Eq,Show,Ord)++tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l+tokenPos _ = "end of file"++posLineCol (Pn _ l c) = (l,c)+mkPosToken t@(PT p _) = (posLineCol p, prToken t)++prToken t = case t of+ PT _ (TS s) -> s+ PT _ (TI s) -> s+ PT _ (TV s) -> s+ PT _ (TD s) -> s+ PT _ (TC s) -> s+ PT _ (T_CId s) -> s++ _ -> show t++data BTree = N | B String Tok BTree BTree deriving (Show)++eitherResIdent :: (String -> Tok) -> String -> Tok+eitherResIdent tv s = treeFind resWords+ where+ treeFind N = tv s+ treeFind (B a t left right) | s < a = treeFind left+ | s > a = treeFind right+ | s == a = t++resWords = b "grammar" (b "concrete" (b "abstract" N N) N) (b "pre" N N)+ where b s = B s (TS s)++unescapeInitTail :: String -> String+unescapeInitTail = unesc . tail where+ unesc s = case s of+ '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs+ '\\':'n':cs -> '\n' : unesc cs+ '\\':'t':cs -> '\t' : unesc cs+ '"':[] -> []+ c:cs -> c : unesc cs+ _ -> []++-------------------------------------------------------------------+-- Alex wrapper code.+-- A modified "posn" wrapper.+-------------------------------------------------------------------++data Posn = Pn !Int !Int !Int+ deriving (Eq, Show,Ord)++alexStartPos :: Posn+alexStartPos = Pn 0 1 1++alexMove :: Posn -> Char -> Posn+alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1+alexMove (Pn a l c) _ = Pn (a+1) l (c+1)++type AlexInput = (Posn, -- current position,+ Char, -- previous char+ String) -- current input string++tokens :: String -> [Token]+tokens str = go (alexStartPos, '\n', str)+ where+ go :: (Posn, Char, String) -> [Token]+ go inp@(pos, _, str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError (pos, _, _) -> [Err pos]+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act pos (take len str) : (go inp')++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p, c, []) = Nothing+alexGetChar (p, _, (c:s)) =+ let p' = alexMove p c+ in p' `seq` Just (c, (p', c, s))++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p, c, s) = c+}
@@ -0,0 +1,1096 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}+module GFCC.Par where+import GFCC.Abs+import GFCC.Lex+import GFCC.ErrM+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+#else+import Array+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif++-- parser produced by Happy Version 1.16++newtype HappyAbsSyn = HappyAbsSyn (() -> ())+happyIn23 :: (String) -> (HappyAbsSyn )+happyIn23 x = unsafeCoerce# x+{-# INLINE happyIn23 #-}+happyOut23 :: (HappyAbsSyn ) -> (String)+happyOut23 x = unsafeCoerce# x+{-# INLINE happyOut23 #-}+happyIn24 :: (Integer) -> (HappyAbsSyn )+happyIn24 x = unsafeCoerce# x+{-# INLINE happyIn24 #-}+happyOut24 :: (HappyAbsSyn ) -> (Integer)+happyOut24 x = unsafeCoerce# x+{-# INLINE happyOut24 #-}+happyIn25 :: (Double) -> (HappyAbsSyn )+happyIn25 x = unsafeCoerce# x+{-# INLINE happyIn25 #-}+happyOut25 :: (HappyAbsSyn ) -> (Double)+happyOut25 x = unsafeCoerce# x+{-# INLINE happyOut25 #-}+happyIn26 :: (CId) -> (HappyAbsSyn )+happyIn26 x = unsafeCoerce# x+{-# INLINE happyIn26 #-}+happyOut26 :: (HappyAbsSyn ) -> (CId)+happyOut26 x = unsafeCoerce# x+{-# INLINE happyOut26 #-}+happyIn27 :: (Grammar) -> (HappyAbsSyn )+happyIn27 x = unsafeCoerce# x+{-# INLINE happyIn27 #-}+happyOut27 :: (HappyAbsSyn ) -> (Grammar)+happyOut27 x = unsafeCoerce# x+{-# INLINE happyOut27 #-}+happyIn28 :: (Header) -> (HappyAbsSyn )+happyIn28 x = unsafeCoerce# x+{-# INLINE happyIn28 #-}+happyOut28 :: (HappyAbsSyn ) -> (Header)+happyOut28 x = unsafeCoerce# x+{-# INLINE happyOut28 #-}+happyIn29 :: (Abstract) -> (HappyAbsSyn )+happyIn29 x = unsafeCoerce# x+{-# INLINE happyIn29 #-}+happyOut29 :: (HappyAbsSyn ) -> (Abstract)+happyOut29 x = unsafeCoerce# x+{-# INLINE happyOut29 #-}+happyIn30 :: (Concrete) -> (HappyAbsSyn )+happyIn30 x = unsafeCoerce# x+{-# INLINE happyIn30 #-}+happyOut30 :: (HappyAbsSyn ) -> (Concrete)+happyOut30 x = unsafeCoerce# x+{-# INLINE happyOut30 #-}+happyIn31 :: (AbsDef) -> (HappyAbsSyn )+happyIn31 x = unsafeCoerce# x+{-# INLINE happyIn31 #-}+happyOut31 :: (HappyAbsSyn ) -> (AbsDef)+happyOut31 x = unsafeCoerce# x+{-# INLINE happyOut31 #-}+happyIn32 :: (CncDef) -> (HappyAbsSyn )+happyIn32 x = unsafeCoerce# x+{-# INLINE happyIn32 #-}+happyOut32 :: (HappyAbsSyn ) -> (CncDef)+happyOut32 x = unsafeCoerce# x+{-# INLINE happyOut32 #-}+happyIn33 :: (Type) -> (HappyAbsSyn )+happyIn33 x = unsafeCoerce# x+{-# INLINE happyIn33 #-}+happyOut33 :: (HappyAbsSyn ) -> (Type)+happyOut33 x = unsafeCoerce# x+{-# INLINE happyOut33 #-}+happyIn34 :: (Exp) -> (HappyAbsSyn )+happyIn34 x = unsafeCoerce# x+{-# INLINE happyIn34 #-}+happyOut34 :: (HappyAbsSyn ) -> (Exp)+happyOut34 x = unsafeCoerce# x+{-# INLINE happyOut34 #-}+happyIn35 :: (Atom) -> (HappyAbsSyn )+happyIn35 x = unsafeCoerce# x+{-# INLINE happyIn35 #-}+happyOut35 :: (HappyAbsSyn ) -> (Atom)+happyOut35 x = unsafeCoerce# x+{-# INLINE happyOut35 #-}+happyIn36 :: (Term) -> (HappyAbsSyn )+happyIn36 x = unsafeCoerce# x+{-# INLINE happyIn36 #-}+happyOut36 :: (HappyAbsSyn ) -> (Term)+happyOut36 x = unsafeCoerce# x+{-# INLINE happyOut36 #-}+happyIn37 :: (Tokn) -> (HappyAbsSyn )+happyIn37 x = unsafeCoerce# x+{-# INLINE happyIn37 #-}+happyOut37 :: (HappyAbsSyn ) -> (Tokn)+happyOut37 x = unsafeCoerce# x+{-# INLINE happyOut37 #-}+happyIn38 :: (Variant) -> (HappyAbsSyn )+happyIn38 x = unsafeCoerce# x+{-# INLINE happyIn38 #-}+happyOut38 :: (HappyAbsSyn ) -> (Variant)+happyOut38 x = unsafeCoerce# x+{-# INLINE happyOut38 #-}+happyIn39 :: ([Concrete]) -> (HappyAbsSyn )+happyIn39 x = unsafeCoerce# x+{-# INLINE happyIn39 #-}+happyOut39 :: (HappyAbsSyn ) -> ([Concrete])+happyOut39 x = unsafeCoerce# x+{-# INLINE happyOut39 #-}+happyIn40 :: ([AbsDef]) -> (HappyAbsSyn )+happyIn40 x = unsafeCoerce# x+{-# INLINE happyIn40 #-}+happyOut40 :: (HappyAbsSyn ) -> ([AbsDef])+happyOut40 x = unsafeCoerce# x+{-# INLINE happyOut40 #-}+happyIn41 :: ([CncDef]) -> (HappyAbsSyn )+happyIn41 x = unsafeCoerce# x+{-# INLINE happyIn41 #-}+happyOut41 :: (HappyAbsSyn ) -> ([CncDef])+happyOut41 x = unsafeCoerce# x+{-# INLINE happyOut41 #-}+happyIn42 :: ([CId]) -> (HappyAbsSyn )+happyIn42 x = unsafeCoerce# x+{-# INLINE happyIn42 #-}+happyOut42 :: (HappyAbsSyn ) -> ([CId])+happyOut42 x = unsafeCoerce# x+{-# INLINE happyOut42 #-}+happyIn43 :: ([Term]) -> (HappyAbsSyn )+happyIn43 x = unsafeCoerce# x+{-# INLINE happyIn43 #-}+happyOut43 :: (HappyAbsSyn ) -> ([Term])+happyOut43 x = unsafeCoerce# x+{-# INLINE happyOut43 #-}+happyIn44 :: ([Exp]) -> (HappyAbsSyn )+happyIn44 x = unsafeCoerce# x+{-# INLINE happyIn44 #-}+happyOut44 :: (HappyAbsSyn ) -> ([Exp])+happyOut44 x = unsafeCoerce# x+{-# INLINE happyOut44 #-}+happyIn45 :: ([String]) -> (HappyAbsSyn )+happyIn45 x = unsafeCoerce# x+{-# INLINE happyIn45 #-}+happyOut45 :: (HappyAbsSyn ) -> ([String])+happyOut45 x = unsafeCoerce# x+{-# INLINE happyOut45 #-}+happyIn46 :: ([Variant]) -> (HappyAbsSyn )+happyIn46 x = unsafeCoerce# x+{-# INLINE happyIn46 #-}+happyOut46 :: (HappyAbsSyn ) -> ([Variant])+happyOut46 x = unsafeCoerce# x+{-# INLINE happyOut46 #-}+happyInTok :: Token -> (HappyAbsSyn )+happyInTok x = unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> Token+happyOutTok x = unsafeCoerce# x+{-# INLINE happyOutTok #-}++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\xff\x00\xff\x00\xfc\x00\xfe\x00\xfb\x00\xfb\x00\xfb\x00\x37\x00\x4d\x00\x29\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x29\x00\x00\x00\x00\x00\xfa\x00\xf9\x00\x00\x00\xf8\x00\xa8\x00\xf7\x00\xae\x00\xff\xff\x00\x00\x00\x00\x00\x00\xf6\x00\x00\x00\xf5\x00\x29\x00\x00\x00\x15\x00\xf3\x00\x29\x00\xf4\x00\x00\x00\x00\x00\xf2\x00\xf1\x00\xad\x00\xad\x00\x76\x00\xf1\x00\xf1\x00\xf0\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x4d\x00\xe9\x00\xef\x00\xeb\x00\xe3\x00\xee\x00\xe2\x00\xe2\x00\xe8\x00\xe1\x00\xed\x00\xe0\x00\xd4\x00\xd1\x00\xec\x00\xd3\x00\xea\x00\x00\x00\xe7\x00\xce\x00\x29\x00\xce\x00\x00\x00\x00\x00\xe6\x00\xe5\x00\xe4\x00\xc8\x00\x00\x00\xdf\x00\x00\x00\xde\x00\xd2\x00\xdb\x00\xbc\x00\xdd\x00\x29\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x00\x00\xc6\x00\x00\x00\x00\x00\x29\x00\x29\x00\x29\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\x23\x00\x00\x00\x00\x00\xda\x00\x00\x00\x05\x00\xc2\x00\xdc\x00\x00\x00\xd9\x00\x00\x00\x04\x00\x37\x00\x00\x00\xa7\x00\xd8\x00\xd7\x00\xd6\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x00\x00\x00\x00\x00\x00\x00\xc0\x00\xca\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x95\x00\xcf\x00\xcd\x00\xcb\x00\x54\x00\xa6\x00\x09\x00\xb2\x00\xc3\x00\x92\x00\x41\x00\xf8\xff\xc1\x00\xbd\x00\xaa\x00\x27\x00\x61\x00\x96\x00\xb4\x00\x87\x00\x00\x00\x00\x00\x00\x00\xbf\x00\x00\x00\xbf\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x4b\x00\xa9\x00\x47\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x0a\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x5f\x00\x00\x00\x01\x00\x8e\x00\x60\x00\x38\x00\x44\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x33\x00\x70\x00\x00\x00\x11\x00\x00\x00\x00\x00\x8a\x00\x7b\x00\x77\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x34\x00\x0a\x00\x21\x00\x00\x00\x20\x00\x00\x00\x00\x00\x7a\x00\xa1\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\xff\x00\x00\x00\x00\x00\x00\x00\x00\xbb\xff\xc9\xff\xc7\xff\xc5\xff\xc3\xff\xc0\xff\xbd\xff\xbb\xff\xbb\xff\x00\x00\xeb\xff\xb8\xff\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xff\xd4\xff\xd3\xff\xbf\xff\xd6\xff\x00\x00\xc0\xff\xcf\xff\xc0\xff\x00\x00\xc0\xff\x00\x00\xea\xff\xe8\xff\xc2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\xff\xdc\xff\xdb\xff\xde\xff\x00\x00\xda\xff\xe9\xff\x00\x00\xdf\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\xff\x00\x00\xc3\xff\x00\x00\x00\x00\xbd\xff\xbb\xff\x00\x00\x00\x00\x00\x00\xc3\xff\xcd\xff\x00\x00\xd5\xff\x00\x00\xcc\xff\xd3\xff\xbf\xff\x00\x00\xc0\xff\xbc\xff\xba\xff\xbb\xff\xb9\xff\xb7\xff\xca\xff\xbe\xff\xd7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\xd2\xff\xc1\xff\xc4\xff\xc6\xff\xc8\xff\x00\x00\x00\x00\xe1\xff\xe2\xff\x00\x00\xc5\xff\x00\x00\xc3\xff\x00\x00\xc9\xff\x00\x00\xe5\xff\x00\x00\x00\x00\xe0\xff\xb9\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd8\xff\xd0\xff\xce\xff\xd1\xff\x00\x00\xe3\xff\xe4\xff\xe6\xff\xe7\xff\x00\x00\xcb\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x02\x00\x00\x00\x01\x00\x03\x00\x03\x00\x0a\x00\x0f\x00\x09\x00\x05\x00\x05\x00\x0a\x00\x03\x00\x03\x00\x16\x00\x0d\x00\x0e\x00\x00\x00\x08\x00\x0a\x00\x13\x00\x19\x00\x14\x00\x02\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x13\x00\x1e\x00\x09\x00\x0a\x00\x1c\x00\x1c\x00\x0d\x00\x0e\x00\x03\x00\x02\x00\x03\x00\x12\x00\x03\x00\x07\x00\x03\x00\x02\x00\x09\x00\x18\x00\x19\x00\x1a\x00\x10\x00\x1c\x00\x09\x00\x0a\x00\x13\x00\x0a\x00\x0d\x00\x0e\x00\x13\x00\x02\x00\x13\x00\x12\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x09\x00\x00\x00\x19\x00\x1a\x00\x19\x00\x1c\x00\x12\x00\x00\x00\x01\x00\x16\x00\x03\x00\x00\x00\x01\x00\x15\x00\x03\x00\x0e\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x0d\x00\x0e\x00\x09\x00\x03\x00\x0d\x00\x0e\x00\x16\x00\x14\x00\x08\x00\x00\x00\x01\x00\x14\x00\x03\x00\x00\x00\x01\x00\x03\x00\x03\x00\x0f\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x0d\x00\x0e\x00\x11\x00\x14\x00\x06\x00\x00\x00\x01\x00\x14\x00\x03\x00\x00\x00\x01\x00\x07\x00\x03\x00\x00\x00\x01\x00\x03\x00\x03\x00\x0f\x00\x0d\x00\x0e\x00\x03\x00\x09\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x0d\x00\x0e\x00\x00\x00\x01\x00\x16\x00\x03\x00\x00\x00\x01\x00\x03\x00\x03\x00\x00\x00\x01\x00\x1e\x00\x03\x00\x0f\x00\x0d\x00\x0e\x00\x04\x00\x05\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x0d\x00\x0e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x01\x00\x15\x00\x0b\x00\x0c\x00\x03\x00\x09\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x13\x00\x13\x00\x12\x00\x0b\x00\x0c\x00\x00\x00\x19\x00\x19\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x19\x00\x0c\x00\x1c\x00\x16\x00\x1e\x00\x1e\x00\x11\x00\x11\x00\x0c\x00\x14\x00\x10\x00\x07\x00\x06\x00\x05\x00\x0b\x00\x16\x00\x0b\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x01\x00\x1c\x00\x19\x00\x03\x00\x07\x00\x10\x00\x08\x00\x1c\x00\x01\x00\x01\x00\x01\x00\x15\x00\x0b\x00\x1c\x00\x04\x00\x02\x00\x01\x00\x0f\x00\x1e\x00\x1c\x00\x04\x00\x07\x00\xff\xff\x06\x00\xff\xff\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1e\x00\xff\xff\xff\xff\x1c\x00\xff\xff\x14\x00\x1e\x00\x18\x00\xff\xff\x14\x00\xff\xff\x14\x00\x1a\x00\xff\xff\x1e\x00\x1c\x00\x15\x00\x19\x00\x1e\x00\x16\x00\x1e\x00\x17\x00\x1c\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x3c\x00\x1b\x00\x1c\x00\x29\x00\x1d\x00\x82\x00\x2e\x00\x38\x00\x8d\x00\x7e\x00\x76\x00\x29\x00\x40\x00\x17\x00\x1e\x00\x1f\x00\x61\x00\x54\x00\x3c\x00\x3d\x00\x16\x00\x66\x00\x22\x00\x16\x00\x28\x00\x39\x00\x29\x00\x3d\x00\xff\xff\x23\x00\x24\x00\x29\x00\x29\x00\x25\x00\x26\x00\x29\x00\x3c\x00\x81\x00\x27\x00\x29\x00\x53\x00\x29\x00\x22\x00\x38\x00\x53\x00\x16\x00\x28\x00\x8e\x00\x29\x00\x23\x00\x24\x00\x7c\x00\x31\x00\x25\x00\x26\x00\x6e\x00\x3c\x00\x2a\x00\x27\x00\x16\x00\x28\x00\x39\x00\x29\x00\x38\x00\x1b\x00\x16\x00\x28\x00\x16\x00\x29\x00\x7e\x00\x1b\x00\x1c\x00\x65\x00\x1d\x00\x1b\x00\x1c\x00\x73\x00\x1d\x00\x2f\x00\x16\x00\x28\x00\x39\x00\x29\x00\x1e\x00\x1f\x00\x38\x00\x40\x00\x1e\x00\x1f\x00\x72\x00\x58\x00\x41\x00\x5b\x00\x1c\x00\x5a\x00\x5c\x00\x1b\x00\x1c\x00\x74\x00\x1d\x00\x16\x00\x16\x00\x28\x00\x39\x00\x29\x00\x5d\x00\x1f\x00\x17\x00\x8a\x00\x1e\x00\x1f\x00\x78\x00\x5e\x00\x7a\x00\x1b\x00\x1c\x00\x20\x00\x1d\x00\x1b\x00\x1c\x00\x53\x00\x1d\x00\x1b\x00\x1c\x00\x3e\x00\x1d\x00\x16\x00\x82\x00\x1f\x00\x4b\x00\x55\x00\x83\x00\x1f\x00\x17\x00\x64\x00\x84\x00\x1f\x00\x1b\x00\x1c\x00\x44\x00\x1d\x00\x1b\x00\x1c\x00\x4d\x00\x1d\x00\x1b\x00\x1c\x00\xff\xff\x1d\x00\x16\x00\x85\x00\x1f\x00\x48\x00\x49\x00\x75\x00\x1f\x00\x17\x00\x18\x00\x31\x00\x1f\x00\x32\x00\x33\x00\x34\x00\x35\x00\x32\x00\x33\x00\x34\x00\x35\x00\x3e\x00\x59\x00\x1a\x00\x8b\x00\x3a\x00\x57\x00\x3f\x00\x60\x00\x3a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x32\x00\x33\x00\x34\x00\x35\x00\xbb\xff\x63\x00\x2b\x00\x39\x00\x3a\x00\x61\x00\xbb\xff\x16\x00\x51\x00\x32\x00\x33\x00\x34\x00\x35\x00\x16\x00\x69\x00\x29\x00\x19\x00\xff\xff\xff\xff\x6a\x00\x2c\x00\x36\x00\x60\x00\x2d\x00\x42\x00\x44\x00\x46\x00\x91\x00\x44\x00\x90\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8e\x00\x7c\x00\x29\x00\x16\x00\x68\x00\x80\x00\x6c\x00\x6b\x00\x29\x00\x70\x00\x71\x00\x72\x00\x46\x00\x6d\x00\x29\x00\x78\x00\x7a\x00\x4b\x00\x6e\x00\xff\xff\x29\x00\x4d\x00\x50\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x29\x00\x00\x00\x57\x00\xff\xff\x53\x00\x00\x00\x60\x00\x00\x00\x64\x00\x28\x00\x00\x00\xff\xff\x29\x00\x46\x00\x16\x00\xff\xff\x44\x00\xff\xff\x48\x00\x29\x00\xb9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = array (20, 72) [+ (20 , happyReduce_20),+ (21 , happyReduce_21),+ (22 , happyReduce_22),+ (23 , happyReduce_23),+ (24 , happyReduce_24),+ (25 , happyReduce_25),+ (26 , happyReduce_26),+ (27 , happyReduce_27),+ (28 , happyReduce_28),+ (29 , happyReduce_29),+ (30 , happyReduce_30),+ (31 , happyReduce_31),+ (32 , happyReduce_32),+ (33 , happyReduce_33),+ (34 , happyReduce_34),+ (35 , happyReduce_35),+ (36 , happyReduce_36),+ (37 , happyReduce_37),+ (38 , happyReduce_38),+ (39 , happyReduce_39),+ (40 , happyReduce_40),+ (41 , happyReduce_41),+ (42 , happyReduce_42),+ (43 , happyReduce_43),+ (44 , happyReduce_44),+ (45 , happyReduce_45),+ (46 , happyReduce_46),+ (47 , happyReduce_47),+ (48 , happyReduce_48),+ (49 , happyReduce_49),+ (50 , happyReduce_50),+ (51 , happyReduce_51),+ (52 , happyReduce_52),+ (53 , happyReduce_53),+ (54 , happyReduce_54),+ (55 , happyReduce_55),+ (56 , happyReduce_56),+ (57 , happyReduce_57),+ (58 , happyReduce_58),+ (59 , happyReduce_59),+ (60 , happyReduce_60),+ (61 , happyReduce_61),+ (62 , happyReduce_62),+ (63 , happyReduce_63),+ (64 , happyReduce_64),+ (65 , happyReduce_65),+ (66 , happyReduce_66),+ (67 , happyReduce_67),+ (68 , happyReduce_68),+ (69 , happyReduce_69),+ (70 , happyReduce_70),+ (71 , happyReduce_71),+ (72 , happyReduce_72)+ ]++happy_n_terms = 31 :: Int+happy_n_nonterms = 24 :: Int++happyReduce_20 = happySpecReduce_1 0# happyReduction_20+happyReduction_20 happy_x_1+ = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> + happyIn23+ (happy_var_1+ )}++happyReduce_21 = happySpecReduce_1 1# happyReduction_21+happyReduction_21 happy_x_1+ = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> + happyIn24+ ((read happy_var_1) :: Integer+ )}++happyReduce_22 = happySpecReduce_1 2# happyReduction_22+happyReduction_22 happy_x_1+ = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> + happyIn25+ ((read happy_var_1) :: Double+ )}++happyReduce_23 = happySpecReduce_1 3# happyReduction_23+happyReduction_23 happy_x_1+ = case happyOutTok happy_x_1 of { (PT _ (T_CId happy_var_1)) -> + happyIn26+ (CId (happy_var_1)+ )}++happyReduce_24 = happyReduce 5# 4# happyReduction_24+happyReduction_24 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut28 happy_x_1 of { happy_var_1 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + case happyOut39 happy_x_5 of { happy_var_5 -> + happyIn27+ (Grm happy_var_1 happy_var_3 (reverse happy_var_5)+ ) `HappyStk` happyRest}}}++happyReduce_25 = happyReduce 5# 5# happyReduction_25+happyReduction_25 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut42 happy_x_4 of { happy_var_4 -> + happyIn28+ (Hdr happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_26 = happyReduce 4# 6# happyReduction_26+happyReduction_26 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut40 happy_x_3 of { happy_var_3 -> + happyIn29+ (Abs (reverse happy_var_3)+ ) `HappyStk` happyRest}++happyReduce_27 = happyReduce 5# 7# happyReduction_27+happyReduction_27 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut41 happy_x_4 of { happy_var_4 -> + happyIn30+ (Cnc happy_var_2 (reverse happy_var_4)+ ) `HappyStk` happyRest}}++happyReduce_28 = happyReduce 5# 8# happyReduction_28+happyReduction_28 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut33 happy_x_3 of { happy_var_3 -> + case happyOut34 happy_x_5 of { happy_var_5 -> + happyIn31+ (Fun happy_var_1 happy_var_3 happy_var_5+ ) `HappyStk` happyRest}}}++happyReduce_29 = happySpecReduce_3 9# happyReduction_29+happyReduction_29 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn32+ (Lin happy_var_1 happy_var_3+ )}}++happyReduce_30 = happySpecReduce_3 10# happyReduction_30+happyReduction_30 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut42 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn33+ (Typ happy_var_1 happy_var_3+ )}}++happyReduce_31 = happyReduce 4# 11# happyReduction_31+happyReduction_31 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut35 happy_x_2 of { happy_var_2 -> + case happyOut44 happy_x_3 of { happy_var_3 -> + happyIn34+ (Tr happy_var_2 (reverse happy_var_3)+ ) `HappyStk` happyRest}}++happyReduce_32 = happySpecReduce_1 11# happyReduction_32+happyReduction_32 happy_x_1+ = case happyOut35 happy_x_1 of { happy_var_1 -> + happyIn34+ (trA_ happy_var_1+ )}++happyReduce_33 = happySpecReduce_1 12# happyReduction_33+happyReduction_33 happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn35+ (AC happy_var_1+ )}++happyReduce_34 = happySpecReduce_1 12# happyReduction_34+happyReduction_34 happy_x_1+ = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn35+ (AS happy_var_1+ )}++happyReduce_35 = happySpecReduce_1 12# happyReduction_35+happyReduction_35 happy_x_1+ = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn35+ (AI happy_var_1+ )}++happyReduce_36 = happySpecReduce_1 12# happyReduction_36+happyReduction_36 happy_x_1+ = case happyOut25 happy_x_1 of { happy_var_1 -> + happyIn35+ (AF happy_var_1+ )}++happyReduce_37 = happySpecReduce_1 12# happyReduction_37+happyReduction_37 happy_x_1+ = happyIn35+ (AM+ )++happyReduce_38 = happySpecReduce_3 13# happyReduction_38+happyReduction_38 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut43 happy_x_2 of { happy_var_2 -> + happyIn36+ (R happy_var_2+ )}++happyReduce_39 = happyReduce 5# 13# happyReduction_39+happyReduction_39 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut36 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36+ (P happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_40 = happySpecReduce_3 13# happyReduction_40+happyReduction_40 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut43 happy_x_2 of { happy_var_2 -> + happyIn36+ (S happy_var_2+ )}++happyReduce_41 = happySpecReduce_1 13# happyReduction_41+happyReduction_41 happy_x_1+ = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn36+ (K happy_var_1+ )}++happyReduce_42 = happySpecReduce_2 13# happyReduction_42+happyReduction_42 happy_x_2+ happy_x_1+ = case happyOut24 happy_x_2 of { happy_var_2 -> + happyIn36+ (V happy_var_2+ )}++happyReduce_43 = happySpecReduce_1 13# happyReduction_43+happyReduction_43 happy_x_1+ = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn36+ (C happy_var_1+ )}++happyReduce_44 = happySpecReduce_1 13# happyReduction_44+happyReduction_44 happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn36+ (F happy_var_1+ )}++happyReduce_45 = happySpecReduce_3 13# happyReduction_45+happyReduction_45 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut43 happy_x_2 of { happy_var_2 -> + happyIn36+ (FV happy_var_2+ )}++happyReduce_46 = happyReduce 5# 13# happyReduction_46+happyReduction_46 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut23 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36+ (W happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_47 = happyReduce 5# 13# happyReduction_47+happyReduction_47 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut36 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36+ (RP happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_48 = happySpecReduce_1 13# happyReduction_48+happyReduction_48 happy_x_1+ = happyIn36+ (TM+ )++happyReduce_49 = happyReduce 5# 13# happyReduction_49+happyReduction_49 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36+ (L happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_50 = happySpecReduce_2 13# happyReduction_50+happyReduction_50 happy_x_2+ happy_x_1+ = case happyOut26 happy_x_2 of { happy_var_2 -> + happyIn36+ (BV happy_var_2+ )}++happyReduce_51 = happySpecReduce_1 14# happyReduction_51+happyReduction_51 happy_x_1+ = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn37+ (KS happy_var_1+ )}++happyReduce_52 = happyReduce 7# 14# happyReduction_52+happyReduction_52 (happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut45 happy_x_3 of { happy_var_3 -> + case happyOut46 happy_x_5 of { happy_var_5 -> + happyIn37+ (KP (reverse happy_var_3) happy_var_5+ ) `HappyStk` happyRest}}++happyReduce_53 = happySpecReduce_3 15# happyReduction_53+happyReduction_53 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut45 happy_x_1 of { happy_var_1 -> + case happyOut45 happy_x_3 of { happy_var_3 -> + happyIn38+ (Var (reverse happy_var_1) (reverse happy_var_3)+ )}}++happyReduce_54 = happySpecReduce_0 16# happyReduction_54+happyReduction_54 = happyIn39+ ([]+ )++happyReduce_55 = happySpecReduce_3 16# happyReduction_55+happyReduction_55 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn39+ (flip (:) happy_var_1 happy_var_2+ )}}++happyReduce_56 = happySpecReduce_0 17# happyReduction_56+happyReduction_56 = happyIn40+ ([]+ )++happyReduce_57 = happySpecReduce_3 17# happyReduction_57+happyReduction_57 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut31 happy_x_2 of { happy_var_2 -> + happyIn40+ (flip (:) happy_var_1 happy_var_2+ )}}++happyReduce_58 = happySpecReduce_0 18# happyReduction_58+happyReduction_58 = happyIn41+ ([]+ )++happyReduce_59 = happySpecReduce_3 18# happyReduction_59+happyReduction_59 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut32 happy_x_2 of { happy_var_2 -> + happyIn41+ (flip (:) happy_var_1 happy_var_2+ )}}++happyReduce_60 = happySpecReduce_0 19# happyReduction_60+happyReduction_60 = happyIn42+ ([]+ )++happyReduce_61 = happySpecReduce_1 19# happyReduction_61+happyReduction_61 happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn42+ ((:[]) happy_var_1+ )}++happyReduce_62 = happySpecReduce_3 19# happyReduction_62+happyReduction_62 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut42 happy_x_3 of { happy_var_3 -> + happyIn42+ ((:) happy_var_1 happy_var_3+ )}}++happyReduce_63 = happySpecReduce_0 20# happyReduction_63+happyReduction_63 = happyIn43+ ([]+ )++happyReduce_64 = happySpecReduce_1 20# happyReduction_64+happyReduction_64 happy_x_1+ = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn43+ ((:[]) happy_var_1+ )}++happyReduce_65 = happySpecReduce_3 20# happyReduction_65+happyReduction_65 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut36 happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_3 of { happy_var_3 -> + happyIn43+ ((:) happy_var_1 happy_var_3+ )}}++happyReduce_66 = happySpecReduce_0 21# happyReduction_66+happyReduction_66 = happyIn44+ ([]+ )++happyReduce_67 = happySpecReduce_2 21# happyReduction_67+happyReduction_67 happy_x_2+ happy_x_1+ = case happyOut44 happy_x_1 of { happy_var_1 -> + case happyOut34 happy_x_2 of { happy_var_2 -> + happyIn44+ (flip (:) happy_var_1 happy_var_2+ )}}++happyReduce_68 = happySpecReduce_0 22# happyReduction_68+happyReduction_68 = happyIn45+ ([]+ )++happyReduce_69 = happySpecReduce_2 22# happyReduction_69+happyReduction_69 happy_x_2+ happy_x_1+ = case happyOut45 happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + happyIn45+ (flip (:) happy_var_1 happy_var_2+ )}}++happyReduce_70 = happySpecReduce_0 23# happyReduction_70+happyReduction_70 = happyIn46+ ([]+ )++happyReduce_71 = happySpecReduce_1 23# happyReduction_71+happyReduction_71 happy_x_1+ = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn46+ ((:[]) happy_var_1+ )}++happyReduce_72 = happySpecReduce_3 23# happyReduction_72+happyReduction_72 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut38 happy_x_1 of { happy_var_1 -> + case happyOut46 happy_x_3 of { happy_var_3 -> + happyIn46+ ((:) happy_var_1 happy_var_3+ )}}++happyNewToken action sts stk [] =+ happyDoAction 30# notHappyAtAll action sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = happyDoAction i tk action sts stk tks in+ case tk of {+ PT _ (TS ";") -> cont 1#;+ PT _ (TS "(") -> cont 2#;+ PT _ (TS ")") -> cont 3#;+ PT _ (TS "{") -> cont 4#;+ PT _ (TS "}") -> cont 5#;+ PT _ (TS ":") -> cont 6#;+ PT _ (TS "=") -> cont 7#;+ PT _ (TS "->") -> cont 8#;+ PT _ (TS "?") -> cont 9#;+ PT _ (TS "[") -> cont 10#;+ PT _ (TS "]") -> cont 11#;+ PT _ (TS "!") -> cont 12#;+ PT _ (TS "$") -> cont 13#;+ PT _ (TS "[|") -> cont 14#;+ PT _ (TS "|]") -> cont 15#;+ PT _ (TS "+") -> cont 16#;+ PT _ (TS "@") -> cont 17#;+ PT _ (TS "#") -> cont 18#;+ PT _ (TS "/") -> cont 19#;+ PT _ (TS ",") -> cont 20#;+ PT _ (TS "abstract") -> cont 21#;+ PT _ (TS "concrete") -> cont 22#;+ PT _ (TS "grammar") -> cont 23#;+ PT _ (TS "pre") -> cont 24#;+ PT _ (TL happy_dollar_dollar) -> cont 25#;+ PT _ (TI happy_dollar_dollar) -> cont 26#;+ PT _ (TD happy_dollar_dollar) -> cont 27#;+ PT _ (T_CId happy_dollar_dollar) -> cont 28#;+ _ -> cont 29#;+ _ -> happyError' (tk:tks)+ }++happyError_ tk tks = happyError' (tk:tks)++happyThen :: () => Err a -> (a -> Err b) -> Err b+happyThen = (thenM)+happyReturn :: () => a -> Err a+happyReturn = (returnM)+happyThen1 m k tks = (thenM) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Err a+happyReturn1 = \a tks -> (returnM) a+happyError' :: () => [Token] -> Err a+happyError' = happyError++pGrammar tks = happySomeParser where+ happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut27 x))++pHeader tks = happySomeParser where+ happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut28 x))++pAbstract tks = happySomeParser where+ happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut29 x))++pConcrete tks = happySomeParser where+ happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut30 x))++pAbsDef tks = happySomeParser where+ happySomeParser = happyThen (happyParse 4# tks) (\x -> happyReturn (happyOut31 x))++pCncDef tks = happySomeParser where+ happySomeParser = happyThen (happyParse 5# tks) (\x -> happyReturn (happyOut32 x))++pType tks = happySomeParser where+ happySomeParser = happyThen (happyParse 6# tks) (\x -> happyReturn (happyOut33 x))++pExp tks = happySomeParser where+ happySomeParser = happyThen (happyParse 7# tks) (\x -> happyReturn (happyOut34 x))++pAtom tks = happySomeParser where+ happySomeParser = happyThen (happyParse 8# tks) (\x -> happyReturn (happyOut35 x))++pTerm tks = happySomeParser where+ happySomeParser = happyThen (happyParse 9# tks) (\x -> happyReturn (happyOut36 x))++pTokn tks = happySomeParser where+ happySomeParser = happyThen (happyParse 10# tks) (\x -> happyReturn (happyOut37 x))++pVariant tks = happySomeParser where+ happySomeParser = happyThen (happyParse 11# tks) (\x -> happyReturn (happyOut38 x))++pListConcrete tks = happySomeParser where+ happySomeParser = happyThen (happyParse 12# tks) (\x -> happyReturn (happyOut39 x))++pListAbsDef tks = happySomeParser where+ happySomeParser = happyThen (happyParse 13# tks) (\x -> happyReturn (happyOut40 x))++pListCncDef tks = happySomeParser where+ happySomeParser = happyThen (happyParse 14# tks) (\x -> happyReturn (happyOut41 x))++pListCId tks = happySomeParser where+ happySomeParser = happyThen (happyParse 15# tks) (\x -> happyReturn (happyOut42 x))++pListTerm tks = happySomeParser where+ happySomeParser = happyThen (happyParse 16# tks) (\x -> happyReturn (happyOut43 x))++pListExp tks = happySomeParser where+ happySomeParser = happyThen (happyParse 17# tks) (\x -> happyReturn (happyOut44 x))++pListString tks = happySomeParser where+ happySomeParser = happyThen (happyParse 18# tks) (\x -> happyReturn (happyOut45 x))++pListVariant tks = happySomeParser where+ happySomeParser = happyThen (happyParse 19# tks) (\x -> happyReturn (happyOut46 x))++happySeq = happyDontSeq+++returnM :: a -> Err a+returnM = return++thenM :: Err a -> (a -> Err b) -> Err b+thenM = (>>=)++happyError :: [Token] -> Err a+happyError ts =+ Bad $ "syntax error at " ++ tokenPos ts ++ + case ts of+ [] -> []+ [Err _] -> " due to lexer error"+ _ -> " before " ++ unwords (map prToken (take 4 ts))++myLexer = tokens+trA_ a_ = Tr a_ []+{-# LINE 1 "GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++{-# LINE 28 "GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Int# Happy_IntList++++++{-# LINE 49 "GenericTemplate.hs" #-}++{-# LINE 59 "GenericTemplate.hs" #-}++{-# LINE 68 "GenericTemplate.hs" #-}++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser). We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+ happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+ = {- nothing -}+++ case action of+ 0# -> {- nothing -}+ happyFail i tk st+ -1# -> {- nothing -}+ happyAccept i tk st+ n | (n <# (0# :: Int#)) -> {- nothing -}++ (happyReduceArr ! rule) i tk st+ where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))+ n -> {- nothing -}+++ happyShift new_state i tk st+ where new_state = (n -# (1# :: Int#))+ where off = indexShortOffAddr happyActOffsets st+ off_i = (off +# i)+ check = if (off_i >=# (0# :: Int#))+ then (indexShortOffAddr happyCheck off_i ==# i)+ else False+ action | check = indexShortOffAddr happyTable off_i+ | otherwise = indexShortOffAddr happyDefActions st++{-# LINE 127 "GenericTemplate.hs" #-}+++indexShortOffAddr (HappyA# arr) off =+#if __GLASGOW_HASKELL__ > 500+ narrow16Int# i+#elif __GLASGOW_HASKELL__ == 500+ intToInt16# i+#else+ (i `iShiftL#` 16#) `iShiftRA#` 16#+#endif+ where+#if __GLASGOW_HASKELL__ >= 503+ i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+#else+ i = word2Int# ((high `shiftL#` 8#) `or#` low)+#endif+ high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ low = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 2#++++++data HappyAddr = HappyA# Addr#+++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++{-# LINE 170 "GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =+ let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in+-- trace "shifting the error token" $+ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+ happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+ = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+ = let r = fn v1 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+ = let r = fn v1 v2 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+ = let r = fn v1 v2 v3 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happyReduce k nt fn j tk st sts stk+ = case happyDrop (k -# (1# :: Int#)) sts of+ sts1@((HappyCons (st1@(action)) (_))) ->+ let r = fn stk in -- it doesn't hurt to always seq here...+ happyDoSeq r (happyGoto nt j tk st1 sts1 r)++happyMonadReduce k nt fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+ happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))+ where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+ drop_stk = happyDropStk k stk++happyMonad2Reduce k nt fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+ happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))+ where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+ drop_stk = happyDropStk k stk++ off = indexShortOffAddr happyGotoOffsets st1+ off_i = (off +# nt)+ new_state = indexShortOffAddr happyTable off_i+++++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++happyGoto nt j tk st = + {- nothing -}+ happyDoAction j tk new_state+ where off = indexShortOffAddr happyGotoOffsets st+ off_i = (off +# nt)+ new_state = indexShortOffAddr happyTable off_i+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail 0# tk old_st _ stk =+-- trace "failing" $ + happyError_ tk++{- We don't need state discarding for our restricted implementation of+ "error". In fact, it can cause some bogus parses, so I've disabled it+ for now --SDM++-- discard a state+happyFail 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) =+-- trace ("discarding state, depth " ++ show (length stk)) $+ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+-- save the old token and carry on.+happyFail i tk (action) sts stk =+-- trace "entering error recovery" $+ happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq+-- otherwise it emits+-- happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template. GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
@@ -0,0 +1,204 @@+-- This Happy file was machine-generated by the BNF converter+{+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}+module GFCC.Par where+import GFCC.Abs+import GFCC.Lex+import GFCC.ErrM+}++%name pGrammar Grammar+%name pHeader Header+%name pAbstract Abstract+%name pConcrete Concrete+%name pAbsDef AbsDef+%name pCncDef CncDef+%name pType Type+%name pExp Exp+%name pAtom Atom+%name pTerm Term+%name pTokn Tokn+%name pVariant Variant+%name pListConcrete ListConcrete+%name pListAbsDef ListAbsDef+%name pListCncDef ListCncDef+%name pListCId ListCId+%name pListTerm ListTerm+%name pListExp ListExp+%name pListString ListString+%name pListVariant ListVariant++-- no lexer declaration+%monad { Err } { thenM } { returnM }+%tokentype { Token }++%token + ';' { PT _ (TS ";") }+ '(' { PT _ (TS "(") }+ ')' { PT _ (TS ")") }+ '{' { PT _ (TS "{") }+ '}' { PT _ (TS "}") }+ ':' { PT _ (TS ":") }+ '=' { PT _ (TS "=") }+ '->' { PT _ (TS "->") }+ '?' { PT _ (TS "?") }+ '[' { PT _ (TS "[") }+ ']' { PT _ (TS "]") }+ '!' { PT _ (TS "!") }+ '$' { PT _ (TS "$") }+ '[|' { PT _ (TS "[|") }+ '|]' { PT _ (TS "|]") }+ '+' { PT _ (TS "+") }+ '@' { PT _ (TS "@") }+ '#' { PT _ (TS "#") }+ '/' { PT _ (TS "/") }+ ',' { PT _ (TS ",") }+ 'abstract' { PT _ (TS "abstract") }+ 'concrete' { PT _ (TS "concrete") }+ 'grammar' { PT _ (TS "grammar") }+ 'pre' { PT _ (TS "pre") }++L_quoted { PT _ (TL $$) }+L_integ { PT _ (TI $$) }+L_doubl { PT _ (TD $$) }+L_CId { PT _ (T_CId $$) }+L_err { _ }+++%%++String :: { String } : L_quoted { $1 }+Integer :: { Integer } : L_integ { (read $1) :: Integer }+Double :: { Double } : L_doubl { (read $1) :: Double }+CId :: { CId} : L_CId { CId ($1)}++Grammar :: { Grammar }+Grammar : Header ';' Abstract ';' ListConcrete { Grm $1 $3 (reverse $5) } +++Header :: { Header }+Header : 'grammar' CId '(' ListCId ')' { Hdr $2 $4 } +++Abstract :: { Abstract }+Abstract : 'abstract' '{' ListAbsDef '}' { Abs (reverse $3) } +++Concrete :: { Concrete }+Concrete : 'concrete' CId '{' ListCncDef '}' { Cnc $2 (reverse $4) } +++AbsDef :: { AbsDef }+AbsDef : CId ':' Type '=' Exp { Fun $1 $3 $5 } +++CncDef :: { CncDef }+CncDef : CId '=' Term { Lin $1 $3 } +++Type :: { Type }+Type : ListCId '->' CId { Typ $1 $3 } +++Exp :: { Exp }+Exp : '(' Atom ListExp ')' { Tr $2 (reverse $3) } + | Atom { trA_ $1 }+++Atom :: { Atom }+Atom : CId { AC $1 } + | String { AS $1 }+ | Integer { AI $1 }+ | Double { AF $1 }+ | '?' { AM }+++Term :: { Term }+Term : '[' ListTerm ']' { R $2 } + | '(' Term '!' Term ')' { P $2 $4 }+ | '(' ListTerm ')' { S $2 }+ | Tokn { K $1 }+ | '$' Integer { V $2 }+ | Integer { C $1 }+ | CId { F $1 }+ | '[|' ListTerm '|]' { FV $2 }+ | '(' String '+' Term ')' { W $2 $4 }+ | '(' Term '@' Term ')' { RP $2 $4 }+ | '?' { TM }+ | '(' CId '->' Term ')' { L $2 $4 }+ | '#' CId { BV $2 }+++Tokn :: { Tokn }+Tokn : String { KS $1 } + | '[' 'pre' ListString '[' ListVariant ']' ']' { KP (reverse $3) $5 }+++Variant :: { Variant }+Variant : ListString '/' ListString { Var (reverse $1) (reverse $3) } +++ListConcrete :: { [Concrete] }+ListConcrete : {- empty -} { [] } + | ListConcrete Concrete ';' { flip (:) $1 $2 }+++ListAbsDef :: { [AbsDef] }+ListAbsDef : {- empty -} { [] } + | ListAbsDef AbsDef ';' { flip (:) $1 $2 }+++ListCncDef :: { [CncDef] }+ListCncDef : {- empty -} { [] } + | ListCncDef CncDef ';' { flip (:) $1 $2 }+++ListCId :: { [CId] }+ListCId : {- empty -} { [] } + | CId { (:[]) $1 }+ | CId ',' ListCId { (:) $1 $3 }+++ListTerm :: { [Term] }+ListTerm : {- empty -} { [] } + | Term { (:[]) $1 }+ | Term ',' ListTerm { (:) $1 $3 }+++ListExp :: { [Exp] }+ListExp : {- empty -} { [] } + | ListExp Exp { flip (:) $1 $2 }+++ListString :: { [String] }+ListString : {- empty -} { [] } + | ListString String { flip (:) $1 $2 }+++ListVariant :: { [Variant] }+ListVariant : {- empty -} { [] } + | Variant { (:[]) $1 }+ | Variant ',' ListVariant { (:) $1 $3 }++++{++returnM :: a -> Err a+returnM = return++thenM :: Err a -> (a -> Err b) -> Err b+thenM = (>>=)++happyError :: [Token] -> Err a+happyError ts =+ Bad $ "syntax error at " ++ tokenPos ts ++ + case ts of+ [] -> []+ [Err _] -> " due to lexer error"+ _ -> " before " ++ unwords (map prToken (take 4 ts))++myLexer = tokens+trA_ a_ = Tr a_ []+}+
@@ -0,0 +1,148 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+module GFCC.Print where++-- pretty-printer generated by the BNF converter++import GFCC.Abs+import Data.Char+import Data.List (intersperse)++-- the top-level printing method+printTree :: Print a => a -> String+printTree = render . prt 0++type Doc = [ShowS] -> [ShowS]++doc :: ShowS -> Doc+doc = (:)++render :: Doc -> String+render d = rend 0 (map ($ "") $ d []) "" where+ rend i ss = case ss of+ "[" :ts -> showChar '[' . rend i ts+ "(" :ts -> showChar '(' . rend i ts+ "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts+ "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts+ "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts+ ";" :ts -> showChar ';' . new i . rend i ts+ t : "," :ts -> showString t . space "," . rend i ts+ t : ")" :ts -> showString t . showChar ')' . rend i ts+ t : "]" :ts -> showString t . showChar ']' . rend i ts+ t :ts -> space t . rend i ts+ _ -> id+ new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace+ space t = showString t . (\s -> if null s then "" else (' ':s))++parenth :: Doc -> Doc+parenth ss = doc (showChar '(') . ss . doc (showChar ')')++concatS :: [ShowS] -> ShowS+concatS = foldr (.) id++concatD :: [Doc] -> Doc+concatD = foldr (.) id++unwordsD :: [Doc] -> Doc+unwordsD = concatD . intersperse (doc (showChar ' '))++replicateS :: Int -> ShowS -> ShowS+replicateS n f = concatS (replicate n f)++-- the printer class does the job+class Print a where+ prt :: Int -> a -> Doc++instance Print Char where+ prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')++instance Print String where+ prt _ s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')++mkEsc :: Char -> Char -> ShowS+mkEsc q s = case s of+ _ | s == q -> showChar '\\' . showChar s+ '\\'-> showString "\\\\"+ '\n' -> showString "\\n"+ '\t' -> showString "\\t"+ _ -> showChar s++prPrec :: Int -> Int -> Doc -> Doc+prPrec i j = if j<i then parenth else id+++instance Print Integer where+ prt _ x = doc (shows x)+++instance Print Double where+ prt _ x = doc (shows x)+++instance Print (Tree c) where+ prt _i e = case e of+ Grm header abstract concretes -> prPrec _i 0 (concatD [prt 0 header , doc (showString ";") , prt 0 abstract , doc (showString ";") , prt 0 concretes])+ Hdr cid cids -> prPrec _i 0 (concatD [doc (showString "grammar") , prt 0 cid , doc (showString "(") , prt 0 cids , doc (showString ")")])+ Abs absdefs -> prPrec _i 0 (concatD [doc (showString "abstract") , doc (showString "{") , prt 0 absdefs , doc (showString "}")])+ Cnc cid cncdefs -> prPrec _i 0 (concatD [doc (showString "concrete") , prt 0 cid , doc (showString "{") , prt 0 cncdefs , doc (showString "}")])+ Fun cid type' exp -> prPrec _i 0 (concatD [prt 0 cid , doc (showString ":") , prt 0 type' , doc (showString "=") , prt 0 exp])+ Lin cid term -> prPrec _i 0 (concatD [prt 0 cid , doc (showString "=") , prt 0 term])+ Typ cids cid -> prPrec _i 0 (concatD [prt 0 cids , doc (showString "->") , prt 0 cid])+ Tr atom exps -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 atom , prt 0 exps , doc (showString ")")])+ AC cid -> prPrec _i 0 (concatD [prt 0 cid])+ AS str -> prPrec _i 0 (concatD [prt 0 str])+ AI n -> prPrec _i 0 (concatD [prt 0 n])+ AF d -> prPrec _i 0 (concatD [prt 0 d])+ AM -> prPrec _i 0 (concatD [doc (showString "?")])+ R terms -> prPrec _i 0 (concatD [doc (showString "[") , prt 0 terms , doc (showString "]")])+ P term0 term1 -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "!") , prt 0 term1 , doc (showString ")")])+ S terms -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 terms , doc (showString ")")])+ K tokn -> prPrec _i 0 (concatD [prt 0 tokn])+ V n -> prPrec _i 0 (concatD [doc (showString "$") , prt 0 n])+ C n -> prPrec _i 0 (concatD [prt 0 n])+ F cid -> prPrec _i 0 (concatD [prt 0 cid])+ FV terms -> prPrec _i 0 (concatD [doc (showString "[|") , prt 0 terms , doc (showString "|]")])+ W str term -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 str , doc (showString "+") , prt 0 term , doc (showString ")")])+ RP term0 term1 -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "@") , prt 0 term1 , doc (showString ")")])+ TM -> prPrec _i 0 (concatD [doc (showString "?")])+ L cid term -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 cid , doc (showString "->") , prt 0 term , doc (showString ")")])+ BV cid -> prPrec _i 0 (concatD [doc (showString "#") , prt 0 cid])+ KS str -> prPrec _i 0 (concatD [prt 0 str])+ KP strs variants -> prPrec _i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "[") , prt 0 variants , doc (showString "]") , doc (showString "]")])+ Var strs0 strs1 -> prPrec _i 0 (concatD [prt 0 strs0 , doc (showString "/") , prt 0 strs1])+ CId str -> prPrec _i 0 (doc (showString str))++instance Print [Concrete] where+ prt _ es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])+instance Print [AbsDef] where+ prt _ es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])+instance Print [CncDef] where+ prt _ es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])+instance Print [CId] where+ prt _ es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])+instance Print [Term] where+ prt _ es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])+instance Print [Exp] where+ prt _ es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , prt 0 xs])+instance Print [String] where+ prt _ es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , prt 0 xs])+instance Print [Variant] where+ prt _ es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
@@ -0,0 +1,58 @@+-- automatically generated by BNF Converter+module Main where+++import IO ( stdin, hGetContents )+import System ( getArgs, getProgName )++import GFCC.Lex+import GFCC.Par+import GFCC.Skel+import GFCC.Print+import GFCC.Abs+++++import GFCC.ErrM++type ParseFun a = [Token] -> Err a++myLLexer = myLexer++type Verbosity = Int++putStrV :: Verbosity -> String -> IO ()+putStrV v s = if v > 1 then putStrLn s else return ()++runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO ()+runFile v p f = putStrLn f >> readFile f >>= run v p++run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO ()+run v p s = let ts = myLLexer s in case p ts of+ Bad s -> do putStrLn "\nParse Failed...\n"+ putStrV v "Tokens:"+ putStrV v $ show ts+ putStrLn s+ Ok tree -> do putStrLn "\nParse Successful!"+ showTree v tree++++showTree :: (Show a, Print a) => Int -> a -> IO ()+showTree v tree+ = do+ putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree+ putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree++main :: IO ()+main = do args <- getArgs+ case args of+ [] -> hGetContents stdin >>= run 2 pGrammar+ "-s":fs -> mapM_ (runFile 0 pGrammar) fs+ fs -> mapM_ (runFile 2 pGrammar) fs+++++
@@ -0,0 +1,25 @@+GHC = ghc+GHCFLAGS =++.PHONY: all gfcc2c clean ++all: gfcc2c++gfcc2c: + $(GHC) $(GHCFLAGS) --make -o $@ gfcc2c.hs++bnfc:+ bnfc -gadt -d ../../GF/Canon/GFCC/GFCC.cf+ -rm -f GFCC/Doc.tex GFCC/Skel.hs+ happy -gca GFCC/Par.y+ alex -g GFCC/Lex.x++clean:+ -rm -f gfcc2c+ -rm -f *.o *.hi+ -rm -f GFCC/*.hi GFCC/*.o++bnfcclean: clean+ -rm -f GFCC/*.bak+ -rm -f GFCC/Lex.* GFCC/Par.* GFCC/Layout.* GFCC/Skel.* GFCC/Print.* GFCC/Test.* GFCC/Abs.* GFCC/ComposOp.* GFCC/Test GFCC/ErrM.* GFCC/SharedString.*+ -rmdir -p GFCC/
@@ -0,0 +1,47 @@++GFDIR=../../../../../++LIBGFCC_INCLUDES = $(GFDIR)/lib/c+LIBGFCC_LIBDIR = $(GFDIR)/lib/c++GFCC2C = $(GFDIR)/bin/gfcc2c++TEST_PROG = bronzeage-test++GRAMMAR_DIR = $(GFDIR)/examples/bronzeage++GRAMMAR_MODULES = Bronzeage BronzeageEng BronzeageSwe++GRAMMAR_H_FILES = $(addsuffix .h, $(GRAMMAR_MODULES))+GRAMMAR_C_FILES = $(addsuffix .c, $(GRAMMAR_MODULES))+GRAMMAR_O_FILES = $(addsuffix .o, $(GRAMMAR_MODULES))++CFLAGS += -O2+CPPFLAGS += -I$(LIBGFCC_INCLUDES)++.PHONY: clean++all: bronzeage.gfcc $(TEST_PROG)++$(TEST_PROG): $(GRAMMAR_O_FILES) $(TEST_PROG).o $(LIBGFCC_LIBDIR)/libgfcc.a ++$(TEST_PROG).o: $(GRAMMAR_H_FILES) $(GRAMMAR_O_FILES) $(TEST_PROG).c++$(GRAMMAR_H_FILES) $(GRAMMAR_C_FILES): $(GFCC2C) bronzeage.gfcc+ $(GFCC2C) bronzeage.gfcc++bronzeage.gfcc:+ echo "i -optimize=all $(GRAMMAR_DIR)/BronzeageEng.gf" > mkBronzeage.gfs+ echo "i -optimize=all $(GRAMMAR_DIR)/BronzeageSwe.gf" >> mkBronzeage.gfs+ echo "s" >> mkBronzeage.gfs+ echo "pm -printer=gfcc | wf bronzeage.gfcc" >> mkBronzeage.gfs+ cat mkBronzeage.gfs | gf+ rm -f mkBronzeage.gfs++clean:+ -rm -f $(TEST_PROG) *.o+++distclean: clean+ -rm -f $(GRAMMAR_H_FILES) $(GRAMMAR_C_FILES)+ -rm -f bronzeage.gfcc
@@ -0,0 +1,31 @@+#include "Bronzeage.h"++#include "BronzeageEng.h"++#include <unistd.h>++int main() {+ Tree *tree = + mk_PhrPos(+ mk_SentV(+ mk_lie_V(),+ mk_NumCN(+ mk_two_Num(),+ mk_UseN(mk_wife_N())+ )+ )+ );++ int i;++ for (i = 0; i < 1000; i++) {+ Term *term;+ term = BronzeageEng_lin(tree);+ term_print(stdout, term);+ fputs("\n", stdout);+ }++ tree_free(tree);++ return 0;+}
@@ -0,0 +1,223 @@+import GFCC.Abs+import GFCC.ErrM+import GFCC.Lex+import GFCC.Par++import Control.Monad+import Data.Char+import Data.List+import Numeric+import System.Environment+import System.Exit+import System.IO++constrType :: Grammar -> String+constrType g = unlines $ + ["typedef enum { "]+ ++ map (\x -> " " ++ x ++ "," ) ds+ ++ ["} Fun;"]+ where fs = [id2c n | (n,_) <- constructors g ]+ ds = case fs of+ [] -> []+ (x:xs) -> (x ++ " = ATOM_FIRST_FUN"):xs++mkFunSigs :: Grammar -> String+mkFunSigs g = unlines [mkFunSig n ats | (n,(ats,_)) <- constructors g]++mkFunSig :: CId -> [CId] -> String+mkFunSig n ats = + "extern Tree *mk_" ++ id2c n ++ "(" ++ commaSep adecls ++ ");"+ where + adecls = map ("Tree *" ++) args+ args = [ "x" ++ show x | x <- [0..c-1] ]+ c = length ats++mkFuns :: Grammar -> String+mkFuns g = unlines [mkFun n ats | (n,(ats,_)) <- constructors g]++mkFun :: CId -> [CId] -> String+mkFun n ats = unlines $+ ["extern Tree *mk_" ++ id2c n ++ "(" ++ commaSep adecls ++ ") {",+ " Tree *t = tree_fun(" ++ id2c n ++ "," ++ show c ++ ");"]+ ++ [" tree_set_child(" ++ commaSep ["t",show i, args!!i] ++ ");" | i <- [0..c-1]]+ ++ [" return t;",+ "}"]+ where + adecls = map ("Tree *" ++) args+ args = [ "x" ++ show x | x <- [0..c-1] ]+ c = length ats++doDie :: String -> [String] -> [String]+doDie s args = ["fprintf(" ++ commaSep ("stderr":show s':args) ++ ");",+ "exit(1);"]+ where s' = "Error: " ++ s ++ "\n"++mkLin :: Grammar -> CId -> String+mkLin g l = unlines $+ ["extern Term *" ++ langLinName_ l ++ "(Tree *t) {",+ " Term **cs = NULL;",+ " int n = arity(t);",+ " if (n > 0) {",+ " int i;",+ " cs = (Term**)term_alloc(n * sizeof(Term *));", -- FIXME: handle failure+ " for (i = 0; i < n; i++) {",+ " cs[i] = " ++ langLinName_ l ++ "(tree_get_child(t,i));",+ " }",+ " }",+ "",+ " switch (t->type) {",+ " case ATOM_STRING: return term_str(t->value.string_value);",+-- " case ATOM_INTEGER: return NULL;", -- FIXME!+-- " case ATOM_DOUBLE: return NULL;", -- FIXME!+ " case ATOM_META: return term_meta();"]+ ++ [" case " ++ id2c n ++ ": return " ++ linFunName n ++ "(cs);" + | (n,_) <- constructors g]+ ++ [" default: "]+ ++ map (" " ++) (doDie (langLinName_ l ++ " %d") ["t->type"])+ ++ [" return NULL;",+ " }",+ "}",+ "",+ "extern Term *" ++ langLinName l ++ "(Tree *t) {",+ " Term *r;",+ " term_alloc_pool(1000000);", -- FIXME: size?+ " r = " ++ langLinName_ l ++ "(t);",+ " /* term_free_pool(); */", -- FIXME: copy term?+ " return r;",+ "}"]++langLinName :: CId -> String+langLinName n = id2c n ++ "_lin"++langLinName_ :: CId -> String+langLinName_ n = id2c n ++ "_lin_"++linFunName :: CId -> String+linFunName n = "lin_" ++ id2c n+++mkLinFuns :: [CncDef] -> String+mkLinFuns cs = unlines $ map mkLinFunSig cs ++ [""] ++ map mkLinFun cs++mkLinFunSig :: CncDef -> String+mkLinFunSig (Lin n t) =+ "static Term *" ++ linFunName n ++ "(Term **cs);"++mkLinFun :: CncDef -> String+mkLinFun (Lin (CId n) t) | "__" `isPrefixOf` n = ""+mkLinFun (Lin n t) = unlines [+ "static Term *" ++ linFunName n ++ "(Term **cs) {",+ " return " ++ term2c t ++ ";",+ "}"+ ]++term2c :: Tree a -> String+term2c t = case t of+ -- terms+ R terms -> fun "term_array" terms+ -- an optimization of t!n where n is a constant int+ P term0 (C n) -> "term_sel_int("++ term2c term0 ++ "," ++ show n ++ ")"+ P term0 term1 -> "term_sel(" ++ term2c term0 ++ "," ++ term2c term1 ++ ")"+ S terms -> fun "term_seq" terms+ K tokn -> term2c tokn+ V n -> "cs[" ++ show n ++ "]"+ C n -> "term_int(" ++ show n ++ ")"+ F cid -> linFunName cid ++ "(cs)"+ FV terms -> fun "term_variants" terms+ W str term -> "term_suffix(" ++ string2c str ++ "," ++ term2c term ++ ")"+ RP term0 term1 -> "term_rp(" ++ term2c term0 ++ "," ++ term2c term1 ++ ")"+ TM -> "term_meta()"+ -- tokens+ KS s -> "term_str(" ++ string2c s ++ ")"+ KP strs vars -> error $ show t -- FIXME: pre token+ _ -> error $ show t + where fun f ts = f ++ "(" ++ commaSep (show (length ts):map term2c ts) ++ ")"++commaSep = concat . intersperse ","+++id2c :: CId -> String+id2c (CId s) = s -- FIXME: convert ticks++string2c :: String -> String+string2c s = "\"" ++ concatEsc (map esc s) ++ "\""+ where + esc c | isAscii c && isPrint c = [c]+ esc '\n' = "\\n"+ esc c = "\\x" ++ map toUpper (showHex (ord c) "")+ concatEsc [] = ""+ concatEsc (x:xs) | length x <= 2 = x ++ concatEsc xs+ | otherwise = x ++ "\" \"" ++ concatEsc xs++lang2file :: CId -> String -> String+lang2file n ext = id2c n ++ "." ++ ext++constructors :: Grammar -> [(CId, ([CId],CId))]+constructors (Grm _ (Abs ads) _) = [(n,(ats,rt)) | Fun n (Typ ats rt) _ <- ads]++absHFile :: Grammar -> FilePath+absHFile (Grm (Hdr a _) _ _) = lang2file a "h"++cncHFile :: Concrete -> FilePath+cncHFile (Cnc l _) = lang2file l "h"++mkAbsH :: Grammar -> String+mkAbsH g = unlines ["#include \"gfcc-tree.h\"",+ "#include \"gfcc-term.h\"",+ constrType g,+ "",+ mkFunSigs g]++mkAbsC :: Grammar -> String+mkAbsC g = unlines [include (absHFile g),+ "",+ mkFuns g]++mkCncH :: Grammar -> Concrete -> String+mkCncH g (Cnc l _) = unlines+ [include (absHFile g),+ "",+ "extern Term *" ++ langLinName l ++ "(Tree *);"]++mkCncC :: Grammar -> Concrete -> String+mkCncC g c@(Cnc l cds) = unlines $ + ["#include <stdio.h>",+ "#include <stdlib.h>",+ include (cncHFile c),+ ""]+ ++ [mkLinFuns cds, mkLin g l]++mkH :: FilePath -> String -> (FilePath, String)+mkH f c = (f, c')+ where c' = unlines ["#ifndef " ++ s, "#define " ++ s, "", c, "#endif"]+ s = [if x=='.' then '_' else toUpper x | x <- f]++include :: FilePath -> String+include f = "#include " ++ show f++-- returns list of file name, file contents+gfcc2c :: Grammar -> [(FilePath, String)]+gfcc2c g@(Grm (Hdr a _) _ cs) = + [mkH (absHFile g) (mkAbsH g), (lang2file a "c", mkAbsC g)]+ ++ concat [[mkH (cncHFile cnc) (mkCncH g cnc),(lang2file c "c", mkCncC g cnc)] | cnc@(Cnc c _) <- cs]++parse :: String -> Err Grammar+parse = pGrammar . myLexer++die :: String -> IO ()+die s = do hPutStrLn stderr "Usage: gfcc2c <gfcc file>"+ exitFailure++createFile :: FilePath -> String -> IO ()+createFile f c = do hPutStrLn stderr $ "Writing " ++ f ++ "..."+ writeFile f c++main :: IO ()+main = do args <- getArgs+ case args of+ [file] -> do c <- readFile file + case parse c of+ Bad err -> die err+ Ok g -> do let fs = gfcc2c g+ mapM_ (uncurry createFile) fs+ _ -> die "Usage: gfcc2c <gfcc file>"
@@ -0,0 +1,37 @@+# This file written by John J. Camilleri, June 2011+# Geany documentation ref: http://www.geany.org/manual/dev/index.html#custom-filetypes++[styling]+# foreground;background;bold;italic+default=0xffffff;0x1E1E1E;false;false+commentline=0x747474;0x1E1E1E;false;false+commentblock=0x747474;0x1E1E1E;false;false+commentblock2=0x747474;0x1E1E1E;false;false+commentblock3=0x747474;0x1E1E1E;false;false+number=0x7ECDFF;0x1E1E1E;false;false+keyword=0xFFCA4A;0x1E1E1E;true;false+import=0x8C2421;0x1E1E1E;false;false+string=0xA18651;0x1E1E1E;false;false+character=0xA18651;0x1E1E1E;false;false+class=0xB2A886;0x1E1E1E;True;false+operator=0x98BAC5;0x1E1E1E;true;false+identifier=0xffffff;0x1E1E1E;false;false+capital=0x7BB25A;0x1E1E1E;false;false+module=0xAD7DAD;0x1E1E1E;false;false+data=0x5ABEFF;0x1E1E1E;false;false++[keywords]+keywords=PType Str Strs Type abstract case cat concrete data def flags fun in incomplete instance interface let lin lincat lindef of open oper param pre printname resource strs table transfer variants where with++[settings]+extension=gf++comment_single=--+comment_open={-+comment_close=-}+comment_use_indent=true++#tag_parser=GF+lexer_filetype=Haskell++[build_settings]
@@ -0,0 +1,8 @@+name: gf-tools+version: 0.1+build-type: Simple+cabal-version: >= 1.8++Executable gfdoc+ main-is: GFDoc.hs+ build-depends: base, directory>=1.2, time>=1.5, process
@@ -0,0 +1,1 @@+(error "install updated GF mode from https://github.com/GrammaticalFramework/gf-emacs-mode")
@@ -0,0 +1,211 @@+<?xml version="1.0" encoding="UTF-8"?>+<!--++ Author: John J. Camilleri+ Copyright (C) 2011, John J. Camilleri+ Based on haskell.lang by Duncan Coutts <duncan@haskell.org> and Anders Carlsson <andersca@gnome.org>++ This library is free software; you can redistribute it and/or+ modify it under the terms of the GNU Library General Public+ License as published by the Free Software Foundation; either+ version 2 of the License, or (at your option) any later version.++ This library is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+ Library General Public License for more details.++ You should have received a copy of the GNU Library General Public+ License along with this library; if not, write to the+ Free Software Foundation, Inc., 59 Temple Place - Suite 330,+ Boston, MA 02111-1307, USA.++-->+<language id="gf" _name="Grammatical Framework" version="2.0" _section="Sources">+ <metadata>+ <property name="mimetypes">text/x-gf;text/plain</property>+ <property name="globs">*.gf</property>+ </metadata>++ <styles>+ <style id="preprocessor" _name="Preprocessor" map-to="def:preprocessor"/>+ <style id="comment" _name="Comment" map-to="def:comment"/>+ <style id="variable" _name="Variable" />+ <style id="symbol" _name="Symbol" />+ <style id="keyword" _name="Keyword" map-to="def:keyword"/>+ <style id="type" _name="Data Type" map-to="def:type"/>+ <style id="string" _name="String" map-to="def:string"/>+ <style id="character" _name="Character" map-to="def:character"/>+ <style id="char-escape" _name="Escaped Character" map-to="def:special-char"/>+ <style id="decimal" _name="Decimal" map-to="def:decimal"/>+ </styles>++ <definitions>++ <define-regex id="symbolchar">[!#$%&*+./>=<?@:\\^|~-]</define-regex>++ <context id="line-comment" style-ref="comment" end-at-line-end="true" class="comment" class-disabled="no-spell-check">+ <start>(?<!\%{symbolchar})--+(?!\%{symbolchar})</start>+ <include>+ <context ref="def:in-comment"/>+ <context ref="haddock:line-paragraph"/>+ <context ref="haddock:directive"/>+ </include>+ </context>++ <context id="block-comment" style-ref="comment" class="comment" class-disabled="no-spell-check">+ <start>\{-</start>+ <end>-\}</end>+ <include>+ <context ref="def:in-comment"/>+ <context ref="haddock:block-paragraph"/>+ <context ref="haddock:directive"/>+ <context ref="block-comment"/>+ </include>+ </context>++ <context id="pragma" style-ref="preprocessor">+ <start>\{-#</start>+ <end>#-\}</end>+ </context>++ <context id="variable" style-ref="variable">+ <match>\b[a-z_][0-9a-zA-Z_'#]*</match>+ </context>++ <context id="type-or-constructor" style-ref="type">+ <match>\b[A-Z][0-9a-zA-Z._'#]*</match>+ </context>++ <!-- Must not extend parent context, or we end up matching+ "\end{code}" as part of the Haskell context, but when in+ literate haskell mode it should be terminating a code block. -->+ <context id="symbol" style-ref="symbol" extend-parent="false">+ <match>\%{symbolchar}+</match>+ </context>++ <context id="keysymbol" style-ref="keyword">+ <prefix>(?<!\%{symbolchar})</prefix>+ <suffix>(?!\%{symbolchar})</suffix>+ <keyword>\.\.</keyword>+ <keyword>::</keyword>+ <keyword>=</keyword>+ <keyword>\|</keyword>+ <keyword>\</keyword>+ <keyword>-></keyword>+ <keyword><-</keyword>+ <keyword>@</keyword>+ <keyword>~</keyword>+ <keyword>=></keyword>+ </context>++ <define-regex id="escaped-character" extended="true">+ \\( # leading backslash+ [abfnrtv\\"\'&] | # escaped character+ [0-9]+ | # decimal digits+ o[0-7]+ | # 'o' followed by octal digits+ x[0-9A-Fa-f]+ | # 'x' followed by hex digits+ \^[A-Z@\[\\\]^_] | # control character codes+ NUL | SOH | STX | ETX | EOT | ENQ | ACK |+ BEL | BS | HT | LF | VT | FF | CR | SO |+ SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK |+ SYN | ETB | CAN | EM | SUB | ESC | FS | GS |+ RS | US | SP | DEL # control char names+ )+ </define-regex>++ <context id="string" style-ref="string" end-at-line-end="true" class="string" class-disabled="no-spell-check">+ <start>"</start>+ <end>"</end>+ <include>+ <context ref="def:line-continue"/>+ <context style-ref="char-escape">+ <match>\%{escaped-character}</match>+ </context>+ </include>+ </context>++ <context id="char" style-ref="character" end-at-line-end="true">+ <start>'</start>+ <end>'</end>+ <include>+ <context style-ref="char-escape" once-only="true">+ <match>\%{escaped-character}</match>+ </context>+ <context once-only="true" extend-parent="false">+ <match>.</match>+ </context>+ <context style-ref="def:error" extend-parent="false">+ <match>.</match>+ </context>+ </include>+ </context>++ <context id="decimal" style-ref="decimal">+ <match>[0-9]+</match>+ </context>++ <context id="keyword" style-ref="keyword">+ <keyword>PType</keyword>+ <keyword>Str</keyword>+ <keyword>Strs</keyword>+ <keyword>Type</keyword>+ <keyword>abstract</keyword>+ <keyword>case</keyword>+ <keyword>cat</keyword>+ <keyword>concrete</keyword>+ <keyword>data</keyword>+ <keyword>def</keyword>+ <keyword>flags</keyword>+ <keyword>fun</keyword>+ <keyword>in</keyword>+ <keyword>incomplete</keyword>+ <keyword>instance</keyword>+ <keyword>interface</keyword>+ <keyword>let</keyword>+ <keyword>lin</keyword>+ <keyword>lincat</keyword>+ <keyword>lindef</keyword>+ <keyword>of</keyword>+ <keyword>open</keyword>+ <keyword>oper</keyword>+ <keyword>param</keyword>+ <keyword>pre</keyword>+ <keyword>printname</keyword>+ <keyword>resource</keyword>+ <keyword>strs</keyword>+ <keyword>table</keyword>+ <keyword>transfer</keyword>+ <keyword>variants</keyword>+ <keyword>where</keyword>+ <keyword>with</keyword>+ </context>++ <context id="body">+ <include>+ <context ref="line-comment"/>+ <context ref="pragma"/>+ <context ref="block-comment"/>+ <context ref="keyword"/>+ <context ref="variable"/>+ <context ref="type-or-constructor"/>+ <context ref="keysymbol"/>+ <context ref="symbol"/>+ <context ref="string"/>+ <context ref="char"/>+ <context ref="decimal"/>+ </include>+ </context>++ <context id="gf" class="no-spell-check">+ <include>+ <context ref="def:shebang"/>+ <context ref="c:if0-comment"/>+ <context ref="c:include"/>+ <context ref="c:preprocessor"/>+ <context ref="body"/>+ </include>+ </context>++ </definitions>+</language>
@@ -0,0 +1,1 @@+Development moved to https://github.com/GrammaticalFramework/gftest
@@ -0,0 +1,33 @@+# This file written by John J. Camilleri, June 2011+# Geany documentation ref: http://www.geany.org/manual/dev/index.html#custom-filetypes+[styling]+default=0x000000;0xffffff;false;false+commentline=0x808080;0xffffff;false;false+commentblock=0x808080;0xffffff;false;false+commentblock2=0x808080;0xffffff;false;false+commentblock3=0x808080;0xffffff;false;false+number=0x007f00;0xffffff;false;false+keyword=0x00007f;0xffffff;true;false+import=0x991111;0xffffff;false;false+string=0xff901e;0xffffff;false;false+character=0x7f007f;0xffffff;false;false+class=0x0000d0;0xffffff;false;false+operator=0x301010;0xffffff;false;false+identifier=0x000000;0xffffff;false;false+instance=0x000000;0xffffff;false;false+capital=0x635b00;0xffffff;false;false+module=0x007f7f;0xffffff;false;false+data=0x000000;0xffffff;false;false++[keywords]+keywords=PType Str Strs Type abstract case cat concrete data def flags fun in incomplete instance interface let lin lincat lindef of open oper param pre printname resource strs table transfer variants where with++[settings]+extension=gf++comment_single=--+comment_open={-+comment_close=-}+comment_use_indent=true++lexer_filetype=Haskell
@@ -0,0 +1,49 @@++$infile = $#ARGV >= 0 ? '@'.join('@, @', @ARGV).'@' : '/the input file/';++print <<EOF;+----------------------------------------------------------------------+-- |+-- Module : HelpFile+-- Maintainer : Aarne Ranta+-- Stability : Stable (Autogenerated)+-- Portability : Haskell 98+--+-- > CVS \$Date \$+-- > CVS \$Author \$+-- > CVS \$Revision \$+--+-- Help on shell commands. Generated from $infile by invoking the +-- perl script \@mkHelpFile.perl\@.+-- Automatically generated -- PLEASE DON'T EDIT THIS FILE,+-- edit $infile instead.+-----------------------------------------------------------------------------++module HelpFile (txtHelpFileSummary, txtHelpCommand, txtHelpFile) where++import Operations++txtHelpFileSummary :: String+txtHelpFileSummary =+ unlines \$ map (concat . take 1 . lines) \$ paragraphs txtHelpFile++txtHelpCommand :: String -> String+txtHelpCommand c =+ case lookup c [(takeWhile (/=',') p,p) | p <- paragraphs txtHelpFile] of+ Just s -> s+ _ -> "Command not found."++txtHelpFile :: String+txtHelpFile =+EOF++while (<>) {+ chop;+ s/([\"\\])/\\$1/g;+ $pref = /^ / ? "\\n" : "\\n";+ print " \"$pref$_\" ++\n";+}++print " []\n";++
binary file changed (absent → 4006 bytes)
binary file changed (absent → 5227 bytes)
binary file changed (absent → 36233 bytes)
@@ -0,0 +1,95 @@+/* Copyright © Elnaz Abolahrar and Thomas Hallgren, 2011 */++body {+ background: #eee url("brushed-metal.png");+}++/* th, td { vertical-align: baseline; text-align: left; } */++div#surface {+ min-height: 3ex;+ margin: 5px;+ padding: 5px;+ border: 3px dashed #e0e0e0;+}++div#words {+ min-height: 3ex;+ margin: 5px;+ padding: 6px;+ border: 3px solid #e0e0e0;+}++div.word, span.word, div#words input[type=button] {+ display: inline-block;+ font-family: sans-serif;+ font-size: 100%;+ background-color: white;+ border: 1px solid black;+ padding: 3px;+ margin: 3px;+}++/* added for quiz */+ textarea.quest {+ width: 452px;+ height: 35px;+ font-size:16px;+ }++ textarea.explain {+ width: 452px;+ height: 70px;+ font-size:16px;+ }+ + input.answer1 {+ width: 442px;+ height: 20px;+ font-size:16px;+ }+ + div.hint {+ font-family: Verdana; + font-weight: bold; + font-size:16px;+ }+ + div.bold { + font-weight: bold; + font-size:16px;+ }+ + input.number {+ text-align:center; + font-family: Verdana; + font-weight: bold; + font-size:16px;+ }+ + div.shift_left {+ padding-left: 320px;+ }+ /* default for all links */+ a:link {color: #2E8B57; font-size:16px; font-weight: bold; text-decoration: underline; }+ a:active {color: #2E8B57; font-size:16px; font-weight: bold; text-decoration: underline; }+ a:visited {color: #2E8B57; font-size:16px; font-weight: bold; text-decoration: underline; }+ a:hover {color: #CD853F; font-size:16px; font-weight: bold; text-decoration: none; }++.invalid { color: red; }++div.modtime { float: right; }+.modtime { color: #444; white-space: nowrap; }++ul.space>li { margin-top: 0.5ex; }++div#saldospel input[type=button] { font-size: 100%; }++div#saldospel input.correct { color: green; }+div#saldospel input.incorrect { color: red; }++#surface input[type=text] { width: 5em; }+++span.field { background-color: #eee; }+
@@ -0,0 +1,640 @@+// Copyright © Elnaz Abolahrar and Thomas Hallgren, 2011++// minibar.js, assumes that support.js has also been loaded++var tree_icon="tree-btn.png";++/*+// This is essentially what happens when you call start_minibar:+if(server.grammar_list) grammars=server.grammar_list;+else grammars=server.get_grammarlist();+show_grammarlist(grammars)+select_grammar(grammars[0])+grammar_info=server.get_languages()+show_languages(grammar_info)+new_language()+complete_output=get_completions()+show_completions(complete_output)+*/++function Minibar(server,opts,target) {+ // Typically called when the HTML document is loaded++ /* --- Configuration ---------------------------------------------------- */++ // default values for options:+ this.options={+ show_abstract: false,+ show_trees: false,+ show_grouped_translations: true,+ delete_button_text: "⌫",+ default_source_language: null,+ + //modified for quiz+ try_google: false,+ + feedback_url: null,+ + //modified for quiz+ random_button: false,+ + help_url: null+ }++ // Apply supplied options+ if(opts) for(var o in opts) this.options[o]=opts[o];++ /* --- Creating user interface elements --------------------------------- */++ this.surface=div_id("surface");+ this.extra=div_id("extra");+ this.menubar=div_id("menubar");+ this.quizbar=div_id("quizbar");+ this.words=div_id("words");+ this.translations=div_id("translations");++ this.minibar=element(target || "minibar");+ this.minibar_contin=element("minibar_contin");+ this.minibar_buttons=element("minibar_buttons");+ this.minibar.innerHTML="";+ + //modified for quiz+ with(this) {+ appendChildren(minibar,[menubar, quizbar]);+ appendChildren(minibar_contin,[surface,words]);+ append_extra_buttons(extra,options);+ }++ // Filled in and added to minibar later:+ this.grammar_menu=empty_id("select","grammar_menu");+ this.from_menu=empty_id("select","from_menu");+ this.to_menu=empty_id("select","to_menu");+ ++ /* --- Minibar client state initialisation ------------------------------ */+ this.grammar=null;+ + //modified for quiz+ this.current={from: null, to:null, input: ""};+ + this.previous=null;++ this.server=server;++ /* --- Main program, this gets things going ----------------------------- */+ with(this) {+ if(server.grammar_list) show_grammarlist(server.grammar_list);+ else server.get_grammarlist(bind(show_grammarlist,this));+ }+}++/* --- Auxiliary functions ---------------------------------------------- */+++Minibar.prototype.show_grammarlist=function(grammars) {+ debug(this)+ with(this) {+ //debug("show_grammarlist ")+ menubar.innerHTML="";+ if(grammars.length>0) {+ function opt(g) { return option(g,g); }+ appendChildren(grammar_menu,map(opt,grammars));+ grammar_menu.onchange=+ bind(function() { select_grammar(grammar_menu.value); },this);+ appendChildren(menubar,[text("Grammar: "),grammar_menu]);+ }+ //modified for quiz+ appendChildren(menubar,+ [text(" From: "), from_menu,+ text(" To: "), to_menu]);+ //modified for quiz+ appendChildren(minibar_buttons,+ [button(options.delete_button_text,bind(delete_last,this),"H"),+ button("Clear",bind(clear_all,this),"L")]);+ + if(options.random_button)+ menubar.appendChild(button("Random",bind(generate_random,this),"R"));+ if(options.help_url)+ menubar.appendChild(button("Help",bind(open_help,this)));+ + select_grammar(grammars[0]);+ }+}++Minibar.prototype.select_grammar=function(grammar_name) {+ var t=this;+ //debug("select_grammar ");+ function get_languages() {+ t.server.get_languages(bind(t.show_languages,t));+ }+ t.server.switch_grammar(grammar_name,get_languages);+}++Minibar.prototype.show_languages=function(grammar_info) {+ var t=this;+ with(t) {+ //debug("show_languages ");+ grammar=grammar_info;++ var new_language=function () {+ current.from=from_menu.value;+ + //modified for quiz+ //clear_all();+ }+ + //added for quiz+ var change_tolang=function () {+ current.to=to_menu.value;+ + //var langname = element("to_menu").value;+ //to_menu.current={to: langname, input: ""};+ //clear_all();+ }+ + from_menu.onchange=bind(new_language,t);+ update_language_menu(from_menu,grammar);+ set_initial_language(options,from_menu,grammar);+ + //modified and added for quiz+ //to_menu.onchange=bind(get_translations,t);+ to_menu.onchange=bind(change_tolang,t);+ + update_language_menu(to_menu,grammar);+ + //modified for quiz+ //insertFirst(to_menu,option("All","All"));+ //to_menu.value="All";++ new_language();+ + //added for quiz+ change_tolang();+ }+}++Minibar.prototype.clear_all1=function() {+ with(this) {+ remove_typed_input();+ current.input="";+ previous=null;+ surface.innerHTML="";+ translations.innerHTML="";+ }+ + //added for quiz+ document.answer.answer_text.value = "";+ document.explanation.explanation_text.value= ""; + document.getElementById("hint_txt").innerHTML = "";+}++Minibar.prototype.clear_all=function() {+ with(this) {+ clear_all1();+ get_completions();+ }+}++Minibar.prototype.get_completions=function() {+ + with(this) {+ //debug("get_completions ");+ words.innerHTML="...";+ + //modified for quiz+ server.complete(current.to,current.input,bind(show_completions,this));+ }+}++Minibar.prototype.show_completions=function(complete_output) {+ with(this) {+ //debug("show_completions ");+ var completions=complete_output[0].completions;+ var emptycnt=add_completions(completions)+ if(true/*emptycnt>0*/) get_translations();+ else translations.innerHTML="";+ if(surface.typed && emptycnt==completions.length) {+ if(surface.typed.value=="") remove_typed_input();+ }+ else add_typed_input();+ }+ + //added for quiz :updates the hint and prevents the check_notEmpty alert in show_hint when all words are deleted+ if (!(document.answer.answer_text.value == null || document.answer.answer_text.value ==""))+ { if (hint_times > 0 && hint_times < max_hint_times)+ show_hint();+ } + else + document.getElementById("hint_txt").innerHTML = "";+}++Minibar.prototype.add_completions=function(completions) {+ with(this) {+ if(words.timeout) clearTimeout(words.timeout),words.timeout=null;+ words.innerHTML="";+ words.completions=completions;+ words.word=[];+ var t=surface.typed ? surface.typed.value : "";+ var emptycnt=0;+ for(var i=0;i<completions.length;i++) {+ var s=completions[i];+ if(s.length>0) {+ var w=word(s);+ words.appendChild(w);+ words.word[i]=w;+ }+ else emptycnt++;+ }+ filter_completions(t,true);+ return emptycnt;+ }+}++Minibar.prototype.filter_completions=function(t,dim) {+ with(this) {+ if(words.timeout) clearTimeout(words.timeout),words.timeout=null;+ words.filtered=t;+ //if(dim) debug('filter "'+t+'"');+ var w=words.word;+ words.count=0;+ var dimmed=0;+ var prefix=""; // longest common prefix, for completion+ for(var i=0;i<w.length;i++) {+ var s=words.completions[i];+ var keep=hasPrefix(s,t);+ if(keep) {+ if(words.count==0) prefix=s;+ else prefix=(commonPrefix(prefix,s));+ words.count++;+ }+ if(dim) {+ w[i].style.opacity= keep ? "1" : "0.5";+ if(keep) w[i].style.display="inline";+ else dimmed++;+ }+ else + w[i].style.display=keep ? "inline" : "none";+ }+ words.theword=prefix;+ if(dimmed>0)+ words.timeout=setTimeout(function(){ filter_completions(t,false)},1000);+ }+}+ +Minibar.prototype.get_translations=function() {+ with(this) {+ var c=current;+ if(options.show_grouped_translations)+ server.translategroup(c.from,c.input,bind(show_groupedtranslations,this));+ else+ server.translate(c.from,c.input,bind(show_translations,this));+ }+}++Minibar.prototype.target_lang=function() {+ with(this) return langpart(to_menu.value,grammar.name);+}++Minibar.prototype.add_typed_input=function() {+ with(this) {+ var inp;+ if(surface.typed) inp=surface.typed;+ else {+ inp=empty("input","type","text");+ inp.value="";+ inp.setAttribute("accesskey","t");+ inp.style.width="10em";+ inp.onkeyup=bind(complete_typed,this);+ surface.appendChild(inp);+ surface.typed=inp;+ }+ inp.focus();+ }+}++Minibar.prototype.remove_typed_input=function() {+ with(this) {+ if(surface.typed) {+ surface.typed.parentNode.removeChild(surface.typed);+ surface.typed=null;+ }+ }+}++Minibar.prototype.complete_typed=function(event) {+ with(this) {+ //element("debug").innerHTML=show_props(event,"event");+ var inp=surface.typed;+ //debug('"'+inp.value+'"');+ var s=inp.value;+ var ws=s.split(" ");+ if(ws.length>1 || event.keyCode==13) {+ if(ws[0]!=words.filtered) filter_completions(ws[0],true);+ if(words.count==1) add_word(words.theword);+ else if(elem(ws[0],words.completions)) add_word(ws[0]);+ else if(words.theword.length>ws[0].length) inp.value=words.theword;+ }+ else if(s!=words.filtered) filter_completions(s,true)+ }+}++Minibar.prototype.generate_random=function() {+ var t=this;+ function show_random(random) {+ t.clear_all1();+ t.add_words(random[0].text);+ }+ + function lin_random(abs) {+ t.server.linearize(abs[0].tree,t.current.from,show_random);+ }+ t.server.get_random(lin_random);+}++Minibar.prototype.add_words=function(s) {+ with(this) {+ var ws=s.split(" ");+ for(var i=0;i<ws.length;i++)+ add_word1(ws[i]+" ");+ get_completions();+ }+ //added for quiz+ document.answer.answer_text.value += s+" "; +}++Minibar.prototype.word=function(s) { + var t=this;+ function click_word() {+ if(t.surface.typed) t.surface.typed.value="";+ t.add_word(s);+ }+ return button(s,click_word);+}++Minibar.prototype.add_word=function(s) {+ with(this) {+ add_word1(s+" ");+ if(surface.typed) {+ var s2;+ if(hasPrefix(s2=surface.typed.value,s)) {+ s2=s2.substr(s.length);+ while(s2.length>0 && s2[0]==" ") s2=s2.substr(1);+ surface.typed.value=s2;+ }+ else surface.typed.value="";+ }+ get_completions();+ }+ + //added for quiz+ document.answer.answer_text.value += s+" ";+}++Minibar.prototype.add_word1=function(s) {+ with(this) {+ previous={ input: current.input, previous: previous };+ current.input+=s;+ var w=span_class("word",text(s));+ if(surface.typed) surface.insertBefore(w,surface.typed);+ else surface.appendChild(w);+ }+}++Minibar.prototype.delete_last=function() {+ with(this) {+ if(surface.typed && surface.typed.value!="")+ surface.typed.value="";+ else if(previous) {+ current.input=previous.input;+ previous=previous.previous;+ if(surface.typed) {+ surface.removeChild(surface.typed.previousSibling);+ surface.typed.focus();+ }+ else surface.removeChild(surface.lastChild);+ translations.innerHTML="";+ + //added for quiz (to update the user answer area)+ var last_answer= document.answer.answer_text.value ;+ document.answer.answer_text.value = remove_last(last_answer);+ + get_completions();+ }+ }+}++ //added for quiz+ function remove_last(txt){+ var str = remove_unwanted_characters(txt);+ var ls= str.lastIndexOf(" ");+ if (ls > -1)+ return str.substring(0,ls ) + " ";+ else+ return "";+ }++Minibar.prototype.tdt=function(tree_btn,txt) {+ with(this) {+ return options.show_trees ? tda([tree_btn,txt]) : td(txt);+ }+}++Minibar.prototype.show_translations=function(translationResults) {+ with(this) {+ var trans=translations;+ //var to=target_lang(); // wrong+ var to=to_menu.value;+ var cnt=translationResults.length;+ //trans.translations=translations;+ trans.single_translation=[];+ trans.innerHTML="";+ /*+ trans.appendChild(wrap("h3",text(cnt<1 ? "No translations?" :+ cnt>1 ? ""+cnt+" translations:":+ "One translation:")));+ */+ for(p=0;p<cnt;p++) {+ var tra=translationResults[p];+ if (tra.translations != null) {+ for (q = 0; q < tra.translations.length; q++) {+ var t = tra.translations[q];+ var lin=t.linearizations;+ var tbody=empty("tbody");+ if(options.show_abstract && t.tree)+ tbody.appendChild(tr([th(text("Abstract: ")),+ tdt(abstree_button(t.tree),text(" "+t.tree))]));+ for(var i=0;i<lin.length;i++) + if(to=="All" || lin[i].to==to)+ tbody.appendChild(tr([th(text(langpart(lin[i].to,grammar.name)+": ")),+ tdt(parsetree_button(t.tree,lin[i].to),+ text(lin[i].text))]));+ trans.appendChild(wrap("table",tbody));+ }+ }+ else if(tra.typeErrors) {+ var errs=tra.typeErrors;+ for(var i=0;i<errs.length;i++)+ trans.appendChild(wrap("pre",text(errs[i].msg)))+ }+ }+ }+}++Minibar.prototype.show_groupedtranslations=function(translationsResult) {+ with(this) {+ var trans=translations;+ var to=target_lang();+ //var to=to_menu.value // wrong+ var cnt=translationsResult.length;+ //trans.translations=translationsResult;+ trans.single_translation=[];+ trans.innerHTML="";+ for(p=0;p<cnt;p++) {+ var t=translationsResult[p];+ if(to=="All" || t.to==to) {+ var lin=t.linearizations;+ var tbody=empty("tbody");+ if(to=="All") tbody.appendChild(tr([th(text(t.to+":"))]));+ for(var i=0;i<lin.length;i++) {+ if(to!="All") trans.single_translation[i]=lin[i].text;+ tbody.appendChild(tr([td(text(lin[i].text))]));+ if (lin.length > 1) tbody.appendChild(tr([td(text(lin[i].tree))]));+ }+ trans.appendChild(wrap("table",tbody));+ }+ }+ }+}++Minibar.prototype.append_extra_buttons=function(extra,options) {+ with(this) {+ if(options.try_google)+ extra.appendChild(button("Try Google Translate",bind(try_google,this)));+ if(options.feedback_url)+ appendChildren(extra,[text(" "),button("Feedback",bind(open_feedback,this))]);+ }+}++Minibar.prototype.try_google=function() {+ with(this) {+ var to=target_lang();+ var s=current.input;+ if(surface.typed) s+=surface.typed.value;+ var url="http://translate.google.com/?sl="+ +langpart(current.from,grammar.name);+ if(to!="All") url+="&tl="+to;+ url+="&q="+encodeURIComponent(s);+ window.open(url);+ }+}++Minibar.prototype.open_help=function() {+ with(this) open_popup(options.help_url,"help");+}++Minibar.prototype.open_feedback=function() {+ with(this) {+ // make the minibar state easily accessible from the feedback page:+ minibar.state={grammar:grammar,current:current,to:to_menu.value,+ translations:translations};+ open_popup(options.feedback_url,'feedback');+ }+}++function update_language_menu(menu,grammar) {+ // Replace the options in the menu with the languages in the grammar+ var lang=grammar.languages;+ menu.innerHTML="";+ + for(var i=0; i<lang.length; i++) {+ var ln=lang[i].name;+ if(!hasPrefix(ln,"Disamb")) {+ var lp=langpart(ln,grammar.name);+ menu.appendChild(option(lp,ln));+ }+ }+}++function set_initial_language(options,menu,grammar) {+ if(grammar.userLanguage) menu.value=grammar.userLanguage;+ else if(options.default_source_language) {+ for(var i=0;i<menu.options.length;i++) {+ var o=menu.options[i].value;+ var l=langpart(o,grammar.name);+ if(l==options.default_source_language) menu.value=o;+ }+ }+}++function langpart(conc,abs) { // langpart("FoodsEng","Foods") == "Eng"+ return hasPrefix(conc,abs) ? conc.substr(abs.length) : conc;+}++function abstree_button(abs) {+ var i=img(tree_icon);+ i.setAttribute("onclick","toggle_img(this)");+ i.other=server.current_grammar_url+"?command=abstrtree&tree="+encodeURIComponent(abs);+ return i;+}++function parsetree_button(abs,lang) {+ var i=img(tree_icon);+ i.setAttribute("onclick","toggle_img(this)");+ i.other=server.current_grammar_url+ +"?command=parsetree&from="+lang+"&tree="+encodeURIComponent(abs);+ return i;+}++function toggle_img(i) {+ var tmp=i.src;+ i.src=i.other;+ i.other=tmp;+}++function open_popup(url,target) {+ var w=window.open(url,target,'toolbar=no,location=no,status=no,menubar=no');+ w.focus();+}++function setField(form,name,value) {+ form[name].value=value;+ var el=element(name);+ if(el) el.innerHTML=value;+}++function opener_element(id) { with(window.opener) return element(id); }++// This function is called from feedback.html+function prefill_feedback_form() {+ var state=opener_element("minibar").state;+ var trans=state.translations;+ var gn=state.grammar.name+ var to=langpart(state.to,gn);++ var form=document.forms.namedItem("feedback");+ setField(form,"grammar",gn);+ setField(form,"from",langpart(state.current.from,gn));+ setField(form,"input",state.current.input);+ setField(form,"to",to);+ if(to=="All") element("translation_box").style.display="none";+ else setField(form,"translation",trans.single_translation.join(" / "));+ + // Browser info:+ form["inner_size"].value=window.innerWidth+"×"+window.innerHeight;+ form["outer_size"].value=window.outerWidth+"×"+window.outerHeight;+ form["screen_size"].value=screen.width+"×"+screen.height;+ form["available_screen_size"].value=screen.availWidth+"×"+screen.availHeight;+ form["color_depth"].value=screen.colorDepth;+ form["pixel_depth"].value=screen.pixelDepth;++ window.focus();+}+ ++/*+se.chalmers.cs.gf.gwt.TranslateApp/align-btn.png++GET /grammars/Foods.pgf?&command=abstrtree&tree=Pred+(This+Fish)+(Very+Fresh)+GET /grammars/Foods.pgf?&command=parsetree&tree=Pred+(This+Fish)+Expensive&from=FoodsAfr+GET /grammars/Foods.pgf?&command=alignment&tree=Pred+(This+Fish)+Expensive+*/
@@ -0,0 +1,56 @@++/* --- Grammar access object ------------------------------------------------ */++function pgf_online(options) {+ var server = {+ // State variables (private):+ grammars_url: "/grammars/",+ grammar_list: null,+ current_grammar_url: null,+ + // Methods:+ switch_grammar: function(grammar_url,cont) {+ this.current_grammar_url=this.grammars_url+grammar_url;+ if(cont) cont();+ },+ get_grammarlist: function(cont) {+ http_get_json(this.grammars_url+"grammars.cgi",cont);+ },+ pgf_call: function(cmd,args,cont) {+ var url=this.current_grammar_url+"?command="+cmd;+ for(var arg in args) url+="&"+arg+"="+encodeURIComponent(args[arg]);+ http_get_json(url,cont);+ },+ + get_languages: function(cont) {+ this.pgf_call("grammar",{},cont);+ },+ + get_random: function(cont) {+ this.pgf_call("random",{random:Math.random()},cont);+ },+ linearize: function(tree,to,cont) {+ this.pgf_call("linearize",{tree:tree,to:to},cont);+ },+ linearizeAll: function(tree,to,cont) {+ this.pgf_call("linearizeAll",{tree:tree,to:to},cont);+ },+ complete: function(from,input,cont) {+ this.pgf_call("complete",{from:from,input:input},cont);+ },+ parse: function(from,input,cont) {+ this.pgf_call("parse",{from:from,input:input},cont);+ },+ translate: function(from,input,cont) {+ this.pgf_call("translate",{from:from,input:input},cont);+ },+ translategroup: function(from,input,cont) {+ this.pgf_call("translategroup",{from:from,input:input},cont);+ }+ + };+ for(var o in options) server[o]=options[o];+ if(server.grammar_list && server.grammar_list.length>0)+ server.switch_grammar(server.grammar_list[0]);+ return server;+}
@@ -0,0 +1,50 @@+<!-- Copyright © Elnaz Abolahrar, 2011 --> +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<title>Quiz About</title> +<link rel=stylesheet type="text/css" href="minibar_quiz.css"> + +<meta name = "viewport" content = "width = device-width"> +<meta http-equiv="Content-type" content="text/html; charset=UTF-8"> +<meta charset="UTF-8"> + +</head> + +<body> + +<h3>About GF Translation Quiz </h3> + +<p style="font-size:18px;"> + This project is actually part of my master thesis work at <a href="http://chalmers.se/en/Pages/default.aspx" >Chalmers University of Technology</a> + , in the Language Technology group under supervision of Professor <a href="http://www.cse.chalmers.se/~aarne/">Aarne Ranta.</a> The application + is an exercise generator to be used in training the lexical, morphological and syntactic aspects of human languages. + One important aspect of this application is that it is intended to be as general as possible and specially not + to be limited to any specific human language. For this purpose GF’s (The <a href="http://www.grammaticalframework.org/" >Grammatical Framework </a>) + Resource Grammar Libraries have been applied as the constructive core of the project. The application also uses the + <a href="http://code.google.com/p/grammatical-framework/wiki/GFWebServiceAPI" >GF web services API </a> + which has made it possible to apply the PGF API as Web Service, to be more precise the Quiz uses the additional API for JavaScript defined in pgf_online.js provided by the + <a href="http://www.grammaticalframework.org:41296/minibar/minibar.html"> Minibar </a> application. + The Quiz also relies on the Minibar, + in the "Easy Study Mode" of the Quiz, where word magnets from the Minibar are available to help the user construct his/her answer. +</p> +<p style="font-size:18px;"> The generated exercises are in the preliminary form of sentences + in a certain language - selected by the user - which need to be translated to another one - which is also the user's choice. + The user may choose the grammar he/she wants to train with as well. More information about how the quiz works can be found from the + <a href="quiz_help.html" >link </a> in the Quiz main page. + +</p> + +<br/> + Author: <i><b> Elnaz Abolahrar </b></i> (elnaz dot abolahrar at gmail dot com) +<br/> + Date: December, 2010 - Göteborg, Sweden +<br/> +<br/> + +<br/> +<div class="shift_left"><a href="javascript: window.close()">Close page</a></div> + +</body> + +</html>
@@ -0,0 +1,46 @@+<!-- Copyright © Elnaz Abolahrar, 2011 --> +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<title>Quiz Help</title> +<link rel=stylesheet type="text/css" href="minibar_quiz.css"> + +<meta name = "viewport" content = "width = device-width"> +<meta http-equiv="Content-type" content="text/html; charset=UTF-8"> +<meta charset="UTF-8"> + +</head> + +<body> +<a href="quiz_about.html" >About GF Translation Quiz </a> + +<h3>• How the Quiz works? </h3> + +<p style="font-size:18px;"> + <b>Hint:</b> You will find the Hint button very handy in all quiz modes. In fact it works very much similar to the famous <a href="http://en.wikipedia.org/wiki/Mastermind_(board_game)">Mastermind</a> game. Words in green stand for correct words in their correct place in the sentence, and yellow words mean these words are correct words and are part of the right answer but they are misplaced, while red words stand for words which do not exist in the right answer and are either misspelled or totally wrong lexically or grammatically. +<br/><br/> + <b>Check Answer:</b> You can check whether your answer is right by either clicking on this button or pressing the Enter/Return key of your keyboard. (Exception: In the "Easy Study Mode" you cannot use the Enter/Return key for checking your answer, because it has another functionality which is adding typed words to your answer.) Please note that by checking your answer you also submit it, and for each question you have only one submission chance to increase your score - further submissions don't have any impact on your score. Use the Hint if you are not sure and of course if it is available. Also note that Check Answer moves you automatically to the next question if your answer is right. +<br/><br/> + <b>History:</b> At the end of the quiz, either if you end it manually by pressing the "End" button or when the quiz ends itself e.g. when you pass the quiz or at the end of an exam, you will get a "Show Quiz History" button by which you may review and print the whole questions together with your answers and the programs' feedback. +</p> +<hr> + +<h3>• How different are different Quiz Modes? </h3> + +<p style="font-size:18px;"> <b>Easy Study Mode: </b> +In this mode word magnets are available to help you; you can type and/or click on them freely to construct your answer. Use "⌫" (Delete last) <!--img border="0" src="Delete_button.jpg" alt="⌫" width="30" height="17" /--> and "Clear" buttons to delete the last word or all of your answer in case required. Theses words come from the grammar you have chosen, and therefore it keeps you from mistyping words and even making grammatically wrong sentences. Also you have unlimited Hint which is automatically updated as you modify your answer. You can also go to one previous question at a time and of course check your answer's correctness. +<br/><br/><b>Medium Study Mode: </b> +In this mode you can use the Hint button for a maximum of 3 times for each question, and you have the possibility of going to one previous question at a time as well as checking your answer's correctness. +<br/><br/><b>Hard Study Mode: </b> +In this mode you can use the Hint button only once for each question, and you may not use the Previous question button however you may check your answer's correctness. +<br/><br/><b>Exam Mode: </b> +In this mode you cannot use the Hint, Previous question or Check answer buttons, and you will not see your score until the end of the exam. +</p> + +<br/> +<div class="shift_left"><a href="javascript: window.close()">Close page</a></div> + +</body> + +</html> +
@@ -0,0 +1,64 @@+// Copyright © Elnaz Abolahrar, 2011 + +// pre_start: runs on load time before evrything else to prepare the quiz + +function pre_start() +{ + hide_element('history_part'); + hide_element('toggle_show'); + + default_values(); + + var quiz_mode=empty_id("select","quiz_mode"); + + //adds the "Quiz Mode" and "Restart Quiz" and "End Quiz" and "Start Quiz" + appendChildren(minibar.quizbar, + [text(" Quiz Mode: "), quiz_mode, + button("Restart Quiz","restart_quiz()","R"), + button("End Quiz","end_quiz(true)","E"), + button("Start Quiz","start_quiz()","S")]); + + + //adds the "Next Question" and "Previous Question" and "Hint" and "Check Answer" buttons + var buttons_bar=element("buttons_bar"); + appendChildren(buttons_bar, + [button("< Previous Question","previous_question_quiz()","B", "previous_question"), + button("Next Question >","generate_question()","N", "next_question"), + button("Hint","show_hint()","H", "hint"), + submit_button("Check Answer", "check_answer")]); + + disable_all(); + + //hide the minibar word magnets + hide_element('minibar_contin'); + + //hide the delete and clear buttons + hide_element('minibar_buttons'); + + mode_options(quiz_mode); +} + + +function mode_options(quiz_mode) + { + var opt=empty("option"); + opt.setAttribute("value","Easy Study Mode"); + opt.innerHTML="Easy Study Mode"; + quiz_mode.appendChild(opt); + + var opt=empty("option"); + opt.setAttribute("value","Medium Study Mode"); + opt.innerHTML="Medium Study Mode"; + quiz_mode.appendChild(opt); + + var opt=empty("option"); + opt.setAttribute("value","Hard Study Mode"); + opt.innerHTML="Hard Study Mode"; + quiz_mode.appendChild(opt); + + var opt=empty("option"); + opt.setAttribute("value","Exam Mode"); + opt.innerHTML="Exam Mode"; + quiz_mode.appendChild(opt); + } +
@@ -0,0 +1,248 @@+// Copyright © Elnaz Abolahrar and Thomas Hallgren, 2011 + +function hide_element(elem_id) +{ + document.getElementById(elem_id).style.display="none"; +} + +function show_element(elem_id) +{ + document.getElementById(elem_id).style.display=""; +} + +function toggle_info() +{ + if ( info_hidden == true ) + { + show_element("info"); + hide_element("toggle_show"); + show_element("toggle_hide"); + info_hidden = false; + } + else + { + hide_element("info"); + show_element("toggle_show"); + hide_element("toggle_hide"); + info_hidden = true; + } +} + +function show_word_magnets() +{ + if ( words_hidden == true ) + { + show_element("words"); + words_hidden= false; + var buttons_bar=element("buttons_bar"); + buttons_bar.removeChild(buttons_bar.lastChild); + } +} + +function hide_word_magnets() +{ + if ( words_hidden == false ) + { + hide_element("words"); + words_hidden= true; + + //add "Show magnets" button + var buttons_bar=element("buttons_bar"); + appendChildren(buttons_bar, + [ button("Show Magnets","show_word_magnets()","M", "show_magnets")]); + } +} + +function popUp(newPage, pageName) +{ + window.open(newPage, pageName, "dependent = 1, scrollbars=1, location=1, statusbar=1, width=540, height=650, left = 10, top = 20"); +} + + +function disable_all() +{ + //disables the "Hint", "Check Answer", "Next Question" and "Previous Question" buttons + user answer area + document.getElementById('check_answer').disabled = true; + document.getElementById('next_question').disabled = true; + document.getElementById('previous_question').disabled = true; + document.getElementById('hint').disabled = true; + document.getElementById('user_answer').disabled = true; +} + +function set_mode() +{ + //disable the grammar - To - From languages, and mode menubar + document.getElementById('grammar_menu').disabled = true; + document.getElementById('from_menu').disabled = true; + document.getElementById('to_menu').disabled = true; + document.getElementById('quiz_mode').disabled = true; + + + selected_mode = element("quiz_mode").value; + + //sets the Quiz mode displayed + document.getElementById('mode').value = selected_mode; + +/*-------------------------------------- Modes Settings --------------------------------------*/ + switch (selected_mode) + { + case "Easy Study Mode": + have_minibar = true; + have_prevQuestion = true; + have_checkAns = true; + max_hint_times = 100; + break; + + case "Medium Study Mode": + have_minibar = false; + have_prevQuestion = true; + have_checkAns = true; + max_hint_times = 3; + break; + + case "Hard Study Mode": + have_minibar = false; + have_prevQuestion = false; + have_checkAns = true; + max_hint_times = 1; + break; + + case "Exam Mode": + have_minibar = false; + have_prevQuestion = false; + have_checkAns = false; + max_hint_times = 0; + break; + } +} + +function reset_mode() +{ + //enable the grammar - To - From languages, and mode menubar + document.getElementById('grammar_menu').disabled = false; + document.getElementById('from_menu').disabled = false; + document.getElementById('to_menu').disabled = false; + document.getElementById('quiz_mode').disabled = false; + + //clears the Quiz mode displayed + document.getElementById('mode').value = ""; +} + +function remove_minibar() +{ + if (have_minibar && is_ended == false ) + { + //hide the minibar word magnets + hide_element("minibar_contin"); + + //hide the delete and clear buttons + hide_element("minibar_buttons"); + } +} + +function remove_unwanted_characters(txt) +{ + //removes digits, special characters and extra spaces from user's answer + txt = txt.replace(/[\u0021-\u0026 \u0028-\u0040 \u005b-\u0060 \u007b-\u007e]+/g,' ').replace(/^\s+|\s+$/g,'').replace(/\s+/g,' '); + + //changes the first character to lowercase + txt= txt.replace(txt.charAt(0),txt.charAt(0).toLowerCase()); + + return txt; +} + +function split_to_words(str) +{ + if (!(str == "" || str == null)) + str = str.split(" "); + else + str = ""; + + return str; +} + +function string_matching(serv_answer,use_answer) +{ + var result = new Array(); + + //for empty answers + if ( use_answer== "" || use_answer== null) + result= ""; + else + { + var min_length = Math.min(serv_answer.length, use_answer.length); + + var i=0; + for (i= 0; i < min_length; i++) + { + if (serv_answer[i] == use_answer[i]) + result[i] = 1; + else + result[i] = 0; + } + //for answers with extra words (more than the number of words in the right answer) + while ( i < use_answer.length) + { + result[i] = 0; + i++; + } + } + + return result; +} + +function sum_all(arr) { + var s = 0; + for (var i = 0; i < arr.length; i++) + { + s += arr[i]; + } + return s; +} + +function find_closest(all_ans) +{ + var best_match = new Array(); + var comp = new Array(); + var server_answer2 = new Array(); + var max=0; + var k = 0; + for (k= 0; k < all_ans.length; k++) + { + server_answer = remove_unwanted_characters(all_ans[k]); + server_answer2 = split_to_words(server_answer); + + comp = string_matching(server_answer2, user_answer_splited); + var sum = sum_all(comp); + if (sum >= max) + { + best_match = server_answer2; + max= sum; + } + } + return best_match; +} + +function clearing() +{ + //clears the question, answer and the explanation and hint display areas + document.question.question_text.value= "..."; + document.answer.answer_text.value = ""; + document.explanation.explanation_text.value= ""; + document.getElementById("hint_txt").innerHTML = ""; +} + +//checks that the answer field is not empty +function check_notEmpty() +{ + if (document.answer.answer_text.value == null || document.answer.answer_text.value =="") + { + alert(" You have to write something first!"); + //sets the focus on the answer area + document.answer.answer_text.focus(); + + return false; + } + else + return true; +}
@@ -0,0 +1,285 @@+/* --- Accessing document elements ------------------------------------------ */++function element(id) {+ return document.getElementById(id);+}++/* --- JavaScript tricks ---------------------------------------------------- */++// To be able to object methods that refer to "this" as callbacks+// See section 3.3 of https://github.com/spencertipping/js-in-ten-minutes/raw/master/js-in-ten-minutes.pdf+function bind(f, this_value) {+ return function () {return f.apply (this_value, arguments)};+};++/* --- JSONP ---------------------------------------------------------------- */++// Inspired by the function jsonp from +// http://www.west-wind.com/Weblog/posts/107136.aspx+// See also http://niryariv.wordpress.com/2009/05/05/jsonp-quickly/+// http://en.wikipedia.org/wiki/JSON#JSONP+function jsonp(url,callback)+{ + if (url.indexOf("?") > -1)+ url += "&jsonp=" + else+ url += "?jsonp=" + url += callback;+ //url += "&" + new Date().getTime().toString(); // prevent caching + + var script = empty("script"); + script.setAttribute("src",url);+ script.setAttribute("type","text/javascript"); + document.body.appendChild(script);+}++var json = {next:0};++// Like jsonp, but instead of passing the name of the ballback function, you +// pass the callback function directly, making it possible to use anonymous+// functions.+function jsonpf(url,callback)+{+ var name="callback"+(json.next++);+ json[name]=function(x) { delete json[name]; callback(x); }+ jsonp(url,"json."+name);+}++/* --- AJAX ----------------------------------------------------------------- */++function GetXmlHttpObject(handler)+{ + var objXMLHttp=null+ if (window.XMLHttpRequest)+ {+ objXMLHttp=new XMLHttpRequest()+ }+ else if (window.ActiveXObject)+ {+ objXMLHttp=new ActiveXObject("Microsoft.XMLHTTP")+ }+ return objXMLHttp+}++function ajax_http_get(url,callback) {+ var http=GetXmlHttpObject()+ if (http==null) {+ alert ("Browser does not support HTTP Request")+ return+ } + var statechange=function() {+ if (http.readyState==4 || http.readyState=="complete") {+ if(http.status==200) callback(http.responseText);+ else alert("Request for "+url+" failed: "+ +http.status+" "+http.statusText);+ }+ }+ http.onreadystatechange=statechange;+ http.open("GET",url,true)+ http.send(null)+ //dump("http get "+url+"\n")+ return http+}++// JSON via AJAX+function ajax_http_get_json(url,cont) {+ ajax_http_get(url,function(txt) { cont(eval("("+txt+")")); });+}++function sameOrigin(url) {+ return hasPrefix(url,location.protocol+"//"+location.host+"/");+}++// Use AJAX when possible, fallback to JSONP+function http_get_json(url,cont) {+ if(sameOrigin(url)) ajax_http_get_json(url,cont);+ else jsonpf(url,cont);+}+++/* --- HTML construction ---------------------------------------------------- */+function text(s) { return document.createTextNode(s); }++function node(tag,as,ds) {+ var n=document.createElement(tag);+ for(var a in as) n.setAttribute(a,as[a]);+ for(var i in ds) n.appendChild(ds[i]);+ return n;+}++function empty(tag,name,value) {+ var el=node(tag,{},[])+ if(name && value) el.setAttribute(name,value);+ return el;+}++function empty_id(tag,id) { return empty(tag,"id",id); }+function empty_class(tag,cls) { return empty(tag,"class",cls); }++function div_id(id) { return empty_id("div",id); }+function span_id(id) { return empty_id("span",id); }++function wrap(tag,contents) { return node(tag,{},[contents]); }++function wrap_class(tag,cls,contents) {+ var el=empty_class(tag,cls);+ if(contents) el.appendChild(contents);+ return el;+}++function span_class(cls,contents) { return wrap_class("span",cls,contents); }+function div_class(cls,contents) { return wrap_class("div",cls,contents); }++function p(contents) { return wrap("p",contents); }+function dt(contents) { return wrap("dt",contents); }+function li(contents) { return wrap("li",contents); }++function th(contents) { return wrap("th",contents); }+function td(contents) { return wrap("td",contents); }++function tr(cells) { return node("tr",{},cells); }++//modified for quiz (id added)+function button(label,action,key ,id) {+ var el=node("input",{"type":"button","value":label},[]);+ if(typeof action=="string") el.setAttribute("onclick",action);+ else el.onclick=action;+ if(key) el.setAttribute("accesskey",key);+ if(id) el.setAttribute("id",id);+ return el;+}++//added for quiz+function submit_button(label, id) {+ var el=empty("input","type","submit");+ el.setAttribute("value",label);+ if(id) el.setAttribute("id", id);+ return el;+}++function option(label,value) {+ return node("option",{"value":value},[text(label)]);+}++function appendChildren(el,ds) {+ for(var i in ds) el.appendChild(ds[i]);+ return el;+}++function insertFirst(parent,child) {+ parent.insertBefore(child,parent.firstChild);+}++function tda(cs) { return node("td",{},cs); }++function img(src) { return empty("img","src",src); }++/* --- Debug ---------------------------------------------------------------- */++function debug(s) {+ var d=element("debug");+ if(d) d.appendChild(text(s+"\n"))+}++function show_props(obj, objName) {+ var result = "";+ for (var i in obj) {+ result += objName + "." + i + " = " + obj[i] + "<br>";+ }+ return result;+}++function field_names(obj) {+ var result = "";+ for (var i in obj) {+ result += " " + i;+ }+ return result;+}++/* --- Data manipulation ---------------------------------------------------- */+function swap(a,i,j) { // Note: this doesn't work on strings.+ var tmp=a[i];+ a[i]=a[j];+ a[j]=tmp;+ return a;+}++function sort(a) {+// https://developer.mozilla.org/en/Core_JavaScript_1.5_Reference/Global_Objects/Array/sort+ return a.sort();+ /* // Note: this doesn't work on strings.+ for(var i=0;i<a.length-1;i++) {+ var min=i;+ for(var j=i+1;j<a.length;j++)+ if(a[j]<a[min]) min=j;+ if(min!=i) swap(a,i,min);+ }+ return a;+ */+}++function filter(p,xs) {+ var ys=[];+ for(var i=0;i<xs.length;i++)+ if(p(xs[i])) ys[ys.length]=xs[i];+ return ys;+}++function implode(cs) { // array of strings to string+ /*+ var s="";+ for(var i=0;i<cs.length;i++)+ s+=cs[i];+ return s;+ */+ return cs.join("");+}++function hasPrefix(s,pre) { return s.substr(0,pre.length)==pre; }++function commonPrefix(s1,s2) {+ for(var i=0;i<s1.length && i<s2.length && s1[i]==s2[i];i++);+ return s1.substr(0,i);+}++/*+function all(p,xs) {+ for(var i=0;i<xs.length;i++)+ if(!p(xs[i])) return false;+ return true;+}+*/++function map(f,xs) {+ var ys=[];+ for(var i=0;i<xs.length;i++) ys[i]=f(xs[i]);+ return ys;+}++// map in continuation passing style +function mapc(f,xs,cont) { mapc_from(f,xs,0,[],cont); }++function mapc_from(f,xs,i,ys,cont) {+ if(i<xs.length)+ f(xs[i],function(y){ys[i]=y;mapc_from(f,xs,i+1,ys,cont)});+ else+ cont(ys);+}++function overlaps(as,bs) {+ for(var i=0;i<as.length;i++)+ if(elem(as[i],bs)) return true;+ return false;+}++function elem(a,as) {+ for(var i=0;i<as.length;i++)+ if(a==as[i]) return true;+ return false;+}++function shuffle(a) {+ for(i=0;i<a.length;i++) swap(a,i,Math.floor(Math.random()*a.length))+ return a;+}
@@ -0,0 +1,165 @@+<!-- Copyright © Elnaz Abolahrar, 2011 --> +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<title>GF Translation Quiz</title> + +<link rel=stylesheet type="text/css" href="minibar_quiz.css"> + +<meta name = "viewport" content = "width = device-width"> +<meta http-equiv="Content-type" content="text/html;charset=UTF-8"> +<meta charset="UTF-8"> + +<script type="text/JavaScript" src="support.js"></script> +<script type="text/JavaScript" src="minibar_quiz.js"></script> +<script type="text/JavaScript" src="pgf_online.js"></script> +<script type="text/JavaScript" src="quiz_support.js"></script> +<script type="text/javascript" src="translation_quiz.js"></script> +<script type="text/JavaScript" src="quiz_pre_start.js"></script> + +</head> + +<body> + +<div id = "info" > +<a href="javascript:popUp('quiz_about.html', 'about')">About GF Translation Quiz</a> +<h2 style=" padding-left: 35px;"><i> Welcome to GF Translation Quiz </i></h2> + +<p style="font-size:20px;"> + To start the quiz choose a grammar, From and To languages + <br/> as well as a quiz mode, then press the "Start Quiz" button. + <br/> <b>Note:</b> You may not change these settings in the middle of + <br/> a quiz. + The quiz is over when you have done at least + <span style="color:#2E8B57;"><b><script type="text/javascript"> document.write(min_no_questions); </script></b></span> + <br/>examples with a minimum success of + <span style="color:#2E8B57;"><b><script type="text/javascript"> document.write(pass_percentage * 100); </script> % </b></span> + . However <br/> you can restart or quit the quiz + at any time by clicking <br/>on the "Restart Quiz" or "End Quiz" buttons. +</p> + +<a style="font-size:18px;" href="javascript:popUp('quiz_help.html', 'help')">Click here to learn more about how the Quiz works.</a> +<br/> + +</div> + +<div id = "toggle_hide"; class="shift_left"; ><a href="javascript: toggle_info()">Hide Information</a></div> +<div id = "toggle_show"; class="shift_left"; ><a href="javascript: toggle_info()">Show Information</a></div> + +<hr noshade size=0 /> + +<div id = "minibar1" class="bold"> +</div> + +<hr noshade size=0 /> + +<table frame="void" cellpadding="5" > + <tr> + <td><b>Quiz Question:</b></td> + </tr> + <tr> + <td> + <form name="question"> + <textarea class="quest" name="question_text" wrap="virtual" readonly="true"> + </textarea> + </form> + </td> + </tr> +</table> + +<form name="answer" onsubmit="check_answer_quiz(); return false;"> + <fieldset> + + <legend><b>Your Answer: </b></legend> + <div id = "minibar_buttons" class="shift_left";></div> + <div id = "minibar_contin"></div> + <table cellpadding="2"> + <tr> + <td> + <input class="answer1" type="text" id="user_answer" name="answer_text" value="" /> + </td> + </tr> + <tr> + <td> + <div id="hint_txt" class="hint"> + </td> + </tr> + + <tr> + <td> + <div id = "buttons_bar"></div> + </td> + </tr> + <tr> + <td> + <div id = "history_bar"></div> + </td> + </tr> + </table> + + </fieldset> +</form> + + +<table frame="void" cellpadding="5" > + <tr> + <td><b>Explanation:</b></td> + </tr> + <tr> + <td> + <form name="explanation"> + <textarea class="explain" name="explanation_text" wrap="virtual" readonly="true"> + </textarea> + </form> + </td> + </tr> +</table> + +<table cellpadding="1" cellspacing="10"> + <tr> + <td><b>Current Quiz Mode:</b></td> + <td><b>Answered Questions</b></td> + <td><b>Your Score</b></td> + </tr> + <tr> + <td><input type="text" id="mode" style="border: 0; text-align:left; color:#CD5C5C; background-color:#ccc;" class="number" size="18" readonly="true"/></td> + <td><input type="text" id="counter_display" class="number" size="4" readonly="true" value="0" /></td> + <td><input type="text" id="score_display" style="color:#2E8B57" class="number" size="3" readonly="true" value="0" /></td> + </tr> +</table> + +<div id="history_part"> +</div> + +<script type="text/javascript"> + + var online_options={ + //grammars_url: "http://www.grammaticalframework.org/grammars/" + //grammars_url: "http://tournesol.cs.chalmers.se:41296/grammars", + //grammars_url: "http://localhost:41296/grammars", + //grammar_list: ["Foods.pgf"], // leave undefined to get list from server + } + + if(/^\?\/tmp\//.test(location.search)) { + online_options.grammars_url=location.search.substr(1); + } + + var server=pgf_online(online_options); + + var minibar_options= { + show_abstract: false, + show_trees: false, + show_grouped_translations: false, + default_source_language: "Eng", + try_google: false + } + + var minibar=new Minibar(server,minibar_options,"minibar1"); + + pre_start(); + +</script> + +</body> + +</html>
@@ -0,0 +1,766 @@+// Copyright © Elnaz Abolahrar, 2011 + +// translation_quiz.js, assumes that quiz_support.js has also been loaded + +/*-------------------------------------- Configuration Variables --------------------------------------*/ + +var pass_percentage = 0.75; +var min_no_questions = 10; +var exam_quesNo = 10; // sets the number of questions appearing in an exam +var max_answer_times = 1; // the max limit for the user to increase his/her score + + +/*-------------------------------------- other Variables --------------------------------------*/ + +var grammar; +var question_lang; +var answer_lang; + +//saves the random tree generated by the server in generate_question function to be used by the check_answer +var rand_tree; + +var counter; +var score; +var confirmed_check = new Boolean(true); +var prev_pressed = new Boolean(); + +var prev_question; +var prev_explanation; +var prev_answer; +var prev_hint; +var current_question; +var current_answer; +var current_explanation= ""; +var current_hint; + +//for history +var quiz_history = []; +var history_shown= new Boolean(); +var index =0; + +//for check answer +var answer_was_right= new Boolean(); +var raw_user_answer; +var user_answer; +var user_answer_splited; +var server_answer; +var all_answers = []; +var parsed_trees = 0; +var words_hidden = new Boolean(); + +var answer_times ; +var hint_times ; +var hint_pressed = new Boolean(); +var restart_active = new Boolean(); +var is_ended = new Boolean(); +var info_hidden = new Boolean(); + +//modes variables +var have_minibar = new Boolean(); +var have_prevQuestion = new Boolean(); +var have_checkAns = new Boolean(); +var max_hint_times; +var selected_mode; + +/*-------------------------------------- Functions --------------------------------------*/ + + +function default_values() +{ + //resets the question, answer and the explanation and hint display areas + document.question.question_text.value= "Quiz questions will be displayed here."; + document.answer.answer_text.value = " "; + document.explanation.explanation_text.value= "Explanations are displayed here."; + document.getElementById("hint_txt").innerHTML = ""; + + //resets some flags + prev_pressed = false; + is_ended = false; //refering to the End button or end o quiz by score or end of exam + restart_active = false; //refering to the Restart button + hint_pressed = false; + answer_was_right= false; + history_shown= false; + + //resets the counter and score displays and some variables + answer_times = 1; + counter = 0; + score = 0; + hint_times =0; + document.getElementById('counter_display').value = counter; + document.getElementById('score_display').value = score; + + //resets the variables for keeping the history + quiz_history = []; + index =0; + var history=element("history_part"); + history.innerHTML =""; + + //resets the variables for keeping the parsing and linearization altenatives + parsed_trees = 0; + all_answers = []; + + //shows the normal user answer area + show_element("user_answer"); +} + +function start_quiz() +{ + //sets the grammar and From and To languages + grammar= minibar.grammar_menu.value; + question_lang= minibar.from_menu.value; + answer_lang= minibar.to_menu.value; + + //removes the start button + minibar.quizbar.removeChild(minibar.quizbar.lastChild); + + set_mode(); + + //shows the minibar area and buttons + var buttons_bar=element("buttons_bar"); + if (have_minibar) + { + //show the minibar word magnets + show_element("minibar_contin"); + + //show the delete and clear buttons + show_element("minibar_buttons"); + + //hides the normal user answer area + hide_element("user_answer"); + + //changes the "Check Answer" button to a none_submit one + buttons_bar.removeChild(buttons_bar.lastChild); + appendChildren(buttons_bar, + [ button("Check Answer","check_answer_quiz()","C", "check_answer")]); + } + else + { + //enable the user answer area + document.getElementById('user_answer').disabled = false; + + //hide the minibar word magnets + hide_element("minibar_contin"); + + //hide the delete and clear buttons + hide_element("minibar_buttons"); + + //changes the "Check Answer" button to a submit one + buttons_bar.removeChild(buttons_bar.lastChild); + appendChildren(buttons_bar, + [ submit_button("Check Answer", "check_answer")]); + } + + //conditionally enbles the "Hint", "Check Answer", "Next Question" and "Previous Question" buttons, and the minibar + + if (have_checkAns) + document.getElementById('check_answer').disabled = false; + else + document.getElementById('check_answer').disabled = true; + + if (have_prevQuestion) + document.getElementById('previous_question').disabled = false; + + if ( max_hint_times > 0 ) + document.getElementById('hint').disabled = false; + + document.getElementById('next_question').disabled = false; + + //generates the first quiz question + generate_question(); + + //resets the restart_active + restart_active= true ; + + //hides the information + if ( info_hidden == false ) + toggle_info(); +} + +function restart_quiz() +{ + //javascript:location.reload(true); + + if (restart_active == true) + { + var end_confirmed= new Boolean(true); + + if (!is_ended ) + end_confirmed = confirm(" Are you sure you want to quit this quiz!"); + + if (end_confirmed) + { + end_quiz(false); + + reset_mode(); + + //add the start button + appendChildren(minibar.quizbar,[ button("Start Quiz","start_quiz()","S")]); + + //removes the History button + var history_bar=element("history_bar"); + history_bar.removeChild(history_bar.lastChild); + + default_values(); + } + } +} + +function generate_question() +{ + //for the exam mode + if (selected_mode == "Exam Mode") + { + if (check_notEmpty()) + { + if (counter > 0) + { + document.getElementById('score_display').value = "?"; + + //save the current user answer for history + current_answer = document.answer.answer_text.value; + quiz_history[index][1] = current_answer; + + make_all_answers(); + } + else + exam_continue(); + } + } + else + { + if (prev_pressed == true ) + { + //changes the question, answer and the explanation back to the current one + document.question.question_text.value= current_question; + document.answer.answer_text.value = current_answer; + document.explanation.explanation_text.value= current_explanation; + document.getElementById("hint_txt").innerHTML = current_hint; + + prev_pressed = false; // to go back to normal + + //enables the "Previous Question","Hint" and "Check Answer" buttons + document.getElementById('previous_question').disabled = false; + document.getElementById('check_answer').disabled = false; + document.getElementById('hint').disabled = false; + } + else + { + // if the user clicks the "Next Question" without cheking his/her previous answer, + // asks for user's confirmation before moving to the next question + if ( answer_times == 0 ) + { + confirmed_check = confirm("Are you sure you don't want to check your answer's correctness!"); + + if ( hint_times == 0 ) + { + //saves the current answer and the explanation which is null(the answer was not checked or hinted) + current_answer = document.answer.answer_text.value; + + current_explanation = "You did not check your answer's correctness!"; + + current_hint = ""; + } + //save the current user answer for history + quiz_history[index][1] = document.answer.answer_text.value; + + //save the current explanation for history + quiz_history[index][2] = "You did not check your answer's correctness!"; + } + if (confirmed_check == true ) + { + //save the current question for the "previous question" button and history + prev_question = current_question; + + //save the current answer for the "previous question" button + prev_answer = current_answer; + + //save the current explanation and hint for the "previous question" button + prev_explanation = current_explanation; + prev_hint= current_hint; + + //clears the question, answer and the explanation and hint display areas + clearing(); + + if (have_minibar) + { + minibar.clear_all(); + + //unhides the words area and removes the "Show Magnets" button + show_word_magnets(); + } + + if (answer_was_right) //here it still contains info about the previous question + document.explanation.explanation_text.value= current_explanation; + + //resets the times user has answered to the current question + answer_times = 0; + + //resets the times user has pressed hint for the current question + hint_times = 0; + + document.getElementById('counter_display').value = counter; + //increments the counter + counter= ++ counter; + + //sends a question retrival request to the server + server.get_random(generate_question2); + } + } + } + //sets the focus on the answer area + document.answer.answer_text.focus(); +} + +function generate_question2(random_trees) +{ + //we now have a random abstract syntax tree that we need to linearize + server.pgf_call("linearizeAll",{tree:random_trees[0].tree, + to:question_lang}, generate_question3); + rand_tree= random_trees[0].tree; +} + +function generate_question3(random_texts) +{ + var no_of_lins = random_texts[0].texts.length; + + //generates a random number, to determine which linearization should be used as the question + var which= Math.floor(Math.random()* no_of_lins ); + if (which >= no_of_lins) + which = which - 1; + + //display the new quiz quetion sent by server + document.question.question_text.value= counter +". " + random_texts[0].texts[which]; + + //save the current question for the "previous question" button and history + current_question = document.question.question_text.value; + index = quiz_history.length; + quiz_history[index] = []; + quiz_history[index][0]= current_question; +} + +function check_answer_quiz() +{ + if (check_notEmpty()) + { + //resets the user confirmation for moving to next question without checking the answer + confirmed_check = true; + + //clears the explanation and Hint display area + document.explanation.explanation_text.value = ""; + document.getElementById("hint_txt").innerHTML = ""; + + //save the current user answer for the "peivious question" button and history + current_answer = document.answer.answer_text.value; + quiz_history[index][1] = current_answer; + + //increments the times the user has answered to the current question + answer_times ++; + + //resets the hint_pressed flag + hint_pressed = false; + + if ((answer_times + hint_times) <= 1) + make_all_answers(); + else + continue_checking(); + } +} + +function make_all_answers() +{ + //resets the variables for keeping the parsing and linearization altenatives + parsed_trees = 0; + all_answers = []; + + //we now need to linearize the random abstract syntax tree in order to + //find all possible correct answers then we check user's answer against these answers. + server.pgf_call("linearize",{tree:rand_tree, to:question_lang}, parse_answer); +} + +function parse_answer(right_answer) +{ + server.parse(question_lang,right_answer[0].text, parse_answer2); +} + +var trees_to_go; +function parse_answer2(parsed_answer) +{ + trees_to_go = parsed_trees = parsed_answer[0].trees.length; + var j =0; + for (j= 0; j < parsed_trees ; j++) + { + server.linearizeAll(parsed_answer[0].trees[j], answer_lang, collect_answers); + } +} + +function collect_answers(lin_answer) +{ + var next= 0; + var i=0; + for (i= 0; i < lin_answer[0].texts.length ; i++) + { + next = all_answers.length; + all_answers[next]= lin_answer[0].texts[i]; + } + + trees_to_go--; + if(trees_to_go == 0) + continue_checking(); +} + +function continue_checking() +{ + if (selected_mode == "Exam Mode") + { + check_answer_exam2(); + exam_continue(); + } + else + if (hint_pressed) + show_hint2(); + else + check_answer2(); +} + +function check_answer2() +{ + if (have_minibar) + hide_word_magnets(); + + raw_user_answer= document.answer.answer_text.value; + user_answer = remove_unwanted_characters(raw_user_answer); + answer_was_right= false; + var k = 0 ; + for (k= 0; k < all_answers.length; k++) + { + server_answer = remove_unwanted_characters(all_answers[k]); + + if ( user_answer == server_answer ) + { + if (answer_times <= max_answer_times) + { + //increments the score + score ++; + document.getElementById('score_display').value = score; + } + + document.explanation.explanation_text.value = "Yes, that was the correct answer."; + answer_was_right= true; + + break; + + } + } + + if (k >= all_answers.length) + { + document.explanation.explanation_text.value= "No, the correct answer(s) is(are): \n " + + all_answers; + document.getElementById('counter_display').value = counter; + } + + //save the current explanation for the "previous question" button and history + current_explanation = document.explanation.explanation_text.value; + quiz_history[index][2] = current_explanation; + + if ((counter >= min_no_questions) && ((score/counter) >= pass_percentage)) + { + if (answer_was_right) + document.explanation.explanation_text.value += "\nAlso, "; + else + document.explanation.explanation_text.value += "\nHowever, "; + + document.explanation.explanation_text.value += "Congratulations!!! You passed the quiz. Click \"Restart Quiz\" for a new one."; + + document.getElementById('counter_display').value = counter; + + end_quiz(false); + } + else + if (answer_was_right) + { + //goes to the next question automaticly after getting the correct answer + generate_question(); + } + + //save the current hint for the "previous question" button + current_hint = document.getElementById("hint_txt").innerHTML ; +} + +function check_answer_exam2() +{ + + raw_user_answer= document.answer.answer_text.value; + user_answer = remove_unwanted_characters(raw_user_answer); + + var k = 0 ; + for (k= 0; k < all_answers.length; k++) + { + server_answer = remove_unwanted_characters(all_answers[k]); + + if ( user_answer == server_answer ) + { + //increments the score + score ++; + + //save the current explanation for history + current_explanation = "Yes, that was the correct answer."; + quiz_history[index][2] = current_explanation; + + break; + } + } + + if (k >= all_answers.length) + { + //save the current explanation for history + current_explanation = "No, the correct answer(s) is(are): \n " + all_answers; + quiz_history[index][2] = current_explanation; + } +} + +function exam_continue() +{ + if (counter >= exam_quesNo) + exam_result(); + else + { + //clears the question and answer and the explanation and hint display areas + clearing(); + + document.getElementById('counter_display').value = counter + "/" + exam_quesNo; + //increments the counter + counter= ++ counter; + + //sends a question retrival request to the server + server.get_random(generate_question2); + } +} + +function exam_result() +{ + document.getElementById('score_display').value = score; + document.getElementById('counter_display').value = counter + "/" + exam_quesNo; + document.explanation.explanation_text.value= "That's the end of exam."; + end_quiz(false); +} + +function show_hint() +{ + if (hint_times < max_hint_times) + { + if (check_notEmpty()) + { + //clears the explanation and Hint area + document.explanation.explanation_text.value = ""; + document.getElementById("hint_txt").innerHTML = ""; + + //increments the times the user has pressed hint button + hint_times= ++ hint_times; + + //resets the user confirmation for moving to next question without checking the answer + confirmed_check = true; + + //save the current user answer for the "peivious question" button + current_answer = document.answer.answer_text.value; + + //sets the hint_pressed flag + hint_pressed = true; + + raw_user_answer= document.answer.answer_text.value; + user_answer = remove_unwanted_characters(raw_user_answer); + user_answer_splited = split_to_words(user_answer); + + if ((answer_times + hint_times) <= 1) + make_all_answers(); + else + continue_checking(); + } + } + else + { + //Error message (max_hint_times is passed) + document.explanation.explanation_text.value = "Sorry, you have already used up your allowed number of hints for this question."; + } +} + +function show_hint2() +{ + var best_answer = new Array(); + best_answer= find_closest(all_answers); + + var compared = new Array(); + compared = string_matching(best_answer, user_answer_splited); + + //preparing the Hint spans + var hint = element("hint_txt"); + hint.innerHTML = "<b>Hint: </b>"; + var max_length = Math.max(best_answer.length, user_answer_splited.length); + for (k= 0; k < max_length; k++) + { + var id = "word" + k.toString(); + var word_span= span_id(id); + hint.appendChild(word_span); + } + + var k=0; + var visited = new Array(); + for (k= 0; k < best_answer.length; k++) + { + visited[k] = 0; + } + + var i= 0; //i is used for the user_answer + var myid = ""; + while ( i < compared.length) + { + myid = "word" + i.toString(); + if (compared[i] == 0) + { + var j =0; //j is used for the server_answer + while (j < best_answer.length) + { + if (visited[j] == 0 && user_answer_splited[i] == best_answer[j] && (j >= compared.length || compared[j] == 0 )) + { + //yellow for the right word in wrong place + document.getElementById(myid).style.color="#FFFF00"; + visited[j] = 1; + break; + } + j++; + } + + if ( j >= best_answer.length) + { + //red for the totaly wrong word + document.getElementById(myid).style.color="#FF0000"; + } + } + else + { //green for the right word in right place + document.getElementById(myid).style.color="#339933"; + } + document.getElementById(myid).innerHTML = user_answer_splited[i] + " "; + i++; + } + + while ( i < best_answer.length) + { + myid = "word" + i.toString(); + document.getElementById(myid).style.color="#FF0000"; + document.getElementById(myid).innerHTML = "____ "; + i++; + } + + //save the current explanation and hint for the "previous question" button + current_explanation = document.explanation.explanation_text.value; + current_hint = document.getElementById("hint_txt").innerHTML ; +} + +function previous_question_quiz() +{ + if ( counter > 1) + { + if ( answer_times == 0 && hint_times == 0 ) + { + //sets the current answer and the explanation and hint + current_answer = document.answer.answer_text.value; + current_explanation = ""; + current_hint = ""; + } + + //disables the "Previous Question","Hint" and "Check Answer" buttons + document.getElementById('previous_question').disabled = true; + document.getElementById('check_answer').disabled = true; + document.getElementById('hint').disabled = true; + + //changes the question, answer and the explanation + document.question.question_text.value= prev_question; + document.answer.answer_text.value = prev_answer; + document.explanation.explanation_text.value= prev_explanation; + document.getElementById("hint_txt").innerHTML = prev_hint; + + prev_pressed = true; // to remember the current question, answer and explanation + } +} + +function end_quiz(confirm_needed) +{ + if (restart_active == true && is_ended == false) + { + var end= new Boolean(true); + + if (confirm_needed) + end = confirm(" Are you sure you want to quit this quiz!"); + + if (end) + { + if (have_minibar) + { + //removes the "Show Magnets" button if exists + show_word_magnets(); + //remove the minibar word magnets if there was any + remove_minibar(); + //shows the normal user answer area + show_element("user_answer"); + } + disable_all(); + is_ended = true; + + //adds a Show Quiz History button + var history_bar=element("history_bar"); + appendChildren(history_bar, + [ button("Show Quiz History","show_history()","H", "quiz_history")]); + } + } +} + +function show_history() +{ + var current_grammar = minibar.grammar.name; // minibar.grammar.name gives the grammar name without .pgf + var to_lang= langpart(minibar.to_menu.value,current_grammar); + var from_lang= langpart(minibar.from_menu.value,current_grammar); + var history=element("history_part"); + if (history_shown == false) + { + var i=0; + for (i= 0; i < quiz_history.length ; i++) + { + var question = text("Question" + " "+quiz_history[i][0] + "\n"); + history.appendChild(empty("br")); + history.appendChild(question); + history.appendChild(empty("br")); + + var answer = text("Your Answer" + ": "+ quiz_history[i][1] + "\n"); + history.appendChild(answer); + history.appendChild(empty("br")); + + var explan = text("Explanation" + ": "+ quiz_history[i][2] + "\n"); + history.appendChild(explan); + history.appendChild(empty("br")); + history.appendChild(empty("br")); + } + history_shown = true; + } + + var history_content = history.innerHTML; + + var history_window = window.open('', 'historyPopup', "dependent = 1, scrollbars=1, location=1, statusbar=1, width=540, height=650, left = 10, top = 20"); + history_window.document.writeln('<html><head><title>Quiz History</title></head><body>'); + history_window.document.writeln('<h3> Your Quiz History </h3>'); + history_window.document.write('<b> Quiz Mode: </b>'); + history_window.document.write(selected_mode+ ", "); + history_window.document.write('<b> Grammar: </b> '); + history_window.document.write(" "+ current_grammar +", "); + history_window.document.write('<b> From: </b>'); + history_window.document.write(" "+ from_lang + ", "); + history_window.document.write('<b> To: </b>'); + history_window.document.writeln(" "+ to_lang); + history_window.document.writeln('<div style="font-size:18px;">'); + history_window.document.writeln(history_content); + history_window.document.writeln('</div>'); + history_window.document.writeln('<div style="color: #2E8B57; font-size:16px; font-weight: bold;"><a href="javascript: window.print()">Print History</a></div>'); + history_window.document.writeln('<div style="padding-left: 320px; color: #2E8B57; font-size:16px; font-weight: bold;"><a href="javascript: window.close()">Close page</a></div>'); + history_window.document.writeln('</body></html>'); + history_window.document.close(); +}
@@ -0,0 +1,20 @@+body { color: black; background: #eee; }+h1 { font-size: 175%; }+h1,h2,h3,h4,small { font-family: sans-serif;}+h1,h2,h3,h4 { color: #303030; text-shadow: rgba(0,0,0,0.25) 3px 3px 5px; }++h1:first-child, h2:first-child { margin-top: 0; margin-bottom: 1ex; }+h1 img { float: right; border: 0; max-width: 50%; }+h1 img.nofloat { float: none; }++img.cloud, img.right, div.right, div.modtime, div.version { float: right; }++li { margin-top: 0.5ex; margin-bottom: 0.5ex; }++div.modtime >small { visibility: hidden; }+div.modtime:hover >small { visibility: visible; }+.modtime,.version { color: #999; white-space: nowrap; }++table.loaded_grammars th { text-align: left; font-family: sans-serif; }+table.loaded_grammars td { padding-right: 1em; font-family: monospace; }+table.loaded_grammars tr td:nth-child(2) { color: #555; }
@@ -0,0 +1,160 @@+<!DOCTYPE html>+<html> <head>+<title>GF Cloud Service API (preliminary)</title>+<meta charset="UTF-8">+<link rel="stylesheet" type="text/css" href="gfse/editor.css" title="Cloud">+<meta name = "viewport" content = "width = device-width">+<style type="text/css">+dl.api>dt, .request { background-color: #cef; }+.response { background-color: #ffc; }+dd { margin-top: 0.5ex; margin-bottom: 0.5ex; }+em { color: #36f; }+</style>+</head>++<body>+<h1><a href="./"><img src="P/gf-cloud.png" alt=""></a> GF Cloud Service API (preliminary)</h1>++The GF cloud service API provides the following functionality:++<ul>+ <li>the functionality available in via the <strong>PGF service API</strong>,+ <li>the functionality provided by the commands in the+ <strong>GF shell</strong>,+ <li>some additional services for+ grammar compilation and persistent storage of files in the cloud.+</ul>++<p>+<strong>This is preliminary and subject to change!</strong>++<h2>Availability and protocol</h2>+<p>+The service is available from+<a href="http://cloud.grammaticalframework.org/"><code>http://cloud.grammaticalframework.org/</code></a>.++Users that have GF installed on their own computer can also+run the service locally by starting GF with the command <code>gf -server</code>.++<p>+Requests are made via HTTP with the GET or POST method. (The examples below+show GET requests, but POST is preferred for requests that change the state+on the server.)+<p>+Data in requests is in the <code>application/x-www-form-urlencoded</code> format+(the format used by default by web browsers when submitting form data).+<p>+Data in responses is usually in JSON format.+The HTTP response code is usually 200, but can also be+204 (after file upload),+404 (file to download or remove was not found),+400 (for unrecognized commands or missing/unacceptable parameters in requests)+or+501 (for unsupported HTTP request methods).+Unrecognized parameters in requests are silently ignored.++<h2>Requests</h2>++<h3>PGF Service</h3>++The GF Cloud Service supports the same set of PGF service requests as the+already available PGF web service. For example, a request like++<blockquote class=request>+<code>http://cloud.grammaticalframework.org/grammars/Foods.pgf?command=random</code>+</blockquote>++might return a result like++<blockquote class=response>+<code>[{"tree":"Pred (That Pizza) (Very Boring)"}]</code>+</blockquote>++<p>+For more info, see:+<ul>+ <li><a href="gf-web-api-examples.html">PGF web service API examples</a>.+ <li><a href="http://code.google.com/p/grammatical-framework/wiki/GFWebServiceAPI">PGF web service API documentation</a>.+</ul>++<h3>GF Shell Service</h3>+This service lets you execute arbitrary GF shell commands. Before you can do+this, you need to use the <code class=request>/new</code> command to obtain a+working directory (which also serves as a session identifier) on the server,+see below.++<dl class=api>+ <dt><code>/gfshell?dir=</code>...<code>&command=i+Foods.pgf</code>+ <dd> + <dt><code>/gfshell?dir=</code>...<code>&command=gr</code>+ <dd class=response><code>Pred (That Pizza) (Very Boring)</code>+ <dt><code>/gfshell?dir=</code>...<code>&command=ps+-lextext+%22That+pizza+is+very+boring.%22</code>+ <dd class=response><code>that pizza is very boring .</code>++</dl>++For documentation of GF shell commands, see:+<ul>+ <li><a href="http://www.grammaticalframework.org/doc/gf-shell-reference.html">GF Shell Reference</a>+</ul>++<h3>Additional cloud service</h3>++<dl class=api>+ <dt><code>/new</code>+ <dd>This generates a new working directory on the server, e.g.+ <code class=response>/tmp/gfse.123456</code>.+ Most of the cloud service commands require that a working directory+ is specified in the <code class=request>dir</code> parameter.+ The working directory is persistent, so clients are expected+ to remember and reuse it. Access to previously+ uploaded files requires that the same working directory is used.++ <dt><code>/parse?</code><var>path</var><code>=</code><var>source</var>+ <dd>This command can be used to check GF source code for syntax errors.+ It also converts GF source code to the JSON representation used in+ GFSE (the cloud-based GF grammar editor).++ <dt><code>/cloud?dir=</code>...<code>&command=<strong>upload</strong>&</code><var>path<sub>1</sub></var><code>=</code><var>source<sub>1</sub></var><code>&</code><var>path<sub>2</sub></var><code>=</code><var>source<sub>2</sub></var><code>&</code>...+ <dd>Upload files to be stored in the cloud.+ The response code is 204 if the upload was successful.++ <dt><code>/cloud?dir=</code>...<code>&command=<strong>make</strong>&</code><var>path<sub>1</sub></var><code>=</code><var>source<sub>1</sub></var><code>&</code><var>path<sub>2</sub></var><code>=</code><var>source<sub>2</sub></var><code>&</code>...+ <dd>Upload grammar files and compile them into a PGF file. Example response:+ <blockquote class=response><code>+ { "errorcode":"OK", <em>// "OK" or "Error"</em>+ <br> "command":"gf -s -make FoodsEng.gf FoodsSwe.gf FoodsChi.gf",+ <br> "output":"\n\n" <em>// Warnings and errors from GF</em>+ <br>}</code></blockquote>++ <dt><code>/cloud?dir=</code>...<code>&command=<strong>remake</strong>&</code><var>path<sub>1</sub></var><code>=</code><var>source<sub>1</sub></var><code>&</code><var>path<sub>2</sub></var><code>=</code><var>source<sub>2</sub></var><code>&</code>...+ <dd>Like <code>command=<strong>make</strong></code>, except you can leave+ the <var>source<sub>i</sub></var> parts empty to reuse previously uploaded+ files.++ <dt><code>/cloud?dir=</code>...<code>&command=<strong>download</strong>&file=</code><var>path</var>+ <dd>Download the specified file.++ <dt><code>/cloud?dir=</code>...<code>&command=<strong>ls</strong>&ext=.pgf</code>+ <dd>List files with the specified extension, e.g.+ <code class=response>["Foods.pgf","Letter.pgf"]</code>.++ <dt><code>/cloud?dir=</code>...<code>&command=<strong>rm</strong>&file=</code><var>path</var>+ <dd>Remove the specified file.++ <dt><code>/cloud?dir=</code>...<code>&command=<strong>link_directories</strong>&newdir=</code>...+ <dd>Combine server directores. This is used by GFSE to share grammars+ between multiple devices.+</dl>++<hr>+<address></address>+<div class=modtime><small>+<!-- hhmts start -->Last modified: Tue Jun 17 10:42:21 CEST 2014 <!-- hhmts end -->+ </small></div>+<address>+<a href="http://www.cse.chalmers.se/~hallgren/">TH</a>+<img src="http://www.altocumulus.org/~hallgren/online.cgi?icon" alt="">+</address>+</body>+ </html>
@@ -0,0 +1,183 @@+<!DOCTYPE html>+<html>+<head>+<title>GF web services API examples</title>+<meta charset="UTF-8">+<link rel="stylesheet" type="text/css" href="gfse/editor.css" title="Cloud">+<meta name = "viewport" content = "width = device-width">++<style type="text/css">++dt { background: #cef; }+dt.js { background: white; margin-bottom: 1ex; }+dt.js em { color: #36f; }+dd { background: #ffc; margin-top: 1ex; margin-bottom: 1ex; }+dt, dd { padding: 0.3ex; }++dl.apiexamples>dt, dl.apiexamples>dd { font-family: monospace; }+dl.apiexamples>dd { white-space: pre; }++@media projection {+ div.intro { display: none; }++ body {+ font-size: 150%;+ }++ h2 { page-break-before: always; }++ dl.apiexamples dd {+ page-break-after: always;+ /*border-style: none;*/+ }+}++</style>++<body>+<h1><a href="../"><img src="../P/gf-cloud.png" alt=""></a>+ GF web services API examples</h1>++GF can be used interactively from the GF Shell. Some of the functionality+availiable in the GF shell is also available via the GF web services API.++<p>+The+<a href="gf-web-api.html">GF+Web Service API page</a> describes the calls supported by the GF web service+API. Below, we illustrate these calls by examples, and also show+how to make these calls from JavaScript using the API defined in+<a href="js/pgf_online.js"><code>pgf_online.js</code></a>.++<p>+<strong>Note</strong> that <code>pgf_online.js</code> was initially developed+with one particular web application in mind (the minibar), so the server API was+incomplete. It was simplified and generalized in August 2011 to support the+full API.++<dl>+ <dt class=js>These boxes show what the calls look like in the JavaScript+ API defined in <code>pgf_online.js</code>.+ <dt>These boxes show the corresponding URLs sent to the PGF server.+ <dd>These boxes show the JSON (JavaScript data structures) returned by the PGF+ server. This will be passed to the callback function supplied in the+ call.+</dl>++<h2>Initialization</h2>+<dl class=apiexamples>+ <dt class=js>+ <em>// Select which server and grammars to use:</em>+ <br>var server_options = {+ <br> grammars_url: "http://www.grammaticalframework.org/grammars/",+ <br> grammar_list: ["Foods.pgf"] <em>// It's ok to skip this</em>+ <br>}+ <br>var server = pgf_online(server_options);+</dl>++<h2>Examples</h2>++<dl class=apiexamples>+ <dt class=js> <em>// Get the list of available grammars</em>+ <br>server.get_grammarlist(callback)+ <dt>http://localhost:41296/grammars/grammars.cgi+ <dd>["Foods.pgf","Phrasebook.pgf"]+ <dt class=js> <em>// Select which grammar to use</em>+ <br>server.switch_grammar("Foods.pgf")+ <dt class=js><em>// Get list of concrete languages and other grammar info</em>+ <br>server.grammar_info(callback)+ <dt>http://localhost:41296/grammars/Foods.pgf+ <dd>{"name":"Foods",+ "userLanguage":"FoodsEng",+ "startcat":"Comment",+ "categories":["Comment","Float","Int","Item","Kind","Quality","String"],+ "functions":["Boring","Cheese","Delicious","Expensive","Fish","Fresh",+ "Italian","Mod","Pizza","Pred","That","These","This","Those","Very",+ "Warm","Wine"],+ "languages":[{"name":"FoodsBul","languageCode":""},+ {"name":"FoodsEng","languageCode":"en-US"},+ {"name":"FoodsFin","languageCode":""},+ {"name":"FoodsSwe","languageCode":"sv-SE"},+ ...]+}+ <dt class=js><em>// Get a random syntax tree</em>+ <br>server.get_random({},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=random+ <dd>[{"tree":"Pred (That Pizza) (Very Boring)"}]+ <dt class=js><em>// Linearize a syntax tree</em>+ <br>server.linearize({tree:"Pred (That Pizza) (Very Boring)",to:"FoodsEng"},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=linearize&tree=Pred+(That+Pizza)+(Very+Boring)&to=FoodsEng+ <dd>[{"to":"FoodsEng","text":"that pizza is very boring"}]+ <dt class=js>server.linearize({tree:"Pred (That Pizza) (Very Boring)"},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=linearize&tree=Pred+(That+Pizza)+(Very+Boring)+ <dd>[{"to":"FoodsBul","text":"онази пица е много еднообразна"},+ {"to":"FoodsEng","text":"that pizza is very boring"},+ {"to":"FoodsFin","text":"tuo pizza on erittäin tylsä"},+ {"to":"FoodsSwe","text":"den där pizzan är mycket tråkig"},+ ...+]+ <dt class=js><em>// Parse a string</em>+ <br>server.parse({from:"FoodsEng",input:"that pizza is very boring"},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=parse&input=that+pizza+is+very+boring&from=FoodsEng+ <dd>[{"from":"FoodsEng",+ "brackets":{"cat":"Comment","fid":10,"index":0,"children":[{"cat":"Item","fid":7,"index":0,"children":[{"token":"that"},{"cat":"Kind","fid":6,"index":0,"children":[{"token":"pizza"}]}]},{"token":"is"},{"cat":"Quality","fid":9,"index":0,"children":[{"token":"very"},{"cat":"Quality","fid":8,"index":0,"children":[{"token":"boring"}]}]}]},+ "trees":["Pred (That Pizza) (Very Boring)"]}]+ <dt class=js><em>// Translate to all available languages</em>+ <br>server.translate({from:"FoodsEng",input:"that pizza is very boring"},callback)+ <dd>...+ <dt class=js><em>// Translate to one language</em>+ <br>server.translate({input:"that pizza is very boring", from:"FoodsEng", to:"FoodsSwe"}, callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=translate&input=that+pizza+is+very+boring&from=FoodsEng&to=FoodsSwe+ <dd>[{"from":"FoodsEng",+ "brackets":{"cat":"Comment","fid":10,"index":0,"children":[{"cat":"Item","fid":7,"index":0,"children":[{"token":"that"},{"cat":"Kind","fid":6,"index":0,"children":[{"token":"pizza"}]}]},{"token":"is"},{"cat":"Quality","fid":9,"index":0,"children":[{"token":"very"},{"cat":"Quality","fid":8,"index":0,"children":[{"token":"boring"}]}]}]},+ "translations":+ [{"tree":"Pred (That Pizza) (Very Boring)",+ "linearizations":+ [{"to":"FoodsSwe",+ "text":"den där pizzan är mycket tråkig"}]}]}]+ <dt class=js><em>// Get completions (what words could come next)</em>+ <br>server.complete({from:"FoodsEng",input:"that pizza is very "},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=complete&input=that+pizza+is+very+&from=FoodsEng+ <dd>[{"from":"FoodsEng",+ "brackets":{"cat":"_","fid":0,"index":0,"children":[{"cat":"Item","fid":7,"index":0,"children":[{"token":"that"},{"cat":"Kind","fid":6,"index":0,"children":[{"token":"pizza"}]}]},{"token":"is"},{"token":"very"}]},+ "completions":["boring","delicious","expensive","fresh","Italian","very","warm"],+ "text":""}]+ <dt class=js><em>// Get info about a category in the abstract syntax</em>+ <br>server.browse({id:"Kind"},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=browse&id=Kind&format=json+ <dd>{"def":"cat Kind",+ "producers":["Cheese","Fish","Mod","Pizza","Wine"],+ "consumers":["Mod","That","These","This","Those"]}+ <dt class=js><em>// Get info about a function in the abstract syntax</em>+ <br>server.browse({id:"This"},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=browse&id=This&format=json+ <dd>{"def":"fun This : Kind -> Item","producers":[],"consumers":[]}+ <dt class=js><em>// Get info about all categories and functions in the abstract syntax</em>+ <br>server.browse({},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=browse&format=json+ <dd>{"cats":{"Kind":{"def":"cat Kind",+ "producers":["Cheese","Fish","Mod","Pizza","Wine"],+ "consumers":["Mod","That","These","This","Those"]},+ ...},+ "funs":{"This":{"def":"fun This : Kind -> Item","producers":[],"consumers":[]},+ ...}+}+ <dt class=js><em>// Convert an abstract syntax tree to JSON</em>+ <br>server.pgf_call("abstrjson",{tree:"Pred (That Pizza) (Very Boring)"},callback)++ <dt>http://localhost:41296/grammars/Foods.pgf?command=abstrjson&tree=Pred+(That+Pizza)+(Very+Boring)+ <dd>{"fun":"Pred","fid":4,+ "children":[{"fun":"That","fid":1,+ "children":[{"fun":"Pizza","fid":0}]},+ {"fun":"Very","fid":3,+ "children":[{"fun":"Boring","fid":2}]}]}+ <dt class=js><em>// Lookup the morphological analysis of a word</em>+ <br>server.pgf_call("lookupmorpho",{input:"fish",from:"FoodsEng"},callback)+ <dt>http://localhost:41296/grammars/Foods.pgf?command=lookupmorpho&input=fish&from=FoodsEng+ <dd>[{"lemma":"Fish","analysis":"s Pl"},{"lemma":"Fish","analysis":"s Sg"}]+</dl>+<hr>+<div class=modtime><small>+<!-- hhmts start -->Last modified: Thu Jun 16 17:08:04 CEST 2016 <!-- hhmts end -->+ </small></div>+<address><a href="http://www.cse.chalmers.se/~hallgren/">TH</a></address>
@@ -0,0 +1,358 @@+GF Web Service API+June 2016++%!style:cloud.css+%!options(html): --toc+%!options(html): --toc-level=3+%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>+%!postproc(html): <H1> <H1><a href="http://www.grammaticalframework.org/"><IMG src="Logos/gf0.png"></a>++==Introduction==++The PGF API is available as Web Service through the built-in HTTP server in+the main GF executable. It is activated by starting GF with the ``-server``+flag:++```+$ gf -server+This is GF version 3.8.+Document root = /usr/share/gf-3.8/www+Starting HTTP server, open http://localhost:41296/ in your web browser.+```++A compiled GF grammar (a ``.pgf`` file) can be used in web applications+%in the same way as JSP, ASP or PHP pages are used.+by placing it somewhere under the document root.+%, usually in the ``grammars/`` subdirectory.+When there is a request for access to a ``.pgf`` file, the GF web server+will load and cache the grammar and interpret any parameters included in the URL+(in the //url-encoded-query// format). The response you get back is usually+a data structure in [JSON http://www.json.org/] format,+but it could also be an image or plain text.++For example, if ``my_grammar.pgf`` is a grammar placed directly under the+document root, then the grammar could be accessed using this URL:++```+http://localhost:41296/my_grammar.pgf+```++The default when no parameters are included in the URL is a response with+some general information about the grammar, encoded in JSON format.+To perform specific command you have to tell what command you want to perform.+The command is encoded in the parameter ``command``, i.e.:++``http://localhost/my_grammar.pgf?command=``//cmd//++where //cmd// is the name of the command. Most commands require+additional arguments, which are encoded as parameters as well.+The supported commands and their arguments are described below.+++==Commands==++--------------------------------------------------------------------------------++===Grammar===++This command provides some general information about the grammar. This command is also executed if no `command` parameter is given.++=====Input=====+|| Parameter | Description | Default |+| command | should be ``grammar`` | - |++=====Output=====+A JSON object including the following fields:++|| Field | Description |+| ``name`` | the name of the abstract syntax in the grammar |+| ``userLanguage`` | the concrete language in the grammar which best matches the default language set in the user's browser |+| ``categories`` | list of all abstract syntax categories defined in the grammar |+| ``functions`` | list of all abstract syntax functions defined in the grammar |+| ``languages`` | list of concrete languages available in the grammar |++Every language is described with object having this two fields:++|| Field | Description |+| ``name`` | the name of the concrete syntax for the language |+| ``languageCode`` | the two-character language code according to the [ISO standard http://www.loc.gov/standards/iso639-2/php/code_list.php] i.e. ``en`` for English, ``bg`` for Bulgarian, etc. |++The language codes need to be specified in the grammar with+``flags language=...``. The web service receives the code of the language+set in the browser and compares it with the codes+defined in the grammar. If there is a match then the service returns+the corresponding concrete syntax name. If no match is found then the+first language in alphabetical order is returned.++--------------------------------------------------------------------------------+ +===Parsing===++This command parses a string and returns a list of abstract syntax trees.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``parse`` | - |+| ``cat`` | the start category for the parser | the default start category for the grammar |+| ``input`` | the string to be parsed | empty string |+| ``from`` | the name of the concrete syntax to use for parsing | all languages in the grammar will be tried |+| ``limit`` | limit how many trees are returned (gf>3.3.3) | no limit is applied |++====Output====+List of objects where every object represents the analyzes for every input language. The objects have three fields:++|| Field | Description |+| ``from`` | the concrete language used in the parsing |+| ``brackets`` | the bracketed string from the parser |+| ``trees`` | list of abstract syntax trees |+| ``typeErrors`` | list of errors from the type checker |++The abstract syntax trees are sent as plain strings. The type errors are objects with two fields:++|| Field | Description |+| ``fid`` | forest id which points to a bracket in the bracketed string where the error occurs |+| ``msg`` | the text message for the error |++The current implementation either returns a list of abstract syntax trees or a list of type errors. By checking whether the field trees is not null we check whether the type checking was successful.++--------------------------------------------------------------------------------++===Linearization===++The command takes an abstract syntax tree and produces string in the specified language(s).++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``linearize`` | - |+| ``tree`` | the abstract syntax tree to linearize | - |+| ``to`` | the name of the concrete syntax to use in the linearization | linearizations for all languages in the grammar will be generated |++====Output====+|| Field | Description |+| ``to`` | the concrete language used for the linearization |+| ``tree`` | the output text |+++--------------------------------------------------------------------------------++===Translation===++The translation is a two step process. First the input sentence is parsed with the source language and after that the output sentence(s) are produced via linearization with the target language(s). For that reason the input and the output for this command is the union of the input/output of the commands for parsing and the one for linearization.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``translate`` | - |+| ``cat`` | the start category for the parser | the default start category for the grammar |+| ``input`` | the input string to be translated | empty string |+| ``from`` | the source language | all languages in the grammar will be tried |+| ``to`` | the target language | linearizations for all languages in the grammar will be generated |+| ``limit`` | limit how many parse trees are used (gf>3.3.3) | no limit is applied |++====Output====++The output is a list of objects with these fields:+|| Field | Description |+| ``from`` | the concrete language used in the parsing |+| ``brackets`` | the bracketed string from the parser |+| ``translations`` | list of translations |+| ``typeErrors`` | list of errors from the type checker |++Every translation is an object with two fields:+| ``tree`` | abstract syntax tree |+| ``linearizations`` | list of linearizations |++Every linearization is an object with two fields:+| Field | Description |+| ``to`` | the concrete language used in the linearization |+| ``text`` | the sentence produced |++The type errors are objects with two fields:++|| Field | Description |+| ``fid`` | forest id which points to a bracket in the bracketed string where the error occurs |+| ``msg`` | the text message for the error |++The current implementation either returns a list of translations or a list of type errors. By checking whether the field translations is not null we check whether the type checking was successful.++--------------------------------------------------------------------------------++===Random Generation===++This command generates random abstract syntax tree where the top-level function will be of the specified category. The categories for the sub-trees will be determined by the type signatures of the parent function.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``random`` | - |+| ``cat`` | the start category for the generator | the default start category for the grammar |+| ``limit`` | maximal number of trees generated | 1 |++====Output====+The output is a list of objects with only one field:++|| Field | Description |+| ``tree`` | the generated abstract syntax tree |++The length of the list is limited by the limit parameter.++--------------------------------------------------------------------------------++===Word Completion===++Word completion is a special case of parsing. If there is an incomplete sentence then it is first parsed and after that the state of the parse chart is used to predict the set of words that could follow in a grammatically correct sentence.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``complete`` | - |+| ``cat`` | the start category for the parser | the default start category for the grammar |+| ``input`` | the string to the left of the cursor that is already typed | empty string |+| ``from`` | the name of the concrete syntax to use for parsing | all languages in the grammar will be tried |+| ``limit`` | maximal number of trees generated | all words will be returned |++====Output====+The output is a list of objects with two fields which describe the completions.+|| Field | Description |+| ``from`` | the concrete syntax for this word |+| ``text`` | the word itself |+++--------------------------------------------------------------------------------++===Abstract Syntax Tree Visualization===++This command renders an abstract syntax tree into an image.+Several image formats are supported.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``abstrtree`` | - |+| ``tree`` | the abstract syntax tree to render | - |+| ``format`` | output format (gf>3.3.3) | ``png`` |++====Output====+By default, the output is an image in PNG format.+The Content-Type is set to ``image/png``, so the easiest way to visualize the+generated image is to add HTML element ``<img/>`` which points to URL+for the visualization command i.e.:++```+<img src="http://localhost/my_grammar.pgf?command=abstrtree&tree=..."/>+```++The ``format`` parameter can also be ``gif``, ``svg`` or ``gv``, for+GIF (``image/gif``), SVG (``image/svg+xml``)+or graphviz (``text/plain``) format, respectively.++--------------------------------------------------------------------------------++===Parse Tree Visualization===++This command renders the parse tree that corresponds to a specific abstract syntax tree. The generated image is in PNG format.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``parsetree`` | - |+| ``tree`` | the abstract syntax tree to render | - |+| ``from`` | the name of the concrete syntax to use in the rendering | - |+| ``format`` | output format (gf>3.3.3) | ``png`` |+| //options// | additional rendering options (gf>3.4) | - |++The additioal rendering options are: ``noleaves``, ``nofun`` and ``nocat`` (booleans, false by default);+``nodefont``, ``leaffont``, ``nodecolor``, ``leafcolor``, ``nodeedgestyle`` and ``leafedgestyle``+(strings, have builtin defaults).++====Output====++By default, the output is an image in PNG format. The Content-Type is set to ``image/png``, so the easiest way to visualize the generated image is to add HTML element ``<img/>`` which points to URL for the visualization command i.e.:++```+<img src="http://localhost/my_grammar.pgf?command=parsetree&tree=..."/>+```++The ``format`` parameter can also be ``gif``, ``svg`` or ``gv``, for+GIF (``image/gif``), SVG (``image/svg+xml``)+or graphviz (``text/plain``) format, respectively.++--------------------------------------------------------------------------------++===Word Alignment Diagrams===++This command renders the word alignment diagram for some sentence and all languages in the grammar. The sentence is generated from a given abstract syntax tree.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``alignment`` | - |+| ``tree`` | the abstract syntax tree to render | - |+| ``format`` | output format (gf>3.3.3) | ``png`` |+| ``to`` | list of languages to include in the diagram (gf>3.4) | all languages supported by the grammar |++====Output====+By default, the output is an image in PNG format. The Content-Ttype is set to+``image/png``, so the easiest way to visualize the generated image is to add HTML element ``<img/>`` which points to URL for the visualization command i.e.:++```+<img src="http://localhost/my_grammar.pgf?command=alignment&tree=..."/>+```++The ``format`` parameter can also be ``gif``, ``svg`` or ``gv``, for+GIF (``image/gif``), SVG (``image/svg+xml``)+or graphviz (``text/plain``) format, respectively.++--------------------------------------------------------------------------------+===Word Dependency Diagrams===++This command (available in GF>=3.8) outputs word dependency diagrams+in various format.++====Input====+|| Parameter | Description | Default |+| ``command`` | should be ``deptree`` | - |+| ``tree`` | the abstract syntax tree to render | - |+| ``format`` | output format, see below | ``dot`` |+| ``to`` | name of the concrete syntax to use in the diagram | - |++The ``format`` is one of the following:++- ``png``, ``gif``, ``gv``: rendered with graphviz,+- ``svg``, ``latex``: [universal dependency http://universaldependencies.org/]+ diagrams, in SVG format for use in web pages or+ as LaTeX Picture code for use in LaTeX documents,+- ``conll``, ``malt_tab`` and ``malt_input``: text formats++--------------------------------------------------------------------------------++===Undocumented commands===++There a few additional commands that lack proper documentation:++- ``abstrjson``, ``browse``, ``download``, ``generate``, ``linearizeAll``,+ ``linearizeTable``, ``lookupmorpho``, ``translategroup``.+++See the source code for details.++--------------------------------------------------------------------------------++==Commands that use the C run-time system==++GF includes two implementations of the PGF API: the traditional+Haskell implementation and the newer C implementation. The commands documented+above all use the Haskell implementation.+The following commands use the C implementation instead:++- ``c-parse``, ``c-linearize``, ``c-linearizeAll``, ``c-translate``,+ ``c-lookupmorpho``, ``c-flush``, ``c-grammar``, ``c-abstrtree``,+ ``c-parsetree``, ``c-wordforword``.+++They implement the same functionality as the corresponding commands+without the ``c-`` prefix, although there are some restrictions in what+parameters they support, and some differences in the JSON+data structures they output.++When using these commands, the grammar will be loaded and cached+by the C run-time system. If you use commands from both the Haskell and C+implementations with the same grammar, the grammar will be loaded twice.++--------------------------------------------------------------------------------++[www.grammaticalframework.org http://www.grammaticalframework.org]
@@ -0,0 +1,112 @@+import Network.HTTP.Base+import Codec.Binary.UTF8.String+import Data.Char+import Data.List+import System++main = do+ xs <- getArgs+ let xxoo = lexArgs (unwords xs)+ case pArgs xxoo of + Just (oo,xx) -> do+ morpho oo xx+ _ -> do+ putStrLn $ "cannot read " ++ unwords xs ++ "."+ putStrLn "<p>"+ putStrLn usage++usage = "usage: gfmorpho LANG POS FORMS OPT*"++noParse xx = length xx < 3 ----++lexArgs = map (decodeString . urlDecode) . words . map unspec . drop 1 . dropWhile (/='=') where+ unspec c = case c of+ '=' -> ' ' + '+' -> ' ' + _ -> c++pArgs xxoo = do+ let (oo,xx) = partition isOption xxoo+ if length xx < 3 then Nothing else return (oo,xx)++morpho :: [String] -> [String] -> IO ()+morpho oo xx = do+ writeFile tmpCommand (script xx)+ system $ command xx+ s <- readFile tmpFile+ putStrLn $ mkFile $ response oo s++script ("!":lang:rest) = "cc -table -unqual " ++ unwords rest+script (lang: pos: forms) = "cc -table -unqual " ++ fun pos ++ quotes forms + where + fun pos = "mk" ++ pos++command ("!":args) = command args+command (lang: pos: forms) = + "/usr/local/bin/gf -run -retain -path=alltenses alltenses/Paradigms" ++ lang ++ ".gfo"+ ++ " < " ++ tmpCommand+ ++ " > " ++ tmpFile++quotes = unwords . map quote where+ quote s = case s of+ '_':tag -> tag+ _ -> "\"" ++ s ++ "\""++-- html response+response oo = + tag "table border=1" . unlines . map (tag "tr" . unwords) . map cleanTable . grep oo . map words . lines++cleanTable ws = [tag "td" (unwords param), tag "td" (tag "i" (unwords form))] where+ (param,form) = getOne (map cleant ws)+ cleant w = case w of+ "s" -> ""+ "." -> "" + _ -> cleanw w+ cleanw = filter (flip notElem "()")+ getOne ws = let ww = filter (/= "=>") ws in (init ww, [last ww]) -- excludes multiwords++responsePlain oo = + unlines . map unwords . grep oo . map cleanTablePlain . map words . lines++cleanTablePlain = map clean where+ clean w = case w of+ "=>" -> "\t"+ "s" -> ""+ "." -> ""+ _ -> cleanw w+ cleanw = filter (flip notElem "()")++grep oo wss = filter (\ws -> all (flip matchIn ws) oo) wss++matchIn p ws = quant (matchPol pol patt) ws where+ quant = if pol then any else all+ (pol,patt) = (head p == '-', tail p)+ matchPol True p w = match p w+ matchPol False p w = not (match p w)+ match p w = case (p,w) of+ ('*':ps,_ ) -> any (match ps) [drop i w | i <- [0..length w]] ---+ (c:ps, d:ws) -> c == d && match ps ws+ _ -> p == w++tmpFile = "_gfmorpho.tmp"+tmpCommand = "_gfcommand.tmp"++isOption = (flip elem "-~") . head++tag t s = "<" ++ t ++ ">" ++ s ++ "</" ++ t ++ ">"+++-- html file with UTF8++mkFile s = unlines $ [+ "<HTML>",+ "<HEAD>",+ "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=utf-8\">",+ "<TITLE>GF Smart Paradigm Output</TITLE>",+ "</HEAD>",+ "<BODY>",+ s,+ "</BODY>",+ "</HTML>"+ ]+
@@ -0,0 +1,23 @@+A service for using smart paradigms on the web.++Works with a cgi script running a Haskell program that calls GF to interprete a query string as a "cc" command on a specified Paradigms file. For instance, if the+user submits the query++ Eng N baby++the program executes the command++ cc -table -unqual ParadigmsEng.mkN "baby"++The resulting output is converted into an HTML table.++The file gfmorpho.html gives some more information. Open issues in addition to those mentioned there are:++- GFMorpho.hs creates the temporary files _gfcommand.tmp and _gfmorpho.tmp which need to be world-writable; they should be created more properly and removed after use+- gfmorpho.cgi defines the variable GF_LIB_PATH to reside in /home/aarne, and must be edited for other environments+- to work for all languages mentioned, one has to compile some incomplete GF grammars not standardly compiled:++ GF/lib/src$ runghc Make alltenses lang langs=Amh,Ara,Lat,Mlt,Tur++(c) Aarne Ranta 2012 under LGPL/BSD.+
@@ -0,0 +1,7 @@+#!/bin/bash++echo "Content-type: text/html";+echo ""+export LANG=en_US.UTF-8+export GF_LIB_PATH=/home/aarne/GF/lib/+/usr/local/bin/runghc GFMorpho "$QUERY_STRING"
@@ -0,0 +1,112 @@+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">+<html> <head>+<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=utf-8">+<title>Use GF Smart Paradigms</title>+</head>++<body>+<h1>Word inflection with smart paradigms</h1>++Give language, part of speech, and one or more word forms, to obtain+the inflection table.+<p>+<form method=get action="cgi-bin/gfmorpho.cgi">+ <input name=args>+ <INPUT TYPE=SUBMIT VALUE="Submit">+</form>+Examples:+<pre>+ Eng N baby+ Fin V odottaa odotti+ Fre V manger+ Ger N Soldat Soldaten _masculine+ Hin N बच्छा+ Jpn V 答える _Gr2+ Lat A vetus veteris+</pre>+Thus notice that strings are given without quotes, but features+are prefixed with an underscore <tt>_</tt>.+++<h2>Languages and part of speech tags</h2>++The available languages are:+<pre>+ Afr Amh Cat Dan Dut Eng Fin Fre Ger Hin Ina Ita Jpn Lat+ Lav Nep Nor Pes Pnb Ron Rus Snd Spa Swe Tha Tur Urd+</pre>+In addition, the library has the languages <tt>Ara Bul Pol</tt>, but they+are not yet available in this way; you can however use the full form of+paradigm applications prefixed by "!" as described below.++<p>++The parts of speech are: N (= noun), A (= adjective), V (= verb).++<p>++The way this works is that the program constructs the most probable+inflection table from the forms given. For a vast majority of words in+all languages, it is enough to give just one form. But sometimes more+forms are needed to get the inflection table right. ++<p>++This is a front end to the Paradigms modules in the GF Resource Grammar. +See <a href=http://grammaticalframework.org/lib/doc/synopsis.html>RGL+Synopsis</a> for more information on available languages and paradigms. ++++<h2>Filtering with patterns</h2>++You may not want to see the whole table. +Then you can filter it with patterns, each of which works like+"grep", using <tt>*</tt> to match any substring, either in the+features or in the forms:+<pre>+ Eng N baby -Gen+ Eng V die -dy*+</pre>+If several pattern are given, they are applied in conjunction.+Patterns prefixed with a tilde <tt>~</tt> rather than a hyphen+<tt>-</tt> are checked for <i>not</i> matching. Thus the search+<pre>+ Eng N baby -Gen ~Pl+</pre>+selects the lines that contain <tt>Gen</tt> but not <tt>Pl</tt>.+++<h2>Using custom paradigms</h2>++(For GF experts.) If you want to use other paradigms than the smart+<tt>mk</tt> paradigms, you can prefix your input with <tt>!</tt> and+use the normal expression syntax of GF. For example:+<pre>+ ! Ara brkN "طير" "فَعل" "فُعُول" Masc NoHum+ ! Bul mkN041 "птица"+ ! Pol mkRegAdj "duży" "większy" "dużo" "więcej"+</pre>+This also allows you to use structured terms:+<pre>+ ! Ger prefixV "auf" (mkV "fassen")+</pre>+++<h2>To do</h2>++<ul>+ <li> nicer input helped by menus+ <li> error handling and reporting when some language doesn't follow+ the format assumed here + <li> better documentation of the paradigms+</ul>++<p>++Powered by <a href=http://grammaticalframework.org>GF</a>. Aarne Ranta 2012.++<hr>+<address></address>+<!-- hhmts start --> Last modified: Wed Sep 12 14:24:51 CEST 2012 <!-- hhmts end -->+</body> </html>
@@ -0,0 +1,7 @@++save: save.hs+ ghc --make save.hs++install::+ @make save+ rsync -avz --exclude .DS_Store P *.html *.css *.js *.cgi *.manifest save www.grammaticalframework.org:/usr/local/www/GF/demos/gfse
binary file changed (absent → 2311 bytes)
binary file changed (absent → 2376 bytes)
binary file changed (absent → 2391 bytes)
binary file changed (absent → 26163 bytes)
binary file changed (absent → 25953 bytes)
binary file changed (absent → 29664 bytes)
binary file changed (absent → 22005 bytes)
@@ -0,0 +1,44 @@++ Safety question before deleting a grammar++ Check identifier syntax++ Allow lincat for deleted cat to be deleted++ Allow lin for deleted fun to be deleted++ Apply category alpha conversion in concrete syntax++ Remove a concrete syntax++ Apply function alpha conversion in concrete syntax++ Change lhs of lins when function type is changed+++ Allow languages other than the ones in the given list to be added++ Export as plain text++ Allow definitions to be reordered+++ 1. possibility to compile the grammar set, returning a URL to a translator app++ 2a. possibility to import modules - resource libraries+- 2b. possibility to import modules - user's own auxiliaries+- 3. possibility to upload own modules++ 4. access to the created files in an on-line shell (making testing possible)+- 5. rule-to-rule type checking and guidance (e.g. with library oper+ suggestions)++ Try grammars in the Translation Quiz++ Show lincat and lin before params and opers below++ Create a new concrete syntax by copying an existing one.+- Easy access to compute_concrete from the editor+- Instead of starting with an empty grammar, start a new grammar by copying+ an example.++ Cloning grammars+- Allow grammars to contain a resoure module. Create the resource module by+ factoring out common parts of the concrete syntaxes.+- Integrate example-based concrete syntax construction (using Ramona's tool)+- Open lexicon modules? They are not installed by default!+ DictEng, MorphalouFre, DictSwe, DictTur, DictBul, DictFun, DictLav+++ compile only the uploaded grammar even if other grammars are present++ 'flags startcat' is needed for grammars with only one category (since the+ default startcat is S, even if it doesn't exist)++- Bug! After adding a 2nd def of a fun with a different type and then deleting+ the old fun, the corresponding lin will have the wrong lhs.+++ Bug! The startcat menu shows the first category by default, but the startcat+ flag is actually not set until a selection is made from the menu.+++ Always open a resizable text box when editing concrete syntax.
@@ -0,0 +1,309 @@+<!DOCTYPE HTML>+<html>+<head>+<title>About: GF online editor for simple multilingual grammars</title>+<link rel="stylesheet" type="text/css" href="editor.css" title="Cloud">+<link rel="alternate stylesheet" type="text/css" href="molto.css" title="MOLTO">++<link rel=author href="http://www.cse.chalmers.se/~hallgren/" title="Thomas Hallgren">++<meta name = "viewport" content = "width = device-width">+<meta http-equiv="Content-type" content="text/html;charset=UTF-8">+<meta charset="UTF-8">++<script type="text/javascript" src="slideshow.js"></script>++</head>++<body>+<h1><a href="../"><img src="../P/gf-cloud.png" alt="" title="GF Cloud Service"></a>GF online editor for simple multilingual grammars</h1>++<div class=right>+ <div class=slideshow>+ <img onload="start_slideshow(this,{delay:5,fade:0.3})" src="P/w1s.jpg" alt="[GF online editor screen shoot]">+ <img class=hidden src="P/w2s.jpg" alt="[GF online editor screen shoot]">+ <img class=hidden src="P/w3s.jpg" alt="[GF online editor screen shoot]">+ <img class=hidden src="P/w4s.jpg" alt="[GF online editor screen shoot]">+ </div>+</div>+<h2>Introduction</h2>++Traditionally, <a href="http://www.grammaticalframework.org/">GF</a>+grammars are created in a text editor and tested in the+GF shell. Text editors know very little (if anything) about the syntax of+GF grammars, and thus provide little guidance for novice GF users. Also, the+grammar author has to download and install the GF software on his/her own+computer.++<p>+In contrast, the+<a href="."><em>GF online editor for simple multilingual grammars</em></a>+is available online, making it easier to get started. All that+is needed is a reasonably modern web browser. Even Android and iOS devices+can be used.+<p>+The editor+also guides the grammar author by showing a skeleton grammar file and+hinting how the parts should be filled in. When a new part is added to the+grammar, it is immediately checked for errors.++<p>+Editing operations are accessed by clicking on editing symbols embedded+in the grammar display:+<span class=more>+</span>=Add an item,+<span class=delete>×</span>=Delete an item,+<span class=edit>%</span>=Edit an item.+These are revealed when hovering over items. On touch devices, hovering is+in some cases simulated by tapping, but there is also a button at the bottom+of the display to "Enable editing on touch devices" that reveals all editing+symbols.++<p>+In spite of its name, the core of the editor runs in the web+browser, so once you have opened the web page, you can+<strong>continue editing</strong> grammars even while you are+<strong>offline</strong>. Grammar compilation & testing and some+error checking is done by the GF server and is not available while offline.++<h3>Current status</h3>++<p>+At the moment, the editor supports only a small subset of the GF grammar+notation.+Proper error checking is done for abstract syntax, but not (yet) for concrete+syntax.++<p>+The grammars created with this editor always consists of one file for the+abstract syntax, and one file for each concrete syntax.++<h4>Abstract syntax</h4>++The supported abstract syntax corresponds to context-free grammars+(no dependent types). The definition of an abstract syntax is limited to+<ul>+ <li>a list of inherited abstract syntaxes,+ <li>a list of <em>category names</em>,+ <var>Cat<sub>1</sub></var> ; ... ; <var>Cat<sub>n</sub></var>,+ <li>a list of <em>functions</em> of the form+ <var>Fun</var> : <var>Cat<sub>1</sub></var> -> ... ->+ <var>Cat<sub>n</sub></var>,+ <li>and a <em>start category</em>.+</ul>++Available editing operations:+<ul>+ <li>Inherited abstract syntaxes can be added and removed.+ <li>Categories can be added, removed and renamed. When renaming a category,+ occurences of it in function types will be updated accordingly.+ <li>Functions can be added, removed and edited. Concrete syntaxes are updated+ to reflect changes.+ <li>Functions can be reordered using drag-and-drop.+</ul>++Error checks:++<ul>+ <li>Syntactically incorrect function definitions are refused.+ <li>Semantic problem such as duplicated definitions or references to+ undefined categories, are highlighted.+</ul>++<h4>Concrete syntax</h4>++At the moment, the concrete syntax for a language <var>L</var> is limited to+<ul>+ <li>inheriting the concrete syntax <var>G<sub>i</sub>L</var>+ for each <var>G<sub>i</sub></var> inherited by the abstract syntax.+ <li>opening a selection of the Resource Grammar Library modules+ <code>Syntax</code><var>L</var>, <code>Paradigms</code><var>L</var>,+ <code>Lexicon</code><var>L</var>, <code>Symbolic</code><var>L</var>+ and <code>Extra</code><var>L</var>,+ <li><em>linearization types</em> for the categories in the abstract syntax,+ <li><em>linearizations</em> for the functions in the abstract syntax,+ <li><em>parameter type definitions</em>,+ <var>P</var> = <var>C<sub>1</sub></var> | ... |<var>C<sub>n</sub></var>,+ <li>and <em>operation definitions</em>, <var>op</var> = <var>expr</var>,+ <var>op</var> : <var>type</var> = <var>expr</var>,+</ul>++Available editing operations:+<ul>+ <li>Modules can be added and removed from the list of opened Resource Grammar+ Library modules.+ <li>The LHSs of the linearization types and linearizations are determined by+ the abstract syntax and do not need to be entered manually.+ The RHSs can+ be edited.+ <li>Parameter types can be added, removed and edited.+ <li>Operation definitons can be added, removed and edited.+ <li>Definitions can be reordered (using drag-and-drop).+</ul>+Also,++<ul>+ <li>When a new concrete syntax is added to the grammar, a copy of the+ currently open concrete syntax is created, since copying and modifying+ is usually easier than creating something new from scratch.+ (If the abstract syntax is currently open, the new conrete syntax will+ start out empty.)+ <li>When adding a new concrete syntax, you normally pick one of the supported+ languages from a list. The language code and the file name is determined+ automatically. But you can also pick <em>Other</em> from the list and change+ the language code afterwards to add a concrete syntax for a language+ that is not in the list.+</ul>++Error checks:+<ul>+ <li>The RHSs in the concrete syntax are checked+ for syntactic correctness by the editor as they are entered.+ (TODO: the syntax of parameter types is not check at the moment.)+ <li>Duplicated definitions are highlighted. Checks for other+ semantic errors are delayed until the grammar is compiled.+</ul>++<h3>Grammar views</h3>++The editor supports three ways to view a grammar:++<ul>+ <li><strong>Column view</strong>:+ this is the traditional view where you see one complete grammar module at a+ time. i.e. either the abstract syntax or one of the concrete syntaxes in the+ grammar.+ <li><strong>Matrix view</strong>:+ this presents an overview of the grammar where columns+ correspond to the abstract and concrete syntax modules and rows correspond+ to the categories and functions in the grammar.+ <li><strong>Row view</strong>:+ this view shows one function form the abstract syntax and+ the corresponding linearization functions from all the concrete syntaxes.+</ul>++<h3>Compiling and testing grammars</h3>++When pressing the <strong>Compile</strong> button, the grammar will be compiled+with GF, and any errors not detected by the editor will be reported.+The grammar will also be compiled when pressing the <strong>Minibar</strong>+and <strong>Quiz</strong> buttons before opening the grammar for testing+in the Minibar or the Translation Quiz, respectively.++<h3><img class=right src="P/1307545089_weather_04.png" alt="">+<img class=right src="P/1306856253_weather_06.png" alt="">Grammars in the+cloud</h3>++While the editor normally stores grammars locally in the browser, it is also+possible to store grammars in the cloud. Grammars can be stored in the cloud+just for backup, or to make them accessible from multiple devices.++<p>+There is no automatic synchronization between local grammars and the cloud.+Instead, the user should press+<img src="P/1306856253_weather_06.png" alt="[Cloud Upload]">+to upload the grammars to the cloud, and press+<img src="P/1307545089_weather_04.png" alt="[Cloud download]">+to download grammars from the cloud. In both cases, complete grammars+are copied and older versions at the destination will be overwritten.+When a grammar is deleted, both the local copy and the copy in the cloud+is deleted.++<p>+Each device is initially assigned to its own unique cloud. Each device can thus+have its own set of grammars that are not available on other devices. It is+also possible to merge clouds and share a common set of grammars between+multiple devices: when uploading grammars to the cloud, a link to this grammar+cloud appears. Accessing this link from another device will cause the clouds of+the two devices to be merged. After this, grammars uploaded from one of the+devices can be downloaded on the other devices. Any number devices can join the+same grammar cloud in this way.++<p>+<strong>Note</strong> that while it is possible to copy grammars between+multiple devices, there is no way to merge concurrent edits from multiple+devices. If the same grammar is uploaded to the+cloud from multiple devices, the last upload wins. Thus the current+implementation is suitable for a single user switching between different+devices, but not recommended for sharing grammars between multiple users.++<p>+Also <strong>note</strong> that each grammar is assigned a unique identity+when it is first created. Renaming a grammar does not change its identity.+This means that name changes are propagated between devices like other changes.++<h4 id=public>Public grammars</h4>+<blockquote>+[October 2012: this is an <strong>experimental feature</strong> that+might be replaced by an incompatible grammar sharing mechanism in the future.]+</blockquote>+<p>+The grammar cloud also includes a list of public grammars.+Grammars can be added to the public list by pressing the+<strong>Publish</strong> button shown next to the grammars in the list of+your grammars.++<p>+The <strong>Publish</strong> button creates <em>copy</em> of your grammar.+If you continue to edit your grammar, the changes will be local only.+You can press the <strong>Publish</strong> button again to update the public+copy.++<p>+You can remove a grammar from the public list by pressing the+<span class=delete>×</span> button next to the grammar in the public list.+You can <em>not</em> remove grammars published by other users.++<p>+When you open a public grammar published by another user, a <em>copy</em> of+the grammar is added to the list of your grammars. Any changes will be made in+your own copy of the grammar. If you publish your copy of the grammar, it will+appear separately in the list of public grammars. You can not+overwrite grammars published by other users, even if they have the same name.++<p>+TODO: Publishing grammars that inherit form other grammars is not recommended.+There is no way to indicate which of several grammars with the same name is+being inherited.++<p>+TODO: There should probably be a way to identify who published a grammar and+when. Maybe the publish button should be restricted to registered users...+++<h3>Example-based grammar writing</h3>++We experimented with this in 2011. It is currently not included, but it+might return in a future version...++<h3>Future work</h3>++This prototype gives an idea of how a web based GF grammar editor could work.+While this editor is implemented in JavaScript and runs in the web browser,+we do not expect to create a full implementation of GF that runs in the+web browser, but let the editor communicate with a server running GF.+<p>+By developing a GF server with an appropriate API, it should+be possible to extend the editor to support a larger fragment of GF,+to do proper error checking and make more of the existing GF shell functionality+accessible directly from the editor.+<p>+The current grammar cloud service is very primitive. In particular, it is not+suitable for multiple users developing a grammar in collaboration.++<h3>Related documents</h3>+<ul>+ <li><a href="http://www.grammaticalframework.org/~hallgren/Talks/GF/gf-ide.html">GF Grammar Development Tools</a>. Slides from a presentation at the MOLTO meeting in Göteborg, March 2011.+ <li><a href="http://www.grammaticalframework.org/grammar-ide/">The GF Grammar IDE</a>. MOLTO deliverable.+ <li><a href="http://www.grammaticalframework.org/compiler-api">The GF Grammar+ Compiler API</a>. MOLTO deliverable.+</ul>++<hr>+<div class=modtime><small>+<!-- hhmts start -->Last modified: Tue Oct 9 16:52:47 CEST 2012 <!-- hhmts end -->+ </small></div>+<address>+<a href="http://www.cse.chalmers.se/~hallgren/">TH</a>+<img src="http://www.altocumulus.org/~hallgren/online.cgi?icon" alt="">+</address>+</body> </html>
@@ -0,0 +1,148 @@++function with_dir(cont) {+ var dir=local.get("dir","");+ if(dir) cont(dir);+ else ajax_http_get("upload.cgi?dir",+ function(dir) {+ local.put("dir",dir);+ cont(dir);+ });+}++function remove_cloud_grammar(g) {+ var dir=local.get("dir")+ if(dir && g.unique_name) {+ var path=dir+"/"+g.unique_name+".json"+ ajax_http_get("upload.cgi?rm="+encodeURIComponent(path),debug);+ }+}++// Upload the grammar to the server and check it for errors+function upload(g) {+ function upload2(dir) {+ var form=node("form",{method:"post",action:"upload.cgi"+dir},+ [hidden(g.basename+".gf",show_abstract(g))])+ for(var i in g.concretes)+ form.appendChild(hidden(g.basename+g.concretes[i].langcode+".gf",+ show_concrete(g)(g.concretes[i])));+ editor.appendChild(form);+ form.submit();+ form.parentNode.removeChild(form);+ }++ with_dir(upload2);+}++// Upload the grammar to store it in the cloud+function upload_json(cont) {+ function upload3(resptext,status) {+ local.put("json_uploaded",Date.now());+ //debug("Upload complete")+ if(cont) cont();+ else {+ var sharing=element("sharing");+ if(sharing) sharing.innerHTML=resptext;+ }+ }+ function upload2(dir) {+ var prefix=dir.substr(10)+"-" // skip "/tmp/gfse."+ //debug("New form data");+ //var form=new FormData(); // !!! Doesn't work on Android 2.2!+ var form="",sep="";+ //debug("Preparing form data");+ for(var i=0;i<local.count;i++) {+ var g=local.get(i,null);+ if(g) {+ if(!g.unique_name) {+ g.unique_name=prefix+i;+ save_grammar(g)+ }+ //form.append(g.unique_name+".json",JSON.stringify(g));+ form+=sep+encodeURIComponent(g.unique_name+".json")+"="++ encodeURIComponent(JSON.stringify(g))+ sep="&"+ }+ }+ //debug("Upload to "+prefix);+ ajax_http_post("upload.cgi"+dir,form,upload3,cont)+ }++ with_dir(upload2);+}++function download_json() {+ var dir=local.get("dir");+ var index=grammar_index();+ var downloading=0;++ function get_list(ok,err) {+ ajax_http_get("upload.cgi?ls="+dir,ok,err);+ }++ function get_file(file,ok,err) {+ downloading++;+ ajax_http_get("upload.cgi?download="+encodeURIComponent(dir+"/"+file),ok,err);+ }++ function file_failed(errormsg,status) {+ debug(errormsg)+ downloading--;+ }+ function file_downloaded(grammar) {+ downloading--;+ var newg=JSON.parse(grammar);+ debug("Downloaded "+newg.unique_name)+ var i=index[newg.unique_name];+ if(i!=undefined) merge_grammar(i,newg)+ else {+ debug("New")+ newg.index=null;+ save_grammar(newg);+ }+ if(downloading==0) done()+ }++ function done() {+ setTimeout(function(){location.href="."},2000);+ }++ function download_files(ls) {+ local.put("current",0);+ if(ls) {+ //debug("Downloading "+ls);+ var files=ls.split(" ");+ cleanup_deleted(files);+ for(var i in files) get_file(files[i],file_downloaded,file_failed);+ }+ else {+ debug("No grammars in the cloud")+ done()+ }+ }++ get_list(download_files);+}++function link_directories(newdir,cont) {+ with_dir(function(olddir) {+ ajax_http_get("upload.cgi?rmdir="+olddir+"&newdir="+newdir,cont)+ })+}++/* -------------------------------------------------------------------------- */++// Send a command to the GF shell+function gfshell(cmd,cont) {+ alert("gfshell(...) not implmemented!!!")+}++// Check the syntax of an expression+function check_exp(s,cont) {+ function check(gf_message) {+ //debug("cc "+s+" = "+gf_message);+ cont(/(parse|syntax) error/.test(gf_message) ? "syntax error" : null);+ }+ if(navigator.onLine)+ ajax_http_get("upload.cgi?cc="+encodeURIComponent(s),check)+ else cont(null)+}
@@ -0,0 +1,278 @@++function with_dir(cont) {+ function have_dir(dir) {+ var unique_id=local.get("unique_id")+ if(!unique_id) {+ unique_id=dir.substr(10) // skip "/tmp/gfse."+ local.put("unique_id",unique_id)+ }+ cont(dir,unique_id)+ }+ var dir=local.get("dir","");+ if(/^\/tmp\//.test(dir)) have_dir(dir);+ else ajax_http_get("/new",+ function(dir) {+ local.put("dir",dir);+ have_dir(dir);+ });+}++function remove_cloud_grammar(g) {+ var dir=local.get("dir")+ if(dir && g.unique_name) {+ var path=g.unique_name+".json"+ gfcloud("rm",{file:path},debug);+ }+}++// Upload the grammar to the server and check it for errors+function old_upload(g) {+ function upload2(dir) {+ var form=node("form",{method:"post",action:"/cloud"},+ [hidden("dir",dir),hidden("command","make"),+ hidden(g.basename+".gf",show_abstract(g))])+ //var files = [g.basename+".gf"]+ for(var i in g.concretes) {+ var cname=g.basename+g.concretes[i].langcode+".gf";+ //files.push(cname);+ form.appendChild(hidden(cname,+ show_concrete(g)(g.concretes[i])));+ }+ editor.appendChild(form);+ form.submit();+ form.parentNode.removeChild(form);+ }++ function upload3(message) { if(message) alert(message); }++ with_dir(upload2)+}++// Upload the grammar to the server and check it for errors+function upload_grammars(gs,cont) {+ function upload2(dir) {+ var pre="dir="+encodeURIComponent(dir)+ var form= {command:"make"}+ for(var aix in gs) {+ var g=gs[aix]+ form[encodeURIComponent(g.basename+".gf")]=show_abstract(g)+ var cnc=g.concretes+ for(var i in cnc) {+ var cname=g.basename+cnc[i].langcode+".gf";+ form[encodeURIComponent(cname)]=show_concrete(g)(cnc[i]);+ }+ }+ ajax_http_post("/cloud",pre+encodeArgs(form),upload3)+ }++ function upload3(json) {+ var res=JSON.parse(json)+ if(cont) cont(res)+ else alert(res.errorcode+"\n"+res.command+"\n\n"+res.output);+ }++ if(navigator.onLine) with_dir(upload2)+ else cont({errorcode:"Offline",command:"",output:""})+}++function assign_unique_name(g,unique_id) {+ if(!g.unique_name) {+ g.unique_name=unique_id+"-"+g.index;+ save_grammar(g)+ }+ return g+}++// Upload all grammars to the cloud+function upload_json(cont) {+ function upload2(dir,unique_id) {+ function upload3(resptext,status) {+ local.put("json_uploaded",Date.now());+ //debug("Upload complete")+ if(cont) cont();+ else {+ var sharing=element("sharing");+ if(sharing) {+ if(status==204) {+ var a=empty("a");+ a.href="share.html#"+dir.substr(5) // skip "/tmp/"+ a.innerHTML=a.href;+ sharing.innerHTML="";+ sharing.appendChild(text("Use the following link for shared access to your grammars from multiple devices: "))+ sharing.appendChild(a)+ }+ else+ sharing.innerHTML=resptext;+ }+ }+ }++ //debug("New form data");+ //var form=new FormData(); // !!! Doesn't work on Android 2.2!+ var form={dir:dir};+ //debug("Preparing form data");+ for(var i=0;i<local.count;i++) {+ var g=local.get(i,null);+ if(g) {+ g=assign_unique_name(g,unique_id)+ //form.append(g.unique_name+".json",JSON.stringify(g));+ form[encodeURIComponent(g.unique_name+".json")]=JSON.stringify(g)+ }+ }+ ajax_http_post("/cloud","command=upload"+encodeArgs(form),upload3,cont)+ }++ with_dir(upload2);+}++function remove_public(name,cont,err) {+ gfcloud_public_post("rm",{file:name},cont,err)+}++// Publish a single grammar+function publish_json(g,cont) {+ function publish2(dir,unique_id) {+ var oldname=g.publishedAs++ function publish3(resptext,status) {+ console.log("publish3")+ if(oldname && oldname!=g.basename) {+ console.log("old name="+oldname)+ var name=oldname+"-"+g.unique_name+".json"+ remove_public(name,cont,cont)+ }+ else cont()+ }+ g.publishedAs=g.basename;+ save_grammar(g);+ g=assign_unique_name(g,unique_id)+ var name=g.basename+"-"+g.unique_name+ var ix=g.index;+ delete g.publishedAs+ delete g.unique_name+ delete g.index+ var form={}+ form[encodeURIComponent(name+".json")]=JSON.stringify(g)+ g=reget_grammar(ix)+ gfcloud_public_post("upload",form,publish3,cont)+ }+ with_dir(publish2);+}++function download_json() {+ var dir=local.get("dir");+ var downloading=0;++ function get_list(ok,err) { gfcloud("ls",{},ok,err) }++ function get_file(file,ok,err) {+ downloading++;+ gfcloud("download",{file:file},ok,err);+ }++ function file_failed(errormsg,status) {+ debug(errormsg)+ downloading--;+ }+ function file_downloaded(grammar) {+ downloading--;+ var newg=JSON.parse(grammar);+ debug("Downloaded "+newg.unique_name)+ var i=my_grammar(newg.unique_name);+ if(i!=null) merge_grammar(i,newg)+ else {+ debug("New")+ newg.index=null;+ save_grammar(newg);+ }+ if(downloading==0) done()+ }++ function done() {+ setTimeout(function(){location.href="."},2000);+ }++ function download_files(ls) {+ local.put("current",0);+ if(ls) {+ //debug("Downloading "+ls);+ var files=JSON.parse(ls);+ cleanup_deleted(files);+ for(var i in files) get_file(files[i],file_downloaded,file_failed);+ }+ else {+ debug("No grammars in the cloud")+ done()+ }+ }++ get_list(download_files);+}++function link_directories(newdir,cont) {+ gfcloud("link_directories",{newdir:newdir},cont)+}++/* -------------------------------------------------------------------------- */++var public_dir="/tmp/public"++// Request GF cloud service in the public directory (using GET)+function gfcloud_public_json(cmd,args,cont,err) {+ var enc=encodeURIComponent;+ var url="/cloud?dir="+public_dir+"&command="+enc(cmd)+encodeArgs(args)+ http_get_json(url,cont,err)+}++// Request GF cloud service in the public directory (using POST)+function gfcloud_public_post(cmd,args,cont,err) {+ var enc=encodeURIComponent;+ var req="dir="+public_dir+"&command="+enc(cmd)+encodeArgs(args)+ ajax_http_post("/cloud",req,cont,err)+}++// Request GF cloud service (using GET, for idempotent requests)+function gfcloud(cmd,args,cont,err) {+ with_dir(function(dir) {+ var enc=encodeURIComponent;+ var url="/cloud?dir="+enc(dir)+"&command="+enc(cmd)+encodeArgs(args)+ ajax_http_get(url,cont,err)+ })+}++// Reqest GF cloud service (using POST, for state changing requests)+function gfcloud_post(cmd,args,cont,err) {+ with_dir(function(dir) {+ var enc=encodeURIComponent;+ var req="dir="+enc(dir)+"&command="+enc(cmd)+encodeArgs(args)+ ajax_http_post("/cloud",req,cont,err)+ })+}++// Send a command to the GF shell+function gfshell(cmd,cont) {+ with_dir(function(dir) {+ var enc=encodeURIComponent;+ ajax_http_get("/gfshell?dir="+enc(dir)+"&command="+enc(cmd),cont)+ })+}++// Check the syntax of a source module+function check_module(path,source,cont) {+ var enc=encodeURIComponent;+ //http_get_json("/parse?"+enc(path)+"="+enc(source),cont)+ ajax_http_post_json("/parse",enc(path)+"="+enc(source),cont)+}++// Check the syntax of an expression+function check_exp(s,cont) {+ function check(gf_message) {+ //debug("cc "+s+" = "+gf_message);+ cont(/(parse|syntax) error/.test(gf_message) ? "syntax error" : null);+ }+ gfshell("cc "+s,check);+}++// Lexing/unlexing text+function lextext(txt,cont) { gfshell('ps -lextext "'+txt+'"',cont) }+function unlextext(txt,cont) { gfshell('ps -bind -unlextext "'+txt+'"',cont) }
@@ -0,0 +1,152 @@+@import url(../cloud.css);++#editor {+ /* This allows the div to grow wider than the window if necessary to+ accommodate the contents. Otherwise, wide things inside can poke+ through the border. */+ display: table;+ width: 100%;+}++div.home, div.grammar { border: 1px solid black; background: #9df; }+div.home { padding: 5px; }+div.files { margin: 0 8px 8px 8px; position: relative; }+td.public_grammars { padding-left: 2em; }+.no_publish .publish { display: none; }++div#file, table.extension td, table.extension th { border: 2px solid #009; }+div#file { border-top-width: 0; }+pre.plain { border: 2px solid #009; }+div#file, pre.plain, table.matrixview td { background: white; padding: 0.6ex; }++table.extension { border-collapse: collapse; background: white; }+table.extension td, table.extension th { padding: 1ex; }+table.extension th { border-right-width: 0; color: #009; }+table.extension td { border-left-width: 0; min-width: 30em; }++.slideshow .hidden { display: none; }++table.grammar_list { border-collapse: collapse; margin-left: 1.0em; }+table.grammar_list td { padding: 0.4ex 0.25em; }++div.namebar { background: #9df; }+div.namebar table { width: 100%; }+.namebar h3, .sheet h3 { margin: 0; color: #009; }+.home h3 { margin-top: 0; color: #009; }++div.comment:before { content: "-- "; }+div.comment { color: #009; margin-left: 1em; }++td.right { text-align: right; }+td.center { text-align: center; }++.kw { font-weight: bold; font-family: sans-serif; color: #009; }+.sep { font-weight: bold; color: #009; }++div.indent { padding-left: 1em; min-width: 1em; min-height: 1em; }++div.fun:hover, div.param:hover, div.lincat:hover, div.oper:hover, div.lin:hover,+div.template:hover+{ background: #def;}++.exb_linbuttons input[type=button] { float: right; clear: right; margin: 0; }+.exb_output { background: #dfd; float: right; margin: 0 10px; }++.more, .delete { font-weight: bold; font-family: sans-serif; }+.more, .delete, .edit, *[onclick], .onclick { cursor: pointer; }+.onclick:hover, .ident[onclick]:hover { text-decoration: underline; }++.hover .more, .hover .delete, .hover .edit { visibility: hidden }++.hover .hidden, .nohover .ifhover { display: none; }++.editable:hover, .deletable:hover { background: #ff9; }++.extensible:hover .more,.editable:hover > .edit ,.deletable:hover > .delete,+ tr.deletable:hover .delete + { visibility: visible; }++.editable { white-space: pre; }+div.lin span.editable { display: inline-block; vertical-align: top; }++.more { color: green; }+.edit { color: orange; }+.delete { color: red; }+.error_message,.inError { color: red; }+.template, .template .sep, .unimportant { color: #999; }+form { display: inline-block; }++table.tabs {+ width: 100%;+ border-width: 0; border-spacing: 0; empty-cells: show;+}++table.tabs td { text-align: center; border: 2px solid #009; padding: 2px; white-space: nowrap; }+table.tabs td.active { background: white; border-bottom-width: 0; }+table.tabs td.inactive {+ background: #cef;+ border-top-color: #66c; border-left-color: #66c; border-right-color: #66c;+}++table.matrixview th { background: #cef; color: #009; }++ table.tabs td.gap+{ border-top-width: 0; border-left-width: 0; border-right-width: 0; }++table.tabs input[type=button], table.matrixview th input[type=button] {+ border: 0;+ background: inherit;+ color: #009;+ font-size: inherit;+ font-weight: bold;+ /*text-decoration: underline;*/+}++.string_edit { font-family: inherit; font-size: inherit; }+textarea.string_edit { vertical-align: top; }++ul.languages { -moz-column-width: 10em; }++#sharing h1, #sharing .footer { display: none; }++div.compiler_output .back_to_editor { display: none; }++textarea.text_mode {+ /*font-family: inherit; font-size: inherit;*/+ width: 99%;+}++div#minibar, div#syntax_editor {+ border: 1px solid black;+ padding: 5px;+ background: #ccc url("../minibar/brushed-metal.png");+}++table.page_overlay {+ position: absolute;+ top: 0; left: 0;+ width: 100%; height: 100%;+ background: rgba(0,0,0,0.5);+}+table.page_overlay>tr>td { text-align: center; vertical-align: middle; }++div.grammar_extension {+ display: inline-block;+ border: 1px solid black;+ background: #9df;+ padding: 2ex;+ margin: 2ex;+ box-shadow: 10px 10px 10px rgba(0,0,0,0.3);+}++div.sheet {+ position: relative;+ background: white;+ padding: 1ex;+ margin: 2ex;+ box-shadow: 5px 5px 15px rgba(0,0,0,0.5);+ transition: all 0.5s ease-in-out;+ -o-transition: all 0.5s ease-in-out;+ -moz-transition: all 0.5s ease-in-out;+ -webkit-transition: all 0.5s ease-in-out;+}
@@ -0,0 +1,2042 @@+++var editor=element("editor");+var compiler_output=element("compiler_output")++/* -------------------------------------------------------------------------- */++// grammar_cache :: [Grammar]+// grammarlist :: {Int=>{unique_name:String,basename:ModId}}+var grammar_cache=[]+var grammarlist={}++function reget_grammar(ix) { return grammar_cache[ix]=local.get(ix) }+function get_grammar(ix) {+ return fix_extends(grammar_cache[ix] || reget_grammar(ix))+}++function put_grammar(ix,g) {+ grammarlist[ix]={unique_name:g.unique_name,basename:g.basename}+ grammar_cache[ix]=g;+ local.put(ix,g)+ local.put(".grammarlist",grammarlist)+}++function remove_grammar(ix) {+ delete grammar_cache[ix];+ delete grammarlist[ix];+ local.remove(ix);+ local.put(".grammarlist",grammarlist)+}++function my_grammar(unique_name) {+ for(var ix in grammarlist)+ if(grammarlist[ix].unique_name==unique_name)+ return ix+ return null+}++function find_grammar(basename) {+ for(var ix in grammarlist)+ if(grammarlist[ix].basename==basename)+ return ix+ return null+}++// For sorting grammars alphabetically by name+function byBasename(a,b) {+ return a.basename<b.basename ? -1 : a.basename>b.basename ? 1 : 0;+}++/* -------------------------------------------------------------------------- */++function initial_view() {+ var current=local.get("current");+ if(current>0) open_grammar(current-1);+ else draw_grammar_list();+ //debug(local.get("dir","no server directory yet"));+}++function draw_grammar_list() {+ local.put("current",0);+ clear(editor);+ var uploaded=local.get("dir") && local.get("json_uploaded");+ var cloud_upload=+ a(jsurl("upload_json()"),+ [node("img",{"class":"cloud",+ src:"P/1306856253_weather_06.png",alt:"[Up Cloud]",+ title: uploaded+ ? "Click to upload grammar updates to the cloud"+ : "Click to store your grammars in the cloud"},+ [])]);+ var userlist=td(wrap("h3",[text("Your grammars "),cloud_upload]))+ if(uploaded) {+ var cloud_download=+ a(jsurl("download_json()"),+ [node("img",{"class":"cloud",+ src:"P/1343909216_weather_03.png",alt:"[Down Cloud]",+ title:"Click to download grammar updates from the cloud"},+ [])]);+ insertAfter(cloud_download,cloud_upload);+ }+ function edtr(cs) { return wrap_class("tr","extensible deletable",cs); }+ function del(i) { return function () { delete_grammar(i); } }+ function clone(i) { return function () { clone_grammar(i); } }+// function new_extension(i) { return function (g,b) { new_grammar([g]) }}+ function item(i,gid) {+ //var i=my_grammar(gid.unique_name)+ var link=a(jsurl("open_grammar("+i+")"),[text(gid.basename)]);+ if(!navigator.onLine) pubspan=[]+ else {+ function publish() {+ pub.disabled=true+ publish_json(get_grammar(i),draw_grammar_list)+ }+ var pub=attr({class:"public",+ title:"Publish a copy of this grammar."},+ button("Publish",publish))+ var pubspan=[span_class("more",pub)]+ }+ return edtr([td(delete_button(del(i),"Delete this grammar")),+ td(title(gid.unique_name || "",link)),+ td(more(clone(i),"Clone this grammar")),+ td(pubspan)+ ])+ }+ if(local.get("count",null)==null)+ userlist.appendChild(text("You have not created any grammars yet."));+ else if(local.count==0)+ userlist.appendChild(text("Your grammar list is empty."));+ else {+ //var ls=[];+ //for(var ix in grammarlist) ls.push(grammarlist[ix])+ //ls.sort(byBasename)+ var rows=[];+ for(var ix in grammarlist) rows.push(item(ix,grammarlist[ix]))+ userlist.appendChild(node("table",{"class":"grammar_list"},rows));+ }++ userlist.appendChild(ul(li(a(jsurl("new_grammar()"),[text("New grammar")]))));+ //editor.appendChild(text(local.count));+ var publiclist=empty_class("td","public_grammars")+ function no_public() {+ userlist.className="no_publish"+ }+ function show_public(files) {+ function rmpublic(file) {+ return function() { remove_public(file,draw_grammar_list) }+ }+ var h=wrap("h3",text("Public grammars"))+ var ordermenu=wrap("select",[option("Newest first","byAge"),+ option("Alphabetical","byName")])+ ordermenu.value=local.get("publicOrder","byAge")+ ordermenu.onchange=function(){+ local.put("publicOrder",ordermenu.value)+ if(n>1) show_grammars()+ }+ var n=files.length+ var count=n==1 ? " (One grammar)" : " ("+n + " grammars)"+ var t=table(tr([td(h),td(text(count)),td(ordermenu)]))+ publiclist.appendChild(t)+ for(var i in files) {+ var file=files[i]+ file.t=new Date(file.time)+ file.s=file.t.getTime()+ }+ function sort_grammars() {+ switch(ordermenu.value) {+ case "byAge":+ files.sort((f1,f2)=>f2.s-f1.s)+ break;+ case "byName":+ files.sort((f1,f2)=>(f1.path>f2.path)-(f1.path<f2.path))+ }+ }+ var gt=empty_class("table","grammar_list")+ publiclist.appendChild(gt)+ function show_grammars() {+ clear(gt)+ if(files.length>0) {+ sort_grammars()+ var unique_id=local.get("unique_id","-")+ for(var i in files) {+ var file=files[i].path+ var parts=file.split(/[-.]/)+ var basename=parts[0]+ var unique_name=parts[1]+"-"+parts[2]+ var mine = my_grammar(unique_name)!=null+ var from_me = parts[1] == unique_id+ var del = from_me || mine+ ? delete_button(rmpublic(file),"Remove this public grammar")+ : []+ var tip = mine+ ? "This is a copy of your grammar"+ : "Click to download a copy of this grammar"+ var modt=new Date(files[i].time)+ var fmtmodt=modt.toDateString()+", "+modt.toTimeString().split(" ")[0]+ var when=wrap_class("small","modtime",text(" "+fmtmodt))+ gt.appendChild(edtr([td(del),+ td(title(tip,+ a(jsurl('open_public("'+file+'")'),+ [text(basename)]))),+ td(text(files[i].comment||"")),+ td(when)]))+ }+ }+ else+ publiclist.appendChild(p(text("No public grammars are available.")))+ // This is outside the table so it won't be cleared,+ // but show_grammars is only called once then there is less+ // than 2 grammars, so it's OK.+ }+ show_grammars()+ }+ if(navigator.onLine)+ gfcloud_public_json("ls-l",{},show_public,no_public)+ var home=div_class("home",table(tr([userlist,publiclist])))+ home.appendChild(empty_id("div","sharing"));+ editor.appendChild(home)+}++function new_grammar() {+ var g={basename:"Unnamed",+ comment:"",+ extends:[],+ uextends:[],+ abstract:{cats:[],funs:[]},+ concretes:[]/*empty_concretes_extending(gs)*/}+ edit_grammar(g);+}+/*+function empty_concretes_extending(gs) {+ var concs=[]+ var langs=[];+ for(var i in gs) {+ var g=gs[i];+ for(var ci in g.concretes) {+ var conc=g.concretes[ci];+ var code=conc.langcode;+ if(!langs[code])+ langs[code]=true,concs.push(new_concrete(code))+ }+ }+ return concs+}+*/+function remove_local_grammar(i) {+ remove_grammar(i);+ while(local.count>0 && !local.get(local.count-1))+ local.count--;+}++function delete_grammar(ix) {+ var g=get_grammar(ix);+ var ok=confirm("Do you really want to delete the grammar "+g.basename+"?")+ if(ok) {+ remove_local_grammar(ix)+ remove_cloud_grammar(g)+ initial_view();+ }+}++function clone_grammar(i) {+ var old=get_grammar(i);+ var g={basename:old.basename,+ extends:old.extends || [], uextends:old.uextends || [],+ abstract:old.abstract,concretes:old.concretes}+ save_grammar(g); // we rely on the serialization to eliminate sharing+ draw_grammar_list();+}++function open_grammar(i) {+ var g=get_grammar(i);+ if(g) {+ g.index=i;+ local.put("current",i+1);+ edit_grammar(g);+ }+ else {+ alert("Something went wrong: grammar at index "+i+" is not usable.")+ draw_grammar_list()+ }+}++function open_public(file) {+ function got_json(g) {+ delete g.index+ delete g.unique_name+ delete g.publishedAs+ if(!g.uextends) g.uextends=[]+ reload_grammar(g)+ }+ var parts=file.split(/[-.]/)+ var unique_name=parts[1]+"-"+parts[2]+ var ix=my_grammar(unique_name)+ console.log("open public",file,ix)+ if(ix!=null) open_grammar(ix)+ else gfcloud_public_json("download",{file:file},got_json)+}++function close_grammar(g) {+ clear(compiler_output);+ save_grammar(g);+ draw_grammar_list();+}+function reload_grammar(g) { save_grammar(g); edit_grammar(g); }++function save_grammar(g) {+ if(g.index==null) g.index=local.count++;+ put_grammar(g.index,g);+}++function edit_grammar(g) {+ replaceChildren(editor,draw_grammar(g));+}++function draw_grammar(g) {+ switch(g.view) {+ case "matrix":+ var files=div_class("files",draw_matrix(g))+ break;+ case "row":+ var files=div_class("files",draw_row(g))+ break;+ default:+ g.view="column"+ var file=draw_file(g)+ var files=div_class("files",[draw_filebar(g,file),file]);+ break;+ }+ return div_class("grammar",[draw_namebar(g,files),files])+}++function draw_namebar(g,files) {+ var err_ind=empty("small"); // space for error indicator+ var cb=compile_button(g,err_ind);+ var mb=minibar_button(g,files,err_ind,cb);+ var qb=quiz_button(g,err_ind);+ //var pb=draw_plainbutton(g,files);++ var fb=draw_view_button(g,"column")+ var mxb=draw_view_button(g,"matrix")+ var rb=draw_view_button(g,"row")++ var xb=draw_closebutton(g);+ var center=[wrap("small",text("View: ")),fb,mxb,rb]+ var right=[err_ind,cb,mb,qb,xb]+ return div_class("namebar",+ [table([tr([td(draw_name(g)),+ td_center(center),+ td_right(right)]),+ tr([attr({colspan:"3"},td(draw_comment(g)))])+ ])+ ])+}++function draw_name(g) {+ return editable("h3",text(g.basename),g,edit_name,"Rename grammar");+}++function draw_closebutton(g) {+ return title("Save and Close this grammar",+ button("X",function(){close_grammar(g);}))+}++function draw_view_button(g,view) {+ var b=title("Shitch to the "+view+" view of the grammar",+ button(view,function(){open_view(g,view);}))+ b.disabled=g.view==view+ return b;+}++/*+function draw_plainbutton(g,files) {+ var b2;+ function show_editor() { edit_grammar(g); }+ function show_plain() {+ files.innerHTML="<pre class=plain>"+show_grammar(g)+"</pre>"+ b.style.display="none";+ if(b2) b2.style.display="";+ else {+ b2=button("Show editor",show_editor);+ insertAfter(b2,b);+ }+ }+ var b=button("Show plain",show_plain);+ b.title="Show plain text representaiton of the grammar";+ return b;+}+*/++function show_compile_error(res,err_ind) {+ var dst=compiler_output+ replaceInnerHTML(err_ind,res.errorcode=="OK" + ? res.errorcode+" "+ : "<span class=error_message>"+res.errorcode+" </span>")+ if(dst) {+ clear(dst);+ if(res.errorcode=="OK")+ dst.appendChild(wrap("h3",text("OK")))+ else+ appendChildren(dst,+ [node("h3",{"class":"error_message"},+ [text(res.errorcode)]),+ wrap("pre",text(res.command)),+ wrap("pre",text(res.output))])+ }+}++function compile_grammar(g,err_ind,cont) {+ function show_error(res) {+ show_compile_error(res,err_ind);+ if(cont) cont(res)+ }+ replaceInnerHTML(err_ind,"Compiling...");+ replaceInnerHTML(compiler_output,"<h3>Compiling...</h3>");+ upload(g,show_error);+}++function compile_button(g,err_ind) {+ function compile() { compile_grammar(g,err_ind) }+ return title("Upload the grammar to check it in GF for errors",+ button("Compile",compile));+}++function minibar_button(g,files,err_ind,comp_btn) {+ var b2;+ var minibar_div=div_id("minibar");+ var editor_div= div_id("syntax_editor");++ function page_overlay(inner) {+ return wrap_class("table","page_overlay",tr(td(inner)))+ }++ function extend_grammar(cat0,fun_type0,update_minibar) {+ var fname0="New"+cat0;+ var fun=parse_fun(fname0+" : " + fun_type0).ok;+ var lins=[];+ var dc=defined_cats(g),df=inherited_funs(g);+ var cs=g.concretes+ var ext=div_class("grammar_extension")+ var form;+ var overlay=page_overlay(ext);++ /*+ function draw_extension_v1() { // version 1+ var cat=fun.type[fun.type.length-1]+ ext.innerHTML="<h4>Extending "+cat+"</h4>"+ var ef=editable("span",draw_fun(g,fun,dc,df),g,edit_fun,+ "Edit this function")+ var tbl=empty_class("table","extension");+ tbl.appendChild(tr([th(text("Abstract")),td([kw("fun "),ef])]));+ var anames=arg_names(fun.type);+ for(var i in cs) {+ var lc=cs[i].langcode;+ var l=[kw("lin "),ident(fun.name)];+ for(var j in anames) { l.push(text(" ")); l.push(ident(anames[j]));}+ l.push(sep(" = "))+ l.push(editable("span",text(lins[lc] || "..."),g,edit_lin(lc),+ "Edit this linearization"))+ tbl.appendChild(tr([th(text(concname(cs[i].langcode))),td(l)]));+ }+ ext.appendChild(tbl);+ ext.appendChild(button("OK",save_extension))+ ext.appendChild(button("Cancel",cancel_extension))+ }+ function edit_fun(g,el) {+ function replace(s) {+ var p=parse_fun(s);+ if(p.ok) {+ fun=p.ok;+ draw_extension_v1();+ return null;+ }+ else+ return p.error;+ }+ string_editor(el,show_fun(fun),replace);+ }+ function edit_lin(lc) {+ return function (g,el) {+ function check(s,cont) {+ function replace() {+ lins[lc]=s;+ draw_extension_v1();+ return null;+ }+ function check2(msg) { if(msg) cont(msg); else replace(); }+ check_exp(s,check2);+ }+ string_editor(el,lins[lc] || "",check,true);+ }+ }+ */+ function draw_extension() { // version 2+ var cat=fun.type[fun.type.length-1]+ ext.innerHTML="<h4>Extending "+cat+"</h4>"+ var fun_name_els=[];+ function update_fun_name() {+ //console.log("update_fun_name")+ fun.name=fun_name.value;+ for(var fi in fun_name_els)+ fun_name_els[fi].innerHTML=fun.name+ }+ var fun_name=node("input",{"class":"string_edit",+ name:"Abstract",+ value:fun.name})+ fun_name.onchange=update_fun_name;+ fun_name.onblur=update_fun_name;+ var ef=wrap("span",[fun_name,sep(" : "),draw_type(fun.type,dc)])+ var tbl=empty_class("table","extension");+ tbl.appendChild(tr([th(text("Abstract")),td([kw("fun "),ef])]));+ var anames=arg_names(fun.type);+ for(var i in cs) {+ var lc=cs[i].langcode;+ var fn=ident(fun.name);+ fun_name_els.push(fn);+ var l=[kw("lin "),fn];+ for(var j in anames) { l.push(text(" ")); l.push(ident(anames[j]));}+ l.push(sep(" = "))+ l.push(node("input",{"class":"string_edit",+ placeholder:"...",size:30,+ name:lc,value:lins[lc] || ""}))+ tbl.appendChild(tr([th(text(concname(cs[i].langcode))),td(l)]));+ }+ form=node("form",{},[tbl])+ form.onsubmit=save_extension;+ form.appendChild(node("input",{type:"submit",value:"OK"}))+ form.appendChild(button("Cancel",cancel_extension))+ ext.appendChild(form);+ // fun_name.focus(); // can't focus before adding it to the document+ return fun_name;+ }+ function save_extension() {+ //console.log("save_extension")+ function extend_grammar(newg) {+ newg.abstract.funs.push(fun);+ var cs=newg.concretes+ for(var ci in cs) {+ var lc=cs[ci].langcode+ if(lins[lc]) {+ var lin={fun: fun.name, args: arg_names(fun.type),+ lin: lins[lc]}+ cs[ci].lins.push(lin)+ }+ }+ }+ function save_if_ok(res) {+ if(res.errorcode=="OK") {+ extend_grammar(g);+ save_grammar(g);+ files.removeChild(overlay)+ minibar_div.style.minHeight="0px";+ if(update_minibar) update_minibar();+ //goto_minibar();+ }+ }+ // Collect input from the form+ fun.name=form["Abstract"].value;+ for(var i in cs) {+ var lc=cs[i].langcode;+ lins[lc]=form[lc].value;+ }+ // This is not functional programming, so copy the grammar first...+ var newg=JSON.parse(JSON.stringify(g));+ extend_grammar(newg)+ compile_grammar(newg,err_ind,save_if_ok);+ return false; // prevent regular form submission+ }+ function cancel_extension() {+ files.removeChild(overlay)+ minibar_div.style.minHeight="0px";+ //goto_minibar();+ }+ var fun_name=draw_extension();+ files.appendChild(overlay)+ fun_name.focus();+ // Hack to prevent the overlay from overflowing the minibar div:+ minibar_div.style.minHeight=overlay.clientHeight-11+"px"+ //overlay.onresize= ... // doesn't work :-(+ }++ function show_editor() {+ clear(minibar_div);+ edit_grammar(g);+ }++ function goto_minibar() {+ clear(files);+ appendChildren(files,[minibar_div,editor_div]);+ var online_options={grammars_url: local.get("dir")+"/",+ grammar_list: [g.basename+".pgf"]}+ var pgf_server=pgf_online(online_options)+ var minibar_options= {+ show_abstract: true,+ show_trees: true,+ show_grouped_translations: false,+ show_brackets: true,+ word_replacements: true,+ extend_grammar: extend_grammar,+ default_source_language: "Eng",+ try_google: true+ }+ var minibar=new Minibar(pgf_server,minibar_options);+ b.style.display="none";+ comp_btn.disabled=true;+ if(b2) b2.style.display="";+ else {+ b2=button("Show editor",show_editor);+ insertAfter(b2,b);+ }+ }+ function goto_minibar_if_ok(res) { if(res.errorcode=="OK") goto_minibar(); }+ function compile() { compile_grammar(g,err_ind,goto_minibar_if_ok) }+ var b=button("Minibar",compile)+ return title("Upload the grammar and test it in the minibar",b)+}++function quiz_button(g,err_ind) {+ function goto_quiz(res) {+ if(res.errorcode=="OK")+ location.href="../TransQuiz/translation_quiz.html?"+local.get("dir")+"/"+ }+ function compile() { compile_grammar(g,err_ind,goto_quiz) }+ return title("Upload the grammar and go to the translation quiz",+ button("Quiz",compile))+}++function add_concrete(g,file) {+ clear(file);+ var dc={};+ for(var i in g.concretes)+ dc[g.concretes[i].langcode]=true;+ var list=[]+ function addconc(name,code) {+ if(!dc[code])+ list.push(li([a(jsurl("add_concrete2("+g.index+",'"+code+"')"),+ [text(name)])]));+ }+ for(var i in languages)+ addconc(languages[i].name,languages[i].code)+ addconc("Other","Other")+ var from= g.current>0 + ? "a copy of "+concname(g.concretes[g.current-1].langcode)+ :"scratch";+ file.appendChild(p(text("You are about to create a new concrete syntax by starting from "+from+".")));+ file.appendChild(p(text("Pick a language for the new concrete syntax:")));+ file.appendChild(node("ul",{"class":"languages"},list));+}++function new_concrete(code) {+ return { langcode:code,params:[],lincats:[],opers:[],lins:[] };+}++function adjust_opens(cnc,oldcode,code) {+ for(var oi in cnc.opens)+ for(var li in rgl_modules)+ if(cnc.opens[oi]==rgl_modules[li]+oldcode)+ cnc.opens[oi]=rgl_modules[li]+code;+}++function add_concrete2(ix,code) {+ var g=get_grammar(ix);+ var cs=g.concretes;+ var ci;+ for(var ci=0;ci<cs.length;ci++) if(cs[ci].langcode==code) break;+ if(ci==cs.length) {+ if(g.current>0) {+ cs.push(cs[g.current-1]); // old and new are shared at this point+ save_grammar(g); // serialization loses sharing+ g=reget_grammar(ix); // old and new are separate now+ var oldcode=cs[g.current-1].langcode;+ var cnc=g.concretes[ci];+ cnc.langcode=code;+ adjust_opens(cnc,oldcode,code);+ timestamp(cnc)+ }+ else+ cs.push(new_concrete(code))+ save_grammar(g);+ }+ open_concrete(g,ci);+}++function open_abstract(g) { g.view="column"; g.current=0; reload_grammar(g); }+function open_concrete(g,i) { g.view="column"; g.current=i+1; reload_grammar(g); }++function open_view(g,view) { g.view=view; reload_grammar(g); }++function open_matrix(g) { open_view(g,"matrix") }+function open_row(g) { open_view(g,"row") }+function open_column(g) { open_view(g,"column") }++function td_gap(c) {return wrap_class("td","gap",c); }+function gap() { return td_gap(text(" ")); }++function tab(active,link) {+ return wrap_class("td",active ? "active" : "inactive",link);+}++function delete_concrete(g,ci) {+ var c=g.concretes[ci];+ var ok=c.params.length==0 && c.lincats.length==0 && c.opers.length==0+ && c.lins.length==0+ || confirm("Do you really want to delete the concrete syntax for "++ concname(c.langcode)+"?");+ if(ok) {+ g.concretes=delete_ix(g.concretes,ci)+ if(g.current && g.current-1>=ci) g.current--;+ reload_grammar(g);+ }+}++function abs_tab_button(g) {+ return button("Abstract",function(){open_abstract(g);})+}++function conc_tab_button(g,ci,no_delete) {+ var cs=g.concretes+ function del() { delete_concrete(g,ci); }+ function open_conc() {open_concrete(g,1*ci); }+ var b=button(concname(cs[ci].langcode),open_conc)+ return no_delete ? b : deletable(del,b,"Delete this concrete syntax")+}++function draw_filebar(g,file) {+ var cur=(g.current||0)-1;+ var filebar = empty_class("tr","extensible")+ filebar.appendChild(gap());+ filebar.appendChild(tab(cur== -1,abs_tab_button(g)));+ for(var i in g.concretes) {+ filebar.appendChild(gap());+ filebar.appendChild(tab(i==cur,conc_tab_button(g,i)));+ }+ function add_conc(el) { return add_concrete(g,file) }+ filebar.appendChild(td_gap(more(add_conc,"Add a concrete syntax")));+ return wrap_class("table","tabs",filebar);+}++function draw_file(g) {+ if(g.current>g.concretes.length) g.current=0; // bug resilience+ return g.current>0+ ? draw_concrete(g,g.current-1)+ : draw_abstract(g);+}++function draw_startcat(g) {+ var abs=g.abstract;+ var startcat = abs.startcat || abs.cats[0];+ function opt(cat) { return option(cat,cat); }+ var opts = g.extends && g.extends.length>0 ? [opt("-")] : [];+ var dc=defined_cats(g);+ for(var cat in dc) if(dc[cat]!="Predef") opts.push(opt(cat));+ var m = node("select",{},opts);+ m.value=startcat;+ m.onchange=function() { + if(m.value!=abs.startcat) {+ abs.startcat=m.value;+ timestamp(abs);+ save_grammar(g); + }+ }+ return indent([kw("flags startcat","This is the default start category for parsing, random generation, etc. [C.3.16, C.5.1]"),+ sep(" = "),m]);+}++var extends_hint="This grammar is an extension of the grammars listed here. [C.2.1]"++function draw_conc_extends(g,conc) {+ var kw_extends=kw("extends ",extends_hint)+ var exts=(g.extends || []).map(conc_extends(conc))+ return exts.length>0+ ? indent([kw_extends,ident(exts.join(", "))])+ : text("")+}++function draw_extends(g) {+ var kw_extends=kw("extends ",extends_hint)+ var exts= g.extends || [];+ var es=[exts.length>0 ? kw_extends : span_class("more",kw_extends)];+ function del(i) { return function() { delete_extends(g,i); }}+ for(var i=0;i<exts.length;i++) {+ if(i>0) es.push(sep(", "))+ es.push(deletable(del(i),ident(exts[i]),"Don't inherit from "+exts[i]));+ }+ var w= exts.length>0 ? "more" : "other"+ function add_exts(el) { return add_extends(g); }+ es.push(more(add_exts,"Inherit from "+w+" grammars"))+ return indent([extensible(es)])+}++function delete_extends(g,ix) {+ g.extends=delete_ix(g.extends,ix);+ g.uextends=delete_ix(g.uextends,ix);+ //timestamp(g);+ reload_grammar(g);+}++function add_extends(g) {+ var file=element("file");+ clear(file)+ var gs=grammarlist+ var list=[]+ for(var i in gs) {+ var ig=get_grammar(i)+ if(gs[i].unique_name && gs[i].basename!=g.basename+ && !elem(gs[i].basename,g.extends || [])+ && !elem(g.basename,ig.extends || [])+ // should also exclude indirectly inherited grammars!!+ )+ list.push(li([a(jsurl("add_extends2("+g.index+","+i+")"),+ [text(gs[i].basename)])]));+ }+ file.appendChild(p(text("Pick a grammar to inherit:")));+ file.appendChild(node("ul",{"class":"grammars"},list));+}++function add_extends2(gix,igix) {+ var g=get_grammar(gix);+ if(!g.extends) g.extends=[];+ g.extends.push(grammarlist[igix].basename);+ g.uextends.push(grammarlist[igix].unique_name);+ //timestamp(g)+ reload_grammar(g);+}++function draw_abstract(g) {+ var kw_abstract = kw("abstract ","A GF grammar must have one abstract syntax module. [C.2.1]")+ var kw_cat = kw("cat","The categories (nonterminals) of the grammar are enumerated here. [C.3.2]");+ var kw_fun = kw("fun","The functions (productions) of the grammar are enumerated here. [C.3.4]");++ var flags=g.abstract.startcat || g.abstract.cats.length>1+ || g.extends && g.extends.length>0+ ? draw_startcat(g)+ : text("");+ function sort_funs() {+ g.abstract.funs=sort_list(this,g.abstract.funs,"name");+ timestamp(g.abstract);+ save_grammar(g);+ }+ var file=div_id("file",+ [kw_abstract,ident(g.basename),sep(" = "),+ /*draw_timestamp(g.abstract),*/+ draw_extends(g),+ flags,+ indent([extensible([kw_cat,+ indent(draw_cats(g))]),+ extensible([kw_fun,+ indent_sortable(draw_funs(g),sort_funs)])])]);+ if(navigator.onLine) {+ var mode_button=text_mode(g,file,0);+ insertBefore(mode_button,file.firstChild)+ }+ return file;+}++function draw_comment(g) {+ return div_class("comment",editable("span",text(g.comment || "…"),g,edit_comment,"Edit grammar description"));+}++function module_name(g,ix) {+ return ix==0 ? g.basename : g.basename+g.concretes[ix-1].langcode+}+function show_module(g,ix) {+ return ix==0 ? show_abstract(g) : show_concrete(g)(g.concretes[ix-1]);+}++function text_mode(g,file,ix) {+ var path=module_name(g,ix)+".gf"+ function switch_to_guided_mode() {+ clear(compiler_output);+ edit_grammar(g); // !!+ }+ function store_parsed(parse_results) {+ var dst=compiler_output;+ var msg=parse_results[path];+ clear(dst)+ //console.log(msg)+ if(dst && msg.error)+ dst.appendChild(span_class("error_message",+ text(msg.location+": "+msg.error)))+ else if(dst && msg.parsed)+ dst.innerHTML=+ "Accepted by GF, but not by this editor ("+msg.parsed+")"+ else if(msg.converted) {+ if(ix==0) {+ var gnew=msg.converted;+ g.abstract=gnew.abstract;+ //g.extends=gnew.extends;+ timestamp(g.abstract);+ save_grammar(g);+ }+ else {+ var conc=g.concretes[ix-1];+ var cnew=msg.converted.concretes[0];+ conc.opens=cnew.opens;+ conc.params=cnew.params;+ conc.lincats=cnew.lincats;+ conc.opers=cnew.opers;+ conc.lins=cnew.lins;+ timestamp(conc);+ save_grammar(g);+ }+ }+ else replaceInnerHTML(dst,"unexpected parse result");+ }+ var last_source=show_abstract(g);+ function parse(source) {+ if(source!=last_source) {+ if(navigator.onLine) {+ //clear(compiler_output) // makes the page "jumpy"+ last_source=source;+ check_module(path,source,store_parsed)+ }+ else replaceInnerHTML(compiler_output,+ "Offline, edits will not be saved")+ }+ }+ function switch_to_text_mode() {+ var ta=node("textarea",{class:"text_mode",rows:25,cols:80},+ [text(show_module(g,ix))])+ var timeout;+ ta.onkeyup=function() {+ if(timeout) clearTimeout(timeout);+ timeout=setTimeout(function(){parse(ta.value)},400)+ }+ var mode_button=div_class("right",[button("Guided mode",switch_to_guided_mode)])+ clear(file)+ appendChildren(file,[mode_button,ta])+ //ta.style.height=ta.scrollHeight+"px";+ ta.focus();+ }+ var mode_button=div_class("right",[button("Text mode",switch_to_text_mode)])+ return mode_button;+}++function add_cat(g) {+ function add(s) {+ var cats=s.split(/\s*(?:\s|[;])\s*/); // allow separating spaces or ";"+ if(cats.length>0 && cats[cats.length-1]=="") cats.pop();+ for(var i in cats) {+ var err=check_name(cats[i],"Category");+ if(err) return err;+ }+ for(var i in cats) g.abstract.cats.push(cats[i]);+ timestamp(g.abstract);+ reload_grammar(g);+ return null;+ }+ return function(el) { string_editor(el,"",add); }+}++function delete_cat(g,ix) {+ with(g.abstract) cats=delete_ix(cats,ix);+ timestamp(g.abstract);+ reload_grammar(g);+}++function rename_cat(g,el,cat) {+ function ren(newcat) {+ if(newcat!="" && newcat!=cat) {+ var err=check_name(newcat,"Category");+ if(err) return err;+ var dc=defined_cats(g);+ if(dc[newcat]) return newcat+" is already in use";+ g=rename_category(g,cat,newcat);+ timestamp(g.abstract);+ reload_grammar(g);+ }+ return null;+ }+ string_editor(el,cat,ren);+}++function duplicated(g,kind,orig) {+ return orig==g.basename+ ? "Same "+kind+" defined twice in this module"+ : "Same "+kind+" already defined in "+orig+}++function draw_ecat(g,i,dc) { // modifies dc !!+ var cs=g.abstract.cats;+ var cat=cs[i]+ function ren(g,el) { rename_cat(g,el,cat); }+ var eident=editable("span",ident(cat),g,ren,"Rename category");+ var check=ifError(dc[cat],duplicated(g,"category",dc[cat]),eident);+ function del() { delete_cat(g,i); }+ var c=deletable(del,check,"Delete this category")+ dc[cs[i]]=g.basename;+ return c+}++function draw_cats(g) {+ var cs=g.abstract.cats;+ var es=[];+ var dc=inherited_cats(g);+ for(var i in cs) {+ es.push(draw_ecat(g,i,dc));+ es.push(sep("; "));+ }+ es.push(more(add_cat(g),"Add more categories"));+ return es;+}++function add_fun(g) {+ function add(s) {+ var p=parse_fun(s);+ if(p.ok) {+ g.abstract.funs.push(p.ok);+ timestamp(g.abstract);+ reload_grammar(g);+ return null;+ }+ else+ return p.error+ }+ return function(el) { string_editor(el,"",add);}+}++function edit_fun(i) {+ return function (g,el) {+ function replace(s) {+ var p=parse_fun(s);+ if(p.ok) {+ var old=g.abstract.funs[i];+ g.abstract.funs[i]=p.ok;+ if(p.ok.name!=old.name) g=rename_function(g,old.name,p.ok.name);+ if(show_type(p.ok.type)!=show_type(old.type))+ g=change_lin_lhs(g,p.ok);+ timestamp(g.abstract);+ reload_grammar(g);+ return null;+ }+ else+ return p.error;+ }+ string_editor(el,show_fun(g.abstract.funs[i]),replace);+ }+}++function delete_fun(g,ix) {+ with(g.abstract) funs=delete_ix(funs,ix);+ timestamp(g.abstract);+ reload_grammar(g);+}++function draw_funs(g) {+ var funs=g.abstract.funs;+ var es=[];+ var dc=defined_cats(g);+ var df=inherited_funs(g);+ for(var i in funs) {+ es.push(node_sortable("fun",funs[i].name,[draw_efun(g,i,dc,df)]));+ }+ es.push(more(add_fun(g),"Add a new function"));+ return es;+}++function draw_efun(g,i,dc,df,click) { // modifies df !!+ var funs=g.abstract.funs;+ function del() { delete_fun(g,i); }+ var f=deletable(del,editable("span",draw_fun(g,funs[i],dc,df,click),g,edit_fun(i),"Edit this function"),"Delete this function");+ df[funs[i].name]=g.basename;+ return f+}++function draw_fun(g,fun,dc,df,click) {+ function check(el) {+ return ifError(dc[fun.name],+ "Function names must be distinct from category names",+ ifError(df[fun.name],duplicated(g,"function",df[fun.name]),el));+ }+ var d=node("span",{},+ [check(ident(fun.name)),sep(" : "),draw_type(fun.type,dc)]);+ if(click) d.onclick=click;+ return d;+}++function draw_type(t,dc) {+ var el=empty("span");+ function check(t,el) {+ if(dc[t]) el.title=dc[t]+"."+t;+ return ifError(!dc[t],"Undefined category",el);+ }+ for(var i in t) {+ if(i>0) el.appendChild(sep(" → "));+ el.appendChild(check(t[i],ident(t[i])));+ }+ return el;+}++function edit_name(g,el) {+ function change_name(name) {+ if(name!=g.basename && name!="") {+ var err=check_name(name,"Grammar");+ if(err) return err;+ g.basename=name+ reload_grammar(g);+ }+ return null;+ }+ string_editor(el,g.basename,change_name)+}++function edit_comment(g,el) {+ function change_comment(comment) {+ g.comment=comment+ reload_grammar(g);+ return null;+ }+ string_editor(el,g.comment || "",change_comment)+}+/* -------------------------------------------------------------------------- */++function draw_concrete(g,i) {+ var conc=g.concretes[i];+ function edit_langcode(g,el) {+ function change_langcode(code) {+ var err=check_name(g.basename+code,"Name of concrete syntax");+ if(err) return err;+ adjust_opens(conc,conc.langcode,code);+ conc.langcode=code;+ timestamp(conc);+ reload_grammar(g);+ }+ string_editor(el,conc.langcode,change_langcode)+ }+ var kw_concrete=kw("concrete ", "A GF grammar can have any number of concrete syntax modules matching the abstract syntax [C.2.1]")+ var kw_open=kw("open ","Opening makes constants from other modules available in this module. [C.2.8]")+ var kw_lincat=kw("lincat","The linearization type for each catagory in the abstract syntax is given here. [C.3.8]")+ var kw_lin=kw("lin","The linearization function for each function in the abstract syntax is given here. [C.3.9]")+ var kw_param=kw("param","Parameter type definitions can be added here. [C.3.12]")+ var kw_oper=kw("oper","Operation definitions can be added here. [C.3.14]")+ var file=div_id("file",+ [kw_concrete,+ ident(g.basename),+ editable("span",ident(conc.langcode),g,+ edit_langcode,"Change language"),+ kw(" of "),ident(g.basename),sep(" = "),+ /*draw_timestamp(conc),*/+ draw_conc_extends(g,conc),+ indent([extensible([kw_open,draw_opens(g,i)])]),+ indent([kw_lincat,draw_lincats(g,i)]),+ indent([kw_lin,draw_lins(g,i)]),+ indent([extensible([kw_param,draw_params(g,i)])]),+ indent([extensible([kw_oper,draw_opers(g,i)])]),+ exb_extra(g,i)+ ])+ if(navigator.onLine) {+ var mode_button=text_mode(g,file,i+1);+ insertBefore(mode_button,file.firstChild)+ }+ return file;+}++var rgl_modules=["Syntax","Lexicon","Paradigms","Extra","Symbolic"];+var common_modules=["Prelude"];+var rgl_info = {+ Prelude: "Some facilities usable in all grammars",+ Paradigms: "Lexical categories (A, N, V, ...) and smart paradigms (mkA, mkN, mkV, ...) for turning raw strings into new dictionary entries.",+ Syntax: "Syntactic categories (Utt, Cl, V, NP, CN, AP, ...), structural words (this_Det, few_Det, ...) and functions for building phrases (mkUtt, mkCl, mkCN, mkVP, mkAP, ...)",+ Lexicon: "A multilingual lexicon with ~350 common words.",+ Extra: "Language-specific extra constructions not available via the common API.",+ Symbolic: "Functions for symbolic expressions (numbers and variables in mathematics)"+}++function add_open(g,ci) {+ return function (el) {+ var conc=g.concretes[ci];+ var os=conc.opens;+ var ds={};+ for(var i in os) ds[os[i]]=true;+ var list=[]+ function add_module(b,m) {+ if(!ds[m]) {+ var info=rgl_info[b];+ var infotext=info ? text(" - "+info) : text("");+ list.push(li([a(jsurl("add_open2("+g.index+","+ci+",'"+m+"')"),+ [text(m)]),infotext]));+ }+ }+ for(var i in rgl_modules) {+ var b=rgl_modules[i];+ add_module(b,b+conc.langcode)+ }+ for(var i in common_modules) {+ var b=common_modules[i];+ add_module(b,b)+ }+ if(list.length>0) {+ var file=element("file");+ clear(file)+ file.appendChild(p(text("Pick a resource library module to open:")));+ file.appendChild(node("ul",{},list));+ }+ }+}++function add_open2(ix,ci,m) {+ var g=get_grammar(ix);+ var conc=g.concretes[ci];+ conc.opens || (conc.opens=[]);+ conc.opens.push(m);+ timestamp(conc);+ save_grammar(g);+ open_concrete(g,ci);+}++function delete_open(g,ci,ix) {+ with(g.concretes[ci]) opens=delete_ix(opens,ix);+ timestamp(g.concretes[ci]);+ reload_grammar(g);+}++function draw_opens(g,ci) {+ var conc=g.concretes[ci];+ var os=conc.opens || [] ;+ var es=[];+ function del(i) { return function() { delete_open(g,ci,i); }}+ function show_opers(m) {+ return function(event) {+ var link=event.target,dst=compiler_output+ function cont2(opers) {+ clear(dst);+ var sheet=div_class("sheet",[wrap("h3",text(m)),+ wrap("pre",text(opers))])+ var dy=dst.offsetTop-link.offsetTop-link.offsetHeight+ sheet.style.top="-"+dy+"px";+ insertFirst(dst,sheet)+ setTimeout(function(){sheet.style.top="0px";},1000)+ }+ function cont1() { gfshell("so",cont2) }+ gfshell("i -retain alltenses/"+m+".gfo",cont1)+ }+ }+ var first=true;+ for(var i in os) {+ if(!first) es.push(sep(", "))+ var m=os[i];+ var b=m.substr(0,m.length-conc.langcode.length);+ var info=rgl_info[m] || rgl_info[b];+ var id=ident(m);+ if(info) id.title=info;+ id.onclick=show_opers(m)+ id.className="ident onclick"+ es.push(deletable(del(i),id,"Don't open this module"));+ first=false;+ }+ es.push(more(add_open(g,ci),"Open more modules"));+ return indent(es);+}++function draw_param(p,dp) {+ function check(el) {+ return ifError(dp[p.name],"Same parameter type defined twice",el);+ }+ return node("span",{},[check(ident(p.name)),sep(" = "),text(p.rhs)]);+}++function add_param(g,ci,el) {+ function add(s) {+ var p=parse_param(s);+ if(p.ok) {+ g.concretes[ci].params.push(p.ok);+ timestamp(g.concretes[ci]);+ reload_grammar(g);+ return null;+ }+ else+ return p.error+ }+ string_editor(el,"",add);+}++function edit_param(ci,i) {+ return function (g,el) {+ function replace(s) {+ var p=parse_param(s);+ if(p.ok) {+ g.concretes[ci].params[i]=p.ok;+ timestamp(g.concretes[ci]);+ reload_grammar(g);+ return null;+ }+ else+ return p.error;+ }+ string_editor(el,show_param(g.concretes[ci].params[i]),replace);+ }+}+++function delete_param(g,ci,ix) {+ with(g.concretes[ci]) params=delete_ix(params,ix);+ timestamp(g.concretes[ci]);+ reload_grammar(g);+}++function draw_params(g,ci) {+ var conc=g.concretes[ci];+ conc.params || (conc.params=[]);+ var params=conc.params;+ var es=[];+ var dp={};+ function del(i) { return function() { delete_param(g,ci,i); }}+ function draw_eparam(i,dp) {+ return editable("span",draw_param(params[i],dp),g,edit_param(ci,i),"Edit this parameter type");+ }+ for(var i in params) {+ es.push(div_class("param",[deletable(del(i),draw_eparam(i,dp),"Delete this parameter type")]));+ dp[params[i].name]=true;+ }+ es.push(more(function(el) { return add_param(g,ci,el)},+ "Add a new parameter type"));+ return indent(es);+}++function delete_lincat(g,ci,cat) {+ var i;+ var c=g.concretes[ci];+ for(i=0;i<c.lincats.length && c.lincats[i].cat!=cat;i++);+ if(i<c.lincats.length) c.lincats=delete_ix(c.lincats,i);+ timestamp(c);+ reload_grammar(g);+}++function draw_lincats(g,i) {+ var conc=g.concretes[i];+ function edit(c) {+ return function(g,el) {+ function check(s,cont) {+ function check2(msg) {+ if(!msg) {+ if(c.template) conc.lincats.push({cat:c.cat,type:s});+ else c.type=s;+ reload_grammar(g);+ }+ cont(msg);+ }+ check_exp(s,check2);+ }+ string_editor(el,c.type,check,true)+ }+ }+ function del(c) { return function() { delete_lincat(g,i,c); } }+ function dlc(c,cls) {+ var t=editable("span",text_ne(c.type),g,edit(c),"Edit lincat for "+c.cat);+ return node("span",{"class":cls},+ [ident(c.cat),sep(" = "),t]);+ }+ var dc=locally_defined_cats(g,{});+ function draw_lincat(c) {+ var cat=c.cat;+ var err=!dc[cat];+ var l1=dlc(c,"lincat");+ var l2= deletable(del(cat),l1,"Delete this lincat");+ var l=ifError(err,"lincat for undefined category",l2);+ delete dc[cat];+ return node_sortable("lincat",cat,[l]);+ }+ function dtmpl(c) { + return wrap("div",dlc({cat:c,type:"",template:true},"template")); }+ var lcs=map(draw_lincat,conc.lincats);+ for(var c in dc)+ lcs.push(dtmpl(c));+ function sort_lincats() {+ conc.lincats=sort_list(this,conc.lincats,"cat");+ timestamp(conc);+ save_grammar(g);+ }+ return indent_sortable(lcs,sort_lincats);+}++/* -------------------------------------------------------------------------- */++function draw_oper(p,dp) {+ function check(el) {+ return ifError(dp[p.name],"Same operator definition defined twice",el);+ }+ return node("span",{},[check(ident(p.name)),text(" "),text(p.rhs)]);+}++function check_oper(s,ok,err) {+ var p=parse_oper(s);+ function check2(msg) {+ if(msg) err(msg);+ else ok(p.ok)+ }+ if(p.ok) {+ // Checking oper syntax by checking an expression with a local+ // definition. Some valid opers will be rejected!!+ var e=p.ok.name+" where { "+p.ok.name+" "+p.ok.rhs+" }";+ check_exp(e,check2);+ }+ else+ err(p.error);+}++function add_oper(g,ci,el) {+ function check(s,cont) {+ function ok(oper) {+ g.concretes[ci].opers.push(oper);+ timestamp(g.concretes[ci]);+ reload_grammar(g);+ cont(null);+ }+ check_oper(s,ok,cont)+ }+ text_editor(el,"",check,true);+}++function edit_oper(ci,i) {+ return function (g,el) {+ function check(s,cont) {+ function ok(oper) {+ g.concretes[ci].opers[i]=oper;+ timestamp(g.concretes[ci]);+ reload_grammar(g);+ cont(null);+ }+ check_oper(s,ok,cont)+ }+ text_editor(el,show_oper(g.concretes[ci].opers[i]),check,true);+ }+}++function delete_oper(g,ci,ix) {+ with(g.concretes[ci]) opers=delete_ix(opers,ix);+ timestamp(g.concretes[ci]);+ reload_grammar(g);+}++function draw_opers(g,ci) {+ var conc=g.concretes[ci];+ conc.opers || (conc.opers=[]);+ var opers=conc.opers;+ var es=[];+ var dp={};+ function del(i) { return function() { delete_oper(g,ci,i); }}+ function draw_eoper(i,dp) {+ return editable("span",draw_oper(opers[i],dp),g,edit_oper(ci,i),"Edit this operator definition");+ }+ for(var i in opers) {+ es.push(node_sortable("oper",opers[i].name,+ [deletable(del(i),draw_eoper(i,dp),+ "Delete this operator definition")]));+ dp[opers[i].name]=true;+ }+ es.push(more(function(el) { return add_oper(g,ci,el)},+ "Add a new operator definition"));+ function sort_opers() {+ conc.opers=sort_list(this,conc.opers,"name");+ timestamp(conc);+ save_grammar(g);+ }+ return indent_sortable(es,sort_opers);+}++function delete_lin(g,ci,fun) {+ var c=g.concretes[ci];+ var i=lin_index(c,fun);+ if(i!=null) {+ c.lins=delete_ix(c.lins,i);+ timestamp(c);+ reload_grammar(g);+ }+}++/* -------------------------------------------------------------------------- */+function arg_names(type) {+ function lower(s) { return s.toLowerCase(); }+ var names=map(lower,type);+ names.pop(); // remove result type+ var n,count={},use={};+ for(var i in names) n=names[i],count[n]=0,use[n]=0;+ for(var i in names) count[names[i]]++;+ function unique(n) {+ return count[n]>1 ? n+(++use[n]) : n;+ }+ return map(unique,names);+}++function draw_elin(g,igs,ci,f,dc,df) {+ var fun=f.fun;+ var conc=g.concretes[ci];+ function edit(g,el) {+ function check(s,cont) {+ function check2(msg) {+ if(!msg) {+ if(f.template)+ conc.lins.push({fun:f.fun,args:f.args,lin:s});+ else { f.lin=s; f.eb_lin=null; }+ timestamp(conc);+ reload_grammar(g);+ }+ cont(msg);+ }+ check_exp(s,check2);+ }+ text_editor(el,f.lin,check,true)+ }+ function dl(cls) {+ var fn=ident(f.fun)+ var fty=function_type(g,f.fun)+ var linty=fty && lintype(g,conc,igs,dc,fty)+ if(fty)+ fn.title="fun "+f.fun+": "+show_type(fty)+ +"\nlin "+f.fun+": "+show_lintype(linty)+ var l=[fn]+ for(var i=0; i<f.args.length;i++) {+ l.push(text(" "));+ var an=ident(f.args[i])+ if(linty) an.title=f.args[i]+": "+linty[i]+ l.push(an);+ }+ l.push(sep(" = "));+ var t=editable("span",text_ne(f.lin),g,edit,"Edit lin for "+f.fun);+ t.appendChild(exb_linbuttons(g,ci,f));+ l.push(t);+ return node("span",{"class":cls},l);+ }+ function del() { delete_lin(g,ci,fun); }+ var l=dl(f.template ? "template" : "lin")+ if(!f.template) {+ l=deletable(del,l,"Delete this linearization function")+ delete df[fun];+ }+ return l;+}++function lin_template(g,f) {+ var args=arg_names(function_type(g,f))+ return {fun:f,args:args,lin:"",template:true}+}++function draw_lins(g,ci) {+ var conc=g.concretes[ci];+ var igs=inherited_grammars(g)+ var dc=defined_cats(g);+ var df=locally_defined_funs(g,{});+ function draw_lin(f) {+ var err= !df[f.fun];+ var l=draw_elin(g,igs,ci,f,dc,df)+ var l=ifError(err,"Function "+f.fun+" is not part of the abstract syntax",l);+ return node_sortable("lin",f.fun,[l]);+ }+ function dtmpl(f) { + var lin=lin_template(g,f)+ return div_class("template",draw_elin(g,igs,ci,lin,dc,df))+ }+ function sort_lins() {+ conc.lins=sort_list(this,conc.lins,"fun");+ timestamp(conc);+ save_grammar(g);+ }+ var ls=map(draw_lin,conc.lins);+ for(var f in df)+ ls.push(dtmpl(f));+ return indent_sortable(ls,sort_lins);+}+++// Return the linearization type for the given abtract type in the given +// concrete syntax, taking into account that lincats may be defined in+// inherited grammars.+// lintype:: Grammar -> Concrete -> [Grammar] -> {Cat=>ModId} => Type -> LinType+function lintype(g,conc,igs,dc,type) {+ //console.log(dc)+ function ihcat_lincat(cat) {+ if(dc[cat]=="Predef") return "{s:Str}" // !!! Is this right?+ var ig=find_inherited_grammar_byname(igs,dc[cat])+ if(!ig) return "??"+ var iconc=ig.concretes[conc_index(ig,conc.langcode)]+ if(!iconc) return "??"+ return cat_lincat(iconc,cat) || "??"+ }+ function lincat(cat) {+ return dc[cat]+ ? (dc[cat]==g.basename ? cat_lincat(conc,cat) : ihcat_lincat(cat))+ || "??"+ : cat+"??"+ }+ return type.map(lincat)+}++function find_inherited_grammar_byname(igs,name) {+ for(var i in igs) if(igs[i].basename==name) return igs[i]+ return null+}++/* -------------------------------------------------------------------------- */++function draw_matrix(g) {+ var row=[th(abs_tab_button(g))]+ var t=empty_class("table","matrixview")+ for(var ci in g.concretes)+ row.push(th(conc_tab_button(g,ci)))+ t.appendChild(tr(row))++ var dc=inherited_cats(g);+ var df=inherited_funs(g);++ for(var i in g.abstract.cats) {+ var cat=g.abstract.cats[i]+ var row=[td([kw("cat"),draw_ecat(g,i,dc)])] // modifies dc+ for(var ci in g.concretes) {+ var conc=g.concretes[ci]+ row.push(td(text(cat_lincat(conc,cat))))+ }+ t.appendChild(tr(row))+ }+ function openr(f) { return function() { g.row=f; open_row(g) } }+ for(var i in g.abstract.funs) {+ var fun=g.abstract.funs[i]+ var e=draw_efun(g,i,dc,df,openr(fun.name)) // modifies df+ var row=[td(e)]+ for(var ci in g.concretes) {+ var conc=g.concretes[ci]+ var lin=fun_lin(conc,fun.name)+ var dl=lin ? simple_draw_lin(lin) : text(" ")+ row.push(td(dl))+ }+ t.appendChild(tr(row))+ }+ return div_class("extensible",[t,more(add_fun(g),"Add a new function")])+}++function simple_draw_lin(f) {+ var l=[]+ if(f.args.length>0) {+ l.push(sep("\\")) /* λ */+ for(var i in f.args) {+ l.push(text(" "));+ l.push(ident(f.args[i]));+ }+ l.push(sep(" → "));+ }+ l.push(text_ne(f.lin));+ return wrap("span",l);+}++function draw_row(g) {+ var ix=null,fname=g.row+ if(fname) ix=fun_index(g,fname)+ if(ix==null) ix=0,fname=g.abstract.funs[0] && g.abstract.funs[0].name+ if(!fname) return text("No functions in the grammar")++ var igs=inherited_grammars(g)+ var dc=defined_cats(g);+ var df=inherited_funs(g);++ var t=empty_class("table","matrixview")++ var e=draw_efun(g,ix,dc,df) // modifies df+ t.appendChild(tr([th(abs_tab_button(g)),td(kw("fun")),td(e)]))++ var fun=g.abstract.funs[ix]++ var missing=[]+ for(var ci in g.concretes) + if(!fun_lin(g.concretes[ci],fname))+ missing.push(ci)++ function copy_button(langcode,lin) {+ function copy() {+ for(var i in missing) {+ var ci=missing[i]+ var conc=g.concretes[ci]+ // This is not functional programming, so copy the lin first...+ var lin2=JSON.parse(JSON.stringify(lin))+ conc.lins.push(lin2)+ timestamp(conc);+ }+ reload_grammar(g)+ }+ var b=button("Copy",copy)+ b.title="Copy lin "+fname+" from "+concname(langcode)+ +" to languages that lack lin "+fname+ return b+ }++ for(var ci in g.concretes) {+ var conc=g.concretes[ci]+ var lin=fun_lin(conc,fname)+ var cp= lin && missing.length>0 ? [copy_button(conc.langcode,lin)] : []+ var dl=draw_elin(g,igs,ci,lin || lin_template(g,fname),dc,df)+ t.appendChild(tr([th(conc_tab_button(g,ci,true)),+ td(kw("lin")),td(dl),td(cp)]))+ }+ var fbar=wrap_class("table","tabs",tr([gap(),tab(true,kw(fname)),gap()]))+ return [fbar,div_id("file",[t])]+}++/* -------------------------------------------------------------------------- */++function defined_cats(g) { return all_defined_cats(g,inherited_grammars(g)) }+function defined_funs(g) { return all_defined_funs(g,inherited_gramamrs(g)) }+function inherited_cats(g) {+ return all_inherited_cats(inherited_grammars(g),predefined_cats())+}+function inherited_funs(g) {return all_inherited_funs(inherited_grammars(g),{})}++function upload(g,cont) {+ var gs=inherited_grammars(g);+ gs.push(g);+ upload_grammars(gs,cont);+}++// inherited_grammars :: Grammar -> [Grammar]+function inherited_grammars(g) {+ var visited={};+ function exists(ix) { return ix!=null; }+ function ihgs(g) {+ if(visited[g.basename]) return []; // avoid cycles and diamonds+ else {+ visited[g.basename]=true;+ var igs=g.uextends.map(my_grammar).filter(exists).map(get_grammar);+ var igss=igs.map(ihgs)+ for(var i in igss) igs=igs.concat(igss[i]);+ return igs;+ }+ }+ return ihgs(g)+}++/*+// cached_grammar__byname :: () -> (ModId->Grammar)+function cached_grammar_byname() {+ var gix=cached_grammar_array_byname()+ function grammar_byname(name) { return gix[name]; }+ return grammar_byname;+}++// cached_grammar_array_byname :: () -> {ModId=>Grammar}+function cached_grammar_array_byname() {+ var gix={};+ for(var i=0;i<local.count;i++) {+ var g=get_grammar(i,null);+ if(g) gix[g.basename]=g; // basenames are not necessarily unique!!+ }+ return gix+}+*/++/* -------------------------------------------------------------------------- */++function find_langcode(concs,langcode) {+ for(var ci in concs)+ if(concs[ci].langcode==langcode)+ return concs[ci];+ return null;+}++function cleanup_deleted(files) {+ var keep={}+ for(var i in files) keep[files[i]]=true;+ //debug("cleanup_deleted "+JSON.stringify(files))+ //debug("keep "+JSON.stringify(keep))+ for(var i=0;i<local.count;i++) {+ var g=local.get(i,null)+ if(g && g.unique_name && !keep[g.unique_name+".json"]) {+ debug("cleanup "+i+" "+g.unique_name);+ remove_local_grammar(i)+ }+ }+}++function merge_grammar(i,newg) {+ var oldg=get_grammar(i);+ var keep="";+ debug("Merging at "+i);+ if(oldg) {+ oldg.basename=newg.basename;+ if(newg.abstract.timestamp<oldg.abstract.timestamp) {+ newg.abstract=newg.abstract+ keep+=" "+oldg.basename+ }+ for(var ci in newg.concretes) {+ var conc=newg.concretes[ci];+ var oldconc=find_langcode(oldg.concretes,conc.langcode);+ if(oldconc && conc.timestamp<oldconc.timestamp) {+ newg.concretes[ci]=oldconc;+ keep+=" "+oldg.basename+conc.langcode;+ }+ }+ }+ put_grammar(i,newg)+ return keep;+}++function timestamp(obj,prop) {+ obj[prop || "timestamp"]=Date.now();+}++function draw_timestamp(obj) {+ var t=obj.timestamp;+ return node("small",{"class":"modtime"},+ [text(t ? " -- "+new Date(t).toLocaleString() : "")]);+}++/* -------------------------------------------------------------------------- */++function delete_ix(old,ix) {+ var a=[];+ for(var i in old) if(i!=ix) a.push(old[i]);+ return a;+}++function sort_list(list,olditems,key) {+ var items=[];+ function find(fun) {+ for(var i=0;i<olditems.length;i++)+ if(olditems[i][key]==fun) return olditems[i];+ return null;+ }+ for(var el=list.firstChild;el;el=el.nextSibling) {+ var name=el.getAttribute("ident")+ if(name) {+ var old=find(name);+ if(old) items.push(old)+ else debug("Bug: did not find "+name+" while sorting");+ }+ }+ if(items.length==olditems.length)+ return items;+ else {+ debug("Bug: length changed while sorting")+ return olditems;+ }+}++function text_editor(el,init,ok,async) {+ string_editor(el,init,ok,async,true)+}++function string_editor(el,init,ok,async,multiline) {+ var p=el.parentNode;+ function restore() {+ e.parentNode.removeChild(e);+ el.style.display="";+ }+ function done() {+ var edited=e.it.value;+ restore();+ function cont(msg) { if(msg) start(msg); }+ if(async) ok(edited,cont)+ else cont(ok(edited));+ return false;+ }+ function start(msg) {+ el.style.display="none";+ m.innerHTML=msg;+ insertAfter(e,el);+ e.it.focus();+ }+ var m=empty_class("span","error_message");+ if(multiline || init.indexOf("\n")>=0) {+ var rows=init.split("\n").length+1+ var i=node("textarea",{"class":"string_edit",name:"it",+ rows:rows,cols:"60"},+ [text(init)]);+ }+ else {+ var i=node("input",{"class":"string_edit",name:"it",value:init},[]);+ if(init.length>10) i.size=init.length+5;+ }+ var e=node("form",{},+ [i,+ text(" "),+ node("input",{type:"submit",value:"OK"},[]),+ button("Cancel",restore),+ text(" "),+ m])+ e.onsubmit=done+ start("");+}++function ifError(b,msg,el) { return b ? inError(msg,el) : el; }++function inError(msg,el) {+ return node("span",{"class":"inError",title:msg},[el]);+}++function kw(txt,hint) {+ var w=wrap_class("span","kw",text(txt));+ if(hint) w.title=hint;+ return w;+}+function sep(txt) { return wrap_class("span","sep",text(txt)); }+function ident(txt) { return wrap_class("span","ident",text(txt)); }+function unimportant(txt) { return wrap_class("small","unimportant",text(txt)); }+function indent(cs) { return div_class("indent",cs); }++function indent_sortable(cs,sort) {+ var n= indent(cs);+ n.onsort=sort;+ return n;+}++function node_sortable(cls,name,ls) {+ return node("div",{"class":cls,"ident":name},ls);+}++function extensible(cs) { return div_class("extensible",cs); }++function more(action,hint,label) {+ var b=node("span",{"class":"more","title":hint || "Add more"},+ [text(label || " + ")]);+ b.onclick=function() { action(b); }+ return b;+}++function text_ne(s) { // like text(s), but force it to be non-empty+ return text(s ? s : "\xa0\xa0\xa0")+}++function editable(tag,cs,g,edit,hint) {+ var b=edit_button(function(){edit(g,e)},hint);+ var e=node(tag,{"class":"editable"},[cs,b]);+ //e.onclick=b.onclick;+ return e;+}++function edit_button(action,hint) {+ var b=node("span",{"class":"edit","title":hint || "Edit"},[text("%")]);+ b.onclick=action;+ return b;+}++function deletable(del,el,hint) {+ var b=delete_button(del,hint)+ return node("span",{"class":"deletable"},[b,el])+}++function delete_button(action,hint) {+ var b=node("span",{"class":"delete",title:hint || "Delete"},[text("×")])+ b.onclick=action;+ return b;+}++function touch_edit() {+ var b=node("input",{type:"checkbox"},[]);+ function touch() {+ document.body.className=b.checked ? "nohover" : "hover";+ }+ b.onchange=touch;+ insertAfter(b,editor);+ insertAfter(wrap("small",text("Enable editing on touch devices. ")),b);+}+/* --- DOM Support ---------------------------------------------------------- */++function a(url,linked) { return node("a",{href:url},linked); }+function ul(lis) { return wrap("ul",lis); }+function table(rows) { return wrap("table",rows); }+function td_right(cs) { return node("td",{"class":"right"},cs); }+function td_center(cs) { return node("td",{"class":"center"},cs); }+function jsurl(js) { return "javascript:"+js; }++/* -------------------------------------------------------------------------- */++function download_from_cloud() {+ var newdir="/tmp/"+location.hash.substr(1)++ function download2(olddir) {+ //debug("Starting grammar sharing in the cloud")+ if(newdir!=olddir) link_directories(newdir,download3)+ else download4()+ }+ function download3() {+ //debug("Uploading local grammars to cloud");+ local.put("dir",newdir);+ upload_json(download4)+ }+ function download4() {+ //debug("Downloading grammars from the cloud");+ download_json()+ }++ with_dir(download2)+}++/* --- Initialization ------------------------------------------------------- */++//document.body.appendChild(empty_id("div","debug"));++function fix_extends(g) {+ //console.log("fix_extends ",g)+ if(g) {+ g.extends=g.extends || []+ var es=[],us=[]+ if(g.uextends) {+ // update inherited grammars (they might be renamed or removed)+ for(var i in g.uextends) {+ var u=g.uextends[i]+ var gix=my_grammar(u)+ if(gix!=null) {+ us.push(u)+ es.push(grammarlist[gix].basename)+ }+ }+ }+ else {+ // add g.uextends to grammars created before 2012-10-16+ for(var i in g.extends) {+ var e=g.extends[i]+ var gix=find_grammar(e)+ var u+ if(gix!=null) u=grammarlist[gix].unique_name+ if(u) { es.push(e); us.push(u); }+ }+ }+ g.extends=es+ g.uextends=us+ }+ return g+}++function dir_bugfix() {+ // remove trailing newline caused by bug in older version+ var dir=local.get("dir");+ if(dir) {+ var n=dir.length;+ while(dir[dir.length-1]=="\n" || dir[dir.length-1]=="\r")+ dir=dir.substr(0,dir.length-1)+ if(dir.length<n) {+ debug("removing trailing newline")+ local.put("dir",dir);+ }+ //debug("Server directory: "+JSON.stringify(dir))+ }+ else debug("No server directory yet")+}++function get_grammarlist() {+ var list=local.get(".grammarlist")+ if(list) grammarlist=list+ else if(local.get("count")!=null) {+ console.log("initializing grammarlist")+ grammarlist={}+ var n=local.count;+ for(var ix=0;ix<n;ix++) {+ var g=local.get(ix,null);+ if(g)+ grammarlist[ix]={unique_name:g.unique_name,basename:g.basename}+ }+ local.put(".grammarlist",grammarlist)+ }+}++if(editor) {+ if(supports_html5_storage()) {+ get_grammarlist();+ initial_view();+ touch_edit();+ dir_bugfix();+ initialize_sorting(["DIV","INPUT","TEXTAREA"],+ ["fun","lin","lincat","oper"]);+ }+ else+ editor.innerHTML="<p>This browser does not appear to support localStorage, and the grammar editor does not work without it. Sorry!"+}++//console.log("hi")
@@ -0,0 +1,190 @@++var example_based=[];++/*+-- cat lincat fun lin fun cat cat+environ :: ([(CId, CId)],[(CId, Expr)],[((CId, CId), [CId])]) -> Environ+*/+function exb_state(g,ci) {+ var conc=g.concretes[ci]+ function show_list(show1,xs) {+ return "["+map(show1,xs).join(",")+"]";+ }+ function show_fun(fun) {+ var t=fun.type+ var res=t[t.length-1]+ var args=t.slice(0,length-1);+ return "(("+fun.name+","+res+"),["+args.join(",")+"])"+ }+ function show_lincat(lincat) {+ return "("+lincat.cat+","+lincat.type+")"+ }+ function show_lin(lin) {+ return "("+lin.fun+","+(lin.eb_lin||"?")+")"+ }+ function show_funs(funs) { return show_list(show_fun,funs) }+ function show_lincats(lincats) { return show_list(show_lincat,lincats); }+ function show_lins(lins) { return show_list(show_lin,lins) }+ return "("+show_lincats(conc.lincats)+ +","+show_lins(conc.lins)+ +","+show_funs(g.abstract.funs)+")"+}++function exb_call(g,ci,command,args,cont) {+ var url=window.exb_url || "exb/exb.fcgi";+ var q=encodeArgs(args);+ var cmd="?command="+command+"&state="+encodeURIComponent(exb_state(g,ci))+q;+ http_get_json(url+cmd,cont)+}++function ask_possibilities(g,ci) {+ var conc=g.concretes[ci];++ function show_poss(poss) {+ //debug("possibilities: "+JSON.stringify(poss))+ var exready={}+ for(var i in poss[0]) exready[poss[0][i]]=true;+ var testable={}+ for(var i in poss[1]) testable[poss[1][i]]=true;+ example_based[ci]={exready:exready,testable:testable}+ conc.example_based=true;+ if(!conc.example_lang) conc.example_lang=g.concretes[0].langcode;+ reload_grammar(g);+ }+ var exci=conc_index(g,conc.example_lang);+ if(!conc.example_lang || !exci)+ conc.example_lang=g.concretes[ci==0 ? 1 : 0].langcode;+ var exci=conc_index(g,conc.example_lang);+ exb_call(g,ci,"possibilities",{example_state:exb_state(g,exci)},show_poss)+}++var parser = { Eng: "ParseEngAbs.pgf",+ Swe: "ParseSwe.pgf"+ }++function exb_extra(g,ci) {+ var conc=g.concretes[ci];+ function stop_exb() {+ conc.example_based=false;+ reload_grammar(g);+ }++ function exblangmenu() {+ function opt(conc) {+ return option(concname(conc.langcode),conc.langcode);+ }+ function skip_target(c) { return c.langcode!=conc.langcode; }+ var m =node("select",{},map(opt,filter(skip_target,g.concretes)));+ if(conc.example_lang) m.value=conc.example_lang;+ m.onchange=function() { conc.example_lang=m.value; save_grammar(g); }+ return m+ }++ function ask_poss() { ask_possibilities(g,ci) }++ if(navigator.onLine && g.concretes.length>1 && conc.example_based && !example_based[ci]) ask_poss();+ var sb=button("Start",ask_poss)+ if(parser[conc.langcode] && g.concretes.length>1)+ return indent([wrap("small",text("Example-based editing: ")),+ conc.example_based+ ? node("span",{},+ [button("Stop",stop_exb),+ wrap("small",text(" Example language: ")),+ exblangmenu()+ ])+ : sb])+ else {+ sb.disabled=true;+ var why= g.concretes.length>1+ ? " ("+concname(conc.langcode)+" is not supported yet)"+ : " (Add another language to take examples from first.)"+ return indent([unimportant("Example-based editing: "), sb,+ unimportant(why)])+ }+}++function fun_lincat(g,conc,fun) {+ var t=function_type(g,fun);+ var abscat=t[t.length-1]+ return cat_lincat(conc,abscat)+}++function exb_linbuttons(g,ci,f) {+ var conc=g.concretes[ci];+ var fun=f.fun;+ var eb=example_based[ci];+ var exb_output;+ function fill_example(maybetree) {+ var tree=maybetree.Just+ if(tree) {+ if(f.template)+ conc.lins.push({fun:f.fun,args:f.args,+ lin:tree[0],eb_lin:tree[1]});+ else {+ f.lin=tree[0];+ f.eb_lin=tree[1];+ }+ ask_possibilities(g,ci)+ }+ else exb_output.innerHTML="Bug: no tree found"+ }+ function show_example(example){+ exb_output.innerHTML="";+ var s=prompt(example[1]);+ if(s) {+ var cat=fun_lincat(g,conc,fun)+ exb_output.innerHTML="...";+ //server.parse({from:"ParseEng",cat:cat,input:s},fill_example)+ exb_call(g,ci,"abstract_example",+ {cat:cat,input:s,+ parser:parser[conc.langcode],+ params:"["+f.args.join(",")+"]",+ "abstract":example[0]},+ fill_example)+ }+ }+ function by_example() {+ var dir=local.get("dir")+ if(dir) {+ if(exb_output) {+ exb_output.innerHTML="...";+ exb_call(g,ci,"provide_example",+ {lang:g.basename+conc.example_lang,+ parser:parser[conc.langcode],+ fun:fun,+ grammar:dir+"/"+g.basename+".pgf"},+ show_example)+ }+ }+ else exb_output.innerHTML="Compile the grammar first!"+ }+ function show_test(txt) {+ exb_output.innerHTML="";+ exb_output.appendChild(text(txt))+ }+ function test_it(b) {+ if(exb_output) {+ exb_output.innerHTML="...";+ exb_call(g,ci,"test_function",+ {fun:fun,parser:parser[conc.langcode]},+ show_test)+ }+ }+ var buttons=[];+ if(conc.example_based && eb) {+ if(f.template) {+ var byex=button("By example",by_example);+ if(!(eb.exready[fun] && fun_lincat(g,conc,fun)))+ byex.disabled=true+ buttons.push(byex)+ }+ else {+ var b=button("Test it",test_it);+ if(!eb.testable[fun] || !f.eb_lin) b.disabled=true;+ buttons.push(b)+ }+ var exb_output=node("span",{"class":"exb_output"},[]);+ buttons.push(exb_output)+ }+ return node("span",{"class":"exb_linbuttons"},buttons)+}
@@ -0,0 +1,345 @@+/* Abstract syntax for a small subset of GF grammars in JavaScript */++/*+type UniqueId = String --persistent unique grammar identifier used by the editor+type Id = String -- all sorts of identifiers in grammars+type ModId = Id -- module name+type Cat = Id -- category name+type FunId = Id -- function name+type Type = [Cat] -- [Cat_1,...,Cat_n] means Cat_1 -> ... -> Cat_n++type Grammar = { basename: ModId,+ comment: String,+ extends: [ModId], -- in 1-to-1 correspondence with uextends+ uextends: [UniqueId], -- added 2012-10-16+ abstract: Abstract,+ concretes: [Concrete] }++type Abstract = { startcat: Cat, cats: [Cat], funs: [Fun] }+type Fun = { name: FunId, type: Type }++type Concrete = { langcode: Id,+ opens: [ModId],+ params: [{name: Id, rhs: String}],+ lincats : [{ cat: Cat, type: Term}],+ opers: [{name: Lhs, rhs: Term}],+ lins: [Lin]+ }+type Lin = {fun: FunId, args: [Id], lin: Term}++type Lhs = String -- name and type of oper,+ -- e.g "regN : Str -> { s:Str,g:Gender} ="+type Term = String -- arbitrary GF term (not parsed by the editor)+type LinType = [Term]+*/++// locally_defined_cats :: Grammar -> {Cat=>ModId} -> {Cat=>ModId} // destr upd+function locally_defined_cats(g,dc) {+ with(g.abstract)+ for(var i in cats) dc[cats[i]]=g.basename;+ return dc;+}++// predefined_cats :: () -> {Cat=>ModId}+function predefined_cats() {+ var pd = "Predef"+ return { "Int":pd, "Float":pd, "String":pd}+}++// all_defined_cats :: Grammar -> [Grammar] -> {Cat=>ModId}+function all_defined_cats(g,igs) {+ return all_inherited_cats(igs,locally_defined_cats(g,predefined_cats()))+}+// all_inherited_cats :: [Grammar] -> {Cat=>ModId} -> {Cat=>ModId} // destr upd+function all_inherited_cats(igs,dc) {+ for(var i in igs) dc=locally_defined_cats(igs[i],dc)+ return dc;+}++// locally_defined_funs :: [Grammar] -> {FunId=>ModId} -> {Id=>ModId} // destr upd+function locally_defined_funs(g,df) {+ with(g.abstract)+ for(var i in funs) df[funs[i].name]=g.basename;+ return df;+}++// all_defined_funs :: Grammar -> [Grammar] -> {FunId=>ModId}+function all_defined_funs(g,igs) {+ return all_inherited_funs(igs,locally_defined_funs(g,{}))+}+// all_inherited_funs :: [Grammar] -> {FunId=>ModId} -> {FunId=>ModId} // destr upd+function all_inherited_funs(igs,df) {+ for(var i in igs) df=locally_defined_funs(igs[i],df)+ return df;+}++// Return the index of the function the given name in the abstract syntax+// fun_index :: Grammar -> FunId -> (Int|null)+function fun_index(g,fun) {+ with(g.abstract)+ for(var i in funs) if(funs[i].name==fun) return i+ return null;+}++// Return the type of a named function in the abstract syntax+// function_type :: Grammar -> FunId -> (Type|null)+function function_type(g,fun) {+ var ix=fun_index(g,fun)+ return ix==null ? null : g.abstract.funs[ix].type+}++// Return the lincat defined in a given concrete syntax for an abstract category+// cat_lincat :: Concrete -> Cat -> (Term|null)+function cat_lincat(conc,cat) {+ with(conc)+ for(var i in lincats) if(lincats[i].cat==cat) return lincats[i].type+ return null;+}++// Return the index of the lin in a given concrete syntax for an abstract function+// lin_index :: Concrete -> FunId -> (Int|null)+function lin_index(conc,fun) {+ with(conc) for(var i in lins) if(lins[i].fun==fun) return i+ return null;+}++// Return the lin defined in a given concrete syntax for an abstract function+// fun_lin :: Concrete -> FunId -> (Lin|null)+function fun_lin(conc,fun) {+ var i=lin_index(conc,fun)+ if(i!=null) return conc.lins[i]+ return null;+}++// Return the index of the concrete syntax with a given langcode+// conc_index :: Grammar -> Id -> (Int|null)+function conc_index(g,langcode) {+ var c=g.concretes;+ for(var ix=0;ix<c.length;ix++)+ if(c[ix].langcode==langcode) return ix+ return null;+}++// rename_category :: Grammar -> Cat -> Cat -> Grammar // destructive update+function rename_category(g,oldcat,newcat) {+ function rename_cats(cats) {+ for(var i in cats) if(cats[i]==oldcat) cats[i]=newcat;+ }+ function rename_type(t) {+ for(var i in t) if(t[i]==oldcat) t[i]=newcat;+ }+ function rename_funs(funs) {+ for(var i in funs) rename_type(funs[i].type)+ }+ function rename_abstract(a) {+ rename_cats(a.cats);+ rename_funs(a.funs);+ }+ function rename_lincat(lc) {+ if(lc.cat==oldcat) lc.cat=newcat;+ }+ function rename_concrete(c) {+ for(var i in c.lincats) rename_lincat(c.lincats[i]);+ }+ function rename_concretes(cs) {+ for(var i in cs) rename_concrete(cs[i]);+ }+ rename_abstract(g.abstract)+ rename_concretes(g.concretes);+ return g;+}++// rename_function :: Grammar -> FunId -> FunId -> Grammar // destructive update+function rename_function(g,oldfun,newfun) {+ function rename_concrete(c) {+ var i=lin_index(c,oldfun)+ if(i!=null) c.lins[i].fun=newfun;+ }+ for(var i in g.concretes) rename_concrete(g.concretes[i]);+ return g;+}++// change_lin_lhs :: Grammar -> Fun -> Grammar // destructive update+function change_lin_lhs(g,fun) {+ function change_concrete(c) {+ var i=lin_index(c,fun.name)+ if(i!=null) c.lins[i].args=arg_names(fun.type);+ }+ for(var i in g.concretes) change_concrete(g.concretes[i]);+ return g;+}++/* --- Parsing -------------------------------------------------------------- */++// GF idenfifier syntax:+var lex_id=/^[A-Za-z][A-Za-z0-9_']*$/+// See https://developer.mozilla.org/en/JavaScript/Guide/Regular_Expressions++function check_id(s) { return lex_id.test(s); }++function check_name(s,kind) {+ return check_id(s)+ ? null+ : s+"? "+kind+" names must start with a letter and can contain letters, digits, _ and '"+}++// parse_fun :: String -> {error:String} + {ok:Fun}+function parse_fun(s) {+ var ws=s.split(/\s+/);+ var fun={name:"",type:[]};+ /* Use a state machine to parse function definitions */+ /* f : T1 -> ... -> Tn */+ var state="name";+ var ok=true;+ for(var i=0;ok && i<ws.length;i++) {+ if(ws[i]!="") {+ switch(state) {+ case "name": fun.name=ws[i]; state=":"; break;+ case ":": ok=ws[i]==":"; state="type"; break;+ case "type": fun.type.push(ws[i]); state="->"; break;+ case "->": ok=ws[i]=="->"; state="type"; break;+ }+ }+ }+ var err=check_name(fun.name,"Function");+ if(err) return {error: err};+ return ok && state=="->"+ ? {ok:fun}+ : { error : "Fun : Cat<sub>1</sub> -> ... -> Cat<sub>n</sub>" }+}+++// parse_param :: String -> {error:String} + { ok:{name:Id,rhs:String} }+function parse_param(s) {+ var ws=s.split("=");+ if(ws.length==2) {+ var name=ws[0].trim();+ var err=check_name(name,"Parameter type");+ return err ? { error:err } : { ok: { name:name,rhs:ws[1].trim() } }+ }+ else+ return { error: "P = C1 | ... | Cn" }+}++// parse_oper :: String -> {error:String} + {ok:{name:Lhs, rhs:Term}}+function parse_oper(s) {+ var i=s.indexOf(" ");+ var operr = { error: "op = expr" }+ if(i>0 && i<s.length-1) {+ var name=s.substr(0,i).trim();+ var rhs=s.substr(i).trim();+ var err=check_name(name,"Operator");+ return err + ? {error:err}+ : rhs!="" ? {ok: {name:name, rhs:rhs}} + : operr+ }+ else return operr+ +}++/* --- Print as plain text (normal GF source syntax) ------------------------ */++// show_type :: Type -> String+function show_type(t) {+ var s="";+ for(var i in t) {+ if(i>0) s+=" -> ";+ s+=t[i];+ }+ return s;+}++// show_lintype :: LinType -> String+function show_lintype(t) {+ var s="";+ for(var i in t) {+ if(i>0) s+=" -> ";+ s+= check_id(t[i]) ? t[i] : "("+t[i]+")";+ }+ return s;+}++// show_fun :: Fun -> String+function show_fun(fun) {+ return fun.name+" : "+show_type(fun.type);+}++// show_grammar :: Grammar -> String+function show_grammar(g) {+ return show_abstract(g)+"\n"+show_concretes(g)+}++function show_abstract(g) {+// var startcat= g.abstract.cats.length==1 ? g.abstract.cats[0] : g.abstract.startcat;+ var startcat= g.abstract.startcat || g.abstract.cats[0];+ return "abstract "+g.basename+" = "+ +show_extends(g.extends)+ +"{\n\n"+ +"flags coding = utf8 ;\n\n"+ +show_startcat(startcat)+ +show_cats(g.abstract.cats)+ +show_funs(g.abstract.funs)+ +"}\n";+}++function show_extends(exts) {+ return exts && exts.length>0 ? exts.join(", ")+" ** " : "";+}++function show_startcat(startcat) {+ return startcat && startcat!="-"+ ? "flags startcat = "+startcat+";\n\n"+ : "";+}++function show_cats(cats) {+ return cats.length>0 ? "cat\n "+cats.join("; ")+";\n\n" : "";+}++function show_funs(funs) { return show_list("fun",show_fun,funs); }++function show_concretes(g) {+ return map(show_concrete(g),g.concretes).join("\n\n");+}++function conc_extends(conc) { return function(m) { return m+conc.langcode; }}++function show_concrete(g) {+ return function(conc) {+ return "" // "--# -path=.:present\n"+ + "concrete "+g.basename+conc.langcode+" of "+g.basename+" = "+ +show_extends((g.extends || []).map(conc_extends(conc)))+ +show_opens(conc.opens)+ +"{\n\nflags coding = utf8 ;\n\n"+ +show_lincats(conc.lincats)+ +show_lins(conc.lins)+ +show_params(conc.params)+ +show_opers(conc.opers)+ +"}\n"+ }+}++function show_list(kw,show1,list) {+ return list.length>0 + ? kw+"\n "+map(show1,list).join(";\n ")+";\n\n"+ : ""+}++function show_opens(opens) {+ return opens && opens.length>0 ? "\n\nopen "+opens.join(", ")+" in " : ""+}++function show_params(params) { return show_list("param",show_param,params); }+function show_lincats(lincats) { return show_list("lincat",show_lincat,lincats); }+function show_opers(opers) { return show_list("oper",show_oper,opers); }+function show_lins(lins) { return show_list("lin",show_lin,lins); }+++function show_param(p) { return p.name + " = " + p.rhs; }+function show_oper(p) { return p.name + " " + p.rhs; }+function show_lincat(p) { return p.cat + " = " + p.type; }++function show_lin(lin) {+ return lin.fun + " " + lin.args.join(" ")+ " = " + lin.lin;+}
@@ -0,0 +1,4 @@+CACHE MANIFEST+# 5+NETWORK:+*
@@ -0,0 +1,64 @@+<!DOCTYPE html>+<html> <!-- manifest="gfse.manifest" -->+<head>+<title>GF online editor for simple multilingual grammars</title>+<meta charset="UTF-8">+<link rel="stylesheet" type="text/css" href="editor.css" title="Cloud">+<link rel="alternate stylesheet" type="text/css" href="molto.css" title="MOLTO">+<link rel="stylesheet" type="text/css" href="../minibar/minibar.css">+<link rel="stylesheet" type="text/css" href="../syntax-editor/editor.css">++<link rel=author href="http://www.cse.chalmers.se/~hallgren/" title="Thomas Hallgren">++<meta name = "viewport" content = "width = device-width">+<meta http-equiv="Content-type" content="text/html;charset=UTF-8">++</head>++<body class=hover>++<h2>GF online editor for simple multilingual grammars</h2>+<div id=editor></div>+<small class="hidden">+<span class=more>+</span>=Add an item,+<span class=delete>×</span>=Delete item,+<span class=edit>%</span>=Edit item.+</small>+<small class="ifhover">Hover over items for hints and editing options.</small>+<div id=compiler_output class=compiler_output></div>++<noscript>+This page does not work without JavaScript.+</noscript>++<hr>+<div class=modtime><small>+HTML+<!-- hhmts start -->Last modified: Thu May 21 09:47:39 CEST 2015 <!-- hhmts end -->+</small></div>+<a href="about.html">About</a>+<pre id=debug></pre>+<script type="text/javascript" src="config.js"></script> <!-- optional -->+<script type="text/javascript" src="../js/support.js"></script>+<script type="text/JavaScript" src="../js/pgf_online.js"></script>+<script type="text/javascript" src="../js/localstorage.js"></script>+<script type="text/JavaScript" src="../js/langcode.js"></script>++<script type="text/javascript" src="localstorage.js"></script>+<script type="text/javascript" src="gf_abs.js"></script>+<script type="text/javascript" src="example_based.js"></script>+<script type="text/javascript" src="sort.js"></script>+<script type="text/javascript" src="cloud2.js"></script>+<script type="text/javascript" src="editor.js"></script>++<script type="text/JavaScript" src="../minibar/minibar.js"></script>+<script type="text/JavaScript" src="../minibar/minibar_input.js"></script>+<script type="text/JavaScript" src="../minibar/minibar_translations.js"></script>+<script type="text/JavaScript" src="../minibar/minibar_support.js"></script>++<script type="text/javascript" src="../js/grammar_manager.js"></script>+<script type="text/javascript" src="../syntax-editor/ast.js"></script>+<script type="text/javascript" src="../syntax-editor/editor_menu.js"></script>+<script type="text/javascript" src="../syntax-editor/editor.js"></script>+</body>+</html>
@@ -0,0 +1,4 @@++//Needs ../js/localstorage.js++var local=appLocalStorage("gf.editor.simple.grammar")
@@ -0,0 +1,105 @@+body { color: #413b36; background: #fffcfa; }+h1 { font-size: 175%; }+h1,h2,h3,h4,small { font-family: sans-serif; }+h1,h2,h3,h4,a { color: #5c1a1a; }++h1:first-child, h2:first-child { margin-top: 0; margin-bottom: 1ex; }++#editor {+ /* This allows the div to grow wider than the window if necessary to+ accommodate the contents. Otherwise, wide things inside can poke+ through the border. */+ display: table;+ width: 100%;+}++div.grammar { border: 2px solid #b09779; background: #642121; }+div.files { margin: 0 8px 8px 8px; }++div#file { border: 2px solid #b0977d; border-top-width: 0; }+pre.plain { border: 2px solid #b0977d; }+div#file, pre.plain { background: #fffcfa; padding: 0.6ex; }++.slideshow .hidden { display: none; }++img.cloud, img.right, div.right, div.modtime { float: right; }+.modtime { color: #999; white-space: nowrap; }++table.grammar_list { border-collapse: collapse; margin-left: 1.0em; }+table.grammar_list td { padding: 0.4ex 0.25em; }++/*div.namebar { background: #642121; }*/+div.namebar table { width: 100%; }+.namebar h3 { margin: 0; color: white; }++td.right { text-align: right; }++.kw { font-weight: bold; font-family: sans-serif; color: #642121; }+.sep { font-weight: bold; color: #642121; }++div.indent { padding-left: 1em; min-width: 1em; min-height: 1em; }++/*+div.fun, div.param, div.lincat, div.oper, div.lin+{ padding-left: 2em; text-indent: -2em; }+*/+.more, .delete { font-weight: bold; font-family: sans-serif; }+.more, .delete, .edit { cursor: pointer; }++.hover .more, .hover .delete, .hover .edit { visibility: hidden }++.hover .hidden, .nohover .ifhover { display: none; }++.editable:hover, .deletable:hover { background: #ff9; }+.namebar .editable:hover { background: #04b; }++.extensible:hover .more,.editable:hover > .edit ,.deletable:hover > .delete,+ tr.deletable:hover .delete+ { visibility: visible; }++.more { color: green; }+.edit { color: orange; }+.delete { color: red; }+.error_message,.inError { color: red; }+.template, .template .sep, .unimportant { color: #999; }+form { display: inline-block; }++table.tabs {+ width: 100%;+ border-width: 0; border-spacing: 0; empty-cells: show;+}++table.tabs td { text-align: center; border: 2px solid #b09779; padding: 2px; white-space: nowrap; }+table.tabs td.active { background: white; border-bottom-width: 0; }+table.tabs td.inactive {+ background: #e1e1e1;+ border-top-color: #b09779; border-left-color: #b09779; border-right-color: #b09779;+}++ table.tabs td.gap+{ border-top-width: 0; border-left-width: 0; border-right-width: 0; }++table.tabs input[type=button] {+ border: 0;+ background: inherit;+ color: #642121;+ font-size: inherit;+ font-weight: bold;+ /*text-decoration: underline;*/+}++input.string_edit { font-family: inherit; font-size: inherit; }++ul.languages { -moz-column-width: 20em; }++li { margin-top: 0.5ex; margin-bottom: 0.5ex; }++#sharing h1, #sharing .footer { display: none; }++div.compiler_output .back_to_editor { display: none; }++div#minibar {+ border: 1px solid black;+ padding: 5px;+ background: #ccc url("../minibar/brushed-metal.png");+}
@@ -0,0 +1,28 @@+<!DOCTYPE html>+<html> <head>+<title>Download from Grammar Cloud</title>+<link rel="stylesheet" type="text/css" href="editor.css" title="Cloud">+<link rel="alternate stylesheet" type="text/css" href="molto.css" title="MOLTO">++</head>++<body>+<h1><img src="P/1307545048_weather_09.png" alt="">Download from Grammar Cloud</h1>++<pre id=debug></pre>++<hr>+<address></address>+<!-- hhmts start -->Last modified: Wed Apr 3 21:53:09 CEST 2013 <!-- hhmts end -->+<script type="text/javascript" src="../js/support.js"></script>+<script type="text/javascript" src="../js/localstorage.js"></script>+<script type="text/javascript" src="localstorage.js"></script>+<script type="text/javascript" src="gf_abs.js"></script>+<script type="text/javascript" src="editor.js"></script>+<script type="text/javascript" src="cloud2.js"></script>+<script type="text/javascript" src="sort.js"></script>+<script type="text/javascript">+download_from_cloud();+</script>+</body>+</html>
@@ -0,0 +1,86 @@++var internet_explorer=navigator.appName=="Microsoft Internet Explorer";++/* How to change opacity in IE:+http://joseph.randomnetworks.com/archives/2006/08/16/css-opacity-in-internet-explorer-ie/+*/++var set_opacity =+ internet_explorer+ ? function(el,o) { el.style.filter="alpha(opacity="+Math.round(o*100)+")";}+ : function(el,o) { el.style.opacity=o; };++function start_slideshow(img,options) {+ var p=img.parentNode;+ if(p.tagName=="A") p=p.parentNode;+ var is=p.getElementsByTagName("img");+ if(is.length>1) {+ var cur=0;+ var w=img.width;+ var h=img.height;+ //p.style.position="relative";+ p.style.minWidth=w+"px";+ p.style.minHeight=h+"px";+ var images=[];+ for(var i=0;i<is.length;i++) {+ images[i]=is[i];+ var c=images[i];+ if(internet_explorer) c.style.zoom=1;+ c.style.position="absolute";+ }+ var timeout=1000*(options.delay || 5);+ var ft=options.fade==null ? 1 : options.fade;+ var tick=function() {+ var c=images[cur];+ cur= (cur+1) % images.length;+ var n=images[cur];+ set_opacity(n,0);+ //n.style.position="static";+ n.style.zIndex=1;+ n.className="";+ if(n.width>w) { w=n.width; p.style.minWidth=w+"px"; }+ if(n.height>h) { h=n.height; p.style.minHeight=h+"px"; }+ c.style.position="absolute";+ c.style.zIndex=0;+ fade(n,0,1,ft,function() {+ if(c.width>n.width || c.height>n.height) fade(c,1,0,ft,null);+ else set_opacity(c,0); });+ //debug.innerHTML=w+"x"+h;+ //for(var i=0;i<images.length;i++)+ //debug.appendChild(text(" "+images[i].style.position));+ }+ //var debug=document.createElement("div");+ //p.parentNode.insertBefore(debug,p);+ //debug.innerHTML=w+"x"+h;+ setInterval(tick,timeout);+ }+ //else alert("No slideshow!");+}++function fade(el,start,stop,t,after) {+ // el: which element to fade+ // start: starting opacity [0..1]+ // stop: ending opacity [0..1]+ // t: duration of fade (in seconds), default 1s+ // after: function to call when done fading, optional+ var dt=40; // Animation granularity, 1/40ms = 25fps+ el.step=(stop-start)*dt/(1000*(t==null ? 1 : t));+ el.stop=stop;+ //alert("fade "+start+" "+stop+" "+el.step);+ var done=function() {+ clearInterval(el.timer);+ el.timer=null;+ if(after) after();+ }+ var f=function() {+ var next=el.current+el.step;+ if(next>=1) { next=1; done(); }+ if(next<=0) { next=0; done(); }+ set_opacity(el,next);+ el.current=next+ }+ if(!el.timer) {+ el.current=start;+ el.timer=setInterval(f,dt);+ }+}
@@ -0,0 +1,157 @@++function initialize_sorting(tagList,classList) {+ /*+ var debugoutput=empty("pre");+ document.body.appendChild(debugoutput)+ function jsdebug(txt) {+ //clear(debugoutput)+ debugoutput.appendChild(text(txt+"\n"))+ }+ */+ function listToSet(list) {+ var set={}+ for(var i in list) set[list[i]]=true+ return set;+ }+ var sortable_tag=listToSet(tagList)+ var sortable_class=listToSet(classList)++ function sortable(elem) {+ return elem && elem.tagName!="INPUT" && elem.tagName!="BUTTON"+ && (sortable_tag[elem.tagName]+ ? sortable_class[elem.className]+ ? elem+ : null+ : sortable(elem.parentNode))+ }++ function move_element(elem,x,y) {+ elem.style.left=x+"px";+ elem.style.top=y+"px";+ elem.delta={x:x,y:y};+ }++ function adjust_refs(elem,dy) {+ //jsdebug("dy="+dy);+ move_element(elem,elem.delta.x,elem.delta.y-dy);+ elem.downAt.y+=dy;+ elem.range.lo-=dy;+ elem.range.hi-=dy;+ }++ function move_up(elem) {+ var prev=elem.previousElementSibling;+ if(prev) {+ var top=elem.offsetTop;+ var mid=prev.offsetTop+prev.offsetHeight/2;+ if(top<mid) {+ elem.parentNode.insertBefore(elem,prev);+ adjust_refs(elem,elem.offsetTop-top)+ }+ //else jsdebug("not yet, top="+top+", mid="+mid);+ }+ //else jsdebug("at top");+ }++ function move_down(elem) {+ var next=elem.nextElementSibling;+ if(next) {+ var top=elem.offsetTop;+ var bot=top+elem.offsetHeight;+ var mid=next.offsetTop+next.offsetHeight/2;+ if(bot>mid) {+ next.parentNode.insertBefore(next,elem);+ adjust_refs(elem,elem.offsetTop-top)+ }+ //else jsdebug("not yet, top="+top+", bot="+bot+", mid="+mid);+ }+ //else jsdebug("at bottom");+ }++ function swap(elem,dy) {+ if(dy>0) move_down(elem);+ else if(dy<0) move_up(elem);+ }++ function restrictTo(range,y) {+ return Math.min(range.hi,Math.max(range.lo,y));+ }++ // -------------------------------------------------------------------------+ // These functions isolate the difference between mouse interfaces and touch+ // interfaces++ function eventPosition(event) {+ var p=event+ if(event.touches) p=event.touches[0]+ return {x:p.screenX,y:p.screenY}+ }++ function setStartHandler(ondown) {+ if("ontouchstart" in window) document.ontouchstart=ondown+ else document.onmousedown=ondown+ }++ function setDragHandlers(onmove,onend) {+ if("ontouchstart" in window) {+ document.ontouchmove=onmove;+ document.ontouchend=onend;+ }+ else {+ document.onmousemove=onmove;+ document.onmouseup=onend;+ }+ }+ // -------------------------------------------------------------------------+ + function startDrag(event,elem) {+ //jsdebug("Start dragging");+ elem.style.position="relative";+ elem.delta || (elem.delta={x:0,y:0});+ var p=eventPosition(event)+ elem.downAt={x:p.x-elem.delta.x,y:p.y-elem.delta.y};+ var list=elem.parentNode;+ // elem and list must have the same offsetParent for this to work!!+ var top=list.offsetTop-elem.offsetTop+elem.delta.y;+ elem.range={lo:top,hi:top+list.offsetHeight-elem.offsetHeight};+ elem.style.zIndex=1;+ //console.log("Start dragging",elem.id,list.offsetTop,elem.offsetTop,elem.range.lo,elem.range.hi)+ function dragMove(event) {+ var p=eventPosition(event)+ var dx=0/*p.x-elem.downAt.x*/;+ var dy=restrictTo(elem.range,p.y-elem.downAt.y);+ //jsdebug("dragging to "+dx+" "+dy+" "+show_props(elem.range,"range"));+ //console.log("dragging to ",dy);+ move_element(elem,dx,dy);+ //jsdebug("dragging to "+elem.offsetLeft+" "+elem.offsetTop);+ swap(elem,dy)+ return false;+ }+ function dragEnd() {+ //jsdebug("dropped");+ elem.style.zIndex=0;+ move_element(elem,0,0);+ setDragHandlers(null,null)+ return false;+ }+ setDragHandlers(dragMove,dragEnd)+ return false;+ }++ function mousedown(event) {+ var elem=sortable(event.target);+ if(elem) return startDrag(event,elem);+ //else jsdebug("Clicked outside"/*+taglist(event.target)/*+show_props(event,"event")*/);+ }++ //var jsdebug=debug;++ function init() {+ setStartHandler(mousedown)+ //var d=element("javascriptdebug");+ //if(d) jsdebug=function(msg) { d.innerHTML=msg; }+ }+ init();+}++//Inspired by http://tool-man.org/examples/sorting.html
@@ -0,0 +1,41 @@+<!DOCTYPE html>++<!-- This is the start page served by "gf -server" -->++<title>GF Cloud Service</title>+<meta charset="UTF-8">+<link rel="stylesheet" type="text/css" href="cloud.css" title="Cloud">+<meta name = "viewport" content = "width = device-width">++<h1><a href="http://www.grammaticalframework.org/"><img src="Logos/gf0.png" alt=""></a><img class=nofloat src="P/gf-cloud.png" alt=""> GF Cloud Service</h1>++<h2>Web Applications</h2>++<ul>+ <li><a href="minibar/minibar.html">Minibar</a>+ (word-completing translation tool)+ <li><a href="syntax-editor/editor.html">Syntax Editor</a>+ (for building and manipulating abstract syntax trees)+ <li><a href="TransQuiz/translation_quiz.html">Translation Quiz</a>+ <li><a href="gfse/">GF online editor for simple multilingual grammars</a>+ <li><a href="translator/">Simple Translation Tool</a>+ (bilingual document editor)+ <li><a href="wc.html">Wide Coverage Translation Demo</a>+</ul>++<h2>Documentation</h2>++<ul>+ <li><a href="minibar/about.html">About Minibar</a>+ <li><a href="minibar/minibar-api.html">Minibar API documentation</a>+ <li><a href="gfse/about.html">About the online grammar editor</a>+ <li><a href="translator/about.html">About the simple translation tool</a>+ <li><a href="gf-web-api-examples.html">PGF web service API examples</a>+ <li><a href="gf-web-api.html">PGF web service API documentation</a>+ <li><a href="gf-cloud-api.html">GF Cloud Service API</a>+</ul>++<hr>++<a href="http://www.grammaticalframework.org/">www.grammaticalframework.org</a>+<div class=version><small><a href="/version">GF version</a></small></div>
@@ -0,0 +1,314 @@+// Copied from https://github.com/christos-c/tree-viewer (TH 2015-03-24)++// Inspired by "D3.js Drag and Drop Zoomable Tree" by Rob Schmuecker <robert.schmuecker@gmail.com>+// https://gist.github.com/robschmuecker/7880033++function d3Tree(treeData) {+ // panning variables+ var panSpeed = 200;+ // Misc. variables+ var i = 0;+ var duration = 450;+ var root;+ + // size of the diagram+ var pageWidth = $(document).width();+ var viewerWidth = pageWidth - (0.2 * pageWidth);+ var viewerHeight = 500;++ var tree = d3.layout.tree()+ .size([viewerWidth-20, viewerHeight]);++ // define a d3 diagonal projection for use by the node paths later on.+ var diagonal = d3.svg.diagonal()+ .projection(function(d) {+ return [d.x, d.y];+ });+ + // Can be used to draw the links between nodes instead of the diagonal+ // TODO Doesn't work with the collapse/expand transition+ //function straightLine(d) {+ // return "M" + d.source.x + "," + d.source.y + "L" + d.target.x + "," + d.target.y;+ //}++ // A recursive helper function for performing some setup by walking through all nodes+ function visit(parent, visitFn, childrenFn) {+ if (!parent) return;++ visitFn(parent);++ var children = childrenFn(parent);+ if (children) {+ var count = children.length;+ for (var i = 0; i < count; i++) {+ visit(children[i], visitFn, childrenFn);+ }+ }+ }++ // TODO: Pan function, can be better implemented.+ function pan(domNode, direction) {+ var speed = panSpeed;+ if (panTimer) {+ clearTimeout(panTimer);+ translateCoords = d3.transform(svgGroup.attr("transform"));+ if (direction == 'left' || direction == 'right') {+ translateX = direction == 'left' ? translateCoords.translate[0] + speed : translateCoords.translate[0] - speed;+ translateY = translateCoords.translate[1];+ } else if (direction == 'up' || direction == 'down') {+ translateX = translateCoords.translate[0];+ translateY = direction == 'up' ? translateCoords.translate[1] + speed : translateCoords.translate[1] - speed;+ }+ scaleX = translateCoords.scale[0];+ scaleY = translateCoords.scale[1];+ scale = zoomListener.scale();+ svgGroup.transition().attr("transform", "translate(" + translateX + "," + translateY + ")scale(" + scale + ")");+ d3.select(domNode).select('g.node').attr("transform", "translate(" + translateX + "," + translateY + ")");+ zoomListener.scale(zoomListener.scale());+ zoomListener.translate([translateX, translateY]);+ panTimer = setTimeout(function() {+ pan(domNode, speed, direction);+ }, 50);+ }+ }++ // Define the zoom function for the zoomable tree+ function zoom() {+ svgGroup.attr("transform", "translate(" + d3.event.translate + ")scale(" + d3.event.scale + ")");+ }+++ // define the zoomListener which calls the zoom function on the "zoom" event constrained within the scaleExtents+ var zoomListener = d3.behavior.zoom().scaleExtent([0.1, 3]).on("zoom", zoom);+ + // remove the previous svg if there+ d3.select("svg").remove();+ + // define the baseSvg, attaching a class for styling and the zoomListener+ var baseSvg = d3.select("#tree-container").append("svg")+ .attr("width", viewerWidth)+ .attr("height", viewerHeight)+ .attr("class", "overlay")+ .call(zoomListener)+ .on("dblclick.zoom", null);++ // The arrowmarker to be appended at the end of each path+ // TODO Looks terrible (not currently used)+ baseSvg.append("marker")+ .attr("id", "markerArrow")+ .attr("markerWidth", 4)+ .attr("markerHeight", 4)+ .attr("refY","2")+ .attr("refX", "10")+ .attr("orient", "auto")+ .append("polygon")+ .attr("points", "0,0 4,2 0,4")+ .attr("style", "fill: #ccc");++ // Helper functions for collapsing and expanding nodes.+ function collapse(d) {+ if (d.children) {+ d._children = d.children;+ d._children.forEach(collapse);+ d.children = null;+ }+ }++ function expand(d) {+ if (d._children) {+ d.children = d._children;+ d.children.forEach(expand);+ d._children = null;+ }+ }++ var overCircle = function(d) {+ selectedNode = d;+ updateTempConnector();+ };+ var outCircle = function(d) {+ selectedNode = null;+ updateTempConnector();+ };++ // Toggle children function+ function toggleChildren(d) {+ if (d.children) {+ d._children = d.children;+ d.children = null;+ } else if (d._children) {+ d.children = d._children;+ d._children = null;+ }+ return d;+ }++ // Toggle children on click.+ function click(d) {+ if (d3.event.defaultPrevented) return; // click suppressed+ d = toggleChildren(d);+ update(d);+ }++ function update(source) {+ // Compute the new height, function counts total children of root node and sets tree height accordingly.+ // This prevents the layout looking squashed when new nodes are made visible or looking sparse when nodes are removed+ // This makes the layout more consistent.+ var levelHeight = [1];+ var childCount = function(level, n) {+ if (n.children && n.children.length > 0) {+ if (levelHeight.length <= level + 1) levelHeight.push(0);++ levelHeight[level + 1] += n.children.length;+ n.children.forEach(function(d) {+ childCount(level + 1, d);+ });+ }+ };+ childCount(0, root);+ var maxLevel = levelHeight.length+2;++ // Compute the new tree layout.+ var nodes = tree.nodes(root).reverse(),+ links = tree.links(nodes);++ // Set heights between levels based on maxLevel.+ nodes.forEach(function(d) {+ d.y = (d.depth * (viewerHeight/(maxLevel)));+ });++ // Update the nodes…+ var node = svgGroup.selectAll("g.node")+ .data(nodes, function(d) {+ return d.id || (d.id = ++i);+ });++ // Enter any new nodes at the parent's previous position.+ var nodeEnter = node.enter().append("g")+ .attr("class", "node")+ .attr("transform", function(d) {+ return "translate(" + source.x0 + "," + source.y0 + ")";+ })+ .on('click', click);++ nodeEnter.append("rect")+ .attr('class', 'nodeRect')+ // Size of the rectangle/2+ .attr("x", function(d){return -(d.name.length*5+10)/2})+ .attr("y", -10)+ .attr("width", 0)+ .attr("height", 0)+ .style("fill", function(d) {+ return d._children ? "lightsteelblue" : "#fff";+ });++ nodeEnter.append("text")+ .attr("y", 0)+ .attr("dy", ".35em")+ .attr('class', 'nodeText')+ .attr("text-anchor", "middle")+ .text(function(d) {+ return d.name;+ })+ .style("fill-opacity", 0);++ // Update the text to reflect whether node has children or not.+ node.select('text')+ .attr("y", 0)+ .attr("text-anchor", "middle")+ .text(function(d) {+ return d.name;+ });++ node.select("rect.nodeRect")+ .attr("width", function(d) {+ // Adjust the size of the square according to the label+ return d.children || d._children ? d.name.length*5+10 : 0;+ })+ .attr("height", function(d) {+ return d.children || d._children ? 20 : 0;+ })+ .style("fill", function(d) {+ return d._children ? "lightsteelblue" : "#fff";+ });++ // Transition nodes to their new position.+ var nodeUpdate = node.transition()+ .duration(duration)+ .attr("transform", function(d) {+ return "translate(" + d.x + "," + d.y + ")";+ });++ // Fade the text in+ nodeUpdate.select("text")+ .style("fill-opacity", 1);++ // Transition exiting nodes to the parent's new position.+ var nodeExit = node.exit().transition()+ .duration(duration)+ .attr("transform", function(d) {+ return "translate(" + source.x + "," + source.y + ")";+ })+ .remove();++ nodeExit.select("circle")+ .attr("r", 0);++ nodeExit.select("text")+ .style("fill-opacity", 0);++ // Update the links…+ var link = svgGroup.selectAll("path.link")+ .data(links, function(d) {+ return d.target.id;+ });++ // Enter any new links at the parent's previous position.+ link.enter().insert("path", "g")+ .attr("class", "link")+ //TODO MARKERS LOOK TERRIBLE+ // .attr("marker-end", "url(#markerArrow)")+ .attr("d", function(d) {+ var o = {x: source.x, y: source.y};+ return diagonal({source: o,target: o});+ });+ // TODO doesn't work with the transition+ // .attr("d", straightLine);++ // Transition links to their new position.+ link.transition()+ .duration(duration)+ .attr("d", diagonal);+ // TODO doesn't work with the transition+ // .attr("d", straightLine);++ // Transition exiting nodes to the parent's new position.+ link.exit().transition()+ .duration(duration)+ .attr("d", function(d) {+ var o = {x: source.x, y: source.y};+ return diagonal({source: o,target: o});+ })+ // TODO doesn't work with the transition+ // .attr("d", straightLine)+ .remove();++ // Stash the old positions for transition.+ nodes.forEach(function(d) {+ d.x0 = d.x;+ d.y0 = d.y;+ });+ }++ // Append a group which holds all nodes and which the zoom Listener can act upon.+ var svgGroup = baseSvg.append("g");++ // Define the root+ root = treeData;+ root.x0 = viewerWidth / 2;+ root.y0 = 0;++ // Layout the tree initially and center on the root node.+ update(root);+ d3.select('g').attr("transform", "translate(0,20)");+}
@@ -0,0 +1,43 @@++/* --- GF robust parser interface ------------------------------------------- */++var gfrobust = {}++gfrobust.url="http://www.grammaticalframework.org:41296/robust-parser/parse"+gfrobust.jsonurl="http://www.grammaticalframework.org:41296/robust-parser.cgi"+gfrobust.grammar="Parse" // the name of the grammar+gfrobust.targetlist=[] // do not use, exposed only for debugging++gfrobust.call=function(querystring,cont) {+ http_get_json(gfrobust.jsonurl+querystring,cont)+}++// Translate a sentence to the given target language+gfrobust.translate=function(source,to,cont) {+ var encsrc=encodeURIComponent(source)+ if(encsrc.length<200) // match limit in runtime/c/utils/pgf-server.c+ gfrobust.call("?sentence="+encsrc+"&to="+gfrobust.grammar+to,cont)+ else cont("[GF robust parser: sentence too long]")+}++// Get the url of a parse tree image (SVG)+gfrobust.parsetree_url=function(source) {+ return gfrobust.url+"?sentence="+encodeURIComponent(source)+}++// Get functions to test which source and target langauges are supported+gfrobust.get_support=function(cont) {+ function ssupport(code) { return code=="Eng" }+ function tsupport(code) { return gfrobust.targets[code] }+ function init2(langstr) {+ var ls=langstr.split(" "); // ls probably contains an empty string here+ var langs=[], pre=gfrobust.grammar, n=pre.length+ for(var i=0;i<ls.length;i++)+ if(ls[i].substr(0,n)==pre) langs.push(ls[i].substr(n))+ gfrobust.targetlist=langs+ gfrobust.targets=toSet(langs)+ cont(ssupport,tsupport)+ }+ if(gfrobust.target) cont(ssupport,tsupport)+ else gfrobust.call("",init2) // retrieve list of supported target languages+}
@@ -0,0 +1,167 @@++/* --- GF wide coverage translation interface ------------------------------- */++var gftranslate = {}++gftranslate.jsonurl="/robust/App16.pgf"+gftranslate.grammar="App" // the name of the grammar++gftranslate.documented_classes=+ ["N", "N2", "N3", "A", "A2", "V", "V2", "VV", "VS", "VQ", "VA", "V3", "V2V",+ "V2S", "V2Q", "V2A", "Adv", "Prep"]++gftranslate.call=function(querystring,cont,errcont) {+ http_get_json(gftranslate.jsonurl+querystring,cont,errcont)+}++function enc_langs(g,to) {+ return Array.isArray(to)+ ? to.map(function(l){return g+l}).join("+")+ : g+to+}++function unspace_translations(g,trans) {+ var langs=[g+"Chi",g+"Jpn",g+"Tha"]+ for(var i=0;i<trans.length;i++) {+ var lins=trans[i].linearizations+ if(lins) {+ for(var j=0;j<lins.length;j++) {+ var lin=lins[j]+ if(elem(lin.to,langs)) {+ //console.log(i,j,"space",lin.to,lin.text)+ lin.text=lin.text.split(" ").join("")+ //console.log(i,j,"unspace",lin.to,lin.text)+ }+ }+ }+ }+ return trans+}++function length_limit(lang) {+ switch(lang) {+ case "Bul":+ case "Chi":+ case "Eng":+ case "Swe":+ return 500+ default:+ return 200+ }+}++function check_limit(lang,source) {+ var len=source.length, limit=length_limit(lang)+ return len<=limit ? null : "sentense too long, "+len+">"+limit+}++// Translate a sentence+gftranslate.translate=function(source,from,to,start,limit,cont) {+ var g=gftranslate.grammar+ var lexer="&lexer=text"+ if(from=="Chi") lexer="",source=source.split("").join(" ")+ function errcont(text,code) { cont([{error:code+" "+text}]) }+ function extract(result) {+ cont(unspace_translations(g,result[0].translations))+ }+ var too_long=check_limit(from,source)+ if(too_long) cont([{error:too_long}])+ else+ gftranslate.call("?command=c-translate&jsontree=true&input="+ +encodeURIComponent(source)+ +lexer+"&unlexer=text&from="+g+from+"&to="+enc_langs(g,to)+ +"&start="+start+"&limit="+limit,extract,errcont)+}++// Translate a sentence word for word (if all else fails...)+gftranslate.wordforword=function(source,from,to,cont) {+ var g=gftranslate.grammar+ var lexer="&lexer=text"+ if(from=="Chi") lexer="",source=source.split("").join(" ")+ function errcont(text,code) { cont([{error:code+" "+text}]) }+ function extract(result) {+ cont(unspace_translations(g,result[0].translations))+ }+ var enc_to = enc_langs(g,to)+ var too_long=check_limit(from,source)+ if(too_long) cont([{error:too_long}])+ else+ gftranslate.call("?command=c-wordforword&input="+ +encodeURIComponent(source)+ +lexer+"&unlexer=text&from="+g+from+"&to="+enc_to+ ,extract,errcont)+}++// Get list of supported languages+gftranslate.waiting=[]+gftranslate.get_languages=function(cont,errcont) {+ function init2(grammar_info) {+ var ls=grammar_info.languages+ gftranslate.grammar=grammar_info.name+ var langs=[], pre=gftranslate.grammar, n=pre.length+ for(var i=0;i<ls.length;i++)+ if(ls[i].name.substr(0,n)==pre) langs.push(ls[i].name.substr(n))+ gftranslate.targetlist=langs+ var w=gftranslate.waiting+ for (var i=0;i<w.length;i++) w[i].cont(langs)+ gftranslate.waiting=[]+ }+ function init2error(text,status,ct) {+ var w=gftranslate.waiting+ for (var i=0;i<w.length;i++) {+ var e=w[i].errcont+ if(e) e(text,status,ct)+ }+ gftranslate.waiting=[]+ }+ if(gftranslate.targetlist) cont(gftranslate.targetlist)+ else {+ gftranslate.waiting.push({cont:cont,errcont:errcont})+ if(gftranslate.waiting.length<2) + gftranslate.call("?command=c-grammar",init2,init2error)+ }+}++// Get functions to test which source and target langauges are supported+gftranslate.get_support=function(cont,errcont) {+ function support(code) { return gftranslate.targets[code] }+ function init2(langs) {+ gftranslate.targets=toSet(langs)+ cont(support,support)+ }+ if(gftranslate.targets) cont(support,support)+ else gftranslate.get_languages(init2,errcont)+}++// trans_text_quality : String -> {quality:String, text:String}+function trans_text_quality(text) {+ var quality="default_quality"+ switch(text[0]) {+ case '+': text=text.substr(1).trimLeft(); quality="high_quality"; break;+ case '*': text=text.substr(1).trimLeft(); quality="low_quality"; break;+ }+ return {quality:quality,text:text}+}++// find_to :: Lang -> [{to:Lang,...}] -> Int+function find_to(to,lins) {+ for(var i=0;i<lins.length;i++)+ if(lins[i].to==to) return i+ return -1 // Hmm....+}++function trans_quality(r,to) {+ var ix=to ? find_to(to,r.linearizations) : 0+ if(ix<0) return null+ else {+ var text=r.linearizations[ix].text+ if(r.prob==0) return {quality:"high_quality",text:text}+ else if(r.prob<0) return {quality:"bad_quality",text:text}+ else {+ var t=trans_text_quality(text)+ if(t.quality=="default_quality" && r.tree && r.tree[0]=="?")+ t.quality="low_quality"+ return t+ }+ }+}
@@ -0,0 +1,180 @@+/* --- Grammar Manager object ----------------------------------------------- */+/*+This object stores the state for:+- grammar+- startcat+- languages++Hooks which actions can be hooked to:+- onload+- change_grammar+- change_startcat+- change_languages++*/+function GrammarManager(server,opts) {+ var t = this;+ /* --- Configuration ---------------------------------------------------- */++ // default values+ this.options = {+ initial: {}+ };+ this.actions = {+ onload: [+ function(gm){ debug("default action: onload"); }+ ],+ change_grammar: [+ function(grammar){ debug("default action: change grammar"); }+ ],+ change_startcat: [+ function(startcat){ debug("default action: change startcat"); }+ ],+ change_languages: [+ function(languages){ debug("default action: change languages"); }+ ]+ }++ // Apply supplied options+ if(opts) for(var o in opts) this.options[o]=opts[o];++ /* --- Client state initialisation -------------------------------------- */+ this.server = server;+ this.grammar = null; // current grammar+ this.grammars=[];+ this.grammar_dirs=[];+ this.startcat = null; // current startcat+ this.languages = this.options.initial.languages || [];+ // current languages (empty means all langs)++ /* --- Main program, this gets things going ----------------------------- */+ this.init=function(){+ this.server.get_grammarlists(bind(this.onload,this));+ }+ this.init();+}++// +//GrammarManager.prototype.update_grammar_list=function(dir,grammar_names,dir_count) {+GrammarManager.prototype.onload=function(dir,grammar_names,dir_count) {+ var t=this;+ t.grammars=[];+ t.grammar_dirs=[];+ t.grammar_dirs.push(dir);+ t.grammars=t.grammars.concat(grammar_names.map(function(g){return dir+g}));+ var grammar0=t.options.initial.grammar || t.grammars[0];+ t.change_grammar(grammar0);++ // Execute hooked actions+ t.run_actions("onload",dir,grammar_names,dir_count);+}++/* --- Registering / unregistering actions to hooks ------------------------- */++GrammarManager.prototype.register_action=function(hook,action) {+ var hookring = this.actions[hook];+ hookring.push(action);+}++GrammarManager.prototype.unregister_action=function(hook,action) {+ var hookring = this.actions[hook];+ for (var f=0; f < hookring.length; f++) {+ if (hookring[f] == action) {+ hookring = Array.remove(hookring, f);+ }+ }+}++// Execute actions for a given hook+// TODO: any number of arguments+GrammarManager.prototype.run_actions=function(hook,arg1,arg2,arg3) {+ var acts = this.actions[hook];+ for (f in acts) {+ acts[f](arg1,arg2,arg3);+ }+}++/* --- Grammar -------------------------------------------------------------- */++// API+GrammarManager.prototype.change_grammar=function(grammar_url) {+ var t=this;+ t.server.switch_to_other_grammar(grammar_url, function() {+ t.server.grammar_info(function(grammar){+ // Set internal state+ t.grammar = grammar;++ // Call internal functions+ t.update_startcat(grammar);+ t.update_language_list(grammar);++ // Execute hooked actions+ t.run_actions("change_grammar",grammar);+ });+ });+}++/* --- Start category ------------------------------------------------------- */++// Internal+// Sets default startcat for grammar+GrammarManager.prototype.update_startcat=function(grammar) {+ var t=this;+ var cats=grammar.categories;+ var startcat0 = t.options.initial.startcat;+ if (elem(startcat0, cats))+ t.startcat = startcat0;+ else+ t.startcat = grammar.startcat;+}++// API+GrammarManager.prototype.change_startcat=function(startcat) {+ var t = this;++ // Set internal state+ t.startcat = startcat;++ // Call internal functions+ // ...+ + // Execute hooked actions+ t.run_actions("change_startcat",startcat);+}++/* --- Languages ------------------------------------------------------------ */++// Internal+// Sets default languages for grammar+GrammarManager.prototype.update_language_list=function(grammar) {+ var t = this;+ function langpart(conc,abs) { // langpart("FoodsEng","Foods") == "Eng"+ return hasPrefix(conc,abs) ? conc.substr(abs.length) : conc;+ }+ // Replace the options in the menu with the languages in the grammar+ var langs=grammar.languages;+ for(var i=0; i<langs.length; i++) {+ var ln=langs[i].name; // "PhrasebookEng"+ if(!hasPrefix(ln,"Disamb")) {+ var lp=langpart(ln,grammar.name); // "Eng"+ if (elem(lp, t.options.initial.languages)) {+ t.languages.push(ln);+ }+ }+ }+}++// API+GrammarManager.prototype.change_languages=function(languages) {+ var t = this;++ // Set internal state+ t.languages = languages;++ // Call internal functions+ // ...++ // Execute hooked actions+ t.run_actions("change_languages",languages);+}+
@@ -0,0 +1,70 @@+// Language names and ISO-639 codes (both 3-letter and 2-letter codes)+// See http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes++var languages =+ function() {+ function lang1(namecode2) {+ function lang(code,name,code2) {+ return {code:code, name:name, code2:code2}+ }+ var nc=namecode2.split(":")+ var name=nc[0]+ var ws=name.split("/")+ var code2=nc.length>1 ? nc[1] : ""+ return ws.length==1 ? lang(name.substr(0,3),name,code2)+ : lang(ws[0],ws[1],code2)+ }+ var ls+ // [ISO-639-2 code "/"] language name ":" ISO 639-1 code+ ls=["Afrikaans:af","Amharic:am","Arabic:ar","Bulgarian:bg","Catalan:ca",+ "Chinese:zh","Czech:cs","Danish:da","Dutch:nl","English:en",+ "Estonian:et","Finnish:fi","French:fr","German:de","Greek:el",+ "Hebrew:he","Hindi:hi","Ina/Interlingua:ia",+ "Icelandic:is","Gle/Irish:ga","Italian:it","Jpn/Japanese:ja",+ "Latin:la","Lav/Latvian:lv","Mlt/Maltese:mt","Mongolian:mn",+ "Nepali:ne","Norwegian:nb","Pes/Persian:fa","Polish:pl",+ "Portuguese:pt","Pnb/Punjabi:pa",+ "Ron/Romanian:ro","Russian:ru","Snd/Sindhi:sd","Spanish:es",+ "Swedish:sv","Thai:th","Turkish:tr","Urdu:ur"]+ // GF uses nonstd 3-letter codes? Pes/Persian:fa, Pnb/Punjabi:pa+ return map(lang1,ls)+ }()++var langname={}+var langcode={}+var langcode2={}+var langcode3={}+for(var i in languages) {+ langname[languages[i].code]=languages[i].name+ langcode[languages[i].name]=languages[i]+ langcode2[languages[i].code]=languages[i].code2+ langcode3[languages[i].code2]=languages[i].code+}++function concname(code) { return langname[code] || code; }+function alangcode(code) { return langcode2[code] || code; }++// Add a country code to the language code+function add_country(code) {+ switch(code) {+ case "en": return "en-US" // "en-scotland" // or "en-GB"+ case "sv": return "sv-SE"+ case "fr": return "fr-FR"+ case "de": return "de-DE"+ case "fi": return "fi-FI"+ case "zh": return "zh-CN"+ case "hi": return "hi-IN"+ case "es": return "es-ES"+ case "it": return "it-IT"+ case "bg": return "bg-BG" // ?+ case "da": return "da-DK"+ case "nb": return "nb-NO"+ case "nl": return "nl-NL"+ case "ja": return "ja-JP"+ case "ro": return "ja-RO"+ case "el": return "el-GR"+ case "th": return "th-TH"+ // ...+ default: return code+ }+}
@@ -0,0 +1,60 @@+++// See http://diveintohtml5.info/storage.html++function supports_html5_storage() {+ try {+ return 'localStorage' in window && window['localStorage'] !== null;+ } catch (e) {+ return false;+ }+}++var fakedLocalStorage = [] // a shared substitute for persistent localStorage++// An interface to localStorage, to store JSON data under a unique prefix+function appLocalStorage(appPrefix,privateStorage) {++ function parse(s,def) {+ try { return JSON.parse(s) } catch(e) { return def }+ }++ function methods(storage) {+ return {+ get: function (name,def) {+ var id=appPrefix+name+ return parse(storage[id]||"",def);+ },+ put: function (name,value) {+ var id=appPrefix+name;+ storage[id]=JSON.stringify(value);+ },+ remove: function(name) {+ var id=appPrefix+name;+ delete storage[id]+ },+ ls: function(prefix) {+ var pre=appPrefix+(prefix||"")+ var files=[]+ for(var i in storage)+ if(hasPrefix(i,pre)) files.push(i.substr(pre.length))+ files.sort()+ return files+ },+ get count() { return this.get("count",0); },+ set count(v) { this.put("count",v); }+ }+ }++ function get_html5_storage() {+ try {+ return 'localStorage' in window+ && window['localStorage']+ || fakedLocalStorage+ } catch (e) {+ return fakedLocalStorage; // fake it+ }+ }++ return methods(privateStorage || get_html5_storage())+}
@@ -0,0 +1,80 @@++/* --- Grammar access object ------------------------------------------------ */++function pgf_online(options) {+ var server = {+ // State variables (private):+ grammars_url: "/grammars/",+ other_grammars_urls: [],+ grammar_list: null,+ current_grammar_url: null,++ // Methods:+ switch_grammar: function(grammar_url,cont) {+ this.current_grammar_url=this.grammars_url+grammar_url;+ if(cont) cont();+ },+ add_grammars_url: function(grammars_url,cont) {+ this.other_grammars_urls.push(grammars_url);+ if(cont) cont();+ },+ switch_to_other_grammar: function(grammar_url,cont) {+ this.current_grammar_url=grammar_url;+ if(cont) cont();+ },+ get_grammarlist: function(cont,err) {+ if(this.grammar_list) cont(this.grammar_list)+ else http_get_json(this.grammars_url+"grammars.cgi",cont,err);+ },+ get_grammarlists: function(cont,err) { // May call cont several times!+ var ds=this.other_grammars_urls;+ var n=1+ds.length;+ function pair(dir) {+ return function(grammar_list){cont(dir,grammar_list,n)}+ }+ function ignore_error(err) { console.log(err) }+ this.get_grammarlist(pair(this.grammars_url),err)+ for(var i in ds)+ http_get_json(ds[i]+"grammars.cgi",pair(ds[i]),ignore_error);+ },+ pgf_call: function(cmd,args,cont,err) {+ var url=this.current_grammar_url+"?command="+cmd+encodeArgs(args)+ http_get_json(url,cont,err);+ },+ + get_languages: function(cont,err) {+ this.pgf_call("grammar",{},cont,err);+ },+ grammar_info: function(cont,err) {+ this.pgf_call("grammar",{},cont,err);+ },+ + get_random: function(args,cont,err) { // cat, limit+ args.random=Math.random(); // side effect!!+ this.pgf_call("random",args,cont,err);+ },+ linearize: function(args,cont,err) { // tree, to+ this.pgf_call("linearize",args,cont,err);+ },+ complete: function(args,cont,err) { // from, input, cat, limit+ this.pgf_call("complete",args,cont,err);+ },+ parse: function(args,cont,err) { // from, input, cat+ this.pgf_call("parse",args,cont,err);+ },+ translate: function(args,cont,err) { // from, input, cat, to+ this.pgf_call("translate",args,cont,err);+ },+ translategroup: function(args,cont,err) { // from, input, cat, to+ this.pgf_call("translategroup",args,cont,err);+ },+ browse: function(args,cont,err) { // id, format+ if(!args.format) args.format="json"; // sife effect!!+ this.pgf_call("browse",args,cont,err);+ }+ };+ for(var o in options) server[o]=options[o];+ if(server.grammar_list && server.grammar_list.length>0)+ server.switch_grammar(server.grammar_list[0]);+ return server;+}
@@ -0,0 +1,424 @@+/* --- Accessing document elements ------------------------------------------ */++function element(id) {+ return document.getElementById(id);+}++/* --- JavaScript tricks ---------------------------------------------------- */++// To be able to use object methods that refer to "this" as callbacks+// See section 3.3 of https://github.com/spencertipping/js-in-ten-minutes/raw/master/js-in-ten-minutes.pdf+function bind(f, this_value) {+ return function () {return f.apply (this_value, arguments)};+};++// Implement Array.isArray for older browsers that lack it.+// https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects/Array/isArray+if(!Array.isArray) {+ Array.isArray = function (arg) {+ return Object.prototype.toString.call(arg) == '[object Array]';+ };+}++// Create a clone of an array+// http://davidwalsh.name/javascript-clone-array+if(!Array.clone) {+ Array.clone = function(arg) {+ return arg.slice(0);+ };+}++// Array Remove - By John Resig (MIT Licensed)+// http://ejohn.org/blog/javascript-array-remove/if(!Array.remove) {+if(!Array.remove) {+ Array.remove = function(arg, from, to) {+ var rest = arg.slice((to || from) + 1 || arg.length);+ arg.length = from < 0 ? arg.length + from : from;+ return arg.push.apply(arg, rest);+ };+}++/* --- JSONP ---------------------------------------------------------------- */++// Inspired by the function jsonp from+// http://www.west-wind.com/Weblog/posts/107136.aspx+// See also http://niryariv.wordpress.com/2009/05/05/jsonp-quickly/+// http://en.wikipedia.org/wiki/JSONP+function jsonp(url,callback)+{+ if (url.indexOf("?") > -1)+ url += "&jsonp="+ else+ url += "?jsonp="+ url += callback;+ //url += "&" + new Date().getTime().toString(); // prevent caching++ var script = empty("script");+ script.setAttribute("src",url);+ script.setAttribute("type","text/javascript");+ document.body.appendChild(script);+}++var json = {next:0};++// Like jsonp, but instead of passing the name of the callback function, you+// pass the callback function directly, making it possible to use anonymous+// functions.+function jsonpf(url,callback,errorcallback)+{+ var name="callback"+(json.next++);+ json[name]=function(x) { delete json[name]; callback(x); }+ jsonp(url,"json."+name);+}++/* --- AJAX ----------------------------------------------------------------- */++function GetXmlHttpObject(handler)+{+ var objXMLHttp=null+ if (window.XMLHttpRequest)+ {+ // See http://www.w3.org/TR/XMLHttpRequest/+ // https://developer.mozilla.org/en/xmlhttprequest+ objXMLHttp=new XMLHttpRequest()+ }+ else if (window.ActiveXObject)+ {+ objXMLHttp=new ActiveXObject("Microsoft.XMLHTTP")+ }+ return objXMLHttp+}++function ajax_http(method,url,body,callback,errorcallback) {+ var http=GetXmlHttpObject()+ if (!http) {+ var errortext="Browser does not support HTTP Request";+ if(errorcallback) errorcallback(errortext,500)+ else alert(errortext)+ }+ else {+ function statechange() {+ if (http.readyState==4 || http.readyState=="complete") {+ if(http.status<300) callback(http.responseText,http.status);+ else if(errorcallback)+ errorcallback(http.responseText,http.status,+ http.getResponseHeader("Content-Type"));+ else alert("Request for "+url+" failed: "+ +http.status+" "+http.statusText);+ }+ }+ http.onreadystatechange=statechange;+ http.open(method,url,true)+ http.send(body)+ }+ return http+}++function ajax_http_get(url,callback,errorcallback) {+ ajax_http("GET",url,null,callback,errorcallback)+}++function ajax_http_post(url,formdata,callback,errorcallback) {+ ajax_http("POST",url,formdata,callback,errorcallback)+ // See https://developer.mozilla.org/En/XMLHttpRequest/Using_XMLHttpRequest#Using_FormData_objects+}++// JSON via AJAX+function ajax_http_get_json(url,cont,errorcallback) {+ ajax_http_get(url, with_json(cont,errorcallback), errorcallback);+}++function ajax_http_post_json(url,formdata,cont,errorcallback) {+ ajax_http_post(url, formdata, with_json(cont,errorcallback), errorcallback);+}++function with_json(cont,errorcallback) {+ return function(txt){+ if(txt) {+ try {+ var json=eval("("+txt+")")+ } catch (e) {+ if(errorcallback)+ errorcallback("JSON parsing problem",500,"text/plain")+ return+ }+ cont(json);+ }+ else {+ if(errorcallback)+ errorcallback("Empty response form server (crash?)",500,"text/plain")+ }+ }+}++function sameOrigin(url) {+ var a=empty("a");+ a.href=url; // converts to an absolute URL+ return hasPrefix(a.href,location.protocol+"//"+location.host+"/");+}++/*+// Use AJAX when possible, fallback to JSONP+function http_get_json(url,cont,errorcallback) {+ if(sameOrigin(url)) ajax_http_get_json(url,cont,errorcallback);+ else jsonpf(url,cont,errorcallback);+}+*/++// For better error handling, always use AJAX, don't fallback to JSONP+// Cross-origin requests are allowed by the PGF service and are supported in+// all modern browsers.+// See http://en.wikipedia.org/wiki/Cross-origin_resource_sharing+function http_get_json(url,cont,errorcallback) {+ ajax_http_get_json(url,cont,errorcallback);+}++/* --- URL construction ----------------------------------------------------- */++function encodeArgs(args) {+ var q=""+ for(var arg in args)+ if(args[arg]!=undefined)+ q+="&"+arg+"="+encodeURIComponent(args[arg]);+ return q;+}++/* --- HTML construction ---------------------------------------------------- */+function text(s) { return document.createTextNode(s); }++function node(tag,as,ds) {+ var n=attr(as,document.createElement(tag));+ if(ds) for(var i in ds) n.appendChild(ds[i]);+ return n;+}++function attr(as,n) {+ for(var a in as) n.setAttribute(a,as[a]);+ return n+}++function empty(tag,name,value) {+ var el=node(tag,{},[])+ if(name && value) el.setAttribute(name,value);+ return el;+}++function empty_id(tag,id) { return empty(tag,"id",id); }+function empty_class(tag,cls) { return empty(tag,"class",cls); }++function div_id(id,cs) { return node("div",{id:id},cs); }+function span_id(id) { return empty_id("span",id); }++function wrap(tag,contents) {+ return node(tag,{},Array.isArray(contents) ? contents : [contents]);+}++function wrap_class(tag,cls,contents) {+ return node(tag,{"class":cls},+ contents ? Array.isArray(contents) ?+ contents : [contents] : [])+}++function span_class(cls,contents) { return wrap_class("span",cls,contents); }+function div_class(cls,contents) { return wrap_class("div",cls,contents); }++function p(contents) { return wrap("p",contents); }+function dt(contents) { return wrap("dt",contents); }+function dd(contents) { return wrap("dd",contents); }+function li(contents) { return wrap("li",contents); }++function th(contents) { return wrap("th",contents); }+function td(contents) { return wrap("td",contents); }++function tr(cells) { return wrap("tr",cells); }++function button(label,action,key) {+ var el=node("input",{"type":"button","value":label},[]);+ if(typeof action=="string") el.setAttribute("onclick",action);+ else el.onclick=action;+ if(key) el.setAttribute("accesskey",key);+ return el;+}++function option(label,value) {+ return node("option",{"value":value},[text(label)]);+}++function hidden(name,value) {+ return node("input",{type:"hidden",name:name,value:value},[])+}++function tda(cs) { return node("td",{},cs); }++function img(src) { return empty("img","src",src); }++function title(t,n) { return attr({title:t},n) }++/* --- Document modification ------------------------------------------------ */++function clear(el) { replaceInnerHTML(el,""); }+function replaceInnerHTML(el,html) { if(el) el.innerHTML=html; }+function replaceChildren(el,newchild) { clear(el); el.appendChild(newchild); }++function appendChildren(el,ds) {+ for(var i in ds) el.appendChild(ds[i]);+ return el;+}++function replaceNode(el,ref) {+ ref.parentNode.replaceChild(el,ref)+}++function insertFirst(parent,child) {+ parent.insertBefore(child,parent.firstChild);+}++function insertBefore(el,ref) { ref.parentNode.insertBefore(el,ref); }++function insertAfter(el,ref) {+ ref.parentNode.insertBefore(el,ref.nextSibling);+}++function toggleHidden(el) {+ if (el.classList.contains("hidden"))+ el.classList.remove("hidden")+ else+ el.classList.add("hidden")+}++// Update the selected options in a menu that allow multiple selections+function updateMultiMenu(menu,selection) {+ var set=toSet(selection)+ var os=menu.options+ for(var i=0;i<os.length;i++)+ os[i].selected=set[os[i].value] || false+}++/* --- Document data extraction --------------------------------------------- */++// List the selected options in a menu that allows multiple selections+function multiMenuSelections(menu) {+ var selection=[]+ var os=menu.options;+ for(var i=0;i<os.length;i++)+ if(os[i].selected) selection.push(os[i].value)+ return selection+}++/* --- Debug ---------------------------------------------------------------- */++function debug(s) {+ var d=element("debug");+ if(d) d.appendChild(text(s+"\n"))+}++function show_props(obj, objName) {+ var result = "";+ for (var i in obj) {+ result += objName + "." + i + " = " + obj[i] + "<br>";+ }+ return result;+}++function field_names(obj) {+ var result = "";+ for (var i in obj) {+ result += " " + i;+ }+ return result;+}++/* --- Data manipulation ---------------------------------------------------- */+function swap(a,i,j) { // Note: this doesn't work on strings.+ var tmp=a[i];+ a[i]=a[j];+ a[j]=tmp;+ return a;+}++function sort(a) {+// https://developer.mozilla.org/en/Core_JavaScript_1.5_Reference/Global_Objects/Array/sort+ return a.sort();+ /* // Note: this doesn't work on strings.+ for(var i=0;i<a.length-1;i++) {+ var min=i;+ for(var j=i+1;j<a.length;j++)+ if(a[j]<a[min]) min=j;+ if(min!=i) swap(a,i,min);+ }+ return a;+ */+}++function filter(p,xs) {+ var ys=[];+ for(var i=0;i<xs.length;i++)+ if(p(xs[i])) ys[ys.length]=xs[i];+ return ys;+}++function implode(cs) { // array of strings to string+ /*+ var s="";+ for(var i=0;i<cs.length;i++)+ s+=cs[i];+ return s;+ */+ return cs.join("");+}++function hasPrefix(s,pre) { return s.substr(0,pre.length)==pre; }++function commonPrefix(s1,s2) {+ for(var i=0;i<s1.length && i<s2.length && s1[i]==s2[i];i++);+ return s1.substr(0,i);+}++/*+function all(p,xs) {+ for(var i=0;i<xs.length;i++)+ if(!p(xs[i])) return false;+ return true;+}+*/++function map(f,xs) {+ var ys=[];+ for(var i=0;i<xs.length;i++) ys[i]=f(xs[i]);+ return ys;+}++// map in continuation passing style+function mapc(f,xs,cont) { mapc_from(f,xs,0,[],cont); }++function mapc_from(f,xs,i,ys,cont) {+ if(i<xs.length)+ f(xs[i],function(y){ys[i]=y;mapc_from(f,xs,i+1,ys,cont)});+ else+ cont(ys);+}++function overlaps(as,bs) {+ for(var i=0;i<as.length;i++)+ if(elem(as[i],bs)) return true;+ return false;+}++function elem(a,as) {+ if (!as) return false;+ for(var i=0;i<as.length;i++)+ if(a==as[i]) return true;+ return false;+}++function shuffle(a) {+ for(i=0;i<a.length;i++) swap(a,i,Math.floor(Math.random()*a.length))+ return a;+}++// Convert an array of strings to a set (for quick & easy membership tests)+function toSet(a) {+ var set={}+ for(var i=0;i<a.length;i++) set[a[i]]=true+ return set+}
@@ -0,0 +1,539 @@++/* --- Wide Coverage Translation Demo web app ------------------------------- */++var wc={}+wc.selected_cnls=[] // list of grammar names+wc.cnls={} // maps grammars names to {pgf_online:...,grammar_info:{...}}+wc.f=document.forms[0]+wc.o=element("output")+wc.e=element("extra")+wc.i=element("grammarinfo")+wc.p=element("pick")+wc.grammarbox=element("grammarbox")+wc.os=[] /* output segment list+ [{input,text:String; from,to::Lang;+ target:Node;+ rs::[TranslationResults];+ current_pick::Int // index into rs or -1+ }] */+wc.cache={} // output segment cache, indexed by source text+wc.translating=""++wc.delayed_translate=function() {+ function restart(){+ if(wc.f.input.value!=wc.translating) wc.translate()+ var h=wc.f.input.scrollHeight,bh=document.body.clientHeight+ if(h>bh) h=bh+ if(wc.f.input.clientHeight<h) wc.f.input.style.height=h+15+"px"+ }+ if(wc.timer) clearTimeout(wc.timer);+ wc.timer=setTimeout(restart,500)+}++wc.clear=function() {+ wc.f.input.value=""+ wc.f.input.style.height=""+ clear(wc.o)+ wc.delayed_translate()+}++wc.save=function() {+ if(wc.local) {+ var f=wc.f+ wc.local.put("from",f.from.value)+ wc.local.put("to",f.to.value)+ wc.local.put("input",f.input.value)+ wc.local.put("colors",f.colors.checked)+ wc.local.put("cnls",wc.selected_cnls)+ }+}++wc.load=function() {+ if(wc.local) {+ var f=wc.f+ f.input.value=wc.local.get("input",f.input.value)+ f.from.value=wc.local.get("from",f.from.value)+ f.to.value=wc.local.get("to",f.to.value)+ f.colors.checked=wc.local.get("colors",f.colors.checked)+ wc.selected_cnls=wc.local.get("cnls",wc.selected_cnls)+ wc.colors()+ wc.delayed_translate()+ }+}++wc.translate=function(redo) {+ // redo=true => discard translated segment cache and resubmit translation+ // requests to the server (browser cache may still be used)+ var f=wc.f, e=wc.e, p=wc.p++ /*+ function disable(yes) {+ f.translate.disabled=yes+ f.to.disabled=yes+ if(f.swap) f.swap.disabled=yes+ }+ */++ function split_punct(s) {+ return s.split(/([.!?]+[ \t\n]+|\n\n+|[ \t\n]*[-•*+#]+[ \t\n]+)/)+ }++ function find_pick(rs) {+ for(var i=0;i<rs.length && !rs[i].t;i++)+ ;+ return i+ }++ function translate_segment(so) { // so = segment output+ so.rs=[] // list of alternative translations for this segment+ so.current_pick= -1 // index of currently selected alternative++ function show_error(msg) {+ //if(e) e.innerHTML="<span class=low_quality>Translation problem: "+msg+"</span>"+ //else+ {+ replaceChildren(so.target,text("["+msg+"]"))+ so.target.className="error"+ }+ //disable(false)+ }+ function show_pick(i) { return function() { show_trans(i); return false; } }+ function show_picks() {+ clear(p)+ for(var i=0;i<so.rs.length;i++) {+ if(so.rs[i].t) {+ var pick=text(i+1) // +"⃝"+ if(i!=so.current_pick) {+ var pick=node("a",{href:"#"},[pick])+ pick.onclick=pick.onmouseover=show_pick(i)+ }+ var q=so.rs[i].t.quality+ p.appendChild(text(" "))+ p.appendChild(span_class("pick "+q,pick))+ }+ }+ if(!so.got_more) p.appendChild(text("..."))+ /*+ p.appendChild(wrap_class("small","pick",+ node("a",{href:wc.google_translate_url(),+ target:"google_translate"},+ [text("Google Translate")])))+ */+ }+ function treetext(tree) {+ function inflect(w,wcls) {+ function show_inflections(lins) {+ if(wc.e2) wc.e2.innerHTML=lins[0].text+ }+ function get_inflections() {+ var tree="MkDocument+%22%22+(Inflection"+wcls+"+"+w+")+%22%22"+ var l=gftranslate.grammar+f.to.value+ gftranslate.call("?command=c-linearize&to="+l+"&tree="+tree,show_inflections)+ }+ var wn=wrap_class("span","inflect",text(w))+ if(wc.e2) wn.onclick=get_inflections+ return wn+ }+ function word(w) {+ var ps=w.split("_")+ var n=ps.length+ return ps.length>1 && elem(ps[n-1],gftranslate.documented_classes)+ ? inflect(w,ps[n-1]) : text(w)+ }+ return tree.split(/([ ()]+)/).map(word)+ }+ function show_more() {+ wc.selected=so+ var r=so.rs[so.current_pick]+ var prob=r.prob<=0 ? "" : r.prob || ""+ if(e) {+ clear(e)+ var speak_from=speech_buttons(so.from,"",so.input)+ var speak_to=speech_buttons(so.to,"",so.text)+ speak_to.className=speak_from.className="speech_buttons"+ e.appendChild(wrap("div",[speak_from,+ text(so.input+" → "+so.text),+ speak_to]))+ e.appendChild(wrap("div",text(prob)))+ if(r.tree) {+ wc.e2=node("div",{id:"tree-container","class":"e2"})+ e.appendChild(wrap("span",treetext(r.tree)))+ /*+ var g=gftranslate.jsonurl+ var u="format=svg&tree="+encodeURIComponent(r.tree)+ var from="&from="+r.grammar+f.to.value+ r.imgurls=[g+"?command=c-abstrtree&"+u,+ g+"?command=c-parsetree&"+u+from]+ if(!r.img) {+ r.img=node("img",{src:r.imgurls[0]},[])+ r.img_ix=0+ r.img.onclick=function() {+ r.img_ix=1-r.img_ix+ r.img.src=r.imgurls[r.img_ix]+ }+ }+ else if(r.img.src!=r.imgurls[r.img_ix]) // language change?+ r.img.src=r.imgurls[r.img_ix]+ wc.e2.appendChild(r.img)+ */+ e.appendChild(wc.e2)+ if(window.d3 && window.d3Tree) window.d3Tree(wc.bracketsToD3(r.jsontree))+ }+ }+ if(wc.p /*&& so.rs.length>1*/) show_picks()+ //if(f.speak.checked) wc.speak(t.text,f.to.value)+ if(!so.got_more) {+ so.got_more=true+ if(so.rs.length<10)+ trans(so.input,so.rs.length,10-so.rs.length)+ }+ }+ so.target.onclick=show_more++ function show_trans(i) {+ var r=so.rs[i]+ if(!r.t) {+ i=find_pick(so.rs)+ r=so.rs[i]+ }+ if(r && r.t) {+ replaceChildren(so.target,text(r.t.text))+ so.text=r.t.text+ so.target.className=r.t.quality+ so.current_pick=i+ if(wc.selected==so) show_more()+ }+ }+ function showit(r,grammar) {+ r.grammar=grammar+ r.t=trans_quality(r,grammar+f.to.value)+ so.rs.push(r)+ var j=so.rs.length-1+ if(so.current_pick<0 || so.current_pick==j) show_trans(j)+ else if(wc.selected==so) show_picks()+ //disable(false)+ }++ function word_for_word(text,cont) {+ function step3(tra) {+ if(tra.length>=1) {+ var r=tra[0]+ r.prob = -1+ if(r.linearizations) showit(r,gftranslate.grammar)+ else if(r.error!=undefined)+ show_error(r.error)+ }+ else if(so.rs.length==0)+ show_error("Unable to translate")+ }+ gftranslate.wordforword(text,f.from.value,wc.languages || f.to.value,step3)+ }++ function trans(text,i,count) {+ function step3(tra) {+ if(tra.length>=1) {+ var r=tra[0]+ if(r.error!=undefined) {+ if(i==0 && so.rs.length==0) {+ //show_error(r.error)+ word_for_word(text)+ }+ }+ else {+ function cmp(a,b) { return a.prob-b.prob; }+ tra=tra.sort(cmp)+ for(var ti=0;ti<tra.length;ti++) {+ var r=tra[ti]+ if(r.linearizations) showit(r,gftranslate.grammar)+ //else show_error("no linearizations")+ }+ }+ }+ else if(i==0 && so.rs.length==0)+ show_error("Unable to translate")+ }+ gftranslate.translate(text,f.from.value,wc.languages || f.to.value,i,count,step3)+ }+ function step2(text) { trans(text,0,10) }+ function step2cnl(text,ix) {+ function step3cnl(results) {+ var trans=results[0].translations+ if(trans && trans.length>=1) {+ for(var i=0;i<trans.length;i++) {+ var r=trans[i]+ r.prob=0+ showit(r,cnl)+ }+ }+ step2cnl(text,ix+1)+ }+ if(ix<wc.selected_cnls.length) {+ var g=wc.cnls[wc.selected_cnls[ix]]+ var gi=g.grammar_info+ var langs=gi.languages.map(function(l) { return l.name; })+ var cnl=gi.name+ var from=cnl+f.from.value,to=cnl+f.to.value+ if(elem(from,langs) && elem(to,langs))+ g.pgf_online.translate({from:from,+ //to:to,+ lexer:"text",unlexer:"text",+ jsontree:true,input:text},+ step3cnl,+ function(){step2cnl(text,ix+1)})+ else step2cnl(text,ix+1)+ }+ else step2(text)+ }+ if(wc.selected_cnls) step2cnl(so.input,0)+ else step2(so.input)+ }++ function change_segment_to(so,to) {+ var rs=so.rs+ if(rs) {+ for(var i=0;i<rs.length;i++)+ rs[i].t=trans_quality(rs[i],rs[i].grammar+to)+ var i=so.current_pick+ if(!rs[i].t) {+ i=find_pick(rs)+ //console.log("Change pick",so.current_pick,i)+ so.current_pick=i+ clear(p)+ wc.selected=null+ }+ var r=rs[i]+ so.text=r.t.text+ replaceChildren(so.target,text(r.t.text))+ so.target.className=r.t.quality+ }+ so.to=to+ }++ //disable(true)+ clear(wc.o)+ clear(e)+ clear(p)+++ var old_selected=wc.selected+ wc.selected=null+ if(redo) {+ wc.cache={}+ var old=wc.cache+ }+ else {+ var old=wc.cache+ for(var i=0;i<wc.os.length;i++) old[wc.os[i].input]=wc.os[i]+ // could also keep all copies if the same text occurs more than once...+ wc.os=[]+ }++ wc.translating=f.input.value+ var is=split_punct(wc.translating+"\n")++ for(var i=0;i<is.length;i++) {+ var same=old[is[i]]+ if(same /*&& same.to==f.to.value*/ && same.from==f.from.value) {+ // reuse an unchanged segment+ wc.os[i]=same+ wc.o.appendChild(same.target)+ if(same==old_selected) wc.selected=same+ delete old[is[i]] // can't use the same node twice+ if(same.to!=f.to.value) change_segment_to(same,f.to.value)+ }+ else {+ // create a new output segment+ var o=wc.os[i]={input:is[i],text:is[i],+ from:f.from.value,to:f.to.value}+ if(i&1) { // punctuation+ o.target=span_class("punct",text(is[i]))+ wc.o.appendChild(o.target)+ }+ else { // text segment to be translated+ o.target=span_class("placeholder",text(is[i]))+ wc.o.appendChild(o.target)+ translate_segment(o)+ }+ }+ }+ wc.save()+ return false;+}++wc.speak=function(text,lang) {+ if(wc.speech) {+ var u=new SpeechSynthesisUtterance(text)+ u.lang=add_country(alangcode(lang))+ speechSynthesis.cancel()+ speechSynthesis.speak(u)+ }+}++wc.colors=function() {+ document.body.className=wc.f.colors.checked ? "colors" : ""+ wc.local.put("colors",wc.f.colors.checked)+}++wc.swap=function() {+ var f=wc.f+ function txt(so) { return so.text }+ f.input.value=wc.os.map(txt).join("").trimRight()+ var from=f.from.value+ f.from.value=f.to.value+ f.to.value=from+ wc.translate()+}++wc.google_translate_url=function() {+ return "http://translate.google.com/"+ +"#"+alangcode(wc.f.from.value)+ +"/"+alangcode(wc.f.to.value)+ +"/"+encodeURIComponent(wc.f.input.value)+}++wc.try_google=function() {+ var w=window.open(wc.google_translate_url(),+ "google_translate")+ w.focus()+}++wc.bracketsToD3=function(bs) {+ if(bs.token) return {name:bs.token}+ else if(bs.other) return {name:bs.other}+ else if(bs.fun) {+ var t={name:bs.fun}+ if(bs.children/* && bs.children.length>0*/)+ t.children=bs.children.map(wc.bracketsToD3)+ return t+ }+ else return {name:"??"}+}++// Update language selection menus with the languages supported by the grammar+wc.init_languages=function () {+ function init2(langs) {+ replaceInnerHTML(wc.i,"Enter text to translate above")+ wc.languages=langs+ var langset=toSet(langs)+ function update_menu(m) {+ var l=m.value+ clear(m)+ for(var i=0;i<langs.length;i++)+ m.appendChild(option(concname(langs[i]),langs[i]))+ if(langset[l]) m.value=l+ }+ update_menu(wc.f.from)+ update_menu(wc.f.to)+ }+ function initerror(errortext,status,ct) {+ var msg = status==404 ? "The wide cover translation grammar was not found on the server" : "Server problem "+status+ replaceChildren(wc.i,text(msg))+ if(wc.i) wc.i.className="error"+ }+ replaceInnerHTML(wc.i,"Loading the wide coverage translation grammar, please wait...")+ gftranslate.get_languages(init2,initerror)+}++wc.init_speech=function() {+ var speak=element("speak")+ if(speak) {+ wc.speech=window.speechSynthesis && window.speechSynthesis.getVoices().length>0+ if(wc.speech) speak.style.display="inline"+ }+}+++wc.show_grammarbox=function() {+ wc.grammarbox.parentNode.style.display="block";+}++wc.hide_grammarbox=function() {+ wc.grammarbox.parentNode.style.display="";+ clear(wc.grammarbox)+}++wc.init_cnl=function(grammar) {+ var g+ if(wc.cnls[grammar]) g=wc.cnls[grammar]+ else g=wc.cnls[grammar]={}+ g.pgf_online=pgf_online({})+ g.pgf_online.switch_grammar(grammar)+ g.pgf_online.grammar_info(function(info){g.grammar_info=info})+}++wc.init_cnls=function() {+ var gs=wc.selected_cnls+ for(var i=0;i<gs.length;i++) wc.init_cnl(gs[i])+}++wc.select_grammars=function() {+ function done() {+ wc.hide_grammarbox()+ var gs=[]+ var glist=list.children+ for(var i=0;i<glist.length;i++)+ if(glist[i].cb.checked) gs.push(glist[i].grammar)+ wc.selected_cnls=gs+ wc.init_cnls()+ wc.local.put("cnls",wc.selected_cnls)+ wc.translate(true)+ }+ function cancel() {+ wc.hide_grammarbox()+ }+ function remove(x,xs) {+ function other(y) { return y!=x; }+ return filter(other,xs)+ }+ function checkbox(grammar,checked) {+ var vb=node("input",{type:"checkbox"})+ vb.checked=checked+ return vb+ }+ function grammar_pick(grammar,checked) {+ var cb=checkbox(grammar,checked)+ var p=[cb,text(" "+grammar.split(".pgf")[0])]+ var dt=node("dt",{class:"grammar_pick"},p)+ dt.cb=cb+ dt.grammar=grammar+ return dt+ }+ function show_list(grammars) {+ var sg=wc.selected_cnls+ for(var i=0;i<sg.length;i++) {+ if(elem(sg[i],grammars))+ list.appendChild(grammar_pick(sg[i],true))+ else+ remove(sg[i],wc.selected_cnls)+ }+ for(var i=0;i<grammars.length;i++)+ if(!elem(grammars[i],wc.selected_cnls))+ list.appendChild(grammar_pick(grammars[i],false))+ }+ + clear(wc.grammarbox)+ wc.grammarbox.appendChild(wrap("h2",[button("X",cancel),text("Select which domain-specific grammars to use")]))+ wc.grammarbox.appendChild(text("These grammars are tried before the wide-coverage grammar. They can give higher quality translations within their respective domains."))+ var list=empty("dl")+ wc.grammarbox.appendChild(list)+ wc.grammarbox.appendChild(button("OK",done))+ wc.grammarbox.appendChild(button("Cancel",cancel))+ wc.show_grammarbox()+ wc.pgf_online.get_grammarlist(show_list)+}++wc.initialize=function(grammar_name,grammar_url) {+ if(grammar_name && grammar_url) {+ gftranslate.grammar=grammar_name+ gftranslate.jsonurl=grammar_url+ }+ wc.init_languages()+ //init_speech()+ setTimeout(wc.init_speech,500) // A hack for Chrome.+ wc.pgf_online=pgf_online({});+ wc.local=appLocalStorage("gf.wc."+gftranslate.grammar+".")+ wc.load()+ wc.init_cnls()+ initialize_sorting(["DT"],["grammar_pick"])+ wc.f.input.focus()+}
@@ -0,0 +1,246 @@+<!DOCTYPE html>+<html> <head>+<title>About Minibar</title>+<link rel=stylesheet type="text/css" href="minibar.css">+<meta charset="UTF-8">+<meta name = "viewport" content = "width = device-width">+<style>+:target .summary { font-weight: bold; background: white; }+</style>+</head>++<body class=minibar>+<h1>About Minibar</h1>++<a href="minibar.html">Minibar</a> is an alternative implementation of the+<a href="http://www.grammaticalframework.org/">GF</a> web app+<a href="http://www.grammaticalframework.org:41296/fridge/">Fridge Poetry</a>.+It doesn't do everything the original Fridge Poetry does (e.g. drag-and-drop is missing),+so I refer to it as a minibar rather than a full refrigerator :-)++<p>+Some implementation details:++<ul class=space>+ <li>It is implemented directly in JavaScipt. It does not use Google Web Toolkit or any big JavaScript libraries.+ <li>It has been tested and found to work in the following browsers:+ <ul>+ <li>On the Mac: Firefox 3.5 & 3.6, Safari 4.0, Opera 10.10 and+ Google Chrome 4.0.249.49.+ <li>On Linux: Firefox 3.0.18 & 3.5, Opera 10.10.+ <li>On the Android Dev Phone: Android Mobile Safari 3.0.4 & 3.1.2+ and Android Opera Mini 4.2.+ </ul>+ It does not seem work in Internet Explorer 7+ (there are both styling and scripting issues).+ There seems to be some rendering bugs in Chrome 5.0.342.9 β.+ <li>The implementation consist of two JavaScript files:+ <a href="minibar.js">minibar.js</a> and <a href="../js/support.js">support.js</a>+ The latter is also used in+ <a href="http://spraakbanken.gu.se/swe/forskning/saldo/ordspel">a couple of+ small web apps</a> based on the+ <a href="http://spraakbanken.gu.se/sal/ws/">SALDO web services</a>.+ <li>To access the GF web service, it uses the+ <a href="http://en.wikipedia.org/wiki/JSONP">JSONP method</a>+ mentioned in the GF+ web services paper, which allows the web app to be hosted on a different server+ from the GF web service. (To demonstrate this, I put the Minibar demo on+ www.cs.chalmers.se, while the GF server that it calls is on+ www.grammaticalframework.org.)+ <li>As an experiment, it does no use the <code>grammars.xml</code> file,+ but instead calls a little CGI script,+ <a href="http://www.grammaticalframework.org:41296/grammars/grammars.cgi.txt">grammars.cgi</a>+ which lists the .pgf files in the directory, in JSONP format.+ (Note: if you want to install this on your own computer,+ <ul>+ <li>if you click on the link,+ the CGI script will be downloaded as <code>grammars.cgi.txt</code>,+ but it should be called <code>grammars.cgi</code> and stored on the server+ in the same directory as the grammar files.+ <li>for CGI scripts to work with lighttpd, <code>"mod_cgi"</code> needs+ to be included in the definition of <code>server.modules</code> in the+ <code>lighttpd.conf</code> file.)+ </ul>+ <li>[Added 2010-02-16] There is a button for generating random sentences.+ <li>[Added 2010-02-23] All translations are shown, not just the first one,+ if there are multiple parses.+ <li>[Added 2010-02-25] Next to each translation, there is now a little tree+ icon that you can click on to see a drawing of an abstract syntax tree or a+ parse tree. If you click on a drawing it collapses back into a tree icon.+ <li>[Added 2010-04-09] Preparations to support different ways to access the+ grammar: currently we access a PGF server via JSONP, but I would also like+ to support AJAX, and local/downloaded JavaScript grammars.+ <li>[Added 2010-04-19] A text entry field appears when you click in+ the sentence area (with a dashed border). This allows you to enter words by+ typing on the keyboard. As you start typing word magnets that don't match what+ you are typing are removed. When only one magnet remains, you can press enter+ to complete the word.+ <li>[Added 2010-04-19] There is a menu for choosing the output language:+ you can pick "All" to translate to all available languages, or pick one+ particular language.+ <li>[Added 2010-04-19] You can pass options to the function+ <code>start_minibar</code> to customize the user interface. The default is+ <code>{show_abstract:true,show_trees:true}</code> to show the abstract syntax+ of parsed sentences, and to show icons that expand to syntax/parse trees next+ each translation.+ These features can be turned off by setting the fields to <code>false</code>.+ <li>[Added 2010-04-30] The grammar menu is omitted if there is only one+ grammar in the grammar list.+ <li>[Added 2010-04-30] Fewer hardwired constants and new+ <code>start_minibar</code> options (server, grammars_url, grammar_list,+ show_grouped_translations, delete_button_text) to make+ <code>minibar.js</code> more resuable.)+ <li>[Added 2010-05-26] The magnets are now created with+ <code><input type=button></code> tags to make them clickable in more+ browsers.+ <li>[Added 2010-05-26] The text entry field is now visible from the start,+ and it is removed when no more words can be added to the sentence. When you+ press enter, a word is added if there is only one magnet left,+ <em>or</em> if what you have entered exactly matches one of the remaining+ magnet.+ <li>[Added 2010-05-28] Added a link to make it easy to try the same sentence in+ <a href="http://translate.google.com">Google Translate</a>.This can be+ turned off by passing the option <code>{try_google:false}</code> to+ <code>start_minibar</code>.+ <li>[Added 2010-06-02] Added support for Help and Feedback buttons, controlled+ by the options <code>feedback_url</code> and <code>help_url</code> passed to+ <code>start_minibar</code>.+ <li>[Added 2010-06-02] New option: <code>default_source_language</code>.+ <li>[Added 2010-09-10] Minibar now automatically uses+ <a href="http://en.wikipedia.org/wiki/XMLHttpRequest">XHR</a>+ instead of JSONP when possible (i.e. when the HTML document and the+ PGF service are on the same server).+ <li>[Added 2010-09-10] The default input language is now the user's preferred+ language, if possible. This is implemented by consulting the+ <code>userLanguage</code> field in the grammar info output by pgf-server.+ <li>[Added 2010-10-27] Keyboard input and completion should now work much+ more smoothly:+ <ul>+ <li>When you press space, the current word will be completed (if incomplete)+ and a new magnet will be created. If there is more than one possible+ completion, no magnet is created, but the common prefix of the possible+ completions is added to the text box.+ <li>Instead of asking the server for possible completions every time a new+ letter is added to the curent word, minibar only ask for completions for+ whole words and then filters the list locally when more letters are entered,+ speeding things up when server responses are slow.+ </ul>+ <li>[Added 2010-10-27] Code restructuring:+ <ul>+ <li>The PGF server API has been moved to its own file:+ <a href="../js/pgf_online.js">pgf_online.js</a>. This+ allows it to be reused in other applicaitons without importing the entire+ minibar. It also allows minibar to be used with different server+ interfaces. <a href="minibar.html">minibar.html</a> has been updated to+ show how you use the new <a href="minibar.js">minibar.js</a> and+ <a href="../js/pgf_online.js">pgf_online.js</a>.+ <li>The minibar code has been rewritten to avoid storing state information+ in the document tree and accessing it by referring to named document+ elements. The code now also avoids using string literals containing+ the names of top-level functions to specify event handlers for buttons+ and menus. (The code is no longer introspective, so α conversion+ will not change its meaning.)+ </ul>+ <li>[Added 2010-11-09] Some new documentation:+ <ul>+ <li><a href="gf-web-api-examples.html">gf-web-api-examples.html</a>:+ examples illustrating the PGF server API provided by+ <a href="../js/pgf_online.js">pgf_online.js</a>.+ <li><a href="example.html">example.html</a>: a minimal example of a web+ page that uses <a href="../js/pgf_online.js">pgf_online.js</a> to talk to the+ PGF server.+ </ul>+ <li>[Added 2011-03-03] Added a button to display word alignment.+ <li>[Changed 2011-03-22] Don't force focus to the typed input field+ after every word. On touch-based devices, the on-screen keyboard kept+ popping up after every word, which was very annoying if you were+ entering a sentence by tapping on the magnets.+ <li>[Changed 2011-08-03] Moved the initialization code in minibar.html to+ <a href="minibar_online.js">minibar_online.js</a>.+ <li>[Changed 2011-08-08] For improved modularity and reusability,+ two smaller objects have been factored out from the Minibar object:+ Input and Translations. These have been placed in two separate files:+ <a href="minibar_input.js">minibar_input.js</a> and+ <a href="minibar_translations.js">minibar_translations.js</a>.+ Some common auxiliary functions have also been moved to a separate file:+ <a href="minibar_support.js">minibar_support.js</a>.+ <li>[Added 2011-08-09] Added some <a href="minibar-api.html">Minibar API</a>+ documentation.+ <li>[Changed 2011-08-22] Quick fix to allow literals to be entered:+ if you press Enter, the current word will be accepted, even if there are no+ matching completions.+ (You can now use names of people when constructing sentences in the Letter+ grammar, for example.)+ <li>[Added 2011-10-18] Added a button to display some grammar info and a+ start category menu. The start category menu can be turned off by passing+ the option <code>{startcat_menu:false}</code> when starting the minibar.+ <li>[Added 2012-02-10] New minibar option <code>initial_grammar</code> to+ control which of the available grammars is selected initially.+ <li>[Added 2012-03-08] Added the option+ <code>{tree_img_format: <var>fmt</var>}</code>+ to make it easy to select <code>"gif"</code>, <code>"png"</code> or+ <code>"svg"</code> output+ for abstract synax trees, parse trees and word alignment diagrams.+ <li>[Added 2012-03-19] Minibar now remembers the most recently used grammar+ and automatically selects it the next time you return to the minibar.+ (This is implemented using localStorage, i.e. the data is stored locally on+ the user's device.)+ <li>[Added 2012-03-26] Support for adding grammars from several servers to+ the grammar menu. You can also add grammars from several directories on the+ same server of course. The included minibar configuration file adds the+ user's own grammars from the grammar editor.+ <li id=wordforword>+ [Added 2012-04-02] <span class=summary>Word-for-word replacements</span>:+ when a complete and+ unambiguous sentence has been entered, the words glow blue and when you+ click on one, possible replacements appear. (Replacements are shown as names+ of functions in the abstract syntax for now. They should be shown as words+ in the concrete syntax instead.) When you click on a replacement word,+ the sentence is reconstructed with the new word, adjusting other words+ as needed for agreement. This functionality is activated by passing the+ option <code>{word_replacements:true}</code> when starting the minibar.+ <li>[Added 2012-04-03]+ If you leave the minibar and later return, the previous input will be+ restored. One input string per grammar is remembered, so you can also switch+ back and forth between grammars without losing the input.+ (This is implemented using localStorage, i.e. the data is stored locally on+ the user's device.)+ <li>[Added 2012-04-04] Grammar editor integration: as part of the+ word-for-word replacement interface, minibar can now show a button for+ extending the grammar with a new word. This is activated by passing the+ option <code>{extend_grammar:<var>func</var>}</code> when starting the+ minibar, where <var>func</var> is the editor function to call+ (to be document further).+ <li>[Added 2012-04-18] Added buttons to use generated translations as input.+ (This functionality is available in the original Fridge Poetry, but has+ been missing in Minibar, until now.)+ <li>[Added 2012-11-23] Added support for switching back and forth between the+ minibar and the new syntax tree editor. The default configuration in+ <code>minibar_online.js</code> shows how to enable it.+ <li>[Added 2012-11-29] After pressing the <strong>i</strong> button to view+ grammar info, there is now a <strong>More info</strong> button to get+ more detailed information about all categories and functions in the+ grammar.+ <li>[Added 2013-03-25] Initial support for selecting an arbitrary subset+ of languages to appear in the translations and in word alignment+ diagrams.+ <li>[Added 2013-03-26] Parse tree visualizations: click once to show parse+ trees without function names. Click again to add function names.+ <li>[Added 2013-03-27] Click on a linearization to obtain a table with all+ variants and forms. Click again to hide the table.+ <li>[Added 2013-04-02] Abstract syntax tree visualizations: click once to+ show abstract syntax trees without category names. Click again to add+ category names.+ <li>[Added 2013-04-02] Minibar now remembers from one visit to the next+ the selected set of target languages for each grammar.+</ul>++<hr>+<div class=modtime><small>+<!-- hhmts start -->Last modified: Tue Apr 2 15:49:32 CEST 2013 <!-- hhmts end -->+</small></div>+<address>+<a href="http://www.cse.chalmers.se/~hallgren/">TH</a>+<img src="http://www.altocumulus.org/~hallgren/online.cgi?icon" alt="">+</address>+</body> </html>
binary file changed (absent → 138 bytes)
binary file changed (absent → 36233 bytes)
@@ -0,0 +1,57 @@+<!DOCTYPE html>+<html> <head>+<title>PGF online server example</title>+<style type="text/css">+body { background: #ddd; }+h1, h2, h3, small, th { font-family: sans-serif; }+div.modtime { float: right; }+.modtime { color: #666; white-space: nowrap; }+</style>+<script type="text/JavaScript" src="../js/support.js"></script>+<script type="text/JavaScript" src="../js/pgf_online.js"></script>+<script type="text/JavaScript">++var server_options={+ grammars_url: "http://www.grammaticalframework.org/grammars/",+ grammar_list: ["Foods.pgf"]+}+var pgf_server = pgf_online(server_options);++function call_server() {+ pgf_server.parse({from:"FoodsEng",input:document.forms[0].input.value},+ show_output)+}++function show_output(parsed) {+ document.getElementById("output").innerHTML=parsed[0].trees[0]+}++</script>++</head>++<body>+<h1>PGF online server example</h1>++<form onsubmit="call_server(); return false">+Input:+<input name=input size=50 value="this cheese is expensive">+<input type=submit value=Parse>++<p>+Output:+<span id=output></span>+</form>+++<h2>Documentation</h2>+<ul>+ <li><a href="gf-web-api-examples.html">GF Web API examples</a>+</ul>++<hr>+<div class=modtime><small>+<!-- hhmts start -->Last modified: Tue Nov 20 13:42:21 CET 2012 <!-- hhmts end -->+ </small></div>+<address><a href="http://www.cse.chalmers.se/~hallgren/">TH</a></address>+</body> </html>
@@ -0,0 +1,44 @@+#!/bin/bash++bin=bin+AUTOHEADER=no+. $bin/cgistart.sh++save_feedback() {+getquery++if [ -n "$feedback_path" ] && + echo "t=$(date +%F+%T)&ip=$REMOTE_ADDR&$query&accept_language=$HTTP_ACCEPT_LANGUAGE&user_agent=$(echo -n $HTTP_USER_AGENT | plain2url)" >> "$feedback_path"+then ++ pagestart "Thank you!"+ echo "Your feedback has been saved."+ begin script type="text/javascript"+ echo "setTimeout(function(){window.close()},4000);"+ end+ pageend++else++ pagestart "Feedback error"+ echo "Your feedback could not be saved. Sorry."+ p+ tag 'input type=button onclick="javascript:history.back()" value="<- Go back"'+ pageend++fi+}++view_feedback() {+ charset="UTF-8"+ pagestart "Collected Feedback"+ begin pre class=feedbacklist+ Reg show reverse drop color_depth,pixel_depth,outer_size,inner_size,available_screen_size urlmatch-v 'from=&input=&improvement=&comment=' urlmatch-v 'user_agent=*Googlebot*' from-url <"$PATH_TRANSLATED" | plain2html+ end+ pageend+}++case "$PATH_TRANSLATED" in+ "") save_feedback ;;+ *) view_feedback+esac
@@ -0,0 +1,49 @@+<!DOCTYPE html>+<html> <head>+<title>Feedback</title>+<link rel=stylesheet type="text/css" href="minibar.css">+<script type="text/JavaScript" src="../js/support.js"></script>+<script type="text/JavaScript" src="minibar_support.js"></script>+<script type="text/JavaScript" src="minibar.js"></script>+<meta name = "viewport" content = "width = device-width">++</head>++<body class=minibar onload="prefill_feedback_form()">++<h2><span id=grammar></span> Feedback</h2>++<form class=feedback name=feedback action="feedback.cgi" method="post">+<input type=hidden name="grammar">++<p>+<input type=hidden name="from"> <span class=field id=from>...</span> input:+<input type=hidden name="input"> <span class=field id=input>...</span>++<div id=translation_box>+<p><input type=hidden name="to"> <span class=field id="to">...</span> translation:+<input type=hidden name="translation"> <span class=field id=translation>...</span>++<p><label accesskey="S">Suggest a better translation:+<textarea rows=3 name="improvement"></textarea></label>+</div>++<p><label accesskey="C">Comments:+<br><textarea rows=5 name="comment"></textarea></label>++<p>+<input type=submit value="Submit Feedback">+<input type=button value="Cancel" onclick="window.close()">+++<input type=hidden name="inner_size">+<input type=hidden name="outer_size">+<input type=hidden name="screen_size">+<input type=hidden name="available_screen_size">+<input type=hidden name="color_depth">+<input type=hidden name="pixel_depth">++</form>+</body>++</html>
@@ -0,0 +1,259 @@+<!DOCTYPE html>+<html>+<head>+<title>GF web services API examples</title>+<meta charset="UTF-8">+<meta name = "viewport" content = "width = device-width">++<style type="text/css">+body { background: #eee; }+h1, h2, h3, small, th { font-family: sans-serif; }+th { text-align: left; }+h1,h2 { border-bottom: 2px solid black }+dt { background: #cef; }+code { background: #ffc; }+dt.js { background: white; margin-bottom: 1ex; }+dt.js em { color: #36f; }+dd { background: #ffc; margin-top: 1ex; margin-bottom: 1ex; }++dl.apiexamples>dt, dl.apiexamples>dd { font-family: monospace; }+dl.apiexamples>dd { white-space: pre; }++table.border { border-collapse: collapse; margin-top: 1ex; margin-bottom: 1ex; }+table.border td, table.border th { border: 1px solid black; background: #fcfcfc; }++div.modtime { float: right; }+.modtime { color: #666; white-space: nowrap; }++</style>++<body>+<h1>Minibar API</h1>++The Minibar web app consists of the following objects:++<ul>+ <li><a href="#Minibar">Minibar</a>+ <li><a href="#Input">Input</a>+ <li><a href="#Translations">Translations</a>+</ul>++They are described below.++<h2 id=Minibar>The Minibar object</h2>++<p>+This object implements the complete Minibar web app. It is defined in+<a href="minibar.js">minibar.js</a>. It also uses the <code>Input</code>+and <code>Translations</code> objects described below, and some auxiliary+functions defined in <a href="minibar_support.js">minibar_support.js</a>+and <a href="../js/support.js">support.js</a>, so to use it in an+HTML file, you would normally include at least the following:++<blockquote><pre>+<script type="text/JavaScript" src="minibar.js"></script>+<script type="text/JavaScript" src="minibar_input.js"></script>+<script type="text/JavaScript" src="minibar_translations.js"></script>+<script type="text/JavaScript" src="minibar_support.js"></script>+<script type="text/JavaScript" src="../js/support.js"></script>+</pre></blockquote>++<p>+For an example, see <a href="minibar.html">minibar.html</a>.++<h3>Constructor</h3>++<code>var minibar=new Minibar(server,options,target)</code>++<ul>+ <li><code>server</code> is the PGF service object.+ <li><code>options</code> is an object where the following properties+ can be set to override various default options:+ <table class=border>+ <tr><th>Option<th>Default<th>Description+ <tr><td>show_abstract<td>false<td rowspan=6>See Translations,+ not used directly by Minibar+ <tr><td>show_trees<td>false+ <tr><td>tree_img_format<td>"png"+ <tr><td>show_grouped_translations<td>true+ <tr><td>show_brackets<td>false+ <tr><td>translate_limit<td>25++ <tr><td>delete_button_text<td>"⌫"<td rowspan=5>See Input,+ not used directly by Minibar+ <tr><td>default_source_language<td>null+ <tr><td>startcat_menu<td>true+ <tr><td>random_button<td>true+ <tr><td>word_replacements<td>false+ <tr><td>try_google<td>true<td>Include a button to try the current+ sentence in Google Translate+ <tr><td>feedback_url<td>null<td>Include a button to open a feedback+ form. The HTTP server must be configured to handle form submissions+ for this to work.+ <tr><td>help_url<td>null<td>Include a button to open a help text.+ </table>+ <li><code>target</code> is the <code>id</code> of the HTML element inside+ which the minibar user interface is created. It can be omitted if+ the <code>id</code> is <code>minibar</code>. The HTML document should+ contain something like this:+ <blockquote><code><div id="minibar"></div></code></blockquote>+</ul>++<h3>Methods</h3>+There are several internal methods, but since this is a self-contained+web app, there is usually no need to call any methods from outside.++<h2 id=Input>The Input object</h2>++This object handles user input. Text can be entered by typing or by clicking+on the "refrigerator magnets".+<p>+It is defined in+<a href="minibar_input.js">minibar_input.js</a>.+It also uses some auxiliary functions defined+in <a href="minibar_support.js">minibar_support.js</a>+and <a href="../js/support.js">support.js</a>, so to use it in an+HTML file, you would normally include at least the following:++<blockquote><pre>+<script type="text/JavaScript" src="minibar_input.js"></script>+<script type="text/JavaScript" src="minibar_support.js"></script>+<script type="text/JavaScript" src="../js/support.js"></script>+</pre></blockquote>++<h3>Constructor</h3>++<code>var input=new Input(server,translations,options)</code>++<ul>+ <li><code>server</code> is the PGF service object+ <li><code>options</code> is an object where the following properties+ can be set to override various default options:+ <table class=border>+ <tr><th>Option<th>Default<th>Description+ <tr><td>delete_button_text<td>"⌫"<td>The label for the button that deletes the last word.+ <tr><td>default_source_language<td>null<td>The concrete language to+ use for input in case the user's browers doesn't supply a suitable+ default. If none is provided the first language in alphabetical+ order will be used.+ <tr><td>startcat_menu<td>true<td>Include a menu to choose which start+ category to use for parsing (instead of the grammar's default start+ category).+ <tr><td>random_button<td>true<td>Include a button to generate a+ random sentence.+ <tr><td>word_replacements<td>false<td>Enable+ <a href="about.html#wordforword">word-for-word replacements</a>.+ (This is an experimental feature.)+ </table>++ <li><code>translations</code> is the object that is notified when the input+ has changed. In the minibar, this is the object that display translations, but+ other apps might of course use the entered text for other purposes.+ The following methods will be called:+ <ul>+ <li><code>translations.clear()</code> is called when there is no entered+ text.+ <li><code>translations.translateFrom({from:<var>conc</var>,input:<var>string</var>})</code>+ is called when the user has entered some text. The <code>from</code>+ property is the name of the concrete syntax and the <code>input</code>+ property is the entered text.+ </ul>+</ul>++<h3>Properties and user interface</h3>++The <code>input</code> object created by the <code>Input</code> constructor+contains the following fields that the caller should add to the user interface:+<ul>+ <li><code>input.main</code> is the main user interface where the current+ input and the refrigerator magnets are displayed.+ <li><code>input.menus</code> contains the menu for selecting input language.+ <li><code>input.buttons</code> contains+ buttons for deleting the last word, clearing the input and generating+ a random sentence (if enabled in the options).+</ul>++<h3>Methods</h3>++<ul>+ <li><code>input.change_grammar(grammar_info)</code> should be called+ after a different grammar is selected in the <code>server</code> object. It+ will clear away old input and magnets, and update the input language menu+ with the languages available in the new grammar.++</ul>++<h2 id=Translations>The Translations object</h2>++This object displays translations. It is defined in+<a href="minibar_translations.js">minibar_translations.js</a>.+It also uses some auxiliary functions defined+in <a href="minibar_support.js">minibar_support.js</a>+and <a href="../js/support.js">support.js</a>, so to use it in an+HTML file, you would normally include at least the following:++<blockquote><pre>+<script type="text/JavaScript" src="minibar_translations.js"></script>+<script type="text/JavaScript" src="minibar_support.js"></script>+<script type="text/JavaScript" src="../js/support.js"></script>+</pre></blockquote>++<h3>Constructor</h3>+<code>var translations=new Translations(server,options)</code>+<ul>+ <li><code>server</code> is the PGF service object.+ <li><p><code>options</code> is an object where the following properties+ can be set to override various default options:+ <table class=border>+ <tr><th>Option<th>Default<th>Description+ <tr><td>show_abstract<td>false<td>show the abstract syntax in addition+ to the concrete syntax for the translations+ <tr><td>show_trees<td>false<td>add buttons to display syntax trees+ next to translations.+ <tr><td>tree_img_format<td>"png"<td>format for trees & alignment images,+ can be "gif", "png" or "svg"+ <tr><td>show_grouped_translations<td>true<td>in case there are+ multiple translations, group them by concrete language+ <tr><td>show_brackets<td>false<td>show bracketed string+ <tr><td>translate_limit<td>25<td>maximum number of parse trees to retrieve </table>++</ul>++<h3>Properties and user interface</h3>+++The <code>translations</code> object created by the <code>Translations</code>+constructor contains the following fields that the caller should add to+the user interface:+<ul>+ <li><code>translations.main</code> is the main user interface where the current+ translations are displayed.+ <li><code>translations.menus</code> contains the menu for selecting+ a target language. The user can select <em>All</em> or one particular+ language.+</ul>++<h3>Methods</h3>+<ul>+ <li><code>translations.change_grammar(grammar_info)</code> should be called+ after a different grammar is selected in the <code>server</code> object. It+ will clear away old translations and update the target language menu+ with the languages available in the new grammar.+ <li><code>translations.clear()</code> clears the main output area from old translations.+ <li><code>translations.translateFrom({from:<var>conc</var>,input:<var>string</var>})</code>+ displays translations of the text given in the <code>input</code>+ property (as an array of words)+ from the concrete syntax indicated by the <code>from</code>.+</ul>+++<hr>+<div class=modtime>+<small class=modtime>+HTML <!-- hhmts start -->Last modified: Tue Nov 27 15:03:15 CET 2012 <!-- hhmts end -->+</small>+</div>++<address>+<a href="Http://www.cse.chalmers.se/~hallgren/">TH</a>+</address>
@@ -0,0 +1,92 @@+body.minibar {+ background: #ccc url("brushed-metal.png");+}++h1, h2, h3, small, th { font-family: sans-serif; }+h1, h2, h3 { color: #303030; text-shadow: rgba(0,0,0,0.25) 3px 3px 5px; }++h1:first-child, h2:first-child { margin-top: 0; margin-bottom: 1ex; }++th, td { vertical-align: baseline; text-align: left; }++div.menubar { font-family: sans-serif; font-size: small; }++div#surface {+ min-height: 3ex;+ margin: 5px;+ padding: 5px;+ border: 3px dashed #e0e0e0;+}++div#words {+ min-height: 3ex;+ margin: 5px;+ padding: 6px;+ border: 3px solid #e0e0e0;+}++div.word, span.word, div#words div, div#words input[type=button], div#surface input[type=button] {+ display: inline-block;+ font-family: sans-serif;+ font-size: 100%;+ background-color: white;+ border: 1px solid black;+ padding: 3px;+ margin: 3px;+ box-shadow: 2px 2px 4px rgba(0,0,0,0.3);+}+div#surface span.editable, div#surface input[type=button] {+ color: blue;+ border-color: blue;+ box-shadow: 2px 2px 4px rgba(0,0,255,0.5);+ cursor: pointer;+}+++.invalid { color: red; }++div.modtime { float: right; }+.modtime { color: #666; white-space: nowrap; }++ul.space>li { margin-top: 0.75ex; }++div#saldospel input[type=button] { font-size: 100%; }++div#saldospel input.correct { color: green; }+div#saldospel input.incorrect { color: red; }++#surface input[type=text] { width: 5em; }++.feedback textarea { width: 95%; }++span.field { background-color: #eee; }++pre.feedbacklist { background: white }++img.button { padding: 1px; }++div.brackets {+ margin: 5px;+}++span.brackets {+ background: #ddd;+ display: inline-block;+ border-color: black;+ border-style: solid;+ border-width: 0 0 1px 0;+ /*border: 1px solid black;*/+ padding: 2px 3px;+}++div.brackets .token {+ padding: 0 0.5ex;+}++div.browse, table.browse td {+ background: white;+ padding: 2px;+}++table.lintable { display: inline-table; border-collapse: collapse; }+table.lintable td { border: 1px solid black; padding: 2px; }
@@ -0,0 +1,52 @@+<!DOCTYPE html>+<html>+<head>+<title>Minibar</title>+<link rel=stylesheet type="text/css" href="minibar.css">+<link rel=stylesheet type="text/css" href="../syntax-editor/editor.css">++<link rel=author href="http://www.cse.chalmers.se/~hallgren/" title="Thomas Hallgren">++<meta name = "viewport" content = "width = device-width">+<meta charset="UTF-8">++</head>++<body class=minibar>+<h2>Minibar online</h2>+<div id=minibar></div>+<div id=syntax_editor></div>++<noscript>This page doesn't works unless JavaScript is enabled.</noscript>++<hr>++<small>+[<a href="about.html">About Minibar</a><!--+| <a href="http://www.grammaticalframework.org:41296/fridge/">Original Fridge Poetry</a>+& <a href="http://www.grammaticalframework.org:41296/translate/">Translator</a>-->]+</small>+<small class=modtime>+HTML <!-- hhmts start -->Last modified: Wed Oct 10 14:14:10 CEST 2018 <!-- hhmts end -->+</small>++<div id="debug" class="hidden"></div>++<script type="text/javascript" src="config.js"></script> <!-- optional -->+<script type="text/JavaScript" src="../js/grammar_manager.js"></script>+<script type="text/JavaScript" src="../js/support.js"></script>+<script type="text/JavaScript" src="../js/localstorage.js"></script>+<script type="text/JavaScript" src="../js/langcode.js"></script>+<script type="text/JavaScript" src="minibar.js"></script>+<script type="text/JavaScript" src="minibar_input.js"></script>+<script type="text/JavaScript" src="minibar_translations.js"></script>+<script type="text/JavaScript" src="minibar_support.js"></script>+<script type="text/JavaScript" src="../js/pgf_online.js"></script>+<script type="text/javascript" src="../syntax-editor/ast.js"></script>+<script type="text/javascript" src="../syntax-editor/editor_menu.js"></script>+<script type="text/javascript" src="../syntax-editor/editor.js"></script>+<script type="text/javascript" src="minibar_online.js"></script>+<script type="text/javascript" src="../gfse/gf_abs.js"></script>++</body>+</html>
@@ -0,0 +1,332 @@+/* minibar.js+needs: minibar_support.js, minibar_input.js, minibar_translations.js, support.js+*/++/*+// This is essentially what happens when you call start_minibar:+if(server.grammar_list) grammars=server.grammar_list;+else grammars=server.get_grammarlist();+show_grammarlist(grammars)+select_grammar(grammars[0])+grammar_info=server.get_languages()+show_languages(grammar_info)+new_language()+complete_output=get_completions()+show_completions(complete_output)+*/++// For backward compatibility:+function start_minibar(server,opts,target) {+ if(target) opts.target=target;+ return new Minibar(server,opts);+}++/* --- Main Minibar object -------------------------------------------------- */+function Minibar(server,opts) {+ // Contructor, typically called when the HTML document is loaded++ /* --- Configuration ---------------------------------------------------- */++ // default values for options:+ this.options={+ target: "minibar",+ try_google: true,+ feedback_url: null,+ help_url: null,+ initial_grammar: null+ }++ // Apply supplied options+ this.server=server;+ if(opts) for(var o in opts) this.options[o]=opts[o];++ // LocalStorage+ this.local=appLocalStorage("gf.minibar.")++ /* --- Syntax editor integration ---------------------------------------- */+ if(!this.options.abstract_action) this.integrate_syntax_editor()++ /* --- Creating the components of the minibar --------------------------- */+ this.translations=new Translations(server,this.options)+ this.input=new Input(server,this.translations,this.options)++ /* --- Creating user interface elements --------------------------------- */++ this.menubar=div_class("menubar");+ this.extra=div_id("extra");++ this.minibar=element(this.options.target);+ this.minibar.innerHTML="";+ with(this) {+ appendChildren(menubar,[input.menus,translations.menus,input.buttons])+ appendChildren(minibar,[menubar,input.main,translations.main,extra]);+ if(options.help_url)+ menubar.appendChild(button("Help",bind(open_help,this)));+ append_extra_buttons(extra,options);+ }+ this.set_hidden = function(b) {+ this.hidden=b+ this.minibar.style.display= b ? "none" : ""+ }+ this.hide = function() { this.set_hidden(true); }+ this.show = function() { this.set_hidden(false); }++ /* --- Minibar client state initialisation ------------------------------ */+ this.grammar=null;++ /* --- Main program, this gets things going ----------------------------- */+ with(this) {+ server.get_grammarlists(bind(show_grammarlist,this));+ }+}++Minibar.prototype.integrate_syntax_editor=function() {+ var minibar=this+ var editor_target="syntax_editor"+ var e=element(editor_target)+ if(!e || !window.Editor) return++ e.style.display="none"+ minibar.options.abstract_action=function(tree) {+ function not_all(s) { return s!="All" }+ var languages=filter(not_all,minibar.translations.toLangs)+ var editor_options = {+ target: editor_target,+ show_grammar_menu: minibar.grammars.length>1,+ show_startcat_menu: minibar.input.options.startcat_menu,+ initial: { grammar: minibar.grammar_menu.value, // hmm+ startcat: minibar.input.startcat_menu.value, // hmm+ languages: languages,+ abstr: tree+ },+ lin_action: function(new_input,langFrom) {+ console.log(editor.menu.ui.grammar_menu.value)+ var grammar_url=editor.menu.ui.grammar_menu.value // hmm+ || minibar.server.current_grammar_url // hmm+ var startcat=editor.get_startcat()+ || minibar.input.startcat_menu.value // hmm+ var toLangs=gm.languages // hmm+ minibar.input.set_input_for(grammar_url,+ {from:langFrom,+ startcat:startcat,+ input:gf_lex(new_input)})+ minibar.translations.set_toLangs_for(grammar_url,toLangs)++ //Better: keep editor around and reactivate it next time:+ editor.hide()+ // ...++ //Easier: delete the editor and create a new one next time:+ clear(editor.container)+ editor=minibar.editor=null;++ // Even if the grammar is the same as before, this call is+ // what eventually triggers the new_input to be loaded:+ minibar.select_grammar(grammar_url)++ // Make the minibar visible again+ minibar.show()+ }+ }+ minibar.hide()+ var gm = new GrammarManager(minibar.server,editor_options);+ var editor=minibar.editor=new Editor(gm,editor_options)+ editor.show()+ }+}++Minibar.prototype.get_current_input=function(cont) {+ var t=this+ if(!t.hidden) cont(gf_unlex(t.input.current.input))+ else {+ var tree=t.editor.get_ast()+ function pick(lins) { cont(lins[0].text) }+ t.server.linearize({tree:tree,to:t.input.current.from},pick)+ }+}++Minibar.prototype.show_grammarlist=function(dir,grammar_names,dir_count) {+ var t=this;+ var first_time= !t.grammar_menu+ if(first_time) {+ t.grammar_menu=empty_id("select","grammar_menu");+ t.grammars=[];+ t.grammar_dirs=[];+ }++ t.grammar_dirs.push(dir);+ t.grammars=t.grammars.concat(grammar_names.map(function(g){return dir+g}))+ function glabel(g) {+ return hasPrefix(dir,"/tmp/gfse.") ? "gfse: "+g : g+ }+ function opt(g) { return option(glabel(g),dir+g); }+ appendChildren(t.grammar_menu,map(opt,grammar_names));+ function pick() {+ var grammar_url=t.grammar_menu.value+ t.local.put("last_grammar",grammar_url)+ t.select_grammar(grammar_url);+ }+ function pick_first_grammar() {+ if(t.timeout) clearTimeout(t.timeout),t.timeout=null;+ if(t.grammar_menu.length>1 && !t.grammar_menu.parentElement) {+ t.grammar_menu.onchange=pick;+ insertFirst(t.menubar,title("Show grammar info",button("i",bind(t.show_grammarinfo,t))))+ insertFirst(t.menubar,t.grammar_menu);+ insertFirst(t.menubar,text("Grammar: "));+ }+ var grammar0=t.options.initial_grammar+ if(!grammar0) {+ var last_grammar=t.local.get("last_grammar");+ if(last_grammar && elem(last_grammar,t.grammars))+ grammar0=last_grammar;+ }+ if(!grammar0) grammar0=t.grammars[0];+ t.grammar_menu.value=grammar0;+ t.select_grammar(grammar0);+ }+ // Wait at most 1.5s before showing the grammar menu.+ if(first_time) t.timeout=setTimeout(pick_first_grammar,1500);+ if(t.grammar_dirs.length>=dir_count) pick_first_grammar();++}++Minibar.prototype.select_grammar=function(grammar_url) {+ var t=this;+ //debug("select_grammar ");+ function change_grammar() {+ t.server.grammar_info(bind(t.change_grammar,t));+ }+ t.server.switch_to_other_grammar(grammar_url,change_grammar);+}++Minibar.prototype.change_grammar=function(grammar_info) {+ var t=this;+ //debug("show_languages ");+ t.grammar=grammar_info;+ t.input.change_grammar(grammar_info)+ t.translations.change_grammar(grammar_info)+}++Minibar.prototype.show_grammarinfo=function() {+ var t=this+ var g=this.grammar;+ function draw_cats(cats) {+ function draw_cat(cat) {+ var i=cats[cat]+ return tr([td(text(i.def)),+ td(text(i.producers.join(", "))),+ td(text(i.consumers.join(", ")))])+ }+ var table=wrap_class("table","browse",g.categories.map(draw_cat))+ var hdr=tr([th(text("Category")),+ th(text("Producers")),+ th(text("Consumers"))])+ insertFirst(table,hdr)+ return table+ }+ function draw_funs(funs) {+ function draw_fun(fun) {+ var def=funs[fun].def.split(":")+ return tr([td(text(def[0])),td(text(":")),td(text(def[1]||""))])+ }+ return div_class("browse",wrap("table",g.functions.map(draw_fun)))+ }+ function draw_more(info) {+ replaceChildren(cats,draw_cats(info.cats))+ replaceChildren(funs,draw_funs(info.funs))+ btn.disabled=true;+ }++ function more() { t.server.browse({},draw_more) }++ var cats=wrap("div",text(g.categories.join(", ")))+ var funs=wrap("div",text(g.functions.join(", ")))+ var btn=button("More info",more)++ clear(t.translations.main)+ var hdr=[text(g.name)]+ if(g.lastmodified) {+ hdr.push(text(" "))+ hdr.push(wrap("small",text("("+g.lastmodified+")")))+ }+ appendChildren(this.translations.main,+ [wrap("h3",hdr),+ btn,+ wrap("h4",text("Start category")), text(g.startcat || ""),+ wrap("h4",text("Categories")), cats,+ wrap("h4",text("Functions")), funs])+}++Minibar.prototype.append_extra_buttons=function(extra,options) {+ with(this) {+ if(options.try_google)+ extra.appendChild(button("Try Google Translate",bind(try_google,this)));+ if(options.feedback_url) {+ var b=button("Feedback",bind(open_feedback,this));+ b.title="Click to suggest improvements. Select a language in the To: menu first to suggest a better translation to that language."+ appendChildren(extra,[text(" "),b]);+ }+ }+}++Minibar.prototype.try_google=function() {+ with(this) {+ var to=translations.target_lang();+ var s=gf_unlex(input.current.input);+ if(input.surface.typed) s+=" "+input.surface.typed.value;+ var url="http://translate.google.com/?sl="+ +langpart(input.current.from,grammar.name);+ if(to!="All") url+="&tl="+to;+ url+="&q="+encodeURIComponent(s);+ window.open(url);+ }+}++Minibar.prototype.open_help=function() {+ open_popup(this.options.help_url,"help");+}++Minibar.prototype.open_feedback=function() {+ with(this) {+ // make the minibar state easily accessible from the feedback page:+ minibar.state={grammar:grammar,current:input.current,+ to:translations.to_menu.value,+ translations:translations.main};+ open_popup(options.feedback_url,'feedback');+ }+}++// This function is called from feedback.html+function prefill_feedback_form() {+ var state=opener_element("minibar").state;+ var trans=state.translations;+ var gn=state.grammar.name+ var to=langpart(state.to,gn);++ var form=document.forms.namedItem("feedback");+ setField(form,"grammar",gn);+ setField(form,"from",langpart(state.current.from,gn));+ setField(form,"input",gf_unlex(state.current.input));+ setField(form,"to",to);+ if(to=="All") element("translation_box").innerHTML=" To suggest a better translation to a particular language, select that language in the To: menu before pressing the Feedback button."+ else setField(form,"translation",trans.single_translation.join(" / "));+ + // Browser info:+ form["inner_size"].value=window.innerWidth+"×"+window.innerHeight;+ form["outer_size"].value=window.outerWidth+"×"+window.outerHeight;+ form["screen_size"].value=screen.width+"×"+screen.height;+ form["available_screen_size"].value=screen.availWidth+"×"+screen.availHeight;+ form["color_depth"].value=screen.colorDepth;+ form["pixel_depth"].value=screen.pixelDepth;++ window.focus();+}+ ++/*+se.chalmers.cs.gf.gwt.TranslateApp/align-btn.png++GET /grammars/Foods.pgf?&command=abstrtree&tree=Pred+(This+Fish)+(Very+Fresh)+GET /grammars/Foods.pgf?&command=parsetree&tree=Pred+(This+Fish)+Expensive&from=FoodsAfr+GET /grammars/Foods.pgf?&command=alignment&tree=Pred+(This+Fish)+Expensive+*/
@@ -0,0 +1,562 @@++/* --- Input object --------------------------------------------------------- */++function Input(server,translations,opts) { // Input object constructor+ var t=this+ t.server=server;+ t.translations=translations;++ // Default values for options:+ t.options={+ delete_button_text: "⌫",+ default_source_language: null,+ startcat_menu: true,+ random_button: true,+ word_replacements: false+ }++ // Apply supplied options+ if(opts) for(var o in opts) t.options[o]=opts[o];++ // User interface elements+ t.main=empty("div");+ t.menus=empty("span");+ t.buttons=empty("span");+ t.surface=div_id("surface");+ t.words=div_id("words");+ t.from_menu=empty("select");+ t.startcat_menu=empty("select")++ with(t) {+ appendChildren(main,[surface,words]);+ if(options.startcat_menu)+ appendChildren(menus,[text(" Startcat: "),startcat_menu])+ appendChildren(menus,[text(" From: "),from_menu])+ appendChildren(buttons,+ [title("Delete last word",button(options.delete_button_text,bind(delete_last,t),"H")),+ button("Clear",bind(clear_all,t),"L")]);+ if(options.random_button)+ buttons.appendChild(button("Random",bind(generate_random,t),"R"));++ var o=options;+ if(o.initial_grammar && o.initial && o.initial.from && o.initial.input)+ t.set_input_for(o.initial_grammar,o.initial)+ }++ /* --- Input client state initialization --- */+ t.current={from: null, input: [] };++ t.from_menu.onchange=bind(t.change_language,t);+ t.startcat_menu.onchange=bind(t.change_startcat,t);+}++Input.prototype.change_grammar=function (grammar) {+ var t=this;+ grammar.browse={} // for caching output from the browse command+ t.grammar=grammar;+ t.local=mi_local(t.server.current_grammar_url)+ update_language_menu(t.from_menu,grammar);+ set_initial_language(t.options,t.from_menu,grammar,t.local.get("from"));+ t.update_startcat_menu(grammar)+ t.change_language();+}++Input.prototype.update_startcat_menu=function (grammar) {+ var menu=this.startcat_menu;+ menu.innerHTML="";+ var cats=grammar.categories;+ for(var cat in cats) menu.appendChild(option(cats[cat],cats[cat]))+ var startcat=this.local.get("startcat") || grammar.startcat;+ if(startcat) menu.value=startcat;+ else {+ insertFirst(menu,option("Default",""));+ menu.value="";+ }+}++Input.prototype.change_startcat=function () {+ this.local.put("startcat",this.startcat_menu.value)+ this.clear_all();+}++Input.prototype.change_language=function () {+ this.current.from=this.from_menu.value;+ this.local.put("from",this.current.from)+ var old_current=this.local.get("current");+ var new_input= old_current && old_current.from==this.current.from+ ? old_current.input : []+ this.clear_all1();+ this.add_words(new_input)+}++Input.prototype.set_input_for=function(grammar_url,initial) {+ var local=mi_local(grammar_url)+ local.put("from",initial.from)+ local.put("current",{from:initial.from,input:initial.input})+ if(initial.startcat) local.put("startcat",initial.startcat)+}++Input.prototype.clear_all2=function() {+ with(this) {+ current.input=[];+ local.put("current",current)+ remove_surface_words()+ }+}++Input.prototype.clear_all1=function() {+ with(this) {+ remove_typed_input();+ clear_all2();+ translations.clear();+ }+}++Input.prototype.clear_all=function() {+ this.clear_all1();+ this.get_completions();+}++Input.prototype.get_completions=function() {+ with(this) {+ //debug("get_completions ");+ words.innerHTML="...";+ var s=gf_unlex(current.input)+" ";+ var args={from:current.from, input:s, cat:startcat_menu.value}+ server.complete(args,bind(show_completions,this));+ if(options.word_replacements) server.parse(args,bind(get_tree1,this));+ // Making two server calls in parallel! The two continuations can+ // be called in any order, make sure they are appropriately independent.+ }+}++Input.prototype.show_completions=function(complete_output) {+ var self=this;+ function switch_input(lin) {+ with(self) {+ local.put("current",{from:lin.to,input:lin.text.split(" ")})+ from_menu.value=lin.to;+ change_language()+ }+ }+ with(self) {+ //debug("show_completions ");+ var completions=complete_output[0].completions;+ var emptycnt=add_completions(completions)+ translations.translateFrom(current,startcat_menu.value,switch_input);+ if(surface.typed && emptycnt==completions.length) {+ if(surface.typed.value=="") remove_typed_input();+ }+ else add_typed_input();+ }+}++Input.prototype.add_completions=function(completions) {+ with(this) {+ if(words.timeout) clearTimeout(words.timeout),words.timeout=null;+ words.innerHTML="";+ words.completions=completions;+ words.word=[];+ var t=surface.typed ? surface.typed.value : "";+ var emptycnt=0;+ for(var i=0;i<completions.length;i++) {+ var s=completions[i];+ if(s.length>0) {+ var w=word(s);+ words.appendChild(w);+ words.word[i]=w;+ }+ else emptycnt++;+ }+ filter_completions(t,true);+ return emptycnt;+ }+}++Input.prototype.filter_completions=function(t,dim) {+ with(this) {+ if(words.timeout) clearTimeout(words.timeout),words.timeout=null;+ words.filtered=t;+ //if(dim) debug('filter "'+t+'"');+ var w=words.word;+ words.count=0;+ var dimmed=0;+ var prefix=""; // longest common prefix, for completion+ for(var i=0;i<w.length;i++) {+ var s=words.completions[i];+ var keep=hasPrefix(s,t);+ if(keep) {+ if(words.count==0) prefix=s;+ else prefix=(commonPrefix(prefix,s));+ words.count++;+ }+ if(dim) {+ w[i].style.opacity= keep ? "1" : "0.5";+ if(keep) w[i].style.display="inline";+ else dimmed++;+ }+ else + w[i].style.display=keep ? "inline" : "none";+ }+ words.theword=prefix;+ if(dimmed>0)+ words.timeout=setTimeout(function(){ filter_completions(t,false)},1000);+ }+}+++Input.prototype.add_typed_input=function() {+ with(this) {+ if(!surface.typed) {+ var inp=empty("input","type","text");+ inp.value="";+ inp.setAttribute("accesskey","t");+ inp.style.width="10em";+ inp.onkeyup=bind(complete_typed,this);+ surface.appendChild(inp);+ surface.typed=inp;+ inp.focus();+ }+ }+}++Input.prototype.remove_surface_words=function() {+ with(this) {+ var typed=surface.typed;+ if(typed) while(typed.previousSibling)+ surface.removeChild(typed.previousSibling)+ else clear(surface)+ }+}++Input.prototype.remove_typed_input=function() {+ with(this) {+ if(surface.typed) {+ surface.typed.parentNode.removeChild(surface.typed);+ surface.typed=null;+ }+ }+}++Input.prototype.complete_typed=function(event) {+ with(this) {+ //element("debug").innerHTML=show_props(event,"event");+ var inp=surface.typed;+ //debug('"'+inp.value+'"');+ var s=inp.value;+ var ws=s.split(" ");+ if(ws.length>1 || event.keyCode==13) {+ if(ws[0]!=words.filtered) filter_completions(ws[0],true);+ if(words.count==1) add_word(words.theword);+ else if(event.keyCode==13) add_word(ws[0]) // for literals+ else if(elem(ws[0],words.completions)) add_word(ws[0]);+ else if(words.theword.length>ws[0].length) inp.value=words.theword;+ }+ else if(s!=words.filtered) filter_completions(s,true)+ }+}++Input.prototype.generate_random=function() {+ var t=this;+ function show_random(random) {+ t.clear_all1();+ t.add_words(gf_lex(random[0].text));+ }+ + function lin_random(abs) {+ t.server.linearize({tree:abs[0].tree,to:t.current.from},show_random);+ }+ t.server.get_random({cat:t.startcat_menu.value},lin_random);+}++Input.prototype.add_words=function(ws) {+ this.add_words1(ws);+ this.get_completions();+}++Input.prototype.add_words1=function(ws) {+ for(var i=0;i<ws.length;i++)+ if(ws[i]) this.add_word1(ws[i]);+ this.local.put("current",this.current)+}++Input.prototype.word=function(s) { + var t=this;+ function click_word() {+ if(t.surface.typed) t.surface.typed.value="";+ t.add_word(s);+ }+ return button(s,click_word);+}++Input.prototype.add_word=function(s) {+ with(this) {+ add_word1(s);+ local.put("current",current)+ if(surface.typed) {+ var s2;+ if(hasPrefix(s2=surface.typed.value,s)) {+ s2=s2.substr(s.length);+ while(s2.length>0 && s2[0]==" ") s2=s2.substr(1);+ surface.typed.value=s2;+ }+ else surface.typed.value="";+ }+ get_completions();+ }+}++Input.prototype.add_word1=function(s) {+ with(this) {+ current.input.push(s);+ var w=span_class("word",text(s));+ surface.insertBefore(w,surface.typed);+ }+}++Input.prototype.delete_last=function() {+ with(this) {+ if(surface.typed && surface.typed.value!="")+ surface.typed.value="";+ else if(current.input.length>0) {+ current.input.pop();+ local.put("current",current)+ if(surface.typed) {+ surface.removeChild(surface.typed.previousSibling);+ surface.typed.focus();+ }+ else surface.removeChild(surface.lastChild);+ translations.clear();+ get_completions();+ }+ }+}++/* --- Structural editing --------------------------------------------------- */++Input.prototype.get_tree1=function(parse) {+ var t=this;+ function proceed(lin) { t.get_tree2(lin,parse[0].trees[0]) }++ if(parse.length==1 && parse[0].from==t.current.from+ && parse[0].trees && parse[0].trees.length==1)+ t.server.linearize({to:t.current.from,tree:parse[0].trees[0]},proceed);+ else t.end_structural_editing();+}++Input.prototype.get_tree2=function(lin,tree) {+ var t=this;+ with(t) {+ if(lin.length==1 && lin[0].to==current.from+ && lin[0].text==gf_unlex(current.input)+ && (lin[0].brackets)) {+ var bs=lin[0].brackets;+ //var tree=show_abstract_tree(bs);+ function proceed() { t.enable_structural_editing(bs,tree) }+ server.linearize({to:current.from,tree:tree},+ proceed,bind(end_structural_editing,t))+ }+ else end_structural_editing();+ }+}++Input.prototype.end_structural_editing=function() {+ var t=this;+ if(t.surface.structural_editing_enabled) {+ var ws=t.current.input;+ t.clear_all2()+ t.add_words1(ws);+ t.surface.structural_editing_enabled=false;+ }+}++Input.prototype.enable_structural_editing=function(bracketss,tree) {+ var t=this;+ with(t) {+ var typed=surface.typed;+ function add_bracket(brackets) {+ function add_bs(b,parent) {+ if(b.token) {+ var fun=parent.fun,cat=parent.cat;+ function showrepl() {+ t.show_replacements(brackets,parent,tree)+ }+ if(fun && cat) {+ var w= span_class("word editable",text(b.token));+ w.onclick=showrepl+ }+ else+ var w= span_class("word",text(b.token));+ w.title=(fun||"_")+":"+(cat||"_")+" "+parent.fid+":"+parent.index+ surface.insertBefore(w,typed);+ }+ else b.children.map(function(c){add_bs(c,b)})+ }+ add_bs(brackets,null)+ }+ remove_surface_words()+ //add_bs(brackets);+ if(Array.isArray(bracketss))+ bracketss.map(add_bracket) // gf>3.5+ else+ add_bracket(bracketss) // gf<=3.5+ t.surface.structural_editing_enabled=true;+ }+}++Input.prototype.show_replacements=function(brackets,parent,tree) {+ var fun=parent.fun,cat=parent.cat;+ var t=this;+ with(t) {+ function browse1(fun_info) {+ var fun_type = fun_info.def.split(":")[1];+ function browse2(cat_info) {+ var extb=null;+ function examine_replacement(rfun) {+ function browse3(rfun_info) {+ var rfun_type=rfun_info.def.split(":")[1];+ function replace() {+ t.replace_word(brackets,parent,rfun,tree);+ }+ function show_replacement(lin) {+ //console.log(lin)+ t.words.insertBefore(button(lin[0].text || rfun,replace),extb);+ }+ if(rfun_type==fun_type) {+ var tmpl=fun_template(rfun,rfun_type)+ if(tmpl)+ t.server.linearize({to:t.current.from,cat:cat,tree:tmpl},show_replacement)+ else+ t.words.insertBefore(button(rfun,replace),extb)+ }+ }+ t.browse(rfun,browse3)+ }+ var ps=cat_info.producers;+ clear(t.words);+ var extf=t.options.extend_grammar;+ if(extf) {+ function update() {+ console.log("update minibar")+ t.grammar.browse={}; // clear cache+ t.show_replacements(brackets,parent,tree)+ }+ extb=button("New "+cat+"...",+ function() { extf(cat,fun_type,update)})+ t.words.appendChild(extb)+ }+ if(ps)+ for(var pi in ps)+ if(ps[pi]!=fun) examine_replacement(ps[pi])+ }+ t.browse(cat,browse2)+ }+ t.browse(fun,browse1)+ }+}++Input.prototype.replace_word=function(brackets,parent,fun,tree) {+ var t=this;+ function proceed(tree) {+ //parent.fun=fun;+ //var tree=show_abstract_tree(brackets);+ tree=modify_tree(tree,parent.fid,fun)+ tree=show_tree(tree) // Convert JSON repr of tree back to string+ function replace(lin_output) {+ if(lin_output.length==1 && lin_output[0].to==t.current.from) {+ t.clear_all1();+ t.add_words(gf_lex(lin_output[0].text))+ }+ }+ function err(text,status,ctype) {+ t.words.innerHTML=+ ctype.split(";")[0]=="text/html"+ ? text+ : "Word replacement failed"+ }+ t.server.linearize({to:t.current.from,tree:tree},replace,err)+ }+ // Convert the string representaiton of the abstract syntax tree to JSON:+ t.server.pgf_call("abstrjson",{tree:tree},proceed)+}++Input.prototype.browse=function(id,cont) {+ var t=this;+ if(t.grammar.browse[id]) cont(t.grammar.browse[id])+ else {+ function browsed(info) {+ t.grammar.browse[id]=info;+ cont(info);+ }+ t.server.browse({id:id},browsed);+ }+}+++/* --- Auxiliary functions -------------------------------------------------- */+++function mi_local(grammar_url) {+ return appLocalStorage("gf.minibar_input."+grammar_url+".")+}+++function set_initial_language(options,menu,grammar,old_from) {+ var user_from=old_from || grammar.userLanguage;+ if(user_from) menu.value=user_from; // !! What if the language was removed?+ else if(options.default_source_language) {+ for(var i=0;i<menu.options.length;i++) {+ var o=menu.options[i].value;+ var l=langpart(o,grammar.name);+ if(l==options.default_source_language) menu.value=o;+ }+ }+}++/*+function show_abstract_tree(b) { return show_tree(abstract_tree(b)) }++function abstract_tree(b) {+ return { fun:b.fun,children:abstract_trees(b.children) }+}++function abstract_trees(bs) {+ var as=[];+ for(var i in bs)+ if(bs[i].fun) as.push(abstract_tree(bs[i]))+ return as+}+*/++function show_tree(t) {+ return t.children+ ? t.fun+" "+t.children.map(show_tree_atomic).join(" ")+ : t.fun;+}++function show_tree_atomic(t) {+ var s=show_tree(t);+ return t.children && t.children.length>0 ? "("+s+")" : s+}++// Find the node labelled fid in tree and replace the function there with fun+function modify_tree(tree,fid,fun) {+ if(tree.fun) {+ if(tree.fid==fid) tree.fun=fun+ else if(tree.children)+ tree.children.map(function(t) { modify_tree(t,fid,fun) })+ }+ return tree;+}++function fun_template(fname,ftype) {+ if(window.parse_fun) {+ var fun=parse_fun(fname+" : "+ftype).ok+ if(fun) {+ var t=fname;+ for(var i=1;i<fun.type.length;i++) t+=" ?"+ return t;+ }+ }+ return null;+}
@@ -0,0 +1,67 @@+<!DOCTYPE html>+<html manifest="minibar_offline.manifest">+<head>+<title>Minibar Offline</title>+<link rel=stylesheet type="text/css" href="http://www.grammaticalframework.org/src/www/minibar/minibar.css">++<meta name = "viewport" content = "width = device-width">+<meta http-equiv="Content-type" content="text/html;charset=UTF-8">+<meta charset="UTF-8">++</head>++<body class=minibar>+<h2>Minibar Offline, technology preview</h2>+<div id=beskrivning_intro>+<p>+<a href="javascript:dolj('intro')">[Hide introduction]</a>+<br>+<strong>These examples work flawlessly in the <a href="http://www.opera.com/browser/">Opera</a> web browser.</strong>+They also work to some extent in Opera Mobile 11 and WebKit browsers+(Safari and Chrome) and recent versions of Gecko browers (Firefox).+A hardcoded+<a href="http://tests.novemberborn.net/javascript/callstack-size.html">call stack size limit</a> still causes some problems.++<p>+How it works: a JavaScript translation of the Haskell PGF run-time library+is downloaded and run in the browser. The binary PGF files are downloaded+from the server, parsed and used in the normal way by functions in the PGF+library. The brower is+<a href="http://diveintohtml5.info/offline.html">directed to keep a+local copy of everything</a>, so that you can have access to the minibar+even when you are offline.+</div>+<p id=beskriv_intro style="display: none"><a href="javascript:beskriv('intro')">[Show introduction]</a>++<div id=minibar>+</div>++<hr>++<small>+[<a href="http://www.altocumulus.org/~hallgren/hs2js/tests/">About hs2js</a>+| <a href="minibar.html">Minibar online</a>]+</small>+<small class=modtime>+HTML <!-- hhmts start -->Last modified: Tue Nov 20 13:45:07 CET 2012 <!-- hhmts end -->+</small>+<address><a href="http://www.cse.chalmers.se/~hallgren/">TH</a></address>++<pre id=nodebug>+</pre>++<script type="text/javascript" src="http://www.grammaticalframework.org/~hallgren/hs2js/test/debug.js"></script>+<script type="text/javascript" src="http://www.grammaticalframework.org/~hallgren/hs2js/test/json.js"></script>+<script type="text/javascript" src="http://www.grammaticalframework.org/~hallgren/hs2js/test/builtin.js"></script>+<script type="text/JavaScript" src="http://www.grammaticalframework.org/~hallgren/hs2js/test/Services.js"></script>+<script type="text/javascript" src="http://www.grammaticalframework.org/~hallgren/hs2js/test/visadolj.js"></script>++<script type="text/JavaScript" src="../js/support.js"></script>+<script type="text/JavaScript" src="minibar.js"></script>+<script type="text/JavaScript" src="minibar_input.js"></script>+<script type="text/JavaScript" src="minibar_translations.js"></script>+<script type="text/JavaScript" src="minibar_support.js"></script>+<script type="text/JavaScript" src="pgf_offline.js"></script>+<script type="text/javascript" src="minibar_offline.js"></script>+</body>+</html>
@@ -0,0 +1,18 @@++var offline_options = {+ grammars_url: "/~hallgren/hs2js/test/",+ grammar_list: ["Foods.pgf","Smart.pgf","Phrasebook.pgf"]+}++var server=pgf_offline(offline_options);++var minibar_options= {+ show_abstract: true,+ show_trees: false,+ show_grouped_translations: false,+ default_source_language: "Eng",+ try_google: true,+ random_button: false+}++var minibar1=new Minibar(server,minibar_options);
@@ -0,0 +1,4 @@+CACHE MANIFEST+# 12+NETWORK:+*
@@ -0,0 +1,37 @@+// minibar_online.js, assumes that minibar.js and pgf_online.js have been loaded.++var online_options={+ //grammars_url: "http://www.grammaticalframework.org/grammars/",+ //grammars_url: "http://tournesol.cs.chalmers.se:41296/grammars/",+ //grammars_url: "http://localhost:41296/grammars/",+ //grammar_list: ["Foods.pgf"], // leave undefined to get list from server+}++if(window.grammar_list) online_options.grammar_list=grammar_list++var minibar_options= {+ show_abstract: true,+ show_trees: true,+// tree_img_format: "png", // or "svg"+ show_grouped_translations: false,+ show_brackets: true,+ word_replacements: true,+ default_source_language: "Eng",+ //feedback_url: "feedback.html",+ try_google: true+}++if(/^\?\/tmp\//.test(location.search)) {+ var args=decodeURIComponent(location.search.substr(1)).split(" ")+ if(args[0]) online_options.grammars_url=args[0];+ if(args[1]) minibar_options.initial_grammar=args[1];+}+else if(supports_html5_storage()) {+ var s=window.localStorage["gf.editor.simple.grammardir"]+ if(s) var editor_dir=JSON.parse(s);+}++var server=pgf_online(online_options);+if(editor_dir) server.add_grammars_url(editor_dir+"/");++var minibar=new Minibar(server,minibar_options);
@@ -0,0 +1,117 @@++/* --- Auxiliary functions -------------------------------------------------- */++function langpart(conc,abs) { // langpart("FoodsEng","Foods") == "Eng"+ return hasPrefix(conc,abs) ? conc.substr(abs.length) : conc;+}+++// Lookup language codes (from "flags language = ..." in the source grammar)+function langCode(grammar,conc) {+ if(!grammar.langCode) {+ var ls=grammar.languages+ var langCode={}+ for(var i=0;i<ls.length;i++)+ if(ls[i].languageCode)+ langCode[ls[i].name]=ls[i].languageCode+ grammar.langCode=langCode+ }+ return grammar.langCode[conc]+}++// Words are separated by spaces (for now). GF has other lexers/unlexers.+function gf_lex(s) { return s.split(" "); }+function gf_unlex(ws) { return ws.join(" "); }++function update_language_menu(menu,grammar) {+ // Replace the options in the menu with the languages in the grammar+ var lang=grammar.languages;+ menu.innerHTML="";+ + for(var i=0; i<lang.length; i++) {+ var ln=lang[i].name;+ if(!hasPrefix(ln,"Disamb")) {+ var lp=langpart(ln,grammar.name);+ menu.appendChild(option(lp,ln));+ }+ }+}++function button_img(url,action) {+ var i=node("img",{"class":"button","src":url});+ i.onclick=action;+ return i;+}++function cycle_images(img_urls) {+ var current=0;+ function cycle() {+ current++;+ if(current>=img_urls.length) current=0;+ i.src=img_urls[current]+ }+ var i=button_img(img_urls[0],cycle);+ return i+}++function toggle_img(i) {+ var tmp=i.src;+ i.src=i.other;+ i.other=tmp;+}++function setField(form,name,value) {+ form[name].value=value;+ var el=element(name);+ if(el) el.innerHTML=value;+}++function open_popup(url,target) {+ var w=window.open(url,target,'toolbar=no,location=no,status=no,menubar=no');+ w.focus();+}++function opener_element(id) { with(window.opener) return element(id); }++function supportsSVG() {+ return document.implementation.hasFeature("http://www.w3.org/TR/SVG11/feature#BasicStructure", "1.1")+}++function speech_buttons(to3,to2,txt) {+ var voices = window.speechSynthesis && window.speechSynthesis.getVoices() || []+ var dvs = voices.filter(function(v){return v.default})+ function pick2dash(v) { return hasPrefix(v.lang,to2dash) }+ if(to2)+ var pick=function (v) { return v.lang==to2 }+ else if(to3.length==3) {+ var to2dash=alangcode(to3)+"-"+ var pick=pick2dash+ }+ else {+ // Maybe the name of the concrete syntax is the name of the language+ // like in Numerals.pgf+ var lang=to3.substr(0,1).toUpperCase()+to3.substr(1).toLowerCase()+ var codes=langcode[lang]+ var to2dash=(codes ? codes.code2 : to3)+"-"+ var pick=pick2dash+ }+ function btn(v) {+ // Remove spaces more fluent Thai:+ var txt2 = v.lang=="th-TH" ? txt.split(" ").join("") : txt+ var u=new SpeechSynthesisUtterance(txt2)+ u.lang=v.lang // how to use v.voiceURI or v.name?++ function speak() {+ speechSynthesis.cancel()+ speechSynthesis.speak(u)+ }+ return button(v.lang,speak)+ }+ //console.log(voices.length,"voices")+ var vs=dvs.filter(pick)+ if(vs.length==0) vs=voices.filter(pick)+ //console.log(vs.length,"voices for "+to3+" "+to2)+ var btns=vs.map(btn)+ //console.log(btns.length,"voice buttons")+ return wrap("span",btns)+}
@@ -0,0 +1,332 @@+/* --- Translations object -------------------------------------------------- */++var tree_icon="../minibar/tree-btn.png";+var alignment_icon="../minibar/align-btn.png";++function Translations(server,opts) {+ this.server=server;++ // Default values for options:+ this.options={+ show_abstract: false,+ abstract_action: null, // action when selecting the abstracy syntax tree+ show_trees: false, // add buttons to show abstract syntax trees,+ // parse trees & word alignment+ tree_img_format: supportsSVG() ? "svg" : "png",+ // format for trees & alignment images,+ // can be "gif", "png" or "svg"+ show_grouped_translations: true,+ to_multiple: true, // allow selection of multiple target languages+ show_brackets: false, // show bracketed string+ speech: true, // enable speech synthesis buttons+ translate_limit: 25 // maximum number of parse trees to retrieve+ }++ // Apply supplied options+ if(opts) for(var o in opts) this.options[o]=opts[o];++ this.main=empty("div");+ this.menus=empty("span");++ var tom_opts={id:"to_menu"}+ if(this.options.to_multiple)+ tom_opts.multiple=true,tom_opts.size=8,+ tom_opts.style="position: absolute";+ var tom=this.to_menu=node("select",tom_opts,[]);+ if(this.options.to_multiple) {+ tom.style.display="none"+ function toggle_tom() {+ tom.style.display= tom.style.display=="none" ? "" : "none"+ }+ appendChildren(this.menus,[button("To:",toggle_tom),tom,text(" ... ")])+ }+ else appendChildren(this.menus,[text(" To: "),tom])+ tom.onchange=bind(this.change_language,this);+ var o=this.options+ if(o.initial_grammar && o.initial_toLangs)+ this.set_toLangs_for(o.initial_grammar,o.initial_toLangs)++ /* // This seems triggers weird scrolling behavior in Firefox and Chrome:+ tom.onmouseover=function() { var n=tom.options.length;+ tom.size=n<12 ? n : 12; }+ tom.onmouseout=function() { var n=tom.options.length;+ tom.size=n<4 ? n : 4; }+ */+}++Translations.prototype.change_grammar=function(grammar) {+ var t=this+ t.grammar=grammar;++ t.local=mt_local(t.server.current_grammar_url)++ update_language_menu(t.to_menu,grammar);+ insertFirst(t.to_menu,option("All","All"));+ t.to_menu.value="All";+ var toLangs=t.local.get("toLangs")+ if(toLangs && toLangs.length>0) {+ t.toLangs=toLangs+ t.toSet=toSet(toLangs)+ updateMultiMenu(t.to_menu,toLangs)+ }+ else {+ t.toLangs=["All"]+ t.toSet={"All":true}+ }+}++Translations.prototype.clear=function() {+ this.main.innerHTML="";+}++Translations.prototype.set_toLangs_for=function(grammar_url,toLangs) {+ var local=mt_local(grammar_url)+ local.put("toLangs",toLangs)+}++Translations.prototype.change_language=function() {+ var t=this+ t.toLangs=multiMenuSelections(t.to_menu)+ t.toSet=toSet(t.toLangs)+ t.local.put("toLangs",t.toLangs)+ t.get_translations();+}++Translations.prototype.translateFrom=function(current,startcat,lin_action) {+ this.current=current;+ this.startcat=startcat;+ this.lin_action=lin_action;+ this.get_translations();+}++Translations.prototype.get_translations=function() {+ with(this) {+ var c=current;+ var args={from:c.from,input:gf_unlex(c.input),cat:startcat}+ if(options.translate_limit) args.limit=options.translate_limit+ if(options.show_grouped_translations)+ server.translategroup(args,bind(show_groupedtranslations,this));+ else+ server.translate(args,bind(show_translations,this));+ }+}++Translations.prototype.target_lang=function() {+ with(this) return langpart(to_menu.value,grammar.name);+}++Translations.prototype.show_translations=function(translationResults) {+ var self=this;+ function abs_tdt(tree) {+ var as = self.options.show_trees+ ? [self.abstree_button(tree),+ self.alignment_button(tree,to=="All",self.toLangs),+ text(" ")]+ : []+ as.push(text(tree))+ return td(as)+ }+ function text_speech(langcode,to,txt,lin) {+ var langcode2=langCode(self.grammar,to)+ return wrap("span",[txt,speech_buttons(langcode,langcode2,lin)])+ }+ function lin_tdt(tree,to,langcode,lin) {+ var txt=wrap("span",text("▸ "+lin))+ var ts = text_speech(langcode,to,txt,lin)+ var as = wrap("span",+ self.options.show_trees+ ? [self.parsetree_button(tree,to,self.grammar),text(" "),ts]+ : [ts])+ as.active=txt+ as.swap=ts+ return as+ }+ function act(lin) {+ return self.lin_action ? function() { self.lin_action(lin) } : null+ }+ function atext(s,act) {+ var txt=wrap("span",text(s))+ txt.onclick=act+ return txt+ }+ function show_lin(langcode,lin,tree) {+ function draw_table(lintable,action) {+ function draw_texts(texts) {+ function text1(s) {+ var txt=atext(s,action)+ return wrap("div",text_speech(langcode,lin.to,txt,s))+ }+ return texts.map(text1)+ }+ function draw_row(row) {+ return tr([td(atext(row.params,action)),td(draw_texts(row.texts))])+ } // ▼ ▾+ return wrap("span",+ [atext("▾ ",action),+ wrap_class("table","lintable",lintable.map(draw_row))])+ }+ function get_tabular() {+ function show_table(lins) {+ if(lins.length==1) {+ function restore() { replaceNode(one.swap,all) }+ var all=draw_table(lins[0].table,restore)+ replaceNode(all,one.swap)+ one.active.onclick=function() { replaceNode(all,one.swap) }+ }+ }+ self.server.pgf_call("linearizeTable",{"tree":tree,"to":lin.to},+ show_table)+ }+ var one= lin_tdt(tree,lin.to,langcode,lin.text) // ▶+ one.active.onclick=get_tabular+ return td(one)+ }+ with(self) {+ var trans=main;+ //var to=target_lang(); // wrong+ var to=to_menu.value;+ var toLangs=self.toLangs+ var toSet=self.toSet+ var cnt=translationResults.length; // cnt==1 usually+ //trans.translations=translations;+ trans.single_translation=[];+ trans.innerHTML="";+ /*+ trans.appendChild(wrap("h3",text(cnt<1 ? "No translations?" :+ cnt>1 ? ""+cnt+" translations:":+ "One translation:")));+ */+ for(var p=0;p<cnt;p++) {+ var tra=translationResults[p];+ var bra=tra.brackets;+ if (tra.translations != null) {+ for (q = 0; q < tra.translations.length; q++) {+ var t = tra.translations[q];+ var lin=t.linearizations;+ var tbody=empty("tbody");+ if(options.show_abstract && t.tree) {+ function abs_act() {+ self.options.abstract_action(t.tree)+ }+ var abs_hdr = options.abstract_action + ? title("Edit the syntax tree",+ button("Abstract",abs_act))+ : text("Abstract: ")+ tbody.appendChild(tr([th(abs_hdr),abs_tdt(t.tree)]));+ }+ for(var i=0;i<lin.length;i++) {+ if(lin[i].to==to && toLangs.length==1)+ trans.single_translation.push(lin[i].text);+ if(lin[i].to==current.from && lin[i].brackets)+ bra=lin[i].brackets;+ if(to=="All" || toSet[lin[i].to]) {+ var langcode=langpart(lin[i].to,grammar.name)+ //var hdr=text(langcode+": ")+ var hdr=title("Switch input language to "+langcode,+ button(langcode,act(lin[i])))+ //hdr.disabled=lin[i].to==current.from+ tbody.appendChild(+ tr([th(hdr),show_lin(langcode,lin[i],t.tree)]));+ }+ }+ trans.appendChild(wrap("table",tbody));+ }+ }+ else if(tra.typeErrors) {+ var errs=tra.typeErrors;+ for(var i=0;i<errs.length;i++)+ trans.appendChild(wrap("pre",text(errs[i].msg)))+ }+ if(options.show_brackets)+ trans.appendChild(div_class("brackets",draw_bracketss(bra)));++ }+ }+}++Translations.prototype.show_groupedtranslations=function(translationsResult) {+ with(this) {+ var trans=main;+ var to=target_lang();+ //var to=to_menu.value // wrong+ var cnt=translationsResult.length;+ //trans.translations=translationsResult;+ trans.single_translation=[];+ trans.innerHTML="";+ for(var p=0;p<cnt;p++) {+ var t=translationsResult[p];+ if(to=="All" || t.to==to) {+ var lin=t.linearizations;+ var tbody=empty("tbody");+ if(to=="All") tbody.appendChild(tr([th(text(t.to+":"))]));+ for(var i=0;i<lin.length;i++) {+ if(to!="All") trans.single_translation[i]=lin[i].text;+ tbody.appendChild(tr([td(text(lin[i].text))]));+ if (lin.length > 1) tbody.appendChild(tr([td(text(lin[i].tree))]));+ }+ trans.appendChild(wrap("table",tbody));+ }+ }+ }+}++Translations.prototype.abstree_button=function(abs) {+ var f=this.options.tree_img_format;+ var img=this.server.current_grammar_url+"?command=abstrtree&format="+f+"&tree="+encodeURIComponent(abs)+ var btn=tree_button(img,"&nocat=true");+ btn.title="Click to display abstract syntax tree"+ return btn+}++Translations.prototype.alignment_button=function(abs,all,toLangs) {+ var f=this.options.tree_img_format;+ var i=button_img(alignment_icon,function(){toggle_img(i)});+ var to= all ? "" : "&to="+encodeURIComponent(toLangs.join(" "))+ i.title="Click to display word alignment"+ i.other=this.server.current_grammar_url+"?command=alignment&format="+f+"&tree="+encodeURIComponent(abs)+to;+ return i;+}++Translations.prototype.parsetree_button=function(abs,lang,grammar) {+ var f=this.options.tree_img_format;+ var img=this.server.current_grammar_url+ +"?command=parsetree&format="+f+"&nodep=true&nodefont=arial"+ +"&from="+lang+"&tree="+encodeURIComponent(abs);+ var img_nofun=img+"&nofun=true"+ var help="Click again to display parse tree. Click again to show function names."+ if(f=="svg" && grammar.hasDependencyLabels) {+ var depimg=this.server.current_grammar_url+ +"?command=deptree&format=svg&to="+lang+ +"&tree="+encodeURIComponent(abs);+ var imgs=[tree_icon,depimg,img_nofun,img]+ help="Click to display dependency tree. "+help+ }+ else var imgs=[tree_icon,img_nofun,img]+ var btn=cycle_images(imgs)+ btn.title=help+ return btn;+}++/* --- Auxiliary functions -------------------------------------------------- */++function mt_local(grammar_url) {+ return appLocalStorage("gf.minibar_translations."+grammar_url+".")+}++function tree_button(img_url,opt) {+ return cycle_images([tree_icon,img_url+(opt||"&nofun=true"),img_url])+}++function draw_brackets(b) {+ return b.token+ ? span_class("token",text(b.token))+ : node("span",{"class":"brackets",+ title:(b.fun||"_")+":"+b.cat+" "+b.fid+":"+b.index},+ b.children.map(draw_brackets))+}++function draw_bracketss(bs) {+ return Array.isArray(bs)+ ? bs.map(draw_brackets) //with gf>3.5, in some cases+ : draw_brackets(bs) // with gf<=3.5+}
@@ -0,0 +1,117 @@+// Assumes that Services.js has been loaded++function pgf_offline(options) {+ var server = {+ // State variables (private):+ grammars_url: "",+ other_grammars_urls: [],+ grammar_list: ["Foods.pgf"],+ current_grammar_url: null,+ pgf : null,+ + // Methods:+ switch_grammar: function(grammar_url,cont) {+ var new_grammar_url=this.grammars_url+grammar_url;+ this.switch_to_other_grammar(new_grammar_url,cont)+ },+ add_grammars_url: function(grammars_url,cont) {+ this.other_grammars_urls.push(grammars_url);+ if(cont) cont();+ },+ switch_to_other_grammar: function(new_grammar_url,cont) {+ //debug("switch_grammar ");+ var self=this;+ var update_pgf=function(pgfbinary) {+ debug("Got "+new_grammar_url+", length="+ +pgfbinary.length+", parsing... ");+ self.pgf = {v: Services_decodePGF.v({v:pgfbinary}) }+ //debug("done")+ self.current_grammar_url=new_grammar_url;+ if(cont) cont();+ }+ ajax_http_get_binary(new_grammar_url+"?command=download",update_pgf);+ },+ get_grammarlist: function(cont,err) {+ if(this.grammar_list) cont(this.grammar_list)+ else http_get_json(this.grammars_url+"grammars.cgi",cont,err);+ },+ get_grammarlists: function(cont,err) { // May call cont several times!+ var ds=this.other_grammars_urls;+ var n=1+ds.length;+ function pair(dir) {+ return function(grammar_list){cont(dir,grammar_list,n)}+ }+ function ignore_error(err) { console.log(err) }+ this.get_grammarlist(pair(this.grammars_url),err)+ for(var i in ds)+ http_get_json(ds[i]+"grammars.cgi",pair(ds[i]),ignore_error);+ },+ + get_languages: function(cont) {+ cont(fromJSValue(Services_grammar.v(this.pgf)))+ },+ grammar_info: function(cont) {+ cont(fromJSValue(Services_grammar.v(this.pgf)))+ },++ get_random: function(cont) {+ alert("Random generation not supported yet in the offline version");+ },+ linearize: function(args,cont) {+ cont(fromJSValue(Services_linearize.v(this.pgf)(v(args.tree))(v(args.to))));+ },+ complete: function(args,cont) {+ cont(fromJSValue(Services_complete.v(this.pgf)(v(args.from))(v(args.input))));+ },+ parse: function(args,cont) {+ cont(fromJSValue(Services_parse.v(this.pgf)(v(args.from))(v(args.input))));+ },+ translate: function(args,cont) {+ cont(fromJSValue(Services_translate.v(this.pgf)(v(args.from))(v(args.input))));+ },+ translategroup: function(args,cont) {+ cont(fromJSValue(Services_translategroup.v(this.pgf)(v(args.from))(v(args.input))));+ }+ };+ for(var o in options) server[o]=options[o];+ return server;+};++++// See https://developer.mozilla.org/En/XMLHttpRequest/Using_XMLHttpRequest+function ajax_http_get_binary(url,callback) {+ var http=GetXmlHttpObject()+ if (http==null) {+ alert ("Browser does not support HTTP Request")+ return+ } + var statechange=function() {+ if (http.readyState==4 || http.readyState=="complete") {+ if(http.status==200) {+ var buffer=http.mozResponseArrayBuffer;+ if(buffer) callback(bufferToString(buffer)) // Gecko 2 (Firefox 4)+ else callback(http.responseText); // other browsers+ }+ else alert("Request for "+url+" failed: "+ +http.status+" "+http.statusText);+ }+ }+ http.onreadystatechange=statechange;+ http.open("GET",url,true);+ http.overrideMimeType('text/plain; charset=x-user-defined');+ http.send(null);+ //dump("http get "+url+"\n")+ return http;+}++function bufferToString(buffer) {+ // This function converts to the current representation of ByteString,+ // but it would be better to use binary buffers for ByteStrings as well.+ debug("bufferToString");+ var u=new Uint8Array(buffer);+ var a=new Array(u.length);+ for(var i=0;i<u.length;i++)+ a[i]=String.fromCharCode(u[i]);+ return a.join("");+}
@@ -0,0 +1,59 @@+<!DOCTYPE html> +<html>+<head> +<title>Phrasebook</title> +<link rel=stylesheet type="text/css" href="minibar.css"> +<meta charset="UTF-8">+<meta name = "viewport" content = "width = device-width">+</head>+ +<body class=minibar>++<div id=minibar></div>++<hr> + +<small> ++Powered by <a href="http://www.grammaticalframework.org/">GF</a>,+see <a href="http://www.grammaticalframework.org/examples/phrasebook/doc-phrasebook.html">doc</a>.++</small>++<script type="text/JavaScript" src="../js/support.js"></script>+<script type="text/JavaScript" src="../js/localstorage.js"></script>+<script type="text/JavaScript" src="minibar.js"></script>+<script type="text/JavaScript" src="minibar_input.js"></script>+<script type="text/JavaScript" src="minibar_translations.js"></script>+<script type="text/JavaScript" src="minibar_support.js"></script>+<script type="text/JavaScript" src="../js/pgf_online.js"></script>++<script type="text/JavaScript">++var online_options={+ // grammars_url: "http://www.grammaticalframework.org/grammars/",+//grammars_url: "http://tournesol.cs.chalmers.se:41296/grammars",+//grammars_url: "http://localhost:41296/grammars/",+ grammar_list: ["Phrasebook.pgf"] // leave undefined to get list from server+}++var server=pgf_online(online_options);++var phrasebook_options={+ delete_button_text: "Del",+ help_url: "http://www.grammaticalframework.org/examples/phrasebook/help-phrasebook.html",+ feedback_url: "feedback.html",+ default_source_language: "Eng",+ startcat_menu: false,+ to_multiple: false+}++start_minibar(server,phrasebook_options)+</script>++</body> + +</html> +++
@@ -0,0 +1,30 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html> <head>+<title>Saldotest</title>+<link rel=stylesheet type="text/css" href="minibar.css">+<script type="text/JavaScript" src="../js/support.js"></script>+<script type="text/JavaScript" src="saldotest.js"></script>+<meta name = "viewport" content = "width = device-width">+</head>++<body onload="start_saldotest();start_saldospel()">++<h2>Vilket ord ska bort?</h2>+<div id=saldospel>+</div>++<h2>Hel- och halvspöke</h2>+<div id=saldotest>+</div>++<hr>+<small>+[Baserad på <a href="http://spraakbanken.gu.se/sal/ws/">SALDOs nättjänster</a>]+</small>+<small class=modtime>+HTML <!-- hhmts start -->Last modified: Tue Nov 20 13:47:13 CET 2012 <!-- hhmts end -->+</small>+<address>TH <img src="http://www.altocumulus.org/~hallgren/online.cgi?icon" alt=""></address>+</body>++</html>
@@ -0,0 +1,340 @@++var Saldo_ws_url = "http://spraakbanken.gu.se/ws/saldo-ws/";+//var Saldo_ff_url = Saldo_ws_url+"ff/json+remember_completions/";+var Saldo_lid_url = Saldo_ws_url+"lid/json";++function saldo_ws(fn,fmt,arg,cont_name) {+ jsonp(Saldo_ws_url+fn+"/"+fmt+(cont_name ? "+"+cont_name : "")+"/"+arg,"");+}++function saldo_json(fn,arg,cont_name) { saldo_ws(fn,"json",arg,cont_name); }+function saldo_lid(arg,cont_name) { saldo_json("lid",arg,cont_name); }+function saldo_lid_rnd(cont_name) { saldo_lid("rnd?"+Math.random(),cont_name); }++var ordlista=[];+var current="";++function start_saldotest() {+ appendChildren(element("saldotest"),+ [button("Slumpa","random_word()"),+ button("Rensa","clear_all()"),+ button("⌫","delete_last()"),+ //button("Ordlista","show_ordlista()"),+ button("Visa tänkbara drag","show_moves()"),+ button("Gör ett drag","make_a_move()"),+ //button("Visa prefix","show_prefixes()"),+ div_id("surface"),+ div_id("words"),+ div_id("translations")])+ var style0="min-height: 3ex; margin: 5px; padding: 5px;";+ element("surface").setAttribute("style",style0+"border: 3px dashed #e0e0e0;");+ element("words").setAttribute("style",style0+"border: 3px solid #e0e0e0;");+ clear_all();+}++function random_word() {+ saldo_lid_rnd("show_random");+}++function show_random(lid) {+ var lex=lid.lex;+ reset_all(lex.substring(0,lex.indexOf('.')));+}++function clear_all() { reset_all(""); }++function reset_all(s) {+ current=s;+ element("surface").innerHTML=s;+ element("translations").innerHTML="";+ get_completions();+}++function delete_last() {+ var len=current.length;+ if(len>0) {+ current=current.substring(0,len-1);+ var s=element("surface");+ s.innerHTML=current;+ element("translations").innerHTML="";+ get_completions();+ }+}++function with_completions(s,cont) {+ var c=ordlista[s];+ if(c && c.a) cont(c);+ else {+ //if(c) alert("c already has fields"+field_names(c));+ ordlista[s]={put: function(c) { ordlista[s]=c; cont(c); }};+ var url=Saldo_ws_url+"ff/json+ordlista[\""+s+"\"].put/"+encodeURIComponent(s);+ jsonp(url,"");+ }+}++function get_completions() {+ with_completions(current,show_completions);+}++function word(s) {+ //var w=span_class("word",text(s));+ //if(s==" ") w.innerHTML=" ";+ //w.setAttribute("onclick",'extend_current("'+s+'")');+ //return w;+ return button(s,'extend_current("'+s+'")');+}++function extend_current(s) {+ current+=s;+ element("words").innerHTML="";+ element("surface").innerHTML=current;+ get_completions();+}++function show_completions(saldo_ff) {+ var box=element("words");+ box.innerHTML="";+ //var c=saldo_ff.c.split("");+ var c=filter(allowed,saldo_ff.c);+ sort(c);+ for(var i=0;i<c.length;i++) {+ var s=c[i];+ if(s!='-')+ box.appendChild(word(s));+ }+ show_translations(saldo_ff.a);+}++function allowed(c) {+ switch(c) {+ case 'å':+ case 'ä':+ case 'ö':+ case 'é':+ case 'ü':+ return true;+ default:+ return 'a'<=c && c<='z';+ }+}++// ordklasser: mxc sxc (förekommer bara som prefix),+// *h (förekommer bara som suffix)+function ignore(msd) {+ switch(msd) {+ case "c":+ case "ci":+ case "cm":+ case "seg":+ case "sms":+ return true;+ default:+ return false;+ }+}++function count_wordforms(a) {+ var cnt=0;+ for(var i=0;i<a.length;i++)+ if(!ignore(a[i].msd)) cnt++;+ return cnt;+}++function pad(s) {+ return s.length>0 ? " "+s : "";+}++function show_translations(a) {+ var tr=element("translations");+ tr.innerHTML="";+ //if(!a) alert("a undefined in show_translations");+ if(count_wordforms(a)<1) {+ tr.appendChild(p(text(a.length<1 ? "Detta är inte en giltig ordform"+ : "Denna form förekommer bara i sammansättningar")));+ element("surface").setAttribute("class","invalid");+ }+ else {+ element("surface").setAttribute("class","valid");+ for(var i=0;i<a.length;i++)+ if(!ignore(a[i].msd))+ tr.appendChild(p(text(a[i].gf+" ("+a[i].pos+pad(a[i].is)+", "+a[i].msd+")")));+ }+}++function show_ordlista() {+ var trans=element("translations");+ trans.innerHTML="Följande ord har slagits upp: ";+ var apnd=function(el) { trans.appendChild(el) };+ for(var i in ordlista) {+ apnd(empty("br"));+ apnd(span_class(ordlista[i].a.length<1 ? "invalid" : "valid",text(" "+i)));+ apnd(text(": "+(ordlista[i].ok!=null ? ordlista[i].ok.length : "?")+ +"/"+(ordlista[i].allowed!=null ? ordlista[i].allowed.length : "?")));+ }+}++function extend_ordlista(s,cs,cont) {+ if(cs.length<1) cont();+ else {+ var c=cs[0];+ var cs2=cs.substring(1);+ with_completions(s+c,function(o){extend_ordlista(s,cs2,cont)});+ }+}++function known_possible_moves(s,cont) {+ var c=implode(sort(filter(allowed,ordlista[s].c)));+ ordlista[s].allowed=c;+ extend_ordlista(s,c,function() {+ var ok="";+ for(var i=0;i<c.length;i++) {+ var next=s+c[i];+ var ff=ordlista[next];+ //if(!ff.a) alert(show_props(ff,"ff"));+ if(next.length<2 || count_wordforms(ff.a)<1) ok+=c[i];+ }+ ordlista[s].ok=ok;+ cont(ok);+ }+ );+}++function unknown_possible_moves(s,cont) {+ with_completions(s,function(c){known_possible_moves(s,cont);});+}++function currently_possible_moves(cont) {+ known_possible_moves(current,cont);+}++function show_moves() {+ var trans=element("translations");+ trans.innerHTML="Letar efter möjliga drag";+ currently_possible_moves(function(ok) {+ trans.innerHTML="Tänkbara drag: "+ok;+ winning_moves(trans,ok);+ });+}++function winning_moves(trans,ok) {+ var ws=map(function(c){return current+c;},ok);+ mapc(unknown_possible_moves,ws,function(oks){+ var winning="";+ for(i=0;i<oks.length;i++)+ if(oks[i].length<1) winning+=ok[i];+ trans.innerHTML+="<br>Vinnande drag: "+winning;+ });+}++function make_a_move() {+ currently_possible_moves(function(ok) {+ if(ok.length<1) element("translations").innerHTML="Hittade inga möjliga drag!";+ else {+ var i=Math.floor(Math.random()*ok.length);+ extend_current(ok[i]);+ }+ }+ );+}++function show_prefixes_of(trans,s) {+ if(s.length>0) {+ var p=s.substr(0,s.length-1);+ with_completions(p,function(c) {+ if(count_wordforms(c.a)>0) trans.innerHTML+="<br>"+p;+ show_prefixes_of(trans,p);+ });+ }+}++function show_prefixes() {+ var trans=element("translations");+ trans.innerHTML="Prefix av "+current+":";+ show_prefixes_of(trans,current);+}++/* -------------------------------------------------------------------------- */++var spel={ antal_ord: 4, // antal närbesläktade ord att visa+ antal_korrekta_svar: 0,+ antal_felaktiga_svar: 0 + };++function start_saldospel() {+ spel.hylla=div_id("hylla");+ spel.status=div_id("status");+ //element("saldospel").innerHTML="<span id=score></span>";+ appendChildren(element("saldospel"),+ [spel.hylla,spel.status,+ p(text("")),+ button("Nya ord","spel0()"),+ text(" "),+ wrap("b",span_id("score"))]);+ spel.score=element("score");+ show_score();+ spel0();+}++function spel0() { // Välj ord 1+ saldo_lid_rnd("spel1");+}++function spel1(lid) { // Slå upp md1 för ord 1+ spel.lid=lid;+ saldo_json("md1",lid.lex,"spel2");+}++function spel2(md1) { // Kontrollera att det finns minst 4 ord i md1 för ord1+ if(md1.length<spel.antal_ord) spel0();+ else {+ spel.md1=md1;+ spel3();+ }+}++function spel3() { // Välj ord 2+ saldo_lid_rnd("spel4");+}++function spel4(lid) { // Slå upp md1 för ord 2+ spel.lid2=lid;+ saldo_json("md1",lid.lex,"spel5");+}++function spel5(md1) { // Kontrollera att ord 1 och ord 2 inte har något gemensamt+ var ordlista1=map(wf,spel.md1);+ var ord2=wf(spel.lid2.lex);+ var ordlista2=map(wf,md1).concat(ord2);+ if(overlaps(ordlista1,ordlista2)) spel3();+ else spel6(ordlista1,ord2);+}++function spel6(ordlista1,ord2) {+ spel.ord2=ord2;+ var pos=Math.floor(Math.random()*spel.antal_ord);+ var ordlista=shuffle(shuffle(ordlista1).slice(0,spel.antal_ord).concat(ord2));+ spel.hylla.innerHTML="";+ var lista=empty_class("div","space");+ for(var i=0;i<ordlista.length;i++)+ lista.appendChild((button(ordlista[i],"spel7(this)")));+ spel.hylla.appendChild(lista);+}++function spel7(btn) {+ btn.disabled=true;+ var ok=btn.value==spel.ord2;+ //btn.setAttribute("class",ok ? "correct" : "incorrect");+ btn.setAttribute("style",ok ? "color: green" : "color: red");+ if(ok) spel.antal_korrekta_svar++; else spel.antal_felaktiga_svar++;+ show_score();+ if(ok) spel0();+}++function show_score() {+ spel.score.innerHTML=""+spel.antal_korrekta_svar+" rätt, "+ +spel.antal_felaktiga_svar+" fel";+}++function wf(ord) { // word form, wf("band..1") == "band"+ return ord.split(".",1)[0].split("_").join(" ");+}
binary file changed (absent → 149 bytes)
@@ -0,0 +1,4 @@+User-agent: *+Disallow: /grammars+Disallow: /robust+Disallow: /*.pgf
@@ -0,0 +1,2 @@+html:+ pandoc --from=markdown+pipe_tables --to=html --output=about.html README.md
@@ -0,0 +1,76 @@+<!DOCTYPE html>+<html>+<head>+<title>About the syntax editor</title>+<link rel=stylesheet type="text/css" href="../minibar/minibar.css">+<link rel=stylesheet type="text/css" href="editor.css">+<meta charset="UTF-8">+</head>+<body class="about">++# GF web-based syntax editor++John J. Camilleri +January 2013++A tool for building and manipulating abstract syntax trees in GF.+This is meant as improved replacement of the [old syntax editor][old].++[old]:http://www.grammaticalframework.org/~meza/restWiki/editor.html++## Example usage++If you want to use the tool in your own application, everything you need in the source+files `editor.html` and `editor_online.js`. Contact the [GF developer mailing list][gf-dev]+if you have any problems.++[gf-dev]:http://groups.google.com/group/gf-dev++## Available startup options++### Grammar Manager++| Options | Description | Default |+|---------------------+-------------------------------------------------------------------------+-------------------|+| `initial.grammar` | Initial grammar URL, e.g. `"http://localhost:41296/grammars/Foods.pgf"` | |+| `initial.startcat` | Initial startcat | (grammar default) |+| `initial.languages` | Initial linearisation languages, e.g. `["Eng","Swe","Mlt"]` | (all) |+++### Editor++| Options | Description | Default |+|----------------------+---------------------------------------------------------------------------------+----------|+| `target` | | "editor" |+| `initial.abstr` | Initial abstract tree (as string), e.g. `"Pred (That Fish) Expensive"` | |+| `lin_action` | Function called when clicking on the language button beside each linearisation. | |+| `lin_action_tooltip` | Tooltip for the button beside each linearisation. | |+| `show_grammar_menu` | Show grammar menu? | True |+| `show_startcat_menu` | Show startcat menu? | True |+| `show_to_menu` | Show languages menu? | True |+| `show_random_button` | Show random button? | True |+| `show_import` | Show import button/panel? | True |+| `show_export` | Show export button? | True |++## Notes++- Tested with latest Chrome and Firefox (only).++## To do/feature requests++- Compatibility with grammars with dependent category types+- Clicking on tokens to select tree node+- Clipboard of trees+- Usage of printnames+- Enter string/float/int literals+- more prominence to Disamb-linearizations+- show all resulting linearization variants+- undo/redo (or back/forward) navigation+- structure fridge magnets more (eg newline before the magnet whose first letter is different)++## Known bugs++- Change startcat doesn't work when given an initial startcat ++</body>+</html>
@@ -0,0 +1,129 @@+<!DOCTYPE html>+<html>+<head>+<title>+About the syntax editor+</title>+<link rel=stylesheet type="text/css" href="../minibar/minibar.css"> <link rel=stylesheet type="text/css" href="editor.css"> <meta charset="UTF-8">+</head>+<body class="about">++<h1 id="gf-web-based-syntax-editor">GF web-based syntax editor</h1>+<p>John J. Camilleri<br />January 2013</p>+<p>A tool for building and manipulating abstract syntax trees in GF. This is meant as improved replacement of the <a href="http://www.grammaticalframework.org/~meza/restWiki/editor.html">old syntax editor</a>.</p>+<h2 id="example-usage">Example usage</h2>+<p>If you want to use the tool in your own application, everything you need in the source files <code>editor.html</code> and <code>editor_online.js</code>. Contact the <a href="http://groups.google.com/group/gf-dev">GF developer mailing list</a> if you have any problems.</p>+<h2 id="available-startup-options">Available startup options</h2>+<h3 id="grammar-manager">Grammar Manager</h3>+<table>+<thead>+<tr class="header">+<th align="left">Options</th>+<th align="left">Description</th>+<th align="left">Default</th>+</tr>+</thead>+<tbody>+<tr class="odd">+<td align="left"><code>initial.grammar</code></td>+<td align="left">Initial grammar URL, e.g. <code>"http://localhost:41296/grammars/Foods.pgf"</code></td>+<td align="left"></td>+</tr>+<tr class="even">+<td align="left"><code>initial.startcat</code></td>+<td align="left">Initial startcat</td>+<td align="left">(grammar default)</td>+</tr>+<tr class="odd">+<td align="left"><code>initial.languages</code></td>+<td align="left">Initial linearisation languages, e.g. <code>["Eng","Swe","Mlt"]</code></td>+<td align="left">(all)</td>+</tr>+</tbody>+</table>+<h3 id="editor">Editor</h3>+<table>+<thead>+<tr class="header">+<th align="left">Options</th>+<th align="left">Description</th>+<th align="left">Default</th>+</tr>+</thead>+<tbody>+<tr class="odd">+<td align="left"><code>target</code></td>+<td align="left"></td>+<td align="left">"editor"</td>+</tr>+<tr class="even">+<td align="left"><code>initial.abstr</code></td>+<td align="left">Initial abstract tree (as string), e.g. <code>"Pred (That Fish) Expensive"</code></td>+<td align="left"></td>+</tr>+<tr class="odd">+<td align="left"><code>lin_action</code></td>+<td align="left">Function called when clicking on the language button beside each linearisation.</td>+<td align="left"></td>+</tr>+<tr class="even">+<td align="left"><code>lin_action_tooltip</code></td>+<td align="left">Tooltip for the button beside each linearisation.</td>+<td align="left"></td>+</tr>+<tr class="odd">+<td align="left"><code>show_grammar_menu</code></td>+<td align="left">Show grammar menu?</td>+<td align="left">True</td>+</tr>+<tr class="even">+<td align="left"><code>show_startcat_menu</code></td>+<td align="left">Show startcat menu?</td>+<td align="left">True</td>+</tr>+<tr class="odd">+<td align="left"><code>show_to_menu</code></td>+<td align="left">Show languages menu?</td>+<td align="left">True</td>+</tr>+<tr class="even">+<td align="left"><code>show_random_button</code></td>+<td align="left">Show random button?</td>+<td align="left">True</td>+</tr>+<tr class="odd">+<td align="left"><code>show_import</code></td>+<td align="left">Show import button/panel?</td>+<td align="left">True</td>+</tr>+<tr class="even">+<td align="left"><code>show_export</code></td>+<td align="left">Show export button?</td>+<td align="left">True</td>+</tr>+</tbody>+</table>+<h2 id="notes">Notes</h2>+<ul>+<li>Tested with latest Chrome and Firefox (only).</li>+</ul>+<h2 id="to-dofeature-requests">To do/feature requests</h2>+<ul>+<li>Compatibility with grammars with dependent category types</li>+<li>Clicking on tokens to select tree node</li>+<li>Clipboard of trees</li>+<li>Usage of printnames</li>+<li>Enter string/float/int literals</li>+<li>more prominence to Disamb-linearizations</li>+<li>show all resulting linearization variants</li>+<li>undo/redo (or back/forward) navigation</li>+<li>structure fridge magnets more (eg newline before the magnet whose first letter is different)</li>+</ul>+<h2 id="known-bugs">Known bugs</h2>+<ul>+<li>Change startcat doesn't work when given an initial startcat</li>+</ul>+</body>+</html>++
@@ -0,0 +1,366 @@+/* --- ID for a node in a tree ---------------------------------------------- */+function NodeID(x) {+ this.id = new Array();+ this.id.push(0);++ // Initialize from input+ if (x) {+ var type = Object.prototype.toString.call(x);+ switch (type) {+ case "[object Number]": this.id = [x]; break;+ case "[object String]": this.id = map(function(s){return parseInt(s)}, x.split(",")); break;+ case "[object Array]" : this.id = Array.clone(x); break;+ case "[object Object]": this.id = Array.clone(x.get()); break; // another NodeID+ }+ }++ // get id+ this.get = function() {+ return this.id;+ }+ + // Add child node to id+ this.add = function(x) {+ this.id.push(parseInt(x));+ return this.id;+ }++ // compare with other id+ this.equals = function(other) {+ return JSON.stringify(this.id)==JSON.stringify(other.id);+ }++ // clone+ this.clone = function() {+ return new NodeID( this );+ }++ // Return NodeID as string+ this.toString = function() {+ return this.id.toString();+ }+}++/* --- Abstract Syntax Tree (with state)------------------------------------- */++function ASTNode(data) {+ for (var d in data) this[d]=data[d];+ this.children = [];+ if (data) for (var c in data.children) {+ this.children.push( new ASTNode(data.children[c]) );+ }+ this.hasChildren = function(){+ return this.children.length > 0;+ }++ // generic HOF for traversing tree+ this.traverse = function(f) {+ function visit(node) {+ f(node);+ for (var i in node.children) {+ visit(node.children[i]);+ }+ }+ visit(this);+ }+ +}++function AST(fun, cat) {++ // local helper function for building ASTNodes+ var newNode = function(fun, cat) {+ return new ASTNode({+ "fun": fun,+ "cat": cat,+ "string": "", // for String literals+ "deps": {}, // dependent types+ "children": []+ });+ }++ this.root = newNode(fun, cat);+ + this.currentID = new NodeID(); // current id in tree+ this.currentNode = this.root; // current node in tree++ this.getCurrentNode = function() {+ return this.currentNode;+ }+ this.getCurrentID = function() {+ return this.currentID;+ }+ this.setCurrentID = function(id) {+ this.currentID = id; // new new NodeID(id);+ this.currentNode = this.find(this.currentID);+ }++ this.hasParent = function() {+ return this.currentID.get().length > 1;+ // return !this.atRoot();+ }+ this.atRoot = function() {+ return this.currentNode == this.root;+ // return !this.hasParent();+ }++ this.getRoot = function() {+ return this.root;+ }+ this.getFun = function() {+ return this.currentNode.fun;+ }+ this.setFun = function(f) {+ this.currentNode.fun = f;+ }+ this.getCat = function() {+ return this.currentNode.cat;+ }+ this.setCat = function(c) {+ this.currentNode.cat = c;+ }++ // Add a single type dependency at current node+ this.addDep = function(k, type) {+ // Add unassigned type variable to current+ this.currentNode.deps[k] = null;++ // Add actual type dep node+ var node = newNode(k, type);+ node.depid = k; // links to dep in parent+ this._add(this.currentID, node);+ return node;+ }++ // Add a node as child of current node+ this.add = function(fun, cat) {+ var node = newNode(fun,cat);+ this._add(this.currentID, node);+ return node;+ }++ // add node as child of id+ this._add = function(id, node) {+ var x = this.find(id);+ x.children.push(node);+ }++ // Wrap the current node inside another node+ // Doesn't check whether child_ix is within in range+ this.wrap = function(typeobj, child_ix) {+ var subtree = new ASTNode(this.currentNode);+ this.currentNode.fun = typeobj.name;+ this.currentNode.cat = typeobj.ret;+ this.currentNode.children = [];+ for (var i in typeobj.args) {+ this.add(null, typeobj.args[i]);+ }+ this.currentNode.children[child_ix] = subtree;+ return subtree;+ }++ // Wrap the current node inside another node+ // Doesn't check whether child_ix is within in range+ this.unwrap = function() {+ var parent_id = this.currentID.clone();+ parent_id.get().pop();+ if (parent_id.get().length==1) {+ this.root = this.currentNode;+ this.currentID = new NodeID();+ } else {+ var gparent_id = parent_id.clone();+ gparent_id.get().pop();+ var gparent = this.find(gparent_id);+ child_ix = parent_id.clone().get().pop();+ gparent.children[child_ix] = this.currentNode;+ this.currentID = parent_id;+ }+ }++ // Determine if current node is writable (empty/no children)+ this.is_writable=function() {+ var cn = this.currentNode;+ var blank = cn.fun == null || cn.children.length == 0;+ return blank;+ }++ // Determine if a fun would fit in a current hole+ this.fits_in_place=function(typeobj) {+ var cn = this.currentNode;++ var inplace = false;+ if (typeobj.args.length == cn.children.length) {+ var matches = 0;+ for (var i in typeobj.args) {+ if (typeobj.args[i] == cn.children[i].cat)+ matches++;+ }+ inplace = matches == cn.children.length;+ }+ return inplace;+ }++ // Set entire subtree at current node+ this.setSubtree = function(node) {+ this._setSubtree(this.currentID, node);+ }+ + // set tree at given id+ this._setSubtree = function(id, subtree) {+ var lid = Array.clone(id.get()); // clone NodeID array+ var node = this.root;++ if (lid.length==1) {+ // Insert at root+ this.currentNode = this.root = new ASTNode(subtree);+ }+ else {+ lid.shift(); // throw away root+ while (lid.length>1 && node.hasChildren()) {+ node = node.children[lid.shift()];+ }+ this.currentNode = node.children[lid.shift()] = new ASTNode(subtree);+ }+ }++ // Find a node in the tree from its ID+ this.find = function(id) {+ var lid = undefined+ if (Object.prototype.toString.call(id) == "[object Object]") {+ lid = Array.clone( id.get() );+ } else {+ alert("non-NodeID passed to AST.find()");+ }+ var node = this.root;+ if (lid[0] == 0) lid.shift();+ while (lid.length>0 && node.children.length>0) {+ node = node.children[lid.shift()];+ }+ if (lid.length>0)+ return undefined;+ return node;+ }+ + // Clear children of current node+ this.removeChildren = function() {+ this.currentNode.children = [];+ }++ // Move current ID to next hole+ this.toNextHole = function() {+ var id = new NodeID(this.currentID);+ + // loop until we're at top+ while (id.get().length > 0) {+ var node = this.find(id);++ // first check children+ for (var i in node.children) {+ var child = node.children[i];+ if (!child.fun) {+ var newid = new NodeID(id);+ newid.add(i);+ this.setCurrentID(newid);+ return;+ }+ }++ // otherwise go up to parent+ id.get().pop();+ }+ }++ // Return parent of current node+ this.getParent = function() {+ var parent_id = this.currentID.clone();+ parent_id.get().pop();+ return this.find(parent_id);+ }++ // Move current id to child number i+ this.toChild = function(i) {+ if (i < this.currentNode.children.length) {+ this.currentID.add(i);+ this.currentNode = this.currentNode.children[i];+ }+ }++ // generic HOF for traversing tree+ // this.traverse = function(f) {+ // this.root.traverse(f);+ // }+ this.traverse = function(f) {+ function visit(id, node) {+ f(node);+ for (var i in node.children) {+ var newid = new NodeID(id);+ newid.add(parseInt(i));+ visit(newid, node.children[i]);+ }+ }+ visit(new NodeID(), this.root);+ }++ // Return tree as string+ this.toString = function() {+ var s = "";+ function visit(node) {+ if (node.cat == "String")+ s += '"' + ((node.string) ? node.string : "") + '"';+ else+ s += node.fun ? node.fun : "?" ;+ if (!node.hasChildren())+// if (node.children.length == 0)+ return;+ for (var i in node.children) {+ s += " (";+ visit(node.children[i]);+ s += ")";+ }+ }+ visit(this.root);+ return s;+ }++}+ +// Parse type signature into a JSON object+// (This probably needs a better home)+AST.parse_type_signature = function(str) {+ var obj = {+ signature: str,+ type: undefined,+ name: undefined,+ deps: [],+ args: [],+ ret: undefined+ };+ var ix = str.indexOf(":");+ + // judgement type+ var bits = str.substr(0, ix).trim().split(" ");+ obj.type = bits[0];++ // name (possibly with constructors)+ obj.name = bits.slice(1).join(" ");+ + // function args (possibly with type dependency)+ var regex_dep = new RegExp(/\(\s*(.+?)\s*:\s*(.+?)\s*\)/);+ var bits = map(function(s){return s.trim()}, str.substr(ix+1).split("->"));+ for (var i=0 ; i<bits.length-1; i++) {+ var bit = bits[i];+ var m = regex_dep.exec(bit);+ if (m == null) {+ obj.args.push(bit);+ } else {+ // We have a type dependency+ obj.deps.push({ "id": m[1], "type": m[2] });+ }+ }++ //return type+ obj.ret = bits[bits.length-1];++ return obj;+}+
@@ -0,0 +1,140 @@+body.syntax-editor {+ background: #ccc url("../minibar/brushed-metal.png");+}++.hidden+{+ display:none;+}++.editor select#to_menu+{+ height: 10em;+ position: absolute;+ min-width: 5em;+ }++#import+{+ position: absolute;+ display: inline-block;+ padding: 0.3em;+ background: #EEE;+ border: 1px solid #999;+ font-size: 0.95em;+ box-shadow: 2px 2px 4px rgba(0, 0, 0, 0.3);+ }+#import.hidden+{+ display: none;+ }+#import input[type=text]+{+ width: 20em;+ font-family: monospace;+ padding: 0.2em;+ }++#tree, #tree_str+{+ white-space:pre-wrap;+ font-family: monospace;+ background: rgba(238, 238, 238, 0.6);+ padding:0.5em;+ margin:0.5em 0;+ }++#tree .node+{+ margin: 0.5em 0 0.5em 0.75em;+ border-left: 1px dashed #BBB;+ padding-left: 1.25em;+ }+#tree .node.first+{+ margin-left: 0;+ border-left: none;+ }++#tree .node a+{+ cursor: pointer;+ }+#tree .node a:hover+{+ text-decoration: underline;+ }+#tree .node a.current+{+ font-weight: bold;+ }++#tree_str+{+ font-size:0.85em;+ color:#666;+ }++#refinements+{+ /* display: inline-block; */+ /* margin-left: 0.5em; */+ margin-top: 0.3em;+ border: 3px solid #e0e0e0;+ padding: 5px;+ }++#linearisations+{+ /* background: rgba(170, 170, 170, 0.5); */+ /* padding:0.5em; */+ margin:0.5em 0;+ }+#linearisations div+{+ padding:0.2em;+ }+#linearisations .lang+{+ display: inline-block;+ margin-right: 0.5em;+ width: 3em;+ font-weight: bold;+ text-align: center;+ }+#linearisations .lin+{+ }++.refinement+{+ margin: 0.1em;+ display: inline-block;+ cursor: pointer;+ border: 1px solid;+ padding: 0.2em;+ font: 0.9em sans-serif;+ background: white;+ box-shadow: 2px 2px 4px rgba(0, 0, 0, 0.3);+ }+.refinement.disabled+{+ opacity: 0.5;+ }++div#debug+{+ font: 10px monospace;+ white-space: pre-wrap;+ color: #333;+ margin: 1em 0;+ border: 1px dashed #999;+ padding: 1em;+ }++/* From http://www.grammaticalframework.org/css/style.css */+.about table { border-collapse: collapse; }+.about th,+.about td { border: 1px solid #333; padding:0 5px; }+.about td { background: white; }+.about th { background: #9df; }
@@ -0,0 +1,46 @@+<!doctype html>+<html lang="en">+<head>+ <meta charset="utf-8">+ <link rel="author" href="http://www.grammaticalframework.org/~john/" title="John J. Camilleri">+ <title>Syntax Editor</title>+ <link rel="stylesheet" type="text/css" href="../minibar/minibar.css" />+ <link rel="stylesheet" type="text/css" href="editor.css" />+</head>+<body class="syntax-editor">+ <h2>Syntax Editor</h2>+ <div id="minibar"></div>+ <div id="editor"></div>+ <noscript>This page doesn't work unless JavaScript is enabled.</noscript>++ <hr />+ <small class="modtime">+ John J. Camilleri, December 2012 </br>+ [ <a href="about.html">About syntax editor</a>+ | <a href="../minibar/minibar.html">Minibar</a> ]+ </small>+ <div id="debug" class="hidden"></div>++ <!-- Common -->+ <script type="text/javascript" src="../js/grammar_manager.js"></script>+ <script type="text/javascript" src="../js/support.js"></script>+ <script type="text/JavaScript" src="../js/localstorage.js"></script>+ <script type="text/javascript" src="../js/pgf_online.js"></script>+ <script type="text/JavaScript" src="../js/langcode.js"></script>++ <!-- Editor -->+ <script type="text/javascript" src="ast.js"></script>+ <script type="text/javascript" src="editor_menu.js"></script>+ <script type="text/javascript" src="editor.js"></script>++ <!-- Minibar -->+ <script type="text/JavaScript" src="../minibar/minibar.js"></script>+ <script type="text/JavaScript" src="../minibar/minibar_input.js"></script>+ <script type="text/JavaScript" src="../minibar/minibar_translations.js"></script>+ <script type="text/JavaScript" src="../minibar/minibar_support.js"></script>++ <!-- Get us rolling! -->+ <script type="text/javascript" src="editor_online.js"></script>+ +</body>+</html>
@@ -0,0 +1,588 @@+/* --- Main Editor object --------------------------------------------------- */+function Editor(gm,opts) {+ var t = this;+ /* --- Configuration ---------------------------------------------------- */++ // default values for options:+ this.options={+ target: "editor",+ initial: {+ grammar: null,+ startcat: null,+ languages: null,+ abstr: null,+ node_id: null+ },+ show: {+ grammar_menu: true,+ startcat_menu: true,+ to_menu: true,+ random_button: true+ }+ }++ // Apply supplied options+ if(opts) for(var o in opts) this.options[o]=opts[o];++ /* --- Creating UI components ------------------------------------------- */+ this.container = document.getElementById(this.options.target);+ this.container.classList.add("editor");++ this.ui = {+ menubar: div_class("menu"),++ tree: div_id("tree"),++ tree_str: div_id("tree_str"),++ actionbar: div_id("actions"),+ clear_button: button("Clear", function(){+ t.clear_node();+ }),+ wrap_button: button("Wrap…", function(){+ t.wrap_candidates();+ }),+ unwrap_button: button("Unwrap", function(){+ t.unwrap();+ }),++ refinements: div_id("refinements"),++ lin: div_id("linearisations")+ };+ this.ui.clear_button.title = "Clear current node and all its children";+ this.ui.wrap_button.title = "Wrap the current node with a new function";+ this.ui.unwrap_button.title = "Replace parent of current node with current node (if possible)";++ appendChildren(this.container, [+ t.ui.menubar,+ t.ui.tree,+ t.ui.tree_str,+ t.ui.actionbar,+ t.ui.lin+ ]);+ appendChildren(this.ui.actionbar, [+ t.ui.clear_button,+ t.ui.wrap_button,+ t.ui.unwrap_button,+ t.ui.refinements+ ]);++ /* --- Client state initialisation -------------------------------------- */+ this.gm = gm;+ this.server = gm.server;+ this.ast = null;+ this.clear_on_change_startcat = true; // temp. false when wrapping++ /* --- Register Grammar Manager hooks ----------------------------------- */+ this.hook_change_grammar = function(grammar){+ debug("Editor: change grammar");+ var args = {+ format: "json"+ };+ var cont = function(data){+ t.process_grammar_constructors(data);+ t.start_fresh();+ };+ t.server.browse(args, cont);+ };+ this.hook_change_startcat = function(startcat){+ debug("Editor: change startcat");+ t.startcat = startcat;+ if (t.clear_on_change_startcat)+ t.start_fresh();+ };+ this.hook_change_languages = function(languages){+ debug("Editor: change languages");+ t.update_linearisation();+ };+ this.gm.register_action("change_grammar",this.hook_change_grammar);+ this.gm.register_action("change_startcat",this.hook_change_startcat);+ this.gm.register_action("change_languages",this.hook_change_languages);++ /* --- Main program, this gets things going ----------------------------- */+ this.menu = new EditorMenu(this, this.options);++ /* --- Other basic stuff ------------------------------------------------ */+ this.shutdown = function() {+ t.gm.unregister_action("change_grammar",t.hook_change_grammar);+ t.gm.unregister_action("change_startcat",t.hook_change_startcat);+ t.gm.unregister_action("change_languages",t.hook_change_languages);+ clear(t.container);+ t.container.classList.remove("editor");+ }+ this.hide = function() {+ t.container.style.display="none";+ }+ this.show = function() {+ t.container.style.display="block";+ }++}++/* --- Pre-processed grammar information ------------------------------------ */++Editor.prototype.process_grammar_constructors=function(data) {+ var t = this;+ t.grammar_constructors=data;+ for (var fun in t.grammar_constructors.funs) {+ var def = t.grammar_constructors.funs[fun].def;+ var typeobj = AST.parse_type_signature(def);+ t.grammar_constructors.funs[fun] = typeobj;+ }+}++// Look up information for a category+Editor.prototype.lookup_cat = function(cat) {+ var t = this;+ return t.grammar_constructors.cats[cat];+}++// Look up information for a function+Editor.prototype.lookup_fun = function(fun) {+ var t = this;+ return t.grammar_constructors.funs[fun];+}++/* --- API for getting and setting state ------------------------------------ */++Editor.prototype.get_ast=function() {+ return this.ast.toString();+}++Editor.prototype.get_startcat=function() {+ return this.gm.startcat;+}++// Called from Minibar, for example+Editor.prototype.initialize_from=function(opts) {+ var t = this;+ if (opts.abstr) {+ t.ast = new AST(null, t.get_startcat());+ t.import_ast(opts.abstr);+ }+}++// Called after changing grammar or startcat+Editor.prototype.start_fresh=function () {+ var t = this;+ t.ast = new AST(null, t.get_startcat());+ if (t.options.initial.abstr) {+ t.import_ast(t.options.initial.abstr);+ t.options.initial.abstr = null; // don't use again+ }+ t.update_current_node();+ clear(t.ui.lin);+}++/* --- Functions for handling tree manipulation ----------------------------- */++// Add refinement to UI, returning object+Editor.prototype.add_refinement=function(fun,opts) {+ var t = this;+ options = {+ label: fun,+ disable_destructive: false+ };+ if (opts) for (var o in opts) options[o] = opts[o];+ var typeobj = t.lookup_fun(fun);++ // hide refinement if identical to current fun?++ var opt = span_class("refinement", text(options.label));+ opt.title = typeobj.signature;++ // If refinement would be destructive, disable it+ if (options.disable_destructive) {+ var blank = t.ast.is_writable();+ var inplace = t.ast.fits_in_place(typeobj);+ if (!blank && !inplace) {+ opt.classList.add("disabled");+ }+ }++ t.ui.refinements.appendChild(opt);+ return opt;+}++// Add a literal refinement to UI, e.g. String+Editor.prototype.add_literal_refinement=function() {+ var t = this;+ t.ui.refinements.innerHTML = "Enter string: ";+ var nde = t.ast.getCurrentNode();+ var val = (nde.string) ? nde.string : "";+ var input = node("input",{+ type:"text",+ value: val+ },[]);+ // TODO: Perhaps we should have an update button instead+ input.onkeyup = function() {+ nde.string = input.value;+ t.redraw_tree();+ t.update_linearisation();+ }+ t.ui.refinements.appendChild(input);+}++// Show refinements for given cat (usually that of current node)+Editor.prototype.get_refinements=function(cat) {+ var t = this;+ t.ui.refinements.innerHTML = "…";+ if (cat == undefined) cat = t.ast.getCat();++ // Special case when cat is "String"+ if (cat == "String") {+ t.add_literal_refinement();+ return;+ }++ var args = {+ id: cat,+ format: "json"+ };+ var cont = function(data){+ clear(t.ui.refinements);+ // t.ui.refinements.innerHTML = "Refinements: ";+ function addClickHandler(fun) {+ return function() {+ t.select_refinement.apply(t,[fun]);+ }+ }+ for (var pi in data.producers) {+ var fun = data.producers[pi];+ var ref = t.add_refinement(fun, {+ disable_destructive: true+ });+ ref.onclick = addClickHandler(fun);+ }+ };+ var err = function(data){+ clear(t.ui.refinements);+ alert("Error");+ };+ t.server.browse(args, cont, err);+}++// Select refinement now by default replaces "in-place"+// Case 1: current node is blank/no kids+// Case 2: kids have all same types, perform an in-place replacement+// Case 3: kids have diff types/number, prevent replacement (must clear first)+Editor.prototype.select_refinement=function(fun) {+ var t = this;++ // Check if current node is blank or childless (case 1)+ var blank = t.ast.is_writable();++ // Check if we can replace in-place (case 2)+ var typeobj = t.lookup_fun(fun);+ var inplace = !blank && t.ast.fits_in_place(typeobj);++ if (!blank && !inplace) {+ alert("Use 'Clear' first if you want to replace the subtree.");+ return;+ }++ t.ast.setFun(fun);++ if (blank) {+ t.ast.removeChildren();++ // Add dependent type placeholders+ if (typeobj.deps.length > 0) {+ alert("the syntax editor current doesn't support dependent types");+ // for (var i in typeobj.deps) {+ // t.ast.addDep(typeobj.deps[i].id, typeobj.deps[i].type);+ // }+ }+ // Add function argument placeholders+ if (typeobj.args.length > 0) {+ for (var i in typeobj.args) {+ t.ast.add(null, typeobj.args[i]);+ }+ }+ }++ // Update ui+ t.redraw_tree();+ t.update_linearisation();++ // Select next hole & get its refinements+ t.ast.toNextHole();+ t.update_current_node();+}++Editor.prototype.update_current_node=function(newID) {+ with(this) {+ if (newID)+ ast.setCurrentID(newID);+ redraw_tree();+ get_refinements();+ }+}++// Clear current node and all its children+Editor.prototype.clear_node = function() {+ var t = this;+ t.ast.removeChildren();+ t.ast.setFun(null);+ t.redraw_tree();+ t.get_refinements();+}++// Show wrap candidates+Editor.prototype.wrap_candidates = function() {+ var t = this;++ // we need to end with this+ var cat = t.ast.getCat();++ var refinements = [];+ for (var i in t.grammar_constructors.funs) {+ var obj = t.grammar_constructors.funs[i];+ if (elem(cat, obj.args)) {+ // if no parent, then cat can be anything+ // as long as the current tree fits somewhere+ if (!t.ast.hasParent() || obj.ret==cat) {+ refinements.push(obj);+ }+ }+ }++ if (refinements.length == 0) {+ alert("No functions exist which can wrap the selected node.");+ return;+ }++ // Display wrap refinements+ function addClickHandler(fun, child_ix) {+ return function() {+ t.wrap.apply(t,[fun, child_ix]);+ }+ }+ t.ui.refinements.innerHTML = "Wrap with: ";+ for (var i in refinements) {+ var typeobj = refinements[i];+ var fun = typeobj.name;++ // Find valid child ids+ var child_ixs = [];+ for (var a in typeobj.args) {+ if (typeobj.args[a] == cat) {+ child_ixs.push(a);+ }+ }++ // if (child_ixs.length < 2) {+ // var ref = t.add_refinement(fun);+ // ref.onclick = addClickHandler(typeobj.name, a);+ // } else {+ // Show a refinement for each potential child position+ for (var c in child_ixs) {+ var id = child_ixs[c];+ var label = fun;+ for (var a in typeobj.args) {+ if (a == id)+ if (t.ast.currentNode.hasChildren())+ label += " ("+t.ast.currentNode.fun+" …)";+ else+ label += " "+t.ast.currentNode.fun;+ else+ label += " ?";+ }+ var ref = t.add_refinement(typeobj.name, {label: label});+ ref.onclick = addClickHandler(typeobj.name, id);+ }+ // }+ }+}++// Wrap the current node inside another function+Editor.prototype.wrap = function(fun, child_ix) {+ var t = this;+ var typeobj = t.grammar_constructors.funs[fun];++ // if we are at root node, potentially change startcat+ if (t.ast.atRoot() && t.get_startcat() != typeobj.ret) {+ var old_val = t.clear_on_change_startcat;+ t.clear_on_change_startcat = false;+ t.gm.change_startcat(typeobj.ret);+ t.clear_on_change_startcat = old_val;+ }++ // do actual replacement+ t.ast.wrap(typeobj, child_ix);++ // refresh stuff+ t.redraw_tree();+ t.update_linearisation();+ t.ast.toNextHole();+ t.update_current_node();+}++// Unwrap a node by deleting a fun with same input/output category+Editor.prototype.unwrap = function() {+ var t = this;+ var fun = t.ast.getFun();+ var typeobj = t.grammar_constructors.funs[fun];++ // Cannot unwrap when at root+ if (t.ast.atRoot()) {+ alert("It is not possible to unwrap the top node");+ return;+ }++ var child = t.ast.getCurrentNode();+ var parent = t.ast.getParent();++ // TODO: We can also unwrap when at level one and cats don't match++ // Check if unwrap is possible+ if (parent.children.length==1 &&+ (parent.cat==child.cat || parent==t.ast.getRoot())+ ) {++ // do actual unwrap+ t.ast.unwrap();++ // if root node changed, potentially change startcat+ var rootcat = t.ast.getRoot().cat;+ if (rootcat != t.get_startcat()) {+ var old_val = t.clear_on_change_startcat;+ t.clear_on_change_startcat = false;+ t.gm.change_startcat(rootcat);+ t.clear_on_change_startcat = old_val;+ }++ // refresh stuff+ t.redraw_tree();+ t.update_linearisation();+ // t.ast.toNextHole();+ // t.update_current_node();+ } else {+ alert("Cannot unwrap this node");+ }+}++// Generate random subtree from current node+Editor.prototype.generate_random = function() {+ var t = this;+ t.ast.removeChildren();+ var args = {+ cat: t.ast.getCat(),+ limit: 1+ };+ if (!args.cat) {+ alert("Missing category at current node");+ return;+ }+ var cont = function(data){+ var tree = data[0].tree;+ t.import_ast(tree);+ };+ var err = function(data){+ alert("Error");+ };+ t.server.get_random(args, cont, err);+}++// Redraw tree+Editor.prototype.redraw_tree=function() {+ var t = this;+ var elem = node; // function from support.js+ function visit(container, id, node) {+ var container2 = empty_class("div", "node");+ if (id.get().length == 1)+ container2.classList.add("first");++ // Special case for String literal+ if (node.cat == "String") {+ var label =+ '"' + ((node.string) ? node.string : "") + '"' ++ " : String";+ } else {+ var label =+ ((node.fun) ? node.fun : "?") + " : " ++ ((node.cat) ? node.cat : "?");+ }++ var current = id.equals(t.ast.getCurrentID());+ var element = elem("a", {class:(current?"current":"")}, [text(label)]);+ element.onclick = function() {+ t.update_current_node(id);+ }+ container2.appendChild( element );++ for (var i in node.children) {+ var newid = new NodeID(id);+ newid.add(parseInt(i));+ visit(container2, newid, node.children[i]);+ }++ container.appendChild(container2);+ }+ with(this) {+ clear(ui.tree);+ ui.tree_str.innerText = ast.toString();+ visit(ui.tree, new NodeID(), ast.root);+ }+}++// Get and display linearisations for AST+Editor.prototype.update_linearisation=function(){+ var t = this;+ // langpart("FoodsEng","Foods") == "Eng"+ function langpart(conc,abs) {+ return hasPrefix(conc,abs) ? conc.substr(abs.length) : conc;+ }+ function row(lang, lin) {+ var langname = langpart(lang, t.gm.grammar.name);+ var btn = button(langname, function(){+ bind(t.options.lin_action,t)(lin,lang);+ });+ if (t.options.lin_action_tooltip) {+ btn.title = t.options.lin_action_tooltip;+ }+ var c1 = th(btn);+ var c2 = td(text(lin));+ var row = tr([c1,c2]);+ return row;+ }+ var args = {+ tree: t.ast.toString()+ };+ t.server.linearize(args, function(data){+ clear(t.ui.lin);+ var tbody=empty("tbody");+ for (var i in data) {+ var lang = data[i].to;+ if (t.gm.languages.length < 1 || elem(lang, t.gm.languages)) {+ tbody.appendChild(row(lang, data[i].text))+ }+ }+ t.ui.lin.appendChild(wrap("table",tbody));+ });+}++// Import AST from string representation, setting at current node+Editor.prototype.import_ast = function(abstr) {+ var t = this;+ var args = {+ tree: abstr+ };+ var cont = function(tree){+ // Build tree of just fun, then populate with cats+ t.ast.setSubtree(tree);+ /// TODO: traverse only subtree, not everything!+ t.ast.traverse(function(node){+ if (!node.fun) return;+ var typeobj = t.lookup_fun(node.fun);+ node.cat = typeobj.ret;+ });+ t.redraw_tree();+ t.update_linearisation();+ };+ var err = function(tree){+ alert("Invalid abstract syntax tree");+ };+ t.server.pgf_call("abstrjson", args, cont, err);+}
@@ -0,0 +1,197 @@+/* --- Editor Menu object --------------------------------------------------- */+function EditorMenu(editor,opts) {+ var t = this;+ /* --- Configuration ---------------------------------------------------- */++ // default values for options:+ this.options={+ target: "editor",+ show_grammar_menu: true,+ show_startcat_menu: true,+ show_to_menu: true,+ show_random_button: true,+ show_import: true,+ show_debug: false,+ }++ // Apply supplied options+ if(opts) for(var o in opts) this.options[o]=opts[o];++ /* --- Creating UI components ------------------------------------------- */+ this.container = editor.ui.menubar;+ this.ui = {+ grammar_menu: empty_id("select","grammar_menu"),+ startcat_menu: empty("select"),+ to_toggle: button("Languages…", function(){+ toggleHidden(t.ui.to_menu);+ }),+ to_menu: node("select",{+ id: "to_menu",+ multiple: "multiple",+ class: "hidden"+ }),+ random_button: button("Random", function(){+ t.editor.generate_random();+ }),+ import: {+ toggle: button("Import…", function(){+ toggleHidden(t.ui.import.panel);+ }),+ panel: node("div",{+ id: "import",+ class: "hidden"+ }),+ input: node("input",{type:"text"},[]),+ button: button("Import", function(){+ t.editor.import_ast(t.ui.import.input.value);+ toggleHidden(t.ui.import.panel);+ })+ },++ debug_toggle: button("⚙", function(){+ toggleHidden(element("debug"));+ })+ };+ this.ui.to_toggle.title = "Select languages to linearise to (use Ctrl/Shift to select multiple)";+ this.ui.random_button.title = "Insert a randomly generated tree at the current node";+ this.ui.import.toggle.title = "Import an abstract syntax tree from a string (replaces current tree)";+ this.ui.debug_toggle.title = "Toggle the debug console";++ if (t.options.show_grammar_menu) {+ appendChildren(t.container, [text(" Grammar: "), t.ui.grammar_menu]);+ t.ui.grammar_menu.onchange = function(){+ var grammar_url = t.ui.grammar_menu.value;+ t.gm.change_grammar(grammar_url);+ }+ }+ if (t.options.show_startcat_menu) {+ appendChildren(t.container, [text(" Start Category: "), t.ui.startcat_menu]);+ t.ui.startcat_menu.onchange = function(){+ var startcat = t.ui.startcat_menu.value;+ t.gm.change_startcat(startcat);+ }+ }+ if (t.options.show_to_menu) {+ appendChildren(t.container, [text(" To: "), t.ui.to_toggle, t.ui.to_menu]);+ t.ui.to_menu.onchange = function(){+ var languages = multiMenuSelections(t.ui.to_menu)+ t.gm.change_languages(languages);+ }+ }+ if (t.options.show_random_button) {+ appendChildren(t.container, [t.ui.random_button]);+ }+ if (t.options.show_import) {+ appendChildren(t.container, [+ t.ui.import.toggle,+ t.ui.import.panel+ ]);+ appendChildren(t.ui.import.panel, [+ text("Import AST: "),+ t.ui.import.input,+ t.ui.import.button+ ]);+ }++ if (t.options.show_debug) {+ appendChildren(t.container, [t.ui.debug_toggle]);+ }++ /* --- Client state initialisation -------------------------------------- */+ this.editor = editor;+ this.gm = editor.gm;+ this.server = editor.server;++ /* --- Register Grammar Manager hooks ----------------------------------- */+ this.gm.register_action("onload", bind(this.hook_onload, this));+ this.gm.register_action("change_grammar", bind(this.hook_change_grammar, this));+ this.gm.register_action("change_startcat", bind(this.hook_change_startcat, this));++}++/* --- Grammar menu --------------------------------------------------------- */++// show the grammar list+EditorMenu.prototype.hook_onload=function(dir,grammar_names,dir_count) {+ debug("EditorMenu: onload");+ var t=this;+ var first_time=t.ui.grammar_menu.options.length == 0;+ if(first_time) {+ t.grammars=[];+ t.grammar_dirs=[];+ }+ t.grammar_dirs.push(dir);+ t.grammars=t.grammars.concat(grammar_names.map(function(g){return dir+g}))+ function glabel(g) {+ return hasPrefix(dir,"/tmp/gfse.") ? "gfse: "+g : g+ }+ function opt(g) { return option(glabel(g),dir+g); }+ appendChildren(t.ui.grammar_menu, map(opt, grammar_names));+ function pick_first_grammar() {+ if(t.timeout) clearTimeout(t.timeout),t.timeout=null;+ var grammar0=t.gm.options.initial.grammar;+ if(!grammar0) grammar0=t.grammars[0];+ t.ui.grammar_menu.value=grammar0;+// t.change_grammar();+ }+ // Wait at most 1.5s before showing the grammar menu.+ if(first_time) t.timeout=setTimeout(pick_first_grammar,1500);+ if(t.grammar_dirs.length>=dir_count) pick_first_grammar();+}++// Copied from minibar.js+EditorMenu.prototype.hook_change_grammar=function(grammar) {+ debug("EditorMenu: change grammar");+ var t=this;+ t.update_startcat_menu(grammar);+ t.update_language_menu(t.ui.to_menu, grammar);+}++/* --- Start category menu -------------------------------------------------- */++// Called from hook_change_grammar+EditorMenu.prototype.update_startcat_menu=function(grammar) {+ var t=this;+ var menu=this.ui.startcat_menu;+ menu.innerHTML="";+ var cats=grammar.categories;+ for(var cat in cats) menu.appendChild(option(cats[cat],cats[cat]))+ var startcat0 = t.gm.options.initial.startcat;+ if (elem(startcat0, cats))+ menu.value = startcat0;+ else+ menu.value = grammar.startcat;+}++// If startcat changed externally, update menu+EditorMenu.prototype.hook_change_startcat=function(startcat) {+ debug("EditorMenu: change startcat");+ var t=this;+ var menu=this.ui.startcat_menu;+ menu.value = startcat;+}++/* --- Langugage (to) menu -------------------------------------------------- */++// Called from hook_change_grammar+EditorMenu.prototype.update_language_menu=function(menu,grammar) {+ var t = this;+ function langpart(conc,abs) { // langpart("FoodsEng","Foods") == "Eng"+ return hasPrefix(conc,abs) ? conc.substr(abs.length) : conc;+ }+ // Replace the options in the menu with the languages in the grammar+ var langs=grammar.languages;+ menu.innerHTML="";++ for(var i=0; i<langs.length; i++) {+ var ln=langs[i].name;+ if(!hasPrefix(ln,"Disamb")) {+ var lp=langpart(ln,grammar.name);+ var opt=option(lp,ln);+ if (elem(ln, t.gm.languages)) {+ opt.selected=true;+ }+ menu.appendChild(opt);+ }+ }+}
@@ -0,0 +1,65 @@+var server_options = {+ // grammars_url: "http://www.grammaticalframework.org/grammars/",+ // grammars_url: "http://localhost:41296/grammars/",+}+var editor_options = {+ target: "editor",+ initial: {+// abstr: "PropOpenDate (SuperlPlace TheMostExpensive School) Tomorrow"+ },+ show: {+ grammar_menu: true,+ startcat_menu: true,+ to_menu: true,+ random_button: true+ }+}+var gm_options = {+ initial: {+ // grammar: "http://localhost:41296/grammars/Smart.pgf",+ // startcat: "Command",+ // languages: ["Eng","Swe"]+ }+}+if(window.Minibar) // Minibar loaded?+ editor_options.lin_action_tooltip="Load sentence in Minibar";+ editor_options.lin_action=function(s,langFrom) {+ var editor=this;+ var minibar_options = {+ target: "minibar",+ show_abstract: true,+ show_trees: true,+ show_grouped_translations: false,+ show_brackets: true,+ word_replacements: true,+ initial_grammar: editor.menu.ui.grammar_menu.value, // hmm+ initial: {+ from: langFrom,+ input: s.split(" "), // is it that easy?+ startcat: editor.menu.ui.startcat_menu.value // hmm+ },+ initial_toLangs: multiMenuSelections(editor.menu.ui.to_menu), // hmm++ // get us back to the editor!+ abstract_action: function(tree) {+ var opts = {+ abstr: tree+ }+ editor.initialize_from(opts);+ editor.minibar.hide();+ editor.show();+ }+ }+ editor.hide();+ editor.minibar=new Minibar(server,minibar_options);+ //editor.minibar.editor = editor; // :S+ editor.minibar.show();+ }+if(/^\?\/tmp\//.test(location.search)) {+ var args=decodeURIComponent(location.search.substr(1)).split(" ")+ if(args[0]) server_options.grammars_url=args[0];+}+var server = pgf_online(server_options);+var gm = new GrammarManager(server, gm_options);+var editor = new Editor(gm, editor_options);+
@@ -0,0 +1,83 @@+<!DOCTYPE html>+<html> <head>+<title>About: Simple Translation Tool</title>+<link rel="stylesheet" type="text/css" href="../gfse/editor.css" title="Cloud">+<link rel="alternate stylesheet" type="text/css" href="../gfse/molto.css" title="MOLTO">++<link rel=author href="http://www.cse.chalmers.se/~hallgren/" title="Thomas Hallgren">++<meta name = "viewport" content = "width = device-width">+<meta http-equiv="Content-type" content="text/html;charset=UTF-8">+<meta charset="UTF-8">+</head>++<body>+<h1><a href="../"><img src="../P/gf-cloud.png" alt="" title="GF Cloud Service"></a>About the Simple Translation Tool</h1>++<p>++<a href="./">This</a> is a simple bilingual document editor. Documents consist+of a sequence of segments that are translated independently. The user can import+text in the source language and obtain automatically translated text in the+target language. Imported text can be segmented based on punctuation.+Optionally, one can also use line breaks or blank lines to indicate segmentation+in imported text. Text can be edited after it has been imported.++<p>+Through menu options, the user sets the source and target language+for the document and chooses which translation method to use by default.+The tool supports the following machine translation services:+<ul>+ <li>The <a href="http://www.grammaticalframework.org/">GF</a> web service.+ The user picks which GF grammar to use from a menu of available grammars.+ <li>The <a href="http://www.apertium.org/">Apertium</a> web service.+ <li>The GF Robust Parser. This is an exprimental service that supports+ translation from English to a few other languages.+</ul>++<p>+If an unsatisfactory automatic translation is+obtained, the user can click on it and replace it with a manual translation.+If multiple translations are obtained, one of them is shown by default and+the other ones are available in a popup menu.++<p>+Source segments can also be edited. If a GF grammar is used for translation,+the <a href="../minibar/about.html">Minibar</a> and the+<a href="../syntax-editor/about.html">Syntax Editor</a> can be used.+A plain text box is also available, regardless of translation method.++<p>+The tool handles a set of documents. Documents can be named, saved,+closed and reopened later. Documents can be saved locally or in the cloud.++<h2>TODO</h2>+<ul>+ <li>Text can be imported by copying and pasting and from local files+ (in browsers that support it, currently Chrome, Firefox and Opera, but+ not Safari), but other ways could be added.+ <li>Text can be exported by copying and pasting, but other ways could+ be added.+ <li>GF's lexer/unlexer is used to allow for more natural looking text, but+ the unlexer does the wrong thing if the first word of a sentence is supposed+ to be capitalized, e.g. "I am ready." and "Spanish wine is good."+ <li>Document sharing in the cloud.+ <li>Interface to other translation services.+ <li>Interface to the grammar editor for grammar extension.+ <li>More browser compatibility testing (Chrome, Firefox, Safari &+ Opera Mobile tested so far).+ <li>...+ <li>...+</ul>+++<hr>+<div class=modtime><small>+<!-- hhmts start -->Last modified: Fri Apr 19 15:58:50 CEST 2013 <!-- hhmts end -->+ </small></div>+<address>+<a href="http://www.cse.chalmers.se/~hallgren/">TH</a>+<img src="http://www.altocumulus.org/~hallgren/online.cgi?icon" alt="">+</address>+</body>+ </html>
@@ -0,0 +1,110 @@+<!DOCTYPE html>+<html> <head>+<title>Simple Translation Tool</title>+<link rel="stylesheet" type="text/css" href="../gfse/editor.css" title="Cloud">+<link rel="stylesheet" type="text/css" href="translator.css" title="Cloud">+<link rel="stylesheet" type="text/css" href="../minibar/minibar.css">+<link rel=stylesheet type="text/css" href="../syntax-editor/editor.css">+<meta name = "viewport" content = "width = device-width">+<meta charset="UTF-8">+</head>++<body class=hover>+<div class=pagehead>+ <h1><img src="../P/gf-cloud.png" alt="" title="GF Cloud Service">Simple Translation Tool</h1>+<form name=options>+<table class=menubar>+ <tr><td><span onclick="">File</span>+ <dl>+ <dt onclick="translator.new(this)">New+ <dt onclick="translator.browse(this)">Open...+ <dt id="import_globalsight" onclick="translator.import_globalsight(this)">Import from GlobalSight...+ <dt onclick="translator.save(this)">Save+ <dt onclick="translator.saveAs(this)">Save As...+ <!--+ <dt onclick="translator.close(this)">Close+ -->+ <dt onclick="translator.open_in_wc(this)">Open in Wide Coverage Translation Demo+ </dl>+ <td><span onclick="">Edit</span>+ <dl>+ <dt id="edit_import" onclick="translator.import(this)">Import text...+ <dt id="edit_add_segment" onclick="translator.add_segment(this)">Add a segment...+ <dt id="edit_remove_segment" onclick="translator.remove(this)">Remove the last segment+ </dl>+ <td><span onclick="">View</span>+ <dl>+ <dt><label><input name=view value=segmentbysegment type=radio checked onchange="translator.change(this)">Segment by segment</label>+ <dt><label><input name=view value=paralleltexts type=radio onchange="translator.change(this)">Parallel texts</label>+ </dl>+ <td><span onclick="">Options</span>+ <dl>+ <dt>+ <table class=submenu>+ <tr><td><span onclick="">Source Language</span>+ <dl id=source>+ <dt><label><input name=source value=Eng type=radio onchange="translator.change(this)">English</label>+ <dt><label><input name=source value=Swe type=radio onchange="translator.change(this)">Swedish</label>+ <dt><label><input name=source value=Ita type=radio onchange="translator.change(this)">Italian</label>+ </dl>+ </table>+ <dt>+ <table class=submenu>+ <tr><td><span onclick="">Target Language</span>+ <dl id=target>+ <dt><label><input name=target value=Eng type=radio onchange="translator.change(this)">English</label>+ <dt><label><input name=target value=Swe type=radio onchange="translator.change(this)">Swedish</label>+ <dt><label><input name=target value=Ita type=radio onchange="translator.change(this)">Italian</label>+ </dl>+ </table>+ <dt>+ <table class=submenu>+ <tr><td><span onclick="">Default translation method</span>+ <dl id=methods>+ <dt><label><input name=method value=Manual type=radio onchange="translator.change(this)">Manual</label>+ <dt><label><input name=method value=GFRobust type=radio onchange="translator.change(this)">GF Wide Coverage Translation</label>+ </dl>+ </table>+ <dt><label><input name=cloud type=checkbox onchange="translator.change(this)"> Save in the cloud</label>+ </dl>+</table>+</form>+</div>+<div class=overlay><div id=filebox class=filebox></div></div>++<div id=document class=document>+...+ <noscript>This document translation editor requires JavaScript to work+ </noscript>+</div>+<hr>+<div class=modtime><small>HMTL+<!-- hhmts start -->Last modified: Fri Mar 6 12:46:23 CET 2015 <!-- hhmts end -->+</small></div>+<a href="about.html">About</a>++<script type="text/JavaScript" src="../js/grammar_manager.js"></script>+<script type="text/javascript" src="../js/support.js"></script>+<script type="text/javascript" src="../js/pgf_online.js"></script>+<script type="text/javascript" src="../js/gftranslate.js"></script>+<script type="text/javascript" src="../js/localstorage.js"></script>+<script type="text/javascript" src="../js/langcode.js"></script>+<script type="text/javascript" src="../gfse/localstorage.js"></script>+<script type="text/javascript" src="../gfse/cloud2.js"></script>++<script type="text/javascript" src="../minibar/minibar.js"></script>+<script type="text/javascript" src="../minibar/minibar_input.js"></script>+<script type="text/javascript" src="../minibar/minibar_translations.js"></script>+<script type="text/javascript" src="../minibar/minibar_support.js"></script>+<script type="text/javascript" src="../syntax-editor/ast.js"></script>+<script type="text/javascript" src="../syntax-editor/editor_menu.js"></script>+<script type="text/javascript" src="../syntax-editor/editor.js"></script>++<script type="text/javascript" src="translator.js"></script>++<script type="text/javascript" >+var translator = new Translator()+</script>+<script defer async type="text/javascript" src="http://api.apertium.org/JSLibrary.js" onload="translator.add_apertium()"></script>+</body>+</html>
@@ -0,0 +1,20 @@++div.overlay {+ display: none;+ position: absolute;+ z-index: 1;+ top: 0;+ left: 0;+ width: 100%; height: 100%;+ background: white; /* fallback */+ background: rgba(0,0,0,0.3);+}++div.overlay > div {+ margin: 5em 3em;+ background: white; /* fallback */+ background: rgba(255,255,255,0.95);+ padding: 1em;+ box-shadow: 4px 4px 12px rgba(0,0,0,0.33);+ /*border-radius: 5px;*/+}
@@ -0,0 +1,114 @@+@import url("overlay.css");++body { margin:0; padding: 5px; position: relative; }+h1 { float: right; margin: 0; font-size: 150%; }+h2 { font-size: 120%; }+h3 { font-size: 100%; }++div.pagehead {+ font-family: sans-serif;+ /*position: fixed; top: 5px; left: 5px; right: 5px; z-index: 2;*/+ background-color: #d0d0d0;+ padding: 1px 5px;+ border-radius: 5px;+}+table.menubar td { padding: 5px; cursor: default; }+table.menubar dl, td.options > div > dl, dl.popupmenu {+ z-index: 2;+ display: none; position: absolute;+ background: white; /* fallback */+ background: rgba(255,255,255,0.95);+ color: black;+ border: 1px solid black;+ margin: 0;+ padding: 5px 0;+ box-shadow: 4px 4px 12px rgba(0,0,0,0.33);+}+table.menubar td:hover > dl, :hover > dl.popupmenu { display: block; }+table.menubar dt, dl.popupmenu > dt { margin: 0; padding: 5px; }+table.submenu dt { padding: 0; }+table.menubar td:hover, table.menubar dt:hover, dl.popupmenu > dt:hover {+ background-color: #36f; color: white;+}+table.menubar dt.disabled { color: #999; }+table.menubar dt.disabled:hover { background-color: white; }+table table dl { left: 6em; }+table.menubar dt { white-space: nowrap; }+dt.unsupported { color: #999; }++div.document {+ /*margin-top: 7ex;*/+ clear: both;+ background: white;+ border: 2px solid #009;+ padding: 0.6ex;+}++div.document h2, div.document h3 { color: #009; }++table.segments { margin-left: auto; margin-right: auto; }+.current_segment, .segment:hover { background: #ff9; }++td.actions { padding: 1ex 1em 1ex 0.5em; }+td.options { padding: 1ex 1em; }+.segment td.source, .segment td.target {+ padding: 1ex;+ border-bottom: 2px solid #ccc;+ vertical-align: baseline;+}+td.options > div, td.actions > div { position: relative; margin: 0; }+td.options:hover > div > form > dl,td.actions:hover > div > dl {+ display: block;+}+td.options > div > form > dl, td.actions > div > dl {+ left: 1em;+ font-family: sans-serif;+ white-space: nowrap;+}++td.source input[name=it], td.target input[name=it], textarea, input[name=punctchars] {+ font-family: inherit; font-size: inherit;+}++td.source input[name=it], td.target input[name=it], textarea { width: 100%; }++table.paralleltexts td {+ padding: 1ex;+ vertical-align: baseline;+ line-height: 130%;+}+table.paralleltexts td.source {+ padding-right: 0.7em;+ border-right: 2px solid #ccc;+}+table.paralleltexts td.target { padding-left: 0.7em; }++label { font-family: sans-serif; }++form { margin: 0; }++form.import { + min-width: 90%; /* extend to availiable width for Safari */+ /*background: #eee;*/+ margin: 10px; /* extend to available width for other browsers */+ padding: 10px;+ box-shadow: 4px 4px 12px rgba(0,0,0,0.33);+}++span.actions { visibility: hidden; }+tr:hover div > span.actions { visibility: visible; }+span.arrow, span.actions { color: blue; }+span.error { color: red; }+span.choices { color: blue; font-weight: bold; font-family: sans-serif; }++.default_quality { background-color: #ffc; background-color: rgba(255,255,0,0.20) }+.high_quality { background-color: #cfc; background-color: rgba(0,255,0,0.20); }+.low_quality { background-color: #fcc; background-color: rgba(255,0,0,0.20); }+.bad_quality { background-color: #f88; background-color: rgba(255,0,0,0.53); }+.manual_quality { background-color: #ccf; background-color: rgba(0,0,255,0.20); }++div#minibar, div#syntax_editor {+ border: 1px solid black;+ padding: 5px;+ background: #ccc url("../minibar/brushed-metal.png");+}
@@ -0,0 +1,1321 @@+++/* --- Translator object ---------------------------------------------------- */++function Translator() {+ var t=this++ t.local=appLocalStorage("gf.translator.")+ t.view=element("document")+ t.filebox=element("filebox")+ if(!supports_html5_storage()) {+ var warning=span_class("error",text("It appears that localStorage is unsupported or disabled in this browser. Local documents will not be preserved after you leave or reload this page!"))+ insertAfter(warning,t.view)+ }+ if(!supports_local_files()) {+ var item=element("import_globalsight")+ if(item) item.style.display="none"+ }+ t.servers={}; //The API is stateful, use one pgf_online object per grammar+ t.grammar_info={};+ pgf_online({}).get_grammarlist(bind(t.extend_methods,t))++ function update_language_menu(t,id) {+ var dl=element(id);+ clear(dl);+ for(var i in languages) {+ var l=languages[i]+ dl.appendChild(dt(radiobutton(id,l.code,l.name,bind(t.change,t))))+ }+ }++ update_language_menu(t,"source")+ update_language_menu(t,"target")+ if(window.apertium) t.add_apertium()+ //initialize_sorting(["TR"],["segment"])+ t.document=empty_document();+ t.current=t.local.get("current")+ if(t.current && t.current!="/") {+ if(t.local.get("current_in_cloud")) t.open_from_cloud(t.current)+ else t.open(t.current)+ }+}++Translator.prototype.redraw=function() {+ var t=this;+ if(t.current=="/") t.browse()+ else {+ t.drawing=t.draw_document()+ clear(t.view)+ appendChildren(t.view,t.drawing.doc)+ var o=t.document.options+ var form=document.forms.options+ update_radiobutton(form,"method",o.method)+ update_radiobutton(form,"source",o.from)+ update_radiobutton(form,"target",o.to)+ update_radiobutton(form,"view",o.view || "segmentbysegment")+ update_checkbox("cloud",o.cloud || false)+ t.update_language_menus()+ t.update_translations()+ t.update_edit_menu()+ }+}++Translator.prototype.switch_grammar=function(grammar,cont) {+ var t=this+ var gi=t.grammar_info[grammar]+ if(gi) cont(gi)+ else {+ var pgf=t.servers[grammar]+ if(pgf) pgf.waiting.push(cont)+ else {+ pgf=t.servers[grammar]=pgf_online({grammar_list:[grammar]})+ pgf.waiting=[cont]+ function cont2(gr_info) {+ t.grammar_info[grammar]=gr_info+ //console.log("Passing grammar info for "+grammar+" to "+pgf.waiting.length+" clients")+ while(pgf.waiting.length>0) pgf.waiting.pop()(gr_info)+ }+ function cont1() { pgf.grammar_info(cont2)}+ pgf.switch_grammar(grammar,cont1)+ }+ }+}++Translator.prototype.update_edit_menu=function() {+ var t=this+ function set_class(id,name) {+ var e=element(id)+ if(e) e.className=name+ }++ var able= t.document.globalsight ? "disabled" : ""+ set_class("edit_import",able)+ set_class("edit_add_segment",able)+ set_class("edit_remove_segment",able)+}++Translator.prototype.update_language_menus=function() {+ var t=this+ var o=t.document.options+ var method=o.method+(o.method=="Apertium"?"/"+o.from:"")+ if(t.menus_for==method) return;+ t.menus_for=method+ function mark_menu(name,supported) {+ var menu=document.forms.options[name]+ for(var i=0;i<menu.length;i++)+ menu[i].parentNode.parentNode.className=+ (supported(menu[i].value)?"":"un")+"supported"+ }+ function mark_menus(ssupport,tsupport) {+ mark_menu("source",ssupport)+ mark_menu("target",tsupport)+ }+ function yes(code) { return true; }+ function no(code) { return false; }+ switch(o.method) {+ case "Manual":+ mark_menus(yes,yes)+ break;+ case "GFRobust":+ if(window.gftranslate) gftranslate.get_support(mark_menus)+ else mark_menus(no,no)+ break;+ case "Apertium":+ function ssupport(code) {+ return apertium.isTranslatable(alangcode(code))+ }+ function tsupport(code) {+ return apertium.isTranslatablePair(alangcode(o.from),alangcode(code))+ }+ if(window.apertium) mark_menus(ssupport,tsupport)+ else mark_menus(no,no)+ break;+ default: // GF+ function cont() {+ function gfsupport(code) { return t.gf_supported(o.method,code) }+ mark_menus(gfsupport,gfsupport)+ }+ t.switch_grammar(o.method,cont)+ }+}++Translator.prototype.gf_supported=function(grammar,langcode) {+ var t=this;+ var concname=t.grammar_info[grammar].name+langcode+ var l=t.grammar_info[grammar].languages+ for(var i in l) if(l[i].name==concname) return true+ return false+}++Translator.prototype.update_translations=function() {+ var t=this+ for(var i in t.document.segments) t.update_translation(i)+}++Translator.prototype.update_translation=function(i) {+ var t=this+ var doc=t.document+ var o=doc.options+ var ss=doc.segments+ var ds=t.drawing.segments+ var ts=t.drawing.targets+ var segment=ss[i]++ function draw_update() {+ if(ds) {+ var sd=t.draw_segment(segment,i)+ var old=ds[i]+ ds[i]=sd+ replaceNode(sd,old)+ }+ else if(ts) {+ clear(ts[i])+ ts[i].appendChild(qtext(segment.target))+ ts[i].appendChild(text(" "))+ }+ }+ function update_segment(m,txts) {+ segment.target=txts[0];+ segment.options={method:m,from:o.from,to:o.to} // no sharing!+ if(txts.length>1) segment.choices=txts+ else delete segment.choices+ draw_update()+ }+ function update_apertium_translation() {+ var afrom=alangcode(o.from), ato=alangcode(o.to)++ function upd3(txts) { update_segment("Apertium",txts) }++ function upd3s(txt) { upd3([{quality:"error",text:txt}]) }++ function upd1(res) {+ //console.log(translate_output)+ if(res.translation) upd3([res.translation])+ else upd3s("["+res.error.message+"]")+ }++ function upd0(source) { apertium.translate(source,afrom,ato,upd1) }++ if(!window.apertium)+ upd3s("[Apertium is not available]")+ else if(apertium.isTranslatablePair(afrom,ato)) {+ if(!eq_options(segment.options,o)) upd0(segment.source)+ }+ else+ upd3s("[Apertium does not support "+show_translation(o)+"]")+ }+ function update_gfrobust_translation() {+ function upd3(trans,sp,qf) {+ var ts=[]+ for(var i=0;i<trans.length;i++) {+ var t=trans[i].linearizations[0].text+ if(sp.punct) t=t+sp.punct+ if(!elem(t,ts)) ts.push(t)+ }+ update_segment("GFRobust",ts.map(qf || trans_text_quality))+ }++ function upd3s(txt) {+ update_segment("GFRobust",[{quality:"error",text:txt}])+ }++ function upd2b(trans,sp) {+ function badq(txt) { return {quality:"bad_quality",text:txt} }+ if(trans.length==0) upd3s("[no translation]")+ else upd3(trans,sp,badq)+ }++ // upd0b :: {txt:String,punct:String} -> ()+ function upd0b(sp) {+ function upd1b(translate_output) {+ //console.log(translate_output)+ upd2b(translate_output,sp)+ }+ gftranslate.wordforword(sp.txt,o.from,o.to,upd1b)+ }++ function upd2(trans,sp) {+ if(trans.length==0) upd0b(sp) // upd3s("[no translation]")+ else if(trans[0].error!=undefined)+ //upd3s("[GF robust translation problem: "+trans[0].error+"]")+ upd0b(sp)+ else upd3(trans,sp)+ }+ // upd0 :: {txt:String,punct:String} -> ()+ function upd0(sp) {+ function upd1(translate_output) {+ //console.log(translate_output)+ upd2(translate_output,sp)+ }+ gftranslate.translate(sp.txt,o.from,o.to,0,10,upd1)+ }+ if(!window.gftranslate)+ upd3s("[GF robust parser is not available]")+ else {+ function check_support(ssupport,tsupport) {+ var fls=ssupport(o.from)+ var tls=tsupport(o.to)+ if(fls && tls) {+ var want={from:o.from, to:o.to, method:"GFRobust"}+ if(!eq_options(segment.options,want)) {+ //console.log("Updating "+i)+ //lexgfrobust(segment.source,upd0)+ upd0(rmpunct(segment.source))+ }+ //else console.log("No update ",want,segment.options)+ }+ else {+ var fn=" from "+concname(o.from)+ var tn=" to "+concname(o.to)+ var msg="The GF robust translation service: not supported:"+ if(!fls) msg+=fn+(tls ? "." : ", ")+ if(!tls) msg+=tn+"."+ upd3s("["+msg+"]")+ }+ }+ function no_support(text,status,ct) {+ upd3s("[GF Robust translation service error: "+status+"]")+ }+ gftranslate.get_support(check_support,no_support)+ }+ }++ function update_gf_translation(grammar,gfrom,gto) {+ var server=t.servers[grammar]+ function upd3(txts) { update_segment(grammar,txts) }+ function upd3s(txt) { upd3([{quality:"error",text:txt}]) }+ function upd2(ts) {+ switch(ts.length) {+ case 0: upd3s("[no translation]");break;+ default:+ //mapc(unlextext,ts,upd3);+ upd3(ts)+ break;+ }+ }+ function upd1(translate_output) {+ //console.log(translate_output)+ upd2(collect_texts(translate_output[0].translations))+ }+ function upd0(source) {+ server.translate({from:gfrom,to:gto,lexer:"text",unlexer:"text",+ input:source},upd1)+ }+ var fls=t.gf_supported(grammar,o.from)+ var tls=t.gf_supported(grammar,o.to)+ if(fls && tls) {+ var want={from:o.from, to:o.to, method:grammar}+ if(!eq_options(segment.options,want)) {+ //console.log("Updating "+i)+ //lextext(segment.source,upd0)+ upd0(segment.source)+ }+ //else console.log("No update ",want,segment.options)+ }+ else {+ var fn=concname(o.from)+ var tn=concname(o.to)+ var sup="supported by the grammar"+ var isnot=" is not "+sup+ var is=" is "+sup+ var msg= fls ? tn+isnot : tls ? fn+isnot :+ "Neither "+fn+" nor "+tn+is+ upd3s("["+msg+"]")+ }+ }++ var m=segment_method(doc,ss[i])+ switch(m) {+ case "Manual": /* Nothing to do */ break;+ case "Apertium": update_apertium_translation(); break;+ case "GFRobust": update_gfrobust_translation(); break;+ default: // GF+ function upd00(grammar_info) {+ var gname=grammar_info.name+ var gfrom=gname+o.from, gto=gname+o.to+ update_gf_translation(m,gfrom,gto)+ }+ t.switch_grammar(m,upd00)+ }+}++Translator.prototype.add_apertium=function() {+ var dl=element("methods")+ if(dl) add_apertium_to_menu(dl,bind(this.change,this))+}++function add_apertium_to_menu(dl,action) {+ dl.appendChild(dt(radiobutton("method","Apertium","Apertium",action)))+}++Translator.prototype.extend_methods=function(grammars) {+ this.grammars=grammars+ var dl=element("methods")+ if(dl) this.extend_methods_menu(dl,bind(this.change,this))+ update_radiobutton(document.forms.options,"method",this.document.options.method)+ this.redraw()+}++Translator.prototype.extend_methods_menu=function(dl,action) {+ var grammars=this.grammars+ if(dl) for(var i in grammars) {+ dl.appendChild(dt(radiobutton("method",grammars[i],+ "GF: "+grammars[i],+ action)))+ }+}++Translator.prototype.change=function(el) {+ var t=this+ var o=t.document.options;+ function update(field) {+ if(el.value!=o[field]) {+ o[field]=el.value+ t.redraw()+ }+ }+ function update_checkbox(field) {+ if(el.checked!=o[field]) {+ o[field]=el.checked+ t.redraw()+ }+ }+ switch(el.name) {+ case "method": update("method"); break;+ case "source": update("from"); break;+ case "target": update("to"); break;+ case "view" : update("view"); break;+ case "cloud" : update_checkbox("cloud"); break;+ }+}++Translator.prototype.new=function(el) {+ hide_menu(el);+ this.current=null;+ this.local.put("current",null)+ this.document=empty_document()+ this.redraw();+}++Translator.prototype.browse=function(el) {+ hide_menu(el);+ var t=this+ function ls(files,open,del) {+ var ul=empty_class("ul","files")+ for(var i in files) {+ var name=files[i]+ var link=a(jsurl(open+"('"+name+"')"),[text(name)])+ ul.appendChild(li(deletable(del(name),link)))+ }+ return ul+ }+ function delete_local(name) {+ return function() {+ if(confirm("Are you sure you want to delete the local document "+name+"?")) {+ t.local.remove("/"+name)+ browse();+ }+ }+ }+ function delete_from_cloud(name) {+ return function() {+ if(confirm("Are you sure you want to delete the cloud document "+name+"?")) {+ gfcloud("rm",{file:name+cloudext},browse)+ }+ }+ }+ function browse() {+ var list=empty("div")+ clear(t.filebox)+ t.filebox.appendChild(list)+ list.appendChild(wrap("h2",text("Open...")))+ var files=t.local.ls("/")+ if(files.length>0) {+ list.appendChild(wrap("h3",text("Local documents")))+ list.appendChild(ls(files,"translator.open",delete_local))+ }+ function lscloud(result) {+ var filenames=JSON.parse(result)+ var files=map(strip_cloudext,filenames)+ if(files.length>0) {+ list.appendChild(wrap("h3",[text("Documents in the cloud "),+ img("../P/cloud.png")]))+ list.appendChild(ls(files,"translator.open_from_cloud",delete_from_cloud))+ }+ }+ if(navigator.onLine) gfcloud("ls",{ext:cloudext},lscloud)+ /*+ t.current="/"+ t.local.put("current","/")+ */+ + t.filebox.appendChild(button("Cancel",function () { t.hide_filebox() }))+ t.show_filebox()+ }+ setTimeout(browse,100) // leave time to hide the menu first+}++Translator.prototype.open=function(name) {+ var t=this+ if(name) {+ var path="/"+name+ var document=t.local.get(path);+ if(document) t.load(name,document,false)+ else alert("No such document: "+name)+ }+}++Translator.prototype.show_filebox=function() {+ this.filebox.parentNode.style.display="block";+}++Translator.prototype.hide_filebox=function() {+ var t=this+ t.filebox.parentNode.style.display="";+ clear(t.filebox)+}++Translator.prototype.load=function(name,document,in_cloud) {+ var t=this+ t.current=name;+ t.current_in_cloud=in_cloud;+ t.local.put("current",name)+ t.local.put("current_in_cloud",in_cloud)+ t.document=document;+ t.hide_filebox();+ t.redraw();+}++Translator.prototype.open_from_cloud=function(name) {+ var t=this+ var filename=name+cloudext+ function ok(result) {+ var document=JSON.parse(result)+ if(document) t.load(name,document,true)+ }+ gfcloud("download",{file:encodeURIComponent(filename)},ok);+}++Translator.prototype.save=function(el) {+ var t=this+ hide_menu(el);+ if(t.current!="/") {+ if(t.current) {+ var path="/"+t.current+ if(t.document.options.cloud) {+ function done() {+ //t.local.remove(path)+ t.local.put("current_in_cloud",true)+ t.local.put("current",t.current)+ }+ save_in_cloud(t.current+cloudext,t.document,done)+ }+ else {+ t.local.put(path,t.document)+ t.local.put("current",t.current)+ }+ }+ else t.saveAs()+ }+}++Translator.prototype.saveAs=function(el) {+ var t=this+ hide_menu(el);+ if(t.current!="/") {+ var name=prompt("File name?")+ if(name) {+ t.current=t.document.name=name;+ t.local.put("current",name)+ t.save();+ t.redraw();+ }+ }+}++Translator.prototype.close=function(el) {+ hide_menu(el);+ this.browse();+}+/*+Translator.prototype.add_segment1=function(el) {+ hide_menu(el);+ var t=this+ function imp() {+ var text=prompt("Text segment to import?")+ if(text) {+ t.document.segments.push(new_segment(text))+ t.redraw();+ }+ }+ setTimeout(imp,100)+}+*/+Translator.prototype.add_segment=function(el) {+ var t=this+ if(t.document.globalsight) return+ hide_menu(el);+ function imp() {+ var n=t.document.segments.length+ t.insert_segment(n)+ }+ if(t.current!="/") setTimeout(imp,100)+}++Translator.prototype.insert_segment=function(i) {+ var t=this+ function restore() {+ t.redraw()+ }+ function done() {+ var text=inp.value+ if(text) {+ var newseg=new_segment(text)+ t.document.segments=insert_ix(t.document.segments,i,newseg)+ }+ restore()+ return false+ }+ var inp=node("input",{name:"it",value:""})+ var e=form({},[inp, submit(), button("Cancel",restore)])+ var source=wrap_class("td","source",e)+ var edit=wrap_class("tr","segment",[td([]),source])+ + var ss=t.drawing.segments+ var n=ss ? ss.length : 0+ if(n>0) {+ if(i==0) insertBefore(edit,ss[0])+ else insertAfter(edit,ss[i-1])+ }+ else t.view.appendChild(wrap_class("table","segments",edit))+ + e.onsubmit=done+ inp.focus();+}++Translator.prototype.import=function(el) {+ var t=this+ if(t.document.globalsight) return // disabled+ hide_menu(el);+ function imp() {+ function restore() {+ t.redraw()+ }+ function done() {+ function add_segments(text) {+ var ls=window.lines(text)+ var segs= punct.firstChild.checked + ? split_punct(text,punctchars.value)+ : paras.firstChild.checked + ? join_paragraphs(ls)+ : ls+ for(var i in segs)+ t.document.segments.push(new_segment(segs[i]))+ }+ function import_text(text2) {+ var text=inp.value+ add_segments(text2)+ add_segments(text)+ restore()+ }+ function import_file(ev) { import_text(ev.target.result) }+ if(files.files && files.files.length>0) {+ var file=files.files[0]+ var r=new FileReader()+ r.onload=import_file+ r.readAsText(file)+ }+ else import_text("")+ return false+ }+ var inp=node("textarea",{name:"it",value:"",rows:"10"})+ var punct=radiobutton("separator","punct",+ "Punctuation indicates where segments end: ",null,true)+ var lines=radiobutton("separator","lines",+ "Segments are separated by line breaks",null,false)+ var paras=radiobutton("separator","paras",+ "Segments are separated by blank lines",null,false)+ var punctchars=node("input",{name:"punctchars",value:".?!",size:"5"})+ var lang=concname(t.document.options.from)+ var e=form({class:"import"},+ [wrap("h3",text("Import text ("+lang+")")),+ inp,+ wrap("dl",[dt([punct,punctchars]),dt(lines),dt(paras)]),+ submit(), button("Cancel",restore)])++ if(supports_local_files()) {+ // Allow import from local files, if the browers supports it.+ var files=node("input",{name:"files","type":"file"})+ var extra=wrap("label",[text("Choose a file: "),+ files,+ text(" and/or enter text to import below.")])+ e.insertBefore(extra,inp)+ }+ t.view.appendChild(e)+ e.onsubmit=done+ inp.focus();+ }+ if(t.current!="/") setTimeout(imp,100)+}++Translator.prototype.export_globalsight=function() {+ t=this++ /*+ Taken from this discussion on saving to local files:+ http://stackoverflow.com/questions/2897619/using-html5-javascript-to-generate-and-save-a-file+ */+ open("data:application/octet-stream,"+ +encodeURIComponent(export_globalsight_download_file(t.document)),+ t.document.name+ /*,'toolbar=no,location=no,status=no'*/);++/*+ Also consider: FileSaver saveAs()++ Not directly support in browsers:+ http://www.w3.org/TR/file-writer-api/#the-filesaver-interface++ Alternative implementation: FileSaver.js:+ https://github.com/eligrey/FileSaver.js+ http://eligrey.com/blog/post/saving-generated-files-on-the-client-side+*/+}++Translator.prototype.import_globalsight=function(el) {+ hide_menu(el);+ var t=this+ function imp() {+ function done() {+ function import_text(name,text) {+ var ls=lines(text)+ if(ls.length>0 && ls[0]=="# GlobalSight Download File") {+ t.current=null;+ t.local.put("current",null)+ t.document=import_globalsight_download_file(ls)+ t.current=t.document.name=name+ t.hide_filebox();+ t.redraw();+ }+ else alert("Not a GlobalSight Download File") // !! improve+ }+ function import_file(name,ev) { import_text(name,ev.target.result) }+ if(files.files && files.files.length>0) {+ var file=files.files[0]+ var r=new FileReader()+ r.onload=function(ev) { import_file(file.name,ev); }+ r.readAsText(file)+ }+ return false+ }++ clear(t.filebox)+ t.filebox.appendChild(wrap("h2",text("Import")))+ function restore() { t.hide_filebox() }+ var cancel_button=button("Cancel",restore)+ if(supports_local_files()) {+ // Allow import from local files, if the browers supports it.+ var files=node("input",{name:"files","type":"file"})+ var inp=wrap("p",wrap("label",[text("Choose a file: "),files]))+ var e=form({class:"import"},+ [wrap("h3",text("Import a GlobalSight Download File")),+ inp, submit(), cancel_button])+ t.filebox.appendChild(e)+ e.onsubmit=done+ }+ else {+ t.filebox.appendChild(wrap("p",[text("Support for readling local files is missing in this browser.")]))+ t.filebox.appendChild(cancel_button)+ }+ t.show_filebox();+ }+ setTimeout(imp,100) // leave time to hide the menu first+}++Translator.prototype.open_in_wc=function(el) {+ var t=this+ hide_menu(el)+ var doc=t.document+ var sourcetext=doc.segments.map(function(s){return s.source}).join(" ")+ var wc=appLocalStorage("gf.wc."+gftranslate.grammar+".")+ wc.put("from",doc.options.from)+ wc.put("to",doc.options.to)+ wc.put("input",sourcetext)+ var w=window.open("../wc.html","wc")+ w.focus()+}++Translator.prototype.remove=function(el) {+ var t=this+ if(t.document.globalsight) return+ hide_menu(el);+ function rm() {+ if(t.document && t.document.segments.length>0) {+ t.document.segments.pop();+ t.redraw();+ }+ }+ if(t.current!="/") setTimeout(rm,100)+}++Translator.prototype.remove_segment=function(i) {+ var t=this+ if(t.document && t.document.segments.length>i) {+ t.document.segments=delete_ix(t.document.segments,i)+ t.redraw();+ }+}++Translator.prototype.replace_segment=function(i,sd) {+ var t=this;+ var ds=t.drawing.segments;++ if(ds) {+ var old=ds[i]+ ds[i]=sd+ replaceNode(sd,old)+ }+}++Translator.prototype.pick_translation=function(i,txt) {+ var t=this+ var s=t.document.segments[i]+ set_manual(s)+ s.target=txt // side effect, updating the document in-place+ t.replace_segment(i,t.draw_segment(s,i))+}++Translator.prototype.edit_source=function(source,i) {+ var t=this+ var doc=t.document+ var s=doc.segments[i]++ function restore() { t.replace_segment(i,t.draw_segment(s,i)) }+ function change(str) {+ s.source=str // side effect, updating the document in-place+ restore();+ if(s.options.method!="Manual") {+ s.options.to="" // hack to force an update+ t.update_translation(i)+ }+ }+ function done() { change(inp.value); return false; }++ function goto_minibar() {+ function cont(grammar_info) {+ var gname=grammar_info.name+ var gfrom=gname+doc.options.from+ var gto=gname+doc.options.to+ var pgf_server=t.servers[grammarname]+ function cont2(source) {+ function ok() {+ function cont(input) { unlextext(input,change) }+ minibar.get_current_input(cont)+ t.hide_filebox()+ }+ function cancel() {+ restore()+ t.hide_filebox()+ }+ var minibar_options= {+ startcat_menu: false,+ random_button: false,+ try_google: false,+ show_abstract: true,+ show_trees: true,+ show_grouped_translations: false,+ word_replacements: true,+ default_source_language: "Eng",+ initial_grammar: pgf_server.current_grammar_url,+ initial:{from:gfrom,+ startcat:grammar_info.startcat,+ input:source.split(" ")},+ initial_toLangs: [gfrom,gto]+ }+ clear(t.filebox)+ appendChildren(t.filebox,[empty_id("div","minibar"),+ empty_id("div","syntax_editor")])+ var minibar=new Minibar(pgf_server,minibar_options)+ appendChildren(t.filebox,[button("OK",ok),+ button("Cancel",cancel)])+ t.show_filebox()+ }+ lextext(s.source,cont2)++ }+ t.switch_grammar(grammarname,cont)+ }++ var inp=node("input",{name:"it",value:s.source})+ var e=form({},[inp, submit(), button("Cancel",restore),text(" ")])+ var grammarname=uses_gf(doc,s)+ if(grammarname) e.appendChild(button("Minibar",goto_minibar))+ replaceChildren(source,e)+ e.onsubmit=done+ inp.focus()+}++Translator.prototype.edit_translation=function(i) {+ var t=this+ var s=t.document.segments[i]+ + function restore() { t.replace_segment(i,t.draw_segment(s,i)) }+ function done() {+ set_manual(s)+ s.options.from=t.document.options.from+ s.options.to=t.document.options.to+ s.target={quality:"manual_quality",text:inp.value}+ // side effect, updating the document in-place+ restore();+ return false;+ }++ var inp=node("input",{name:"it",value:qstring(s.target)})+ var e=form({},[inp, submit(), button("Cancel",restore)])+ var target=wrap_class("td","target",e)+ var edit=t.draw_segment_given_target(s,target,i)+ t.replace_segment(i,edit)+ e.onsubmit=done+ inp.focus();+}++function hide_menu(el) {+ function disp(s) { el.parentNode.style.display=s; }+ if(el) {+ disp("none")+ setTimeout(function(){disp("")},500)+ }+}++/* --- Documents ------------------------------------------------------------ */++/*+type Document = { name:String, options:DocOptions, segments:[Segment],+ globalsight : GlobalSight|null }+type Segment = { source:String, target:QText, options:Options }+ & ( {} | { choices:[QText] } )+type QText = { quality:Quality, text:String }+ | String // mostly for backward compatibility+type Quality = "default_quality" | "low_quality" | "high_quality" + | "manual_quality"+type DocOptions = Options & { view:View, cloud:Bool }+type Options = {from: Lang, to: Lang, method:Method}+type Lang = String // Eng, Swe, Ita, etc+type Method = "Manual" | "Apertium" | "GFRobust" | GFGrammarName+type View = "segmentbysegment" | "paralleltexts"+type GFGrammarName = String // e.g. "Foods.pgf"++type GlobalSight = { header: [String], segments:[[String]] }+*/++function eq_options(o1,o2) {+ return o1.method==o2.method && o1.from==o2.from && o1.to==o2.to+}++Translator.prototype.draw_document=function() {+ var t=this+ var doc=t.document+ var o=doc.options;+ function draw_globalsight() {+ function gs_export() { t.export_globalsight(); }+ return doc.globalsight+ ? wrap("span",[text(" (from GlobalSight) "),+ button("Export",gs_export)])+ : text("")+ }+ var hdr=wrap("h2",[text(doc.name),text(" "),+ wrap("small",[draw_translation(o),draw_globalsight()])])+ if(doc.options.cloud) insertFirst(hdr,img("../P/cloud.png"))+ switch(o.view || "segmentbysegment") {+ case "paralleltexts":+ function src(seg) { return seg.source }+ function trg(seg) { return seg.target }+ function fmt(txt,i) {+ var sd=span_class("segment",[qtext(txt),text(" ")])+ function setclass(cls) {+ return function() {+ targets[i].className=sources[i].className=cls+ }+ }+ sd.onmouseover=setclass("current_segment")+ sd.onmouseout=setclass("segment")+ return sd+ }+ var sources=mapix(fmt,map(src,doc.segments))+ var targets=mapix(fmt,map(trg,doc.segments))+ var drawing=[hdr,wrap_class("table","paralleltexts",+ tr([wrap_class("td","source",sources),+ wrap_class("td","target",targets)]))]+ return {doc:drawing,sources:sources,targets:targets}+ default:+ var segments=mapix(bind(t.draw_segment,t),doc.segments)+ var drawing=[hdr,wrap_class("table","segments",segments)]+ return {doc:drawing,segments:segments}+ }+}++Translator.prototype.draw_segment=function(s,i) {+ var t=this+ var dopt=t.document.options+ var opt=s.options+ var txt=qtext(s.target)+ if(opt.from!=dopt.from || opt.to!=dopt.to) txt=span_class("error",txt)+ var target=wrap_class("td","target",txt)+ function edit() { t.edit_translation(i) }+ function pick(txt) { t.pick_translation(i,txt) }+ target.onclick=edit+ if(s.choices) appendChildren(target,draw_choices(s.choices,pick))+ return t.draw_segment_given_target(s,target,i)+}++function qtext(t) {+ switch(typeof(t)) {+ case "string": return text(t)+ default: return span_class(t.quality||"",text(t.text))+ }+}++function qstring(t) {+ switch(typeof(t)) {+ case "string": return t+ default: return t.text+ }+}++function draw_choices(txts,onclick) {+ function opt(txt) { + var o=dt(qtext(txt))+ o.onclick=function(ev) { ev.stopPropagation(); onclick(txt) }+ return o+ }+ return [span_class("choices",text("+")),+ wrap_class("dl","popupmenu",map(opt,txts))]+}++Translator.prototype.draw_segment_given_target=function(s,target,i) {+ var t=this++ function draw_options2() {+ var o=s.options+ function change(el) {+ s.use_default = el.value=="Default"+ var m = s.use_default ? t.document.options.method : el.value+ if(m!=o.method) {+ o.method=m // side effect, updating the document in-place+ o.to="" // hack to force an update+ //console.log("Method changed to "+m)+ t.update_translation(i)+ }+ }+ var autoB=radiobutton("method","Default","Default",change)+ var manualB=radiobutton("method","Manual","Manual",change)+ var gfrobustB=radiobutton("method","GFRobust","GF Wide Coverage Translation",change)+ var dl=wrap_class("dl","popupmenu",+ [dt(autoB),+ dt([manualB,text(" "),draw_translation(o)]),+ dt(gfrobustB)])+ if(window.apertium) add_apertium_to_menu(dl,change)+ t.extend_methods_menu(dl,change)+ var form=wrap("form",dl)+ var d = s.use_default+ var m = d || d==null ? "Default" : o.method || "Default"+ update_radiobutton(form,"method",m)+ return form+ }+ function draw_options() {+ return wrap("div",[span_class("arrow",hovertext(" ⇒ ")),draw_options2()])+ }+ if(t.document.globalsight)+ var actions=empty_class("td","actions")+ else {+ var insertB=dt(text("Insert a new segment"))+ insertB.onclick=function() { t.insert_segment(i) }+ var removeB=dt(text("Remove this segment"))+ removeB.onclick=function() { t.remove_segment(i) }+ var actions=wrap_class("td","actions",+ wrap("div",[span_class("actions",hovertext("◊")),+ wrap_class("dl","popupmenu",+ [insertB,removeB])]))+ }+ var txt=wrap("span",text(s.source))+ var source=wrap_class("td","source",txt)+ if(!t.document.globalsight)+ txt.onclick=function() { t.edit_source(source,i); }+ /*+ if(window.gftranslate && segment_method(t.document,s)=="GFRobust") {+ function add_button(src) {+ var btn=img("../minibar/tree-btn.png")+ btn.className="right"+ btn.other=gftranslate.parsetree_url(src)+ btn.title="Click to toggle parse tree view."+ btn.onclick=function() { toggle_img(btn) }+ source.appendChild(btn)+ }+ lexgfrobust(s.source,add_button)+ }+ */+ var options=wrap_class("td","options",draw_options())++ return node("tr",{"class":"segment",id:i},[actions,source,options,target])+}++/* --- Document constructor ------------------------------------------------- */++function empty_document() {+ return { name:"Unnamed",+ options: {from:"Eng", to:"Swe", method:"Manual"},+ segments:[] }+}++/* --- Segments ------------------------------------------------------------- */++function new_segment(source) {+ return { source:source, target:"", options:{} } // leave options empty+}++function set_manual(segment) {+ segment.options.method="Manual"+ segment.use_default=false+}++// Return the name of the grammar if the segment uses GF for translation+function uses_gf(doc,segment) {+ var m= segment_method(doc,segment)+ return /\.pgf$/.test(m) ? m : null+}++// Return the translation method use by a segment+function segment_method(doc,segment) {+ var m= segment.options.method || doc.options.method+ var d=segment.use_default+ if(d || d==null) m=doc.options.method+ return m+}++/* -------------------------------------------------------------------------- */++function draw_translation(o) { return text(show_translation(o)) }++function show_translation(o) {+ return "("+concname(o.from||"?")+" → "+concname(o.to||"?")+")"+}++/* --- Auxiliary functions -------------------------------------------------- */++// Collect alternative texts in the output from PGF service translate command+function collect_texts(ts) {+ var list=[]+ for(var i in ts)+ for(var j in ts[i].linearizations) {+ var t=ts[i].linearizations[j].text+ if(!elem(t,list)) list.push(t) // avoid duplicates+ }+ return list+}++function mapix(f,xs) {+ var ys=[];+ for(var i in xs) ys.push(f(xs[i],i))+ return ys;+}++function delete_ix(old,ix) {+ var a=[];+ for(var i in old) if(i!=ix) a.push(old[i]);+ return a;+}++function insert_ix(old,ix,x) {+ var a=[];+ var done=false;+ for(var i in old) {+ if(i==ix) { a.push(x); done=true; }+ a.push(old[i])+ }+ if(!done) a.push(x)+ return a;+}++// Convert array of lines to array of paragraphs+function join_paragraphs(lines) {+ var paras=[]+ var current="";+ for(var i in lines)+ if(lines[i]=="") paras.push(current),current=""+ else current+=" "+lines[i]+ if(current) paras.push(current)+ return paras+}++function split_punct(text,punct) {+ var ss=text.split(new RegExp("(["+punct+"])"))+ var segs=[];+ for(var i=0;i<ss.length;i+=2) segs.push((ss[i]+(ss[i+1]||"")).trim())+ if(segs.length>0 && segs[segs.length-1]=="") segs.pop();+ return segs+}++// Break a string into lines+function lines(text) {+ var ls=text.split("\r\n") // DOS+ if(ls.length<=1) ls=text.split(/\n|\r/) // Unix | Mac+ return ls+}++function supports_local_files() {+ // See http://www.html5rocks.com/en/tutorials/file/dndfiles/+ return window.File && window.FileList && window.FileReader+}++/* --- GlobalSight support -------------------------------------------------- */++function import_globalsight_download_file(ls) {+ var doc=empty_document()+ doc.globalsight={header:[],segments:[]}+ var i=0;++ // Scan header and pick up source & target locale+ for(;i<ls.length && ls[i][0]=="#";i++) {+ doc.globalsight.header.push(ls[i])+ var hdr=ls[i].split(":");+ if(hdr.length==2) {+ function setlang(opt) {+ var code2=hdr[1].trim().split("_")[0] // pick en from en_UK+ var code3=langcode3[code2]+ if(code3) doc.options[opt]=code3;+ // Should notify the user about unsupported language codes!!+ }+ switch(hdr[0]) {+ case "# Source Locale": setlang("from"); break;+ case "# Target Locale": setlang("to");break;+ }+ }+ }+ // skip blank lines+ for(;i<ls.length && ls[i].length==0;i++)+ doc.globalsight.header.push(ls[i])++ while(i<ls.length) {+ var seghdr=[]+ // skip segment header+ for(;i<ls.length && ls[i][0]=="#";i++) seghdr.push(ls[i])+ var seg=""+ // extract segment text+ for(;i<ls.length && ls[i][0]!="#";i++)+ if(ls[i]!="") seg = seg=="" ? ls[i] : seg+" "+ls[i];+ if(seg!="") doc.segments.push(new_segment(seg.trim()))+ doc.globalsight.segments.push(seghdr)+ }+ return doc;+}++function export_globalsight_download_file(doc) {+ var ls=[].concat(doc.globalsight.header)++ var gs=doc.globalsight.segments+ var ss=doc.segments+ for(var i=0;i<gs.length && i<ss.length;i++)+ ls=ls.concat(gs[i],qstring(ss[i].target))++ ls.push("")+ ls.push("# END GlobalSight Download File")+ ls.push("")+ return ls.join("\n")+}+++/* --- Cloud Support -------------------------------------------------------- */+++var cloudext=".gfstdoc"+function strip_cloudext(s) { return s.substr(0,s.length-cloudext.length) }++function save_in_cloud(filename,document,cont) {+ function save(dir) {+ var form={dir:dir}+ form[filename]=JSON.stringify(document);+ ajax_http_post("/cloud","command=upload"+encodeArgs(form),cont)+ }+ with_dir(save)+}++/*+// Like lextext, but separate punctuation from the end+function lexgfrobust(txt,cont) {+ function rmpunct(txt) {+ var ts=gf_lex(txt)+ var n=ts.length+ var punct=""+ if(n>0 && /[.?!]/.test(ts[n-1])) { punct=ts[n-1]; ts.pop()}+ cont(gf_unlex(ts),punct)+ }+ lextext(txt,rmpunct)+}+*/+// rmpunct :: String -> {txt:String,punct:String}+function rmpunct(txt) {+ function ispunct(c) {+ switch(c) {+ case ' ':+ case '\t':+ case '\n':+ case '.':+ case '?':+ case '!':+ return true+ default:+ return false+ }+ }+ var i=txt.length-1+ while(i>=0 && ispunct(txt[i])) i--+ i+++ return {txt:txt.substr(0,i),punct:txt.substr(i)}+}++/* --- DOM Support ---------------------------------------------------------- */++function a(url,linked) { return node("a",{href:url},linked); }+function jsurl(js) { return "javascript:"+js; }++function replaceNode(node,ref) { ref.parentNode.replaceChild(node,ref) }++function radiobutton(name,value,label,change,checked) {+ var b=node("input",{type:"radio",name:name,value:value})+ if(change) b.onchange=function(event) { return change(event.target) }+ if(checked) b.checked=true+ return wrap("label",[b,text(label)])+}++function update_radiobutton(form,name,value) {+ var bs=form[name]+ if(bs.length)+ for(var i in bs) if(bs[i].value==value) bs[i].checked=true+}++function update_checkbox(name,checked) {+ document.forms.options[name].checked=checked+}++function form(attrs,fields) { return node("form",attrs,fields) }++function submit(label) {+ return node("input",{type:"submit",value:label||"OK"})+}+++function deletable(del,el,hint) {+ var b=delete_button(del,hint)+ return node("span",{"class":"deletable"},[b,el])+}++function delete_button(action,hint) {+ var b=node("span",{"class":"delete",title:hint || "Delete"},[text("×")])+ b.onclick=action;+ return b;+}++function hovertext(txt) {+ return node("span",{onclick:""},[text(txt)])+}
@@ -0,0 +1,138 @@+<!DOCTYPE html>+<html> <head>+<title>Demo: GF Wide Coverage Translation</title>+<link rel="stylesheet" type="text/css" href="gfse/editor.css" title="Cloud">+<link rel="stylesheet" type="text/css" href="translator/overlay.css">+<meta name = "viewport" content = "width = device-width">+<meta charset="UTF-8">+<link rel=top href="../" title="GF">+<style>+div.center { text-align: center; }+table { border-collapse: collapse; table-layout: fixed; width: 100%; }+td { padding: 0 5px; vertical-align: top; }+td.output { background: #fcfcfc; border: 1px solid grey; }+td.input, td.output { font-family: sans-serif; font-size: 90%; }+div#output { white-space: pre-line; }+div.input { margin-right: 5px; }+textarea { font: inherit; }+body:target h1, body:target div.modtime { display: none; }+small { color: #666; }+#pick>* { padding: 0 0.5ex; }+#speak { display: none; }+.colors .default_quality { background-color: #ffb; }+.colors .high_quality { background-color: #bfb; }+.colors .low_quality { background-color: #fa7; }+.colors .bad_quality { background-color: #f89; }+.placeholder { color: #999; }+.error { color: #c00; }+div.e2 table { background: white; }+span.inflect { color: blue; }+.grammar_pick { margin: 5px; }+h2 > input { float: right; }++.node { cursor: pointer; }+/*.overlay { background-color: #eed; }*/+.node rect { fill: #fff; stroke: black; stroke-width: 1.5px; }+.node text { font-size: 10px; font-family: serif; }+.link { fill: none; stroke: #ccc; stroke-width: 1.5px; }+.speech_buttons > * { display: none; }+.speech_buttons > *:nth-child(1) { display: inline; }+.speech_buttons > *:nth-child(2) { display: inline; }+/* .speech_buttons:hover > * { display: inline; } */+</style>+</head>++<body id=embed>+<div>+<h1><a href="http://www.grammaticalframework.org/"><img class=nofloat src="P/gf-cloud.png" alt="GF"></a> Wide Coverage Translation Demo</h1>+</div>++<div class=overlay><div id=grammarbox class=grammarbox></div></div>++<form onsubmit="return wc.translate(true)" style="width: 100%">+<table>+<tr><td>+ <select name=from>+ <option value=Bul>Bulgarian</option>+ <option value=Cat>Catalan</option>+ <option value=Chi>Chinese</option>+ <option value=Dut>Dutch</option>+ <option value=Eng selected>English</option>+ <option value=Est>Estonian</option>+ <option value=Fin>Finnish</option>+ <option value=Fre>French</option>+ <option value=Ger>German</option>+ <option value=Hin>Hindi</option>+ <option value=Ita>Italian</option>+ <option value=Jpn>Japanese</option>+ <option value=Spa>Spanish</option>+ <option value=Swe>Swedish</option>+ <option value=Tha>Thai</option>+ </select>+ <input type=button value="Clear" onclick="wc.clear()">+ <td style="text-align: right">+ <input type=button name=swap onclick="wc.swap()" value="⇆">+ <td>+ <select name=to onchange="wc.translate()">+ <option value=Bul>Bulgarian</option>+ <option value=Cat>Catalan</option>+ <option value=Chi>Chinese</option>+ <option value=Dut>Dutch</option>+ <option value=Eng>English</option>+ <option value=Est>Estonian</option>+ <option value=Fin>Finnish</option>+ <option value=Fre>French</option>+ <option value=Ger>German</option>+ <option value=Hin>Hindi</option>+ <option value=Ita>Italian</option>+ <option value=Jpn>Japanese</option>+ <option value=Spa>Spanish</option>+ <option value=Swe selected>Swedish</option>+ <option value=Tha>Thai</option>+ </select>+ <input name=colors type=checkbox checked onchange="wc.colors()"> Colors+ <td><button name=translate type=submit><strong>Translate</strong></button>+ <input type=button name=grammars onclick="wc.select_grammars()" value="Grammars...">+ <tr><td class=input colspan=2>+ <div class=input>+ <textarea name=input rows=5 style="width: 100%" onkeyup="wc.delayed_translate()"></textarea>+ </div>+ <td class=output colspan=2>++ <div id=output></div>+ <tr><td colspan=2>+ <small id=grammarinfo>Enter text to translate above.</small>+ <td colspan=2>+ <!--<small id=speak><input name=speak type=checkbox> Enable speech synthesis</small>-->++</table>+</form>++<div class=center>+ <input type=button onclick="wc.try_google()" value="Try Google Translate">+ <div id=pick></div>+ <small id=extra></small>+ </div>+<hr>+<div class=modtime><small>+<!-- hhmts start -->Last modified: Thu May 19 11:08:21 CEST 2016 <!-- hhmts end -->+</small></div>+<a href="http://www.grammaticalframework.org/demos/translation.html">About</a>+<script src="js/support.js"></script>+<script src="js/gftranslate.js"></script>+<script src="js/localstorage.js"></script>+<script src="js/langcode.js"></script>+<script src="js/pgf_online.js"></script>+<script src="minibar/minibar_support.js">/* speech functions */</script>+<script src="gfse/sort.js"></script>+<script src="js/wc.js"></script>+<script>+wc.initialize()+</script>++<script src="http://code.jquery.com/jquery-1.10.2.min.js"></script>+<script src="http://d3js.org/d3.v3.min.js"></script>+<script src="js/d3Tree.js"></script>++</body>+</html>
@@ -0,0 +1,16 @@+resolver: lts-11.22 # ghc 8.2.2++packages:+- . # GF, PGF+- src/runtime/haskell-bind # PGF2 (requires C runtime to be installed)++extra-deps:+# - happy-1.19.9+# - alex-3.2.4+- cgi-3001.3.0.2+- httpd-shed-0.4.0.3+- time-1.6.0.1 # cgi-3001.3.0.2: time-1.8.0.2 from stack configuration does not match >=1.5 && <1.7++flags:+ gf:+ server: true
@@ -0,0 +1,13 @@+abstract Nat = {++cat Nat ;+data zero : Nat ;+ succ : Nat -> Nat ;+ +oper plus : Nat -> Nat -> Nat ;+def plus zero y = y ;+ plus (succ x) y = succ (plus x y) ;++oper twice : Nat -> Nat = \x -> plus x x ;++}
@@ -0,0 +1,5 @@+-- here we test that the abstract operations are not used for proof search++i testsuite/compiler/check/abstract-operations/Nat.gf+gt -cat=Nat -number=11 -depth=10+pt -compute (twice (succ zero))
@@ -0,0 +1,14 @@+succ (succ (succ (succ (succ (succ (succ (succ (succ (succ zero)))))))))+succ (succ (succ (succ (succ (succ (succ (succ (succ zero))))))))+succ (succ (succ (succ (succ (succ (succ (succ zero)))))))+succ (succ (succ (succ (succ (succ (succ zero))))))+succ (succ (succ (succ (succ (succ zero)))))+succ (succ (succ (succ (succ zero))))+succ (succ (succ (succ zero)))+succ (succ (succ zero))+succ (succ zero)+succ zero+zero++succ (succ zero)+
@@ -0,0 +1,7 @@+abstract Test1Abs = {++cat+ A B ;+ B A ;++}
@@ -0,0 +1,10 @@+abstract Test2Abs = {++cat+ A ;+ B A ;++fun f : (x : A) -> B (g x) ;+ g : (x : A) -> B (f x) ;++}
@@ -0,0 +1,11 @@+abstract Test3Abs = {++cat A ;++fun f : A -> A ;+def f = g ;++fun g : A -> A ;+def g = f ;++}
@@ -0,0 +1,1 @@+i -src testsuite/compiler/check/cyclic/abs-types/Test1Abs.gf
@@ -0,0 +1,4 @@+++testsuite/compiler/check/cyclic/abs-types/Test1Abs.gf:+ circular definitions: A B
@@ -0,0 +1,1 @@+i -src testsuite/compiler/check/cyclic/abs-types/Test2Abs.gf
@@ -0,0 +1,4 @@+++testsuite/compiler/check/cyclic/abs-types/Test2Abs.gf:+ circular definitions: f g
@@ -0,0 +1,1 @@+i -src testsuite/compiler/check/cyclic/abs-types/Test3Abs.gf
@@ -0,0 +1,10 @@+resource TestOperTypes = {++flags+ optimize=noexpand;++oper+ A : T = Str ;+ T : Type = A ;++}
@@ -0,0 +1,10 @@+resource TestOpers = {++flags+ optimize=noexpand;++oper+ A : Str = B ;+ B : Str = A ;++}
@@ -0,0 +1,2 @@+i -src testsuite/compiler/check/cyclic/opers/TestOpers.gf+i -src testsuite/compiler/check/cyclic/opers/TestOperTypes.gf
@@ -0,0 +1,8 @@+++testsuite/compiler/check/cyclic/opers/TestOpers.gf:+ circular definitions: A B+++testsuite/compiler/check/cyclic/opers/TestOperTypes.gf:+ circular definitions: A T
@@ -0,0 +1,7 @@+resource TestParams = {++param+ A = A1 B ;+ B = B1 A ;++}
@@ -0,0 +1,1 @@+i -src testsuite/compiler/check/cyclic/params/TestParams.gf
@@ -0,0 +1,4 @@+++testsuite/compiler/check/cyclic/params/TestParams.gf:+ circular definitions: A B
@@ -0,0 +1,5 @@+abstract Test = { + +cat S; + +}
@@ -0,0 +1,5 @@+concrete TestCnc of Test = open Predef in { + +lincat S = PTrue ; + +}
@@ -0,0 +1,1 @@+i -src testsuite/compiler/check/lincat-types/TestCnc.gf
@@ -0,0 +1,7 @@+++testsuite/compiler/check/lincat-types/TestCnc.gf:3:+ Happened in linearization type of S+ type of PTrue+ expected: Type+ inferred: PBool
@@ -0,0 +1,9 @@+abstract lins = { + +cat Nat ; +cat C Nat ; + +fun zero : Nat ; + test : C zero ; + +}
@@ -0,0 +1,2 @@+i -src testsuite/compiler/check/lins/linsCnc.gf +pg -printer=pgf_pretty
@@ -0,0 +1,39 @@+checking module linsCnc + Warning: no linearization type for C, inserting default {s : Str} + Warning: no linearization of test +abstract lins { + cat C Nat ; + cat Float ; + cat Int ; + cat Nat ; + cat String ; + fun test : C zero ; + fun zero : Nat ; +} +concrete linsCnc { + productions + C1 -> F2[] + lindefs + C0 -> F0 + C1 -> F1 + lin + F0 := (S0) [lindef C] + F1 := () [lindef Nat] + F2 := () [zero] + sequences + S0 := {0,0} + categories + C := range [C0 .. C0] + labels ["s"] + Float := range [CFloat .. CFloat] + labels ["s"] + Int := range [CInt .. CInt] + labels ["s"] + Nat := range [C1 .. C1] + labels [] + String := range [CString .. CString] + labels ["s"] + __gfVar := range [CVar .. CVar] + labels [""] + printnames +}
@@ -0,0 +1,11 @@+concrete linsCnc of lins = { + +lincat Nat = {} ; + +-- we expect warnings because the lines bellow are commented out +-- we don't expect warning for zero because Nat = {} + +-- lincat C = {s : Str} ; +-- lin test = {s = "test"} ; + +}
@@ -0,0 +1,5 @@+resource Res = { + +oper my_oper : Str -> Str ; + +}
@@ -0,0 +1,1 @@+i testsuite/compiler/check/oper-definition/Res.gf
@@ -0,0 +1,5 @@+++testsuite/compiler/check/oper-definition/Res.gf:3:+ Happened in operation my_oper+ No definition given to the operation
@@ -0,0 +1,5 @@+resource Params = {++param P = P1 Str ;++}
@@ -0,0 +1,8 @@+abstract A = {++cat A1; A2 ;+fun f1 : A1 ;+ f2 : A1 ;+ g : A2 ;++}
@@ -0,0 +1,3 @@+abstract B = A - [A1] ** {++}
@@ -0,0 +1,5 @@+abstract strMatch = { + cat S ; + fun f : S -> S ; + z : S ; +}
@@ -0,0 +1,2 @@+i testsuite/compiler/check/strMatch/strMatch.gf +l f z
@@ -0,0 +1,8 @@+concrete strMatchCnc of strMatch = open Prelude in { + lincat S = {s : Str; b : Bool} ; + lin f x = case x.s of { + "" => {s="empty"; b=False} ; + _ => x + } ; + lin z = {s=""; b=False} ; +}
@@ -0,0 +1,12 @@+resource Records = {++param P = A;++oper+ hello = id "hello";+ -- Id should be an identity function for Str+--id : Str -> Str = \ s -> s ;+ id : Str -> Str = \ s -> ({a=s}**f r).a;+ f : { b:Str } -> { b:Str } = \ x -> x;+ r : { a:P; b:Str} = {a=A;b="b"};+}
@@ -0,0 +1,2 @@+i -retain testsuite/compiler/compute/Records.gf+cc hello
@@ -0,0 +1,1 @@+"hello"
@@ -0,0 +1,7 @@+resource Variants = {+ oper+ hello = r.f "hello";+ r = { f:Str->Str = (id|dup) };+ id : Str->Str = \ s -> s;+ dup : Str->Str = \ s -> s++s;+}
@@ -0,0 +1,2 @@+i -retain testsuite/compiler/compute/Variants.gf+cc hello
@@ -0,0 +1,1 @@+variants {"hello"; "hello" ++ "hello"}
@@ -0,0 +1,7 @@+abstract params = { + +cat S; NP ; + +fun test : NP -> S ; + +}
@@ -0,0 +1,1 @@+i testsuite/compiler/params/paramsCnc.gf
@@ -0,0 +1,20 @@+concrete paramsCnc of params = { + +param + Number = Sg | Pl ; + Person = P1 | P2 | P3 ; + +oper + Agr = {n : Number; p : Person} ; + +param + Case = Nom | Acc | Abess Agr ; + +lincat + S = {s : Str} ; + NP = {s : Case => Str} ; + +lin + test np = {s = np.s ! Abess {n=Sg;p=P3}} ; + +}
@@ -0,0 +1,14 @@+abstract funpatt = { + +-- this should raise error +-- we cannot pattern match on functions + +cat D ; +fun D1 : Int -> D ; + D2 : Int -> D ; + +fun d : D -> Int ; +def d (D1 _) = 1 ; + d (D2 _) = 2 ; + +}
@@ -0,0 +1,1 @@+i -src testsuite/compiler/renamer/funpatt.gf
@@ -0,0 +1,5 @@+++testsuite/compiler/renamer/funpatt.gf:11:+ Happened in the renaming of d+ data constructor expected but funpatt.D1 is found instead
@@ -0,0 +1,13 @@+abstract varpatt = { + +-- this should raise error +-- we cannot pattern match on functions + +cat D ; +fun D1 : D ; + D2 : D ; + +fun d : D -> Int ; +def d x = 1 ; + +}
@@ -0,0 +1,4 @@+i -src testsuite/compiler/renamer/varpatt.gf + +pt -compute d D1 +pt -compute d D2
@@ -0,0 +1,4 @@+1 + +1 +
@@ -0,0 +1,14 @@+abstract Check = {++cat Typ ; Exp Typ ;++fun plus : (t : Typ) -> (_,_ : Exp t) -> Exp t ;++fun TInt, TFloat : Typ ;++fun Zero : Exp TInt ;+fun Pi : Exp TFloat ;++fun sqrt : Exp TFloat -> Exp TFloat ;++}
@@ -0,0 +1,6 @@+abstract A = { + +cat A ; + B (A 1) ; + +}
@@ -0,0 +1,7 @@+abstract B = { + +cat S ; + +fun f : S -> S 1 ; + +}
@@ -0,0 +1,8 @@+abstract C = { + +cat S ; + +fun f : S -> S ; +def f x = 1 ; + +}
@@ -0,0 +1,7 @@+abstract LetInDefAbs = {++fun f : Int -> Int ;+def f n = let z = f 0+ in f z ;++}
@@ -0,0 +1,2 @@+i -src testsuite/compiler/typecheck/abstract/LetInDefAbs.gf +ai f
@@ -0,0 +1,6 @@+abstract LetInTypesAbs = {++fun f : let id = Int -> Int+ in id -> id ;++}
@@ -0,0 +1,2 @@+i -src testsuite/compiler/typecheck/abstract/LetInTypesAbs.gf +ai f
@@ -0,0 +1,1 @@+fun f : (Int -> Int) -> Int -> Int
@@ -0,0 +1,15 @@+abstract LitAbs = { + +cat CStr String ; + CInt Int ; + CFloat Float ; + +data empty : CStr "" ; + null : CStr [] ; + other : CStr "other" ; + +data zero : CInt 0 ; + +data pi : CFloat 3.14 ; + +}
@@ -0,0 +1,6 @@+i -src testsuite/compiler/typecheck/abstract/LitAbs.gf +ai null +ai empty +ai other +ai zero +ai pi
@@ -0,0 +1,5 @@+data null : CStr "" +data empty : CStr "" +data other : CStr "other" +data zero : CInt 0 +data pi : CFloat 3.14
@@ -0,0 +1,5 @@+abstract PolyTypes = {++fun f : (A : Type) -> A ;++}
@@ -0,0 +1,5 @@+abstract RecTypes = {++fun f : {s:Int} -> Int ;++}
@@ -0,0 +1,2 @@+i -src testsuite/compiler/typecheck/abstract/PolyTypes.gf +i -src testsuite/compiler/typecheck/abstract/RecTypes.gf
@@ -0,0 +1,12 @@+ + +checking module PolyTypes + The term Type + is not allowed in the abstract syntax + in type of function f in PolyTypes.gf, line 3 + + +checking module RecTypes + The term {s : Int} + is not allowed in the abstract syntax + in type of function f in RecTypes.gf, line 3
@@ -0,0 +1,1 @@+i -src testsuite/compiler/typecheck/abstract/A.gf
@@ -0,0 +1,5 @@+++testsuite/compiler/typecheck/abstract/A.gf:4:+ Happened in the category B+ Prod expected for function A instead of Type
@@ -0,0 +1,1 @@+i -src testsuite/compiler/typecheck/abstract/B.gf
@@ -0,0 +1,5 @@+++testsuite/compiler/typecheck/abstract/B.gf:5:+ Happened in the type of function f+ Prod expected for function S instead of Type
@@ -0,0 +1,1 @@+i -src testsuite/compiler/typecheck/abstract/C.gf
@@ -0,0 +1,5 @@+++testsuite/compiler/typecheck/abstract/C.gf:6:+ Happened in the definition of function f+ {Int <> S}
@@ -0,0 +1,7 @@+resource A = { + +oper a_Det : Str = "a" ; + + silly : Str = a_Det "X" ; + +}
@@ -0,0 +1,1 @@+i -src testsuite/compiler/typecheck/concrete/A.gf
@@ -0,0 +1,5 @@+++testsuite/compiler/typecheck/concrete/A.gf:5:+ Happened in operation silly+ A function type is expected for a_Det instead of type Str
@@ -0,0 +1,5 @@+abstract ArrityCheck = { + fun f : Int -> Int -> Int ; + def f 0 = \x -> x ; + f 1 1 = 0 ; +}
@@ -0,0 +1,1 @@+i testsuite/compiler/update/ArrityCheck.gf
@@ -0,0 +1,8 @@+++testsuite/compiler/update/ArrityCheck.gf:6:1:+ conflicting information in module ArrityCheck+ fun f : Int -> Int -> Int ;+ def f 0 = \x -> x ;+and+ def f 1 1 = 0 ;
@@ -0,0 +1,226 @@+se utf8+i alltenses/LangEng.gfo+i alltenses/LangSwe.gfo+i alltenses/LangBul.gfo+-- Adjective++l -treebank PositA warm_A+l -treebank ComparA warm_A (UsePron i_Pron)+l -treebank ComplA2 married_A2 (UsePron she_Pron)+l -treebank ComplA2 married_A2 (DetNP (DetQuant (PossPron she_Pron) NumPl))+l -treebank ComplA2 married_A2 (DetNP (DetQuant (PossPron she_Pron) NumSg))+l -treebank ReflA2 married_A2+l -treebank PositA (UseA2 married_A2)+l -treebank SentAP (PositA good_A) (EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseComp (CompAdv here_Adv)))))+l -treebank AdAP very_AdA (PositA warm_A)+++-- Adverb++l -treebank PositAdvAdj warm_A+l -treebank PrepNP in_Prep (DetCN (DetQuant DefArt NumSg) (UseN house_N))+l -treebank ComparAdvAdj more_CAdv warm_A (UsePN john_PN)+l -treebank ComparAdvAdjS more_CAdv warm_A (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV run_V)))+l -treebank SubjS when_Subj (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V)))+l -treebank AdNum (AdnCAdv more_CAdv) (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))+++-- Conjunction++l -treebank ConjS and_Conj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V))))+l -treebank ConjAP and_Conj (BaseAP (PositA cold_A) (PositA warm_A))+l -treebank ConjNP or_Conj (BaseNP (UsePron she_Pron) (UsePron we_Pron))+l -treebank ConjAdv or_Conj (BaseAdv here_Adv there_Adv)+l -treebank ConjS either7or_DConj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V))))+l -treebank ConjAP both7and_DConj (BaseAP (PositA warm_A) (PositA cold_A))+l -treebank ConjNP either7or_DConj (BaseNP (UsePron he_Pron) (UsePron she_Pron))+l -treebank ConjAdv both7and_DConj (BaseAdv here_Adv there_Adv)++-- Idiom++l -treebank ImpersCl (UseComp (CompAP (PositA hot_A)))+l -treebank GenericCl (UseV sleep_V)+l -treebank CleftNP (UsePron i_Pron) (UseRCl (TTAnt TPast ASimul) PPos (RelVP IdRP (ComplSlash (SlashV2a do_V2) (UsePron it_Pron))))+l -treebank CleftAdv here_Adv (UseCl (TTAnt TPast ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V)))+l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (UseN house_N))+l -treebank ExistIP (IdetCN (IdetQuant which_IQuant NumPl) (UseN house_N))+l -treebank PredVP (UsePron i_Pron) (ProgrVP (UseV sleep_V))+l -treebank ImpPl1 (UseV go_V)++-- Noun++l -treebank DetCN (DetQuant DefArt NumSg) (UseN man_N)+l -treebank UsePN john_PN+l -treebank UsePron he_Pron+l -treebank PredetNP only_Predet (DetCN (DetQuant DefArt NumSg) (UseN man_N))+l -treebank PPartNP (DetCN (DetQuant DefArt NumSg) (UseN man_N)) see_V2+l -treebank AdvNP (UsePN paris_PN) today_Adv+l -treebank RelNP (UsePN paris_PN) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (UseComp (CompAdv here_Adv))))+l -treebank DetNP (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))))+l -treebank DetCN (DetQuantOrd this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N)+l -treebank DetCN (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN man_N)+l -treebank DetCN (DetQuant this_Quant NumPl) (UseN man_N)+l -treebank DetCN (DetQuant this_Quant NumSg) (UseN man_N)+l -treebank NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))+l -treebank NumCard (NumDigits (IIDig D_5 (IDig D_1)))+l -treebank NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01)))))+l -treebank NumCard (AdNum almost_AdN (NumDigits (IIDig D_5 (IDig D_1))))+l -treebank OrdDigits (IIDig D_5 (IDig D_1))+l -treebank OrdNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01))))+l -treebank OrdSuperl warm_A+l -treebank DetCN (DetQuantOrd DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N)+l -treebank DetCN (DetQuant DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN man_N)+l -treebank DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01))))))) (UseN man_N)+l -treebank DetCN (DetQuant DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01))))))) (UseN man_N)+l -treebank DetCN (DetQuant DefArt NumSg) (UseN man_N)+l -treebank DetCN (DetQuant DefArt NumPl) (UseN man_N)+l -treebank MassNP (UseN beer_N)+l -treebank DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN house_N)+l -treebank UseN house_N+l -treebank ComplN2 mother_N2 (DetCN (DetQuant DefArt NumSg) (UseN king_N))+l -treebank ComplN2 (ComplN3 distance_N3 (DetCN (DetQuant this_Quant NumSg) (UseN city_N))) (UsePN paris_PN)+l -treebank UseN2 mother_N2+l -treebank ComplN2 (Use2N3 distance_N3) (DetCN (DetQuant this_Quant NumSg) (UseN city_N))+l -treebank ComplN2 (Use3N3 distance_N3) (UsePN paris_PN)+l -treebank UseN2 (Use2N3 distance_N3)+l -treebank AdjCN (PositA big_A) (UseN house_N)+l -treebank RelCN (UseN house_N) (UseRCl (TTAnt TPast ASimul) PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a buy_V2))))+l -treebank AdvCN (UseN house_N) (PrepNP on_Prep (DetCN (DetQuant DefArt NumSg) (UseN hill_N)))+l -treebank SentCN (UseN question_N) (EmbedQS (UseQCl (TTAnt TPres ASimul) PPos (QuestIAdv where_IAdv (PredVP (UsePron she_Pron) (UseV sleep_V)))))+l -treebank DetCN (DetQuant DefArt NumSg) (ApposCN (UseN city_N) (UsePN paris_PN))+l -treebank DetCN (DetQuant (PossPron i_Pron) NumSg) (ApposCN (UseN friend_N) (UsePN john_PN))++-- Numeral++l -treebank num (pot2as3 (pot1as2 (pot0as1 (pot0 n6))))+l -treebank num (pot2as3 (pot1as2 (pot0as1 pot01)))+l -treebank num (pot2as3 (pot1as2 (pot1 n6)))+l -treebank num (pot2as3 (pot1as2 pot110))+l -treebank num (pot2as3 (pot1as2 pot111))+l -treebank num (pot2as3 (pot1as2 (pot1to19 n6)))+l -treebank num (pot2as3 (pot1as2 (pot1 n6)))+l -treebank num (pot2as3 (pot1as2 (pot1plus n6 (pot0 n5))))+l -treebank num (pot2as3 (pot2 (pot0 n4)))+l -treebank num (pot2as3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))))+l -treebank num (pot3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))))+l -treebank num (pot3plus (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))) (pot1as2 (pot1plus n8 (pot0 n9))))+l -treebank IDig D_8+l -treebank IIDig D_8 (IIDig D_0 (IIDig D_0 (IIDig D_1 (IIDig D_7 (IIDig D_8 (IDig D_9))))))+++-- Phrase++l -treebank PhrUtt but_PConj (UttImpSg PPos (ImpVP (AdvVP (UseV come_V) here_Adv))) (VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N)))+l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc+l -treebank UttQS (UseQCl (TTAnt TPres ASimul) PPos (QuestCl (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A))))))+l -treebank UttImpSg PNeg (ImpVP (ReflVP (SlashV2a love_V2)))+l -treebank UttImpPl PNeg (ImpVP (ReflVP (SlashV2a love_V2)))+l -treebank UttImpPol PNeg (ImpVP (UseV sleep_V))+l -treebank UttIP whoPl_IP+l -treebank UttIP whoSg_IP+l -treebank UttIAdv why_IAdv+l -treebank UttNP (DetCN (DetQuant this_Quant NumSg) (UseN man_N))+l -treebank UttAdv here_Adv+l -treebank UttVP (UseV sleep_V)+l -treebank VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N))+++-- Question++l -treebank QuestCl (PredVP (UsePN john_PN) (UseV walk_V))+l -treebank QuestVP whoSg_IP (UseV walk_V)+l -treebank QuestSlash whoSg_IP (SlashVP (UsePN john_PN) (SlashV2a love_V2))+l -treebank QuestIAdv why_IAdv (PredVP (UsePN john_PN) (UseV walk_V))+l -treebank QuestIComp (CompIAdv where_IAdv) (UsePN john_PN)+l -treebank IdetCN (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN song_N)+l -treebank IdetIP (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))))+l -treebank AdvIP whoSg_IP (PrepNP in_Prep (UsePN paris_PN))+l -treebank IdetIP (IdetQuant which_IQuant NumSg)+l -treebank PrepIP with_Prep whoSg_IP+l -treebank QuestIComp (CompIAdv where_IAdv) (UsePron it_Pron)+l -treebank QuestIComp (CompIP whoSg_IP) (UsePron it_Pron)+++-- Relative++l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelCl (PredVP (UsePN john_PN) (ComplSlash (SlashV2a love_V2) (UsePron she_Pron)))))))+l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (ComplSlash (SlashV2a love_V2) (UsePN john_PN))))))+l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a love_V2))))))+l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash (FunRP possess_Prep (DetCN (DetQuant DefArt NumSg) (UseN2 mother_N2)) IdRP) (SlashVP (UsePN john_PN) (SlashV2a love_V2))))))++-- Sentence++l -treebank PredVP (UsePN john_PN) (UseV walk_V)+l -treebank PredSCVP (EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV go_V)))) (UseComp (CompAP (PositA good_A)))+l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron he_Pron) (SlashV2a see_V2))))+l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (AdvSlash (SlashVP (UsePron he_Pron) (SlashV2a see_V2)) today_Adv)))+l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashPrep (PredVP (UsePron he_Pron) (UseV walk_V)) with_Prep)))+l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVS (UsePron she_Pron) say_VS (UseSlash (TTAnt TPres ASimul) PPos (SlashVP (UsePron he_Pron) (SlashV2a love_V2))))))+l -treebank ImpVP (ReflVP (SlashV2a love_V2))+l -treebank EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV go_V)))+l -treebank EmbedQS (UseQCl (TTAnt TPres ASimul) PPos (QuestVP whoSg_IP (UseV go_V)))+l -treebank EmbedVP (UseV go_V)+l -treebank UseCl (TTAnt TCond AAnter) PNeg (PredVP (UsePN john_PN) (UseV walk_V))+l -treebank UseQCl (TTAnt TCond AAnter) PNeg (QuestCl (PredVP (UsePN john_PN) (UseV walk_V)))+l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TCond AAnter) PNeg (RelVP IdRP (UseV walk_V)))+l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TCond AAnter) PNeg (RelSlash IdRP (SlashPrep (PredVP (UsePron i_Pron) (UseV walk_V)) with_Prep)))+l -treebank RelS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V))) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (UseComp (CompAP (PositA good_A)))))+++-- Text++l -treebank TEmpty+l -treebank TFullStop (PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc) TEmpty+l -treebank TQuestMark (PhrUtt NoPConj (UttQS (UseQCl (TTAnt TPres ASimul) PPos (QuestCl (PredVP (UsePron they_Pron) (UseComp (CompAdv here_Adv)))))) NoVoc) TEmpty+l -treebank TExclMark (PhrUtt NoPConj (ImpPl1 (UseV go_V)) NoVoc) TEmpty++-- Verb++l -treebank PredVP (UsePron i_Pron) (UseV sleep_V)+l -treebank PredVP (UsePron i_Pron) (ComplVV want_VV (UseV run_V))+l -treebank PredVP (UsePron i_Pron) (ComplVS say_VS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V))))+l -treebank PredVP (UsePron i_Pron) (ComplVQ wonder_VQ (UseQCl (TTAnt TPres ASimul) PPos (QuestVP whoSg_IP (UseV run_V))))+l -treebank PredVP (UsePron they_Pron) (ComplVA become_VA (PositA red_A))+l -treebank PredVP (UsePron i_Pron) (ComplSlash (Slash3V3 give_V3 (UsePron he_Pron)) (UsePron it_Pron))+l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (UseV go_V)) (UsePron she_Pron))+l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2S answer_V2S (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A)))))) (UsePron he_Pron))+l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2Q ask_V2Q (UseQCl (TTAnt TPast ASimul) PPos (QuestVP whoSg_IP (UseV come_V)))) (UsePron he_Pron))+l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2A paint_V2A (PositA red_A)) (UsePron it_Pron))+l -treebank RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron i_Pron) (SlashVV want_VV (SlashV2a buy_V2)))))+l -treebank RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashV2a buy_V2)))))+l -treebank PredVP (UsePron he_Pron) (ReflVP (SlashV2a love_V2))+l -treebank PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompAP (PositA warm_A)))+l -treebank PredVP (UsePron we_Pron) (PassV2 love_V2)+l -treebank PredVP (UsePron we_Pron) (AdvVP (UseV sleep_V) here_Adv)+l -treebank PredVP (UsePron we_Pron) (AdVVP always_AdV (UseV sleep_V))+l -treebank PredVP (UsePron we_Pron) (UseComp (CompAP (PositA small_A)))+l -treebank PredVP (UsePron i_Pron) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (UseN man_N))))+l -treebank PredVP (UsePron i_Pron) (UseComp (CompAdv here_Adv))++++-- Janna's and Krasimir's long examples++l -treebank RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashVV want_VV (SlashV2A paint_V2A (PositA red_A)))))))+l -treebank PhrUtt NoPConj (UttImpSg PPos (ImpVP (AdVVP always_AdV (ComplSlash (SlashV2a listen_V2) (DetCN (DetQuant DefArt NumSg) (UseN sea_N)))))) NoVoc+l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (ExistNP (PredetNP only_Predet (DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n2)))))))) (AdvCN (RelCN (UseN woman_N) (UseRCl (TTAnt TCond ASimul) PPos (RelSlash IdRP (SlashPrep (PredVP (UsePron i_Pron) (ComplVV want_VV (PassV2 see_V2))) with_Prep)))) (PrepNP in_Prep (DetCN (DetQuant DefArt NumSg) (UseN rain_N))))))))) NoVoc+l -treebank PhrUtt NoPConj (UttImpSg PPos (ImpVP (ComplSlash (SlashV2A paint_V2A (ConjAP both7and_DConj (BaseAP (ComparA small_A (DetCN (DetQuant DefArt NumSg) (UseN sun_N))) (ComparA big_A (DetCN (DetQuant DefArt NumSg) (UseN moon_N)))))) (DetCN (DetQuant DefArt NumSg) (UseN earth_N))))) NoVoc+l -treebank PhrUtt NoPConj (ImpPl1 (ComplVS hope_VS (ConjS either7or_DConj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumSg) (ComplN2 father_N2 (DetCN (DetQuant DefArt NumSg) (UseN baby_N)))) (UseV run_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumSg) (UseN2 (Use2N3 distance_N3))) (UseComp (CompAP (PositA small_A))))))))) NoVoc+l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN every_Det (UseN baby_N)) (UseComp (CompNP (ConjNP either7or_DConj (BaseNP (DetCN (DetQuant IndefArt NumSg) (UseN boy_N)) (DetCN (DetQuant IndefArt NumSg) (UseN girl_N))))))))) NoVoc+l -treebank PhrUtt NoPConj (UttAdv (ConjAdv either7or_DConj (ConsAdv here7from_Adv (BaseAdv there_Adv everywhere_Adv)))) NoVoc+l -treebank PhrUtt NoPConj (UttVP (PassV2 know_V2)) NoVoc+l -treebank RelCN (UseN bird_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron i_Pron) (SlashVV want_VV (SlashV2A paint_V2A (PositA red_A))))))+l -treebank UttImpSg PPos (ImpVP (ComplVV want_VV (ComplSlash (SlashV2a buy_V2) (UsePron it_Pron))))+l -treebank UttImpSg PPos (ImpVP (ComplVV want_VV (ComplSlash (SlashV2A paint_V2A (PositA red_A)) (UsePron it_Pron))))+l -treebank UttImpSg PPos (ImpVP (ComplSlash (SlashVV want_VV (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashV2a buy_V2))) (UsePron it_Pron)))+l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumPl) (UseN fruit_N)) (ReflVP (Slash3V3 sell_V3 (DetCN (DetQuant DefArt NumSg) (UseN road_N))))))) NoVoc+l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2V beg_V2V (UseV live_V)))))) NoVoc+l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2S answer_V2S (UseCl (TTAnt TPres ASimul) PPos (ImpersCl (ComplVV must_VV (ReflVP (SlashV2a understand_V2)))))))))) NoVoc+l -treebank PhrUtt NoPConj (UttImpSg PPos (ImpVP (ReflVP (SlashV2Q ask_V2Q (UseQCl (TTAnt TPast ASimul) PPos (QuestVP whoSg_IP (UseV come_V))))))) NoVoc+l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPast ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2A paint_V2A (ComparA beautiful_A (UsePN john_PN))))))) NoVoc++-- more long examples++l -treebank UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant this_Quant NumSg) (UseN grammar_N)) (ComplSlash (SlashV2a speak_V2) (DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot1to19 n2))))))) (UseN language_N)))))+l -treebank UseCl (TTAnt TPast AAnter) PPos (PredVP (UsePron she_Pron) (ComplSlash (SlashV2a buy_V2) (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA red_A) (UseN house_N)))))+
@@ -0,0 +1,1032 @@+Lang: PositA warm_A +LangEng: warm +LangSwe: varm +LangBul: топъл + + +Lang: ComparA warm_A (UsePron i_Pron) +LangEng: warmer than I +LangSwe: varmare än jag +LangBul: по - топъл от мен + + +Lang: ComplA2 married_A2 (UsePron she_Pron) +LangEng: married to her +LangSwe: gift med henne +LangBul: женен за нея + + +Lang: ComplA2 married_A2 (DetNP (DetQuant (PossPron she_Pron) NumPl)) +LangEng: married to hers +LangSwe: gift med hennes +LangBul: женен за нейните + + +Lang: ComplA2 married_A2 (DetNP (DetQuant (PossPron she_Pron) NumSg)) +LangEng: married to hers +LangSwe: gift med hennes +LangBul: женен за нейното + + +Lang: ReflA2 married_A2 +LangEng: married to myself +LangSwe: gift med sig +LangBul: женен за себе си + + +Lang: PositA (UseA2 married_A2) +LangEng: married +LangSwe: gift +LangBul: женен + + +Lang: SentAP (PositA good_A) (EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseComp (CompAdv here_Adv))))) +LangEng: good that she is here +LangSwe: god att hon är här +LangBul: добър , че тя е тук + + +Lang: AdAP very_AdA (PositA warm_A) +LangEng: very warm +LangSwe: mycket varm +LangBul: много топъл + + +Lang: PositAdvAdj warm_A +LangEng: warmly +LangSwe: varmt +LangBul: топло + + +Lang: PrepNP in_Prep (DetCN (DetQuant DefArt NumSg) (UseN house_N)) +LangEng: in the house +LangSwe: i huset +LangBul: в къщата + + +Lang: ComparAdvAdj more_CAdv warm_A (UsePN john_PN) +LangEng: more warmly than John +LangSwe: mer varmt än Johan +LangBul: по - топло от Джон + + +Lang: ComparAdvAdjS more_CAdv warm_A (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV run_V))) +LangEng: more warmly than he runs +LangSwe: mer varmt än han springer +LangBul: по - топло от колкото той бяга + + +Lang: SubjS when_Subj (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V))) +LangEng: when she sleeps +LangSwe: när hon sover +LangBul: когато тя спи + + +Lang: AdNum (AdnCAdv more_CAdv) (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))) +LangEng: more than five +LangSwe: mer än fem +LangBul: повече от пет + + +Lang: ConjS and_Conj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V)))) +LangEng: he walks and she runs +LangSwe: han går och hon springer +LangBul: той ходи и тя бяга + + +Lang: ConjAP and_Conj (BaseAP (PositA cold_A) (PositA warm_A)) +LangEng: cold and warm +LangSwe: kall och varm +LangBul: студен и топъл + + +Lang: ConjNP or_Conj (BaseNP (UsePron she_Pron) (UsePron we_Pron)) +LangEng: she or we +LangSwe: hon eller vi +LangBul: тя или ние + + +Lang: ConjAdv or_Conj (BaseAdv here_Adv there_Adv) +LangEng: here or there +LangSwe: här eller där +LangBul: тук или там + + +Lang: ConjS either7or_DConj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V)))) +LangEng: either he walks or she runs +LangSwe: antingen han går eller hon springer +LangBul: или той ходи или тя бяга + + +Lang: ConjAP both7and_DConj (BaseAP (PositA warm_A) (PositA cold_A)) +LangEng: both warm and cold +LangSwe: både varm och kall +LangBul: и топъл и студен + + +Lang: ConjNP either7or_DConj (BaseNP (UsePron he_Pron) (UsePron she_Pron)) +LangEng: either he or she +LangSwe: antingen han eller hon +LangBul: или той или тя + + +Lang: ConjAdv both7and_DConj (BaseAdv here_Adv there_Adv) +LangEng: both here and there +LangSwe: både här och där +LangBul: и тук и там + + +Lang: ImpersCl (UseComp (CompAP (PositA hot_A))) +LangEng: it is hot +LangSwe: det är hett +LangBul: е горещо + + +Lang: GenericCl (UseV sleep_V) +LangEng: one sleeps +LangSwe: man sover +LangBul: някой спи + + +Lang: CleftNP (UsePron i_Pron) (UseRCl (TTAnt TPast ASimul) PPos (RelVP IdRP (ComplSlash (SlashV2a do_V2) (UsePron it_Pron)))) +LangEng: it is I who did it +LangSwe: det är jag som gjorde det +LangBul: аз съм този който направих него + + +Lang: CleftAdv here_Adv (UseCl (TTAnt TPast ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V))) +LangEng: it is here that she slept +LangSwe: det är här hon sov +LangBul: тук тя спа + + +Lang: ExistNP (DetCN (DetQuant IndefArt NumSg) (UseN house_N)) +LangEng: there is a house +LangSwe: det finns ett hus +LangBul: има къща + + +Lang: ExistIP (IdetCN (IdetQuant which_IQuant NumPl) (UseN house_N)) +LangEng: which houses are there +LangSwe: vilka hus finns det +LangBul: кои къщи са тук + + +Lang: PredVP (UsePron i_Pron) (ProgrVP (UseV sleep_V)) +LangEng: I am sleeping +LangSwe: jag håller på att sova +LangBul: аз спя + + +Lang: ImpPl1 (UseV go_V) +LangEng: let's go +LangSwe: låt oss gå +LangBul: нека да отидем + + +Lang: DetCN (DetQuant DefArt NumSg) (UseN man_N) +LangEng: the man +LangSwe: mannen +LangBul: мъжът + + +Lang: UsePN john_PN +LangEng: John +LangSwe: Johan +LangBul: Джон + + +Lang: UsePron he_Pron +LangEng: he +LangSwe: han +LangBul: той + + +Lang: PredetNP only_Predet (DetCN (DetQuant DefArt NumSg) (UseN man_N)) +LangEng: only the man +LangSwe: bara mannen +LangBul: само мъжът + + +Lang: PPartNP (DetCN (DetQuant DefArt NumSg) (UseN man_N)) see_V2 +LangEng: the man seen +LangSwe: mannen sedd +LangBul: мъжът видян + + +Lang: AdvNP (UsePN paris_PN) today_Adv +LangEng: Paris today +LangSwe: Paris idag +LangBul: Париж днес + + +Lang: RelNP (UsePN paris_PN) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (UseComp (CompAdv here_Adv)))) +LangEng: Paris , which is here +LangSwe: Paris , som är här +LangBul: Париж който е тук + + +Lang: DetNP (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) +LangEng: these five +LangSwe: de här fem +LangBul: тези пет + + +Lang: DetCN (DetQuantOrd this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N) +LangEng: these five best men +LangSwe: de här fem bästa männen +LangBul: тези петима най - добри мъже + + +Lang: DetCN (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN man_N) +LangEng: these five men +LangSwe: de här fem männen +LangBul: тези петима мъже + + +Lang: DetCN (DetQuant this_Quant NumPl) (UseN man_N) +LangEng: these men +LangSwe: de här männen +LangBul: тези мъже + + +Lang: DetCN (DetQuant this_Quant NumSg) (UseN man_N) +LangEng: this man +LangSwe: den här mannen +LangBul: този мъж + + +Lang: NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))) +LangEng: five +LangSwe: fem +LangBul: пет + + +Lang: NumCard (NumDigits (IIDig D_5 (IDig D_1))) +LangEng: 5 1 +LangSwe: 5 1 +LangBul: 5 1 + + +Lang: NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01))))) +LangEng: fifty - one +LangSwe: femtio en +LangBul: петдесет и един + + +Lang: NumCard (AdNum almost_AdN (NumDigits (IIDig D_5 (IDig D_1)))) +LangEng: almost 5 1 +LangSwe: nästan 5 1 +LangBul: почти 5 1 + + +Lang: OrdDigits (IIDig D_5 (IDig D_1)) +LangEng: 5 1st +LangSwe: 5 1:a +LangBul: 5 1ви + + +Lang: OrdNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01)))) +LangEng: fifty - first +LangSwe: femtio första +LangBul: петдесет и първи + + +Lang: OrdSuperl warm_A +LangEng: warmest +LangSwe: varmaste +LangBul: най - топъл + + +Lang: DetCN (DetQuantOrd DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N) +LangEng: the five best men +LangSwe: de fem bästa männen +LangBul: петимата най - добри мъже + + +Lang: DetCN (DetQuant DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN man_N) +LangEng: the five men +LangSwe: de fem männen +LangBul: петимата мъже + + +Lang: DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01))))))) (UseN man_N) +LangEng: one man +LangSwe: en man +LangBul: един мъж + + +Lang: DetCN (DetQuant DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01))))))) (UseN man_N) +LangEng: the one man +LangSwe: den en mannen +LangBul: единият мъж + + +Lang: DetCN (DetQuant DefArt NumSg) (UseN man_N) +LangEng: the man +LangSwe: mannen +LangBul: мъжът + + +Lang: DetCN (DetQuant DefArt NumPl) (UseN man_N) +LangEng: the men +LangSwe: männen +LangBul: мъжете + + +Lang: MassNP (UseN beer_N) +LangEng: beer +LangSwe: öl +LangBul: бира + + +Lang: DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN house_N) +LangEng: my house +LangSwe: mitt hus +LangBul: моята къща + + +Lang: UseN house_N +LangEng: house +LangSwe: hus +LangBul: къща + + +Lang: ComplN2 mother_N2 (DetCN (DetQuant DefArt NumSg) (UseN king_N)) +LangEng: mother of the king +LangSwe: mor till kungen +LangBul: майка на царя + + +Lang: ComplN2 (ComplN3 distance_N3 (DetCN (DetQuant this_Quant NumSg) (UseN city_N))) (UsePN paris_PN) +LangEng: distance from this city to Paris +LangSwe: avstånd från den här staden till Paris +LangBul: разстояние от този град до Париж + + +Lang: UseN2 mother_N2 +LangEng: mother +LangSwe: mor +LangBul: майка + + +Lang: ComplN2 (Use2N3 distance_N3) (DetCN (DetQuant this_Quant NumSg) (UseN city_N)) +LangEng: distance from this city +LangSwe: avstånd från den här staden +LangBul: разстояние от този град + + +Lang: ComplN2 (Use3N3 distance_N3) (UsePN paris_PN) +LangEng: distance to Paris +LangSwe: avstånd till Paris +LangBul: разстояние до Париж + + +Lang: UseN2 (Use2N3 distance_N3) +LangEng: distance +LangSwe: avstånd +LangBul: разстояние + + +Lang: AdjCN (PositA big_A) (UseN house_N) +LangEng: big house +LangSwe: stort hus +LangBul: голяма къща + + +Lang: RelCN (UseN house_N) (UseRCl (TTAnt TPast ASimul) PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a buy_V2)))) +LangEng: house which John bought +LangSwe: hus som Johan köpte +LangBul: къща която Джон купи + + +Lang: AdvCN (UseN house_N) (PrepNP on_Prep (DetCN (DetQuant DefArt NumSg) (UseN hill_N))) +LangEng: house on the hill +LangSwe: hus på kullen +LangBul: къща на хълма + + +Lang: SentCN (UseN question_N) (EmbedQS (UseQCl (TTAnt TPres ASimul) PPos (QuestIAdv where_IAdv (PredVP (UsePron she_Pron) (UseV sleep_V))))) +LangEng: question where she sleeps +LangSwe: fråga var hon sover +LangBul: въпрос където тя спи + + +Lang: DetCN (DetQuant DefArt NumSg) (ApposCN (UseN city_N) (UsePN paris_PN)) +LangEng: the city Paris +LangSwe: staden Paris +LangBul: градът Париж + + +Lang: DetCN (DetQuant (PossPron i_Pron) NumSg) (ApposCN (UseN friend_N) (UsePN john_PN)) +LangEng: my friend John +LangSwe: min vän Johan +LangBul: моят приятел Джон + + +Lang: num (pot2as3 (pot1as2 (pot0as1 (pot0 n6)))) +LangEng: six +LangSwe: sex +LangBul: шест + + +Lang: num (pot2as3 (pot1as2 (pot0as1 pot01))) +LangEng: one +LangSwe: en +LangBul: един + + +Lang: num (pot2as3 (pot1as2 (pot1 n6))) +LangEng: sixty +LangSwe: sextio +LangBul: шестдесет + + +Lang: num (pot2as3 (pot1as2 pot110)) +LangEng: ten +LangSwe: tio +LangBul: десет + + +Lang: num (pot2as3 (pot1as2 pot111)) +LangEng: eleven +LangSwe: elva +LangBul: единадесет + + +Lang: num (pot2as3 (pot1as2 (pot1to19 n6))) +LangEng: sixteen +LangSwe: sexton +LangBul: шестнадесет + + +Lang: num (pot2as3 (pot1as2 (pot1 n6))) +LangEng: sixty +LangSwe: sextio +LangBul: шестдесет + + +Lang: num (pot2as3 (pot1as2 (pot1plus n6 (pot0 n5)))) +LangEng: sixty - five +LangSwe: sextio fem +LangBul: шестдесет и пет + + +Lang: num (pot2as3 (pot2 (pot0 n4))) +LangEng: four hundred +LangSwe: fyra hundra +LangBul: четиристотин + + +Lang: num (pot2as3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7)))) +LangEng: four hundred and sixty - seven +LangSwe: fyra hundra sextio sju +LangBul: четиристотин шестдесет и седем + + +Lang: num (pot3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7)))) +LangEng: four hundred and sixty - seven thousand +LangSwe: fyra hundra sextio sju tusen +LangBul: четиристотин шестдесет и седем хиляди + + +Lang: num (pot3plus (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))) (pot1as2 (pot1plus n8 (pot0 n9)))) +LangEng: four hundred and sixty - seven thousand eighty - nine +LangSwe: fyra hundra sextio sju tusen åttio nio +LangBul: четиристотин шестдесет и седем хиляди осемдесет и девет + + +Lang: IDig D_8 +LangEng: 8 +LangSwe: 8 +LangBul: 8 + + +Lang: IIDig D_8 (IIDig D_0 (IIDig D_0 (IIDig D_1 (IIDig D_7 (IIDig D_8 (IDig D_9)))))) +LangEng: 8 , 0 0 1 , 7 8 9 +LangSwe: 8 0 0 1 7 8 9 +LangBul: 8 , 0 0 1 , 7 8 9 + + +Lang: PhrUtt but_PConj (UttImpSg PPos (ImpVP (AdvVP (UseV come_V) here_Adv))) (VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N))) +LangEng: but come here , my friend +LangSwe: men kom här , min vän +LangBul: но ела тук , мой приятелю + + +Lang: PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc +LangEng: John walks +LangSwe: Johan går +LangBul: Джон ходи + + +Lang: UttQS (UseQCl (TTAnt TPres ASimul) PPos (QuestCl (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A)))))) +LangEng: is it good +LangSwe: är det gott +LangBul: то е ли добро + + +Lang: UttImpSg PNeg (ImpVP (ReflVP (SlashV2a love_V2))) +LangEng: don't love yourself +LangSwe: älska inte dig +LangBul: не се обичай + + +Lang: UttImpPl PNeg (ImpVP (ReflVP (SlashV2a love_V2))) +LangEng: don't love yourselves +LangSwe: älska inte er +LangBul: не се обичайте + + +Lang: UttImpPol PNeg (ImpVP (UseV sleep_V)) +LangEng: don't sleep +LangSwe: sov inte +LangBul: не спете + + +Lang: UttIP whoPl_IP +LangEng: who +LangSwe: vilka +LangBul: кои + + +Lang: UttIP whoSg_IP +LangEng: who +LangSwe: vem +LangBul: кой + + +Lang: UttIAdv why_IAdv +LangEng: why +LangSwe: varför +LangBul: защо + + +Lang: UttNP (DetCN (DetQuant this_Quant NumSg) (UseN man_N)) +LangEng: this man +LangSwe: den här mannen +LangBul: този мъж + + +Lang: UttAdv here_Adv +LangEng: here +LangSwe: här +LangBul: тук + + +Lang: UttVP (UseV sleep_V) +LangEng: to sleep +LangSwe: att sova +LangBul: да спи + + +Lang: VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N)) +LangEng: , my friend +LangSwe: , min vän +LangBul: , мой приятелю + + +Lang: QuestCl (PredVP (UsePN john_PN) (UseV walk_V)) +LangEng: does John walk +LangSwe: går Johan +LangBul: Джон ходи ли + + +Lang: QuestVP whoSg_IP (UseV walk_V) +LangEng: who walks +LangSwe: vem går +LangBul: кой ходи + + +Lang: QuestSlash whoSg_IP (SlashVP (UsePN john_PN) (SlashV2a love_V2)) +LangEng: whom does John love +LangSwe: vem älskar Johan +LangBul: кого обича Джон + + +Lang: QuestIAdv why_IAdv (PredVP (UsePN john_PN) (UseV walk_V)) +LangEng: why does John walk +LangSwe: varför går Johan +LangBul: защо ходи Джон + + +Lang: QuestIComp (CompIAdv where_IAdv) (UsePN john_PN) +LangEng: where is John +LangSwe: var är Johan +LangBul: къде е Джон + + +Lang: IdetCN (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN song_N) +LangEng: which five songs +LangSwe: vilka fem sånger +LangBul: кои пет песни + + +Lang: IdetIP (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) +LangEng: which five +LangSwe: vilka fem +LangBul: кои пет + + +Lang: AdvIP whoSg_IP (PrepNP in_Prep (UsePN paris_PN)) +LangEng: who in Paris +LangSwe: vem i Paris +LangBul: кой в Париж + + +Lang: IdetIP (IdetQuant which_IQuant NumSg) +LangEng: which +LangSwe: vilket +LangBul: кое + + +Lang: PrepIP with_Prep whoSg_IP +LangEng: with whom +LangSwe: med vem +LangBul: с кой + + +Lang: QuestIComp (CompIAdv where_IAdv) (UsePron it_Pron) +LangEng: where is it +LangSwe: var är det +LangBul: къде е то + + +Lang: QuestIComp (CompIP whoSg_IP) (UsePron it_Pron) +LangEng: who is it +LangSwe: vem är det +LangBul: кой е то + + +Lang: ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelCl (PredVP (UsePN john_PN) (ComplSlash (SlashV2a love_V2) (UsePron she_Pron))))))) +LangEng: there is a woman such that John loves her +LangSwe: det finns en kvinna sådan att Johan älskar henne +LangBul: има жена такава че Джон обича нея + + +Lang: ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (ComplSlash (SlashV2a love_V2) (UsePN john_PN)))))) +LangEng: there is a woman who loves John +LangSwe: det finns en kvinna som älskar Johan +LangBul: има жена която обича Джон + + +Lang: ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a love_V2)))))) +LangEng: there is a woman whom John loves +LangSwe: det finns en kvinna som Johan älskar +LangBul: има жена която Джон обича + + +Lang: ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash (FunRP possess_Prep (DetCN (DetQuant DefArt NumSg) (UseN2 mother_N2)) IdRP) (SlashVP (UsePN john_PN) (SlashV2a love_V2)))))) +LangEng: there is a woman the mother of whom John loves +LangSwe: det finns en kvinna modern av vilken Johan älskar +LangBul: има жена майката на която Джон обича + + +Lang: PredVP (UsePN john_PN) (UseV walk_V) +LangEng: John walks +LangSwe: Johan går +LangBul: Джон ходи + + +Lang: PredSCVP (EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV go_V)))) (UseComp (CompAP (PositA good_A))) +LangEng: that she goes is good +LangSwe: att hon går är gott +LangBul: , че тя отива е добър + + +Lang: RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron he_Pron) (SlashV2a see_V2)))) +LangEng: girl whom he sees +LangSwe: flicka som han ser +LangBul: момиче което той вижда + + +Lang: RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (AdvSlash (SlashVP (UsePron he_Pron) (SlashV2a see_V2)) today_Adv))) +LangEng: girl whom he sees today +LangSwe: flicka som han ser idag +LangBul: момиче което той вижда днес + + +Lang: RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashPrep (PredVP (UsePron he_Pron) (UseV walk_V)) with_Prep))) +LangEng: girl with whom he walks +LangSwe: flicka med vilken han går +LangBul: момиче с което той ходи + + +Lang: RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVS (UsePron she_Pron) say_VS (UseSlash (TTAnt TPres ASimul) PPos (SlashVP (UsePron he_Pron) (SlashV2a love_V2)))))) +LangEng: girl whom she says that he loves +LangSwe: flicka som hon säger att han älskar +LangBul: момиче което тя казва че той обича + + +Lang: ImpVP (ReflVP (SlashV2a love_V2)) +LangEng: love yourself +LangSwe: älska dig +LangBul: обичай се + + +Lang: EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV go_V))) +LangEng: that she goes +LangSwe: att hon går +LangBul: , че тя отива + + +Lang: EmbedQS (UseQCl (TTAnt TPres ASimul) PPos (QuestVP whoSg_IP (UseV go_V))) +LangEng: who goes +LangSwe: vem som går +LangBul: който отива + + +Lang: EmbedVP (UseV go_V) +LangEng: to go +LangSwe: att gå +LangBul: да отида + + +Lang: UseCl (TTAnt TCond AAnter) PNeg (PredVP (UsePN john_PN) (UseV walk_V)) +LangEng: John wouldn't have walked +LangSwe: Johan skulle inte ha gått +LangBul: Джон не би ходил + + +Lang: UseQCl (TTAnt TCond AAnter) PNeg (QuestCl (PredVP (UsePN john_PN) (UseV walk_V))) +LangEng: wouldn't John have walked +LangSwe: skulle Johan inte ha gått +LangBul: Джон не би ли ходил + + +Lang: RelCN (UseN girl_N) (UseRCl (TTAnt TCond AAnter) PNeg (RelVP IdRP (UseV walk_V))) +LangEng: girl who wouldn't have walked +LangSwe: flicka som inte skulle ha gått +LangBul: момиче което не би ходило + + +Lang: RelCN (UseN girl_N) (UseRCl (TTAnt TCond AAnter) PNeg (RelSlash IdRP (SlashPrep (PredVP (UsePron i_Pron) (UseV walk_V)) with_Prep))) +LangEng: girl with whom I wouldn't have walked +LangSwe: flicka med vilken jag inte skulle ha gått +LangBul: момиче с което аз не бих ходил + + +Lang: RelS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V))) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (UseComp (CompAP (PositA good_A))))) +LangEng: she sleeps , which is good +LangSwe: hon sover , som är gott +LangBul: тя спи , което е добро + + +Lang: TEmpty +LangEng: +LangSwe: +LangBul: + + +Lang: TFullStop (PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc) TEmpty +LangEng: John walks . +LangSwe: Johan går . +LangBul: Джон ходи . + + +Lang: TQuestMark (PhrUtt NoPConj (UttQS (UseQCl (TTAnt TPres ASimul) PPos (QuestCl (PredVP (UsePron they_Pron) (UseComp (CompAdv here_Adv)))))) NoVoc) TEmpty +LangEng: are they here ? +LangSwe: är de här ? +LangBul: те са ли тук ? + + +Lang: TExclMark (PhrUtt NoPConj (ImpPl1 (UseV go_V)) NoVoc) TEmpty +LangEng: let's go ! +LangSwe: låt oss gå ! +LangBul: нека да отидем ! + + +Lang: PredVP (UsePron i_Pron) (UseV sleep_V) +LangEng: I sleep +LangSwe: jag sover +LangBul: аз спя + + +Lang: PredVP (UsePron i_Pron) (ComplVV want_VV (UseV run_V)) +LangEng: I want to run +LangSwe: jag vill springa +LangBul: аз искам да бягам + + +Lang: PredVP (UsePron i_Pron) (ComplVS say_VS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V)))) +LangEng: I say that she runs +LangSwe: jag säger att hon springer +LangBul: аз казвам , че тя бяга + + +Lang: PredVP (UsePron i_Pron) (ComplVQ wonder_VQ (UseQCl (TTAnt TPres ASimul) PPos (QuestVP whoSg_IP (UseV run_V)))) +LangEng: I wonder who runs +LangSwe: jag undrar vem som springer +LangBul: аз се учудвам кой бяга + + +Lang: PredVP (UsePron they_Pron) (ComplVA become_VA (PositA red_A)) +LangEng: they become red +LangSwe: de blir röda +LangBul: те стават червени + + +Lang: PredVP (UsePron i_Pron) (ComplSlash (Slash3V3 give_V3 (UsePron he_Pron)) (UsePron it_Pron)) +LangEng: I give it to him +LangSwe: jag ger det till honom +LangBul: аз давам него му + + +Lang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (UseV go_V)) (UsePron she_Pron)) +LangEng: I beg her to go +LangSwe: jag ber henne att gå +LangBul: аз моля нея да отиде + + +Lang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2S answer_V2S (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A)))))) (UsePron he_Pron)) +LangEng: I answer to him that it is good +LangSwe: jag svarar till honom att det är gott +LangBul: аз отговарям му , че то е добро + + +Lang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2Q ask_V2Q (UseQCl (TTAnt TPast ASimul) PPos (QuestVP whoSg_IP (UseV come_V)))) (UsePron he_Pron)) +LangEng: I ask him who came +LangSwe: jag frågar honom vem som kom +LangBul: аз питам него кой дойде + + +Lang: PredVP (UsePron i_Pron) (ComplSlash (SlashV2A paint_V2A (PositA red_A)) (UsePron it_Pron)) +LangEng: I paint it red +LangSwe: jag målar det rött +LangBul: аз рисувам него червено + + +Lang: RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron i_Pron) (SlashVV want_VV (SlashV2a buy_V2))))) +LangEng: car which I want to buy +LangSwe: bil som jag vill köpa +LangBul: кола която аз искам да купя + + +Lang: RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashV2a buy_V2))))) +LangEng: car which they beg me to buy +LangSwe: bil som de ber mig att köpa +LangBul: кола която те молят мен да купя + + +Lang: PredVP (UsePron he_Pron) (ReflVP (SlashV2a love_V2)) +LangEng: he loves himself +LangSwe: han älskar sig +LangBul: той се обича + + +Lang: PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompAP (PositA warm_A))) +LangEng: this is warm +LangSwe: det här är varmt +LangBul: това е топло + + +Lang: PredVP (UsePron we_Pron) (PassV2 love_V2) +LangEng: we are loved +LangSwe: vi blir älskade +LangBul: ние сме обичани + + +Lang: PredVP (UsePron we_Pron) (AdvVP (UseV sleep_V) here_Adv) +LangEng: we sleep here +LangSwe: vi sover här +LangBul: ние спим тук + + +Lang: PredVP (UsePron we_Pron) (AdVVP always_AdV (UseV sleep_V)) +LangEng: we always sleep +LangSwe: vi sover alltid +LangBul: ние винаги спим + + +Lang: PredVP (UsePron we_Pron) (UseComp (CompAP (PositA small_A))) +LangEng: we are small +LangSwe: vi är små +LangBul: ние сме малки + + +Lang: PredVP (UsePron i_Pron) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (UseN man_N)))) +LangEng: I am a man +LangSwe: jag är en man +LangBul: аз съм мъж + + +Lang: PredVP (UsePron i_Pron) (UseComp (CompAdv here_Adv)) +LangEng: I am here +LangSwe: jag är här +LangBul: аз съм тук + + +Lang: RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashVV want_VV (SlashV2A paint_V2A (PositA red_A))))))) +LangEng: car which they beg me to want to paint red +LangSwe: bil som de ber mig att vilja måla röd +LangBul: кола която те молят мен да искам да нарисувам червена + + +Lang: PhrUtt NoPConj (UttImpSg PPos (ImpVP (AdVVP always_AdV (ComplSlash (SlashV2a listen_V2) (DetCN (DetQuant DefArt NumSg) (UseN sea_N)))))) NoVoc +LangEng: always listen to the sea +LangSwe: lyssna alltid på havet +LangBul: винаги слушай морето + + +Lang: PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (ExistNP (PredetNP only_Predet (DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n2)))))))) (AdvCN (RelCN (UseN woman_N) (UseRCl (TTAnt TCond ASimul) PPos (RelSlash IdRP (SlashPrep (PredVP (UsePron i_Pron) (ComplVV want_VV (PassV2 see_V2))) with_Prep)))) (PrepNP in_Prep (DetCN (DetQuant DefArt NumSg) (UseN rain_N))))))))) NoVoc +LangEng: there are only two women with whom I would want to be seen in the rain +LangSwe: det finns bara två kvinnor med vilka jag skulle vilja bli sedd i regnet +LangBul: има само две жени с които аз бих искал да съм видян в дъжда + + +Lang: PhrUtt NoPConj (UttImpSg PPos (ImpVP (ComplSlash (SlashV2A paint_V2A (ConjAP both7and_DConj (BaseAP (ComparA small_A (DetCN (DetQuant DefArt NumSg) (UseN sun_N))) (ComparA big_A (DetCN (DetQuant DefArt NumSg) (UseN moon_N)))))) (DetCN (DetQuant DefArt NumSg) (UseN earth_N))))) NoVoc +LangEng: paint the earth both smaller than the sun and bigger than the moon +LangSwe: måla jorden både mindre än solen och större än månen +LangBul: нарисувай земята и по - малка от слънцето и по - голяма от луната + + +Lang: PhrUtt NoPConj (ImpPl1 (ComplVS hope_VS (ConjS either7or_DConj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumSg) (ComplN2 father_N2 (DetCN (DetQuant DefArt NumSg) (UseN baby_N)))) (UseV run_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumSg) (UseN2 (Use2N3 distance_N3))) (UseComp (CompAP (PositA small_A))))))))) NoVoc +LangEng: let's hope that either the father of the baby runs or the distance is small +LangSwe: låt oss hoppas att antingen fadern till bebisen springer eller avståndet är litet +LangBul: нека да се надяваме , че или бащата на бебето бяга или разстоянието е малко + + +Lang: PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN every_Det (UseN baby_N)) (UseComp (CompNP (ConjNP either7or_DConj (BaseNP (DetCN (DetQuant IndefArt NumSg) (UseN boy_N)) (DetCN (DetQuant IndefArt NumSg) (UseN girl_N))))))))) NoVoc +LangEng: every baby is either a boy or a girl +LangSwe: varje bebis är antingen en pojke eller en flicka +LangBul: всяко бебе е или момче или момиче + + +Lang: PhrUtt NoPConj (UttAdv (ConjAdv either7or_DConj (ConsAdv here7from_Adv (BaseAdv there_Adv everywhere_Adv)))) NoVoc +LangEng: either from here , there or everywhere +LangSwe: antingen härifrån , där eller överallt +LangBul: или от тук или там или навсякъде + + +Lang: PhrUtt NoPConj (UttVP (PassV2 know_V2)) NoVoc +LangEng: to be known +LangSwe: att bli kännd +LangBul: да е известно + + +Lang: RelCN (UseN bird_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron i_Pron) (SlashVV want_VV (SlashV2A paint_V2A (PositA red_A)))))) +LangEng: bird which I want to paint red +LangSwe: fågel som jag vill måla röd +LangBul: птица която аз искам да нарисувам червена + + +Lang: UttImpSg PPos (ImpVP (ComplVV want_VV (ComplSlash (SlashV2a buy_V2) (UsePron it_Pron)))) +LangEng: want to buy it +LangSwe: vilj köpa det +LangBul: искай да купиш него + + +Lang: UttImpSg PPos (ImpVP (ComplVV want_VV (ComplSlash (SlashV2A paint_V2A (PositA red_A)) (UsePron it_Pron)))) +LangEng: want to paint it red +LangSwe: vilj måla det rött +LangBul: искай да нарисуваш него червено + + +Lang: UttImpSg PPos (ImpVP (ComplSlash (SlashVV want_VV (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashV2a buy_V2))) (UsePron it_Pron))) +LangEng: want it to beg me to buy +LangSwe: vilj det be mig att köpa +LangBul: искай да молиш мен да купя него + + +Lang: PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumPl) (UseN fruit_N)) (ReflVP (Slash3V3 sell_V3 (DetCN (DetQuant DefArt NumSg) (UseN road_N))))))) NoVoc +LangEng: the fruits sell themselves to the road +LangSwe: frukterna säljer sig till vägen +LangBul: плодовете се продават на пътя + + +Lang: PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2V beg_V2V (UseV live_V)))))) NoVoc +LangEng: I beg myself to live +LangSwe: jag ber mig att leva +LangBul: аз се моля да живея + + +Lang: PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2S answer_V2S (UseCl (TTAnt TPres ASimul) PPos (ImpersCl (ComplVV must_VV (ReflVP (SlashV2a understand_V2)))))))))) NoVoc +LangEng: I answer to myself that it must understand itself +LangSwe: jag svarar till mig att det måste förstå sig +LangBul: аз си отговарям , че трябва да се разбере + + +Lang: PhrUtt NoPConj (UttImpSg PPos (ImpVP (ReflVP (SlashV2Q ask_V2Q (UseQCl (TTAnt TPast ASimul) PPos (QuestVP whoSg_IP (UseV come_V))))))) NoVoc +LangEng: ask yourself who came +LangSwe: fråga dig vem som kom +LangBul: питай се кой дойде + + +Lang: PhrUtt NoPConj (UttS (UseCl (TTAnt TPast ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2A paint_V2A (ComparA beautiful_A (UsePN john_PN))))))) NoVoc +LangEng: I painted myself more beautiful than John +LangSwe: jag målade mig vackrare än Johan +LangBul: аз се нарисувах по - красив от Джон + + +Lang: UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant this_Quant NumSg) (UseN grammar_N)) (ComplSlash (SlashV2a speak_V2) (DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot1to19 n2))))))) (UseN language_N))))) +LangEng: this grammar speaks twelve languages +LangSwe: den här grammatiken talar tolv språk +LangBul: тази граматика говори дванадесет езика + + +Lang: UseCl (TTAnt TPast AAnter) PPos (PredVP (UsePron she_Pron) (ComplSlash (SlashV2a buy_V2) (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA red_A) (UseN house_N))))) +LangEng: she had bought a red house +LangSwe: hon hade köpt ett rött hus +LangBul: тя беше купилa червена къща + +
@@ -0,0 +1,78 @@+import Data.List(partition)+import System.IO+import Distribution.Simple.BuildPaths(exeExtension)+import System.Process(readProcess)+import System.Directory(doesFileExist,getDirectoryContents)+import System.FilePath((</>),(<.>),takeExtension)+import System.Exit(exitSuccess,exitFailure)++main = + do res <- walk "testsuite"+ let cnt = length res+ (good,bad) = partition ((=="OK").fst.snd) res+ ok = length good+ fail = ok<cnt+ putStrLn $ show ok++"/"++show cnt++ " passed/tests"+ let overview = "dist/test/gf-tests.html"+ writeFile overview (toHTML bad)+ if ok<cnt + then do putStrLn $ overview++" contains an overview of the failed tests"+ exitFailure+ else exitSuccess+ where+ toHTML res =+ "<!DOCTYPE html>\n"+ ++ "<meta charset=\"UTF-8\">\n"+ ++ "<style>\n"+ ++ "pre { max-width: 600px; overflow: scroll; }\n"+ ++ "th,td { vertical-align: top; text-align: left; }\n"+ ++ "</style>\n"+ ++ "<table border=1>\n<tr><th>Result<th>Input<th>Gold<th>Output\n"+ ++ unlines (map testToHTML res)+ ++ "</table>\n"++ testToHTML (in_file,(res,(input,gold,output))) =+ "<tr>"++concatMap td [pre res,in_file++":\n"++pre input,pre gold,pre output]+ pre s = "<pre>"++s++"</pre>"+ td s = "<td>"++s++ walk path = fmap concat . mapM (walkFile . (path </>)) =<< ls path++ walkFile fpath = do+ exists <- doesFileExist fpath+ if exists+ then if takeExtension fpath == ".gfs"+ then do let in_file = fpath+ gold_file = fpath <.> ".gold"+ out_file = fpath <.> ".out"+ putStr $ in_file++": "; hFlush stdout+ res <- runTest in_file out_file gold_file+ putStrLn $ fst res+ return [(in_file,res)]+ else return []+ else walk fpath++ runTest in_file out_file gold_file = do+ input <- readFile in_file+ writeFile out_file =<< run_gf input+ exists <- doesFileExist gold_file+ if exists+ then do out <- compatReadFile out_file+ gold <- compatReadFile gold_file+ let info = (input,gold,out)+ return $! if out == gold then ("OK",info) else ("FAIL",info)+ else do out <- compatReadFile out_file+ return ("MISSING GOLD",(input,"",out))+ -- Avoid failures caused by Win32/Unix text file incompatibility+ compatReadFile path =+ do h <- openFile path ReadMode+ hSetNewlineMode h universalNewlineMode+ hGetContents h++-- Should consult the Cabal configuration!+run_gf = readProcess default_gf ["-run","-gf-lib-path="++gf_lib_path]+default_gf = "dist/build/gf/gf"<.>exeExtension+gf_lib_path = "dist/build/rgl"++-- | List files, excluding "." and ".."+ls path = filter (`notElem` [".",".."]) `fmap` getDirectoryContents path
@@ -0,0 +1,44 @@+abstract Test = { + +fun f : Int -> Int -> Int ; + +fun g : Int -> Int ; +def g 1 = 2 ; + +fun g2 : Int -> Int -> Int ; +def g2 1 x = x ; + +fun g0 : Int -> Int -> Int ; +def g0 = g2 ; + +fun g3 : Int -> (Int -> Int) ; +def g3 3 = g ; + +fun const : Float -> String -> Float ; +def const x _ = x ; + +cat Nat ; + +data zero : Nat ; + succ : Nat -> Nat ; + err : Nat ; + +fun zeroF : Nat ; + succF : Nat -> Nat ; + +fun dec : Nat -> Nat ; +def dec zero = zero ; + dec (succ n) = n ; + dec n = err ; -- for fall through checking + +fun plus : Nat -> Nat -> Nat ; +def plus err zero = err ; + plus m err = err ; + plus m zero = m ; + plus m (succ n) = plus (succ m) n ; + +fun dec2 : Int -> Nat -> Nat ; +def dec2 0 zero = err ; + dec2 _ (succ n) = n ; + +}
@@ -0,0 +1,34 @@+i -src testsuite/runtime/eval/Test.gf++pt -compute <\x -> x 1 : (Int->Int)->Int>+pt -compute <? : Int -> Int> 1+pt -compute <\x -> x 1 : (Int->Int)->Int> ?+pt -compute f 1 2+pt -compute <\x -> x : Nat -> Nat>+pt -compute <? : String>+pt -compute f+pt -compute <\x -> x 2 : (Int->Int)->Int> (f 1)+pt -compute g 1+pt -compute g 0+pt -compute <\x -> g x : Int -> Int>+pt -compute g ?+pt -compute <\x -> x 5 : (Int->Int)->Int> (g2 1)+pt -compute <\x -> x 3 : (Int->Int)->Int> (\x -> x)+pt -compute g0+pt -compute <\x -> x 32 : (Int -> Int -> Int) -> Int -> Int> <\x -> f x : Int -> Int -> Int>+pt -compute g0 23+pt -compute const 3.14 "pi"+pt -compute dec (succ (succ zero))+pt -compute dec (succ ?)+pt -compute dec (succ zeroF)+pt -compute dec (succF zeroF)+pt -compute dec zeroF+pt -compute <\x -> dec x : Nat -> Nat>+pt -compute dec ?+pt -compute <\f -> f 0 : (Int -> Int) -> Int> (g3 ?)+pt -compute g (g2 ? 0)+pt -compute plus (succ zero) (succ zero)+pt -compute dec2 0 (succ zero)+pt -compute dec2 0 err+pt -compute plus err (succ zero)+pt -compute <\x -> dec (dec x) : Nat -> Nat>
@@ -0,0 +1,64 @@+\v0 -> v0 1 + +?1 1 + +?3 1 + +f 1 2 + +\v0 -> v0 + +?1 + +f + +f 1 2 + +2 + +g 0 + +\v0 -> g v0 + +g ?1 + +5 + +3 + +g2 + +f 32 + +g2 23 + +3.14 + +succ zero + +?1 + +zeroF + +dec (succF zeroF) + +dec zeroF + +\v0 -> dec v0 + +dec ?1 + +g3 ?3 0 + +g (g2 ?1 0) + +succ (succ zero) + +zero + +dec2 0 err + +succ err + +\v0 -> dec (dec v0) +
@@ -0,0 +1,15 @@+abstract lazy = {++cat Nat ;+data zero : Nat ;+ succ : Nat -> Nat ;++fun infinity : Nat ;+def infinity = succ infinity ;++fun min : Nat -> Nat -> Nat ;+def min zero _ = zero ;+ min _ zero = zero ;+ min (succ x) (succ y) = succ (min x y) ;++}
@@ -0,0 +1,2 @@+i -src testsuite/runtime/eval/lazy.gf+pt -compute min infinity (succ (succ (succ zero)))
@@ -0,0 +1,2 @@+succ (succ (succ zero)) +
@@ -0,0 +1,16 @@+abstract Test = { + +cat S ; +cat E ; + +fun Exist : (E -> S) -> S ; + Even : E -> S ; + +fun a : E ; + f,fa,fb : E -> S ; + +fun IsString : String -> S ; + IsInteger : Int -> S ; + IsFloat : Float -> S ; + +}
@@ -0,0 +1,21 @@+concrete TestCnc of Test = { + +param Number = Pl | Sg; +lincat E = {s:Str; n : Number} ; +lindef E = \s -> {s=s; n=Sg} ; + +lincat S = {s:Str} ; + +lin Exist f = {s = "exists" ++ f.$0 ++ "such that" ++ f.s}; +lin Even x = {s = x.s ++ case x.n of {Sg => "is"; Pl => "are"} ++ "even"}; + +lin a = {s = pre {"a"; "aa" / strs {"a"}}; n = Pl} ; +lin f a = {s = a.s}; +lin fa a = {s = a.s ++ "a"}; +lin fb a = {s = a.s ++ "b"}; + +lin IsString x = {s = x.s ++ "is string"} ; +lin IsInteger x = {s = x.s ++ "is integer"} ; +lin IsFloat x = {s = x.s ++ "is float"} ; + +}
@@ -0,0 +1,12 @@+i -src testsuite/runtime/linearize/TestCnc.gf++l -bracket Even ?+l -bracket Exist (\x -> <Even : E -> S> x)+l -bracket f a+l -bracket fa a+l -bracket fb a+l -bracket IsString "abcd"+l -bracket IsInteger 100+l -bracket IsFloat 12.4+l -bracket <IsString "xyz" : S>+l -bracket <\x -> x : S -> S>
@@ -0,0 +1,28 @@+(S:2 (E:1 (_:0 ?1)) is even) + + +(S:3 exists x such that (S:2 (E:1 (_:0 x)) is even)) + + +(S:1 (E:0 a)) + + +(S:1 (E:0 aa) a) + + +(S:1 (E:0 a) b) + + +(S:1 (String:0 abcd) is string) + + +(S:1 (Int:0 100) is integer) + + +(S:1 (Float:0 12.4) is float) + + +(S:1 (String:0 xyz) is string) + + +cannot linearize
@@ -0,0 +1,12 @@+i -src testsuite/runtime/linearize/TestCnc.gf++l Even ?+l Exist (\x -> <Even : E -> S> x)+l f a+l fa a+l fb a+l IsString "abcd"+l IsInteger 100+l IsFloat 12.4+l <IsString "xyz" : S>+l <\x -> x : S -> S>
@@ -0,0 +1,30 @@+?1 is even + + +exists x such that x is even + + +a + + +aa a + + +a b + + +abcd is string + + +100 is integer + + +12.4 is float + + +xyz is string + + + + +
@@ -0,0 +1,26 @@+abstract City = {++cat S ; City ; Country ; Adj ;++data+ PredIn : City -> Country -> S ;+fun+ PredAdj : City -> Adj -> S ;+ Capital : Country -> City ;+ CountryAdj : Adj -> Country ;+data+ Stockholm, Helsinki : City ;+ Sweden, Finland : Country ;+ Swedish, Finnish : Adj ;++def+ PredAdj city x = PredIn city (CountryAdj x) ;++ Capital Finland = Helsinki ;+ Capital Sweden = Stockholm ;++ CountryAdj Finnish = Finland ;+ CountryAdj Swedish = Sweden ;+++}
@@ -0,0 +1,16 @@+concrete CityEng of City = {++lincat S, City, Country, Adj = Str ;++lin+ PredIn ci co = ci ++ "is in" ++ co ;+ PredAdj ci ad = ci ++ "is" ++ ad ;+ Capital co = "the capital of" ++ co ;+ CountryAdj ad = "the" ++ ad ++ "country" ;+ Stockholm = "Stockholm" ;+ Helsinki = "Helsinki" ;+ Sweden = "Sweden" ;+ Finland = "Finland" ;+ Swedish = "Swedish" ;+ Finnish = "Finnish" ;+}
@@ -0,0 +1,34 @@+abstract Nat = {++cat Nat ;++data + Zero : Nat ;+ Succ : Nat -> Nat ;+ +fun one : Nat ;+def one = Succ Zero ;++fun plus : Nat -> Nat -> Nat ;+def plus x Zero = x ;+def plus x (Succ y) = Succ (plus x y) ;++fun twice : Nat -> Nat ;+def twice x = plus x x ;++fun times : Nat -> Nat -> Nat ;+def times x Zero = Zero ;+def times x (Succ y) = plus (times x y) x ;++fun four : Nat ;+def four = twice (twice one) ;++fun exp : Nat -> Nat ;+def exp Zero = one ;+def exp (Succ x) = twice (exp x) ;++fun plus' : Nat -> Nat -> Nat ;+def plus' Zero = \y -> y ;+def plus' (Succ x) = \y -> Succ (plus x y) ;++}
@@ -0,0 +1,17 @@+abstract lambda = { + +fun f1 : Int -> Int ; +def f1 = (\x -> x) ; + +fun f2 : Int ; +def f2 = f1 1 ; + +cat D ; +data D1 : D ; + D2 : D ; + +fun d : D -> Int -> Int ; +def d D1 = \x -> x ; + d D2 = \x -> 2 ; + +}
@@ -0,0 +1,9 @@+i -src testsuite/runtime/paraphrase/lambda.gf + +pt -compute f1 +pt -compute f2 + +pt -compute d D1 +pt -compute d D2 +pt -compute d D1 1 +pt -compute d D2 1
@@ -0,0 +1,12 @@+\v0 -> v0 + +1 + +\v0 -> v0 + +\v0 -> 2 + +1 + +2 +
@@ -0,0 +1,7 @@+Succ (Succ Zero) + +Succ (Succ (Succ Zero)) + +Succ (Succ Zero) + +unknown variable two
@@ -0,0 +1,8 @@+abstract DummyNat = {++cat Nat ;+fun zero : Nat ;+ succ : Nat -> Nat ;+ plus : Nat -> Nat -> Nat ;++}
@@ -0,0 +1,8 @@+concrete DummyNatCnc of DummyNat = {++lincat Nat = Str ;+lin zero = "z" ;+ succ n = n ;+ plus m n = m ++ n ;++}
@@ -0,0 +1,10 @@+abstract Literals = { + cat S ; + + fun IsString : String -> S ; + IsInteger : Int -> S ; + IsFloat : Float -> S ; + + IsEq : Int -> S ; + +}
@@ -0,0 +1,10 @@+concrete LiteralsCnc of Literals = { + +lincat S = Str ; + +lin IsString x = x.s ++ "is string" ; +lin IsInteger x = x.s ++ "is integer" ; +lin IsFloat x = x.s ++ "is float" ; +lin IsEq x = x.s ++ "=" ++ x.s ; + +}
@@ -0,0 +1,46 @@+import PGF +import Data.Maybe +import System.IO +import System.CPUTime +import System.Random +import Control.Monad +import Data.Set as Set (fromList,toList) + +start_cat = fromJust (readType "Phr") + +main = do + pgf <- readPGF "Lang.pgf" + g <- newStdGen + let trees0 = generateRandomDepth g pgf start_cat (Just 5) + let trees = Set.toList (Set.fromList (take 5000 trees0)) + hPutStrLn stderr ("Number of trees: "++show (length trees)) + mapM_ (\l -> doTestLang pgf l trees) (languages pgf) + +doTestLang pgf l ts = do + hPutStrLn stderr (show l) + ss <- foldM (doTest pgf l start_cat) [] ts + mapM_ (hPutStrLn stderr . show) [(fromIntegral s / fromIntegral n)/1000000000 | (s,n) <- ss] + putStrLn "Done." + +doTest pgf lang cat ss t = do + let s = linearize pgf lang t + putStr (s ++ " ... ") + hFlush stdout + let st = initState pgf lang cat + t1 <- getCPUTime + res <- doParse st t1 [] (words s) + case res of + Just (st,ts) -> putStrLn "Ok" >> return (accum ts ss) + Nothing -> putStrLn "Fail" >> return ss + + +doParse st t1 ts [] = return (Just (st,reverse ts)) +doParse st t1 ts (tk:tks) = do + case nextState st (simpleParseInput tk) of + Left _ -> return Nothing + Right st -> do t2 <- getCPUTime + doParse st t1 ((t2-t1):ts) tks + +accum [] ss = ss +accum (t:ts) [] = (t,1) : accum ts [] +accum (t:ts) ((s,n):ss) = (s+t,n+1) : accum ts ss
@@ -0,0 +1,3 @@+i -src testsuite/runtime/parser/DummyNatCnc.gf+p -cat=Nat -depth=3 "z"+p -cat=Nat -depth=2 "z z"
@@ -0,0 +1,18 @@+succ (succ (succ zero)) +succ (succ zero) +succ zero +zero + +plus (succ zero) (succ zero) +plus (succ zero) zero +plus zero (succ zero) +plus zero zero +succ (plus (succ zero) (succ zero)) +succ (plus (succ zero) zero) +succ (plus zero (succ zero)) +succ (plus zero zero) +succ (succ (plus (succ zero) (succ zero))) +succ (succ (plus (succ zero) zero)) +succ (succ (plus zero (succ zero))) +succ (succ (plus zero zero)) +
@@ -0,0 +1,21 @@+abstract Graph = { + +cat + Node ; + Link (n,m : Node) ; + Path (n,m : Node) ; + Label ({n} : Node) ; -- just to debug implicit arguments of categories + +fun + n1,n2,n3,n4,n5 : Node ; + + l12 : Link n1 n2 ; + l23 : Link n2 n3 ; + l34 : Link n3 n4 ; + l35 : Link n3 n5 ; + + link : ({n,m} : Node) -> Link n m -> Path n m ; + join : ({n,p,m} : Node) -> Link n p -> Path p m -> Path n m ; + + id : ({n} : Node) -> Link n n ; +}
@@ -0,0 +1,14 @@+abstract Hard = {++cat I ;+ F (I -> I) ;+ A (I -> I) I ;+ S ;++fun+ app : (f : I -> I) -> A f (f i) ;+ ex : F (\x -> x) ;+ i : I ;+ s : (f : I -> I) -> A f i -> F f -> S ;++}
@@ -0,0 +1,39 @@+abstract Test = { + +cat Nat ; +data zero : Nat ; + succ : Nat -> Nat ; + +fun plus : Nat -> Nat -> Nat ; +def plus zero n = n ; + plus (succ m) n = plus m (succ n) ; + +cat Vector Nat ; +fun vector : (n : Nat) -> Vector n ; + +fun append : (m,n : Nat) -> Vector m -> Vector n -> Vector (plus m n) ; +fun diff : (m,n : Nat) -> Vector (plus m n) -> Vector m -> Vector n ; + +cat Morph (Nat -> Nat) ; +fun mkMorph : (f : Nat -> Nat) -> Morph f ; +fun mkMorph2 : (f : Nat -> Nat) -> Vector (f zero) -> Morph f ; +fun idMorph : Morph (\x -> x) -> Nat ; + +fun f0 : (n : Nat) -> ((m : Nat) -> Vector n) -> Int ; +fun f1 : (n : Nat -> Nat) -> ((m : Nat) -> Vector (n m)) -> Int ; + +fun cmpVector : (n : Nat) -> Vector n -> Vector n -> Int ; + +fun g : ((n : Nat) -> Vector n) -> Int ; + +cat U (n,m : Nat) ; +fun u0 : (n : Nat) -> U n n ; +fun u1 : (n : Nat) -> U n (succ n) ; +fun h : (n : Nat) -> U n n -> Int ; + +-- fun u2 : (n : Nat) -> U (plus n zero) zero ; +-- fun h2 : (f : Nat -> Nat) -> ((n : Nat) -> U (f n) (f zero)) -> Int ; + +fun forall2 : (n : Nat) -> (Vector n -> Vector n -> Int) -> Int ; + +}
@@ -0,0 +1,3 @@+i -src testsuite/runtime/typecheck/Hard.gf+ai s ? (app ?) ex+ai s ? (app ?) ?
@@ -0,0 +1,6 @@+Expression: s (\v0 -> v0) (app (\v0 -> v0)) ex +Type: S +Probability: 1.0 + +Meta variable(s) ?2 should be resolved +in the expression: s ?2 (app ?2) ?4
@@ -0,0 +1,11 @@+i -src testsuite/runtime/typecheck/Graph.gf+ai join l12 (link l23)+ai join {n1} {n2} {n3} l12 (link {n2} {n3} l23)+ai <? : Label>+ai <? : Label {n1}>+ai <? : Link {n1} {n2}>+ai <\x -> x : ({m},n : Node) -> Node>+ai <n1 : ({m} : Node) -> Node>+ai <? : ({m} : Node) -> Node>+ai <link id : Path n1 n1>+pt -compute <\{n} -> n : ({n} : Node) -> Node> {n1}
@@ -0,0 +1,35 @@+Expression: join {n1} {n2} {n3} l12 (link {n2} {n3} l23) +Type: Path n1 n3 +Probability: 1.0000000000000002e-2 + +Expression: join {n1} {n2} {n3} l12 (link {n2} {n3} l23) +Type: Path n1 n3 +Probability: 1.0000000000000002e-2 + +Expression: <?2 : Label {?1}> +Type: Label {?1} +Probability: 1.0 + +Expression: <?2 : Label {n1}> +Type: Label {n1} +Probability: 1.0 + +{n1} is implicit argument but not implicit argument is expected here +Expression: <\{_1}, x -> x : ({m} : Node) -> (n : Node) -> Node> +Type: ({m} : Node) -> (n : Node) -> Node +Probability: 1.0 + +Expression: <\{_1} -> n1 : ({m} : Node) -> Node> +Type: ({m} : Node) -> Node +Probability: 1.0 + +Expression: <\{_1} -> ?1 : ({m} : Node) -> Node> +Type: ({m} : Node) -> Node +Probability: 1.0 + +Expression: <link {n1} {n1} (id {n1}) : Path n1 n1> +Type: Path n1 n1 +Probability: 1.0 + +n1 +
@@ -0,0 +1,31 @@+i -src testsuite/runtime/typecheck/Test.gf + +ai succ "0" +ai <succ : Int 0> +ai 1 2 +ai <\x -> x 2 : (Int->Int)->Int> 1 +ai unknown_fun +ai <0 : unknown_cat> +ai \x -> x +ai <\x -> x : Int> +ai append (succ (succ zero)) (succ zero) (vector (succ (succ zero))) (vector (succ zero)) +ai <\m,n -> vector (plus m n) : (m,n : Nat) -> Vector (plus m n)> +ai mkMorph (\x -> succ zero) +ai idMorph (mkMorph (\x -> x)) +ai idMorph (mkMorph (\x -> succ zero)) +ai <append zero (succ zero) : Vector zero -> Vector (succ zero) -> Vector (succ zero)> +ai <\n,v1,n,v2 -> append ? ? v1 v2 : (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m)> +ai <\n -> <\v1,v2 -> eqVector n v1 v2 : Vector ? -> Vector ? -> EQ> (vector ?) : (n : Nat) -> Vector n -> EQ> +ai <\v1,v2 -> cmpVector ? v1 v2 : Vector ? -> Vector ? -> Int> (vector ?) +ai f0 ? vector +ai f1 ? vector +ai f1 ? (\x -> vector (succ x)) +ai mkMorph (\x -> cmpVector ? (vector x) (vector (succ x))) +ai g (\n -> vector (succ n)) +ai h ? (u0 ?) +ai h ? (u1 ?) +ai cmpVector (succ (succ zero)) (vector (succ (succ zero))) (append ? (succ zero) (vector ?) (vector (succ zero))) +ai diff ? (succ (succ zero)) (vector (succ (succ (succ (succ (succ zero)))))) (vector (succ (succ (succ zero)))) +ai diff ? (succ (succ zero)) (vector (succ (succ (succ (succ zero))))) (vector (succ (succ (succ zero)))) +ai idMorph (mkMorph2 (\x -> ?) (vector zero)) +ai <(\n -> forall2 n (\x,y -> cmpVector zero x y)) : Nat -> Int>
@@ -0,0 +1,86 @@+Couldn't match expected type Nat + against inferred type String +In the expression: "0" +Category Int should have 0 argument(s), but has been given 1 +In the type: Int 0 +A function type is expected for the expression 1 instead of type Int +Couldn't match expected type Int -> Int + against inferred type Int +In the expression: 1 +unknown category of function identifier unknown_fun + +Category unknown_cat is not in scope +Cannot infer the type of expression \x -> x +A function type is expected for the expression \x -> x instead of type Int +Expression: append (succ (succ zero)) (succ zero) (vector (succ (succ zero))) (vector (succ zero)) +Type: Vector (succ (succ (succ zero))) +Probability: 3.532127097800926e-8 + +Expression: <\m, n -> vector (plus m n) : (m : Nat) -> (n : Nat) -> Vector (plus m n)> +Type: (m : Nat) -> (n : Nat) -> Vector (plus m n) +Probability: 1.0 + +Expression: mkMorph (\x -> succ zero) +Type: Morph (\v0 -> succ zero) +Probability: 0.5 + +Expression: idMorph (mkMorph (\x -> x)) +Type: Nat +Probability: 0.125 + +Couldn't match expected type Morph (\v0 -> v0) + against inferred type Morph (\v0 -> succ zero) +In the expression: mkMorph (\x -> succ zero) +Expression: <append zero (succ zero) : Vector zero -> Vector (succ zero) -> Vector (succ zero)> +Type: Vector zero -> Vector (succ zero) -> Vector (succ zero) +Probability: 1.0 + +Expression: <\n, v1, n1, v2 -> append n n1 v1 v2 : (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m)> +Type: (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m) +Probability: 1.0 + +Category EQ is not in scope +Expression: <\v1, v2 -> cmpVector ?7 v1 v2 : Vector ?7 -> Vector ?7 -> Int> (vector ?7) +Type: Vector ?7 -> Int +Probability: 0.3333333333333333 + +Couldn't match expected type (m : Nat) -> Vector ?1 + against inferred type (n : Nat) -> Vector n +In the expression: vector +Expression: f1 (\v -> v) vector +Type: Int +Probability: 5.555555555555555e-2 + +Expression: f1 (\v -> succ v) (\x -> vector (succ x)) +Type: Int +Probability: 0.16666666666666666 + +Couldn't match expected type Vector x + against inferred type Vector (succ x) +In the expression: vector (succ x) +Couldn't match expected type Vector n + against inferred type Vector (succ n) +In the expression: vector (succ n) +Expression: h ?2 (u0 ?2) +Type: Int +Probability: 8.333333333333333e-2 + +Couldn't match expected type U ?2 ?2 + against inferred type U ?2 (succ ?2) +In the expression: u1 ?2 +Meta variable(s) ?11 should be resolved +in the expression: cmpVector (succ (succ zero)) (vector (succ (succ zero))) (append ?11 (succ zero) (vector ?11) (vector (succ zero))) +Expression: diff (succ (succ (succ zero))) (succ (succ zero)) (vector (succ (succ (succ (succ (succ zero)))))) (vector (succ (succ (succ zero)))) +Type: Vector (succ (succ zero)) +Probability: 2.1558392930913853e-12 + +Couldn't match expected type Vector (plus (succ (succ (succ zero))) (succ (succ zero))) + against inferred type Vector (succ (succ (succ (succ zero)))) +In the expression: vector (succ (succ (succ (succ zero)))) +Expression: idMorph (mkMorph2 (\x -> x) (vector zero)) +Type: Nat +Probability: 1.0416666666666666e-2 + +Couldn't match expected type Vector zero + against inferred type Vector n +In the expression: x
@@ -0,0 +1,37 @@+module Dependencies where++import PGF+import qualified Data.Map as Map+import Data.Maybe as Maybe++type HeadTable = Map.Map CId [CId]++readHeadTable :: FilePath -> IO HeadTable+readHeadTable fpath = do+ ls <- fmap lines $ readFile fpath+ return (Map.fromList [(head ws, tail ws) | l <- ls, let ws = map mkCId (words l), not (null ws)])++getDependencies :: HeadTable -> Expr -> (CId,[(CId,CId)])+getDependencies tbl e = + case unApp e of+ Just (f,es)+ | null es -> (f,[])+ | f == mkCId "MkSymb" -> (f,[])+ | otherwise -> case Map.lookup f tbl of+ Just cs -> let xs = zipWith (\c e -> (c,getDependencies tbl e)) cs es+ hes = [he | (c,he) <- xs, c == c_head]+ (h,deps) = head hes+ in if length hes /= 1+ then error ("there must be exactly one head in "++showExpr [] e)+ else (h,concat (deps:[(h,m):deps | (c,(m,deps)) <- xs, c == c_mod]))+ Nothing -> error ("there is no head defined for function "++showCId f)+ Nothing -> error ("this is not a function application: "++showExpr [] e)++c_head = mkCId "head"+c_mod = mkCId "mod"++test = do+ t <- readHeadTable "ParseEngAbs.heads" + es <- fmap (concatMap (maybeToList . readExpr) . lines) $ readFile "wsj.full"+ let deps = Map.fromListWith (+) [(d,1) | e <- es, d <- snd (getDependencies t e)]+ writeFile "deps" (unlines (map show (Map.toList deps)))
@@ -0,0 +1,115 @@+module Idents where++import PGF++cidASimul = mkCId "ASimul"+cidAAnter = mkCId "AAnter"+cidPositAdvAdj = mkCId "PositAdvAdj"+cidPositAdVAdj = mkCId "PositAdVAdj"+cidUseCl = mkCId "UseCl"+cidPredVP = mkCId "PredVP"+cidSlashVP = mkCId "SlashVP"+cidComplPredVP = mkCId "ComplPredVP"+cidAdjCN = mkCId "AdjCN"+cidUseN = mkCId "UseN"+cidDetQuant = mkCId "DetQuant"+cidDetQuantOrd = mkCId "DetQuantOrd"+cidNumSg = mkCId "NumSg"+cidNumPl = mkCId "NumPl"+cidDetCN = mkCId "DetCN"+cidIndefArt = mkCId "IndefArt"+cidUsePN = mkCId "UsePN"+cidUseQuantPN = mkCId "UseQuantPN"+cidSymbPN = mkCId "SymbPN"+cidMkSymb = mkCId "MkSymb"+cidUsePron = mkCId "UsePron"+cidConjNP = mkCId "ConjNP"+cidBaseNP = mkCId "BaseNP"+cidConsNP = mkCId "ConsNP"+cidConjCN = mkCId "ConjCN"+cidBaseCN = mkCId "BaseCN"+cidConsCN = mkCId "ConsCN"+cidConjAdv = mkCId "ConjAdv"+cidBaseAdv = mkCId "BaseAdv"+cidConsAdv = mkCId "ConsAdv"+cidBaseS = mkCId "BaseS"+cidConsS = mkCId "ConsS"+cidConjS = mkCId "ConjS"+cidMassNP = mkCId "MassNP"+cidAdvNP = mkCId "AdvNP"+cidTPres = mkCId "TPres"+cidTPast = mkCId "TPast"+cidTFut = mkCId "TFut"+cidTCond = mkCId "TCond"+cidTTAnt = mkCId "TTAnt"+cidPPos = mkCId "PPos"+cidPNeg = mkCId "PNeg"+cidComplSlash = mkCId "ComplSlash"+cidSlashV2a = mkCId "SlashV2a"+cidComplVS = mkCId "ComplVS"+cidComplVV = mkCId "ComplVV"+cidUseV = mkCId "UseV"+cidAdVVP = mkCId "AdVVP"+cidAdvVP = mkCId "AdvVP"+cidAdvVPSlash = mkCId "AdvVPSlash"+cidPrepNP = mkCId "PrepNP"+cidto_Prep = mkCId "to_Prep"+cidsuch_as_Prep= mkCId "such_as_Prep"+cidPastPartAP = mkCId "PastPartAP"+cidPassVPSlash = mkCId "PassVPSlash"+cidAdvS = mkCId "AdvS"+cidPositA = mkCId "PositA"+cidIDig = mkCId "IDig"+cidIIDig = mkCId "IIDig"+cidNumCard = mkCId "NumCard" +cidNumDigits = mkCId "NumDigits"+cidNumNumeral = mkCId "NumNumeral"+cidnum = mkCId "num"+cidpot2as3 = mkCId "pot2as3"+cidpot1as2 = mkCId "pot1as2"+cidpot0as1 = mkCId "pot0as1"+cidpot01 = mkCId "pot01"+cidpot0 = mkCId "pot0"+cidn2 = mkCId "n2"+cidn3 = mkCId "n3"+cidn4 = mkCId "n4"+cidn5 = mkCId "n5"+cidn6 = mkCId "n6"+cidn7 = mkCId "n7"+cidn8 = mkCId "n8"+cidn9 = mkCId "n9"+cidPossPron = mkCId "PossPron"+cidCompAP = mkCId "CompAP"+cidCompNP = mkCId "CompNP"+cidCompAdv = mkCId "CompAdv"+cidCompS = mkCId "CompS"+cidCompVP = mkCId "CompVP"+cidUseComp = mkCId "UseComp"+cidCompoundCN = mkCId "CompoundCN"+cidDashCN = mkCId "DashCN"+cidProgrVP = mkCId "ProgrVP"+cidGerundN = mkCId "GerundN"+cidGerundAP = mkCId "GerundAP"+cidGenNP = mkCId "GenNP"+cidPredetNP = mkCId "PredetNP"+cidDetNP = mkCId "DetNP"+cidAdAP = mkCId "AdAP"+cidAdvAP = mkCId "AdvAP"+cidPositAdAAdj = mkCId "PositAdAAdj"+cideither7or_DConj = mkCId "either7or_DConj"+cidboth7and_DConj = mkCId "both7and_DConj"+cidor_Conj = mkCId "or_Conj"+cidand_Conj = mkCId "and_Conj"+cidamp_Conj = mkCId "amp_Conj"+cidSlashV2V = mkCId "SlashV2V"+cidComplVA = mkCId "ComplVA"+cidAdNum = mkCId "AdNum"+cidi_Pron = mkCId "i_Pron"+cidOrdSuperl = mkCId "OrdSuperl"+cidno_RP = mkCId "no_RP"+cidthat_RP = mkCId "that_RP"+cidUseRCl = mkCId "UseRCl"+cidRelSlash = mkCId "RelSlash"+cidRelNP = mkCId "RelNP"+cidRelVP = mkCId "RelVP"+cidmany_Det = mkCId "many_Det"
@@ -0,0 +1,98 @@+module Monad ( Rule(..), Grammar, grammar+ , P, parse+ , cat, word, lemma, inside, transform+ , many, many1, opt+ ) where++import Data.Tree+import Data.Char+import qualified Data.Map as Map+import Control.Monad+import PGF hiding (Tree,parse)++infix 1 :->+++data Rule t e = t :-> P t e e+type Grammar t e = t -> PGF -> Morpho -> [Tree t] -> e++grammar :: (Ord t,Show t) => ([e] -> e) -> [Rule t e] -> Grammar t e+grammar def rules = gr+ where+ gr = \tag ->+ case Map.lookup tag pmap of+ Just f -> \pgf m ts -> case unP f gr pgf m ts of+ Just (e,[]) -> e+ _ -> case ts of+ [Node w []] -> def []+ ts -> def [gr tag pgf m ts | Node tag ts <- ts]+ Nothing -> \pgf m ts -> case ts of+ [Node w []] -> def []+ ts -> def [gr tag pgf m ts | Node tag ts <- ts]++ pmap = Map.fromListWith mplus (map (\(t :-> r) -> (t,r)) rules)+++newtype P t e a = P {unP :: Grammar t e -> PGF -> Morpho -> [Tree t] -> Maybe (a,[Tree t])}++instance Monad (P t e) where+ return x = P (\gr pgf m ts -> Just (x,ts))+ f >>= g = P (\gr pgf m ts -> case unP f gr pgf m ts of+ Just (x,ts) -> unP (g x) gr pgf m ts+ Nothing -> Nothing)++instance MonadPlus (P t e) where+ mzero = P (\gr pgf m ts -> Nothing)+ mplus f g = P (\gr pgf m ts -> unP f gr pgf m ts `mplus` unP g gr pgf m ts)+++parse :: Grammar t e -> PGF -> Morpho -> Tree t -> e+parse gr pgf morpho (Node tag ts) = gr tag pgf morpho ts++cat :: Eq t => t -> P t e e+cat tag = P (\gr pgf morpho ts -> + case ts of+ (Node tag1 ts1 : ts) | tag == tag1 -> Just (gr tag1 pgf morpho ts1,ts)+ _ -> Nothing)++word :: P t e t+word = P (\gr pgf morpho ts -> + case ts of+ (Node w [] : ts) -> Just (w,ts)+ _ -> Nothing)++inside :: Eq t => t -> P t e a -> P t e a+inside tag f = P (\gr pgf morpho ts ->+ case ts of+ (Node tag1 ts1 : ts) | tag == tag1 -> case unP f gr pgf morpho ts1 of+ Just (x,[]) -> Just (x,ts)+ _ -> Nothing+ _ -> Nothing)++lemma :: String -> String -> P String e CId+lemma cat0 an0 = P (\gr pgf morpho ts -> + case ts of+ (Node w [] : ts) -> case [lemma | (lemma, an1) <- lookupMorpho morpho (map toLower w)+ , let cat1 = maybe "" (showType []) (functionType pgf lemma)+ , cat0 == cat1 && an0 == an1] of+ (id:_) -> Just (id,ts)+ _ -> Nothing+ _ -> Nothing)++transform :: ([Tree t] -> [Tree t]) -> P t e ()+transform f = P (\gr pgf morpho ts -> Just ((),f ts))++many :: P t e a -> P t e [a]+many f = do x <- f+ xs <- many f+ return (x:xs)+ `mplus`+ do return []++many1 :: P t e a -> P t e [a]+many1 f = do x <- f+ xs <- many f+ return (x:xs)++opt :: P t e a -> a -> P t e a+opt f x = mplus f (return x)
@@ -0,0 +1,223 @@+PositA head+ComparA head mod+ComplA2 head mod+ReflA2 head+UseA2 head+UseComparA head+CAdvAP mod head mod+AdjOrd head+SentAP head mod+AdAP mod head+AdvAP head mod+PositAdvAdj head+PrepNP head mod+AdAdv mod head+PositAdAAdj head+SubjS mod head+AdnCAdv head+ComplV2 head mod+ComplV3 head mod mod+ComplV2V head mod mod+ComplV2S head mod mod+ComplV2Q head mod mod+ComplV2A head mod mod+SlashV2 mod head+SlashVVV2 mod head mod+NumInt head+OrdInt head+AdvSC head+NumInt head+OrdInt head+ConjS head mod+ConjRS head mod+ConjAP head mod+ConjNP mod head+ConjAdv head mod+ConjIAdv head mod+ConjCN head mod+GenNP head+GenIP head+GenRP mod head+EmptyRelSlash head+MkVPI head+ConjVPI head mod+ComplVPIVV head mod+MkVPS _ _ head+ConjVPS head mod+PredVPS mod head+PartVP head+PassVPSlash head+ExistNP head+ExistIP head+ProgrVP head+ImpPl1 head+ImpP3 mod head+DetCN _ head+UsePN head+UsePron head+PredetNP mod head+PPartNP head mod+AdvNP head mod+RelNP head mod+DetNP head+DetQuant head _ _+DetQuantOrd head _ _+NumCard head+NumDigits head+NumNumeral head+AdNum mod head+OrdDigits head+OrdNumeral head+OrdSuperl head+MassNP head+PossPron head+UseN head+ComplN2 head mod+ComplN3 head mod+UseN2 head+Use2N3 head+Use3N3 head+AdjCN mod head+RelCN head mod+AdvCN head mod+SentCN head mod+ApposCN head mod+num _+pot0 _+pot1to19 _+pot0as1 _+pot1 _+pot1plus _ _+pot1as2 _+pot2 _+pot2plus _ _+pot2as3 _+pot3 _+pot3plus _ _+IDig _+IIDig _ _+num2digits head+PhrUtt mod head mod+UttS head+UttQS head+UttImpSg _ head+UttImpPl _ head+UttImpPol _ head+UttIP head+UttIAdv head+UttNP head+UttAdv head+UttVP head+UttCN head+UttCard head+UttAP head+UttInterj head+PConjConj head+VocNP head+QuestCl head+QuestVP mod head+QuestSlash mod head+QuestIAdv mod head+QuestIComp mod head+IdetCN mod head +IdetIP head+AdvIP head mod+IdetQuant head mod+PrepIP _ head+AdvIAdv head mod+CompIAdv head+CompIP head+ComplSlashIP head mod+AdvQVP head mod+AddAdvQVP head mod+QuestQVP mod head+RelCl head+RelVP mod head+RelSlash mod head+FunRP mod mod head+PredVP mod head+PredSCVP mod head+SlashVP mod head+AdvSlash head mod+SlashPrep head mod+SlashVS mod head mod+ImpVP head+EmbedS head+EmbedQS head+EmbedVP head+UseCl _ _ head+UseQCl _ _ head+UseRCl _ _ head+UseSlash _ _ head+AdvS mod head+ExtAdvS mod head+SSubjS mod mod head+RelS head mod+SymbPN head+CNNumNP head _+MkSymb _+TTAnt head mod+UseV head+ComplVV head mod+ComplVS head mod+ComplVQ head mod+ComplVA head mod+SlashV2a head+Slash2V3 head mod+Slash3V3 head mod+SlashV2V head _ _ mod+SlashV2S head mod+SlashV2Q head mod+SlashV2A head mod+ComplSlash head mod+SlashVV head mod+SlashV2VNP head mod mod+ReflVP head+UseComp head+AdvVP head mod+AdVVP mod head+AdvVPSlash head mod+AdVVPSlash mod head+VPSlashPrep head mod+CompAP head+CompNP head+CompAdv head+CompCN head+CompoundCN _ mod head+DashCN mod head+GerundN head+GerundAP head+PastPartAP head+OrdCompar head+PositAdVAdj head+UseQuantPN _ head+SlashVPIV2V head _ mod+SlashSlashV2V head _ _ mod+ComplVV head _ _ mod+PredVPosv mod head+PredVPovs mod head+CompS head+CompQS head+CompVP mod mod head+VPSlashVS mod head+PastPartRS _ _ head+PresPartRS _ _ head+ApposNP head mod+AdAdV mod head+UttAdV head+BaseNP head mod+ConsNP head mod+BaseVPS head mod+ConsVPS head mod+BaseVPI head mod+ConsVPI head mod+BaseAP head mod+ConsAP head mod+BaseS head mod+ConsS head mod+BaseCN head mod+ConsCN head mod+BaseAdv head mod+ConsAdv head mod+BaseRS head mod+ConsRS head mod
file too large to diff
@@ -0,0 +1,38 @@+module PennFormat(parseTreebank, showTree) where++import Text.PrettyPrint+import Data.Tree+import Data.Char++parseTreebank :: String -> [Tree String]+parseTreebank [] = []+parseTreebank (c:cs)+ | isSpace c = parseTreebank cs+ | c == '(' = let (ts,cs1) = parseTrees cs+ in ts ++ parseTreebank cs1++parseTrees [] = ([],[])+parseTrees (c:cs)+ | isSpace c = parseTrees cs+ | c == ')' = ([],cs)+ | c == '(' = let (w, cs1) = parseWord cs+ (children,cs2) = parseTrees cs1+ (rest, cs3) = parseTrees cs2+ in (Node (normalize w) children : rest,cs3)+ | otherwise = let (w, cs1) = parseWord (c:cs)+ (rest, cs2) = parseTrees cs1+ in (Node w [] : rest,cs2)++normalize tag =+ let (tag0,mod) = break (=='-') tag+ in if null tag0+ then tag+ else tag0++parseWord = break (\c -> isSpace c || c == '(' || c == ')')++printTree (Node w []) = text w+printTree (Node l children) = parens (text l <+> hsep (map printTree children))++showTree :: Tree String -> String+showTree = render . printTree
@@ -0,0 +1,45 @@+import PGF+import Data.Maybe++main = do+ ls <- fmap (filterExprs . lines) $ readFile "log4.txt"+ let (c,m1,m2) = foldl counts (0,0,0) (map (\l -> fromMaybe (error l) (readExpr (f l))) ls)+ print (length ls)+ print ((c / (c+m1+m2))*100)+ print (((c+m2) / (c+m1+m2))*100)+ meta_dist [length [l | l <- ls, length [c | c <- l, c == '?'] == n] | n <- [0..27]]+ meta_dist [length [l | l <- ls, length [x | x <- (zip l (tail l)), x == ('(','?')] == n] | n <- [0..27]]+ cs <- fmap (map (length . words) . lines) $ readFile "wsj.eng"+ print (average [fromIntegral c / fromIntegral (max n 1) | (c,l) <- zip cs ls, let n = length [c | c <- l, c == '?']])+ print (average [fromIntegral c / fromIntegral (max n 1) | (c,l) <- zip cs ls, let n = length [x | x <- (zip l (tail l)), x == ('(','?')]])++average xs = sum xs / fromIntegral (length xs)++filterExprs [] = []+filterExprs (l:ls)+ | null l = filterExprs ls+ | elem (head l) "+#*" = drop 2 l : filterExprs ls+ | otherwise = filterExprs ls++f [] = []+f ('[':cs) = let (xs,']':ys) = break (==']') cs+ in f ('?' : ys)+f ('?':cs) = 'Q' : f cs+f (c:cs) = c : f cs++counts (c,m1,m2) e = c `seq` m1 `seq` m2 `seq`+ case unApp e of+ Just (f,es) | f == mkCId "Q" -> if null es+ then foldl counts (c,m1,m2+1) es+ else foldl counts (c,m1+1,m2) es+ | otherwise -> foldl counts (c+1,m1,m2) es+ Nothing -> case unStr e of+ Just _ -> (c+1,m1,m2)+ Nothing -> error ("counts ("++show e++")")++meta_dist cs = do+ print cs+ let cnt = fromIntegral (sum cs)+ avg = fromIntegral (sum [n*c | (n,c) <- zip [0..] cs]) / cnt+ dev = sqrt (sum [((fromIntegral n-avg) ^ 2)*fromIntegral c | (n,c) <- zip [0..] cs] / cnt)+ print (avg,dev)
@@ -0,0 +1,100 @@+import PGF+import qualified Data.Map as Map+import Data.Maybe+import Data.List++grammar_name = "ParseEngAbs.pgf"++treebank_name = "log4.txt"++chunk_cats = map mkCId+ ["A", "AP", "AdA", "AdV", "Adv", "CN", "Cl", "ClSlash", "Conj", "Det", + "IAdv", "IP", "N", "NP", "Num", "Ord", "Predet", "Prep", "Pron", "QS",+ "Quant", "RP", "RS", "S", "Subj", "V", "V2", "VPS", "VS"]++main = do+ pgf <- readPGF grammar_name+ ls <- fmap (filterExprs . zip [1..] . lines) $ readFile treebank_name+ putStrLn ""+ putStrLn ("trees: "++show (length ls))+ let (_,cat,_) = unType (startCat pgf)+ stats = foldl' (collectStats pgf)+ (initStats pgf)+ [(n,fromMaybe (error l) (readExpr (toQ l)),Just cat) | (n,l) <- ls]++ putStrLn ("coverage: "++show (coverage stats))++ putStrLn ("Writing ParseEngAbs.probs...")+ writeFile "ParseEngAbs.probs" (unlines [show f ++ "\t" ++ show p | (f,p) <- probs pgf stats])+ where+ toQ [] = []+ toQ ('?':cs) = 'Q' : toQ cs+ toQ (c:cs) = c : toQ cs++filterExprs [] = []+filterExprs ((n,l):ls)+ | null l = filterExprs ls+ | elem (head l) "+#*" = (n,drop 2 l) : filterExprs ls+ | otherwise = filterExprs ls++initStats pgf =+ (Map.fromListWith (+)+ ([(f,1) | f <- functions pgf] +++ [(cat pgf f,1) | f <- functions pgf])+ ,0+ )++collectStats pgf (ustats,count) (n,e,mb_cat1) =+ case unApp e of+ Just (f,args) -> let fcat2 = cat2 pgf f n e+ fcat = fromMaybe fcat2 mb_cat1+ cf = fromMaybe 0 (Map.lookup f ustats)+ cc = fromMaybe 0 (Map.lookup fcat ustats)+ in if isJust mb_cat1 && f /= mkCId "Q" && fcat /= fcat2+ then error (show n ++ ": " ++ showExpr [] e)+ else+ cf `seq` cc `seq` count `seq`+ foldl' (collectStats pgf)+ (Map.insert f (cf+1) (Map.insert fcat (cc+1) ustats)+ ,count+1+ )+ (zipWith (\e mb_cat1 -> (n,e,mb_cat1)) args (argCats f))+ Nothing -> case unStr e of+ Just _ -> (ustats,count+1)+ Nothing -> error ("collectStats ("++showExpr [] e++")")+ where+ argCats f =+ case fmap unType (functionType pgf f) of+ Just (arg_tys,_,_) -> let tyCat (_,_,ty) = let (_,cat,_) = unType ty in Just cat+ in map tyCat arg_tys+ Nothing -> repeat Nothing++coverage (stats,gcount) =+ let c = fromMaybe 0 (Map.lookup (mkCId "Q") stats)+ in (fromIntegral (gcount - c) / fromIntegral gcount) * 100++probs pgf (stats,gcount) =+ [toFProb f (cat pgf f) | f <- functions pgf] +++ [toCProb c | c <- chunk_cats]+ where+ toFProb f cat =+ let count = fromMaybe 0 (Map.lookup f stats)+ cat_mass = fromMaybe 0 (Map.lookup cat stats)+ in (f, fromIntegral count / fromIntegral cat_mass :: Double)++ toCProb c =+ let ccount = fromMaybe 0 (Map.lookup c stats)+ in (c, fromIntegral ccount / fromIntegral chunk_mass :: Double)++ chunk_mass =+ sum [fromMaybe 0 (Map.lookup c stats) | c <- chunk_cats]++cat pgf f =+ case fmap unType (functionType pgf f) of+ Just (_,cat,_) -> cat+ Nothing -> error ("Unknown function "++showCId f)++cat2 pgf f n e =+ case fmap unType (functionType pgf f) of+ Just (_,cat,_) -> cat+ Nothing -> error (show n ++ ": Unknown function "++showCId f++" in "++showExpr [] e)
@@ -0,0 +1,809 @@+-- [1416,4467,4623,4871,4561,4303,3763,3137,2501,1857,1353,952,646,483,332,200,116,89,54,41,20,22,7,2,4,5,0,3,2,1,0,0,0,0,0,1]+-- average 5++import Monad+import Idents+import PennFormat++import PGF hiding (Tree,parse)+import Control.Monad+import System.IO+import System.Process+import Data.Maybe+import Data.List+import Data.IORef+import Data.Char+import Data.Tree++test = False++main = do+ pgf <- readPGF "ParseEngAbs.pgf"+ let Just language = readLanguage "ParseEng"+ morpho = buildMorpho pgf language+ s <- readFile "wsj.02-21"+ ref <- newIORef (0,0,0)+ mapM_ (process pgf morpho ref) ((if test then take 40 else id) (parseTreebank s))+ where+ process pgf morpho ref t = do+ (cn,co,l) <- readIORef ref+ let e = (flatten . parse penn pgf morpho . prune) t+ (cn',co') = count (cn,co) e+ l' = l+1+ writeIORef ref (cn',co',l')+ hPutStrLn stdout (showExpr [] e)+ when test $ do+ writeFile ("tmp_tree.dot") (graphvizAbstractTree pgf (True,False) e)+ rawSystem "dot" ["-Tpdf", "tmp_tree.dot", "-otrees/tree"++showAlign l'++".pdf"]+ return ()+ hPutStrLn stderr (show ((fromIntegral cn' / fromIntegral co') * 100))++ count (cn,co) e = cn `seq` co `seq`+ case unApp e of+ Just (f,es) -> if f == meta+ then foldl' count (cn, co+1) es+ else foldl' count (cn+1,co+1) es+ Nothing -> (cn+1,co+1)+++ showAlign n =+ replicate (5 - length s) '0' ++ s+ where+ s = show n++ prune (Node tag ts)+ | tag == "S" + && not (null ts)+ && last ts == Node "." [Node "." []] = Node tag (init ts)+ | otherwise = Node tag ts+ + flatten e =+ case unApp e of+ Just (f,es) | f == meta -> mkApp f (concatMap grab es)+ | otherwise -> mkApp f (map flatten es)+ Nothing -> e++ grab e =+ case unApp e of+ Just (f,es) | f == meta -> concatMap grab es+ | otherwise -> [mkApp f (map flatten es)]+ Nothing -> []+++penn :: Grammar String Expr+penn =+ grammar (mkApp meta) + [ "ADVP":-> do adv <- cat "RB"+ case unApp adv of+ Just (f,[a]) | f == cidPositAdvAdj -> return (mkApp cidPositAdVAdj [a])+ _ -> mzero+ `mplus`+ do adV <- inside "RB" (lemma "AdV" "s")+ return (mkApp adV [])+ , "ADJP":-> do adas <- many pAdA+ v <- inside "JJ" (lemma "V2" "s VPPart")+ pps <- many (cat "PP")+ let adj = mkApp cidPastPartAP [mkApp v []]+ ap0 = foldr (\ada ap -> mkApp cidAdAP [ada,ap]) adj adas+ ap = foldr (\pp ap -> mkApp cidAdvAP [ap,pp]) ap0 pps+ return ap+ `mplus`+ do adas0 <- many pAdA+ adjs <- many1 (cat "JJ")+ let adj = last adjs+ adas = adas0 ++ [mkApp cidPositAdAAdj [adj] | adj <- init adjs]+ ap = foldr (\ada ap -> mkApp cidAdAP [ada,ap]) (mkApp cidPositA [adj]) adas+ return ap+ , "S" :-> do advs <- many $ do pp <- cat "PP"+ inside "," word+ return pp+ `mplus`+ do cat "ADVP" + e0 <- do (tmp,pol,sl,e) <- pClSlash+ guard (not sl)+ return (mkApp cidUseCl [tmp,pol,e])+ `mplus`+ do s <- cat "S"+ inside "," word+ np <- cat "NP"+ inside "VP" $ do+ (t,v) <- pV "VS"+ inside "SBAR" $ do+ cat "-NONE-"+ inside "S" $ do+ cat "-NONE-"+ return (mkApp cidUseCl [mkApp cidTTAnt [ mkApp (fromMaybe meta (isVTense t)) []+ , mkApp cidASimul []+ ]+ ,mkApp cidPPos []+ ,mkApp cidComplPredVP [np,mkApp cidComplVS [mkApp v [],s]]+ ])+ opt (inside "." word) ""+ return (foldr (\ad e -> mkApp cidAdvS [ad, e]) e0 advs)+ `mplus`+ do s1 <- cat "S"+ opt (inside "," word) ""+ cc <- cat "CC"+ s2 <- cat "S"+ return (mkApp cidConjS [cc, mkApp cidBaseS [s1,s2]])+ , "SBAR" :-> do (do cat "-NONE-" -- missing preposition+ return ()+ `mplus`+ do w <- inside "IN" word+ guard (w == "that"))+ cat "S"+ , "NP" :-> do (m_cc,list_np) <- pBaseNPs+ case m_cc of+ Just cc -> return (mkApp cidConjNP [cc, mkListNP list_np])+ Nothing -> if length list_np > 1+ then return (mkApp meta list_np)+ else return (head list_np)+ `mplus`+ do np <- cat "NP"+ rs <- inside "SBAR" $+ do rp <- cat "WHNP"+ inside "S" $+ do (tmp,pol,sl,e) <- pClSlash+ guard sl+ return (mkApp cidUseRCl [tmp,pol,mkApp cidRelSlash [rp,e]])+ `mplus`+ do inside "NP" (cat "-NONE-")+ (tmp,pol,sl,vp) <- inside "VP" pVP+ guard (not sl)+ return (mkApp cidUseRCl [fromMaybe (mkApp meta []) (isVTense tmp)+ ,mkApp pol []+ ,mkApp cidRelVP [rp,vp]])+ return (mkApp cidRelNP [np,rs])+ `mplus`+ do (m_cc,list_np) <- pNPs+ case m_cc of+ Just cc -> return (mkApp cidConjNP [cc, mkListNP list_np])+ Nothing -> if length list_np > 1+ then return (mkApp meta list_np)+ else return (head list_np)+ , "VP" :-> do (_,_,_,e) <- pVP+ return e+ , "PP" :-> do prep <- do cat "IN"+ `mplus`+ do inside "TO" word+ return (mkApp cidto_Prep [])+ `mplus`+ do w1 <- inside "JJ" word+ w2 <- inside "IN" word+ guard (w1 == "such" && w2 == "as")+ return (mkApp cidsuch_as_Prep [])+ np <- cat "NP"+ return (mkApp cidPrepNP [prep,np])+ `mplus`+ do pp1 <- cat "PP"+ inside "," word+ conj <- cat "CC"+ pp2 <- cat "PP"+ opt (inside "," word) ""+ return (mkApp cidConjAdv [conj, mkApp cidBaseAdv [pp1,pp2]])+ , "CC" :-> do cc <- word+ case cc of+ "and" -> return (mkApp cidand_Conj [])+ "&" -> return (mkApp cidamp_Conj [])+ "or" -> return (mkApp cidor_Conj [])+ _ -> mzero+ , "DT" :-> do (dt,b) <- pDT+ return dt+ , "IN" :-> do prep <- lemma "Prep" "s"+ return (mkApp prep [])+ , "NN" :-> do transform (concatMap splitDashN)+ (do n <- lemma "N" "s Sg Nom"+ (do inside "-" word+ n2 <- lemma "N" "s Sg Nom"+ return (mkApp cidDashCN [mkApp n [], mkApp n2 []])+ `mplus`+ do return (mkApp n [])))+ `mplus`+ do v <- lemma "V" "s VPresPart"+ return (mkApp cidGerundN [mkApp v []])+ , "NNS" :-> do transform (concatMap splitDashN)+ (do n <- lemma "N" "s Pl Nom"+ return (mkApp n [])+ `mplus`+ do n1 <- lemma "N" "s Sg Nom"+ inside "-" word+ n2 <- lemma "N" "s Pl Nom"+ return (mkApp cidDashCN [mkApp n1 [], mkApp n2 []]))+ , "PRP" :-> do p <- (lemma "Pron" "s (NCase Nom)"+ `mplus`+ lemma "Pron" "s NPAcc"+ `mplus`+ (do w <- word+ guard (w == "I") -- upper case word+ return cidi_Pron))+ return (mkApp p [])+ , "PRP$":-> do p <- lemma "Pron" "s (NCase Gen)"+ return (mkApp cidPossPron [mkApp p []])+ , "RB" :-> do a <- lemma "A" "s AAdv"+ return (mkApp cidPositAdvAdj [mkApp a []])+ `mplus`+ do adv <- lemma "Adv" "s"+ return (mkApp adv [])+ , "QP" :-> do adn <- inside "IN" (lemma "AdN" "s")+ num <- pCD+ return (mkApp cidDetQuant [mkApp cidIndefArt [], mkApp cidNumCard [mkApp cidAdNum [mkApp adn [], num]]])+ , "WHNP":-> cat "WP"+ `mplus`+ cat "WDT"+ `mplus`+ cat "WP$"+ `mplus`+ do cat "-NONE-"+ return (mkApp cidno_RP [])+ `mplus`+ do w <- inside "IN" word+ guard (w == "that")+ return (mkApp cidthat_RP [])+ , "-NONE-"+ :-> return (mkApp meta [])+ , "JJ" :-> do a <- lemma "A" "s (AAdj Posit Nom)"+ return (mkApp a [])+ , "JJR" :-> do a <- lemma "A" "s (AAdj Compar Nom)"+ return (mkApp a [])+ , "JJS" :-> do a <- lemma "A" "s (AAdj Superl Nom)"+ return (mkApp cidOrdSuperl [mkApp a []])+ , "VB" :-> do v <- mplus (lemma "V" "s VInf") (lemma "V2" "s VInf")+ return (mkApp v [])+ , "VBD" :-> do v <- mplus (lemma "V" "s VPast") (lemma "V2" "s VPast")+ return (mkApp v [])+ , "VBG" :-> do v <- mplus (lemma "V" "s VPresPart") (lemma "V2" "s VPresPart")+ return (mkApp v [])+ , "VBN" :-> do v <- mplus (lemma "V" "s VPPart") (lemma "V2" "s VPPart")+ return (mkApp v [])+ , "VBP" :-> do v <- mplus (lemma "V" "s VInf") (lemma "V2" "s VInf")+ return (mkApp v [])+ , "VBZ" :-> do v <- mplus (lemma "V" "s VPres") (lemma "V2" "s VPres")+ return (mkApp v [])+ , "PDT" :-> do pdt <- lemma "Predet" "s"+ return (mkApp pdt [])+ , "WP" :-> do rp <- (lemma "RP" "s (RC Masc (NCase Nom))"+ `mplus`+ lemma "RP" "s (RC Masc NPAcc)")+ return (mkApp rp [])+ , "WDT" :-> do rp <- lemma "RP" "s (RC Neutr (NCase Nom))"+ return (mkApp rp [])+ , "WP$" :-> do rp <- lemma "RP" "s (RC Masc (NCase Gen))"+ return (mkApp rp [])+ ]++data VForm a+ = VInf | VPart | VGerund | VTense a++instance Functor VForm where+ fmap f VInf = VInf+ fmap f VPart = VPart+ fmap f VGerund = VGerund+ fmap f (VTense t) = VTense (f t)++isVInf VInf = True+isVInf _ = False++isVPart VPart = True+isVPart _ = False++isVGerund VGerund = True+isVGerund _ = False++isVTense (VTense t) = Just t+isVTense _ = Nothing+++pVP = do+ (t,a,p,sl,e0) <- do t <- pCopula+ p <- pPol+ inside "VP" $ do+ advs <- many (cat "ADVP")+ (t',p',sl,e0) <- pVP+ guard (isVPart t' && sl && p' == cidPPos)+ let e1 = mkApp cidPassVPSlash [e0]+ e2 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e1 advs+ return (t,cidASimul,p,False,e2)+ `mplus`+ do t <- pCopula+ p <- pPol+ advs <- many (cat "ADVP")+ e <- do e <- cat "ADJP"+ return (mkApp cidCompAP [e])+ `mplus`+ do e <- cat "NP"+ return (mkApp cidCompNP [e])+ `mplus`+ do e <- cat "NP"+ return (mkApp cidCompNP [e])+ `mplus`+ do e <- cat "PP"+ return (mkApp cidCompAdv [e])+ `mplus`+ do e <- cat "SBAR" + return (mkApp cidCompS [e])+ `mplus`+ do e <- inside "S" $ do+ inside "NP" (cat "-NONE-")+ (tmp,pol,sl,e) <- inside "VP" pVP+ guard (isVInf tmp && not sl && pol == cidPPos)+ return e+ return (mkApp cidCompVP [e])+ let e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) (mkApp cidUseComp [e]) advs+ return (t,cidASimul,p,False,e1)+ `mplus`+ do t <- pCopula+ p <- pPol+ advs <- many (cat "ADVP")+ (tmp,pol,sl,e) <- inside "VP" pVP+ guard (isVGerund tmp && not sl && pol == cidPPos)+ let e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e advs+ return (t,cidASimul,p,False,mkApp cidProgrVP [e1])+ `mplus`+ do t <- pCopula+ p <- pPol+ adv <- cat "ADVP"+ return (t,cidASimul,p,False,mkApp cidUseComp [mkApp cidCompAdv [adv]])+ `mplus`+ do w <- inside "MD" word+ t <- case w of+ "will" -> return cidTFut+ "would" -> return cidTCond+ _ -> mzero+ p <- pPol+ advs <- many (cat "ADVP")+ (tmp,pol,sl,e0) <- inside "VP" pVP+ guard (isVInf tmp && pol == cidPPos)+ let e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (VTense t,cidASimul,p,sl,e1)+ `mplus`+ do t <- pHave+ p <- pPol+ advs <- many (cat "ADVP")+ (tmp,pol,sl,e0) <- inside "VP" pVP+ guard (isVPart tmp && pol == cidPPos)+ let e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidAAnter,p,sl,e1)+ `mplus`+ do t <- pDo+ p <- pPol+ advs <- many (cat "ADVP")+ (tmp,p',sl,e0) <- inside "VP" $ pVP+ guard (p' == cidPPos)+ let e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidASimul,p,sl,e1)+ `mplus`+ do advs <- many (cat "ADVP")+ inside "TO" word -- infinitives+ e0 <- cat "VP"+ let e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (VInf,cidASimul,cidPPos,False,e1)+ `mplus`+ do advs1 <- many (cat "ADVP")+ (t,v) <- pV "V2"+ pps <- many (cat "PP")+ let e0 = mkApp cidSlashV2a [mkApp v []]+ e1 = foldl (\e pp -> mkApp cidAdvVPSlash [e, pp]) e0 pps+ (sl,e2) <- (do (inside "NP" (cat "-NONE-")+ `mplus`+ inside "SBAR" (cat "-NONE-"))+ return (True,e1)+ `mplus`+ do np <- cat "NP"+ return (False,mkApp cidComplSlash [e1, np]))+ let e3 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e2 advs1+ return (t,cidASimul,cidPPos,sl,e3)+ `mplus`+ do (t,v) <- inside "MD" $+ (do v <- lemma "VV" "s (VVF VPres)"+ return (cidTPres,v)+ `mplus`+ do v <- lemma "VV" "s (VVF VPast)"+ return (cidTPast,v))+ p <- pPol+ advs <- many (cat "ADVP")+ vp <- cat "VP"+ let e0 = mkApp cidComplVV [mkApp v [], vp]+ e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (VTense t,cidASimul,p,False,e1)+ `mplus`+ do advs <- many (cat "ADVP")+ (t,v) <- pVV+ vp <- inside "S" $ do+ inside "NP" (cat "-NONE-")+ (tmp,pol,sl,e) <- inside "VP" pVP+ guard ((isVInf tmp || isVGerund tmp) && not sl && pol == cidPPos)+ return e+ let e0 = mkApp cidComplVV [mkApp v [], vp] + e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidASimul,cidPPos,False,e1)+ `mplus`+ do advs <- many (cat "ADVP")+ (t,v) <- pV "V2V"+ inside "S" $ + (do inside "NP" (cat "-NONE-")+ (tmp,pol,sl,vp) <- inside "VP" pVP+ guard (isVInf tmp && not sl)+ let e0 = mkApp cidSlashV2V [mkApp v [], mkApp pol [], vp]+ e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidASimul,cidPPos,True,e1)+ `mplus`+ do np <- cat "NP"+ (tmp,pol,sl,vp) <- inside "VP" pVP+ guard (isVInf tmp && not sl)+ let e0 = mkApp cidComplSlash [mkApp cidSlashV2V [mkApp v [], mkApp pol [], vp], np]+ e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidASimul,cidPPos,False,e1))+ `mplus`+ do advs <- many (cat "ADVP")+ (t,v) <- pV "VA"+ adjp <- cat "ADJP"+ let e0 = mkApp cidComplVA [mkApp v [], adjp]+ e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidASimul,cidPPos,False,e1)+ `mplus`+ do advs <- many (cat "ADVP")+ (t,v) <- pV "VS"+ s <- cat "S" `mplus` cat "SBAR"+ let e0 = mkApp cidComplVS [mkApp v [], s]+ e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidASimul,cidPPos,False,e1)+ `mplus`+ do advs <- many (cat "ADVP")+ (t,v) <- pV "V"+ let e0 = mkApp cidUseV [mkApp v []]+ e1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) e0 advs+ return (t,cidASimul,cidPPos,False,e1)+ pps <- many (cat "PP"+ `mplus`+ inside "ADVP" (cat "RB"))+ let tmp = fmap (\t -> mkApp cidTTAnt [mkApp t [],mkApp a []]) t+ e1 = foldl (\e pp -> mkApp (if sl then cidAdvVPSlash else cidAdvVP) [e, pp]) e0 pps+ return (tmp, p, sl, e1)++pClSlash = do np <- cat "NP"+ advs <- many (cat "ADVP")+ (tmp,pol,sl,vp) <- do (tmp,pol,sl,vp) <- inside "VP" pVP+ return (isVTense tmp,pol,sl,vp)+ `mplus`+ do vp <- cat "VP"+ return (Nothing,meta,False,vp)+ let vp1 = foldr (\pp e -> mkApp cidAdVVP [pp, e]) vp advs+ return (fromMaybe (mkApp meta []) tmp+ ,mkApp pol []+ ,sl+ ,mkApp (if sl then cidSlashVP else cidPredVP) [np,vp1]+ )++pV cat =+ do v <- lookup "VB" "s VInf"+ return (VInf,v)+ `mplus`+ do v <- lookup "VBP" "s VInf"+ return (VTense cidTPres,v)+ `mplus`+ do v <- lookup "VBZ" "s VPres"+ return (VTense cidTPres,v)+ `mplus`+ do v <- lookup "VBD" "s VPast"+ return (VTense cidTPast,v)+ `mplus`+ do v <- lookup "VBN" "s VPPart"+ return (VPart,v)+ `mplus`+ do v <- lookup "VBG" "s VPresPart"+ return (VGerund,v)+ where+ lookup pos fld = + inside pos $+ (do lemma cat fld+ `mplus`+ do w <- word+ return (mkCId ("["++w++"_"++cat++"]")))++pVV =+ do v <- lookup "VB" "s (VVF VInf)"+ return (VInf,v)+ `mplus`+ do v <- lookup "VBP" "s (VVF VInf)"+ return (VTense cidTPres,v)+ `mplus`+ do v <- lookup "VBZ" "s (VVF VPres)"+ return (VTense cidTPres,v)+ `mplus`+ do v <- lookup "VBD" "s (VVF VPast)"+ return (VTense cidTPast,v)+ `mplus`+ do v <- lookup "VBN" "s (VVF VPPart)"+ return (VPart,v)+ `mplus`+ do v <- lookup "VBG" "s (VVF VPresPart)"+ return (VGerund,v)+ where+ lookup pos fld = + inside pos $+ (do lemma "VV" fld+ `mplus`+ do w <- word+ return (mkCId ("["++w++"_VV]")))++pCopula =+ do s <- inside "VB" word+ guard (s == "be")+ return VInf+ `mplus`+ do s <- inside "VBP" word+ guard (s == "am" || s == "'m" || s == "are" || s == "'re")+ return (VTense cidTPres)+ `mplus`+ do s <- inside "VBZ" word+ guard (s == "is" || s == "'s")+ return (VTense cidTPres)+ `mplus`+ do s <- inside "VBD" word+ guard (s == "were" || s == "was")+ return (VTense cidTPast)+ `mplus`+ do s <- inside "VBN" word+ guard (s == "been")+ return VPart+ `mplus`+ do s <- inside "VBG" word+ guard (s == "being")+ return VGerund++pDo =+ do s <- inside "VB" word+ guard (s == "do")+ return VInf+ `mplus`+ do s <- inside "VBP" word+ guard (s == "do")+ return (VTense cidTPres)+ `mplus`+ do s <- inside "VBZ" word+ guard (s == "does")+ return (VTense cidTPres)+ `mplus`+ do s <- inside "VBD" word+ guard (s == "did")+ return (VTense cidTPast)++pHave =+ do s <- inside "VB" word+ guard (s == "have")+ return VInf+ `mplus`+ do s <- inside "VBP" word+ guard (s == "have")+ return (VTense cidTPres)+ `mplus`+ do s <- inside "VBZ" word+ guard (s == "has")+ return (VTense cidTPres)+ `mplus`+ do s <- inside "VBD" word+ guard (s == "had")+ return (VTense cidTPast)+ `mplus`+ do s <- inside "VBN" word+ guard (s == "had")+ return VPart++pPol =+ do w <- inside "RB" word+ guard (w == "n't" || w == "not")+ return cidPNeg+ `mplus`+ do return cidPPos++pBaseNP = + do np <- inside "NN" (lemma "NP" "s (NCase Nom)")+ return (mkApp np [])+ `mplus`+ do m_pdt <- opt (liftM Just (cat "PDT")) Nothing+ m_q <- opt (liftM Just pQuant) Nothing+ m_num <- opt (liftM Just pCD ) Nothing+ m_ord <- opt (liftM Just (cat "JJS")) Nothing+ adjs <- many pModCN+ ns <- many1 (mplus (cat "NN" >>= \n -> return (n,cidNumSg)) + (cat "NNS" >>= \n -> return (n,cidNumPl)))+ let (n,s) = last ns+ cn0 = foldr (\(n,s) e -> mkApp cidCompoundCN [mkApp s [], n, e])+ (mkApp cidUseN [n])+ (init ns)+ cn = foldr (\adj e -> mkApp cidAdjCN [adj, e]) + cn0+ adjs+ num = maybe (mkApp s []) (\n -> mkApp cidNumCard [n]) m_num+ + mkDetQuant q num =+ case m_ord of+ Just ord -> mkApp cidDetQuantOrd [q,num,ord]+ Nothing -> mkApp cidDetQuant [q,num]++ e0 <- if s == cidNumSg+ then case m_q of+ Just (q,True) -> return (mkApp cidDetCN [mkDetQuant q num,cn])+ Just (q,False) -> return (mkApp cidDetCN [q,cn])+ Nothing -> do guard (isNothing m_num)+ return (mkApp cidMassNP [cn])+ else case m_q of+ Just (q,True) -> return (mkApp cidDetCN [mkDetQuant q num,cn])+ Just (q,False) -> return (mkApp cidDetCN [q,cn])+ Nothing -> return (mkApp cidDetCN [mkDetQuant (mkApp cidIndefArt []) num,cn])+ let e1 = case m_pdt of+ Just pdt -> mkApp cidPredetNP [pdt,e0]+ Nothing -> e0+ return e1+ `mplus`+ do dt <- cat "QP"+ n <- mplus (cat "NN") (cat "NNS")+ return (mkApp cidDetCN [dt,mkApp cidUseN [n]])+ `mplus`+ do m_q <- opt (liftM Just pQuant) Nothing+ ws2 <- many1 (inside "NNP" word `mplus` inside "NNPS" word)+ let e0 = mkApp cidSymbPN+ [mkApp cidMkSymb + [mkStr (unwords ws2)]]+ case m_q of+ Just (q,b) -> do guard b+ return (mkApp cidUseQuantPN [q,e0])+ Nothing -> return (mkApp cidUsePN [e0])+ `mplus`+ do p <- inside "PRP" (lemma "NP" "s (NCase Nom)")+ return (mkApp p [])+ `mplus`+ do p <- cat "PRP"+ return (mkApp cidUsePron [p])+ `mplus`+ do np <- cat "NP"+ pps <- many1 (cat "PP")+ prns <- many (cat "PRN")+ let e0 = foldl (\e pp -> mkApp cidAdvNP [e, pp]) np pps+ e1 = foldl (\e pn -> mkApp meta [e, pn]) e0 prns+ return e1+ `mplus`+ do np <- cat "NP"+ inside "," word+ (t',p',sl,vp) <- inside "VP" pVP+ guard (isVPart t' && sl && p' == cidPPos)+ inside "," word+ return (mkApp meta [np, vp])+ `mplus`+ do (q,b) <- pQuant+ return (mkApp cidDetNP [if b+ then mkApp cidDetQuant [mkApp cidIndefArt [],mkApp cidNumSg []]+ else q])+ `mplus`+ do n <- pCD+ return (mkApp cidDetNP [mkApp cidDetQuant [mkApp cidIndefArt [],mkApp cidNumCard [n]]])++pBaseNPs = do+ np <- pBaseNP+ (do inside "," word+ (m_cc,nps) <- pBaseNPs+ return (m_cc ,np:nps)+ `mplus`+ do cc <- cat "CC"+ np2 <- pBaseNP+ return (Just cc,[np,np2])+ `mplus`+ do return (Nothing,[np]))++pNPs = do+ (t1,t2) <- do w <- inside "DT" word+ case map toLower w of+ "both" -> return (mkApp cidand_Conj [],mkApp cidboth7and_DConj [])+ "either" -> return (mkApp cidor_Conj [],mkApp cideither7or_DConj [])+ _ -> mzero+ `mplus`+ do return (mkApp meta [],mkApp meta [])+ (m_cc,nps) <- pList+ return (fmap (toDConj t1 t2) m_cc,nps)+ where+ toDConj t1 t2 cc+ | cc == t1 = t2+ | otherwise = cc++ pList = do+ np <- cat "NP"+ (do inside "," word+ (m_cc,nps) <- pList+ return (m_cc ,np:nps)+ `mplus`+ do cc <- cat "CC"+ np2 <- cat "NP"+ return (Just cc,[np,np2])+ `mplus`+ do return (Nothing,[np]))++mkListNP nps0 =+ foldr (\np1 np2 -> mkApp cidConsNP [np1,np2]) (mkApp cidBaseNP nps2) nps1+ where+ (nps1,nps2) = splitAt (length nps0-2) nps0++pModCN =+ do v <- inside "VBN" (lemma "V2" "s VPPart")+ return (mkApp cidPastPartAP [mkApp v []])+ `mplus`+ do v <- inside "JJ" (lemma "V2" "s VPPart")+ return (mkApp cidPastPartAP [mkApp v []])+ `mplus`+ do v <- inside "JJ" (lemma "V" "s VPresPart")+ return (mkApp cidGerundAP [mkApp v []])+ `mplus`+ do a <- cat "JJ"+ return (mkApp cidPositA [a])+ `mplus`+ do a <- cat "ADJP"+ return a++pCD = + do w0 <- inside "CD" word+ let w = filter (/=',') w0+ guard (not (null w) && all isDigit w)+ let es = [mkApp (mkCId ("D_"++[d])) [] | d <- w]+ e0 = foldr (\e1 e2 -> mkApp cidIIDig [e1,e2]) (mkApp cidIDig [last es]) (init es)+ e1 = mkApp cidNumDigits [e0]+ return e1+ `mplus`+ do w <- inside "CD" word+ e <- case map toLower w of+ "one" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot01 []]]]])+ "two" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn2 []]]]]])+ "three" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn3 []]]]]])+ "four" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn4 []]]]]])+ "five" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn5 []]]]]])+ "six" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn6 []]]]]])+ "seven" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn7 []]]]]])+ "eight" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn8 []]]]]])+ "nine" -> return (mkApp cidnum [mkApp cidpot2as3 [mkApp cidpot1as2 [mkApp cidpot0as1 [mkApp cidpot0 [mkApp cidn9 []]]]]])+ _ -> mzero+ return (mkApp cidNumNumeral [e])+ `mplus`+ do cat "CD"++pQuant =+ inside "DT" pDT+ `mplus`+ do dt <- cat "PRP$"+ return (dt,True)+ `mplus`+ do np <- inside "NP" $ do+ np <- pBaseNP+ inside "POS" word+ return np+ return (mkApp cidGenNP [np],True)+ `mplus`+ do dt <- pMany+ return (dt,False)++pDT =+ do dt <- mplus (lemma "Quant" "s False Sg")+ (lemma "Quant" "s False Pl")+ return (mkApp dt [],True)+ `mplus`+ do dt <- lemma "Det" "s"+ return (mkApp dt [],False)++pMany =+ do w <- inside "JJ" word+ guard (map toLower w == "many")+ return (mkApp cidmany_Det [])++pAdA = do adv <- cat "RB"+ case unApp adv of+ Just (f,[a]) | f == cidPositAdvAdj + -> return (mkApp cidPositAdAAdj [a])+ _ -> mzero+ `mplus`+ do ada <- inside "RB" (lemma "AdA" "s")+ return (mkApp ada [])++splitDashN (Node w []) =+ case break (=='-') w of+ (w1,'-':w2) -> Node w1 [] : Node "-" [Node "-" []] : splitDashN (Node w2 [])+ _ -> [Node w []]+splitDashN t = [t]++meta = mkCId "?"
@@ -0,0 +1,149 @@+module Idents where++import SusanneFormat++cidASimul = app0 "ASimul"+cidAAnter = app0 "AAnter"+cidPositAdvAdj = app0 "PositAdvAdj"+cidPositAdVAdj = app0 "PositAdVAdj"+cidUseCl = app3 "UseCl"+cidPredVP = app2 "PredVP"+cidSlashVP = app2 "SlashVP"+cidVPSlashPrep = app2 "VPSlashPrep"+cidComplPredVP = app0 "ComplPredVP"+cidAdjCN = app2 "AdjCN"+cidUseN = app1 "UseN"+cidDetQuant = app2 "DetQuant"+cidDetQuantOrd = app3 "DetQuantOrd"+cidNumSg = app0 "NumSg"+cidNumPl = app0 "NumPl"+cidDetCN = app2 "DetCN"+cidIndefArt = app0 "IndefArt"+cidDefArt = app0 "DefArt"+cidUsePN = app1 "UsePN"+cidUseQuantPN = app0 "UseQuantPN"+cidSymbPN = app1 "SymbPN"+cidMkSymb = app1 "MkSymb"+cidUsePron = app1 "UsePron"+cidConjNP = app0 "ConjNP"+cidBaseNP = app0 "BaseNP"+cidConsNP = app0 "ConsNP"+cidConjCN = app0 "ConjCN"+cidBaseCN = app0 "BaseCN"+cidConsCN = app0 "ConsCN"+cidConjAdv = app0 "ConjAdv"+cidBaseAdv = app0 "BaseAdv"+cidConsAdv = app0 "ConsAdv"+cidBaseS = app0 "BaseS"+cidConsS = app0 "ConsS"+cidConjS = app0 "ConjS"+cidMassNP = app1 "MassNP"+cidAdvNP = app2 "AdvNP"+cidExtAdvNP = app2 "ExtAdvNP"+cidTPres = app0 "TPres"+cidTPast = app0 "TPast"+cidTFut = app0 "TFut"+cidTCond = app0 "TCond"+cidTTAnt = app2 "TTAnt"+cidPPos = app0 "PPos"+cidPNeg = app0 "PNeg"+cidComplSlash = app2 "ComplSlash"+cidSlashV2a = app1 "SlashV2a"+cidSlashV2A = app2 "SlashV2A"+cidComplVS = app2 "ComplVS"+cidComplVV = app4 "ComplVV"+cidUseV = app1 "UseV"+cidAdVVP = app2 "AdVVP"+cidAdvVP = app2 "AdvVP"+cidAdvVPSlash = app2 "AdvVPSlash"+cidPrepNP = app2 "PrepNP"+cidto_Prep = app0 "to_Prep"+cidsuch_as_Prep= app0 "such_as_Prep"+cidPastPartAP = app1 "PastPartAP"+cidPassVPSlash = app0 "PassVPSlash"+cidAdvS = app2 "AdvS"+cidPositA = app1 "PositA"+cidIDig = app0 "IDig"+cidIIDig = app0 "IIDig"+cidNumCard = app1 "NumCard" +cidNumDigits = app1 "NumDigits"+cidNumNumeral = app1 "NumNumeral"+cidnum = app1 "num"+cidpot2as3 = app0 "pot2as3"+cidpot1as2 = app0 "pot1as2"+cidpot0as1 = app0 "pot0as1"+cidpot01 = app0 "pot01"+cidpot0 = app0 "pot0"+cidn2 = app0 "n2"+cidn3 = app0 "n3"+cidn4 = app0 "n4"+cidn5 = app0 "n5"+cidn6 = app0 "n6"+cidn7 = app0 "n7"+cidn8 = app0 "n8"+cidn9 = app0 "n9"+cidPossPron = app1 "PossPron"+cidCompAP = app1 "CompAP"+cidCompNP = app1 "CompNP"+cidCompAdv = app1 "CompAdv"+cidCompS = app1 "CompS"+cidCompVP = app1 "CompVP"+cidUseComp = app1 "UseComp"+cidCompoundSgCN= app2 "CompoundSgCN"+cidCompoundPlCN= app2 "CompoundPlCN"+cidDashSgN = app2 "DashSgN"+cidDashPlN = app2 "DashPlN"+cidProgrVP = app0 "ProgrVP"+cidGerundN = app0 "GerundN"+cidPresPartAP = app1 "PresPartAP"+cidGenNP = app1 "GenNP"+cidPredetNP = app1 "PredetNP"+cidDetNP = app1 "DetNP"+cidAdAP = app2 "AdAP"+cidAdvAP = app2 "AdvAP"+cidPositAdAAdj = app1 "PositAdAAdj"+cideither7or_DConj = app0 "either7or_DConj"+cidboth7and_DConj = app0 "both7and_DConj"+cidor_Conj = app0 "or_Conj"+cidand_Conj = app0 "and_Conj"+cidamp_Conj = app0 "amp_Conj"+cidSlashV2V = app0 "SlashV2V"+cidComplVA = app0 "ComplVA"+cidAdNum = app0 "AdNum"+cidOrdSuperl = app1 "OrdSuperl"+cidno_RP = app0 "no_RP"+cidthat_RP = app0 "that_RP"+cidUseRCl = app3 "UseRCl"+cidRelSlash = app2 "RelSlash"+cidRelNP = app2 "RelNP"+cidRelCN = app2 "RelCN"+cidRelVP = app2 "RelVP"+cidIdRP = app0 "IdRP"+cidmany_Det = app0 "many_Det"+cidImpVP = app1 "ImpVP"+cidExistNP = app2 "ExistNP"+cidExtAdvS = app2 "ExtAdvS"+cidAdvCN = app2 "AdvCN"+cidNameCN = app2 "NameCN"+cidno_Quant = app0 "no_Quant"+cidSubjS = app2 "SubjS"+cidthat_Subj = app0 "that_Subj"+cidanySg_Det = app0 "anySg_Det"+cidanyPl_Det = app0 "anyPl_Det"+cidhave_V2 = app0 "have_V2"+cidby_Prep = app0 "by_Prep"+cidweekdayPunctualAdv = app1 "weekdayPunctualAdv"+cidi_Pron = app0 "i_Pron"+cidyouSg_Pron = app0 "youSg_Pron"+cidhe_Pron = app0 "he_Pron"+cidshe_Pron = app0 "she_Pron"+cidit_Pron = app0 "it_Pron"+cidwe_Pron = app0 "we_Pron"+cidthey_Pron = app0 "they_Pron"+cidUseComparA = app1 "UseComparA"++app0 f = App f []+app1 f = \x -> App f [x]+app2 f = \x y -> App f [x,y]+app3 f = \x y z -> App f [x,y,z]+app4 f = \w x y z -> App f [w,x,y,z]
@@ -0,0 +1,103 @@+module Parser where++import Data.Char+import Control.Monad++import PGF2+import SusanneFormat+import Debug.Trace++newtype P a = P {runP :: PGF -> Concr -> [ParseTree] -> Maybe ([ParseTree], a)}++instance Monad P where+ return x = P (\pgf cnc ts -> Just (ts, x))+ f >>= g = P (\pgf cnc ts -> case runP f pgf cnc ts of+ Nothing -> Nothing+ Just (ts,x) -> runP (g x) pgf cnc ts)++instance MonadPlus P where+ mzero = P (\pgf cnc ts -> Nothing)+ mplus f g = P (\pgf cnc ts -> mplus (runP f pgf cnc ts) (runP g pgf cnc ts))++getConcr = P (\pgf cnc ts -> Just (ts,cnc))++match convert tag_spec = P (\pgf cnc ts ->+ case ts of+ (t@(Phrase tag1 mods1 fn1 _ _):ts)+ | tag == tag1 &&+ all (flip elem mods1) mods &&+ (null fn || fn == fn1) -> Just (ts,convert pgf cnc t)+ (t@(Word _ tag1 _ _):ts)+ | tag == tag1 && null mods-> Just (ts,convert pgf cnc t)+ _ -> Nothing)+ where+ (f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec+ Phrase tag mods fn _ _ = f []++many1 f = do+ x <- f+ xs <- many f+ return (x:xs)++many f = + do x <- f+ xs <- many f+ return (x:xs)+ `mplus`+ do return []++inside tag_spec p = P (\pgf cnc ts ->+ case ts of+ (t@(Phrase tag1 mods1 fn1 _ ts'):ts)+ | tag == tag1 &&+ all (flip elem mods1) mods &&+ (null fn || fn == fn1) -> case runP p pgf cnc ts' of+ Just ([],x) -> Just (ts,x)+ _ -> Nothing+ _ -> Nothing)+ where+ (f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec+ Phrase tag mods fn _ _ = f []++insideOpt convert tag_spec p = P (\pgf cnc ts ->+ case ts of+ (t@(Phrase tag1 mods1 fn1 _ ts'):ts)+ | tag == tag1 &&+ all (flip elem mods1) mods &&+ (null fn || fn == fn1) -> case runP p pgf cnc ts' of+ Just ([],x) -> Just (ts,x)+ _ -> Just (ts,convert pgf cnc t)+ _ -> Nothing)+ where+ (f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec+ Phrase tag mods fn _ _ = f []++lemma tag cat an0 = P (\pgf cnc ts ->+ case ts of+ (t@(Word _ tag1 form _):ts) | tag == tag1 -> case runP (lookupForm cat an0 form) pgf cnc ts of+ Nothing -> Just (ts,t)+ x -> x+ _ -> Nothing)++lookupForm cat an0 form = P (\pgf cnc ts ->+ case [f | (f,an,_) <- lookupMorpho cnc form, hasCat pgf f cat, an == an0] of+ [] -> case [f | (f,an,_) <- lookupMorpho cnc (map toLower form), hasCat pgf f cat, an == an0] of+ [f] -> Just (ts,App f [])+ _ -> Nothing+ [f] -> Just (ts,App f [])+ _ -> Nothing)+ where+ hasCat pgf f cat =+ case functionType pgf f of+ (DTyp _ cat1 _) -> cat1 == cat++opt f =+ do x <- f+ return (Just x)+ `mplus`+ do return Nothing++word tag = P (\pgf cnc ts ->+ case ts of+ ((Word _ tag1 form _):ts) | tag == tag1 -> Just (ts,form)+ _ -> Nothing)
@@ -0,0 +1,143 @@+module SusanneFormat(Tag,Id,Word,Lemma,ParseTree(..),readTreebank,readTag) where++import Data.Char+import qualified Data.Map as Map++type Tag = String+type Mods = String+type Fn = String+type Index = Int+type Id = String+type Word = String+type Lemma = String++data ParseTree+ = Phrase Tag Mods Fn Index [ParseTree]+ | Word Id Tag Word Lemma+ | App String [ParseTree]+ | Lit String+ deriving Eq++data ParseTreePos+ = Root+ | At ParseTreePos ([ParseTree] -> ParseTree) [ParseTree]++instance Show ParseTree where+ show (Phrase tag mods fn idx ts)+ | tag == "" = "["++fn++show idx++" "++unwords (map show ts)++"]"+ | fn == "" && idx == 0 = "["++tag++mods++" "++unwords (map show ts)++"]"+ | otherwise = "["++tag++mods++":"++fn++show idx++" "++unwords (map show ts)++"]"+ show (Word _ tag w _) = "["++tag++" "++w++"]"+ show (App f ts) + | null ts = f+ | otherwise = "("++f++" "++unwords (map show ts)++")"+ show (Lit s) = show s++readTreebank ls = readLines Root (map words ls)++readLines p [] = []+readLines p ([id,_,tag,w,l,parse]:ls) =+ readParse (Word id tag (readWord w) l) p parse ls++readParse w p [] ls = readLines p ls+readParse w p ('[':cs) ls =+ case readTag w cs of+ (fn,cs) -> readParse w (At p fn []) cs ls+readParse w (At p fn ts) ('.':cs) ls =+ readParse w (At p fn (w:ts)) cs ls+readParse w (At p fn ts) cs ls =+ case readTag w cs of+ (_,']':cs) -> let t = fn (reverse ts)+ in case p of+ Root -> t : readLines p ls+ At p fn ts -> readParse w (At p fn (t:ts)) cs ls+ _ -> readError w++readTag w cs@(c1:c2:_) -- word tag on phrase level+ | isUpper c1 && isUpper c2 =+ case break (\c -> not (isLetter c || isDigit c)) cs of+ (tag,cs) -> case break (\c -> not (elem c "?*%!\"=+-&@")) cs of+ (mods,cs) -> case cs of+ (':':c:cs) | isLetter c -> case break (not . isDigit) cs of+ (ds,cs) -> (Phrase tag mods [c] (if null ds then 0 else read ds),cs)+ | isDigit c -> case break (not . isDigit) (c:cs) of+ (ds,cs) -> (Phrase tag mods "" (if null ds then 0 else read ds),cs)+ _ -> (Phrase tag mods "" 0,cs)+readTag w (c:cs) -- phrase tag+ | isUpper c = let tag = [c]+ in case break (\c -> not (isLetter c || isDigit c || elem c "?*%!\"=+-&@")) cs of+ (mods,cs) -> case cs of+ (':':c:cs) | isLetter c -> case break (not . isDigit) cs of+ (ds,cs) -> (Phrase tag mods [c] (if null ds then 0 else read ds),cs)+ | isDigit c -> case break (not . isDigit) (c:cs) of+ (ds,cs) -> (Phrase tag mods "" (if null ds then 0 else read ds),cs)+ _ -> (Phrase tag mods "" 0,cs)+ | isLower c = let tag = []+ mods = []+ in case break (not . isDigit) cs of+ (ds,cs) -> (Phrase tag mods [c] (if null ds then 0 else read ds),cs)+ | isDigit c = let tag = []+ mods = []+ in case break (not . isDigit) cs of+ (ds,cs) -> (Phrase tag mods [] (read ds),cs)+readTag w cs = readError w++readError (Word id _ _ _) = error id++readWord w0 = replaceEntities w2+ where+ w1 | head w0 == '+' = tail w0+ | otherwise = w0+ w2 | last w1 == '+' = init w1+ | otherwise = w1++ replaceEntities [] = []+ replaceEntities ('<':cs) =+ let (e,'>':cs1) = break (=='>') cs+ in case Map.lookup e entity_names of+ Just c -> c : replaceEntities cs1+ Nothing -> "<"++e++">"++ replaceEntities cs1+ replaceEntities (c: cs) = c : replaceEntities cs++entity_names = Map.fromList+ [("agr",'α')+ ,("agrave",'à')+ ,("apos",'\'')+ ,("auml",'ä')+ ,("bgr",'β')+ ,("blank",' ')+ ,("ccedil",'ç')+ ,("deg",'°')+ ,("dollar",'$')+ ,("eacute",'é')+ ,("egr",'ε')+ ,("egrave",'è')+ ,("frac12",'½')+ ,("frac14",'¼')+ ,("ggr",'γ')+ ,("hellip",'…')+ ,("hyphen",'-')+ ,("iuml",'ï')+ ,("khgr",'χ')+ ,("ldquo",'“')+ ,("lgr",'λ')+ ,("lsquo",'‘')+ ,("mdash",'—')+ ,("mgr",'μ')+ ,("minus",'-')+ ,("ntilde",'ñ')+ ,("oelig",'œ')+ ,("ouml",'ö')+ ,("para",'¶')+ ,("pgr",'π')+ ,("phgr",'φ')+ ,("prime",'′')+ ,("Prime",'″')+ ,("rdquo",'”')+ ,("rgr",'ρ')+ ,("rsquo",'’')+ ,("sect",'§')+ ,("sol",'/')+ ,("tggr",'θ')+ ]+
@@ -0,0 +1,883 @@+import System.Directory+import System.FilePath+import Data.List+import Data.Char(toLower)+import Data.Maybe(fromMaybe)+import Control.Monad+import qualified Data.Map as Map++import PGF2+import SusanneFormat+import Parser+import Idents++main = do+ gr <- readPGF "ParseEngAbs.pgf"+ let Just eng = Map.lookup "ParseEng" (languages gr)+ fs <- getDirectoryContents "data"+ txts <- (mapM (\f -> readFile ("data" </> f)) . filter ((/= ".") . take 1)) (sort fs)+ let ts = (map (convert gr eng) . concatMap filterTree) (readTreebank (lines (concat txts)))+ writeFile "susanne.gft" (unlines (map show ts))++filterTree w@(Word _ tag _ lemma)+ | elem tag ["YB","YBL","YBR","YF","YIL","YIR","YTL","YTR", "YO"] = []+ | otherwise = [w]+filterTree (Phrase tag mods fn idx ts)+ | tag == "O" = ts'+ | tag == "Q" = ts'+ | otherwise = [Phrase tag mods fn idx ts']+ where+ ts' = concatMap filterTree ts++convert pgf eng t@(Phrase tag mods fn idx ts)+ | tag == "S" = case runP pS pgf eng ts of+ Just ([],x) -> x+ _ -> Phrase tag mods fn idx ts'+ | tag == "N" = case runP pNP pgf eng ts of+ Just ([],x) -> x+ _ -> Phrase tag mods fn idx ts'+ | tag == "V" = case runP (pV "V") pgf eng [t] of+ Just ([],(_,_,_,_,x)) -> x+ _ -> Phrase tag mods fn idx ts'+ | tag == "P" = case runP pPP pgf eng ts of+ Just ([],x) -> x+ _ -> Phrase tag mods fn idx ts'+ | tag == "Po"= case runP pPP pgf eng ts of+ Just ([],x) -> x+ _ -> Phrase tag mods fn idx ts'+ | tag == "Fr"= case runP pRS pgf eng ts of+ Just ([],x) -> x+ _ -> Phrase tag mods fn idx ts'+ | otherwise = Phrase tag mods fn idx ts'+ where+ ts' = map (convert pgf eng) ts+convert pgf eng t@(Word _ tag _ lemma)+ | take 2 tag == "NN" = case runP pN pgf eng [t] of+ Just ([],(_,x)) -> x+ _ -> t+ | take 1 tag == "J" = case runP pAP pgf eng [t] of+ Just ([],x) -> x+ _ -> t+ | otherwise = t++pS =+ do mplus pConj (return ())+ advs <- many pAdS+ np <- pSubject+ (t,p,vp) <- pVP+ return (foldr ($) (cidUseCl t p (cidPredVP np vp)) advs)+ `mplus`+ do mplus pConj (return ())+ (t,p,vp) <- pVP+ return (cidImpVP vp)+ `mplus`+ do mplus pConj (return ())+ advs <- many pAdS+ t1 <- match convert "EX"+ (t,p,vp) <- pVP+ return (foldr ($) (cidUseCl t p (cidExistNP t1 vp)) advs)++pSubject =+ do insideOpt convert "N:s" pNP+ `mplus`+ do insideOpt convert "N:S" pNP+ `mplus`+ do insideOpt convert "M:s" pM+ `mplus`+ do insideOpt convert "M:S" pM+ `mplus`+ do insideOpt convert "Ds:s" $ do+ det <- pDet+ return (cidDetNP (det cidNumSg))+ `mplus`+ do insideOpt convert "Dp:s" $ do+ det <- pDet+ return (cidDetNP (det cidNumPl))+ `mplus`+ do insideOpt convert "Ds:S" $ do+ det <- pDet+ return (cidDetNP (det cidNumSg))+ `mplus`+ do insideOpt convert "Dp:S" $ do+ det <- pDet+ return (cidDetNP (det cidNumPl))++pConj =+ do match convert "CC"+ return ()+ `mplus`+ do match convert "CCB"+ return ()++pAdS =+ do adv <- pVPMods+ match convert "YC"+ return (\t -> cidExtAdvS adv t)+ `mplus`+ do adv <- pVPMods+ return (\t -> cidAdvS adv t)++pVP =+ do adVs <- many pAdV+ (t,p,voice,apect,vs) <- pV "VS"+ advs <- many pVPMods+ s <- insideOpt convert "F:o"+ (opt (match convert "CST") >> pS)+ return (t,p,foldr (\adv t -> cidAdVVP adv t)+ (foldl (\t adv -> cidAdvVP t adv)+ (cidComplVS vs s)+ advs)+ adVs)+ `mplus`+ do adVs <- many pAdV+ (t,p,voice,apect,vv) <- pV "VV"+ advs <- many pVPMods+ (p2,voice,aspect,vp) <- inside "Ti" $ do+ match convert "s"+ pVPInf+ return (t,p,foldr (\adv t -> cidAdVVP adv t)+ (foldl (\t adv -> cidAdvVP t adv)+ (cidComplVV vv cidASimul p2 vp)+ advs)+ adVs)+ `mplus`+ do adVs <- many pAdV+ (t,p,voice,apect,v2) <- pV "V2"+ o <- pObject+ opt (match convert "YC") -- what is this?+ advs <- many pVPMods+ return (t,p,foldr (\adv t -> cidAdVVP adv t)+ (foldl (\t adv -> cidAdvVP t adv)+ (cidComplSlash (cidSlashV2a v2) o)+ advs)+ adVs)+ `mplus`+ do adVs <- many pAdV+ (t,p,voice,apect,v) <- pV "V"+ advs <- many pVPMods+ return (t,p,foldr (\adv t -> cidAdVVP adv t)+ (foldl (\t adv -> cidAdvVP t adv)+ (cidUseV v)+ advs)+ adVs)+ `mplus`+ do (t,p) <- inside "V" pCopula+ comp <- pComp+ advs <- many pVPMods+ return (cidTTAnt t cidASimul,p,foldl (\t adv -> cidAdvVP t adv)+ (cidUseComp comp)+ advs)++pCopula = + do match convert "VBZ"+ p <- pPol+ return (cidTPres,p)+ `mplus`+ do match convert "VBDZ"+ p <- pPol+ return (cidTPast,p)++pComp =+ do adv <- insideOpt convert "R:e" pAdv+ return (cidCompAdv adv)+ `mplus`+ do np <- insideOpt convert "N:e" pNP+ return (cidCompNP np)+ `mplus`+ do ap <- pAP+ return (cidCompAP ap)++pAdv =+ do lemma "RP" "Adv" "s"++data Voice = Active | Passive+data Aspect = Simple | Progressive++pV cat =+ do inside "V" $+ do v <- pVPres cat+ return (cidTTAnt cidTPres cidASimul,cidPPos,Active,Simple,v)+ `mplus`+ do v <- do lemma "VVZi" cat "s VPres"+ `mplus`+ do lemma "VVZt" cat "s VPres"+ `mplus`+ do lemma "VVZv" cat "s VPres"+ return (cidTTAnt cidTPres cidASimul,cidPPos,Active,Simple,v)+ `mplus`+ do v <- do lemma "VVDi" cat "s VPast"+ `mplus`+ do lemma "VVDt" cat "s VPast"+ `mplus`+ do lemma "VVDv" cat "s VPast"+ return (cidTTAnt cidTPast cidASimul,cidPPos,Active,Simple,v)+ `mplus`+ do (match convert "VBM" `mplus` match convert "VBR" `mplus` match convert "VBZ") -- am,are,is+ pol <- pPol+ (voice,aspect,v) <- pVPart cat+ return (cidTTAnt cidTPres cidASimul,pol,voice,aspect,v)+ `mplus`+ do (match convert "VBDZ" `mplus` match convert "VBDR") -- was,were+ pol <- pPol+ (voice,aspect,v) <- pVPart cat+ return (cidTTAnt cidTPast cidASimul,pol,voice,aspect,v)+ `mplus`+ do match convert "VH0" -- have+ pol <- pPol+ (voice,aspect,v) <- do v <- pVPastPart cat+ return (Active,Simple,v)+ `mplus`+ do match convert "VBN" -- been+ pVPart cat+ return (cidTTAnt cidTPres cidAAnter,pol,voice,aspect,v)+ `mplus`+ do match convert "VH0" -- have+ return (cidTTAnt cidTPres cidAAnter,cidPPos,Active,Simple,cidhave_V2)+ `mplus`+ do match convert "VHZ" -- has+ pol <- pPol+ (voice,aspect,v) <- do v <- pVPastPart cat+ return (Active,Simple,v)+ `mplus`+ do match convert "VBN" -- been+ pVPart cat+ return (cidTTAnt cidTPres cidAAnter,pol,voice,aspect,v)+ `mplus`+ do match convert "VHZ" -- has+ return (cidTTAnt cidTPres cidAAnter,cidPPos,Active,Simple,cidhave_V2)+ `mplus`+ do match convert "VHD" -- had+ pol <- pPol+ (voice,aspect,v) <- do v <- pVPastPart cat+ return (Active,Simple,v)+ `mplus`+ do match convert "VBN" -- been+ pVPart cat+ return (cidTTAnt cidTPast cidAAnter,pol,voice,aspect,v)+ `mplus`+ do match convert "VHD" -- had+ return (cidTTAnt cidTPast cidASimul,cidPPos,Active,Simple,cidhave_V2)+ `mplus`+ do w <- word "VMo" -- will+ guard (w == "will")+ pol <- pPol+ (voice,apect,vp) <- pVInf cat+ return (cidTTAnt cidTFut cidASimul,pol,voice,apect,vp)+ `mplus`+ do mplus (match convert "VD0") (match convert "VDZ") -- do,does+ match convert "XX"+ vp <- pVPres cat+ return (cidTTAnt cidTPres cidASimul,cidPNeg,Active,Simple,vp)+ `mplus`+ do match convert "VDD" -- did+ match convert "XX"+ vp <- pVPres cat+ return (cidTTAnt cidTPast cidASimul,cidPNeg,Active,Simple,vp)+++pVPInf = do+ adVs <- many pAdV+ (pol,voice,apect,vp) <- do (pol,voice,apect,v2) <- inside "Vi" $+ do pol <- pPol+ match convert "TO"+ (voice,aspect,v) <- pVInf "V2"+ return (pol,voice,aspect,v)+ o <- pObject+ return (pol,voice,apect,cidComplSlash (cidSlashV2a v2) o)+ `mplus`+ do (pol,voice,apect,v2a) <- inside "Vi" $+ do pol <- pPol+ match convert "TO"+ (voice,aspect,v) <- pVInf "V2A"+ return (pol,voice,aspect,v)+ o <- pObject+ ap <- pAP+ return (pol,voice,apect,cidComplSlash (cidSlashV2A v2a ap) o)+ advs <- many pVPMods+ return (pol,voice,apect,+ foldr (\adv t -> cidAdVVP adv t)+ (foldl (\t adv -> cidAdvVP t adv)+ vp+ advs)+ adVs)++pVInf cat =+ do v <- pVPres cat+ return (Active,Simple,v)+ `mplus`+ do match convert "VB0" -- be+ pVPart cat+ `mplus`+ do v <- match convert "VH0" -- have+ return (Active,Simple,v)++pVPPresPart =+ insideOpt convert "Vg" $ do+ v <- pVPresPart "V"+ return (cidUseV v)++pVPart cat =+ do v <- pVPresPart cat+ return (Active,Progressive,v)+ `mplus`+ do v <- pVPastPart cat+ return (Passive,Simple,v)++pVPres cat =+ do lemma "VV0i" cat "s VInf"+ `mplus`+ do lemma "VV0t" cat "s VInf"+ `mplus`+ do lemma "VV0v" cat "s VInf"++pVPresPart cat =+ do lemma "VVGi" cat "s VPresPart"+ `mplus`+ do lemma "VVGt" cat "s VPresPart"+ `mplus`+ do lemma "VVGv" cat "s VPresPart"++pVPastPart cat =+ do lemma "VVNi" cat "s VPPart"+ `mplus`+ do lemma "VVNt" cat "s VPPart"+ `mplus`+ do lemma "VVNv" cat "s VPPart"++pPol =+ do match convert "XX"+ return cidPNeg+ `mplus`+ do return cidPPos++pAdV =+ do insideOpt convert "R:c" $+ lemma "RRR" "AdV" "s"+ `mplus`+ do insideOpt convert "R:m" $+ lemma "RRR" "AdV" "s"++pObject = + match convert "P:u"+ `mplus`+ insideOpt convert "N:o" pNP+ `mplus`+ match convert "N:e"+ `mplus`+ insideOpt convert "M:e" pM+ `mplus`+ do insideOpt convert "Ds:e" $ do+ det <- pDet+ return (cidDetNP (det cidNumSg))+ `mplus`+ do insideOpt convert "Dp:e" $ do+ det <- pDet+ return (cidDetNP (det cidNumPl))+ `mplus`+ do insideOpt convert "P:e" $ pPP++pVPMods =+ do insideOpt convert "N:t" pTimeNPAdv+ `mplus`+ do match convert "N:h"+ `mplus`+ do insideOpt convert "P:p" $ pPP+ `mplus`+ do insideOpt convert "P:q" $ pPP+ `mplus`+ do insideOpt convert "Pb:a" $ do+ match convert "IIb"+ np <- insideOpt convert "N" pNP+ return (cidPrepNP cidby_Prep np)+ `mplus`+ do insideOpt convert "P:t" $ pPP+ `mplus`+ do insideOpt convert "P:h" $ pPP+ `mplus`+ do insideOpt convert "P:m" $ pPP+ `mplus`+ do insideOpt convert "P:r" $ pPP+ `mplus`+ do insideOpt convert "R:p" $ pAdv+ `mplus`+ do insideOpt convert "R:q" $ pAdv+ `mplus`+ do insideOpt convert "R:a" $ pAdv+ `mplus`+ do insideOpt convert "R:t" $ pAdv+ `mplus`+ do insideOpt convert "R:h" $ pAdv+ `mplus`+ do insideOpt convert "R:m" $ pAdv+ `mplus`+ do insideOpt convert "R:c" $ pAdv+ `mplus`+ do insideOpt convert "R:r" $ pAdv+ `mplus`+ do match convert "F:p"+ `mplus`+ do match convert "F:q"+ `mplus`+ do match convert "F:a"+ `mplus`+ do match convert "F:t"+ `mplus`+ do match convert "F:h"+ `mplus`+ do match convert "F:m"+ `mplus`+ do match convert "F:r"+ `mplus`+ do match convert "W:b"+ `mplus`+ do match convert "L:b"++pPP =+ do prep <- do lemma "ICS" "Prep" "s"+ `mplus`+ do lemma "ICSk" "Prep" "s"+ `mplus`+ do lemma "ICSt" "Prep" "s"+ `mplus`+ do lemma "ICSx" "Prep" "s"+ `mplus`+ do lemma "IF" "Prep" "s"+ `mplus`+ do lemma "II" "Prep" "s"+ `mplus`+ do lemma "IIa" "Prep" "s"+ `mplus`+ do lemma "IIb" "Prep" "s"+ `mplus`+ do lemma "IIg" "Prep" "s"+ `mplus`+ do lemma "IIp" "Prep" "s"+ `mplus`+ do lemma "IIt" "Prep" "s"+ `mplus`+ do lemma "IO" "Prep" "s"+ `mplus`+ do lemma "IW" "Prep" "s"+ `mplus`+ do insideOpt convert "II=" $ do+ w1 <- word "II21"+ w2 <- word "II22"+ lookupForm "Prep" "s" (unwords [w1,w2])+ np <- do insideOpt convert "N" pNP+ `mplus`+ do (mb_num,n) <- pN+ case mb_num of+ Just num | num == cidNumPl -> return (cidDetCN (cidDetQuant cidIndefArt num) (cidUseN n))+ _ -> return (cidMassNP (cidUseN n)) -- we don't know the number+ return (cidPrepNP prep np)++pNP =+ do np <- pBaseNP+ mods <- many pNPMods+ return (foldl (\t mod -> mod t)+ np+ mods)+ `mplus`+ do pBaseNP++pBaseNP = + do det <- pDet+ (mb_num,cn) <- pCN+ case mb_num of+ Just num -> return (cidDetCN (det num) cn)+ Nothing -> mzero -- we don't know the number+ `mplus`+ do pn <- pName+ return (cidUsePN pn)+ `mplus`+ do (mb_num,cn) <- pCN+ case mb_num of+ Just num | num == cidNumPl -> return (cidDetCN (cidDetQuant cidIndefArt num) cn)+ _ -> return (cidMassNP cn) -- we don't know the number + `mplus`+ do match convert "PPIS1"+ return (cidUsePron cidi_Pron)+ `mplus`+ do match convert "PPY"+ return (cidUsePron cidyouSg_Pron)+ `mplus`+ do match convert "PPHS1m"+ return (cidUsePron cidhe_Pron)+ `mplus`+ do match convert "PPHS1f"+ return (cidUsePron cidshe_Pron)+ `mplus`+ do match convert "PPH1"+ return (cidUsePron cidit_Pron)+ `mplus`+ do match convert "PPIS2"+ return (cidUsePron cidwe_Pron)+ `mplus`+ do match convert "PPHS2"+ return (cidUsePron cidthey_Pron)+ `mplus`+ do match convert "Nn"++pDet =+ do match convert "DDy"+ return (\num -> if num == cidNumSg+ then cidanySg_Det+ else cidanyPl_Det)+ `mplus`+ do det <- lemma "DA2" "Det" "s"+ return (\num -> det)+ `mplus`+ do num0 <- pNumeral+ return (\num -> cidDetQuant cidIndefArt num0)+ `mplus`+ do q <- pQuant+ ord <- pOrd+ return (\num -> cidDetQuantOrd q num ord)+ `mplus`+ do q <- pQuant+ mb_num <- opt pNumeral+ return (\num -> cidDetQuant q (fromMaybe num mb_num))++pQuant =+ do match convert "AT"+ return cidDefArt+ `mplus`+ do match convert "AT1"+ return cidIndefArt+ `mplus`+ do match convert "ATn"+ return cidno_Quant+ `mplus`+ do match convert "APPGi1"+ return (cidPossPron cidi_Pron)+ `mplus`+ do match convert "APPGy"+ return (cidPossPron cidyouSg_Pron)+ `mplus`+ do match convert "APPGm"+ return (cidPossPron cidhe_Pron)+ `mplus`+ do match convert "APPGf"+ return (cidPossPron cidshe_Pron)+ `mplus`+ do match convert "APPGh1"+ return (cidPossPron cidit_Pron)+ `mplus`+ do match convert "APPGi2"+ return (cidPossPron cidwe_Pron)+ `mplus`+ do match convert "APPGh2"+ return (cidPossPron cidthey_Pron)+ `mplus`+ do lemma "DD1a" "Quant" "s True Sg"+ `mplus`+ do lemma "DD1i" "Quant" "s True Sg"+ `mplus`+ do lemma "DD2a" "Quant" "s True Pl"+ `mplus`+ do lemma "DD2i" "Quant" "s True Pl"+ `mplus`+ do lemma "DDi" "Quant" "s True Pl"+ `mplus`+ insideOpt convert "G" pGenitive++pOrd =+ do a <- lemma "JJT" "A" "s (AAdj Superl Nom)"+ return (cidOrdSuperl a)++pNumeral =+ do w <- word "MC" `mplus` word "MC1"+ cnc <- getConcr+ case parse cnc "Numeral" w of+ Right [(e,_)] -> do n <- toParseTree e+ return (cidNumCard (cidNumNumeral n))+ _ -> mzero+ `mplus`+ do w <- word "MCn"+ cnc <- getConcr+ case parse cnc "Digits" w of+ Right [(e,_)] -> do n <- toParseTree e+ return (cidNumCard (cidNumDigits n))+ _ -> mzero+ where+ toParseTree e = + case unApp e of+ Just (f,es) -> do ps <- mapM toParseTree es+ return (App f ps)+ Nothing -> mzero++pGenitive =+ do np <- insideOpt convert "N" pNP+ match convert "GG"+ return (cidGenNP np)++pCN =+ do pn <- mplus pName (insideOpt convert "Nn" pName)+ (mb_num,cn) <- pCN+ return (mb_num,cidNameCN pn cn)+ `mplus`+ do (mb_num_n,n) <- mplus pN (inside "N" pCN)+ (mb_num,cn) <- pCN+ case mb_num_n of+ Just num | num == cidNumPl -> return (mb_num,cidCompoundPlCN (cidUseN n) cn)+ _ -> return (mb_num,cidCompoundSgCN (cidUseN n) cn) -- here we don't really know the number+ `mplus`+ do ap <- pAP+ (mb_num,cn) <- pCN+ return (mb_num,cidAdjCN ap cn)+ `mplus`+ do t <- match convert "NN1u&"+ mods <- many pCNMods+ return (Just cidNumSg+ ,foldl (\t mod -> mod t)+ t+ mods)+ `mplus`+ do (mb_num,n) <- pN+ mods <- many pCNMods+ return (mb_num,+ foldl (\t mod -> mod t)+ (cidUseN n)+ mods)++pAP =+ do a <- lemma "JJ" "A" "s (AAdj Posit Nom)"+ `mplus`+ lemma "JA" "A" "s (AAdj Posit Nom)"+ `mplus`+ lemma "JB" "A" "s (AAdj Posit Nom)"+ `mplus`+ lemma "JBo" "A" "s (AAdj Posit Nom)"+ `mplus`+ lemma "DAy" "A" "s (AAdj Posit Nom)"+ `mplus`+ lemma "DAz" "A" "s (AAdj Posit Nom)"+ return (cidPositA a)+ `mplus`+ do a <- lemma "JJR" "A" "s (AAdj Compar Nom)"+ return (cidUseComparA a)+ `mplus`+ do vp <- match convert "Tn"+ return (cidPastPartAP vp)+ `mplus`+ do vp <- insideOpt convert "Tg" pVPPresPart+ return (cidPresPartAP vp)+ `mplus`+ do insideOpt convert "J" $ do+ adas <- many pAdA+ ap <- pAP+ mods <- many pAPMods+ return (foldl (\t ada -> cidAdAP ada t)+ (foldl (\t mod -> cidAdvAP t mod)+ ap+ mods)+ adas)++pAdA = do+ a <- lemma "RR" "A" "s AAdv"+ return (cidPositAdAAdj a)++pAPMods =+ do insideOpt convert "P" pPP++pN =+ do n <- lemma "NNn" "N" "s Sg Nom"+ return (Nothing, n)+ `mplus`+ do n <- lemma "NNu" "N" "s Sg Nom"+ return (Just cidNumPl, n)+ `mplus`+ do n <- lemma "NNux" "N" "s Sg Nom"+ return (Nothing, n)+ `mplus`+ do n <- lemma "NN1c" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NN1m" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NN1n" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NN1u" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NN1ux" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NN2" "N" "s Pl Nom"+ return (Just cidNumPl, n)+ `mplus`+ do n <- lemma "NNJ1c" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNJ1n" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNJ2" "N" "s Pl Nom"+ return (Just cidNumPl, n)+ `mplus`+ do n <- lemma "NNLc" "N" "s Sg Nom"+ return (Nothing, n)+ `mplus`+ do n <- lemma "NNL1c" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNL1cb" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNL1n" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNL2" "N" "s Pl Nom"+ return (Just cidNumPl, n)+ `mplus`+ do n <- lemma "NNS1c" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNS1n" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNS2" "N" "s Pl Nom"+ return (Just cidNumPl, n)+ `mplus`+ do n <- lemma "NNT1h" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNT1m" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNT1c" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNT2" "N" "s Pl Nom"+ return (Just cidNumPl, n)+ `mplus`+ do n <- lemma "NNUc" "N" "s Sg Nom"+ return (Nothing, n)+ `mplus`+ do n <- lemma "NNUn" "N" "s Sg Nom"+ return (Nothing, n)+ `mplus`+ do n <- lemma "NNU1c" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNU1n" "N" "s Sg Nom"+ return (Just cidNumSg, n)+ `mplus`+ do n <- lemma "NNU2" "N" "s Pl Nom"+ return (Just cidNumPl, n)+ `mplus`+ do inside "Ns" $ do+ (mb_num1,n1) <- pN+ match convert "YH"+ (mb_num2,n2) <- pN+ case mb_num1 of+ Just num | num == cidNumPl -> return (mb_num2,cidDashPlN n1 n2)+ _ -> return (mb_num2,cidDashSgN n1 n2) -- here we don't really know the number++pCNMods =+ do adv <- insideOpt convert "Po" $ pPP+ return (\t -> cidAdvCN t adv)+ `mplus`+ do adv <- insideOpt convert "P" $ pPP+ return (\t -> cidAdvCN t adv)+ `mplus`+ do adv <- insideOpt convert "Fn" $ do+ match convert "CST"+ s <- pS+ return (cidSubjS cidthat_Subj s)+ return (\t -> cidAdvCN t adv)+ `mplus`+ do fr <- insideOpt convert "Fr" pRS+ return (\t -> cidRelCN t fr)++pNPMods =+ do adv <- insideOpt convert "Po" $ pPP+ return (\t -> cidAdvNP t adv)+ `mplus`+ do adv <- insideOpt convert "P" $ pPP+ return (\t -> cidAdvNP t adv)+ `mplus`+ do adv <- insideOpt convert "Fn" $ do+ match convert "CST"+ s <- pS+ return (cidSubjS cidthat_Subj s)+ return (\t -> cidAdvNP t adv)+ `mplus`+ do match convert "YC"+ adv <- insideOpt convert "Po" $ pPP+ opt (match convert "YC")+ return (\t -> cidExtAdvNP t adv)+ `mplus`+ do match convert "YC"+ adv <- insideOpt convert "P" $ pPP+ opt (match convert "YC")+ return (\t -> cidExtAdvNP t adv)+ `mplus`+ do match convert "YC"+ adv <- insideOpt convert "Fn" $ do+ match convert "CST"+ s <- pS+ return (cidSubjS cidthat_Subj s)+ opt (match convert "YC")+ return (\t -> cidExtAdvNP t adv)+ `mplus`+ do match convert "YC"+ fr <- insideOpt convert "Fr" pRS+ opt (match convert "YC")+ return (\t -> cidRelNP t fr)++pName =+ do w1 <- word "NP1s"+ w2 <- word "NNL1cb"+ return (cidSymbPN (cidMkSymb (Lit (unwords [w1,w2]))))+ `mplus`+ do w1 <- word "NPM1"+ match convert "YH"+ w2 <- word "NPM1"+ return (cidSymbPN (cidMkSymb (Lit (unwords [w1,"-",w2]))))+ `mplus`+ do w1 <- msum [word "NP1c", word "NP1f", word "NP1g"+ ,word "NP1j", word "NP1m", word "NP1p"+ ,word "NP1s", word "NP1t", word "NP1x"+ ,word "NP1z", word "NP2c", word "NP2f"+ ,word "NP2g", word "NP2j", word "NP2m"+ ,word "NP2p", word "NP2s", word "NP2t"+ ,word "NP2x", word "NP2z"]+ return (cidSymbPN (cidMkSymb (Lit w1)))++pM = do+ num <- pNumeral+ mods <- many pNPMods+ return (foldl (\t mod -> mod t)+ (cidDetNP (cidDetQuant cidIndefArt num))+ mods)++pRS = + do rp <- pRP+ np <- pSubject+ (t,p,vp) <- pVP+ return (cidUseRCl t p (cidRelSlash rp (cidSlashVP np vp)))+ `mplus`+ do rp <- pRP+ (t,p,vp) <- pVP+ opt (match convert "YC")+ return (cidUseRCl t p (cidRelVP rp vp))+ `mplus`+ do (prep,rp) <- inside "Pq" $ do+ prep <- lemma "II" "Prep" "s"+ rp <- pRP+ return (prep,rp)+ np <- pSubject+ (t,p,vp) <- pVP+ opt (match convert "YC")+ return (cidUseRCl t p (cidRelSlash rp (cidSlashVP np (cidVPSlashPrep vp prep))))++pRP = + do inside "Dq" (match convert "DDQr")+ return cidIdRP++pTimeNPAdv = do+ day <- lemma "NPD1" "Weekday" "s Sg Nom"+ return (cidweekdayPunctualAdv day)
@@ -0,0 +1,106 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module Format where+import Prelude hiding (words,id)+import Text.XML.HXT.Core +import Data.Ord+import Data.List hiding (words)+import Data.Maybe+import qualified Data.Map as M+import System.Environment+import Debug.Trace as Debug+import Data.Char+import qualified Data.Tree as T+import Control.Monad.State+ +-- Functions for parsing XML to a format read by the other Haskell files++data Word = W {id :: Id, word :: String, pos :: Tag}+data PhrTag = Ph {idPh :: Id, cat :: Tag, tags :: [(Tag,Id)]}+data Sentence = Sent {rootS :: Id, words :: [Word], info :: [PhrTag], ws :: Int}+type Tag = String+type Id = String+++instance XmlPickler [Word] where+ xpickle = xpWords++instance XmlPickler Sentence where+ xpickle = xpSentence++xpSentences :: PU [Sentence] +xpSentences = xpElem "corpus" + $ xpWrap (snd, \a -> ((),a))+ $ xpPair (xpElem "head" $ xpUnit) (xpElem "body" $ xpList $ xpSentence)+xpTags :: PU [PhrTag]+xpTags = xpList $ xpElem "nt"+ $ xpWrap (uncurry3 Ph,\p -> (idPh p,cat p,tags p))+ $ xpTriple (xpAttr "id" xpText) (xpAttr "cat" xpText)+ (xpList $ xpTagMap)++xpTagMap :: PU (Tag,String)+xpTagMap = xpElem "edge"+ $ xpPair (xpAttr "label" xpText)+ (xpAttr "idref" xpText)++xpSentence :: PU Sentence +xpSentence = xpElem "s"+ $ xpWrap (makeSentence,\s -> (rootS s,words s, info s))+ $ xpElem "graph" + $ xpTriple (xpAttr "root" xpText)+ ( xpElem "terminals" xpWords)+ ( xpElem "nonterminals" xpTags)+ where makeSentence (r,ws,tgs) = Sent r ws tgs (length ws)+++xpWords :: PU [Word]+xpWords = xpList $ xpElem "t" + $ xpWrap (uncurry3 W,\t -> (id t, word t,pos t)) + $ xpTriple (xpAttr "id" xpText)+ (xpAttr "word" xpText)+ (xpAttr "pos" xpText)+ +mainF src = + runX (xunpickleDocument xpSentences [withInputEncoding utf8+ , withRemoveWS yes] src+ >>> arrIO (putStrLn . unlines . map (show . toTree))) ++runPickle f src = + runX (xunpickleDocument xpSentences [withInputEncoding utf8+ , withRemoveWS yes] src+ >>> arrIO (return . map f)) ++parse = runPickle toStringTree+parseIdTree = runPickle toTree++toStringTree :: Sentence -> (String,T.Tree String)+toStringTree = second (fmap snd) . toTree++toTree :: Sentence -> (String,T.Tree (Id,String))+toTree s@(Sent root ws inf _) = (root,toTree' root s)++toTree' :: String -> Sentence -> T.Tree (Id,String)+toTree' nr s@(Sent root ws inf _) = + case (lookup' nr ws,lookup'' nr inf) of+ (Just w,_) -> putWord w+ (_,Just p) -> putPhrase p+ _ -> error $ "Error in toTree' "++show nr++" could not be found"+ where putWord (W i w p) = T.Node (i,p) [T.Node (i,w) []]+ putPhrase (Ph i c t) = T.Node (i,c) + $ map (\(tag,next) -> T.Node (next,tag) [toTree' next s]) t++ lookup' y (w@(W x _ _):xs) | y ==x = Just w+ | otherwise = lookup' y xs+ lookup' y [] = Nothing++ lookup'' y (w@(Ph x _ _):xs) | y ==x = Just w+ | otherwise = lookup'' y xs+ lookup'' y [] = Nothing+ ++treeToSentence :: [T.Tree String] -> String+treeToSentence ts = unwords $ map extractS ts+ where extractS (T.Node ws []) = ws+ extractS (T.Node c ts) = unwords $ map extractS ts++showa :: T.Tree String -> String+showa (T.Node root ts) = "("++root++" "++concatMap showa ts++" )"
@@ -0,0 +1,182 @@+module Idents where++import PGF++cidASimul = mkCId "ASimul"+cidAAnter = mkCId "AAnter"+cidPositAdvAdj = mkCId "PositAdvAdj"+cidPositAdVAdj = mkCId "PositAdVAdj"+cidUseCl = mkCId "UseCl"+cidUseQCl = mkCId "UseQCl"+cidPredVP = mkCId "PredVP"+cidAdjCN = mkCId "AdjCN"+cidUseN = mkCId "UseN"+cidDetQuant = mkCId "DetQuant"+cidNumSg = mkCId "NumSg"+cidNumPl = mkCId "NumPl"+cidDetCN = mkCId "DetCN"+cidIndefArt = mkCId "IndefArt"+cidDefArt = mkCId "DefArt"+cidUsePN = mkCId "UsePN"+cidUseQuantPN = mkCId "UseQuantPN"+cidSymbPN = mkCId "SymbPN"+cidMkSymb = mkCId "MkSymb"+cidUsePron = mkCId "UsePron"+cidConjNP = mkCId "ConjNP"+cidBaseNP = mkCId "BaseNP"+cidConsNP = mkCId "ConsNP"+cidConjCN = mkCId "ConjCN"+cidBaseCN = mkCId "BaseCN"+cidConsCN = mkCId "ConsCN"+cidMassNP = mkCId "MassNP"+cidAdvNP = mkCId "AdvNP"+cidTPres = mkCId "TPres"+cidTPast = mkCId "TPast"+cidTFut = mkCId "TFut"+cidTFutKommer = mkCId "TFutKommer"+cidTCond = mkCId "TCond"+cidTTAnt = mkCId "TTAnt"+cidPPos = mkCId "PPos"+cidPNeg = mkCId "PNeg"+cidComplSlash = mkCId "ComplSlash"+cidSlashV2a = mkCId "SlashV2a"+cidSlashV2A = mkCId "SlashV2A"+cidComplVS = mkCId "ComplVS"+cidUseV = mkCId "UseV"+cidAdVVP = mkCId "AdVVP"+cidAdvVP = mkCId "AdvVP"+cidAdvVPSlash = mkCId "AdvVPSlash"+cidPrepNP = mkCId "PrepNP"+cidto_Prep = mkCId "to_Prep"+cidsuch_as_Prep= mkCId "such_as_Prep"+cidPastPartAP = mkCId "PastPartAP"+cidPassV2 = mkCId "PassV2"+cidAdvS = mkCId "AdvS"+cidPositA = mkCId "PositA"+cidIDig = mkCId "IDig"+cidIIDig = mkCId "IIDig"+cidNumCard = mkCId "NumCard" +cidNumDigits = mkCId "NumDigits"+cidNumNumeral = mkCId "NumNumeral"+cidnum = mkCId "num"+cidpot2as3 = mkCId "pot2as3"+cidpot1as2 = mkCId "pot1as2"+cidpot0as1 = mkCId "pot0as1"+cidpot01 = mkCId "pot01"+cidpot0 = mkCId "pot0"+cidn7 = mkCId "n7"+cidPossPron = mkCId "PossPron"+cidCompAP = mkCId "CompAP"+cidCompNP = mkCId "CompNP"+cidCompAdv = mkCId "CompAdv"+cidUseComp = mkCId "UseComp"+cidCompoundCN = mkCId "CompoundCN"+cidDashCN = mkCId "DashCN"+cidProgrVP = mkCId "ProgrVP"+cidGerundN = mkCId "GerundN"+cidGenNP = mkCId "GenNP"+cidPredetNP = mkCId "PredetNP"+cidDetNP = mkCId "DetNP"+cidAdAP = mkCId "AdAP"+cidPositAdAAdj = mkCId "PositAdAAdj"++cidBaseAP = mkCId "BaseAP"+cidConjAP = mkCId "ConjAP"+cidAndConj = mkCId "and_Conj"+cidOrConj = mkCId "or_Conj"+cidConsAP = mkCId "ConsAP"+cidQuestVP = mkCId "QuestVP"+cidComplVV = mkCId "ComplVV"+cidComplVA = mkCId "ComplVA"+cidUseCopula = mkCId "UseCopula"+cidPhrUtt = mkCId "PhrUtt"+cidNoPConj = mkCId "NoPConj"+cidNoVoc = mkCId "NoVoc"+cidUttS = mkCId "UttS"+cidUttQS = mkCId "UttQS"+cidUseComparA = mkCId "UseComparA"+cidOrdSuperl = mkCId "OrdSuperl"+cidUttImpPol = mkCId "UttImpPol"+cidImpVP = mkCId "ImpVP"+cidPConjConj = mkCId "PConjConj"+cidUttNP = mkCId "UttNP"+cidGenericCl = mkCId "GenericCl"+cidAdAdv = mkCId "AdAdv"+cidConsAdv = mkCId "ConsAdv"+cidBaseAdv = mkCId "BaseAdv"+cidConjAdv = mkCId "ConjAdv"+cidConsVPS = mkCId "ConsVPS"+cidBaseVPS = mkCId "BaseVPS"+cidConjVPS = mkCId "ConjVPS"+cidConsS = mkCId "ConsS"+cidBaseS = mkCId "BaseS"+cidConjS = mkCId "ConjS"+cidSubjS = mkCId "SubjS"+cidUttAdv = mkCId "UttAdv"+cidApposCN = mkCId "ApposCN"+cidUseRCl = mkCId "UseRCl"+cidImpersCl = mkCId "ImpersCl"+cidReflVP = mkCId "ReflVP"+cidExistNP = mkCId "ExistNP"+cidUseA2 = mkCId "UseA2"+cidComplN2 = mkCId "ComplN2"+cidAdvIAdv = mkCId "AdvIAdv"+cidQuestIAdv = mkCId "QuestIAdv"+cidQuestIComp = mkCId "QuestIComp"+cidQuestSlash = mkCId "QuestSlash"+cidCompIAdv = mkCId "CompIAdv"+cidCompIP = mkCId "CompIP"+cidIdetCN = mkCId "IdetCN"+cidIdetQuant = mkCId "IdetQuant"+cidPrepIP = mkCId "PrepIP"+cidFocObj = mkCId "FocObj"+cidSlashVP = mkCId "SlashVP"+cidAdvSlash = mkCId "AdvSlash"+cidSSubjS = mkCId "SSubjS"+cidRelVP = mkCId "RelVP"+cidIdRP = mkCId "IdRP"+cidRelSlash = mkCId "RelSlash"+cidTopAdv = mkCId "TopAdv"+cidTopAP = mkCId "TopAP"+cidTopObj = mkCId "TopObj"+cidUseTop = mkCId "UseTop"+++-- added to Extra+cidDropAttVV = mkCId "ComplBareVV"+cidRelCN = mkCId "RelCN"+cidPassV2' = mkCId "PassV2"+cidVPSlashAP = mkCId "PPartAP"+cidReflCN = mkCId "ReflIdPron"+cidReflIdPron = mkCId "ReflIdPron"+cidPredetAdvF = mkCId "PredetAdvF"++cidCompPronAQ = mkCId "CompPronAQ" +cidQuantPronAQ = mkCId "QuantPronAQ"++--not present in grammar+cidCNNumNP = mkCId "CNNumNP"++-- words+cidhow8much_IAdv = mkCId "how8much_IAdv"+cidBy8agent_Prep = mkCId "by8agent_Prep"+cidD_1 = mkCId "D_1"+cidName = mkCId "john_PN"+cidCan_VV = mkCId "can_VV" +cidMust_VV = mkCId "must_VV"+cidWant_VV = mkCId "want_VV"+cidHave_V2 = mkCId "have_V2"+cidGet_V2 = mkCId "faa_vb_1_1_V2" -- in lexicon, not grammar+cidGet_VV = mkCId "faa_vb_1_1_VV" -- in lexicon, not grammar+cidDo_V2 = mkCId "do_V2"+cidDo_VV = mkCId "do_VV"+cidBecome_V2 = mkCId "become_V2" +cidBecome_VA = mkCId "become_VA" ++-- for old translation+cidReflSlash = mkCId "ReflSlash"+cidSlash3V3 = mkCId "Slash3V3"+cidSlash2V3 = mkCId "Slash2V3"+cidSlashV2V = mkCId "Slash2V2"+cidComplVQ = mkCId "ComplVQ"+cidRelNP' = mkCId "RelNP'"
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances, + MultiParamTypeClasses, + ScopedTypeVariables, + FlexibleContexts, + UndecidableInstances #-}+module MonadSP ( Rule(..), Grammar, grammar+ , P, parse+ , cat, word, word2, lemma, inside, insideSuff, transform+ , many, many1, opt+ , optEat, consume, wordlookup,write+ ) where+import Data.Tree+import Data.Char+import Data.List+import qualified Data.Map as Map+import Control.Monad+import Control.Monad.State+import Control.Monad.Writer+import PGF hiding (Tree,parse)+++infix 1 :->+++data Rule m t e = t :-> P t e m e+type Grammar m t e = t -> PGF -> Morpho -> [Tree t] -> m e++instance Show t => Show (Rule m t e) where+ show (t :-> x) = show t+++grammar :: (MonadWriter [String] m,MonadState s m,Ord t,Show t,Show e) + => ([e] -> e) -> [Rule m t e] -> Grammar m t e+grammar def rules = gr + where+ gr = \tag -> do+ + let retry = \pgf m ts -> case ts of + [Node w []] -> return (def [])+ trs -> def `liftM` sequence [ gr tag pgf m trs' + | Node tag trs' <- trs]+ + case Map.lookup tag pmap of+ Just f -> \pgf m ts -> do + stored <- get + r <- unP f gr pgf m ts + case r of+ Just (e,[]) -> return e+ Just (e,xs) -> tell ["Rest parse"] >> retry pgf m ts -- use xs here?+ Nothing -> put stored >> retry pgf m ts+ Nothing -> retry ++ -- If many rules match, try all of them (mplus)+ pmap = Map.fromListWith mplus (map (\(t :-> r) -> (t,r)) rules)++newtype P t e m a = P {unP :: Grammar m t e -> PGF -> Morpho -> [Tree t] -> m (Maybe (a,[Tree t]))} ++instance Monad m => Monad (P t e m) where+ return x = P $ \gr pgf m ts -> return (Just (x,ts))+ f >>= g = P $ \gr pgf m ts -> unP f gr pgf m ts >>= \r -> case r of+ Just (x,ts') -> unP (g x) gr pgf m ts'+ Nothing -> return Nothing++instance MonadState s m => MonadPlus (P t e m) where+ mzero = P $ \gr pgf m ts -> return Nothing+ mplus f g = P $ \gr pgf m ts -> do + store <- get+ res <- unP f gr pgf m ts+ case res of+ Just x -> return (Just x)+ Nothing -> put store >> unP g gr pgf m ts+ +instance MonadState s m => MonadState s (P t e m) where+ put s = P $ \gr pgf m ts -> put s >> return (Just ((),ts))+ get = P $ \gr pgf m ts -> get >>= \s -> return (Just (s,ts))+ +instance MonadWriter w m => MonadWriter w (P t e m) where+ tell w = P $ \gr pgf m ts -> tell w >> return (Just ((),ts))+ listen = error "listen not implemented for P"+ pass = error "pass not implemented for P"+ +-- write x = tell [x]+write :: MonadWriter [w] m => w -> P t e m ()+write = tell . return++instance MonadTrans (P t e) where+ lift m = P $ \gr p morpho ts -> m >>= \r -> return (Just (r,ts))++parse :: Monad m => Grammar m t e -> PGF -> Morpho -> Tree t -> m e+parse gr pgf morpho (Node tag ts) = gr tag pgf morpho ts++silent m = (m,[])+speak s (m,w) = (m,s:w)+speaks s (m,w) = (m,s++w)+addS s m = (m,s)+add s m = (m,[s])+++cat :: (Monad m,Eq t,Show t) => [t] -> P [t] e m e+cat tag = P $ \gr pgf morpho ts ->+ case ts of+ Node tag1 ts1 : ts | tag `isPrefixOf` tag1+ -> gr tag1 pgf morpho ts1 >>= \r -> return (Just (r,ts))+ _ -> return Nothing++word :: (Monad m,Show t,Eq t) => [t] -> P [t] e m [t]+word tag = P $ \gr pgf morpho ts -> return $+ case ts of+ (Node tag1 [Node w []] : ts) | tag `isPrefixOf` tag1 + -> Just (w,ts)+ _ -> Nothing+++word2 :: (Monad m,Eq t) => t -> P t e m t+word2 tag = P $ \gr pgf morpho ts -> return $+ case ts of+ (Node tag1 [Node tag2 [Node w []]] : ts) | tag == tag1 -> Just (w,ts)+ _ -> Nothing+++inside, insideSuff :: (MonadWriter [String] m,Eq t,Show t)=> [t] -> P [t] e m a -> P [t] e m a +insideSuff = inside' isSuffixOf+inside = inside' isPrefixOf++inside' :: (MonadWriter [String] m,Eq t,Show t)=>+ ([t] -> [t] -> Bool) -> [t] -> P [t] e m a -> P [t] e m a +inside' isEq tag f = P $ \gr pgf morpho ts ->+ case ts of+ Node tag1 ts1 : ts | tag `isEq` tag1 -> do+ tell [show tag++" "++show tag1]+ unP f gr pgf morpho ts1 >>= \r -> case r of+ Just (x,[]) -> return (Just (x,ts))+ Just (x,xs) -> tell ["inside fail "++show xs] >> return Nothing+ Nothing -> return Nothing+ _ -> return Nothing+++magicLookup :: String -> String -> String -> Morpho -> PGF -> [Lemma]+magicLookup w cat0 an0 morpho pgf = [ lem + | (lem, an1) <- lookupMorpho morpho (map toLower w)+ , let cat1 = maybe "" (showType []) (functionType pgf lem)+ , cat0 == cat1 && an0 == an1+ ] ++wordlookup :: MonadWriter [String] m => String -> String -> String -> P String e m CId+wordlookup w cat0 an0 = P $ \gr pgf morpho ts -> do+ tell ["wordlookup: " ++ w ++ show ts ++ show cat0]+ let wds = magicLookup w cat0 an0 morpho pgf+ tell [show wds]+ case wds of+ (wd:_) -> return $ Just (wd,ts)+ [] -> return Nothing+ + +lemma :: MonadWriter [String] m => String -> String -> P String e m CId+lemma cat = liftM head . lemmas cat++lemmas :: MonadWriter [String] m => String -> String -> P String e m [CId]+lemmas cat0 an0 = P $ \gr pgf morpho ts -> do+ tell ["lemma: "++show ts++show cat0]+ case ts of+ Node w [] : ts -> case magicLookup w cat0 an0 morpho pgf of+ (id:ids) -> tell ["lemma ok"] >> return (Just (id:ids,ts))+ _ -> tell ["no word "++w++cat0++an0] >> return Nothing+ _ -> tell ["tried to lemma a tag"] >> return Nothing+++transform :: Monad m => ([Tree t] -> [Tree t]) -> P t e m ()+transform f = P $ \gr pgf morpho ts -> return (Just ((),f ts))++many :: MonadState s m => P t e m a -> P t e m [a]+many f = many1 f+ `mplus`+ return []++many1 :: MonadState s m => P t e m a -> P t e m [a]+many1 f = do x <- f+ xs <- many f+ return (x:xs)++opt :: MonadState s m => P t e m a -> a -> P t e m a+opt f x = mplus f (return x) ++optEat :: MonadState s m => P t e m a -> a -> P t e m a+optEat f x = mplus f (consume >> return x) +++consume :: Monad m => P t e m ()+consume = P $ \gr pgf morpho ts ->+ case ts of+ Node x w:ws -> return (Just ((),ws))+ [] -> return (Just ((),[])) +
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+module State where+import Structure+import PGF+import Data.Label ++data State = State {+ _isExist :: Bool+ , _iquant :: Bool+ , _passive :: Bool+ , _sentenceType :: SentenceType+ , _vform :: [VPForm]+ , _complement :: (VPForm,[Maybe Expr],[Bool])+ , _object :: Maybe Expr -- for objects not within the VP 'vilka äpplen äter han'+ , _tmp :: Maybe (VForm CId)+ , _anter :: Bool+ , _pol :: Maybe Bool+ , _subj :: Maybe Expr+ , _nptype :: NPType+ }++$(mkLabels [''State])++startState :: State+startState = State { + _isExist = False+ ,_passive = False+ ,_iquant = False+ ,_vform = []+ ,_complement = (V,[],[])+ ,_sentenceType = Dir + ,_object = Nothing+ ,_tmp = Nothing+ ,_anter = False+ ,_pol = Nothing+ ,_subj = Nothing+ ,_nptype = Normal}+++
@@ -0,0 +1,27 @@+module Structure where++data SentenceType = Q | Dir | Top + deriving (Show,Eq)++data NPType = Generic | Impers | Normal | Exist+ deriving (Show,Eq)++data VPForm = Cop | Sup | VV | VA + | V | V2 | V2A | V2Pass + | Fut | FutKommer+ | VS + + deriving (Eq,Show)++data VForm a+ = VInf | VPart | VSupin | VImp | VTense a+ deriving (Show,Eq)++instance Functor VForm where+ fmap f VInf = VInf+ fmap f VPart = VPart+ fmap f VSupin = VSupin+ fmap f VImp = VImp+ fmap f (VTense t) = VTense (f t)++
file too large to diff
@@ -0,0 +1,1798 @@+{-# LANGUAGE TupleSections, TypeOperators #-}+module Translate + (mapp+ ,main+ ,bigTest+ ,evaluation+ ,evaluations + ,main2 + ,mainTest+ ,mainT2 + ,testa+ ) where++import MonadSP+import Idents+import Test +import Structure+import qualified State as S+import qualified Format as Form++import Control.Arrow hiding ((<+>))+import Control.Monad+import Control.Monad.RWS hiding (gets,modify,local)+import Data.Maybe+import Data.Char+import Data.IORef+import qualified Data.Label as P +import Data.Label.PureM hiding (local)+import Data.List+import Data.Tree+import PGF hiding (parse)+import System.IO+import System.Process++-- Test by runnig mainTest. Use testGr, otherwise very slow++type PMonad = (RWS () [String] S.State)+type Translator a = P String Expr PMonad a+++test = False+usePGF = testGr --newBigGr+testGr = ("../gf/BigTest.pgf","BigTestSwe")+bigGr = ("../gf/Big.pgf","BigSwe")+newBigGr = ("../../../robust/chunk/ExtractPGF.pgf","BigParseSwe")+lang = fromJust $ readLanguage "BigTestSwe"+paint = False++tb = "../Talbanken05_20060604/FPS/P.tiger.xml"+------------------------------------------------------------------------------+-- Run functions+------------------------------------------------------------------------------+mapp f = main' f >> return ()+main = main' "test.xml" >> return ()+bigTest = do res <- main' "../testSuites/testShortSimpleTwo.xml" + writeFile "mappingShort6.txt" $ unlines (getRes res)++evaluation :: IO ()+evaluation = evaluations "EvalMappSuite2.xml" "Evalresult.txt" ++evaluations :: FilePath -> FilePath -> IO ()+evaluations test to = do + res <- main' test + writeFile to $ unlines (show (getQuote res) : getRes res)+main2 = main' "test2.xml" >> return ()+mainTest = main' "testSimple.xml" >>= putStrLn . compareRes . getRes+mainT2 = main' "testSimple.xml" >>= putStrLn . unlines . getRes++getRes :: [(Double,String)] -> [String]+getRes = map snd+getQuote :: [(Double,String)] -> Double+getQuote = fst . last ++-- Standard main+main' :: FilePath -> IO [(Double,String)]+main' fil = do+ pgf <- readPGF $ fst usePGF+ let Just language = readLanguage $ snd usePGF+ morpho = buildMorpho pgf language+ s <- fmap concat $ Form.parse fil+ print $ prune $ snd $ head s+ ref <- newIORef (0,0,0)+ mapM (process pgf morpho ref) s++ where+ process pgf morpho ref (id,t) = do+ (cn,co,l) <- readIORef ref+ let idN = takeWhile (/='_') id + putStrLn idN+ let (e,trace) = evalRWS (parse penn pgf morpho (prune t)) () S.startState+ (cn',co') = count (cn,co) e+ l' = l+1+ writeIORef ref (cn',co',l')+ when test $ putStrLn $ unlines trace+ putStrLn (showExpr [] e)+ when paint $ do+ writeFile "tmp_tree.dot" + (graphvizParseTree pgf lang e) + rawSystem "dot" ["-Tpdf", "tmp_tree.dot"+ , "-otrees/tree"++showAlign l'++"GFparsX.pdf"]+ return ()+ let quote = (fromIntegral cn' / fromIntegral co') * 100+ hPutStrLn stderr (show quote)+ return (quote,idN++"\t"++showExpr [] e)++ count (cn,co) e = cn `seq` co `seq`+ case unApp e of+ Just (f,es) -> if f == meta+ then foldl' count (cn, co+1) es+ else foldl' count (cn+1,co+1) es+ Nothing -> (cn+1,co+1)+++ + prune (Node tag ts)+ | tag == "ROOT" + && not (null ts)+ && last ts == Node "." [Node "." []] = Node tag (init ts)+ | otherwise = Node tag ts++showAlign :: Show a => a -> String+showAlign n =+ replicate (5 - length s) '0' ++ s+ where+ s = show n+++------------------------------------------------------------------------------+-- The grammar : Rules for converting labels+------------------------------------------------------------------------------++penn :: Grammar (RWS () [String] S.State) String Expr+penn =+ grammar (mkApp meta)+ ["ROOT" :-> do s <- inside "MS" $ cat "S"+ `mplus` cat "XP"+ write "root found"+ return s + + ,"S" :-> do write "start" + conj <- maybeParse $ inside "++" pPConj+ subj <- maybeParse $ cat "UK"+ (s,s2) <- pS+ m_voc <- maybeParse (do opt (word2 "IK") ""+ inside "TT" pNP)+ opt (word2 "IP" `mplus`+ word2 "I?" `mplus`+ word2 "IG" `mplus`+ word2 "IU") ""+ S.subj =: subj+ let pconj = fromMaybe (mkExpr cidNoPConj) conj+ voc = fromMaybe (mkExpr cidNoVoc) m_voc+ return $ mkApp cidPhrUtt [pconj, s,voc]++ ,"AP" :-> do write "in AP"+ ad <- inside "AA" pAdA+ write ("found adA: "++show ad)+ a <- inside "HD" pAdj+ write ("found adj: "++show a)+ return $ mkApp cidAdAP [ad,a]+ <+>+ do as <- many $ inside "AA" pAdAdj+ a2 <- inside "HD" pAdj + return (foldr (\ada ap -> mkApp cidAdAP [ada,ap]) a2 as)+ + ,"AVP" :-> --bland annat, just nu, t ex, i kontakt... + do iadv <- inside "HD" pIAdv+ adv <- pAdv+ return $ mkApp cidAdvIAdv [iadv, adv]+ <+>+ do consume+ return (mkExpr meta)+ -- ,"CAVP" :-> coordinated AVP + ,"CAP" :-> conjunct cidConsAP cidBaseAP cidConjAP pAdj++ ,"NP" :-> pflatNP+ + ,"PP" :-> do pr <- write "PP!" >> inside "PR" pPrep+ write "prep found"+ np <- pflatNP <+> inside "HD" pNP + <+> cat "PA" -- this is for deep trees+ write "prep noun found"+ returnApp cidPrepNP [pr,np]+ ,"VP" :-> do write "in cat VP"+ word2 "IM" + v <- pVP "IV"+ write $ "VP returns " ++ show v+ return v ++ -- untranslatables+ ,"XX" :-> do n <- maybeParse pNP + let e = fromMaybe (mkExpr meta) n + write ("xx returns "++show e)+ return $ mkApp meta [e]+ ,"XP" :-> do write "xp!" + x <- cat "XX"+ write "xp found noun"+ a <- pAdv + write "xp found adv "+ opt (word2 "IP") ""+ return $ mkApp meta [x,a]++ ,"CNP" :-> conjunct cidConsNP cidBaseNP cidConjNP pflatNP + ,"CPP" :-> conjunct cidConsAdv cidBaseAdv cidConjAdv (cat "PP")+ ,"CONJP" :-> conjunct meta meta meta (pflatNP <+> cat "PP" <+> pAdj)+ ,"CVP" :-> conjunct cidConsVPS cidBaseVPS cidConjVPS (cat "VP")+ ,"CS" :-> conjunct cidConsS cidBaseS cidConjS (cat "S")+ ,"CXP" :-> conjunct meta meta meta (cat "XP") + --,"NAC" :-> (consume >> return (mkExpr meta))++ -- labels ----+ ,"++" :-> pPConj+ ,"+A" :-> pPredet+ ,"+F" :-> cat "S"+ ,"AA" :-> pAA+ ,"AG" :-> pSpecialPP cidBy8agent_Prep+ ,"AN" :-> pAppos+ ,"AT" :-> pAdj+ ,"CA" :-> pPredet+ ,"DT" :-> pQuant <+> pIQuant <+> pPredet + <+> (fst3 <$> pN2)+ ,"EF" :-> parseRelS+ ,"EO" :-> cat "VP"+ ,"ES" :-> pNP + ,"FO" :-> pItPron + ,"FS" :-> fst <$> pFS+ ,"FV" :-> msum (map pSlashVP vForms)+ ,"IV" :-> pVP "IV" + ,"KA" :-> cat "S"+ ,"MA" :-> inAdv+ ,"MD" :-> cat "NP" <+> cat "PP"+ ,"NA" :-> return (mkExpr cidPNeg)+ ,"OA" :-> cat "PP" <+> cat "VP"+ ,"OO" :-> cat "S" <+> cat "VP" + <+> pAdj+ <+> cat "NP"+ ,"PL" :-> pPart "V" -- could be all sorts of verbs+ ,"PR" :-> pPrep+ ,"RA" :-> inAdv+ ,"SP" :-> do a <- pAdj + <+>+ pAdA + write ("adj return"++show a)+ returnApp cidCompAP [a]+ <+>+ do e <- pNP+ write ("coplua np "++show e)+ returnApp cidCompNP [e]+ <+>+ do e <- cat "PP"+ returnApp cidCompAdv [e]+ <+>+ do consume+ return (mkExpr meta) --we know we are in SP, so ok to consume+ ,"SS" :-> pNP <+> pflatNP <+> cat "NP"+ ,"TA" :-> inAdv+ ,"TT" :-> pNP+ ,"UK" :-> pConj <+> pSubj+ ,"VA" :-> inAdv+ ,"VO" :-> cat "VP"+ ,"VS" :-> cat "VP"+ ,"XA" :-> cat "PP" -- så att säga+ ,"BS" :-> cat "S" + ,"CJ" :-> cat "S" <+> cat "PP" <+> cat "VP" --first conjunct+ <+> pAdj <+> pflatNP+ ,"C+" :-> cat "S" <+> cat "PP" <+> cat "VP" --second conjuct+ <+> pAdj <+> pflatNP+ ,"CC" :-> cat "S" <+> cat "PP" <+> cat "VP" --sister conjuct+ <+> pAdj <+> pflatNP+ ,"HD" :-> (pCN >>= \(a,b,c) -> return (mkApp meta [a,mkExpr b])) <+> pAdj <+> pIAdv <+> pNP+ ,"IF" :-> pVP "IV" -- for deep trees+ ,"PA" :-> pflatNP <+> pNP -- for deep trees+ <+> cat "VP" <+> cat "S" + <+> cat "NP" <+> cat "CNP"+ + ,"VG" :-> cat "VP" -- for deep trees++ -- Not translated:+ -- punctuation: I?,"IC","ID","IG","IK","IM", "IO", "IP", "IQ", "IR", "IS", "IT", "IU",+ -- punctuation: , "JC", "JG", "JR", "JT",+ -- ,"ET" :-> cat "PP"+ -- ,"DB" + -- ,"MS" :-> cat "S"+ --,"ST" paragraph+ --,"PT" cant parse 'sjálv'+ --,"XF" :-> XP+ --,"XT" -- sa kallad+ --,"XX" unclassifiable + --,"YY" :-> inside "YY" (lemma "ja,jo" "") --fix!!+ ] ++cats :: [String] -> Translator Expr +cats tags = msum [cat c | c <- tags]+objCat :: Translator ()+objCat = msum [pCompl t | t <- vForms ]++advsCat :: Translator Expr+advsCat = pAdv+++(<$>) = liftM+a <+> b = mplus a b+infixr 2 <+>+infixr 3 <$>++clType :: CId -> CId+clType typ | typ==cidQuestVP = cidUseQCl+ | otherwise = cidUseCl+utType :: SentenceType -> CId+utType typ | typ==Q = cidUttQS+ | otherwise = cidUttS++parseSCl :: Translator Expr+parseSCl = inside "S" pCl++pS :: Translator (Expr,Maybe Expr)+pS = do+ cl <- do cl <- pCl + write "found cl"+ utt <- gets S.sentenceType+ return $ mkApp (utType utt) [cl] + <+>+ do write "to imperative"+ pImp + <+>+ do write "to SS"+ pSS+ <+>+ do cl <- pUttAdv+ return $ mkApp cidUttAdv [cl]+ s2 <- maybeParse $ inside "+F" (optEat (cat "S") (mkExpr meta))+ let cl1 = maybe cl (\x -> mkApp meta [x]) s2 + return (cl1,s2)+++pNPCl :: Translator Expr+pNPCl = do + np <- parseSubject+ return $ mkApp cidUttNP [np]++pCl :: Translator Expr+pCl = questCl <+> questVP <+> normalCl <+> advCl <+> iadvCl <+> topCl+ where normalCl = do -- jag äter äpplen+ S.sentenceType =: Dir+ np <- pSubject+ write "try normalCl, found np"+ vp <- pVP "FV"+ advs <- many advsCat+ (temp,pol) <- getTmpPol+ nptyp <- gets S.nptype+ let e0 = foldr (\ad e -> mkApp cidAdvVP [e,ad]) vp advs+ e1 = constructCl nptyp np e0+ e2 = mkApp cidUseCl [temp,pol,e1]+ return e2+ advCl = do -- nu äter jag äpplen+ S.sentenceType =: Top + write "try advCl"+ advs <- pAdv + write "try advCl, found adv"+ write "will do FV"+ vp <- pVSO "FV" + np <- gets S.subj+ advs' <- many advsCat+ (temp,pol) <- getTmpPol+ nptyp <- gets S.nptype+ guard $ isJust np+ let e0 = foldr (\ad e -> mkApp cidAdvVP [e,ad]) vp advs'+ cl = constructCl nptyp (fromJust np) e0+ c = mkApp cidTopAdv [advs,cl]+ e1 = mkApp cidUseTop [temp, pol, c ]+ return e1+ iadvCl = do -- när äter jag äpplen+ S.sentenceType =: Q+ iadv <- cats ["RA","TA","AB"]+ write "try iadvCl, found iadv"+ iquant <- gets S.iquant+ guard iquant + vp <- pVSO "FV" + np <- gets S.subj+ advs <- many advsCat+ (temp,pol) <- getTmpPol+ nptyp <- gets S.nptype+ guard $ isJust np+ let e0 = foldr (\ad e -> mkApp cidAdvVP [e,ad]) vp advs+ cl = constructCl nptyp (fromJust np) e0+ c = mkApp cidQuestIAdv [iadv,cl]+ e1 = mkApp cidUseQCl [temp, pol,c ]+ return e1+ questCl = do -- vilka äpplen är godast? / vem har du sett?+ S.sentenceType =: Q+ ip <- inside "SP" parseIP + write "try questcl, found ip"+ vp <- pVSO "FV" + np <- gets S.subj+ guard $ isJust np+ (temp,pol) <- getTmpPol+ let quest = mkApp cidQuestSlash [ip,mkApp cidSlashVP [fromJust np,vp]] + return $ mkApp cidUseQCl [temp,pol,quest]+ questVP = do -- vilka får vara med + ip <- inside "SS" parseIP + write "try questvp, found ip"+ vp <- pVP "FV"+ (temp,pol) <- getTmpPol+ let quest = mkApp cidQuestVP [ip,vp] + S.sentenceType =: Q+ return $ mkApp cidUseQCl [temp,pol,quest]+ topCl = do+ S.sentenceType =: Top+ (vp,cop) <- do vp <- pOVS "FV" Cop + return (vp,True)+ <+>+ do vp <- msum $ map (pOVS "FV") (Cop `delete` vForms)+ return (vp,False)+ np <- gets S.subj+ obj <- gets S.object+ (temp,pol) <- getTmpPol+ guard $ isJust obj+ guard $ isJust np+ let top = if cop then cidTopAP else cidTopObj+ cl = mkApp top [fromJust obj,mkApp cidSlashVP [fromJust np,vp]]+ e1 = mkApp (clType cidUseTop) [temp,pol,cl ]+ return e1 +++getTmpPol :: Translator (Expr,Expr)+getTmpPol = do+ tmp <- gets S.tmp+ pol <- gets S.pol+ ant <- gets S.anter+ let temp = maybe (mkExpr meta) (mkTmp ant) (isVTense tmp)+ return (temp,mkPol pol)+ + ++parseIP :: Translator Expr+parseIP = do p <- inside "PO" (lemma "IP" "s NPNom"+ <+>+ lemma "IP" "s NPAcc" )+ return (mkExpr p)++pSS :: Translator Expr+pSS = + do s1 <- cat "S" -- jag går om hon kommer+ s2 <- cat "S"+ conj <- gets S.subj+ let sub = fromMaybe (mkExpr meta) conj+ return $ mkApp cidSSubjS [s1,sub,s2] ++pSubject :: Translator Expr+pSubject = cat "SS" <+> cat "FV"++pObj :: Translator ()+pObj = msum $ map pCompl vForms+pObject :: Translator ()+pObject = do --a plain object+ obj <- inside "OO" (word "POXPHH" >> return (Just $ mkExpr meta))+ <+>+ do write "look for np in oo"+ liftM Just (inside "OO" pNP)+ <+>+ do write "look for np in sp"+ liftM Just (inside "SP" pNP)+ <+>+ do o <- inside "OA" (cat "PP") + return (Just $ mkApp meta [o]) + <+> + do det <- inside "FO" pItPron -- funnit det attraktivt att (VP)+ a <- pAdj+ vp <- inside "EO" $ cat "VP" + return (Just $ mkApp meta [det,mkApp meta [a,vp]])+ <+> + do inside "IO" $ word "POXPHH" + return (Just $ mkExpr cidReflIdPron) -- sig+ <+>+ liftM Just (inside "ES" pNP)+ S.object =: obj+++pImp :: Translator Expr+pImp = do write "in imperative"+ vp <- pVP "FV"+ write "found vp in imp"+ tmp <- gets S.tmp+ pol <- gets S.pol+ guard (tmp==Just VImp)+ write "vp in imp is ok"+ advs <- many pAdv+ write ("advs found: "++show advs)+ let e0 = foldr (\ad e -> mkApp cidAdvVP [e,ad]) vp advs+ imp = mkApp cidImpVP [e0] + return $ mkApp cidUttImpPol [mkPol pol,imp]++-- "att det inte regnar"+pUttAdv :: Translator Expr+pUttAdv = do + sub <- inside "UK" pSubj + np <- cat "SS" <+> cat "FS" + typ <- gets S.nptype+ write ("SS done for UttAdv"++show np)+ write "now to pVP"+ pol <- pPol+ v <- parseFV+ objCat+ advs <- many pAdv+ tmp <- gets S.tmp+ ant <- gets S.anter+ vp <- constructVP v+ let e0 = foldr (\ad e -> mkApp cidAdvVP [e,ad]) vp advs+ e1 = constructCl typ np e0+ e2 = mkApp cidUseCl [maybe (mkExpr meta) (mkTmp ant) (isVTense tmp)+ ,mkPol pol,e1]+ return $ mkApp cidSubjS [sub,e2]++parseFV :: Translator Expr+parseFV = do+ write "In parseFV"+ write "checked word in parseFV"+ v <- cat "FV"+ p <- maybeParticle "FV"+ write "FV checks tmp "+ return v++parseRelS :: Translator Expr+parseRelS = do + old <- putStateToZero+ rcl <- pRelS+ resetState old+ return rcl+++pRelS :: Translator Expr+pRelS = do+ w <- inside "S" $ inside "SS" $ word "PO" + guard (w =="Som" || w == "som")+ parseTheVP <+> parseTheCl+ where parseTheVP = do+ pol <- pPol+ v <- parseFV+ pObj + vp <- constructVP v+ mkRelCl pol $ mkApp cidRelVP [mkExpr cidIdRP,vp]+ parseTheCl = do+ S.object =: Just (mkExpr meta) -- to indicate that there already is an object (outside+ -- of the relative clause) 'pojken som jag ser'+ np <- pSubject+ pol <- pPol + v <- parseFV+ pObj+ vp <- constructVP v+ mkRelCl pol $ mkApp cidRelSlash [mkExpr cidIdRP,mkApp cidSlashVP [np,vp]]++ mkRelCl pol cl = do+ tmp <- gets S.tmp+ ant <- gets S.anter+ let t = maybe (mkExpr meta) (mkTmp ant) (isVTense tmp)+ return (mkApp cidUseRCl [t,mkPol pol,cl])++++constructCl :: NPType -> Expr -> Expr -> Expr+constructCl typ np vp = + if typ == Generic || typ == Impers+ then mkApp (toCid typ) [vp]+ else mkApp cidPredVP [np,vp]+ where toCid Generic = cidGenericCl+ toCid Impers = cidImpersCl+ toCid _ = meta++pSpecialPP :: CId -> Translator Expr+pSpecialPP cid = + do pr <- inside "PR" $ optEat (lemma "Prep" "s") meta+++ write "prep found"+ guard (pr==cid)+ np <- pflatNP+ return $ mkApp cidPrepNP [mkExpr pr,np]++isVSupin :: VForm CId -> Bool+isVSupin VSupin = True+isVSupin _ = False++isVTense :: Maybe (VForm CId) -> Maybe CId +isVTense (Just (VTense t)) = Just t+isVTense _ = Nothing++isVTenseForm :: CId -> VForm CId -> Bool+isVTenseForm a (VTense t) = t == a +isVTenseForm _ _ = False+++vForms :: [VPForm]+vForms = [Cop,Sup,Fut,FutKommer,VV,VA,V2A,V2,V2Pass,VS,V]+gfvForms :: [String]+gfvForms = ["VV","VA","V2A","V2","VS","V","V3"]++pSlashVP :: VPForm -> Translator Expr+pSlashVP form = do+ write "in pSlashVP"+ (t,v,f) <- case form of + V -> do (t,v) <- pVerb "VV" "V"+ write "found a pVerb of type V"+ return (t,mkExpr v,V)+ VV -> third VV <$> pVV+ V2 -> third V2 <$> pV2Act+ V2A -> do (t,v) <- pVerb "VV" "V2A"+ return (t,mkExpr v,V2A)+ Cop -> do t <- pCopula + return (t,mkExpr meta,Cop)+ Sup -> do t <- pHave+ return (t,mkExpr meta,Sup)+ VA -> do third VA <$> pVA+ Fut -> do t <- pFuturum+ write "found future form"+ return (t,mkExpr meta,Fut)+ VS -> do (t,v) <- pVerb "VV" "VS"+ return (t,mkExpr v,VS)+ V2Pass -> third V2Pass <$> (inside "VV" pExist+ <+> pV2Pass)+ FutKommer -> do t <- pFuturumKommer+ return (t,mkExpr meta,FutKommer)+ S.tmp =: Just t+ S.anter =: (f==Sup)+ modify S.vform (V:)+ return v++mkTmp :: Bool -> CId -> Expr+mkTmp False = mkTmp' cidASimul +mkTmp True = mkTmp' cidAAnter ++mkTmp' :: CId -> CId -> Expr+mkTmp' a t | a ==cidASimul = mkApp cidTTAnt [mkExpr t,mkExpr cidASimul] + | a ==cidAAnter = mkApp cidTTAnt [mkExpr t,mkExpr cidAAnter] ++pVP :: String -> Translator Expr+pVP typ = do+ write $ "doing pVP "++show typ+ msum [do v <- inside typ (pSlashVP x)+ write $ "found IV "++show v+ S.sentenceType =: Dir+ localKeepPol (do+ pCompl x + write $ "pVP have succeeded to parse for typ "++show x+ constructVP v)+ | x <- vForms]+++pVSO :: String -> Translator Expr+pVSO cat = msum $ map (pVSOCat cat) vForms++pVSOCat :: String -> VPForm -> Translator Expr+pVSOCat cat typ = do+ v <- inside cat $ pSlashVP typ + np <- write "looking for SS" >> parseSubject+ write ("pVSO found np "++show np)+ S.subj =: Just np + localKeepPol (pCompl typ >> constructVP v)++pOVS :: String -> VPForm -> Translator Expr+pOVS cat Cop = do+ write "try OVS copula"+ pObject --huset+ write "found compl in OVS Cop" + v <- inside cat $ pSlashVP Cop+ advs <- many pAdv + np <- write "looking for SS" >> parseSubject+ write ("pOVS found np "++show np)+ advs1 <- many pAdv + let np1 = foldr (\ad e -> mkApp cidAdvNP [ad, e]) np (advs++advs1)+ S.subj =: Just np1+ S.sentenceType =: Top + constructVP v+ return v++pOVS cat typ = do --huset målar han rött+ write "try OVS"+ pObject --huset+ v <- inside cat $ pSlashVP typ --målar+ write $ "found compl in OVS "++show typ+ np <- write "looking for SS" >> parseSubject --han+ write ("pOVS found np "++show np)+ S.subj =: Just np + S.sentenceType =: Top + localKeepPol (do pCompl typ --rött+ constructVP v)+ return v+++pInfVP :: Translator (Bool,Expr)+pInfVP = + do write "att v?"+ im <- opt (word2 "IM" >> return True) False+ write $ "infinite marker? "++ show im+ v <- pVP "IV" <+> inside "IF" (pVP "IV")+ return (im,v)+ +constructVP :: Expr -> Translator Expr+constructVP v = do+ (vtyp,exps,bs) <- gets S.complement+ o <- gets S.object+ styp <- gets S.sentenceType+ advs1 <- many pAdv + write $ "in constructVP, will combine for " ++ show vtyp+ vp <- pComplVP vtyp styp v (exps,bs)+ write $ "in constructVP, have combined for " ++ show vtyp+ return $ foldr (\ad e -> mkApp cidAdvVP [ad, e]) vp advs1+ +pComplVP :: VPForm -> SentenceType -> Expr -> ([Maybe Expr],[Bool]) + -> Translator Expr+pComplVP V q vp (exps,_) = do + comp <- getComplement V q exps + (fo,adv,part,adv1) <- case comp of+ (fo:a:p:a1:_) -> return (fo,a,p,a1)+ _ -> argErr "V"+ let vp0 = fromMaybe vp part + vp1 = mkApp cidUseV [vp0]+ vp2 = maybe vp1 (\a -> mkApp cidAdvVP [vp1,a]) adv + vp3 = maybe vp2 (\a -> mkApp cidAdvVP [vp2,a]) adv1+ write ("particle "++show part++" verb "++show vp)+ return $ maybe vp3 (\fob -> mkApp meta [vp3,fob]) fo++pComplVP VA q vp (exps,_) = do + comp <- getComplement VA q exps+ (fo,adv,a) <- case comp of+ (fo:a:Just aj:_) -> return (fo,a,aj)+ _ -> argErr "VA"+ let vp1 = maybe vp (\a -> mkApp cidAdvVPSlash [vp,a]) adv + vp2 = if q==Dir then mkApp cidComplVA [vp1,a]+ else vp1+ when (q/=Dir) $ S.object =: Just a+ return $ maybe vp2 (\fob -> mkApp meta [vp2,fob]) fo++pComplVP VV q vp (exps,bs) = do+ comp <- getComplement VV q exps+ (fo,adv,iv,p) <- case comp of+ (fo:a:Just i:p':_) -> return (fo,a,i,p')+ _ -> argErr "VV"+ let vv0 = if bs==[True] then mkApp cidDropAttVV [vp] else vp+ vv1 = fromMaybe vv0 p + vv2 = maybe vv1 (\a -> mkApp cidAdvVP [vv1,a]) adv + vv3 = if q==Dir then mkApp cidComplVV [vv2,iv] else vv2+ when (q/=Dir) $ S.object =: Just iv + return $ maybe vv3 (\fob -> mkApp meta [vv3,fob]) fo++pComplVP V2 q vp (exps,_) = do+ comp <- getComplement V2 q exps+ (fo,adv,obj,part) <- case comp of+ (fo:a:o:p:[]) -> return (fo,a,o,p) + _ -> argErr "V2"+ let combineVP =+ let vp0 = mkApp cidComplSlash [vp,fromJust obj]+ in maybe vp0 (\a -> mkApp cidAdvVP [vp0,a]) adv + slashedVP = maybe vp (\a -> mkApp cidAdvVPSlash [vp,a]) adv + vp1 = if q/=Dir || isNothing obj then slashedVP else combineVP + return $ maybe vp1 (\fob -> mkApp meta [vp1,fob]) fo++pComplVP V2A q vp (exps,_) = do+ comp <- getComplement V2A q exps+ (fo,adv,obj,adj) <- case comp of + (fo:a:o:Just aj:p:_) -> return (fo,a,o,aj)+ _ -> argErr "V2A"+ let slashVP = mkApp cidSlashV2A [vp,adj]+ case obj of+ Just o -> do+ let vp0 = maybe slashVP (\a -> mkApp cidAdvVPSlash [slashVP,a]) adv + vp1 = mkApp cidComplSlash [vp0,o]+ return $ maybe vp1 (\fob -> mkApp meta [vp1,fob]) fo+ Nothing -> do let vp1 = maybe slashVP (\a -> mkApp cidAdvVPSlash [vp,a]) adv + return $ maybe vp1 (\fob -> mkApp meta [vp1,fob]) fo++pComplVP V2Pass q vp (exps,_) = do+ comp <- getComplement V2Pass q exps+ (fo,adv1,agent,eo,adv2) <- case comp of+ (fo:a:g:e:a2:p_) -> return (fo,a,g,e,a2)+ + _ -> argErr "V2Pass"+ let vp' = foldr (\a vp -> mkApp cidAdvVP [vp,a]) vp + $ catMaybes [adv1,agent,adv2]+ vp3 = maybe vp' (\a -> mkApp meta [a]) eo + return $ maybe vp3 (\fob -> mkApp meta [vp3,fob]) fo++pComplVP Sup q vp (exps,bs) = do+ comp <- getComplement Sup q exps+ (fo,adv,sup) <- case comp of+ (fo:a:Just s:_) -> return (fo,a,s)+ _ -> argErr "Sup"+ pass <- gets S.passive+ let + vp1 = maybe sup (\a -> mkApp cidAdvVPSlash [sup,a]) adv + useV = if bs == [True] || not pass then cidUseV else cidPassV2+ S.anter =: True + S.passive =: False+ let vp2 = mkApp useV [vp1]+ return $ maybe vp2 (\fob -> mkApp meta [vp2,fob]) fo++pComplVP Cop q vp (exps,_) = do+ comp <- getComplement Cop q exps+ (adv,sp) <- case comp of+ (a:s:_) -> return (a,s)+ _ -> argErr "Cop"+ write ("copula sp "++ show sp)+ case sp of+ Just o -> do+ let cop = mkApp cidUseComp [o]+ vp1 = maybe cop (\a -> mkApp cidAdvVPSlash [cop,a]) adv + return vp1+ Nothing -> return $+ maybe (mkApp meta []) (\a -> mkApp meta [a]) adv ++pComplVP Fut q vp (exps,_) = do+ comp <- getComplement Fut q exps+ (fo,adv,v) <- case comp of+ (fo:a:Just s:_) -> return (fo,a,s)+ _ -> argErr "Fut"+ let vp1 = maybe v (\a -> mkApp cidAdvVPSlash [v,a]) adv + write ("fut compl: "++show vp1)+ return $ maybe vp1 (\fob -> mkApp meta [vp1,fob]) fo++pComplVP FutKommer q vp (exps,_) = do+ comp <- getComplement FutKommer q exps+ (fo,adv,vp0) <- case comp of+ (fo:a:Just s:_) -> return (fo,a,s)+ _ -> argErr "FutKommer"+ let vp1 = maybe vp0 (\a -> mkApp cidAdvVPSlash [vp0,a]) adv + return $ maybe vp1 (\fob -> mkApp meta [vp1,fob]) fo+ +pComplVP VS q vp (exps,_) = do+ comp <- getComplement VS q exps+ (fo,adv,s) <- case comp of+ (fo:a:Just s:_) -> return (fo,a,s)+ _ -> argErr "VS"+ let vp0 = if q==Dir then mkApp cidComplVS [vp,s] + else vp+ vp1 = maybe vp0 (\a -> mkApp cidAdvVP [vp1,a]) adv+ when (q/=Dir) $ S.object =: Just s+ return $ maybe vp1 (\fob -> mkApp meta [vp1,fob]) fo++getComplement :: VPForm -> SentenceType -> [Maybe Expr] -> Translator [Maybe Expr]+getComplement v q exps = return exps++argErr :: String -> Translator a+argErr s = do+ write ("wrong number of arguments to pCompl "++ s)+ mzero++pPart :: String -> Translator Expr+pPart v = do+ p <- do write "part right!!"+ inside "AB" (lemma v "part")+ <+>+ do write "part" + inside "PR" (lemma v "part") + return (mkExpr p)+++pVV :: Translator (VForm CId,Expr)+pVV = do+ (t,v) <- tryVerb "FV" cidGet_VV "VV" + <+>+ tryVerb "WV" cidWant_VV "VV"+ <+>+ do write "looking for can"+ tryVerb "QV" cidCan_VV "VV"+ <+>+ tryVerb "MV" cidMust_VV "VV"+ <+>+ pVerb "VV" "VV"+ write ("VV returns tense "++show t)+ return (t,mkExpr v)++pVA :: Translator (VForm CId,Expr)+pVA = do+ (t,v) <- tryVerb "BV" cidBecome_VA "VA"+ <+>+ pVerb "FV" "VA" + write ("VA returs tense "++show t)+ return (t,mkExpr v)+++pV2Act :: Translator (VForm CId,Expr)+pV2Act = do + (t,v) <- do t <- pHave+ return (t,mkExpr cidHave_V2) + <+>+ do (t,v) <- do write "in pV2"+ pVerb "VV" "V2"+ <+> + do write "får är i farten"+ tryVerb "FV" cidGet_V2 "V2"+ <+>+ tryVerb "GV" cidDo_V2 "V2"+ <+>+ tryVerb "GV" cidDo_VV "VV"+ <+>+ tryVerb "BV" cidBecome_V2 "V2"+ return (t,mkExpr v)+ return (t,mkApp cidSlashV2a [v]) ++pV2Pass :: Translator (VForm CId,Expr)+pV2Pass = do+ (t,v) <- pPassVerb "VV" "V2"+ <+>+ tryVerb "GV" cidDo_V2 "V2"+ <+>+ tryVerb "FV" cidGet_V2 "V2"+ return (t,mkApp cidPassV2 [mkExpr v])++pExist :: Translator (VForm CId,Expr)+pExist =+ do lemma "NP -> Cl" "s SPres Simul Pos Main"+ return (VTense cidTPres,mkExpr cidExistNP)+ <+>+ do lemma "NP -> Cl" "s SPret Simul Pos Main"+ return (VTense cidTPast,mkExpr cidExistNP)+ <+>+ do lemma "NP -> Cl" "s SPres Anter Pos Main"+ <+>+ lemma "NP -> Cl" "s SPret Anter Pos Main"+ return (VSupin,mkExpr cidExistNP)++tryVerb :: String -> CId -> String -> Translator (VForm CId,CId)+tryVerb tag cid cat =+ do t <- tense tag+ write ("tryVerb "++tag) + return (t,cid) + <+>+ do write "no tense found"+ pVerb tag cat++pVerb :: String -> String -> Translator (VForm CId, CId)+pVerb x y = write ("in pVerb "++x++" "++y) >> pVerb' "Act" x y++pPassVerb :: String -> String -> Translator (VForm CId, CId)+pPassVerb = pVerb' "Pass"++pVerb' :: String -> String -> String -> Translator (VForm CId, CId)+pVerb' act incat cat =+ do v <- (inside incat $ lemma cat $ "s (VF (VPres "++act++"))")+ <+>+ (inside incat $ lemma "V" $ "s (VF (VPres "++act++"))")+ return (VTense cidTPres,v)+ <+>+ do v <- (inside incat $ lemma cat $ "s (VF (VImper "++ act++"))")+ <+>+ (inside incat $ lemma "V" $ "s (VF (VImper "++ act++"))")+ return (VImp,v)+ <+>+ do v <- (inside incat $ lemma cat $ "s (VI (VInfin "++ act++"))")+ <+>+ (inside incat $ lemma "V" $ "s (VI (VInfin "++ act++"))")+ return (VInf,v)+ <+>+ do v <- (inside incat $ lemma cat $ "s (VF (VPret "++ act++"))")+ <+>+ (inside incat $ lemma "V" $ "s (VF (VPret "++ act++"))")+ return (VTense cidTPast,v)+ <+>+ do v <- (inside incat $ lemma cat $ "s (VI (VSupin "++ act++"))")+ <+>+ (inside incat $ lemma "V" $ "s (VI (VSupin "++ act++"))")+ return (VSupin,v)+ +maybeVerbAdv :: Translator (Maybe Expr)+maybeVerbAdv = maybeParse pAdv ++maybeParticle :: String -> Translator (Maybe Expr)+maybeParticle = maybeParse . inside "PL" . pPart ++metaVerb :: (VForm a,CId)+metaVerb = (VInf,meta)++pCompl :: VPForm -> Translator ()+pCompl Cop = do+ write "copula compl begins"+ pol <- pPol+ adv <- maybeParse $ pAdvMinus ["RA"]+ write $ "copula found adv"++show adv+ sp <- hasMovedObj+ <+>+ Just <$> cat "SP"+ <+>+ do write "copula looking for adv2"+ a <- pAdv+ write "copula found adv2"+ return $ Just $ mkApp cidCompAdv [a]+ S.complement =: (Cop,[adv,sp],[])+ S.pol =: pol++pCompl Sup = do+ write "supinum compl begins"+ fo <- maybeParse $ cat "FO"+ pol <- pPol+ adv <- maybeVerbAdv+ (t',sup,useV) <- inside "IV" $ + do (t,s) <- msum [pVerb "TP" v | v <- gfvForms] + <+>+ inside "TP" (consume >> return (VSupin,meta))+ <+>+ msum [pVerb "VVSN" v | v <- gfvForms] + return (t,s,True) + <+> + do (t,s) <- msum [pPassVerb "VVSN" v | v <- gfvForms] + return (t,s,False) + guard (isVSupin t') + S.passive =: not useV+ S.pol =: pol+ S.complement =: (Sup,[fo,adv,Just $ mkExpr sup],[useV])++pCompl V2 = do+ write "v2 compl begins"+ (pol,fo,adv,part) <- pV2Compl+ obj <- hasMovedObj + <+>+ inside "OO" (word "POXPHH" >> return (Just $ mkExpr meta))+ <+>+ do write "look for np in oo"+ liftM Just (inside "OO" pNP)+ <+>+ do write "look for np in sp"+ liftM Just (inside "SP" pNP)+ <+>+ do o <- inside "OA" (cat "PP") + return (Just $ mkApp meta [o])+ <+> + do det <- inside "FO" pItPron + a <- pAdj+ vp <- inside "EO" $ cat "VP" + return (Just $ mkApp meta [det,mkApp meta [a,vp]]) + <+> + do inside "IO" $ word "POXPHH" + return Nothing -- sig+ <+>+ liftM Just (inside "ES" pNP)+ write "oo ok"+ S.pol =: pol+ S.complement =: (V2,[fo,adv,obj,part],[])++pCompl V2A = do+ write "v2a compl begins"+ (pol,fo,adv,part) <- pV2Compl+ obj <- hasMovedObj+ <+>+ do inside "OO" $ word "POXPHH" + return Nothing -- sig+ <+>+ liftM Just (inside "OO" pNP)+ <+>+ liftM Just (inside "SP" pNP)+ <+>+ do o <- inside "OA" (cat "PP" <+> cat "VP") + return (Just $ mkApp meta [o])+ <+> + do inside "IO" $ word "POXPHH" + return Nothing -- sig+ adj <- inside "OO" pAdj+ write "oo ok"+ S.pol =: pol+ S.complement =: (V2A,[fo,adv,obj,Just adj,part],[])++pCompl V2Pass = do+ write "v2pass compl begins"+ fo <- maybeParse $ cat "FO"+ pol <- pPol+ adv1 <- maybeVerbAdv+ eo <- maybeParse $ cat "ES" + part <- maybeParticle "V2" + write ("particle: "++show part)+ ag <- maybeParse $ inside "AG" $ pSpecialPP cidBy8agent_Prep+ adv2 <- maybeVerbAdv+ write "agent ok"+ S.pol =: pol+ S.complement =: (V2Pass,[fo,adv1,ag,eo,adv2,part],[])++pCompl VV = do+ write "vv compl begins"+ (pol,fo,adv,part) <- pV2Compl + (im,iv) <- do write "look for infinite verb"+ (im,v) <- inside "OO" (inside "VP" pInfVP)+ <+>+ (write "inf2" >> pInfVP)+ return (im,v) + <+>+ do write "looking for weird verb phrase complement for vv"+ iv <- inside "OO" (inside "NAC" $ pVP "IV")+ return (False,iv) + <+>+ do write "looking for complete verb phrase complement for vv"+ v <- inside "OA" $ cat "VP"+ return (True,v) + <+>+ do write "looking for VV in VP"+ v <- inside "VG" $ cat "VP" + return (True,v) + write ("iv found "++show iv)+ write "iv ok"+ p <- maybeParticle "VV"+ write ("particle: "++show p)+ S.pol =: pol+ S.complement =: (VV,[fo,adv,Just iv,p],[im])++pCompl VA = do+ write "va compl begins"+ fo <- maybeParse $ cat "FO"+ pol <- pPol+ adv <- maybeVerbAdv+ a <- inside "SP" (pAdj <+> cat "CNP")+ S.pol =: pol+ S.complement =: (VA,[fo,adv,Just a],[])++pCompl V = do+ write "v-simple compl begins"+ pol <- pPol+ fo <- maybeParse $ cat "FO"+ adv <- maybeVerbAdv+ p <- maybeParticle "V"+ write ("particle: "++show p)+ adv1 <- maybeParse $ inside "OA" $ cat "PP"+ S.pol =: pol+ S.complement =: (V,[fo,adv,p,adv1],[])++pCompl Fut = do+ write "futurum compl begins"+ fo <- maybeParse $ cat "FO"+ pol <- pPol+ adv <- maybeVerbAdv+ iv <- pVP "IV" + write ("comlpfut "++show iv)+ S.pol =: pol+ S.complement =: (Fut,[fo,adv,Just iv],[])++pCompl FutKommer = do+ write "futurum compl begins 'komma att'"+ fo <- maybeParse $ cat "FO"+ pol <- pPol+ word2 "IM"+ adv <- maybeVerbAdv+ iv <- pVP "IV" + S.pol =: pol+ S.complement =: (FutKommer,[fo,adv,Just iv],[])++pCompl VS = do+ write "VS compl "+ (pol,fo,adv,part) <- pV2Compl + adv <- maybeVerbAdv+ s <- inside "OO" $ cat "S" + write "s in vs ok"+ S.pol =: pol + S.complement =: (VS,[fo,adv,Just s],[])++hasMovedObj :: Translator (Maybe a)+hasMovedObj = do+ moved <- isJust <$> gets S.object+ guard moved+ return Nothing ++pV2Compl :: Translator (Maybe Bool,Maybe Expr,Maybe Expr,Maybe Expr)+pV2Compl = do+ fo <- maybeParse $ cat "FO" + pol <- pPol+ write "oo pol ok"+ adv <- maybeVerbAdv+ part <- maybeParticle "V2"+ write ("particle: "++show part)+ return (pol,fo,adv,part)++maybeParse :: Translator a -> Translator (Maybe a)+maybeParse = flip opt Nothing . (Just <$>) ++pflatNP :: Translator Expr+pflatNP =+ do write "in NP with Adj"+ typ <- gets S.sentenceType+ m_predet <- maybeParse $ inside "+A" pPredet+ <+>+ inside "CA" pPredet+ <+>+ inside "DT" pPredet+ m_det <- if typ==Q then S.iquant =: True >> Just <$> inside "DT" pIQuant+ else maybeParse (inside "DT" pQuant)+ <+>+ maybeParse (inside "DT" pDetRefl)+ m_n2 <- maybeParse $ inside "DT" pN2 -- 'antal'+ m_a <- maybeParse $ inside "AT" pAdj+ (noun,n,def) <- inside "HD" pCN+ m_pt <- maybeParse $ inside "PT" consume --'själv'+ et <- many $ inside "ET" $ cat "PP"+ m_app <- maybeParse $ inside "AN" pAppos+ m_relCl <- maybeParse $ do opt (word2 "IK") ""+ inside "EF" parseRelS+ write "start putting together np"+ opt (word2 "IP") ""+ t <- gets S.sentenceType+ let + cn0 = maybe noun (\x -> mkApp meta [noun,mkExpr meta]) m_pt -- kvinnan själv'+ cn1 = case m_a of+ Just a -> mkApp cidAdjCN [a,mkApp cidUseN [cn0]]+ Nothing -> mkApp cidUseN [cn0]+ cn2 = maybe cn1 (\rs -> mkApp cidRelCN [cn1,rs]) m_relCl ++ num = mkExpr n+ d = fromMaybe (mkApp (getCId t cidDetQuant) [mkExpr cidDefArt,num]) m_det+ cn3 = maybe cn2 (\app -> mkApp cidApposCN [cn2,app]) m_app+ np0 <- case (def,m_det) of+ (NDef,_) -> returnApp cidDetCN [d + ,cn3]+ (NIndef,Nothing) -> if n == cidNumSg + then returnApp cidMassNP [cn3]+ else returnApp cidDetCN + [mkApp cidDetQuant + [mkExpr cidIndefArt,num],cn3]+ (NIndef,Just d) -> returnApp cidDetCN [d,cn3]+ (NOther,_) -> do guard (isNothing m_predet && isNothing m_det) + return noun + t <- gets S.sentenceType+ let np' = maybe np0 (\(n2,num,def) -> mkApp (getCId t cidDetCN)+ [mkApp cidDetQuant [def,num]+ ,mkApp cidComplN2 [n2,np0]]) m_n2+ np1 = maybe np' (\p -> mkApp (getCId t cidPredetNP) [p,np']) m_predet+ res = foldr (\e n -> mkApp (getCId t cidAdvNP) [n,e]) np1 et + write $ "will return np" ++ show res+ return res+ <+>+ do (noun,n,def) <- inside "HD" pCN+ guard $ def == NIndef && n == cidNumSg + num <- pNumber+ returnApp cidCNNumNP [mkApp cidUseN [noun],num]+ <+>+ do w1 <- inside "AA" $ word "ABFA"+ w2 <- inside "HD" $ word "POZP"+ guard (map toLower w1 == "hur" && map toLower w2 == "mycket")+ S.iquant =: True+ returnApp cidhow8much_IAdv []+ ++-- returns (word :: Expr, number :: CId, determined :: NounForm)+pCN :: Translator (Expr,CId,NForm)+pCN = + inside "VN" pNoun+ <+>+ do n <- inside "NN" (optEat pNoun metaNoun) + write ("pCN gives NN "++show n) >> return n+ <+>+ inside "AN" pNoun+ <+>+ do w <- inside "POCP" consume -- varandra, reciprokt! ej i GF+ return (mkExpr meta,cidNumPl,NOther)+ <+>+ do write "test for particip"+ (part,num,def) <- inside "SP" findNParticip+ return (part,num,def)+ <+>+ do write "test for category X"+ w <- inside "PO" (lemma "PronAQ" "s (AF (APosit (Strong GPl)) Nom)")+ return (mkApp cidQuantPronAQ [mkExpr w],cidNumPl,NIndef)+ <+>+ do word "NNDD"+ return (mkExpr meta,cidNumSg,NDef) --may be plural...+ <+>+ do write "testing last pCN"+ word "NN"+ return (mkExpr meta,cidNumSg,NIndef)+ + +pNoun,pNounGen :: Translator (Expr,CId,NForm)+pNoun = pNoun' "Nom"+pNounGen = pNoun' "Gen"++pNoun' :: String -> Translator (Expr,CId,NForm)+pNoun' nom = + do n <- lemma "N" ("s Pl Indef "++nom)+ return (mkExpr n,cidNumPl,NIndef)+ <+> do+ n <- lemma "N" ("s Sg Indef "++nom)+ return (mkExpr n,cidNumSg,NIndef)+ <+> do+ n <- lemma "N" ("s Sg Def "++nom)+ return (mkExpr n,cidNumSg,NDef)+ <+> do+ n <- lemma "N" ("s Pl Def "++ nom)+ return (mkExpr n,cidNumPl,NDef)+++metaNoun :: (Expr, CId, NForm)+metaNoun = (mkExpr meta,cidNumSg,NIndef)+data NForm = NDef | NIndef | NOther -- NOther for reciprocs etc + deriving (Eq,Show)++getDef :: NForm -> CId+getDef NDef = cidDefArt+getDef NIndef = cidIndefArt+getDef NOther = meta+++parseSubject :: Translator Expr+parseSubject = inside "SS" (optEat pNP (mkExpr meta)) + <+> + do (n,typ) <- inside "FS" pFS+ S.nptype =: typ+ return n+ +pFS :: Translator (Expr,NPType)+pFS =+ do w <- inside "PO" $ lemma "VP -> Cl" "s SPres Simul Pos Main"+ write "imperson hittad!!"+ return (mkExpr w,Impers)+ <+>+ do w <- inside "PO" $ lemma "NP -> Cl" "s SPres Simul Pos Inv"+ return (mkExpr w,Exist)++pItPron :: Translator Expr+pItPron = + do p <- inside "POOP" $ lemma "Pron" "s Per3 NPNom"+ return $ mkExpr p+ +pPN :: Translator Expr+pPN = do n <- inside "PN" $ optEat (lemma "PN" "s Nom") cidName+ return $ mkExpr n+pNP :: Translator Expr+pNP = + cat "NP" + <+> + (S.sentenceType =: Dir >> cat "AP") + <+> + do write "look for name"+ name <- pPN+ S.sentenceType =: Dir+ return (mkApp cidUsePN [name])+ <+>+ do w <- inside "POTP" $ lemma "NP" "s Per3 NPNom"+ S.sentenceType =: Dir+ return (mkExpr w)+ <+>+ do+ w <- inside "PO" $ lemma "Pron" "s Per3 NPNom" + write "lemma ok"+ S.sentenceType =: Dir+ return (mkApp cidUsePron [mkExpr w])+ <+>+ do w <- inside "PO" $ lemma "VP -> Cl" "s SPres Simul Pos Main"+ write "Man hittad!!"+ S.nptype =: Generic+ S.sentenceType =: Dir+ return (mkExpr w)+ <+>+ do det <- pQuant+ S.sentenceType =: Dir+ return (mkApp cidDetNP [det])++ <+>+ do np <- pflatNP+ S.sentenceType =: Dir+ return np+ <+>+ do write "in complicated np"+ (n,num,def) <- pCN + let cn = mkApp cidUseN [n]+ nums = mkExpr num+ t <- gets S.sentenceType+ e0 <- case def of+ NDef -> returnApp cidDetCN + [mkApp (getCId t cidDetQuant)+ [mkExpr cidDefArt, nums],cn]+ NIndef -> if num==cidNumPl then return cn+ else return (mkApp cidMassNP [cn])+ NOther -> return n -- och guards!!+ S.sentenceType =: Dir+ return e0+ +pAdj :: Translator Expr+pAdj = + do ad <- inside "AJKP" $ optEat (lemma "A" "s (AF ACompar Nom)") meta+ return $ mkApp cidUseComparA [mkExpr ad] + <+>+ do ad <- findAdj+ return $ mkApp cidPositA [ad]+ <+>+ do ad <- findA2+ return $ mkApp cidUseA2 [ad]+ <+>+ do write "will check AP"+ cat "AP"+ <+>+ cat "CAP" + <+>+ -- this can only be used as Comp+ do a <- inside "PO" $ lemma "PronAQ" "s (AF (APosit (Strong GPl)) Nom)"+ return $ mkApp cidCompPronAQ [mkExpr a]+ <+>+ do a <- inside "TP" $ optEat findAPerfParticip meta+ return (mkApp cidVPSlashAP [mkExpr a]) + +findAdj :: Translator Expr+findAdj = + do ad <- inside "AJ" (optEat findA meta)+ <+>+ do write "looking for particip adjective"+ inside "SP" findA+ return $ mkExpr ad+ where findA = lemma "A" adjSN + <+> lemma "A" adjSU+ <+> lemma "A" adjWSg+ <+> lemma "A" adjWPl+++findA2 :: Translator Expr+findA2 = + do ad <- inside "AJ" (lemma "A2" "s (AF (APosit (Strong (GSg Neutr))) Nom)")+ <+>+ inside "AJ" (lemma "A2" "s (AF (APosit (Strong (GSg Utr))) Nom)")+ <+>+ inside "AJ" (lemma "A2" "s (AF (APosit (Strong GPl)) Nom)")+ return $ mkExpr ad+++findNParticip :: Translator (Expr,CId,NForm)+findNParticip = pNoun +++findAPerfParticip :: Translator CId+findAPerfParticip = + lemma "V" "s (VI (VPtPret (Strong (GSg Utr)) Nom))"+ <+>+ lemma "V" "s (VI (VPtPret (Strong (GSg Neutr)) Nom))"+ <+>+ lemma "V" "s (VI (VPtPret (Strong GPl) Nom))"+ <+>+ lemma "V2" "s (VI (VPtPret (Strong (GSg Utr)) Nom))"+ <+>+ lemma "V2" "s (VI (VPtPret (Strong (GSg Neutr)) Nom))"+ <+>+ lemma "V2" "s (VI (VPtPret (Strong GPl) Nom))"+ <+>+ lemma "VV" "s (VI (VPtPret (Strong (GSg Utr)) Nom))"+ <+>+ lemma "VV" "s (VI (VPtPret (Strong (GSg Neutr)) Nom))"+ <+>+ lemma "VV" "s (VI (VPtPret (Strong GPl) Nom))"+ <+>+ lemma "VS" "s (VI (VPtPret (Strong (GSg Utr)) Nom))"+ <+>+ lemma "VS" "s (VI (VPtPret (Strong (GSg Neutr)) Nom))"+ <+>+ lemma "VS" "s (VI (VPtPret (Strong GPl) Nom))"++pAdA :: Translator Expr+pAdA = inside "AB" $ do a <- lemma "A" "s (AF (APosit (Strong (GSg Neutr))) Nom)"+ return (mkApp cidPositAdAAdj [mkApp a[]])+ <+>+ do ada <- optEat (lemma "AdA" "s") meta+ return (mkExpr ada)++adv :: [String]+adv = ["RA","TA","MA","+A","CA","VA"]++pAdv :: Translator Expr+pAdv = pAdv' adv ++pAdvMinus,pAdv' :: [String] -> Translator Expr+pAdvMinus xs = pAdv' $ adv \\ xs++pAdv' xs = + msum [ inside x inAdv | x <- xs]+ <+>+ do write "looking for adv in AA1"+ inside "AA" pAA+ +inAdv :: Translator Expr+inAdv = findAdverb <+> cat "PP" <+> cat "NP" <+> cat "AVP"++pAA :: Translator Expr+pAA = cat "PP" + <+> pAdvAdj + <+> pAdv+ <+> findAdverb+ <+> inside "S" pUttAdv+ <+> cat "AVP"++pIAdv :: Translator Expr+pIAdv =+ msum [ inside x (cat "AVP") | x <- ["RA","TA"]]+ <+>+ do write "making a question"+ a <- inside "AB" $ lemma "IAdv" "s"+ return $ mkExpr a+ ++findAdverb :: Translator Expr+findAdverb = do+ a <- inside "AB" $ optEat (lemma "Adv" "s Per3") meta+ write $ "adverb found "++show a+ return (mkExpr a) + +pAdvAdj :: Translator Expr+pAdvAdj = do+ a <- findAdj+ return $ mkApp cidPositAdvAdj [a]+ +pAdAdj :: Translator Expr+pAdAdj = liftM (\a -> mkApp cidPositAdAAdj [a]) findAdj ++pIQuant :: Translator Expr+pIQuant = inside "PO" piq+ where piq = + do dt <- lemma "IQuant" "s Sg Utr" + <+>+ lemma "IQuant" "s Sg Neutr"+ write ("det: "++show dt)+ returnApp cidDetQuant [mkExpr dt,mkExpr cidNumSg] + <+>+ do dt <- lemma "IQuant" "s Pl Utr"+ <+>+ lemma "IQuant" "s Pl Neutr"+ write ("det: "++show dt)+ returnApp cidDetQuant [mkExpr dt,mkExpr cidNumPl] ++pQuant :: Translator Expr+pQuant =+ do w <- word "PODP" -- to avoid this_Quant when it should be DefArt+ let den = map toLower w+ guard (den=="den" || den=="det") + returnApp cidDetQuant [mkExpr cidDefArt,mkExpr cidNumSg]+ <+> + inside "PO" ( --+ do dt <- lemma "Quant" "s Per3 Sg False False Utr" + <+> lemma "Quant" "s Per3 Sg False False Neutr"+ write ("det: "++show dt)+ returnApp cidDetQuant [mkExpr dt,mkExpr cidNumSg] + <+>+ do dt <- lemma "Quant" "s Per3 Pl False False Utr"+ <+> + lemma "Quant" "s Per3 Pl False False Neutr"+ write ("det: "++show dt)+ returnApp cidDetQuant [mkExpr dt,mkExpr cidNumPl]) + <+>+ -- no case for singular+ do w <- inside "PO" $ lemma "PronAQ" "s (AF (APosit (Strong GPl)) Nom)"+ return $ mkApp cidDetQuant [mkApp cidQuantPronAQ [mkExpr w],mkExpr cidNumPl]+ <+>+ do dt <- inside "PO" $ lemma "Pron" "s Per3 (NPPoss GPl Nom)"+ return $ mkApp cidDetQuant [mkApp cidPossPron [mkExpr dt],mkExpr cidNumPl]+ <+>+ do dt <- inside "PO" $ lemma "Det" "s Per3 False Utr"+ write ("det: "++show dt)+ return $ mkExpr dt + <+>+ do dt <- inside "PO" $ mplus (lemma "Pron" "s Per3 (NPPoss (GSg Neutr) Nom)")+ (lemma "Pron" "s Per3 (NPPoss (GSg Utr) Nom)")+ return $ mkApp cidDetQuant [mkApp cidPossPron [mkExpr dt],mkExpr cidNumSg]+ <+>+ do n <- pNumber + return $ mkApp cidDetQuant [mkExpr cidIndefArt,mkApp cidNumCard [n]]+ <+>+ do inside "EN" $ mplus (lemma "Quant" "s Per3 Sg False False Utr")+ (lemma "Quant" "s Per3 Sg False False Neutr")+ return $ mkApp cidDetQuant [mkExpr cidIndefArt,mkExpr cidNumSg]+ <+>+ do n <- pNumber + return $ mkApp cidDetQuant [mkExpr cidIndefArt,mkApp cidNumCard [n]]+ <+>+ do p <- inside "POXPHHGG" $ lemma "Pron" "s Per3 (NPPoss (GSg Utr) Nom)"+ return $ mkApp cidDetQuant [mkApp cidPossPron [mkExpr p]]+ <+>+ -- genitiv nouns+ do (n,num,def) <- insideSuff "GG" pNounGen+ let dt = mkApp cidDetQuant [mkExpr (getDef def),mkExpr num] + np = mkApp cidDetCN [dt,mkApp cidUseN [n]]+ return $ mkApp cidDetQuant [mkApp cidGenNP [np]] + ++++pDetRefl :: Translator Expr+pDetRefl = + do word "POXP" + write "setting it to true"+ return (mkExpr cidReflIdPron) +++pN2 :: Translator (Expr,Expr,Expr)+pN2 = + do np <- cat "NP"+ return (np,mkExpr cidNumSg, mkExpr cidDefArt) + <+>+ inside "NNDD" (do n <- lemma "N2" "s Pl Def Nom"+ return (mkExpr n,mkExpr cidNumPl,mkExpr cidDefArt)+ <+>+ do n <- lemma "N2" "s Sg Def Nom" + return (mkExpr n,mkExpr cidNumSg,mkExpr cidDefArt) + <+>+ do n <- lemma "N2" "s Sg Indef Nom" + return (mkExpr n,mkExpr cidNumSg,mkExpr cidIndefArt) + <+>+ do n <- lemma "N2" "s Pl Indef Nom"+ return (mkExpr n,mkExpr cidNumPl,mkExpr cidIndefArt))++pAppos :: Translator Expr+pAppos = do inside "XP" consume + return (mkExpr meta)++pPConj :: Translator Expr+pPConj = + do s <- inside "++" $ lemma "PConj" "s"+ return (mkExpr s)+ <+>+ do s <- inside "++" $ lemma "Conj" "s2"+ return (mkApp cidPConjConj [mkExpr s])++pConj :: Translator Expr+pConj = + do word "++OC"+ return $ mkExpr cidAndConj+ <+>+ do word "++EL"+ return $ mkExpr cidOrConj+ <+>+ do s <- inside "++" $ lemma "Conj" "s2"+ return (mkExpr s)+ +pSubj :: Translator Expr+pSubj = do + s <- inside "UK" $ optEat (lemma "Subj" "s") meta+ return $ mkExpr s ++pCopula, pHave :: Translator (VForm CId)+pCopula = write "copula?" >> tense "AV"+pHave = write "have" >> tense "HV" ++pFuturum :: Translator (VForm CId)+pFuturum = do write "futurum?"+ t <- tense "SV"+ write ("futurum: "++show t)+ if isVTenseForm cidTPres t then return (VTense cidTFut)+ else return (VTense cidTCond) -- ?++pFuturumKommer :: Translator (VForm CId)+pFuturumKommer = do+ t <- tense "KV"+ write ("futurum kom att: "++show t)+ return (VTense cidTFutKommer)+ +tense :: String -> Translator (VForm CId)+tense cat =+ do word $ cat++"IV" + return VInf+ <+>+ do word $ cat++"PK" + return VPart+ <+>+ do word $ cat++"PS"+ write "presens"+ return (VTense cidTPres)+ <+>+ do word $ cat++"PT"+ return (VTense cidTPast)+ <+>+ do word $ cat++"SN" + return VSupin+ <+>+ do word $ cat++"IP"+ return VPart + +pPrep :: Translator Expr+pPrep = do write "in pPrep"+ p <- inside "PR" $ optEat (lemma "Prep" "s") meta+ return $ mkExpr p++pPredet :: Translator Expr+pPredet = + do w <- findPredet+ return $ mkExpr w + <+> parsePredetAdv++ where findPredet = do w <- word "PO"+ let wd = map toLower w+ guard (wd /="den" && wd /="det")+ write "in pPredet with PO"+ wordlookup w "Predet" "s Neutr Pl"+ <+>+ wordlookup w "Predet" "s Utr Pl"+ <+>+ wordlookup w "Predet" "s Utr Sg"+ <+>+ wordlookup w "Predet" "s Neutr Sg"+ parsePredetAdv = inside "AB" $ do + w <- lemma "Adv" "s"+ return (mkApp cidPredetAdvF [mkExpr w])+++ +++-- translate all numers to 1. could also be NumNumeral ( num (pot... n1))+pNumber :: Translator Expr+pNumber = + inside "RO" $ do consume+ return $ mkApp cidNumDigits + [mkApp cidIDig + [mkExpr cidD_1]] ++pPol :: Translator (Maybe Bool)+pPol =+ do w <- cat "NA"+ return (Just False)+ <+>+ return (Just True)++listOf :: Translator a -> Translator [a]+listOf f = + many $ do+ a <- inside "CJ" f + word2 "IK"+ return a++conjunct :: CId -> CId -> CId -> Translator Expr -> Translator Expr+conjunct consf basef conjf f =+ do xs <- listOf f+ write $ "found list of " ++show xs+ x1 <- inside "CJ" f+ write $ "found first conj " ++show x1+ conj <- inside "++" pConj + write $ "found conj " ++show conj + x2 <- inside "CJ" f+ write $ "found snd conj " ++show x2+ let compXs x y = mkApp consf [x,y]+ conjs = foldr compXs (mkApp basef [x1,x2]) xs+ return $ mkApp conjf [conj, conjs]+++adjSN, adjSU, adjSPl, adjWPl, adjWSg :: String+adjSN = "s (AF (APosit (Strong (GSg Neutr))) Nom)"+adjSU = "s (AF (APosit (Strong (GSg Utr))) Nom)"+adjSPl = "s (AF (APosit (Strong GPl)) Nom)"+adjWPl = "s (AF (APosit (Weak Pl)) Nom)"+adjWSg = "s (AF (APosit (Weak Sg)) Nom)" ++meta :: CId+meta = mkCId "?"++mkExpr :: CId -> Expr+mkExpr x = mkApp x []++mkPol :: Maybe Bool -> Expr+mkPol (Just True) = mkExpr cidPPos +mkPol (Just False) = mkExpr cidPNeg +mkPol Nothing = mkExpr meta +++returnApp :: CId -> [Expr] -> Translator Expr+returnApp cid exs = do+ t <- gets S.sentenceType+ return $ mkApp (getCId t cid) exs ++localKeepPol :: Translator a -> Translator a+localKeepPol m = do+ (x,st) <- local m+ S.pol =: P.get S.pol st+ return x++local :: Translator a -> Translator (a,S.State)+local m = do + st <- get+ x <- m+ loc <- get+ put st+ return (x,loc)+++--For embedded clauses where the state should be cleared and later reset+putStateToZero :: Translator S.State+putStateToZero = do+ st <- get+ put S.startState+ return st++resetState :: S.State -> Translator ()+resetState = put++getCId :: SentenceType -> CId -> CId+getCId Q c | c == cidCompNP = cidCompIP+ | c == cidCompAdv = cidCompIAdv+ | c == cidDetCN = cidIdetCN+ | c == cidDetQuant = cidIdetQuant+ | c == cidPrepNP = cidPrepIP+getCId _ c = c+ +fst3 :: (a,b,c) -> a+fst3 (a,_,_) = a+third :: a -> (VForm CId,Expr) -> (VForm CId,Expr,a)+third x = uncurry (,,x)++testa :: String -> IO [(Lemma, Analysis, String)]+testa str = do+ pgf <- readPGF "../gf/BigTest.pgf"+ let Just language = readLanguage "BigTestSwe"+ morpho = buildMorpho pgf language+ return [(lemma,an,cat) | (lemma,an) <- lookupMorpho morpho str+ ,let cat = maybe "" (showType []) (functionType pgf lemma)]+