forked from GitHub/gf-core
full disjunctive patterns ; more prec levels for Exp
This commit is contained in:
aarne
@@ -1704,6 +1704,36 @@ Product types and tuples are syntactic sugar for record types and records:
|
||||
Thus the labels ``p1, p2,...``` are hard-coded.
|
||||
|
||||
|
||||
===Record and tuple patterns===
|
||||
|
||||
Record types of parameter types are also parameter types.
|
||||
A typical example is a record of agreement features, e.g. French
|
||||
```
|
||||
oper Agr : PType = {g : Gender ; n : Number ; p : Person} ;
|
||||
```
|
||||
Notice the term ``PType`` rather than just ``Type`` referring to
|
||||
parameter types. Every ``PType`` is also a ``Type``.
|
||||
|
||||
Pattern matching is done in the expected way, but it can moreover
|
||||
utilize partial records: the branch
|
||||
```
|
||||
{g = Fem} => t
|
||||
```
|
||||
in a table of type ``Agr => T`` means the same as
|
||||
```
|
||||
{g = Fem ; n = _ ; p = _} => t
|
||||
```
|
||||
Tuple patterns are translated to record patterns in the
|
||||
same way as tuples to records; partial patterns make it
|
||||
possible to write, slightly surprisingly,
|
||||
```
|
||||
case <g,n,p> of {
|
||||
<Fem> => t
|
||||
...
|
||||
}
|
||||
```
|
||||
|
||||
|
||||
%--!
|
||||
===Prefix-dependent choices===
|
||||
|
||||
|
||||
@@ -18,7 +18,7 @@ concrete ProofSymb of Proof = FormulaSymb ** open Prelude, Precedence in {
|
||||
RedAbs form = continue ["Reductio ad absurdum"] (task neg abs)
|
||||
where { neg = useTop (prefixR 4 "~" form) } ;
|
||||
|
||||
ExFalso form = finish (["Ex falso quodlibet"] ++ form.s) "Ø" ; --- form
|
||||
ExFalso form = finish (["Ex falso quodlibet"] ++ toProve form) "Ø" ; --- form
|
||||
|
||||
ConjSplit a b c =
|
||||
continue ["Conjunction split"]
|
||||
@@ -81,4 +81,10 @@ concrete ProofSymb of Proof = FormulaSymb ** open Prelude, Precedence in {
|
||||
|
||||
abs = "_|_" ;
|
||||
|
||||
toProve : PrecExp -> Str = \c ->
|
||||
variants {
|
||||
[] ; -- for generation
|
||||
useTop c -- for parsing
|
||||
} ;
|
||||
|
||||
}
|
||||
@@ -1,5 +1,4 @@
|
||||
|
||||
module GF.Source.AbsGF where
|
||||
module GF.Source.AbsGF where --H
|
||||
|
||||
import GF.Infra.Ident --H
|
||||
|
||||
@@ -189,16 +188,17 @@ data 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
|
||||
| EConcat Exp Exp
|
||||
| EGlue Exp Exp
|
||||
| ELet [LocDef] Exp
|
||||
| ELetb [LocDef] Exp
|
||||
| EWhere Exp [LocDef]
|
||||
| EEqs [Equation]
|
||||
| EExample Exp String
|
||||
| ELString LString
|
||||
| ELin Ident
|
||||
deriving (Eq,Ord,Show)
|
||||
@@ -220,6 +220,7 @@ data Patt =
|
||||
| PTup [PattTupleComp]
|
||||
| PC Ident [Patt]
|
||||
| PQC Ident Ident [Patt]
|
||||
| PDisj Patt Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattAss =
|
||||
@@ -239,10 +240,6 @@ data Sort =
|
||||
| Sort_Strs
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattAlt =
|
||||
AltP Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Bind =
|
||||
BIdent Ident
|
||||
| BWild
|
||||
@@ -262,7 +259,7 @@ data PattTupleComp =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Case =
|
||||
Case [PattAlt] Exp
|
||||
Case Patt Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Equation =
|
||||
|
||||
@@ -150,75 +150,80 @@ separator LocDef ";" ;
|
||||
|
||||
-- terms and types
|
||||
|
||||
EIdent. Exp4 ::= Ident ;
|
||||
EConstr. Exp4 ::= "{" Ident "}" ;
|
||||
ECons. Exp4 ::= "%" Ident "%" ;
|
||||
ESort. Exp4 ::= Sort ;
|
||||
EString. Exp4 ::= String ;
|
||||
EInt. Exp4 ::= Integer ;
|
||||
EFloat. Exp4 ::= Double ;
|
||||
EMeta. Exp4 ::= "?" ;
|
||||
EEmpty. Exp4 ::= "[" "]" ;
|
||||
EData. Exp4 ::= "data" ;
|
||||
EList. Exp4 ::= "[" Ident Exps "]" ;
|
||||
EStrings. Exp4 ::= "[" String "]" ;
|
||||
ERecord. Exp4 ::= "{" [LocDef] "}" ; -- !
|
||||
ETuple. Exp4 ::= "<" [TupleComp] ">" ; --- needed for separator ","
|
||||
EIndir. Exp4 ::= "(" "in" Ident ")" ; -- indirection, used in judgements
|
||||
ETyped. Exp4 ::= "<" Exp ":" Exp ">" ; -- typing, used for annotations
|
||||
EIdent. Exp6 ::= Ident ;
|
||||
EConstr. Exp6 ::= "{" Ident "}" ;
|
||||
ECons. Exp6 ::= "%" Ident "%" ;
|
||||
ESort. Exp6 ::= Sort ;
|
||||
EString. Exp6 ::= String ;
|
||||
EInt. Exp6 ::= Integer ;
|
||||
EFloat. Exp6 ::= Double ;
|
||||
EMeta. Exp6 ::= "?" ;
|
||||
EEmpty. Exp6 ::= "[" "]" ;
|
||||
EData. Exp6 ::= "data" ;
|
||||
EList. Exp6 ::= "[" Ident Exps "]" ;
|
||||
EStrings. Exp6 ::= "[" String "]" ;
|
||||
ERecord. Exp6 ::= "{" [LocDef] "}" ; -- !
|
||||
ETuple. Exp6 ::= "<" [TupleComp] ">" ; --- needed for separator ","
|
||||
EIndir. Exp6 ::= "(" "in" Ident ")" ; -- indirection, used in judgements
|
||||
ETyped. Exp6 ::= "<" Exp ":" Exp ">" ; -- typing, used for annotations
|
||||
|
||||
EProj. Exp3 ::= Exp3 "." Label ;
|
||||
EQConstr. Exp3 ::= "{" Ident "." Ident "}" ; -- qualified constructor
|
||||
EQCons. Exp3 ::= "%" Ident "." Ident ; -- qualified constant
|
||||
EProj. Exp5 ::= Exp5 "." Label ;
|
||||
EQConstr. Exp5 ::= "{" Ident "." Ident "}" ; -- qualified constructor
|
||||
EQCons. Exp5 ::= "%" Ident "." Ident ; -- qualified constant
|
||||
|
||||
EApp. Exp2 ::= Exp2 Exp3 ;
|
||||
ETable. Exp2 ::= "table" "{" [Case] "}" ;
|
||||
ETTable. Exp2 ::= "table" Exp4 "{" [Case] "}" ;
|
||||
EVTable. Exp2 ::= "table" Exp4 "[" [Exp] "]" ;
|
||||
ECase. Exp2 ::= "case" Exp "of" "{" [Case] "}" ;
|
||||
EVariants. Exp2 ::= "variants" "{" [Exp] "}" ;
|
||||
EPre. Exp2 ::= "pre" "{" Exp ";" [Altern] "}" ;
|
||||
EStrs. Exp2 ::= "strs" "{" [Exp] "}" ;
|
||||
EConAt. Exp2 ::= Ident "@" Exp4 ;
|
||||
EApp. Exp4 ::= Exp4 Exp5 ;
|
||||
ETable. Exp4 ::= "table" "{" [Case] "}" ;
|
||||
ETTable. Exp4 ::= "table" Exp6 "{" [Case] "}" ;
|
||||
EVTable. Exp4 ::= "table" Exp6 "[" [Exp] "]" ;
|
||||
ECase. Exp4 ::= "case" Exp "of" "{" [Case] "}" ;
|
||||
EVariants. Exp4 ::= "variants" "{" [Exp] "}" ;
|
||||
EPre. Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ;
|
||||
EStrs. Exp4 ::= "strs" "{" [Exp] "}" ;
|
||||
EConAt. Exp4 ::= Ident "@" Exp6 ;
|
||||
|
||||
ESelect. Exp1 ::= Exp1 "!" Exp2 ;
|
||||
ETupTyp. Exp1 ::= Exp1 "*" Exp2 ;
|
||||
EExtend. Exp1 ::= Exp1 "**" Exp2 ;
|
||||
ESelect. Exp3 ::= Exp3 "!" Exp4 ;
|
||||
ETupTyp. Exp3 ::= Exp3 "*" Exp4 ;
|
||||
EExtend. Exp3 ::= Exp3 "**" Exp4 ;
|
||||
|
||||
EGlue. Exp1 ::= Exp2 "+" Exp1 ;
|
||||
|
||||
EConcat. Exp ::= Exp1 "++" Exp ;
|
||||
|
||||
EAbstr. Exp ::= "\\" [Bind] "->" Exp ;
|
||||
ECTable. Exp ::= "\\""\\" [Bind] "=>" Exp ;
|
||||
EProd. Exp ::= Decl "->" Exp ;
|
||||
ETType. Exp ::= Exp1 "=>" Exp ; -- these are thus right associative
|
||||
EConcat. Exp ::= Exp1 "++" Exp ;
|
||||
EGlue. Exp ::= Exp1 "+" Exp ;
|
||||
ETType. Exp ::= Exp3 "=>" Exp ; -- these are thus right associative
|
||||
ELet. Exp ::= "let" "{" [LocDef] "}" "in" Exp ;
|
||||
ELetb. Exp ::= "let" [LocDef] "in" Exp ;
|
||||
EWhere. Exp ::= Exp1 "where" "{" [LocDef] "}" ;
|
||||
EWhere. Exp ::= Exp3 "where" "{" [LocDef] "}" ;
|
||||
EEqs. Exp ::= "fn" "{" [Equation] "}" ;
|
||||
|
||||
EExample. Exp ::= "in" Exp5 String ;
|
||||
|
||||
coercions Exp 4 ;
|
||||
|
||||
separator Exp ";" ; -- in variants
|
||||
|
||||
-- list of arguments to category
|
||||
NilExp. Exps ::= ;
|
||||
ConsExp. Exps ::= Exp4 Exps ; -- Exp4 to force parantheses
|
||||
ConsExp. Exps ::= Exp6 Exps ; -- Exp6 to force parantheses
|
||||
|
||||
-- patterns
|
||||
|
||||
PW. Patt1 ::= "_" ;
|
||||
PV. Patt1 ::= Ident ;
|
||||
PCon. Patt1 ::= "{" Ident "}" ;
|
||||
PQ. Patt1 ::= Ident "." Ident ;
|
||||
PInt. Patt1 ::= Integer ;
|
||||
PFloat. Patt1 ::= Double ;
|
||||
PStr. Patt1 ::= String ;
|
||||
PR. Patt1 ::= "{" [PattAss] "}" ;
|
||||
PTup. Patt1 ::= "<" [PattTupleComp] ">" ;
|
||||
PC. Patt ::= Ident [Patt] ;
|
||||
PQC. Patt ::= Ident "." Ident [Patt] ;
|
||||
PW. Patt2 ::= "_" ;
|
||||
PV. Patt2 ::= Ident ;
|
||||
PCon. Patt2 ::= "{" Ident "}" ;
|
||||
PQ. Patt2 ::= Ident "." Ident ;
|
||||
PInt. Patt2 ::= Integer ;
|
||||
PFloat. Patt2 ::= Double ;
|
||||
PStr. Patt2 ::= String ;
|
||||
PR. Patt2 ::= "{" [PattAss] "}" ;
|
||||
PTup. Patt2 ::= "<" [PattTupleComp] ">" ;
|
||||
PC. Patt1 ::= Ident [Patt] ;
|
||||
PQC. Patt1 ::= Ident "." Ident [Patt] ;
|
||||
PDisj. Patt ::= Patt "|" Patt1 ;
|
||||
|
||||
coercions Patt 1 ;
|
||||
coercions Patt 2 ;
|
||||
|
||||
PA. PattAss ::= [Ident] "=" Patt ;
|
||||
|
||||
@@ -233,13 +238,10 @@ rules Sort ::= "Type" | "PType" | "Tok" | "Str" | "Strs" ;
|
||||
|
||||
separator PattAss ";" ;
|
||||
|
||||
AltP. PattAlt ::= Patt ;
|
||||
|
||||
-- this is explicit to force higher precedence level on rhs
|
||||
(:[]). [Patt] ::= Patt1 ;
|
||||
(:). [Patt] ::= Patt1 [Patt] ;
|
||||
(:[]). [Patt] ::= Patt2 ;
|
||||
(:). [Patt] ::= Patt2 [Patt] ;
|
||||
|
||||
separator nonempty PattAlt "|" ;
|
||||
|
||||
-- binds in lambdas and lin rules
|
||||
|
||||
@@ -252,7 +254,7 @@ separator Bind "," ;
|
||||
-- declarations in function types
|
||||
|
||||
DDec. Decl ::= "(" [Bind] ":" Exp ")" ;
|
||||
DExp. Decl ::= Exp2 ; -- can thus be an application
|
||||
DExp. Decl ::= Exp4 ; -- can thus be an application
|
||||
|
||||
-- tuple component (term or pattern)
|
||||
|
||||
@@ -264,7 +266,7 @@ separator PattTupleComp "," ;
|
||||
|
||||
-- case branches
|
||||
|
||||
Case. Case ::= [PattAlt] "=>" Exp ;
|
||||
Case. Case ::= Patt "=>" Exp ;
|
||||
|
||||
separator nonempty Case ";" ;
|
||||
|
||||
@@ -283,7 +285,7 @@ separator Altern ";" ;
|
||||
-- in a context, higher precedence is required than in function types
|
||||
|
||||
DDDec. DDecl ::= "(" [Bind] ":" Exp ")" ;
|
||||
DDExp. DDecl ::= Exp4 ; -- can thus *not* be an application
|
||||
DDExp. DDecl ::= Exp6 ; -- can thus *not* be an application
|
||||
|
||||
separator DDecl "" ;
|
||||
|
||||
@@ -308,8 +310,8 @@ FMinus. FileName ::= "-" FileName ;
|
||||
FAddId. FileName ::= Ident FileName ;
|
||||
|
||||
token LString '\'' (char - '\'')* '\'' ;
|
||||
ELString. Exp4 ::= LString ;
|
||||
ELin. Exp2 ::= "Lin" Ident ;
|
||||
ELString. Exp6 ::= LString ;
|
||||
ELin. Exp4 ::= "Lin" Ident ;
|
||||
|
||||
DefPrintOld. TopDef ::= "printname" [PrintDef] ;
|
||||
DefLintype. TopDef ::= "lintype" [Def] ;
|
||||
|
||||
@@ -205,8 +205,8 @@ trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t')
|
||||
|
||||
trLabelling (lab,ty) = P.LDDecl [trLabelIdent lab] (trt ty)
|
||||
|
||||
trCase (patt, trm) = P.Case [P.AltP (trp patt)] (trt trm)
|
||||
trCases (patts,trm) = P.Case (map (P.AltP . trp) patts) (trt trm)
|
||||
trCase (patt, trm) = P.Case (trp patt) (trt trm)
|
||||
trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm)
|
||||
|
||||
trDecl (x,ty) = P.DDDec [trb x] (trt ty)
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1,11 +1,10 @@
|
||||
|
||||
module GF.Source.PrintGF where
|
||||
module GF.Source.PrintGF where --H
|
||||
|
||||
-- pretty-printer generated by the BNF converter, except --H
|
||||
|
||||
import GF.Infra.Ident --H
|
||||
import GF.Source.AbsGF
|
||||
import Data.Char
|
||||
import GF.Source.AbsGF --H
|
||||
import Data.Char --H
|
||||
|
||||
-- the top-level printing method
|
||||
printTree :: Print a => a -> String
|
||||
@@ -27,13 +26,11 @@ render d = rend 0 (map ($ "") $ d []) "" where
|
||||
|
||||
"[" :ts -> showChar '[' . rend i ts
|
||||
"(" :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 -> showString t . showChar ']' . rend i ts
|
||||
t :ts -> space t . rend i ts
|
||||
@@ -62,12 +59,6 @@ class Print a where
|
||||
instance Print a => Print [a] where
|
||||
prt _ = prtList
|
||||
|
||||
instance Print Integer where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Double where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Char where
|
||||
prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
|
||||
prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
|
||||
@@ -84,8 +75,16 @@ 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 Ident where
|
||||
prt _ i = doc (showString $ prIdent i)
|
||||
prt _ i = doc (showString $ prIdent i) --H
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
@@ -192,6 +191,7 @@ instance Print Included where
|
||||
prt i e = case e of
|
||||
IAll id -> prPrec i 0 (concatD [prt 0 id])
|
||||
ISome id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "[") , prt 0 ids , doc (showString "]")])
|
||||
IMinus id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "-") , doc (showString "[") , prt 0 ids , doc (showString "]")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
@@ -329,49 +329,50 @@ instance Print LocDef where
|
||||
|
||||
instance Print Exp where
|
||||
prt i e = case e of
|
||||
EIdent id -> prPrec i 4 (concatD [prt 0 id])
|
||||
EConstr id -> prPrec i 4 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
|
||||
ECons id -> prPrec i 4 (concatD [doc (showString "%") , prt 0 id , doc (showString "%")])
|
||||
ESort sort -> prPrec i 4 (concatD [prt 0 sort])
|
||||
EString str -> prPrec i 4 (concatD [prt 0 str])
|
||||
EInt n -> prPrec i 4 (concatD [prt 0 n])
|
||||
EFloat n -> prPrec i 4 (concatD [prt 0 n])
|
||||
EMeta -> prPrec i 4 (concatD [doc (showString "?")])
|
||||
EEmpty -> prPrec i 4 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
EData -> prPrec i 4 (concatD [doc (showString "data")])
|
||||
EList id exps -> prPrec i 4 (concatD [doc (showString "[") , prt 0 id , prt 0 exps , doc (showString "]")])
|
||||
EStrings str -> prPrec i 4 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
|
||||
ERecord locdefs -> prPrec i 4 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
|
||||
ETuple tuplecomps -> prPrec i 4 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
|
||||
EIndir id -> prPrec i 4 (concatD [doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
|
||||
ETyped exp0 exp -> prPrec i 4 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
|
||||
EProj exp label -> prPrec i 3 (concatD [prt 3 exp , doc (showString ".") , prt 0 label])
|
||||
EQConstr id0 id -> prPrec i 3 (concatD [doc (showString "{0") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "}0")]) -- H
|
||||
EQCons id0 id -> prPrec i 3 (concatD [doc (showString "%") , prt 0 id0 , doc (showString ".") , prt 0 id])
|
||||
EApp exp0 exp -> prPrec i 2 (concatD [prt 2 exp0 , prt 3 exp])
|
||||
ETable cases -> prPrec i 2 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
ETTable exp cases -> prPrec i 2 (concatD [doc (showString "table") , prt 4 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
EVTable exp exps -> prPrec i 2 (concatD [doc (showString "table") , prt 4 exp , doc (showString "[") , prt 0 exps , doc (showString "]")])
|
||||
ECase exp cases -> prPrec i 2 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
EVariants exps -> prPrec i 2 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
|
||||
EPre exp alterns -> prPrec i 2 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
|
||||
EStrs exps -> prPrec i 2 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
|
||||
EConAt id exp -> prPrec i 2 (concatD [prt 0 id , doc (showString "@") , prt 4 exp])
|
||||
ESelect exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "!") , prt 2 exp])
|
||||
ETupTyp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "*") , prt 2 exp])
|
||||
EExtend exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "**") , prt 2 exp])
|
||||
EIdent id -> prPrec i 6 (concatD [prt 0 id])
|
||||
EConstr id -> prPrec i 6 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H
|
||||
ECons id -> prPrec i 6 (concatD [doc (showString "%") , prt 0 id , 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 id exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 id , 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 id -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 id , 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 id0 id -> prPrec i 5 (concatD [doc (showString "{0") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "}0")]) --H
|
||||
EQCons id0 id -> prPrec i 5 (concatD [doc (showString "%") , prt 0 id0 , doc (showString ".") , prt 0 id])
|
||||
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 "}")])
|
||||
EConAt id exp -> prPrec i 4 (concatD [prt 0 id , doc (showString "@") , prt 6 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 1 exp0 , doc (showString "=>") , prt 0 exp])
|
||||
EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
|
||||
EGlue exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , 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 1 exp , doc (showString "where") , doc (showString "{") , prt 0 locdefs , doc (showString "}")])
|
||||
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 "}")])
|
||||
ELString lstring -> prPrec i 4 (concatD [prt 0 lstring])
|
||||
ELin id -> prPrec i 2 (concatD [doc (showString "Lin") , prt 0 id])
|
||||
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 id -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 id])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
@@ -381,26 +382,27 @@ instance Print Exp where
|
||||
instance Print Exps where
|
||||
prt i e = case e of
|
||||
NilExp -> prPrec i 0 (concatD [])
|
||||
ConsExp exp exps -> prPrec i 0 (concatD [prt 4 exp , prt 0 exps])
|
||||
ConsExp exp exps -> prPrec i 0 (concatD [prt 6 exp , prt 0 exps])
|
||||
|
||||
|
||||
instance Print Patt where
|
||||
prt i e = case e of
|
||||
PW -> prPrec i 1 (concatD [doc (showString "_")])
|
||||
PV id -> prPrec i 1 (concatD [prt 0 id])
|
||||
PCon id -> prPrec i 1 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
|
||||
PQ id0 id -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
|
||||
PInt n -> prPrec i 1 (concatD [prt 0 n])
|
||||
PFloat n -> prPrec i 1 (concatD [prt 0 n])
|
||||
PStr str -> prPrec i 1 (concatD [prt 0 str])
|
||||
PR pattasss -> prPrec i 1 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
|
||||
PTup patttuplecomps -> prPrec i 1 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
|
||||
PC id patts -> prPrec i 0 (concatD [prt 0 id , prt 0 patts])
|
||||
PQC id0 id patts -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
|
||||
PW -> prPrec i 2 (concatD [doc (showString "_")])
|
||||
PV id -> prPrec i 2 (concatD [prt 0 id])
|
||||
PCon id -> prPrec i 2 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H
|
||||
PQ id0 id -> prPrec i 2 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
|
||||
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 id patts -> prPrec i 1 (concatD [prt 0 id , prt 0 patts])
|
||||
PQC id0 id patts -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
|
||||
PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 1 x])
|
||||
x:xs -> (concatD [prt 1 x , prt 0 xs])
|
||||
[x] -> (concatD [prt 2 x])
|
||||
x:xs -> (concatD [prt 2 x , prt 0 xs])
|
||||
|
||||
instance Print PattAss where
|
||||
prt i e = case e of
|
||||
@@ -426,14 +428,6 @@ instance Print Sort where
|
||||
Sort_Strs -> prPrec i 0 (concatD [doc (showString "Strs")])
|
||||
|
||||
|
||||
instance Print PattAlt where
|
||||
prt i e = case e of
|
||||
AltP patt -> prPrec i 0 (concatD [prt 0 patt])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
|
||||
|
||||
instance Print Bind where
|
||||
prt i e = case e of
|
||||
BIdent id -> prPrec i 0 (concatD [prt 0 id])
|
||||
@@ -447,7 +441,7 @@ instance Print Bind where
|
||||
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 2 exp])
|
||||
DExp exp -> prPrec i 0 (concatD [prt 4 exp])
|
||||
|
||||
|
||||
instance Print TupleComp where
|
||||
@@ -470,7 +464,7 @@ instance Print PattTupleComp where
|
||||
|
||||
instance Print Case where
|
||||
prt i e = case e of
|
||||
Case pattalts exp -> prPrec i 0 (concatD [prt 0 pattalts , doc (showString "=>") , prt 0 exp])
|
||||
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])
|
||||
@@ -497,7 +491,7 @@ instance Print Altern where
|
||||
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 4 exp])
|
||||
DDExp exp -> prPrec i 0 (concatD [prt 6 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
|
||||
@@ -517,6 +517,24 @@ transSort :: Sort -> Err String
|
||||
transSort x = case x of
|
||||
_ -> return $ printTree x
|
||||
|
||||
transPatts :: Patt -> Err [G.Patt]
|
||||
transPatts p = case p of
|
||||
PDisj p1 p2 -> liftM2 (++) (transPatts p1) (transPatts p2)
|
||||
PC id patts -> liftM (map (G.PC id) . combinations) $ mapM transPatts patts
|
||||
PR pattasss -> do
|
||||
let (lss,ps) = unzip [(ls,p) | PA ls p <- pattasss]
|
||||
ls = map LIdent $ concat lss
|
||||
ps0 <- mapM transPatts ps
|
||||
let ps' = combinations ps0
|
||||
lss' <- mapM trLabel ls
|
||||
let rss = map (zip lss') ps'
|
||||
return $ map G.PR rss
|
||||
PTup pcs -> do
|
||||
ps0 <- mapM transPatts [e | PTComp e <- pcs]
|
||||
let ps' = combinations ps0
|
||||
return $ map (G.PR . M.tuple2recordPatt) ps'
|
||||
_ -> liftM singleton $ transPatt p
|
||||
|
||||
transPatt :: Patt -> Err G.Patt
|
||||
transPatt x = case x of
|
||||
PW -> return G.wildPatt
|
||||
@@ -535,6 +553,7 @@ transPatt x = case x of
|
||||
PQ id0 id -> liftM3 G.PP (transIdent id0) (transIdent id) (return [])
|
||||
PQC id0 id patts ->
|
||||
liftM3 G.PP (transIdent id0) (transIdent id) (mapM transPatt patts)
|
||||
PDisj _ _ -> Bad $ "not allowed pattern" +++ printTree x
|
||||
|
||||
transBind :: Bind -> Err Ident
|
||||
transBind x = case x of
|
||||
@@ -553,8 +572,8 @@ transCases :: [Case] -> Err [G.Case]
|
||||
transCases = liftM concat . mapM transCase
|
||||
|
||||
transCase :: Case -> Err [G.Case]
|
||||
transCase (Case pattalts exp) = do
|
||||
patts <- mapM transPatt [p | AltP p <- pattalts]
|
||||
transCase (Case p exp) = do
|
||||
patts <- transPatts p
|
||||
exp' <- transExp exp
|
||||
return [(p,exp') | p <- patts]
|
||||
|
||||
|
||||
Reference in New Issue
Block a user