From bca0a65ad1bee99113f650466963bd763aa85718 Mon Sep 17 00:00:00 2001 From: Abdelrahman Abounegm Date: Tue, 9 Jan 2024 08:59:53 +0300 Subject: [PATCH 1/2] Update grammar to reflect syntax from paper --- eo-phi-normalizer/grammar/EO/Phi/Syntax.cf | 4 +- .../src/Language/EO/Phi/Syntax/Abs.hs | 46 ++--- .../src/Language/EO/Phi/Syntax/Doc.txt | 173 +++++++++--------- .../src/Language/EO/Phi/Syntax/Lex.x | 19 +- .../src/Language/EO/Phi/Syntax/Par.y | 42 +++-- .../src/Language/EO/Phi/Syntax/Print.hs | 110 +++++------ 6 files changed, 188 insertions(+), 206 deletions(-) diff --git a/eo-phi-normalizer/grammar/EO/Phi/Syntax.cf b/eo-phi-normalizer/grammar/EO/Phi/Syntax.cf index 40099c94c..be9180219 100644 --- a/eo-phi-normalizer/grammar/EO/Phi/Syntax.cf +++ b/eo-phi-normalizer/grammar/EO/Phi/Syntax.cf @@ -11,8 +11,8 @@ token AlphaIndex ({"α0"} | {"α"} (digit - ["0"]) (digit)* ) ; Program. Program ::= "{" [Binding] "}" ; -Formation. Object ::= "{" [Binding] "}" ; -Application. Object ::= Object "{" [Binding] "}" ; +Formation. Object ::= "⟦" [Binding] "⟧" ; +Application. Object ::= Object "(" [Binding] ")" ; ObjectDispatch. Object ::= Object "." Attribute ; GlobalDispatch. Object ::= "Φ" "." Attribute ; ThisDispatch. Object ::= "ξ" "." Attribute ; diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Abs.hs b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Abs.hs index 4ae129573..04444019a 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Abs.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Abs.hs @@ -1,59 +1,52 @@ --- File generated by the BNF Converter (bnfc 2.9.5). +-- File generated by the BNF Converter (bnfc 2.9.6). + {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | The abstract syntax of language Syntax. + module Language.EO.Phi.Syntax.Abs where -import qualified Data.String import Prelude (String) -import qualified Prelude as C (Eq, Ord, Read, Show) +import qualified Prelude as C (Eq, Ord, Show, Read) +import qualified Data.String -import qualified Data.Data as C (Data, Typeable) +import qualified Data.Data as C (Data, Typeable) import qualified GHC.Generics as C (Generic) data Program = Program [Binding] deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic) data Object - = Formation [Binding] - | Application Object [Binding] - | ObjectDispatch Object Attribute - | GlobalDispatch Attribute - | ThisDispatch Attribute - | Termination + = Formation [Binding] + | Application Object [Binding] + | ObjectDispatch Object Attribute + | GlobalDispatch Attribute + | ThisDispatch Attribute + | Termination deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic) data Binding - = AlphaBinding Attribute Object - | EmptyBinding Attribute - | DeltaBinding Bytes - | LambdaBinding Function + = AlphaBinding Attribute Object + | EmptyBinding Attribute + | DeltaBinding Bytes + | LambdaBinding Function deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic) data Attribute - = Phi - | Rho - | Sigma - | VTX - | Label LabelId - | Alpha AlphaIndex + = Phi | Rho | Sigma | VTX | Label LabelId | Alpha AlphaIndex deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic) data PeeledObject = PeeledObject ObjectHead [ObjectAction] deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic) data ObjectHead - = HeadFormation [Binding] - | HeadGlobal - | HeadThis - | HeadTermination + = HeadFormation [Binding] | HeadGlobal | HeadThis | HeadTermination deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic) data ObjectAction - = ActionApplication [Binding] - | ActionDispatch Attribute + = ActionApplication [Binding] | ActionDispatch Attribute deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic) newtype Bytes = Bytes String @@ -67,3 +60,4 @@ newtype LabelId = LabelId String newtype AlphaIndex = AlphaIndex String deriving (C.Eq, C.Ord, C.Show, C.Read, C.Data, C.Typeable, C.Generic, Data.String.IsString) + diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Doc.txt b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Doc.txt index d611fb084..6b3ef07d2 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Doc.txt +++ b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Doc.txt @@ -1,86 +1,87 @@ -The Language Syntax -BNF Converter - - -%Process by txt2tags to generate html or latex - - - -This document was automatically generated by the //BNF-Converter//. 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). - -==The lexical structure of Syntax== - -===Literals=== - - - - - -Bytes literals are recognized by the regular expression -`````{"--"} | ["0123456789ABCDEF"] ["0123456789ABCDEF"] ('-' ["0123456789ABCDEF"] ["0123456789ABCDEF"])* {"--"}````` - -Function literals are recognized by the regular expression -`````upper (char - [" - !'(),-.:;?[]{|}⟦⟧"])*````` - -LabelId literals are recognized by the regular expression -`````lower (char - [" - !'(),-.:;?[]{|}⟦⟧"])*````` - -AlphaIndex literals are recognized by the regular expression -`````{"α0"} | 'α' (digit - '0') digit*````` - - -===Reserved words and symbols=== -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. - -The reserved words used in Syntax are the following: - | ``Δ`` | ``Φ`` | ``λ`` | ``ν`` - | ``ξ`` | ``ρ`` | ``σ`` | ``φ`` - -The symbols used in Syntax are the following: - | { | } | . | ⊥ - | ↦ | ∅ | ⤍ | , - -===Comments=== -There are no single-line comments in the grammar.There are no multiple-line comments in the grammar. - -==The syntactic structure of Syntax== -Non-terminals are enclosed between < and >. -The symbols -> (production), **|** (union) -and **eps** (empty rule) belong to the BNF notation. -All other symbols are terminals. - - | //Program// | -> | ``{`` //[Binding]// ``}`` - | //Object// | -> | ``{`` //[Binding]// ``}`` - | | **|** | //Object// ``{`` //[Binding]// ``}`` - | | **|** | //Object// ``.`` //Attribute// - | | **|** | ``Φ`` ``.`` //Attribute// - | | **|** | ``ξ`` ``.`` //Attribute// - | | **|** | ``⊥`` - | //Binding// | -> | //Attribute// ``↦`` //Object// - | | **|** | //Attribute// ``↦`` ``∅`` - | | **|** | ``Δ`` ``⤍`` //Bytes// - | | **|** | ``λ`` ``⤍`` //Function// - | //[Binding]// | -> | **eps** - | | **|** | //Binding// - | | **|** | //Binding// ``,`` //[Binding]// - | //Attribute// | -> | ``φ`` - | | **|** | ``ρ`` - | | **|** | ``σ`` - | | **|** | ``ν`` - | | **|** | //LabelId// - | | **|** | //AlphaIndex// - | //PeeledObject// | -> | //ObjectHead// //[ObjectAction]// - | //ObjectHead// | -> | ``{`` //[Binding]// ``}`` - | | **|** | ``Φ`` - | | **|** | ``ξ`` - | | **|** | ``⊥`` - | //ObjectAction// | -> | ``{`` //[Binding]// ``}`` - | | **|** | ``.`` //Attribute// - | //[ObjectAction]// | -> | **eps** - | | **|** | //ObjectAction// //[ObjectAction]// - - - -%% File generated by the BNF Converter (bnfc 2.9.5). +The Language Syntax +BNF Converter + + +%Process by txt2tags to generate html or latex + + + +This document was automatically generated by the //BNF-Converter//. 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). + +==The lexical structure of Syntax== + +===Literals=== + + + + + +Bytes literals are recognized by the regular expression +`````{"--"} | ["0123456789ABCDEF"] ["0123456789ABCDEF"] ('-' ["0123456789ABCDEF"] ["0123456789ABCDEF"])* {"--"}````` + +Function literals are recognized by the regular expression +`````upper (char - [" + !'(),-.:;?[]{|}⟦⟧"])*````` + +LabelId literals are recognized by the regular expression +`````lower (char - [" + !'(),-.:;?[]{|}⟦⟧"])*````` + +AlphaIndex literals are recognized by the regular expression +`````{"α0"} | 'α' (digit - '0') digit*````` + + +===Reserved words and symbols=== +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. + +The reserved words used in Syntax are the following: + | ``Δ`` | ``Φ`` | ``λ`` | ``ν`` + | ``ξ`` | ``ρ`` | ``σ`` | ``φ`` + +The symbols used in Syntax are the following: + | { | } | ⟦ | ⟧ + | ( | ) | . | ⊥ + | ↦ | ∅ | ⤍ | , + +===Comments=== +There are no single-line comments in the grammar.There are no multiple-line comments in the grammar. + +==The syntactic structure of Syntax== +Non-terminals are enclosed between < and >. +The symbols -> (production), **|** (union) +and **eps** (empty rule) belong to the BNF notation. +All other symbols are terminals. + + | //Program// | -> | ``{`` //[Binding]// ``}`` + | //Object// | -> | ``⟦`` //[Binding]// ``⟧`` + | | **|** | //Object// ``(`` //[Binding]// ``)`` + | | **|** | //Object// ``.`` //Attribute// + | | **|** | ``Φ`` ``.`` //Attribute// + | | **|** | ``ξ`` ``.`` //Attribute// + | | **|** | ``⊥`` + | //Binding// | -> | //Attribute// ``↦`` //Object// + | | **|** | //Attribute// ``↦`` ``∅`` + | | **|** | ``Δ`` ``⤍`` //Bytes// + | | **|** | ``λ`` ``⤍`` //Function// + | //[Binding]// | -> | **eps** + | | **|** | //Binding// + | | **|** | //Binding// ``,`` //[Binding]// + | //Attribute// | -> | ``φ`` + | | **|** | ``ρ`` + | | **|** | ``σ`` + | | **|** | ``ν`` + | | **|** | //LabelId// + | | **|** | //AlphaIndex// + | //PeeledObject// | -> | //ObjectHead// //[ObjectAction]// + | //ObjectHead// | -> | ``{`` //[Binding]// ``}`` + | | **|** | ``Φ`` + | | **|** | ``ξ`` + | | **|** | ``⊥`` + | //ObjectAction// | -> | ``{`` //[Binding]// ``}`` + | | **|** | ``.`` //Attribute// + | //[ObjectAction]// | -> | **eps** + | | **|** | //ObjectAction// //[ObjectAction]// + + + +%% File generated by the BNF Converter (bnfc 2.9.6). diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Lex.x b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Lex.x index 6978d4e61..f71d65948 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Lex.x +++ b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Lex.x @@ -1,4 +1,4 @@ --- -*- haskell -*- File generated by the BNF Converter (bnfc 2.9.5). +-- -*- haskell -*- File generated by the BNF Converter (bnfc 2.9.6). -- Lexer definition for use with Alex 3 { @@ -28,7 +28,7 @@ $u = [. \n] -- universal: any character -- Symbols and non-identifier-like reserved words -@rsyms = \Φ | \ξ | \Δ | \λ | \φ | \ρ | \σ | \ν | \{ | \} | \. | \⊥ | \↦ | \∅ | \⤍ | \, +@rsyms = \Φ | \ξ | \Δ | \λ | \φ | \ρ | \σ | \ν | \{ | \} | \⟦ | \⟧ | \( | \) | \. | \⊥ | \↦ | \∅ | \⤍ | \, :- @@ -168,13 +168,14 @@ eitherResIdent tv s = treeFind resWords -- | The keywords and symbols of the language organized as binary search tree. resWords :: BTree resWords = - b "\958" 9 - (b "\916" 5 - (b "{" 3 (b "." 2 (b "," 1 N N) N) (b "}" 4 N N)) - (b "\955" 7 (b "\934" 6 N N) (b "\957" 8 N N))) - (b "\8614" 13 - (b "\963" 11 (b "\961" 10 N N) (b "\966" 12 N N)) - (b "\8869" 15 (b "\8709" 14 N N) (b "\10509" 16 N N))) + b "\958" 11 + (b "}" 6 + (b "," 3 (b ")" 2 (b "(" 1 N N) N) (b "{" 5 (b "." 4 N N) N)) + (b "\955" 9 (b "\934" 8 (b "\916" 7 N N) N) (b "\957" 10 N N))) + (b "\8709" 16 + (b "\966" 14 (b "\963" 13 (b "\961" 12 N N) N) (b "\8614" 15 N N)) + (b "\10215" 19 + (b "\10214" 18 (b "\8869" 17 N N) N) (b "\10509" 20 N N))) where b s n = B bs (TS bs n) where diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Par.y b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Par.y index e07d7cc2d..1fba42102 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Par.y +++ b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Par.y @@ -1,4 +1,4 @@ --- -*- haskell -*- File generated by the BNF Converter (bnfc 2.9.5). +-- -*- haskell -*- File generated by the BNF Converter (bnfc 2.9.6). -- Parser definition for use with Happy { @@ -39,22 +39,26 @@ import Language.EO.Phi.Syntax.Lex %monad { Err } { (>>=) } { return } %tokentype {Token} %token - ',' { PT _ (TS _ 1) } - '.' { PT _ (TS _ 2) } - '{' { PT _ (TS _ 3) } - '}' { PT _ (TS _ 4) } - 'Δ' { PT _ (TS _ 5) } - 'Φ' { PT _ (TS _ 6) } - 'λ' { PT _ (TS _ 7) } - 'ν' { PT _ (TS _ 8) } - 'ξ' { PT _ (TS _ 9) } - 'ρ' { PT _ (TS _ 10) } - 'σ' { PT _ (TS _ 11) } - 'φ' { PT _ (TS _ 12) } - '↦' { PT _ (TS _ 13) } - '∅' { PT _ (TS _ 14) } - '⊥' { PT _ (TS _ 15) } - '⤍' { PT _ (TS _ 16) } + '(' { PT _ (TS _ 1) } + ')' { PT _ (TS _ 2) } + ',' { PT _ (TS _ 3) } + '.' { PT _ (TS _ 4) } + '{' { PT _ (TS _ 5) } + '}' { PT _ (TS _ 6) } + 'Δ' { PT _ (TS _ 7) } + 'Φ' { PT _ (TS _ 8) } + 'λ' { PT _ (TS _ 9) } + 'ν' { PT _ (TS _ 10) } + 'ξ' { PT _ (TS _ 11) } + 'ρ' { PT _ (TS _ 12) } + 'σ' { PT _ (TS _ 13) } + 'φ' { PT _ (TS _ 14) } + '↦' { PT _ (TS _ 15) } + '∅' { PT _ (TS _ 16) } + '⊥' { PT _ (TS _ 17) } + '⟦' { PT _ (TS _ 18) } + '⟧' { PT _ (TS _ 19) } + '⤍' { PT _ (TS _ 20) } L_Bytes { PT _ (T_Bytes $$) } L_Function { PT _ (T_Function $$) } L_LabelId { PT _ (T_LabelId $$) } @@ -80,8 +84,8 @@ Program Object :: { Language.EO.Phi.Syntax.Abs.Object } Object - : '{' ListBinding '}' { Language.EO.Phi.Syntax.Abs.Formation $2 } - | Object '{' ListBinding '}' { Language.EO.Phi.Syntax.Abs.Application $1 $3 } + : '⟦' ListBinding '⟧' { Language.EO.Phi.Syntax.Abs.Formation $2 } + | Object '(' ListBinding ')' { Language.EO.Phi.Syntax.Abs.Application $1 $3 } | Object '.' Attribute { Language.EO.Phi.Syntax.Abs.ObjectDispatch $1 $3 } | 'Φ' '.' Attribute { Language.EO.Phi.Syntax.Abs.GlobalDispatch $3 } | 'ξ' '.' Attribute { Language.EO.Phi.Syntax.Abs.ThisDispatch $3 } diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Print.hs b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Print.hs index 835a64076..a12f4ab9f 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Print.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Syntax/Print.hs @@ -1,4 +1,5 @@ --- File generated by the BNF Converter (bnfc 2.9.5). +-- File generated by the BNF Converter (bnfc 2.9.6). + {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -7,40 +8,23 @@ #endif -- | Pretty-printer for Language. + module Language.EO.Phi.Syntax.Print where -import Data.Char (Char, isSpace) +import Prelude + ( ($), (.) + , Bool(..), (==), (<) + , Int, Integer, Double, (+), (-), (*) + , String, (++) + , ShowS, showChar, showString + , all, elem, foldr, id, map, null, replicate, shows, span + ) +import Data.Char ( Char, isSpace ) import qualified Language.EO.Phi.Syntax.Abs -import Prelude ( - Bool (..), - Double, - Int, - Integer, - ShowS, - String, - all, - elem, - foldr, - id, - map, - null, - replicate, - showChar, - showString, - shows, - span, - ($), - (*), - (+), - (++), - (-), - (.), - (<), - (==), - ) -- | The top-level printing method. -printTree :: (Print a) => a -> String + +printTree :: Print a => a -> String printTree = render . prt 0 type Doc = [ShowS] -> [ShowS] @@ -50,28 +34,25 @@ doc = (:) render :: Doc -> String render d = rend 0 False (map ($ "") $ d []) "" - where - rend :: - Int -> - -- \^ Indentation level. - Bool -> - -- \^ Pending indentation to be output before next character? - [String] -> - ShowS + where + rend + :: Int -- ^ Indentation level. + -> Bool -- ^ Pending indentation to be output before next character? + -> [String] + -> ShowS rend i p = \case - "[" : ts -> char '[' . rend i False ts - "(" : ts -> char '(' . rend i False ts - "{" : ts -> onNewLine i p . showChar '{' . new (i + 1) ts - "}" : ";" : ts -> onNewLine (i - 1) p . showString "};" . new (i - 1) ts - "}" : ts -> onNewLine (i - 1) p . showChar '}' . new (i - 1) ts - [";"] -> char ';' - ";" : ts -> char ';' . new i ts - t : ts@(s : _) - | closingOrPunctuation s -> - pending . showString t . rend i False ts - t : ts -> pending . space t . rend i False ts - [] -> id - where + "[" :ts -> char '[' . rend i False ts + "(" :ts -> char '(' . rend i False ts + "{" :ts -> onNewLine i p . showChar '{' . new (i+1) ts + "}" : ";":ts -> onNewLine (i-1) p . showString "};" . new (i-1) ts + "}" :ts -> onNewLine (i-1) p . showChar '}' . new (i-1) ts + [";"] -> char ';' + ";" :ts -> char ';' . new i ts + t : ts@(s:_) | closingOrPunctuation s + -> pending . showString t . rend i False ts + t :ts -> pending . space t . rend i False ts + [] -> id + where -- Output character after pending indentation. char :: Char -> ShowS char c = pending . showChar c @@ -82,7 +63,7 @@ render d = rend 0 False (map ($ "") $ d []) "" -- Indentation (spaces) for given indentation level. indent :: Int -> ShowS - indent i = replicateS (2 * i) (showChar ' ') + indent i = replicateS (2*i) (showChar ' ') -- Continue rendering in new line with new indentation. new :: Int -> [String] -> ShowS @@ -96,16 +77,16 @@ render d = rend 0 False (map ($ "") $ d []) "" space :: String -> ShowS space t s = case (all isSpace t, null spc, null rest) of - (True, _, True) -> [] -- remove trailing space - (False, _, True) -> t -- remove trailing space - (False, True, False) -> t ++ ' ' : s -- add space if none - _ -> t ++ s - where - (spc, rest) = span isSpace s + (True , _ , True ) -> [] -- remove trailing space + (False, _ , True ) -> t -- remove trailing space + (False, True, False) -> t ++ ' ' : s -- add space if none + _ -> t ++ s + where + (spc, rest) = span isSpace s closingOrPunctuation :: String -> Bool closingOrPunctuation [c] = c `elem` closerOrPunct - closingOrPunctuation _ = False + closingOrPunctuation _ = False closerOrPunct :: String closerOrPunct = ")],;" @@ -123,10 +104,11 @@ 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 {-# OVERLAPPABLE #-} (Print a) => Print [a] where +instance {-# OVERLAPPABLE #-} Print a => Print [a] where prt i = concatD . map (prt i) instance Print Char where @@ -169,8 +151,8 @@ instance Print Language.EO.Phi.Syntax.Abs.Program where instance Print Language.EO.Phi.Syntax.Abs.Object where prt i = \case - Language.EO.Phi.Syntax.Abs.Formation bindings -> prPrec i 0 (concatD [doc (showString "{"), prt 0 bindings, doc (showString "}")]) - Language.EO.Phi.Syntax.Abs.Application object bindings -> prPrec i 0 (concatD [prt 0 object, doc (showString "{"), prt 0 bindings, doc (showString "}")]) + Language.EO.Phi.Syntax.Abs.Formation bindings -> prPrec i 0 (concatD [doc (showString "\10214"), prt 0 bindings, doc (showString "\10215")]) + Language.EO.Phi.Syntax.Abs.Application object bindings -> prPrec i 0 (concatD [prt 0 object, doc (showString "("), prt 0 bindings, doc (showString ")")]) Language.EO.Phi.Syntax.Abs.ObjectDispatch object attribute -> prPrec i 0 (concatD [prt 0 object, doc (showString "."), prt 0 attribute]) Language.EO.Phi.Syntax.Abs.GlobalDispatch attribute -> prPrec i 0 (concatD [doc (showString "\934"), doc (showString "."), prt 0 attribute]) Language.EO.Phi.Syntax.Abs.ThisDispatch attribute -> prPrec i 0 (concatD [doc (showString "\958"), doc (showString "."), prt 0 attribute]) @@ -186,7 +168,7 @@ instance Print Language.EO.Phi.Syntax.Abs.Binding where instance Print [Language.EO.Phi.Syntax.Abs.Binding] where prt _ [] = concatD [] prt _ [x] = concatD [prt 0 x] - prt _ (x : xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] + prt _ (x:xs) = concatD [prt 0 x, doc (showString ","), prt 0 xs] instance Print Language.EO.Phi.Syntax.Abs.Attribute where prt i = \case @@ -215,4 +197,4 @@ instance Print Language.EO.Phi.Syntax.Abs.ObjectAction where instance Print [Language.EO.Phi.Syntax.Abs.ObjectAction] where prt _ [] = concatD [] - prt _ (x : xs) = concatD [prt 0 x, prt 0 xs] + prt _ (x:xs) = concatD [prt 0 x, prt 0 xs] From 854ae6ed13804912b8ca1954626867d12b142f45 Mon Sep 17 00:00:00 2001 From: Abdelrahman Abounegm Date: Tue, 9 Jan 2024 09:02:20 +0300 Subject: [PATCH 2/2] Update tests to use the new syntax --- eo-phi-normalizer/test/eo/phi/normal-1.yaml | 2 +- eo-phi-normalizer/test/eo/phi/normal-2.yaml | 8 ++++---- eo-phi-normalizer/test/eo/phi/test.yaml | 10 +++++----- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/eo-phi-normalizer/test/eo/phi/normal-1.yaml b/eo-phi-normalizer/test/eo/phi/normal-1.yaml index 758437236..889a32292 100644 --- a/eo-phi-normalizer/test/eo/phi/normal-1.yaml +++ b/eo-phi-normalizer/test/eo/phi/normal-1.yaml @@ -1,4 +1,4 @@ -name: "Program in normal form (1)" +name: 'Program in normal form (1)' input: | {} normalized: | diff --git a/eo-phi-normalizer/test/eo/phi/normal-2.yaml b/eo-phi-normalizer/test/eo/phi/normal-2.yaml index 2420abe2f..5efc8bb9c 100644 --- a/eo-phi-normalizer/test/eo/phi/normal-2.yaml +++ b/eo-phi-normalizer/test/eo/phi/normal-2.yaml @@ -1,7 +1,7 @@ -name: "Program in normal form (2)" +name: 'Program in normal form (2)' input: | - { φ ↦ { φ ↦ { φ ↦ { } } } } + { φ ↦ ⟦ φ ↦ ⟦ φ ↦ ⟦ ⟧ ⟧ ⟧ } normalized: | - { φ ↦ { φ ↦ { φ ↦ { } } } } + { φ ↦ ⟦ φ ↦ ⟦ φ ↦ ⟦ ⟧ ⟧ ⟧ } prettified: | - { φ ↦ { φ ↦ { φ ↦ { } } } } + { φ ↦ ⟦ φ ↦ ⟦ φ ↦ ⟦ ⟧ ⟧ ⟧ } diff --git a/eo-phi-normalizer/test/eo/phi/test.yaml b/eo-phi-normalizer/test/eo/phi/test.yaml index 741ee8506..01c49577b 100644 --- a/eo-phi-normalizer/test/eo/phi/test.yaml +++ b/eo-phi-normalizer/test/eo/phi/test.yaml @@ -1,10 +1,10 @@ -name: "Simple static attribute reference" +name: 'Simple static attribute reference' input: | - { φ ↦ { } , a ↦ ξ.φ } + { φ ↦ ⟦ ⟧ , a ↦ ξ.φ } normalized: | { - φ ↦ {}, - a ↦ {} + φ ↦ ⟦⟧, + a ↦ ⟦⟧ } prettified: | - { φ ↦ { }, a ↦ ξ.φ } + { φ ↦ ⟦ ⟧, a ↦ ξ.φ }