preced

1 files changed, 117 insertions, 0 deletions

diff --git a/grammars/prelude/Precedence.gf b/grammars/prelude/Precedence.gf
new file mode 100644
index 000000000..1e0b1a77c
--- /dev/null
+++ b/grammars/prelude/Precedence.gf
@@ -0,0 +1,117 @@
+-- operations for precedence-dependent strings.
+-- five levels: 
+-- p4 (constants), p3 (applications), p2 (products), p1 (sums), p0 (arrows)
+
+resource Precedence = open Prelude in {
+
+param 
+Prec = p4 | p3 | p2 | p1 | p0 ;
+
+lintype 
+PrecTerm = Prec => Str ;
+
+oper 
+pss : PrecTerm -> {s : PrecTerm} = \s -> {s = s} ;
+
+
+-- change this if you want some other type of parentheses
+mkParenth : Str -> Str = \str -> "(" ++ str ++ ")" ;
+
+-- define ordering of precedences
+nextPrec : Prec => Prec =
+  table {p0 => p1 ; p1 => p2 ; p2 => p3 ; _ => p4} ;
+prevPrec : Prec => Prec =
+  table {p4 => p3 ; p3 => p2 ; p2 => p1 ; _ => p0} ;
+
+mkPrec : Str -> Prec => Prec => Str = \str ->
+  table {
+    p4 => table {                -- use the term of precedence p4...
+      _   => str} ;              -- ...always without parentheses
+    p3 => table {                -- use the term of precedence p3...
+      p4  => mkParenth str ;     -- ...in parentheses if p4 is required...
+      _   => str} ;              -- ...otherwise without parentheses
+    p2 => table {
+      p4  => mkParenth str ;
+      p3  => mkParenth str ;
+      _   => str} ;              
+    p1 => table {
+      p1  => str ;
+      p0  => str ;
+      _   => mkParenth str} ;
+    p0 => table {
+      p0  => str ;
+      _   => mkParenth str}
+        } ;
+
+-- make a string into a constant, of precedence p4
+mkConst : Str -> PrecTerm = 
+  \f -> 
+  mkPrec f ! p4 ;
+
+-- make a string into a 1/2/3 -place prefix operator, of precedence p3
+mkFun1 : Str -> PrecTerm -> PrecTerm = 
+  \f -> \x ->
+  table {k => mkPrec (f ++ x ! p4) ! p3 ! k} ;
+mkFun2 : Str -> PrecTerm -> PrecTerm -> PrecTerm = 
+  \f -> \x -> \y ->
+  table {k => mkPrec (f ++ x ! p4 ++ y ! p4) ! p3 ! k} ;
+mkFun3 : Str -> PrecTerm -> PrecTerm -> PrecTerm -> PrecTerm = 
+  \f -> \x -> \y -> \z ->
+  table {k => mkPrec (f ++ x ! p4 ++ y ! p4 ++ z ! p4) ! p3 ! k} ;
+
+-- make a string into a non/left/right -associative infix operator, of precedence p
+mkInfix : Str -> Prec -> PrecTerm -> PrecTerm -> PrecTerm = 
+  \f -> \p -> \x -> \y ->
+  table {k => mkPrec (x ! (nextPrec ! p) ++ f ++ y ! (nextPrec ! p)) ! p ! k} ;
+mkInfixL : Str -> Prec -> PrecTerm -> PrecTerm -> PrecTerm = 
+  \f -> \p -> \x -> \y ->
+  table {k => mkPrec (x ! p ++ f ++ y ! (nextPrec ! p)) ! p ! k} ;
+mkInfixR : Str -> Prec -> PrecTerm -> PrecTerm -> PrecTerm = 
+  \f -> \p -> \x -> \y ->
+  table {k => mkPrec (x ! (nextPrec ! p) ++ f ++ y ! p) ! p ! k} ;
+
+-----------------------------------------------------------
+
+-- alternative:
+-- precedence as inherent feature
+
+lintype TermWithPrec = {s : Str ; p : Prec} ;
+
+oper 
+mkpPrec : Str -> Prec -> TermWithPrec =
+  \f -> \p ->
+  {s = f ; p = p} ;
+
+usePrec : TermWithPrec -> Prec -> Str =
+  \x -> \p ->
+  mkPrec x.s ! x.p ! p ;
+
+-- make a string into a constant, of precedence p4
+mkpConst : Str -> TermWithPrec = 
+  \f -> 
+  mkpPrec f p4 ;
+
+-- make a string into a 1/2/3 -place prefix operator, of precedence p3
+mkpFun1 : Str -> TermWithPrec -> TermWithPrec = 
+  \f -> \x ->
+  mkpPrec (f ++ usePrec x p4) p3 ;
+
+mkpFun2 : Str -> TermWithPrec -> TermWithPrec -> TermWithPrec = 
+  \f -> \x -> \y ->
+  mkpPrec (f ++ usePrec x p4 ++ usePrec y p4) p3 ;
+
+mkpFun3 : Str -> TermWithPrec -> TermWithPrec -> TermWithPrec -> TermWithPrec = 
+  \f -> \x -> \y -> \z ->
+  mkpPrec (f ++ usePrec x p4 ++ usePrec y p4 ++ usePrec z p4) p3 ;
+
+-- make a string a into non/left/right -associative infix operator, of precedence p
+mkpInfix : Str -> Prec -> TermWithPrec -> TermWithPrec -> TermWithPrec = 
+  \f -> \p -> \x -> \y ->
+  mkpPrec (usePrec x (nextPrec ! p) ++ f ++ usePrec y (nextPrec ! p)) p ;
+mkpInfixL : Str -> Prec -> TermWithPrec -> TermWithPrec -> TermWithPrec = 
+  \f -> \p -> \x -> \y ->
+  mkpPrec (usePrec x p ++ f ++ usePrec y (nextPrec ! p)) p ;
+mkpInfixR : Str -> Prec -> TermWithPrec -> TermWithPrec -> TermWithPrec = 
+  \f -> \p -> \x -> \y ->
+  mkpPrec (usePrec x (nextPrec ! p) ++ f ++ usePrec y p) p ;
+} ;
\ No newline at end of file