added bnfc-generated testgf3 files
This commit is contained in:
aarne committed
1 parent
bc77ad3163
commit
674b4765e6
6 files changed
+4336
-2
No files matched your search
@@ -0,0 +1,274 @@
|
||||
module GF.Devel.Compile.AbsGF where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
newtype PIdent = PIdent ((Int,Int),String) deriving (Eq,Ord,Show)
|
||||
newtype LString = LString String deriving (Eq,Ord,Show)
|
||||
data Grammar =
|
||||
Gr [ModDef]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModDef =
|
||||
MModule ComplMod ModType ModBody
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModType =
|
||||
MAbstract PIdent
|
||||
| MResource PIdent
|
||||
| MGrammar PIdent
|
||||
| MInterface PIdent
|
||||
| MConcrete PIdent PIdent
|
||||
| MInstance PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModBody =
|
||||
MBody Extend Opens [TopDef]
|
||||
| MNoBody [Included]
|
||||
| MWith Included [Open]
|
||||
| MWithBody Included [Open] Opens [TopDef]
|
||||
| MWithE [Included] Included [Open]
|
||||
| MWithEBody [Included] Included [Open] Opens [TopDef]
|
||||
| MReuse PIdent
|
||||
| MUnion [Included]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Extend =
|
||||
Ext [Included]
|
||||
| NoExt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Opens =
|
||||
NoOpens
|
||||
| OpenIn [Open]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Open =
|
||||
OName PIdent
|
||||
| OQual PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ComplMod =
|
||||
CMCompl
|
||||
| CMIncompl
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Included =
|
||||
IAll PIdent
|
||||
| ISome PIdent [PIdent]
|
||||
| IMinus PIdent [PIdent]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data TopDef =
|
||||
DefCat [CatDef]
|
||||
| DefFun [FunDef]
|
||||
| DefFunData [FunDef]
|
||||
| DefDef [Def]
|
||||
| DefData [DataDef]
|
||||
| DefPar [ParDef]
|
||||
| DefOper [Def]
|
||||
| DefLincat [Def]
|
||||
| DefLindef [Def]
|
||||
| DefLin [Def]
|
||||
| DefPrintCat [Def]
|
||||
| DefPrintFun [Def]
|
||||
| DefFlag [Def]
|
||||
| DefPrintOld [Def]
|
||||
| DefLintype [Def]
|
||||
| DefPattern [Def]
|
||||
| DefPackage PIdent [TopDef]
|
||||
| DefVars [Def]
|
||||
| DefTokenizer PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Def =
|
||||
DDecl [Name] Exp
|
||||
| DDef [Name] Exp
|
||||
| DPatt Name [Patt] Exp
|
||||
| DFull [Name] Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FunDef =
|
||||
FDecl [Name] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data CatDef =
|
||||
SimpleCatDef PIdent [DDecl]
|
||||
| ListCatDef PIdent [DDecl]
|
||||
| ListSizeCatDef PIdent [DDecl] Integer
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DataDef =
|
||||
DataDef Name [DataConstr]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DataConstr =
|
||||
DataId PIdent
|
||||
| DataQId PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ParDef =
|
||||
ParDefDir PIdent [ParConstr]
|
||||
| ParDefAbs PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ParConstr =
|
||||
ParConstr PIdent [DDecl]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Name =
|
||||
PIdentName PIdent
|
||||
| ListName PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data LocDef =
|
||||
LDDecl [PIdent] Exp
|
||||
| LDDef [PIdent] Exp
|
||||
| LDFull [PIdent] Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Exp =
|
||||
EPIdent PIdent
|
||||
| EConstr PIdent
|
||||
| ECons PIdent
|
||||
| ESort Sort
|
||||
| EString String
|
||||
| EInt Integer
|
||||
| EFloat Double
|
||||
| EMeta
|
||||
| EEmpty
|
||||
| EData
|
||||
| EList PIdent Exps
|
||||
| EStrings String
|
||||
| ERecord [LocDef]
|
||||
| ETuple [TupleComp]
|
||||
| EIndir PIdent
|
||||
| ETyped Exp Exp
|
||||
| EProj Exp Label
|
||||
| EQConstr PIdent PIdent
|
||||
| EQCons PIdent PIdent
|
||||
| EApp Exp Exp
|
||||
| ETable [Case]
|
||||
| ETTable Exp [Case]
|
||||
| EVTable Exp [Exp]
|
||||
| ECase Exp [Case]
|
||||
| EVariants [Exp]
|
||||
| EPre Exp [Altern]
|
||||
| EStrs [Exp]
|
||||
| EPatt Patt
|
||||
| EPattType Exp
|
||||
| ESelect Exp Exp
|
||||
| ETupTyp Exp Exp
|
||||
| EExtend Exp Exp
|
||||
| EGlue Exp Exp
|
||||
| EConcat Exp Exp
|
||||
| EAbstr [Bind] Exp
|
||||
| ECTable [Bind] Exp
|
||||
| EProd Decl Exp
|
||||
| ETType Exp Exp
|
||||
| ELet [LocDef] Exp
|
||||
| ELetb [LocDef] Exp
|
||||
| EWhere Exp [LocDef]
|
||||
| EEqs [Equation]
|
||||
| EExample Exp String
|
||||
| ELString LString
|
||||
| ELin PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Exps =
|
||||
NilExp
|
||||
| ConsExp Exp Exps
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Patt =
|
||||
PChar
|
||||
| PChars String
|
||||
| PMacro PIdent
|
||||
| PM PIdent PIdent
|
||||
| PW
|
||||
| PV PIdent
|
||||
| PCon PIdent
|
||||
| PQ PIdent PIdent
|
||||
| PInt Integer
|
||||
| PFloat Double
|
||||
| PStr String
|
||||
| PR [PattAss]
|
||||
| PTup [PattTupleComp]
|
||||
| PC PIdent [Patt]
|
||||
| PQC PIdent PIdent [Patt]
|
||||
| PDisj Patt Patt
|
||||
| PSeq Patt Patt
|
||||
| PRep Patt
|
||||
| PAs PIdent Patt
|
||||
| PNeg Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattAss =
|
||||
PA [PIdent] Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Label =
|
||||
LPIdent PIdent
|
||||
| LVar Integer
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Sort =
|
||||
Sort_Type
|
||||
| Sort_PType
|
||||
| Sort_Tok
|
||||
| Sort_Str
|
||||
| Sort_Strs
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Bind =
|
||||
BPIdent PIdent
|
||||
| BWild
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Decl =
|
||||
DDec [Bind] Exp
|
||||
| DExp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data TupleComp =
|
||||
TComp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattTupleComp =
|
||||
PTComp Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Case =
|
||||
Case Patt Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Equation =
|
||||
Equ [Patt] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Altern =
|
||||
Alt Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DDecl =
|
||||
DDDec [Bind] Exp
|
||||
| DDExp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data OldGrammar =
|
||||
OldGr Include [TopDef]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Include =
|
||||
NoIncl
|
||||
| Incl [FileName]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FileName =
|
||||
FString String
|
||||
| FPIdent PIdent
|
||||
| FSlash FileName
|
||||
| FDot FileName
|
||||
| FMinus FileName
|
||||
| FAddId PIdent FileName
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
@@ -0,0 +1,26 @@
|
||||
-- BNF Converter: Error Monad
|
||||
-- Copyright (C) 2004 Author: Aarne Ranta
|
||||
|
||||
-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
|
||||
module GF.Devel.Compile.ErrM where
|
||||
|
||||
-- the Error monad: like Maybe type with error msgs
|
||||
|
||||
import Control.Monad (MonadPlus(..), liftM)
|
||||
|
||||
data Err a = Ok a | Bad String
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
instance Monad Err where
|
||||
return = Ok
|
||||
fail = Bad
|
||||
Ok a >>= f = f a
|
||||
Bad s >>= f = Bad s
|
||||
|
||||
instance Functor Err where
|
||||
fmap = liftM
|
||||
|
||||
instance MonadPlus Err where
|
||||
mzero = Bad "Err.mzero"
|
||||
mplus (Bad _) y = y
|
||||
mplus x _ = x
|
||||
@@ -0,0 +1,343 @@
|
||||
{-# OPTIONS -fglasgow-exts -cpp #-}
|
||||
{-# LINE 3 "GF/Devel/Compile/LexGF.x" #-}
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||
module GF.Devel.Compile.LexGF 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\x15\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x18\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x45\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x27\x00\x00\x00\x13\x00\x00\x00\x9c\x00\x00\x00\x6c\x01\x00\x00\x3c\x02\x00\x00\x0c\x03\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x17\x01\x00\x00\xe7\x01\x00\x00\xd5\x00\x00\x00\x35\x00\x00\x00\xe7\x00\x00\x00\xf2\x00\x00\x00\x1d\x01\x00\x00\xc2\x01\x00\x00\xcc\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\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\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\x0d\x00\x0e\x00\x1a\x00\x0e\x00\x0e\x00\x0e\x00\xff\xff\x17\x00\x0e\x00\x0e\x00\x0f\x00\x10\x00\x0e\x00\x05\x00\x0e\x00\x0e\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x0e\x00\x0e\x00\x0e\x00\x11\x00\x0e\x00\x0e\x00\x0e\x00\x04\x00\xff\xff\xff\xff\x02\x00\x02\x00\x09\x00\x09\x00\x09\x00\x0a\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x0e\x00\x0e\x00\x16\x00\x16\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0e\x00\x0e\x00\xff\xff\x12\x00\xff\xff\x0d\x00\x20\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x09\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0e\x00\x0e\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\x06\x00\x07\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1b\x00\xff\xff\x00\x00\x00\x00\x14\x00\x1b\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\xff\xff\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x21\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1c\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\xff\xff\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x19\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\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x1c\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x14\x00\xLine truncated
|
||||
|
||||
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\x2d\x00\x0a\x00\x0a\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2a\x00\x3e\x00\x2b\x00\x27\x00\x27\x00\xff\xff\xff\xff\x3e\x00\xff\xff\xff\xff\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\xff\xff\xff\xff\x2d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x7d\x00\x7d\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\xd7\x00\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\x22\x00\xf7\x00\xff\xff\xff\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x0a\x00\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\x22\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\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\xLine truncated
|
||||
|
||||
alex_deflt :: AlexAddr
|
||||
alex_deflt = AlexA# "\x13\x00\xff\xff\x03\x00\x03\x00\xff\xff\xff\xff\x0b\x00\xff\xff\x0b\x00\x0b\x00\x0b\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x18\x00\xff\xff\x1b\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
|
||||
|
||||
alex_accept = listArray (0::Int,34) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[(AlexAcc (alex_action_7))],[],[],[],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[],[],[]]
|
||||
{-# LINE 36 "GF/Devel/Compile/LexGF.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_PIdent !String
|
||||
| T_LString !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_PIdent s) -> s
|
||||
PT _ (T_LString 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 "lin" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "let" N N)))) (b "resource" (b "oper" (b "lintype" (b "lindef" (b "lincat" N N) N) (b "open" (b "of" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "type" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" 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_3 = tok (\p s -> PT p (TS $ share s))
|
||||
alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s))
|
||||
alex_action_5 = tok (\p s -> PT p (eitherResIdent (T_LString . share) s))
|
||||
alex_action_6 = tok (\p s -> PT p (eitherResIdent (TV . share) s))
|
||||
alex_action_7 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s))
|
||||
alex_action_8 = tok (\p s -> PT p (TI $ share s))
|
||||
alex_action_9 = 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 -> AlexReturn a
|
||||
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
|
||||
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
|
||||
case new_s of
|
||||
-1# -> (new_acc, input)
|
||||
-- on an error, we want to keep the input *before* the
|
||||
-- character that failed, not after.
|
||||
_ -> 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
|
||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,481 @@
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||
module GF.Devel.Compile.PrintGF where
|
||||
|
||||
-- pretty-printer generated by the BNF converter
|
||||
|
||||
import GF.Devel.Compile.AbsGF
|
||||
import 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
|
||||
"[" :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
|
||||
|
||||
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 Integer where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
|
||||
instance Print Double where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
|
||||
|
||||
instance Print PIdent where
|
||||
prt _ (PIdent (_,i)) = doc (showString i)
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
|
||||
instance Print LString where
|
||||
prt _ (LString i) = doc (showString i)
|
||||
|
||||
|
||||
|
||||
instance Print Grammar where
|
||||
prt i e = case e of
|
||||
Gr moddefs -> prPrec i 0 (concatD [prt 0 moddefs])
|
||||
|
||||
|
||||
instance Print ModDef where
|
||||
prt i e = case e of
|
||||
MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print ModType where
|
||||
prt i e = case e of
|
||||
MAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
|
||||
MResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
|
||||
MGrammar pident -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 pident])
|
||||
MInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
|
||||
MConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
|
||||
MInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
|
||||
|
||||
|
||||
instance Print ModBody where
|
||||
prt i e = case e of
|
||||
MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
|
||||
MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
|
||||
MWith included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
|
||||
MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
|
||||
MWithE includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
|
||||
MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
|
||||
MReuse pident -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 pident])
|
||||
MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
|
||||
|
||||
|
||||
instance Print Extend where
|
||||
prt i e = case e of
|
||||
Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])
|
||||
NoExt -> prPrec i 0 (concatD [])
|
||||
|
||||
|
||||
instance Print Opens where
|
||||
prt i e = case e of
|
||||
NoOpens -> prPrec i 0 (concatD [])
|
||||
OpenIn opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
|
||||
|
||||
|
||||
instance Print Open where
|
||||
prt i e = case e of
|
||||
OName pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
OQual pident0 pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 pident0 , doc (showString "=") , prt 0 pident , 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 ComplMod where
|
||||
prt i e = case e of
|
||||
CMCompl -> prPrec i 0 (concatD [])
|
||||
CMIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
|
||||
|
||||
|
||||
instance Print Included where
|
||||
prt i e = case e of
|
||||
IAll pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
ISome pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "[") , prt 0 pidents , doc (showString "]")])
|
||||
IMinus pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "-") , doc (showString "[") , prt 0 pidents , 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 TopDef where
|
||||
prt i e = case e of
|
||||
DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
|
||||
DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
|
||||
DefFunData fundefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 fundefs])
|
||||
DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
|
||||
DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
|
||||
DefPar pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 pardefs])
|
||||
DefOper defs -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 defs])
|
||||
DefLincat defs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 defs])
|
||||
DefLindef defs -> prPrec i 0 (concatD [doc (showString "lindef") , prt 0 defs])
|
||||
DefLin defs -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 defs])
|
||||
DefPrintCat defs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 defs])
|
||||
DefPrintFun defs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 defs])
|
||||
DefFlag defs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 defs])
|
||||
DefPrintOld defs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 defs])
|
||||
DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
|
||||
DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
|
||||
DefPackage pident topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 pident , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
|
||||
DefVars defs -> prPrec i 0 (concatD [doc (showString "var") , prt 0 defs])
|
||||
DefTokenizer pident -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 pident , doc (showString ";")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print Def where
|
||||
prt i e = case e of
|
||||
DDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
|
||||
DDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
|
||||
DPatt name patts exp -> prPrec i 0 (concatD [prt 0 name , prt 0 patts , doc (showString "=") , prt 0 exp])
|
||||
DFull names exp0 exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print FunDef where
|
||||
prt i e = case e of
|
||||
FDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print CatDef where
|
||||
prt i e = case e of
|
||||
SimpleCatDef pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
|
||||
ListCatDef pident ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]")])
|
||||
ListSizeCatDef pident ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print DataDef where
|
||||
prt i e = case e of
|
||||
DataDef name dataconstrs -> prPrec i 0 (concatD [prt 0 name , doc (showString "=") , prt 0 dataconstrs])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print DataConstr where
|
||||
prt i e = case e of
|
||||
DataId pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
DataQId pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
|
||||
|
||||
instance Print ParDef where
|
||||
prt i e = case e of
|
||||
ParDefDir pident parconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 parconstrs])
|
||||
ParDefAbs pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print ParConstr where
|
||||
prt i e = case e of
|
||||
ParConstr pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
|
||||
|
||||
instance Print Name where
|
||||
prt i e = case e of
|
||||
PIdentName pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
ListName pident -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , doc (showString "]")])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print LocDef where
|
||||
prt i e = case e of
|
||||
LDDecl pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
|
||||
LDDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 exp])
|
||||
LDFull pidents exp0 exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
|
||||
|
||||
prtList 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 i e = case e of
|
||||
EPIdent pident -> prPrec i 6 (concatD [prt 0 pident])
|
||||
EConstr pident -> prPrec i 6 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
|
||||
ECons pident -> prPrec i 6 (concatD [doc (showString "%") , prt 0 pident , doc (showString "%")])
|
||||
ESort sort -> prPrec i 6 (concatD [prt 0 sort])
|
||||
EString str -> prPrec i 6 (concatD [prt 0 str])
|
||||
EInt n -> prPrec i 6 (concatD [prt 0 n])
|
||||
EFloat d -> prPrec i 6 (concatD [prt 0 d])
|
||||
EMeta -> prPrec i 6 (concatD [doc (showString "?")])
|
||||
EEmpty -> prPrec i 6 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
EData -> prPrec i 6 (concatD [doc (showString "data")])
|
||||
EList pident exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 pident , prt 0 exps , doc (showString "]")])
|
||||
EStrings str -> prPrec i 6 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
|
||||
ERecord locdefs -> prPrec i 6 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
|
||||
ETuple tuplecomps -> prPrec i 6 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
|
||||
EIndir pident -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
|
||||
ETyped exp0 exp -> prPrec i 6 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
|
||||
EProj exp label -> prPrec i 5 (concatD [prt 5 exp , doc (showString ".") , prt 0 label])
|
||||
EQConstr pident0 pident -> prPrec i 5 (concatD [doc (showString "{") , prt 0 pident0 , doc (showString ".") , prt 0 pident , doc (showString "}")])
|
||||
EQCons pident0 pident -> prPrec i 5 (concatD [doc (showString "%") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
|
||||
EApp exp0 exp -> prPrec i 4 (concatD [prt 4 exp0 , prt 5 exp])
|
||||
ETable cases -> prPrec i 4 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
ETTable exp cases -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
EVTable exp exps -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "[") , prt 0 exps , doc (showString "]")])
|
||||
ECase exp cases -> prPrec i 4 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
EVariants exps -> prPrec i 4 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
|
||||
EPre exp alterns -> prPrec i 4 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
|
||||
EStrs exps -> prPrec i 4 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
|
||||
EPatt patt -> prPrec i 4 (concatD [doc (showString "pattern") , prt 2 patt])
|
||||
EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , doc (showString "type") , prt 5 exp])
|
||||
ESelect exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "!") , prt 4 exp])
|
||||
ETupTyp exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "*") , prt 4 exp])
|
||||
EExtend exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "**") , prt 4 exp])
|
||||
EGlue exp0 exp -> prPrec i 1 (concatD [prt 2 exp0 , doc (showString "+") , prt 1 exp])
|
||||
EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
|
||||
EAbstr binds exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 binds , doc (showString "->") , prt 0 exp])
|
||||
ECTable binds exp -> prPrec i 0 (concatD [doc (showString "\\") , doc (showString "\\") , prt 0 binds , doc (showString "=>") , prt 0 exp])
|
||||
EProd decl exp -> prPrec i 0 (concatD [prt 0 decl , doc (showString "->") , prt 0 exp])
|
||||
ETType exp0 exp -> prPrec i 0 (concatD [prt 3 exp0 , doc (showString "=>") , prt 0 exp])
|
||||
ELet locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , doc (showString "{") , prt 0 locdefs , doc (showString "}") , doc (showString "in") , prt 0 exp])
|
||||
ELetb locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , prt 0 locdefs , doc (showString "in") , prt 0 exp])
|
||||
EWhere exp locdefs -> prPrec i 0 (concatD [prt 3 exp , doc (showString "where") , doc (showString "{") , prt 0 locdefs , doc (showString "}")])
|
||||
EEqs equations -> prPrec i 0 (concatD [doc (showString "fn") , doc (showString "{") , prt 0 equations , doc (showString "}")])
|
||||
EExample exp str -> prPrec i 0 (concatD [doc (showString "in") , prt 5 exp , prt 0 str])
|
||||
ELString lstring -> prPrec i 6 (concatD [prt 0 lstring])
|
||||
ELin pident -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 pident])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Exps where
|
||||
prt i e = case e of
|
||||
NilExp -> prPrec i 0 (concatD [])
|
||||
ConsExp exp exps -> prPrec i 0 (concatD [prt 6 exp , prt 0 exps])
|
||||
|
||||
|
||||
instance Print Patt where
|
||||
prt i e = case e of
|
||||
PChar -> prPrec i 2 (concatD [doc (showString "?")])
|
||||
PChars str -> prPrec i 2 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
|
||||
PMacro pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident])
|
||||
PM pident0 pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
|
||||
PW -> prPrec i 2 (concatD [doc (showString "_")])
|
||||
PV pident -> prPrec i 2 (concatD [prt 0 pident])
|
||||
PCon pident -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
|
||||
PQ pident0 pident -> prPrec i 2 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
|
||||
PInt n -> prPrec i 2 (concatD [prt 0 n])
|
||||
PFloat d -> prPrec i 2 (concatD [prt 0 d])
|
||||
PStr str -> prPrec i 2 (concatD [prt 0 str])
|
||||
PR pattasss -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
|
||||
PTup patttuplecomps -> prPrec i 2 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
|
||||
PC pident patts -> prPrec i 1 (concatD [prt 0 pident , prt 0 patts])
|
||||
PQC pident0 pident patts -> prPrec i 1 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident , prt 0 patts])
|
||||
PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
|
||||
PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
|
||||
PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
|
||||
PAs pident patt -> prPrec i 1 (concatD [prt 0 pident , doc (showString "@") , prt 2 patt])
|
||||
PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 2 x])
|
||||
x:xs -> (concatD [prt 2 x , prt 0 xs])
|
||||
|
||||
instance Print PattAss where
|
||||
prt i e = case e of
|
||||
PA pidents patt -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 patt])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Label where
|
||||
prt i e = case e of
|
||||
LPIdent pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
|
||||
|
||||
|
||||
instance Print Sort where
|
||||
prt i e = case e of
|
||||
Sort_Type -> prPrec i 0 (concatD [doc (showString "Type")])
|
||||
Sort_PType -> prPrec i 0 (concatD [doc (showString "PType")])
|
||||
Sort_Tok -> prPrec i 0 (concatD [doc (showString "Tok")])
|
||||
Sort_Str -> prPrec i 0 (concatD [doc (showString "Str")])
|
||||
Sort_Strs -> prPrec i 0 (concatD [doc (showString "Strs")])
|
||||
|
||||
|
||||
instance Print Bind where
|
||||
prt i e = case e of
|
||||
BPIdent pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
BWild -> prPrec i 0 (concatD [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 Decl where
|
||||
prt i e = case e of
|
||||
DDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
|
||||
DExp exp -> prPrec i 0 (concatD [prt 4 exp])
|
||||
|
||||
|
||||
instance Print TupleComp where
|
||||
prt i e = case e of
|
||||
TComp exp -> prPrec i 0 (concatD [prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print PattTupleComp where
|
||||
prt i e = case e of
|
||||
PTComp patt -> prPrec i 0 (concatD [prt 0 patt])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Case where
|
||||
prt i e = case e of
|
||||
Case patt exp -> prPrec i 0 (concatD [prt 0 patt , doc (showString "=>") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Equation where
|
||||
prt i e = case e of
|
||||
Equ patts exp -> prPrec i 0 (concatD [prt 0 patts , doc (showString "->") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Altern where
|
||||
prt i e = case e of
|
||||
Alt exp0 exp -> prPrec i 0 (concatD [prt 0 exp0 , doc (showString "/") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print DDecl where
|
||||
prt i e = case e of
|
||||
DDDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
|
||||
DDExp exp -> prPrec i 0 (concatD [prt 6 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print OldGrammar where
|
||||
prt i e = case e of
|
||||
OldGr include topdefs -> prPrec i 0 (concatD [prt 0 include , prt 0 topdefs])
|
||||
|
||||
|
||||
instance Print Include where
|
||||
prt i e = case e of
|
||||
NoIncl -> prPrec i 0 (concatD [])
|
||||
Incl filenames -> prPrec i 0 (concatD [doc (showString "include") , prt 0 filenames])
|
||||
|
||||
|
||||
instance Print FileName where
|
||||
prt i e = case e of
|
||||
FString str -> prPrec i 0 (concatD [prt 0 str])
|
||||
FPIdent pident -> prPrec i 0 (concatD [prt 0 pident])
|
||||
FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
|
||||
FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
|
||||
FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
|
||||
FAddId pident filename -> prPrec i 0 (concatD [prt 0 pident , prt 0 filename])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
|
||||
@@ -46,8 +46,8 @@ type Indirection = (Ident,Bool) -- module of origin, whether canonical
|
||||
|
||||
data Judgement = Judgement {
|
||||
jform :: JudgementForm, -- cat fun lincat lin oper param
|
||||
jtype :: Type, -- context type lincat - type constrs
|
||||
jdef :: Term, -- lindef def lindef lin def values
|
||||
jtype :: Type, -- context type lincat - type PType
|
||||
jdef :: Term, -- lindef def lindef lin def constrs
|
||||
jprintname :: Term, -- - - prname prname - -
|
||||
jlink :: Ident,
|
||||
jposition :: Int
|
||||
|
||||
Reference in new issue
Block a user