Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core

18 files changed, 316 insertions, 68 deletions

diff --git a/testsuite/compiler/check/cyclic/abs-types/test3.gfs.gold b/testsuite/compiler/check/cyclic/abs-types/test3.gfs.gold
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/testsuite/compiler/check/cyclic/abs-types/test3.gfs.gold
diff --git a/testsuite/compiler/check/lincat-types/Predef.gf b/testsuite/compiler/check/lincat-types/Predef.gf
new file mode 100644
index 000000000..fded5ae38
--- /dev/null
+++ b/testsuite/compiler/check/lincat-types/Predef.gf
@@ -0,0 +1,48 @@
+--1 Predefined functions for concrete syntax
+
+-- The definitions of these constants are hard-coded in GF, and defined
+-- in Predef.hs (gf-core/src/compiler/GF/Compile/Compute/Predef.hs).
+-- Applying them to run-time variables leads to compiler errors that are
+-- often only detected at the code generation time.
+
+resource Predef = {
+
+-- This type of booleans is for internal use only.
+
+  param PBool = PTrue | PFalse ;
+
+  oper Error : Type = variants {} ;          -- the empty type
+  oper Float : Type = variants {} ;          -- the type of floats
+  oper Int   : Type = variants {} ;          -- the type of integers
+  oper Ints  : Int -> PType = variants {} ;  -- the type of integers from 0 to n
+
+  oper error  : Str        -> Error    = variants {} ; -- forms error message
+  oper length : Tok ->        Int      = variants {} ; -- length of string
+  oper drop   : Int -> Tok -> Tok      = variants {} ; -- drop prefix of length
+  oper take   : Int -> Tok -> Tok      = variants {} ; -- take prefix of length
+  oper tk     : Int -> Tok -> Tok      = variants {} ; -- drop suffix of length
+  oper dp     : Int -> Tok -> Tok      = variants {} ; -- take suffix of length
+  oper eqInt  : Int -> Int -> PBool    = variants {} ; -- test if equal integers
+  oper lessInt: Int -> Int -> PBool    = variants {} ; -- test order of integers
+  oper plus   : Int -> Int -> Int      = variants {} ; -- add integers
+  oper eqStr  : Tok -> Tok -> PBool    = variants {} ; -- test if equal strings
+  oper occur  : Tok -> Tok -> PBool    = variants {} ; -- test if occurs as substring
+  oper occurs : Tok -> Tok -> PBool    = variants {} ; -- test if any char occurs
+  oper isUpper : Tok       -> PBool    = variants {} ; -- test if all chars are upper-case
+  oper toUpper : Tok       -> Tok      = variants {} ; -- map all chars to upper case
+  oper toLower : Tok       -> Tok      = variants {} ; -- map all chars to lower case
+  oper show   : (P : Type) -> P -> Tok = variants {} ; -- convert param to string
+  oper read   : (P : Type) -> Tok -> P = variants {} ; -- convert string to param
+  oper eqVal  : (P : Type) -> P -> P -> PBool = variants {} ; -- test if equal values
+  oper toStr  : (L : Type) -> L -> Str = variants {} ; -- find the "first" string
+  oper mapStr : (L : Type) -> (Str -> Str) -> L -> L = variants {} ; 
+               -- map all strings in a data structure; experimental ---
+
+  oper nonExist : Str = variants {} ;    -- a placeholder for non-existant morphological forms
+  oper BIND : Str = variants {} ;        -- a token for gluing
+  oper SOFT_BIND : Str = variants {} ;   -- a token for soft gluing
+  oper SOFT_SPACE : Str = variants {} ;  -- a token for soft space
+  oper CAPIT : Str = variants {} ;       -- a token for capitalization
+  oper ALL_CAPIT : Str = variants {} ;   -- a token for capitalization of abreviations
+
+} ;
diff --git a/testsuite/compiler/check/lincat-types/test.gfs.gold b/testsuite/compiler/check/lincat-types/test.gfs.gold
index 7e95ec7af..2e14e89e6 100644
--- a/testsuite/compiler/check/lincat-types/test.gfs.gold
+++ b/testsuite/compiler/check/lincat-types/test.gfs.gold
@@ -1,7 +1,9 @@
 
 
-testsuite/compiler/check/lincat-types/TestCnc.gf:3:
-  Happened in linearization type of S
-    type of PTrue
-   expected: Type
-   inferred: PBool
+testsuite/compiler/check/lincat-types/TestCnc.gf:
+   testsuite/compiler/check/lincat-types/TestCnc.gf:3:
+     Happened in linearization type of S
+       type of PTrue
+      expected: Type
+      inferred: Predef.PBool
+      
diff --git a/testsuite/compiler/check/lins/lins.gfs.gold b/testsuite/compiler/check/lins/lins.gfs.gold
index 149912bde..798c91e43 100644
--- a/testsuite/compiler/check/lins/lins.gfs.gold
+++ b/testsuite/compiler/check/lins/lins.gfs.gold
@@ -1,39 +1,41 @@
-checking module linsCnc

