[nongnu] elpa/haskell-tng-mode 0c5acb7 087/385: lexer and grammar supports symid

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 0c5acb7595beaf841071436583adfca25d77e940
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    lexer and grammar supports symid
---
 haskell-tng-font-lock.el  | 74 ++++++++++-------------------------------------
 haskell-tng-lexer.el      | 48 ++++++++++++++++++------------
 haskell-tng-rx.el         | 68 +++++++++++++++++++++++++++++++++++++++++++
 haskell-tng-smie.el       |  9 ++----
 haskell-tng-syntax.el     | 29 ++++++++++---------
 test/src/grammar.hs.sexps |  6 ++--
 test/src/layout.hs.lexer  |  2 +-
 test/src/layout.hs.sexps  | 12 ++++----
 test/src/medley.hs        |  2 ++
 test/src/medley.hs.faceup |  2 ++
 test/src/medley.hs.layout |  2 ++
 test/src/medley.hs.lexer  | 42 ++++++++++++++-------------
 12 files changed, 168 insertions(+), 128 deletions(-)

diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index da9980f..70b98b5 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -35,6 +35,7 @@
 ;;; Code:
 
 (require 'dash)
+(require 'haskell-tng-rx)
 (require 'haskell-tng-util)
 
 (defgroup haskell-tng:faces nil
@@ -67,50 +68,6 @@
   :group 'haskell-tng:faces)
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Here are `rx' patterns that are reused as a very simple form of BNF grammar
-(defconst haskell-tng:rx:conid '(: upper (* word)))
-(defconst haskell-tng:rx:varid '(: (any lower ?_) (* (any word ?_ ?\'))))
-(defconst haskell-tng:rx:qual `(: (+ (: ,haskell-tng:rx:conid (char ?.)))))
-(defconst haskell-tng:rx:consym '(: ":" (+ (syntax symbol))))
-;; TODO restrictive consym, e.g. no :: , @
-(defconst haskell-tng:rx:toplevel
-  ;; TODO multi-definitions, e.g. Servant's :<|>
-  `(: line-start (group (| ,haskell-tng:rx:varid
-                           (: "(" (+? (syntax symbol)) ")")))
-      symbol-end))
-;; note that \n has syntax `comment-end'
-(defconst haskell-tng:rx:newline
-  '(| (syntax comment-end)
-      (: symbol-start
-         "--"
-         (+ (not (syntax comment-end)))
-         (syntax comment-end)))
-  "Newline or line comment.")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Here are compiled regexps that are reused
-(defconst haskell-tng:regexp:reserved
-  (rx (|
-       (: word-start
-          (| "case" "class" "data" "default" "deriving" "do" "else"
-             "foreign" "if" "import" "in" "infix" "infixl"
-             "infixr" "instance" "let" "module" "newtype" "of"
-             "then" "type" "where" "_")
-          word-end)
-       (: symbol-start
-          (| ".." ":" "::" "=" "|" "<-" "->" "@" "~" "=>")
-          symbol-end)
-       (: symbol-start (char ?\\))))
-  "reservedid / reservedop")
-
-(defconst haskell-tng:regexp:qvarid
-  (rx-to-string `(: symbol-start (opt ,haskell-tng:rx:qual) 
,haskell-tng:rx:varid symbol-end)))
-(defconst haskell-tng:regexp:qconid
-  (rx-to-string `(: symbol-start (opt ,haskell-tng:rx:qual) 
,haskell-tng:rx:conid symbol-end)))
-(defconst haskell-tng:regexp:qconsym
-  (rx-to-string `(: ,haskell-tng:rx:consym symbol-end)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Here is the `font-lock-keywords' table of matchers and highlighters.
 (defvar
   haskell-tng:keywords
@@ -118,7 +75,7 @@
   ;; also increases the readability of the code and, in many cases, allows us 
to
   ;; do more work in a single regexp instead of multiple passes.
   (let ((conid haskell-tng:rx:conid)
-        (qual haskell-tng:rx:qual)
+        ;;(qual haskell-tng:rx:qual)
         (consym haskell-tng:rx:consym)
         (toplevel haskell-tng:rx:toplevel)
         (bigspace `(| space ,haskell-tng:rx:newline)))
@@ -150,18 +107,18 @@
       ;; EXT:TypeApplications: It is not easy to disambiguate between type
       ;; applications and value extractor in a pattern. Needs work.
       ;; (,(rx-to-string `(: symbol-start "@" (* space)
-      ;;                     (group (opt ,qual) (| ,conid ,consym))))
+      ;;                     (group (? ,qual) (| ,conid ,consym))))
       ;;  (1 'haskell-tng:type))
 
       ;; imports
       (haskell-tng:font:import:keyword
        (,(rx-to-string
           `(: line-start "import" (+ space)
-              (group (opt word-start "qualified" word-end)) (* space)
+              (group (? word-start "qualified" word-end)) (* space)
               ;; EXT:PackageImports
               ;; EXT:Safe, EXT:Trustworthy, EXT:Unsafe
               (group symbol-start (* ,conid ".") ,conid symbol-end) (* 
,bigspace)
-              (group (opt word-start "hiding" word-end)) (* space)))
+              (group (? word-start "hiding" word-end)) (* space)))
         (haskell-tng:font:multiline:anchor-rewind) nil
         (1 'haskell-tng:keyword)
         (2 'haskell-tng:module)
@@ -232,15 +189,14 @@ If there is no match for GROUP, move to the end of the 
line, canceling this ANCH
 (defun haskell-tng:font:explicit-constructors (limit)
   "Finds paren blocks of constructors when in an import statement.
 Some complexity to avoid matching on operators."
-  (let ((start (point)))
-    (when (re-search-forward
-           (rx (any lower) (* space) "(")
-           limit t)
-      (let ((open (point)))
-        (when-let (close (haskell-tng:paren-close))
-          (when (<= close limit)
-            (goto-char open)
-            (re-search-forward (rx (+ anything)) close t)))))))
+  (when (re-search-forward
+         (rx (any lower) (* space) "(")
+         limit t)
+    (let ((open (point)))
+      (when-let (close (haskell-tng:paren-close))
+        (when (<= close limit)
+          (goto-char open)
+          (re-search-forward (rx (+ anything)) close t))))))
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Here are `function' matchers for use in `font-lock-keywords' and
@@ -337,7 +293,7 @@ succeeds and may further restrict the FIND search limit."
 (haskell-tng:font:multiline deriving
                             (rx word-start "deriving" word-end)
                             (rx word-start "deriving" word-end
-                                (+ space) (group (opt (| "anyclass" "stock" 
"newtype") word-end))
+                                (+ space) (group (? (| "anyclass" "stock" 
"newtype") word-end))
                                 (* space) ?\( (group (* anything)) ?\))
                             haskell-tng:indent-close)
 
@@ -345,7 +301,7 @@ succeeds and may further restrict the FIND search limit."
                             (rx line-start "import" word-end)
                             (rx line-start "import" word-end
                                 (+ (not (any ?\( )))
-                                (opt "(" (group (+ anything))))
+                                (? "(" (group (+ anything))))
                             haskell-tng:indent-close)
 
 (haskell-tng:font:multiline module
diff --git a/haskell-tng-lexer.el b/haskell-tng-lexer.el
index 830f6b2..e5bf3b2 100644
--- a/haskell-tng-lexer.el
+++ b/haskell-tng-lexer.el
@@ -12,7 +12,7 @@
 
 (require 'smie)
 
-(require 'haskell-tng-font-lock)
+(require 'haskell-tng-rx)
 (require 'haskell-tng-layout)
 
 ;; The list of virtual tokens that must be played back at point, or `t' to
@@ -81,26 +81,31 @@ the lexer."
            ;; syntax tables (supported by `smie-indent-forward-token')
            ((looking-at haskell-tng-lexer:fast-syntax) nil)
 
+           ;; If this ordering is changed, things will break, since many 
regexps
+           ;; match more than they should.
+
            ;; known identifiers
            ((looking-at haskell-tng:regexp:reserved)
             (haskell-tng-lexer:last-match))
-           ((looking-at haskell-tng:regexp:qvarid)
-            (haskell-tng-lexer:last-match nil "VARID"))
-           ((looking-at haskell-tng:regexp:qconid)
-            (haskell-tng-lexer:last-match nil "CONID"))
-           ((looking-at haskell-tng:regexp:qconsym)
+           ((looking-at haskell-tng:regexp:qual)
+            ;; Matches qualifiers separately from identifiers because the
+            ;; backwards lexer is not greedy enough. Qualifiers are not
+            ;; interesting from a grammar point of view so we ignore them.
+            (haskell-tng-lexer:last-match nil "")
+            (haskell-tng-lexer:forward-token))
+           ((looking-at haskell-tng:regexp:consym)
             (haskell-tng-lexer:last-match nil "CONSYM"))
-           ;; TODO symid
+           ((looking-at haskell-tng:regexp:conid)
+            (haskell-tng-lexer:last-match nil "CONID"))
+           ((looking-at haskell-tng:regexp:varid)
+            (haskell-tng-lexer:last-match nil "VARID"))
+           ((looking-at haskell-tng:regexp:symid)
+            (haskell-tng-lexer:last-match nil "SYMID"))
            ;; TODO numeric literals
-           ;; TODO l1==l2 is not parsed correctly as VARID SYMID VARID
 
-           ((or
-             ;; known identifiers
-             (looking-at haskell-tng:regexp:reserved)
-             ;; symbols
-             (looking-at (rx (+ (| (syntax word) (syntax symbol))))))
+           ;; unknown things
+           ((looking-at (rx (+ (| (syntax word) (syntax symbol)))))
             (haskell-tng-lexer:last-match))
-
            ;; single char
            (t
             (forward-char)
@@ -136,12 +141,17 @@ the lexer."
               ;; known identifiers
               ((looking-back haskell-tng:regexp:reserved (- (point) 8))
                (haskell-tng-lexer:last-match 'reverse))
-              ((looking-back haskell-tng:regexp:qvarid lbp 't)
-               (haskell-tng-lexer:last-match 'reverse "VARID"))
-              ((looking-back haskell-tng:regexp:qconid lbp 't)
-               (haskell-tng-lexer:last-match 'reverse "CONID"))
-              ((looking-back haskell-tng:regexp:qconsym lbp 't)
+              ((looking-back haskell-tng:regexp:qual lbp 't)
+               (haskell-tng-lexer:last-match 'reverse "")
+               (haskell-tng-lexer:backward-token))
+              ((looking-back haskell-tng:regexp:consym lbp 't)
                (haskell-tng-lexer:last-match 'reverse "CONSYM"))
+              ((looking-back haskell-tng:regexp:conid lbp 't)
+               (haskell-tng-lexer:last-match 'reverse "CONID"))
+              ((looking-back haskell-tng:regexp:varid lbp 't)
+               (haskell-tng-lexer:last-match 'reverse "VARID"))
+              ((looking-back haskell-tng:regexp:symid lbp 't)
+               (haskell-tng-lexer:last-match 'reverse "SYMID"))
               ((looking-back (rx (+ (| (syntax word) (syntax symbol)))) lbp 't)
                (haskell-tng-lexer:last-match 'reverse))
               (t
diff --git a/haskell-tng-rx.el b/haskell-tng-rx.el
new file mode 100644
index 0000000..eb0a9c3
--- /dev/null
+++ b/haskell-tng-rx.el
@@ -0,0 +1,68 @@
+;;; haskell-tng-rx.el --- Internal: regular expressions -*- lexical-binding: t 
-*-
+
+;; Copyright (C) 2018-2019 Tseen She
+;; License: GPL 3 or any later version
+
+;;; Commentary:
+;;
+;;  `rx' expressions and their compiled regexps; used by lexing, syntax table,
+;;  fontification and more.
+;;
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Here are `rx' patterns that are reused as a very simple form of BNF grammar.
+;; Word/symbol boundaries to help backwards regexp searches to be greedy
+(defconst haskell-tng:rx:consym '(: (or "'" ":") ;; Datakinds
+                                    (+ (syntax symbol))))
+(defconst haskell-tng:rx:conid '(: word-start upper (* word)))
+(defconst haskell-tng:rx:varid '(: word-start (any lower ?_) (* (any word))))
+(defconst haskell-tng:rx:symid '(: (+ (syntax symbol))))
+(defconst haskell-tng:rx:qual `(: symbol-start
+                                  (+ (: ,haskell-tng:rx:conid (char ?.)))))
+
+(defconst haskell-tng:rx:reserved
+  '(|
+    (: word-start
+       (| "case" "class" "data" "default" "deriving" "do" "else"
+          "foreign" "if" "import" "in" "infix" "infixl"
+          "infixr" "instance" "let" "module" "newtype" "of"
+          "then" "type" "where" "_")
+       word-end)
+    (: symbol-start
+       (| ".." ":" "::" "=" "|" "<-" "->" "@" "~" "=>")
+       symbol-end)
+    (: symbol-start (char ?\\)))
+  "reservedid / reservedop")
+
+(defconst haskell-tng:rx:toplevel
+  ;; TODO multi-definitions, e.g. Servant's :<|>
+  `(: line-start (group (| ,haskell-tng:rx:varid
+                           (: "(" (+? (syntax symbol)) ")")))
+      symbol-end))
+;; note that \n has syntax `comment-end'
+(defconst haskell-tng:rx:newline
+  '(| (syntax comment-end)
+      (: symbol-start
+         "--"
+         (+ (not (syntax comment-end)))
+         (syntax comment-end)))
+  "Newline or line comment.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Compiled regexps
+(defconst haskell-tng:regexp:reserved
+  (rx-to-string haskell-tng:rx:reserved))
+(defconst haskell-tng:regexp:qual
+  (rx-to-string haskell-tng:rx:qual))
+(defconst haskell-tng:regexp:consym
+  (rx-to-string haskell-tng:rx:consym))
+(defconst haskell-tng:regexp:conid
+  (rx-to-string haskell-tng:rx:conid))
+(defconst haskell-tng:regexp:varid
+  (rx-to-string haskell-tng:rx:varid))
+(defconst haskell-tng:regexp:symid
+  (rx-to-string haskell-tng:rx:symid))
+
+(provide 'haskell-tng-rx)
+;;; haskell-tng-rx.el ends here
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 07254bc..b549e27 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -50,16 +50,11 @@
        ("(" context ")")
        (context "," context))
 
-      ;; operators
-      ;; TODO lexer should identify / normalise operators.
+      ;; operators, we don't care about precedences
       (infixexp
-       (id "$" infixexp)
-       (id "*" infixexp)
-       (id "+" infixexp)
+       (id "SYMID" infixexp)
        (id))
 
-      ;; TODO lexer should identify / normalise ids, consid, etc.
-
       ;; WLDOs
       (wldo
        ("where" decls)
diff --git a/haskell-tng-syntax.el b/haskell-tng-syntax.el
index 1761539..1d32423 100644
--- a/haskell-tng-syntax.el
+++ b/haskell-tng-syntax.el
@@ -10,6 +10,7 @@
 ;;  such as font-lock and SMIE lexing / parsing, where it is needed.
 ;;
 ;;  
https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#Syntax-Tables
+;;  
https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#Syntax-Table-Internals
 ;;
 ;;; Code:
 
@@ -38,16 +39,17 @@
     (--each (string-to-list "!#$%&*+./<=>?@\\^|-~:")
       (modify-syntax-entry it "_" table))
 
-    ;; TODO: should be iff _ is alone or first char
-    ;; small (underscore is a lowercase letter)
+    ;; TODO: debatable. User nav vs fonts and lexing. getting "word boundaries"
+    ;;       is important, same for apostrophe. small (underscore is a 
lowercase
+    ;;       letter)
     (modify-syntax-entry ?_ "w" table)
 
     ;; some special (treated like punctuation)
     (--each (string-to-list ",;")
       (modify-syntax-entry it "." table))
 
-    ;; apostrophe as a symbol, not delimiter
-    (modify-syntax-entry ?\' "_" table)
+    ;; apostrophe as a word, not delimiter
+    (modify-syntax-entry ?\' "w" table)
 
     ;; string delimiter
     (modify-syntax-entry ?\" "\"" table)
@@ -72,23 +74,26 @@
 (defun haskell-tng:syntax-propertize (start end)
   "For some context-sensitive syntax entries."
   (haskell-tng:syntax:char-delims start end)
+  (haskell-tng:syntax:typelevel-lists start end)
   (haskell-tng:syntax:escapes start end))
 
-;; TODO doesn't handle the following correctly
-;;
-;;   foo' 'a' 2
 (defun haskell-tng:syntax:char-delims (start end)
   "Matching apostrophes are string delimiters (literal chars)."
   (goto-char start)
-  (while (re-search-forward "'\\\\?.'" end t)
+  ;;  should handle: foo' 'a' 2 because ' is a word here
+  (while (re-search-forward (rx word-start "'" (? "\\") not-newline "'") end t)
     (let ((open (match-beginning 0))
           (close (- (point) 1)))
       (put-text-property open (1+ open) 'syntax-table '(7 . ?\'))
       (put-text-property close (1+ close) 'syntax-table '(7 . ?\')))))
 
-;; TODO or look for non-string backslashes. While we're at it, we could mark
-;; everything up to the -> with an apat property / category. Alternatively this
-;; would need to be in the lexer (and fontification would miss out).
+(defun haskell-tng:syntax:typelevel-lists (start end)
+  "Apostrophes should be symbols when used in typelevel lists."
+  (goto-char start)
+  (while (re-search-forward (rx space (char ?') (any ?\[ ?:)) end t)
+    (put-text-property (- (point) 1) (point)
+                       'syntax-table '(3 . ?'))))
+
 (defun haskell-tng:syntax:escapes (start end)
   "Backslash inside String is an escape character."
   (goto-char start)
@@ -97,7 +102,5 @@
       (put-text-property (- (point) 1) (point)
                          'syntax-table '(9 . ?\\)))))
 
-;; EXT:ExplicitForAll should turn dots into punctuation
-
 (provide 'haskell-tng-syntax)
 ;;; haskell-tng-syntax.el ends here
diff --git a/test/src/grammar.hs.sexps b/test/src/grammar.hs.sexps
index 2e8f24b..e5cfece 100644
--- a/test/src/grammar.hs.sexps
+++ b/test/src/grammar.hs.sexps
@@ -1,8 +1,8 @@
 -- | Tests for grammar rules i.e. sexps, not indentation
-(module) (Foo.Bar) (where
+(module) (Foo.(Bar)) (where
 
-(((calc) (::) (Int) (->) (Int))
-((calc) (a) = (if) (a) (<) (10)
+((calc) (::) (Int) -> (Int)
+((calc) (a) = (if) (a) < (10)
          (then) (a) + (a) * (a) + (a)
          (else) ((a) + (a)) * ((a) + (a)))
 ))
\ No newline at end of file
diff --git a/test/src/layout.hs.lexer b/test/src/layout.hs.lexer
index 921d495..1920ad6 100644
--- a/test/src/layout.hs.lexer
+++ b/test/src/layout.hs.lexer
@@ -9,7 +9,7 @@ module CONID « CONID , VARID , VARID , VARID , VARID » where
 ; VARID :: CONID VARID -> CONID
 ; VARID VARID = VARID « VARID VARID » where
 { VARID CONID = « »
-; VARID « CONID VARID VARID » = x:xs where { VARID = VARID VARID
+; VARID « CONID VARID VARID » = VARID SYMID VARID where { VARID = VARID VARID
 
 } } ; VARID :: CONID VARID -> « VARID , CONID VARID »
 ; VARID « CONID VARID VARID »
diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps
index 4519f81..fa4bddc 100644
--- a/test/src/layout.hs.sexps
+++ b/test/src/layout.hs.sexps
@@ -3,18 +3,18 @@
 ((data) (Stack) (a) = (Empty)
              (|) (MkStack) (a) ((Stack) (a))
 
-((((push) (::) (a) (->) (Stack) (a)) (->) (Stack) (a)))
+((push) (::) (a) -> (Stack) (a) -> (Stack) (a))
 ((push) (x) (s) = (MkStack) (x) (s))
 
-(((size) (::) (Stack) (a) (->) (Int)))
+((size) (::) (Stack) (a) -> (Int))
 ((size) (s) = (length) ((stkToLst) (s))  (where
            ((stkToLst)  (Empty)         = ([])
-           ((stkToLst) ((MkStack) (x) (s))  = (x:xs) (where ((xs) = (stkToLst) 
(s)
+           ((stkToLst) ((MkStack) (x) (s))  = (x):(xs) (where ((xs) = 
(stkToLst) (s)
 
-))))((pop) (::) (Stack) (a) (->) ((a), (Stack) (a)))
+))))(pop) (::) (Stack) (a) -> ((a), (Stack) (a))
 ((pop) ((MkStack) (x) (s))
-  = ((x), (case) (s) (of ((r (->) (i) (r) (where (i (x) = x))))))) -- pop 
Empty is an error
+  = ((x), (case) (s) (of (r -> (i) (r) (where (i (x) = x)))))) -- pop Empty is 
an error
 
-(((top) (::) (Stack) (a) (->) (a)))
+((top) (::) (Stack) (a) -> (a))
 ((top) ((MkStack) (x) (s)) = (x))))                     -- top Empty is an 
error
 ))
\ No newline at end of file
diff --git a/test/src/medley.hs b/test/src/medley.hs
index b314e8b..2fd20fc 100644
--- a/test/src/medley.hs
+++ b/test/src/medley.hs
@@ -36,6 +36,8 @@ import           System.Process      (CreateProcess (..), 
StdStream (..),
 -- some chars that should be propertized
 chars = ['c', '\n', '\'']
 
+difficult = foo' 'a' 2
+
 foo = "wobble (wibble)"
 
 class Get a s where
diff --git a/test/src/medley.hs.faceup b/test/src/medley.hs.faceup
index 60e2d3d..26359eb 100644
--- a/test/src/medley.hs.faceup
+++ b/test/src/medley.hs.faceup
@@ -36,6 +36,8 @@
 «m:-- »«x:some chars that should be propertized
 »«:haskell-tng:toplevel:chars» «:haskell-tng:keyword:=» 
«:haskell-tng:keyword:[»«s:'c'»«:haskell-tng:keyword:,» 
«s:'\n'»«:haskell-tng:keyword:,» «s:'\''»«:haskell-tng:keyword:]»
 
+«:haskell-tng:toplevel:difficult» «:haskell-tng:keyword:=» foo' «s:'a'» 2
+
 «:haskell-tng:toplevel:foo» «:haskell-tng:keyword:=» «s:"wobble (wibble)"»
 
 «:haskell-tng:keyword:class»«:haskell-tng:type: Get a s 
»«:haskell-tng:keyword:where»
diff --git a/test/src/medley.hs.layout b/test/src/medley.hs.layout
index a87eddb..f3b1a0c 100644
--- a/test/src/medley.hs.layout
+++ b/test/src/medley.hs.layout
@@ -36,6 +36,8 @@ module Foo.Bar.Main
 -- some chars that should be propertized
 ;chars = ['c', '\n', '\'']
 
+;difficult = foo' 'a' 2
+
 ;foo = "wobble (wibble)"
 
 ;class Get a s where
diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer
index 22a7910..21bd33d 100644
--- a/test/src/medley.hs.lexer
+++ b/test/src/medley.hs.lexer
@@ -3,17 +3,17 @@
 
 
 module CONID
-« CONID « .. » , CONID « CONID , « !!! » » , CONID
+« CONID « .. » , CONID « CONID , « SYMID » » , CONID
 
 , VARID , VARID
 , module CONID
 » where
 
-{ import CONID « VARID , VARID , VARID , « <*> » , « <|> » »
+{ import CONID « VARID , VARID , VARID , « SYMID » , « SYMID » »
 ; import CONID « VARID »
-; import CONID « « <$> » »
+; import CONID « « SYMID » »
 ; import CONID « VARID »
-; import CONID « « <> » »
+; import CONID « « SYMID » »
 ; import VARID CONID
 ; import VARID CONID VARID CONID
 ; import VARID CONID
@@ -36,15 +36,17 @@ VARID , VARID , VARID »
 
 ; VARID = « § , § , § »
 
+; VARID = VARID § 2
+
 ; VARID = §
 
 ; class CONID VARID VARID where
 { VARID :: CONID VARID -> VARID
 
-} ; instance CONID VARID « VARID ': VARID » where
+} ; instance CONID VARID « VARID CONSYM VARID » where
 { VARID « CONID VARID _ » = VARID
 
-} ; instance CONID VARID VARID => CONID VARID « VARID ': VARID » where
+} ; instance CONID VARID VARID => CONID VARID « VARID CONSYM VARID » where
 { VARID « CONID _ VARID » = VARID VARID
 
 } ; data CONID = CONID
@@ -55,13 +57,13 @@ VARID , VARID , VARID »
 » deriving « CONID , CONID »
 
 ; class « CONID VARID » => CONID VARID where
-{ « < » , « <= » , « >= » , « > » :: VARID -> VARID -> CONID
-; VARID @Foo , VARID :: VARID -> VARID -> VARID
+{ « SYMID » , « SYMID » , « SYMID » , « SYMID » :: VARID -> VARID -> CONID
+; VARID SYMID CONID , VARID :: VARID -> VARID -> VARID
 
 } ; instance « CONID VARID » => CONID « CONID VARID » where
-{ CONID VARID == CONID VARID = VARID == VARID
-; « CONID VARID VARID » == « CONID VARID VARID » = « l1==l2 » && « r1==r2 »
-; _ == _ = CONID
+{ CONID VARID SYMID CONID VARID = VARID SYMID VARID
+; « CONID VARID VARID » SYMID « CONID VARID VARID » = « VARID SYMID VARID » 
SYMID « VARID SYMID VARID »
+; _ SYMID _ = CONID
 
 } ; data CONID = CONID
 | CONID
@@ -101,12 +103,12 @@ VARID
 
 ; VARID :: CONID CONID
 ; VARID = CONID
-<$> « VARID CONID « VARID § <> VARID § »
-<|> VARID CONID « VARID § <> VARID § »
-<|> VARID CONID « VARID § <> VARID § » »
-<*> VARID
+SYMID « VARID CONID « VARID § SYMID VARID § »
+SYMID VARID CONID « VARID § SYMID VARID § »
+SYMID VARID CONID « VARID § SYMID VARID § » »
+SYMID VARID
 « VARID
-« VARID § <>
+« VARID § SYMID
 VARID § » »
 
 ; type CONID
@@ -116,11 +118,11 @@ VARID § » »
 CONSYM CONID § CONID
 CONSYM CONID CONID CONID
 CONSYM CONID
-CONSYM CONID ' « CONID » « CONID CONID »
-CONSYM § CONSYM CONID ' « CONID » CONID
+CONSYM CONID CONSYM CONID » « CONID CONID »
+CONSYM § CONSYM CONID CONSYM CONID » CONID
 CONSYM CONID CONID CONID
 CONSYM CONID
-CONSYM CONID ' « CONID » « CONID CONID »
+CONSYM CONID CONSYM CONID » « CONID CONID »
 
 ; deriving instance CONID CONID
 ; deriving VARID instance CONID CONID
@@ -130,5 +132,5 @@ CONSYM CONID ' « CONID » « CONID CONID »
 where { VARID = _
 
 
-; « + » = _
+; « SYMID » = _
 } }