Test

.github/workflows/main.yml

@@ -1,3 +1,5 @@
+name: build
+
 on:
   - push
 jobs:

README.md

@@ -24,11 +24,11 @@ Languages
 Following the racket approach to build small languages, we have build some auxiliar languages 
 to ease the task of use/debug the tool.
 
-* `#lang peg`: default language, provides a parse and pretty printing function for the
+* `#lang typed-peg`: default language, provides a parse and pretty printing function for the
 specified PEG, after infering types for the input PEG.
-* `#lang peg/untyped`: disable the type-inference engine. Use at your own risk!
-* `#lang peg/debug/tokenize-only`: outputs the result of the lexical analyser.
-* `#lang peg/debug/parse-only`: outputs the result of the parser.
-* `#lang peg/debug/constraints-only`: outputs the constraints generated by the algorithm.
-* `#lang peg/debug/z3-script-only`: outputs the z3 script that encode the constraints.
-* `#lang peg/debug/infer-only`: outputs the infered types for each grammar non-terminal.
+* `#lang typed-peg/untyped`: disable the type-inference engine. Use at your own risk!
+* `#lang typed-peg/debug/tokenize-only`: outputs the result of the lexical analyser.
+* `#lang typed-peg/debug/parse-only`: outputs the result of the parser.
+* `#lang typed-peg/debug/constraints-only`: outputs the constraints generated by the algorithm.
+* `#lang typed-peg/debug/z3-script-only`: outputs the z3 script that encode the constraints.
+* `#lang typed-peg/debug/infer-only`: outputs the infered types for each grammar non-terminal.

core.rkt

@@ -12,6 +12,10 @@
   (symb)
   #:prefab)
 
+(struct pany
+  ()
+  #:prefab)
+
 (struct pvar
   (name)
   #:prefab)

examples/test1.rkt

@@ -1,3 +1,3 @@
-#lang typed-peg/untyped
+#lang typed-peg/debug/parse-only
 
-start: ('a' 'a')* 
+start: ('a' 'a')* / ! .

examples/test12.rkt

@@ -4,3 +4,7 @@ K <-- (epsilon '3') / (epsilon '2');
 C <-- ('2' / E) (! K);
 E <-- ('1' / '3') ('3' / C);
 start: (epsilon C) *
+=======
+#lang typed-peg/debug/parse-only
+
+start: "aab"

examples/test13.rkt

@@ -0,0 +1,4 @@
+#lang typed-peg/debug/parse-only
+
+start: & "a" / "bb" +
+

grammar.rkt

@@ -4,6 +4,16 @@
          typed-peg/core
          typed-peg/lexer)
 
+;; converting a string token into a tree of
+;; characters concatenation
+
+(define (string->tree s)
+  (match s
+    ['() (peps)]
+    [(cons c '()) (pchr c)]
+    [(cons c s1) (pcat (pchr c)
+                       (string->tree s1))]))
+
 (define core-parser
   (parser
    (start peg)
@@ -23,12 +33,22 @@
           [(cat) $1])
     (cat [(cat term) (pcat $1 $2)]
          [(term) $1])
-    (term [(NOT term) (pneg $2)]
+    (term [(prefixop term) ($1 $2)]
           [(factor)   $1])
-    (factor [(factor STAR) (pstar $1)]
+    (prefixop [(NOT) (lambda (e) (pneg e))]
+              [(AND) (lambda (e) (pneg (pneg e)))])
+    (factor [(factor postfix) ($2 $1)]
             [(atom) $1])
+    (postfix [(STAR) (lambda (e) (pstar e))]
+             [(PLUS) (lambda (e) (pcat e (pstar e)))]
+             [(OPTION) (lambda (e) (pchoice e peps))])
+    (char-list [(CHAR) (pchr (car (string->list $1)))]
+               [(CHAR COMMA char-list) (pchoice $1 $3)])
     (atom [(EPSILON) (peps)]
           [(CHAR)    (pchr (car (string->list $1)))]
+          [(STRING)  (string->tree (string->list $1))]
+          [(LBRACK char-list RBRACK) $2]
+          [(ANY)     (pany)]
           [(VAR)     (pvar $1)]
           [(LPAREN expr RPAREN) $2])
     )))

info.rkt

@@ -2,7 +2,9 @@
 (define collection "typed-peg")
 (define deps '("base"
                "pprint"
-               "peg-gen"))
+               "peg-gen"
+               "rackcheck"
+               "parser-tools-lib"))
 (define build-deps '("scribble-lib"
                      "racket-doc"
                      "rackunit-lib"))