-   Warning: no linearization type for C, inserting default {s : Str}

-   Warning: no linearization of test

-abstract lins {

-  cat C Nat ;

-  cat Float ;

-  cat Int ;

-  cat Nat ;

-  cat String ;

-  fun test : C zero ;

-  fun zero : Nat ;

-}

-concrete linsCnc {

-  productions

-    C1 -> F2[]

-  lindefs

-    C0 -> F0

-    C1 -> F1

-  lin

-    F0 := (S0) [lindef C]

-    F1 := () [lindef Nat]

-    F2 := () [zero]

-  sequences

-    S0 := {0,0}

-  categories

-    C := range  [C0 .. C0]

-         labels ["s"]

-    Float := range  [CFloat .. CFloat]

-             labels ["s"]

-    Int := range  [CInt .. CInt]

-           labels ["s"]

-    Nat := range  [C1 .. C1]

-           labels []

-    String := range  [CString .. CString]

-              labels ["s"]

-    __gfVar := range  [CVar .. CVar]

-               labels [""]

-  printnames

-}

+abstract lins {
+  cat C Nat ;
+  cat Float ;
+  cat Int ;
+  cat Nat ;
+  cat String ;
+  fun test : C zero ;
+  fun zero : Nat ;
+}
+concrete linsCnc {
+  productions
+    C1 -> F4[]
+  lindefs
+    C0 -> F0[CVar]
+    C1 -> F2[CVar]
+  linrefs
+    CVar -> F1[C0]
+    CVar -> F3[C1]
+  lin
+    F0 := (S2) ['lindef C']
+    F1 := (S1) ['lindef C']
+    F2 := () ['lindef Nat']
+    F3 := (S0) ['lindef Nat']
+    F4 := () [zero]
+  sequences
+    S0 :=
+    S1 := <0,0>
+    S2 := {0,0}
+  categories
+    C := range  [C0 .. C0]
+         labels ["s"]
+    Float := range  [CFloat .. CFloat]
+             labels ["s"]
+    Int := range  [CInt .. CInt]
+           labels ["s"]
+    Nat := range  [C1 .. C1]
+           labels []
+    String := range  [CString .. CString]
+              labels ["s"]
+  printnames
+}
diff --git a/testsuite/compiler/check/oper-definition/test.gfs.gold b/testsuite/compiler/check/oper-definition/test.gfs.gold
index 240819c74..373ef17bd 100644
--- a/testsuite/compiler/check/oper-definition/test.gfs.gold
+++ b/testsuite/compiler/check/oper-definition/test.gfs.gold
@@ -1,5 +1,6 @@
 
 
-testsuite/compiler/check/oper-definition/Res.gf:3:
-  Happened in operation my_oper
-   No definition given to the operation
+testsuite/compiler/check/oper-definition/Res.gf:
+   testsuite/compiler/check/oper-definition/Res.gf:3:
+     Happened in operation my_oper
+      No definition given to the operation
diff --git a/testsuite/compiler/check/strMatch/Prelude.gf b/testsuite/compiler/check/strMatch/Prelude.gf
new file mode 100644
index 000000000..1c5b50354
--- /dev/null
+++ b/testsuite/compiler/check/strMatch/Prelude.gf
@@ -0,0 +1,161 @@
+--1 The GF Prelude
+
+-- This file defines some prelude facilities usable in all grammars.
+
+resource Prelude = Predef[nonExist, BIND, SOFT_BIND, SOFT_SPACE, CAPIT, ALL_CAPIT] ** open (Predef=Predef) in {
+
+oper
+
+--2 Strings, records, and tables
+
+  SS  : Type = {s : Str} ;
+  ss  : Str -> SS = \s -> {s = s} ;
+  ss2 : (_,_ : Str) -> SS = \x,y -> ss (x ++ y) ;
+  ss3 : (_,_ ,_: Str) -> SS = \x,y,z -> ss (x ++ y ++ z) ;
+
+  cc2 : (_,_ : SS) -> SS = \x,y -> ss (x.s ++ y.s) ;
+  cc3 : (_,_,_ : SS) -> SS = \x,y,z -> ss (x.s ++ y.s ++ z.s) ;
+
+  SS1 : PType -> Type = \P -> {s : P => Str} ;
+  ss1 : (A : PType) -> Str -> SS1 A = \A,s -> {s = table {_ => s}} ;
+
+  SP1 : Type -> Type = \P -> {s : Str ; p : P} ;
+  sp1 : (A : Type) -> Str -> A -> SP1 A = \_,s,a -> {s = s ; p = a} ;
+
+  constTable : (A : PType) -> (B : Type) -> B -> A => B = \u,v,b -> \\_ => b ;
+  constStr   : (A : PType) -> Str -> A => Str = \A -> constTable A Str ;
+
+-- Discontinuous constituents.
+
+  SD2 : Type = {s1,s2 : Str} ;
+  sd2 : (_,_ : Str) -> SD2 = \x,y -> {s1 = x ; s2 = y} ;
+
+
+--2 Optional elements
+
+-- Optional string with preference on the string vs. empty.
+ 
+  optStr : Str -> Str = \s -> variants {s ; []} ;
+  strOpt : Str -> Str = \s -> variants {[] ; s} ;
+
+-- Free order between two strings.
+
+  bothWays : Str -> Str -> Str = \x,y -> variants {x ++ y ; y ++ x} ;
+
+-- Parametric order between two strings.
+
+  preOrPost : Bool -> Str -> Str -> Str = \pr,x,y -> 
+    if_then_Str pr (x ++ y) (y ++ x) ;
+
+--2 Infixes. prefixes, and postfixes
+
+-- Fixes with precedences are defined in [Precedence Precedence.html].
+
+  infixSS   : Str  -> SS -> SS -> SS = \f,x,y -> ss (x.s ++ f ++ y.s) ;
+  prefixSS  : Str        -> SS -> SS = \f,x   -> ss (f ++ x.s) ;
+  postfixSS : Str        -> SS -> SS = \f,x   -> ss (x.s ++ f) ;
+  embedSS   : Str -> Str -> SS -> SS = \f,g,x -> ss (f ++ x.s ++ g) ;
+
+
+--2 Booleans
+
+ param Bool = False | True ;
+
+oper
+  if_then_else : (A : Type) -> Bool -> A -> A -> A = \_,c,d,e -> 
+    case c of {
+      True => d ;  ---- should not need to qualify
+      False => e
+     } ;
+
+  andB : (_,_ : Bool) -> Bool = \a,b -> if_then_else Bool a b False ;
+  orB  : (_,_ : Bool) -> Bool = \a,b -> if_then_else Bool a True b ;
+  notB : Bool         -> Bool = \a   -> if_then_else Bool a False True ;
+
+  if_then_Str : Bool -> Str -> Str -> Str = if_then_else Str ;
+
+  onlyIf : Bool -> Str -> Str = \b,s -> case b of {
+    True => s ;
+    _ => nonExist
+    } ;
+
+-- Interface to internal booleans
+
+  pbool2bool : Predef.PBool -> Bool = \b -> case b of {
+    Predef.PFalse => False ; Predef.PTrue => True
+    } ;
+
+  init : Tok -> Tok = Predef.tk 1 ;
+  last : Tok -> Tok = Predef.dp 1 ;
+
+--2 High-level acces to Predef operations
+
+  isNil : Tok -> Bool = \b -> pbool2bool (Predef.eqStr [] b) ;
+
+  ifTok : (A : Type) -> Tok -> Tok -> A -> A -> A = \A,t,u,a,b -> 
+    case Predef.eqStr t u of {Predef.PTrue => a ; Predef.PFalse => b} ;
+
+--2 Lexer-related operations
+
+-- Bind together two tokens in some lexers, either obligatorily or optionally
+
+  oper 
+    glue : Str -> Str -> Str = \x,y -> x ++ BIND ++ y ;
+    glueOpt : Str -> Str -> Str = \x,y -> variants {glue x y ; x ++ y} ;
+    noglueOpt : Str -> Str -> Str = \x,y -> variants {x ++ y ; glue x y} ;
+
+-- Force capitalization of next word in some unlexers
+
+    capitalize : Str -> Str = \s -> CAPIT ++ s ;
+
+-- These should be hidden, and never changed since they are hardcoded in (un)lexers
+
+    PARA : Str = "&-" ;
+
+-- Embed between commas, where the latter one disappears in front of other punctuation
+
+    embedInCommas : Str -> Str = \s -> bindComma ++ s ++ endComma ;
+    endComma : Str = pre {"," | "." => []; "" => bindComma ; _ => []} ;
+
+    bindComma : Str = SOFT_BIND ++ "," ;
+    optComma : Str = bindComma | [] ;
+    optCommaSS : SS -> SS = \s -> ss (s.s ++ optComma) ;
+
+--2 Miscellaneous
+
+-- Identity function
+
+  id : (A : Type) -> A -> A = \_,a -> a ;
+
+-- Parentheses
+
+  paren : Str -> Str = \s -> "(" ++ s ++ ")" ;
+  parenss : SS -> SS = \s -> ss (paren s.s) ;
+
+-- Zero, one, two, or more (elements in a list etc)
+
+param
+  ENumber = E0 | E1 | E2 | Emore ;
+
+oper
+  eNext : ENumber -> ENumber = \e -> case e of {
+    E0 => E1 ; E1 => E2 ; _ => Emore} ;
+
+-- convert initial to upper/lower
+
+  toUpperFirst : Str -> Str = \s -> case s of {
+    x@? + xs => Predef.toUpper x + xs ;
+    _ => s
+    } ;
+
+  toLowerFirst : Str -> Str = \s -> case s of {
+    x@? + xs => Predef.toLower x + xs ;
+    _ => s
+    } ;
+
+-- handling errors caused by temporarily missing definitions
+
+  notYet : Str -> Predef.Error = \s ->
+    Predef.error ("NOT YET IMPLEMENTED:" ++ s) ;
+
+}
diff --git a/testsuite/compiler/check/strMatch/strMatch.gfs.gold b/testsuite/compiler/check/strMatch/strMatch.gfs.gold
new file mode 100644
index 000000000..8b1378917
--- /dev/null
+++ b/testsuite/compiler/check/strMatch/strMatch.gfs.gold
@@ -0,0 +1 @@
+
diff --git a/testsuite/compiler/params/params.gfs.gold b/testsuite/compiler/params/params.gfs.gold
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/testsuite/compiler/params/params.gfs.gold
diff --git a/testsuite/compiler/typecheck/abstract/LetInDefAbs.gfs.gold b/testsuite/compiler/typecheck/abstract/LetInDefAbs.gfs.gold
new file mode 100644
index 000000000..e4613af56
--- /dev/null
+++ b/testsuite/compiler/typecheck/abstract/LetInDefAbs.gfs.gold
@@ -0,0 +1,15 @@
+fun f : Int -> Int ;
+def f n = ? ;
+000 CHECK_ARGS  1
+    ALLOC       2
+    PUT_CLOSURE 001
+    SET_PAD
+    TUCK        hp(0) 1
+    EVAL        f tail(0)
+001 ALLOC       2
+    PUT_LIT     0
+    PUSH_FRAME
+    PUSH        hp(0)
+    EVAL        f update
+Probability: 1.0
+
diff --git a/testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs.gold b/testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs.gold
index 588b1643d..bbd381681 100644
--- a/testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs.gold
+++ b/testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs.gold
@@ -1 +1,3 @@
-fun f : (Int -> Int) -> Int -> Int

