--- a/r2/parsetng.scm Fri Oct 14 10:08:56 2005 +1300
+++ b/r2/parsetng.scm Mon Oct 17 06:52:28 2005 +1300
@@ -1,8 +1,3 @@
-(require 'srfi-1)
-(require 'srfi-13)
-(load "json-scheme/portable-packrat.scm")
-(load "../lib/pregexp-20050502/pregexp.scm")
-
(define (port-results filename p)
(base-generator->results
(let ((ateof #f)
@@ -131,7 +126,9 @@
(define-packrat-cached atom (packrat-regex 'atom "[A-Z]"midsym"*"))
(define-packrat-cached var (packrat-regex 'var "[a-z]"midsym"*"))
(define-packrat-cached infixop-raw (packrat-regex 'infixop p midsym"*"))
- (define-packrat-cached integer (packrat-regex 'integer "-?[0-9]+"))
+ (define-packrat-cached integer (packrat-regex 'integer "[0-9]+"))
+ (define (make-binary op left right)
+ `(adj ,op (adj ,left (adj ,right (tuple)))))
(define (rewrite-infix parts)
(let loop ((left (second parts))
(parts parts))
@@ -140,20 +137,23 @@
(op (car parts)) (parts (cdr parts))
(rest (car parts)))
(if at-end
- `(adj ,op (adj (tuple ,left ,rest) (tuple)))
- (loop `(adj ,op (adj (tuple ,left ,(second rest)) (tuple)))
+ (make-binary op left rest)
+ (loop (make-binary op left (second rest))
rest)))))
(values tuple1 toplevel))
- (toplevel ((d <- tuple0 white '#\; '#\;) d))
+ (toplevel ((d <- tuple1 white '#\; '#\;) d)
+ ((white '#f) `(atom |Quit|)))
(datum ((s <- tuple0) s))
(tuple0 ((s <- tuple1) s)
(() '(tuple)))
(tuple1 ((s <- tuple1*) (if (= (length s) 2) (cadr s) s)))
(tuple1* ((d <- fun white '#\, s <- tuple1*) `(tuple ,d ,@(cdr s)))
((d <- fun) `(tuple ,d)))
- (fun ((e <- entry white d <- fun) `(fun ,e ,@(cdr d)))
- ((e <- entry) `(fun ,e))
+ (fun ((f <- fun*) f)
+ ((v <- funcall f <- fun*) `(adj ,v (adj (quote ,f) (tuple))))
((v <- funcall) v))
+ (fun* ((e <- entry white d <- fun*) `(fun ,e ,@(cdr d)))
+ ((e <- entry) `(fun ,e)))
(entry ((k <- simple colon v <- funcall) (list k v)))
(semi ((white '#\; (! '#\;)) 'semi))
(colon ((white '#\:) 'colon))
@@ -161,23 +161,25 @@
((a <- adj) a))
(funcall* ((a <- adj o <- infixop b <- funcall*) (list #f a o b))
((a <- adj o <- infixop b <- adj) (list #t a o b)))
- (infixop ((white r <- infixop-raw) `(atom ,(string->symbol r))))
- (adj ((a <- adj*) (if (equal? (caddr a) '(tuple)) (cadr a) a)))
- (adj* ((v <- simple white vs <- adj*) `(adj ,v ,vs))
+ (infixop ((white r <- infixop-raw) `(var ,(string->symbol r))))
+ (adj ((v <- simple white vs <- adj2) `(adj ,v ,vs))
+ ((v <- simple semi vs <- simple) `(adj ,v ,vs))
+ ((v <- simple (! colon)) v))
+ (adj2 ((v <- simple white vs <- adj2) `(adj ,v ,vs))
((v <- simple semi vs <- simple) `(adj ,v ,vs))
((v <- simple (! colon)) `(adj ,v (tuple))))
(simple ((white d1 <- simple1) d1))
(simple1 (('#\( o <- infixop white '#\)) o)
(('#\( d <- datum white '#\)) d)
- (('#\{ d <- datum white '#\}) `(quote ,d))
- (('#\[ d <- datum white '#\]) `(meta ,d))
+ (('#\[ d <- datum white '#\]) `(quote ,d))
+ (('#\{ d <- datum white '#\}) `(meta-quote ,d))
((l <- literal) `(lit ,l))
- ((a <- atom) `(atom ,(string->symbol a)))
((a <- var) `(var ,(string->symbol a)))
+ ((a <- atom) `(atom ,(string->symbol a)))
+ (('#\' s <- string-body) `(atom ,(string->symbol s)))
(('#\_) `(discard)))
- (str (('#\' s <- string-body) s))
(literal ((i <- integer) (string->number i))
- ((s <- str) s)))))
+ (('#\- i <- integer) (- (string->number i)))))))
(define read-ThiNG
(lambda ()
@@ -188,49 +190,3 @@
(lambda (s)
(parse-result->value "While parsing ThiNG"
(parse-ThiNG (string-results "<string>" s)))))
-
-; (define (cst->v cst)
-; (if (pair? cst)
-; (cond
-; ((eq? (car cst) 'adj)
-; (cons (cst->v (cadr cst))
-; (cst->v (caddr cst))))
-; ((and (eq? (car cst) 'tuple)
-; (null? (cdr cst)))
-; '())
-; ((eq? (car cst) 'quote)
-; (list 'quote (cst->v (cadr cst))))
-; (else
-; (list->vector (map cst->v cst))))
-; cst))
-
-(define (repl-ThiNG)
- (display ">>>ThiNG>>> ")
- (let ((x (fluid-let ((error (lambda x `(ERROR ,@x))))
- (read-ThiNG))))
- (newline)
- ;;(pretty-print (cst->v x))
- (pretty-print x)
- (newline)
- (if (not (equal? x '(atom Quit)))
- (repl-ThiNG))))
-
-"
-define map {
- (_ f Nil) : Nil
- (_ f (Hd: h Tl: t)) : (Hd: f h Tl: map f t)
-};;
-
-define fold-left {
- (_ kons knil Nil) : knil
- (_ kons knil (Hd: h Tl: t)) : fold-left kons (kons h knil) t
-};;
-
-map {x: x + 1} [1, 2, 3];;
-
-map {x: x + 1} (list 1 2 3);;
-
-
- {x: (Update: {} Set: x To: 123)} 'hi';;
-
-"