lexer.rkt

@@ -4,24 +4,50 @@
          (prefix-in : parser-tools/lex-sre))
 
 (define-tokens value-tokens
-  (CHAR VAR))
+  (CHAR VAR STRING))
 
 (define-empty-tokens op-tokens
-  (EOF OR LPAREN RPAREN STAR NOT SEMI EPSILON ARROW START))
+  (EOF OR
+       LPAREN
+       RPAREN
+       STAR
+       NOT
+       SEMI
+       EPSILON
+       ARROW
+       START
+       ANY
+       PLUS
+       OPTION
+       AND
+       LBRACK
+       RBRACK
+       COMMA))
 
 (define next-token
   (lexer-src-pos
    [(eof) (token-EOF)]
    [(:+ whitespace #\newline) (return-without-pos (next-token input-port))]
+   ["." (token-ANY)]
+   ["," (token-COMMA)]
+   ["[" (token-LBRACK)]
+   ["]" (token-RBRACK)]
    ["/" (token-OR)]
+   ["+" (token-PLUS)]
+   ["?" (token-OPTION)]
    ["*" (token-STAR)]
+   ["&" (token-AND)]
    ["<--" (token-ARROW)]
    ["!" (token-NOT)]
    [";" (token-SEMI)]
    ["epsilon" (token-EPSILON)]
    ["start:" (token-START)]
    [#\( (token-LPAREN)]
    [#\) (token-RPAREN)]
+   [(:seq #\" (complement (:seq any-string #\" any-string)) #\")
+    (token-STRING (let* ([s lexeme]
+                         [n (string-length s)])
+                    (substring s 1 (- n 1))))]
    [(:seq alphabetic (:* (:+ alphabetic numeric)))
     (token-VAR lexeme)]
    [(:seq #\' any-char #\') (token-CHAR (let* ([s lexeme]

parser.rkt

@@ -27,6 +27,11 @@
          (cons (tchr c) s1)
          '())]))
 
+(define (run-any s)
+  (match s
+    ['() '()]
+    [(cons c s1) (cons (tchr c) s1)]))
+
 (define (run-var g v s)
   (match (assoc v g)
     [#f (begin
@@ -71,6 +76,7 @@
   (match e
     [(peps) (run-eps s)]
     [(pchr c) (run-chr c s)]
+    [(pany) (run-any s)]
     [(pvar v) (run-var g v s)]
     [(pcat e1 e2) (run-cat g e1 e2 s)]
     [(pchoice e1 e2) (run-choice g e1 e2 s)]

reader.rkt

@@ -19,7 +19,7 @@
   (define grammar (parse port))
   (let ([types (infer grammar)])
     (if (eq? (cdr types) 'unsat)
-        (displayln "The grammar isn't well-typed! It can loop on some inputs.")
+        (error "The grammar isn't well-typed! It can loop on some inputs.")
         (datum->syntax
          #f
          `(module peg-mod racket

scribblings/typed-peg.scrbl

@@ -18,7 +18,8 @@ i.e. terminates its execution on all inputs.
 @section{Requirements}
 
 In order to type check, the tool need a working installation of 
-[Z3 SMT Solver](https://github.com/Z3Prover/z3). The project is known to work with 
+@hyperlink["https://github.com/Z3Prover/z3"]{Z3 SMT Solver}.
+The project is known to work with
 Z3 version 4.8.14.
 
 @section{The language typed-peg}

typing/constraint-gen.rkt

@@ -47,6 +47,7 @@
   (match e
     [(peps) (constr-eq ty (type #t '()))]
     [(pchr c) (constr-eq ty (type #f '()))]
+    [(pany) (constr-eq ty (type #f '()))]
     [(pvar v) (constr-eq (pvar v)
                          ty)]
     [(pchoice e1 e2)