+fun f : (Int -> Int) -> Int -> Int ;

+Probability: 1.0

+

diff --git a/testsuite/compiler/typecheck/abstract/LitAbs.gf b/testsuite/compiler/typecheck/abstract/LitAbs.gf
index 03f850232..08230b8cf 100644
--- a/testsuite/compiler/typecheck/abstract/LitAbs.gf
+++ b/testsuite/compiler/typecheck/abstract/LitAbs.gf
@@ -5,7 +5,7 @@ cat CStr String ;
     CFloat Float ;

 

 data empty : CStr "" ;

-     null  : CStr [] ;

+    -- null  : CStr [] ; -- Commented out by IL 06/2021: causes parse error

      other : CStr "other" ;

 

 data zero : CInt 0 ;

diff --git a/testsuite/compiler/typecheck/abstract/LitAbs.gfs b/testsuite/compiler/typecheck/abstract/LitAbs.gfs
index ce10daa20..71c4cca29 100644
--- a/testsuite/compiler/typecheck/abstract/LitAbs.gfs
+++ b/testsuite/compiler/typecheck/abstract/LitAbs.gfs
@@ -1,5 +1,4 @@
 i -src testsuite/compiler/typecheck/abstract/LitAbs.gf

-ai null

 ai empty

 ai other

 ai zero

diff --git a/testsuite/compiler/typecheck/abstract/LitAbs.gfs.gold b/testsuite/compiler/typecheck/abstract/LitAbs.gfs.gold
index 83dda9094..2d1e93979 100644
--- a/testsuite/compiler/typecheck/abstract/LitAbs.gfs.gold
+++ b/testsuite/compiler/typecheck/abstract/LitAbs.gfs.gold
@@ -1,5 +1,12 @@
-data null : CStr ""


-data empty : CStr ""


-data other : CStr "other"


-data zero : CInt 0


-data pi : CFloat 3.14


+data empty : CStr "" ;

+Probability: 0.5

+

+data other : CStr "other" ;

+Probability: 0.5

+

+data zero : CInt 0 ;

+Probability: 1.0

+

+data pi : CFloat 3.14 ;

+Probability: 1.0

+

diff --git a/testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs b/testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs
index 0b07b7ed4..1edc94e02 100644
--- a/testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs
+++ b/testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs
@@ -1,2 +1,5 @@
 i -src testsuite/compiler/typecheck/abstract/PolyTypes.gf

-i -src testsuite/compiler/typecheck/abstract/RecTypes.gf
\ No newline at end of file
+ai f

+

+i -src testsuite/compiler/typecheck/abstract/RecTypes.gf

+ai f
\ No newline at end of file
diff --git a/testsuite/compiler/typecheck/abstract/test_A.gfs.gold b/testsuite/compiler/typecheck/abstract/test_A.gfs.gold
index 821a4da2c..d99a5ec08 100644
--- a/testsuite/compiler/typecheck/abstract/test_A.gfs.gold
+++ b/testsuite/compiler/typecheck/abstract/test_A.gfs.gold
@@ -1,5 +1,6 @@
 
 
-testsuite/compiler/typecheck/abstract/A.gf:4:
-  Happened in the category B
-   Prod expected for function A instead of Type
+testsuite/compiler/typecheck/abstract/A.gf:
+   testsuite/compiler/typecheck/abstract/A.gf:4:
+     Happened in the category B
+      Prod expected for function A instead of Type
diff --git a/testsuite/compiler/typecheck/abstract/test_B.gfs.gold b/testsuite/compiler/typecheck/abstract/test_B.gfs.gold
index 1355ff7c5..3c923c6de 100644
--- a/testsuite/compiler/typecheck/abstract/test_B.gfs.gold
+++ b/testsuite/compiler/typecheck/abstract/test_B.gfs.gold
@@ -1,5 +1,6 @@
 
 
-testsuite/compiler/typecheck/abstract/B.gf:5:
-  Happened in the type of function f
-   Prod expected for function S instead of Type
+testsuite/compiler/typecheck/abstract/B.gf:
+   testsuite/compiler/typecheck/abstract/B.gf:5:
+     Happened in the type of function f
+      Prod expected for function S instead of Type
diff --git a/testsuite/compiler/typecheck/abstract/test_C.gfs.gold b/testsuite/compiler/typecheck/abstract/test_C.gfs.gold
index d055b11cd..d86aeda8b 100644
--- a/testsuite/compiler/typecheck/abstract/test_C.gfs.gold
+++ b/testsuite/compiler/typecheck/abstract/test_C.gfs.gold
@@ -1,5 +1,6 @@
 
 
-testsuite/compiler/typecheck/abstract/C.gf:6:
-  Happened in the definition of function f
-   {Int <> S}
+testsuite/compiler/typecheck/abstract/C.gf:
+   testsuite/compiler/typecheck/abstract/C.gf:6:
+     Happened in the definition of function f
+      {Int <> S}
diff --git a/testsuite/compiler/typecheck/concrete/test_A.gfs.gold b/testsuite/compiler/typecheck/concrete/test_A.gfs.gold
index 1bd4dffab..19b66a865 100644
--- a/testsuite/compiler/typecheck/concrete/test_A.gfs.gold
+++ b/testsuite/compiler/typecheck/concrete/test_A.gfs.gold
@@ -1,5 +1,9 @@
 
 
-testsuite/compiler/typecheck/concrete/A.gf:5:
-  Happened in operation silly
-   A function type is expected for a_Det instead of type Str
+testsuite/compiler/typecheck/concrete/A.gf:
+   testsuite/compiler/typecheck/concrete/A.gf:5:
+     Happened in operation silly
+      A function type is expected for a_Det instead of type Str
+      
+   ** Maybe you gave too many arguments to a_Det 
+