r1/parsetng.scm
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 223 646d45b098aa
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
223
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     1
(require 'srfi-1) ; list
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     2
(require 'srfi-13) ; string
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     3
(require 'srfi-14) ; charset
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     4
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     5
(eval-when (compile) (load "packrat.scm"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     6
(require 'util)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     7
(require 'packrat)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     8
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     9
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    10
;; utilities
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    11
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    12
(define (transform-grammar grammar)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    13
  (map (lambda (clause)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    14
	 (let ((v (last clause))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    15
	       (front (butlast clause)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    16
	   (if (procedure? v)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    17
	       clause
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    18
	       (append front (list (lambda args
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    19
				     (debug 3 'reducing clause args)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    20
				     (let walk ((formal v))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    21
				       (cond
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    22
					((null? formal) '())
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    23
					((pair? formal) (cons (walk (car formal))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    24
							      (walk (cdr formal))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    25
					((procedure? formal) (apply formal args))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    26
					((number? formal) (list-ref args formal))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    27
					(else formal)))))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    28
       grammar))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    29
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    30
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    31
;; lex0: categorising characters
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    32
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    33
(define (lex0-ThiNG char-provider-thunk)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    34
  (let ((char (char-provider-thunk)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    35
    (and (not (eof-object? char))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    36
	 (cons (cond
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    37
		((char-set-contains? char-set:letter char) 'letter)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    38
		((char-set-contains? char-set:digit char) 'digit)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    39
		((or (char-whitespace? char)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    40
		     (char-set-contains? char-set:blank char))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    41
		 'whitespace)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    42
		(else (case char
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    43
			((#\() 'oparen)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    44
			((#\)) 'cparen)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    45
			((#\[) 'obrack)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    46
			((#\]) 'cbrack)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    47
			((#\{) 'obrace)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    48
			((#\}) 'cbrace)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    49
			((#\+) 'plus)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    50
			((#\-) 'minus)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    51
			((#\=) 'equal)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    52
			((#\") 'doublequote)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    53
			((#\') 'quote)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    54
			((#\.) 'dot)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    55
			((#\:) 'colon)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    56
			((#\|) 'pipe)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    57
			((#\@) 'at)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    58
			((#\#) 'hash)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    59
			((#\\) 'backslash)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    60
			((#\_) 'underscore)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    61
			((#\*) 'star)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    62
			(else 'misc))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    63
	       char))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    64
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    65
(define (unfold-lex0-ThiNG port)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    66
  (unfold (lambda (dummy) (eof-object? (peek-char port)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    67
	  lex0-ThiNG
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    68
	  (lambda (token) token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    69
	  (lambda () (read-char port))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    70
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    71
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    72
;; lex1: building tokens from categorised character stream
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    73
;;
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    74
;; compound (pseudo-)token kinds:
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    75
;;   identifier   [a-zA-Z][a-zA-Z0-9]*:?
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    76
;;   symbol       [^ ]+
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    77
;;   integer      [-+]?[0-9]+/[^.]
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    78
;;   comment      "([^"\\]|\\"|\\\\])*"
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    79
;;   string       '([^'\\]|\\'|\\\\])*'
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    80
;;   :=
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    81
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    82
(define (make-lex1-ThiNG filename char-provider-thunk)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    83
  (let* ((pushback* '())
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    84
	 (position (top-parse-position filename))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    85
	 (prev-position position))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    86
    (define (next!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    87
      (if (null? pushback*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    88
	  (let* ((newval (lex0-ThiNG char-provider-thunk)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    89
	    (if newval
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    90
		(begin
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    91
		  (set! prev-position position)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    92
		  (set! position (update-parse-position position (cdr newval)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    93
	    newval)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    94
	  (let ((v (car pushback*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    95
	    (set! pushback* (cdr pushback*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    96
	    (set! prev-position position)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    97
	    (set! position (cdr v))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    98
	    (car v))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    99
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   100
    (define (pushback! x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   101
      (set! pushback* (cons (cons x position) pushback*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   102
      (set! position prev-position))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   103
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   104
    (define (go fn . data)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   105
      (dispatch* (next!) fn data))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   106
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   107
    (define (dispatch token fn . data)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   108
      (dispatch* token fn data))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   109
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   110
    (define emit-k 'emit-k)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   111
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   112
    (define (dispatch* token fn data)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   113
      (if token
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   114
	  (apply fn token (car token) (cdr token) data)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   115
	  (emit-k #f)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   116
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   117
    (define (emit kind sv)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   118
      (emit-k (cons prev-position (cons kind sv))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   119
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   120
    (define (lex token kind sv)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   121
      (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   122
	((whitespace) (go lex))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   123
	((minus plus) (go lex-sign token))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   124
	((digit) (pushback! token) (go lex-number #f 0))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   125
	((letter) (go lex-identifier (list sv)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   126
	((colon) (go lex-colon token))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   127
	((doublequote) (go lex-string token '() (lambda (result) (go lex))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   128
	((quote) (go lex-string token '() (lambda (result) (emit 'string result))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   129
	((hash) (go lex-symbol '()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   130
	((misc equal star) (go lex-punct (list sv)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   131
	(else (emit kind sv))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   132
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   133
    (define (lex-sign token kind sv sign-token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   134
      (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   135
      (if (eq? kind 'digit)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   136
	  (go lex-number (car sign-token) 0)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   137
	  (go lex-punct (list (cdr sign-token)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   138
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   139
    (define (lex-punct token kind sv acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   140
      (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   141
	((misc equal star plus minus) (go lex-punct (cons sv acc)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   142
	(else
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   143
	 (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   144
	 (emit 'punct (list->string (reverse acc))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   145
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   146
    (define (lex-number token kind sv sign acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   147
      (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   148
	((digit) (go lex-number sign (+ (* acc 10)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   149
					(- (char->integer sv)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   150
					   (char->integer #\0)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   151
	((dot) (go lex-decimal sign acc token))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   152
	(else
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   153
	 (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   154
	 (finish-integer sign acc))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   155
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   156
    (define (lex-decimal token kind sv sign acc dot-token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   157
      (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   158
	((digit) (error "Illegal syntax - floating-point literals not supported"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   159
	(else
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   160
	 (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   161
	 (pushback! dot-token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   162
	 (finish-integer sign acc))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   163
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   164
    (define (finish-integer sign acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   165
      (emit 'integer (* (if (eq? sign 'minus) -1 1) acc)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   166
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   167
    (define (lex-identifier token kind sv acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   168
      (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   169
	((letter digit) (go lex-identifier (cons sv acc)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   170
	((colon) (go lex-selector-identifier token acc))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   171
	(else
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   172
	 (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   173
	 (finish-identifier 'identifier acc))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   174
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   175
    (define (lex-selector-identifier token kind sv colon-token acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   176
      (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   177
      (if (memq kind '(equal star))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   178
	  (begin
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   179
	    (pushback! colon-token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   180
	    (finish-identifier 'identifier acc))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   181
	  (finish-identifier 'selector (cons #\: acc))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   182
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   183
    (define (lex-symbol token kind sv acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   184
      (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   185
	((letter digit misc equal star plus minus) (go lex-symbol (cons sv acc)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   186
	(else
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   187
	 (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   188
	 (finish-identifier 'symbol acc))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   189
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   190
    (define (finish-identifier kind acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   191
      (let ((idstr (list->string (reverse acc))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   192
	(if (and (eq? kind 'identifier)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   193
		 (string=? idstr "resend"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   194
	    (emit 'resend 'resend)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   195
	    (emit kind idstr))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   196
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   197
    (define (lex-colon token kind sv colon-token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   198
      (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   199
	((equal) (emit 'colonequal #f))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   200
	((star) (emit 'colonstar #f))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   201
	(else
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   202
	 (pushback! token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   203
	 (emit 'colon (cdr colon-token)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   204
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   205
    (define (lex-string token kind sv terminator acc k)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   206
      (if (eq? kind (car terminator))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   207
	  (k (list->string (reverse acc)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   208
	  (case kind
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   209
	    ((backslash) (go (lambda (token2 kind2 sv2)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   210
			       (go lex-string 
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   211
				   terminator
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   212
				   (cons (case sv2
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   213
					   ((#\n) #\newline)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   214
					   ((#\t) #\tab)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   215
					   (else sv2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   216
					 acc)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   217
				   k))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   218
	    (else (go lex-string terminator (cons sv acc) k)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   219
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   220
    (lambda ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   221
      (call-with-current-continuation
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   222
       (lambda (k)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   223
	 (set! emit-k k)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   224
	 (error "Value returned without emit from lexer" (go lex)))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   225
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   226
(define (unfold-lex1-ThiNG port)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   227
  (let ((lexer (make-lex1-ThiNG (lambda () (read-char port))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   228
	(done #f))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   229
    (unfold (lambda (dummy) done)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   230
	    (lambda (dummy)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   231
	      (let ((result (lexer)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   232
		(if (not result)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   233
		    (set! done #t))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   234
		result))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   235
	    (lambda (token) token)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   236
	    'dummy1)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   237
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   238
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   239
;; parsing
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   240
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   241
(define (fixup-nary first-val args)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   242
  (let* ((selectors (map car args))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   243
	 (vals (map cadr args))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   244
	 (selector (string-concatenate selectors)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   245
    `(send ,selector ,(cons first-val vals))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   246
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   247
(define-values (ThiNG-parser ThiNG-topexpr-parser)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   248
  (packrat-parser
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   249
   (values toplevel topexpr)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   250
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   251
   (toplevel ((a <- topexpr 'dot b <- toplevel) (cons a b))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   252
	     ((a <- topexpr 'dot '#f) (list a))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   253
	     ((a <- topexpr '#f) (list a)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   254
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   255
   (topexpr ((a <- method-definition) a)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   256
	    ((a <- expr) a))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   257
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   258
   (expr ((a <- nary) a))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   259
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   260
   (nary ((a <- binary args <- nary-args) (fixup-nary a args))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   261
	 ((a <- binary) a))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   262
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   263
   (nary-args ((sel <- selector b <- binary rest <- nary-args) (cons (list sel b) rest))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   264
	      ((sel <- selector b <- binary) (list (list sel b))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   265
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   266
   (binary ((u1 <- unary k <- binaryk) (k u1)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   267
   (binaryk ((op <- binaryop u2 <- unary k <- binaryk)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   268
	     (lambda (u1) (k `(send ,op (,u1 ,u2)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   269
	    (()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   270
	     (lambda (u1) u1)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   271
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   272
   (binaryop ((p <- 'punct) p))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   273
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   274
   (unary ((v <- value k <- unaryk) (k v)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   275
   (unaryk ((i <- id (! (/ ('colonequal) ('colonstar))) k <- unaryk)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   276
	    (lambda (v) (k `(send ,i (,v)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   277
	   (()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   278
	    (lambda (v) v)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   279
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   280
   (value ((i <- id 'oparen s <- stmt-seq 'cparen) `(scope ,i ,s))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   281
	  ((i <- id) `(ref ,i))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   282
	  ((b <- block) `(block . ,b))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   283
	  ((s <- 'string) `(string ,s))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   284
	  ((s <- 'symbol) `(symbol ,(string->symbol s)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   285
	  ((i <- 'integer) `(number ,i))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   286
	  (('resend) `(resend))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   287
	  (('oparen e <- expr u <- updates+ 'cparen) `(update ,e ,u))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   288
	  (('oparen u <- updates 'cparen) `(update (ref "Root") ,u))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   289
	  (('oparen e <- expr 'cparen) e)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   290
	  (('oparen s <- stmt-seq 'cparen) `(scope ,*nil* ,s))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   291
	  (('obrace ee <- expr-seq 'cbrace) `(tuple ,ee)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   292
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   293
   (updates+ ((u <- update uu <- updates) (cons u uu)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   294
   (updates ((u <- update uu <- updates) (cons u uu))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   295
	    (() '()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   296
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   297
   (update ((i <- id 'colonequal e <- expr) (list *false* i e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   298
	   ((i <- id 'colonstar e <- expr) (list *true* i e)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   299
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   300
   (block (('obrack b <- binders s <- stmt-seq 'cbrack) (list b s)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   301
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   302
   (expr-seq ((e <- expr 'dot ee <- expr-seq) (cons e ee))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   303
	     ((e <- expr) (list e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   304
	     (() '()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   305
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   306
   (stmt-seq ((e <- stmt 'dot s <- stmt-seq) (cons e s))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   307
	     ((e <- stmt) (list e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   308
	     (() '()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   309
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   310
   (stmt ((i <- id 'colonequal e <- expr) `(let ,i ,e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   311
	 ((e <- expr) e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   312
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   313
   (binders ((b <- binders+ 'pipe) b)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   314
	    (() '()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   315
   (binders+ ((b <- binder bb <- binders+) (cons b bb))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   316
	     ((b <- binder) (list b)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   317
   (binder (('colon i <- id) i))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   318
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   319
   (method-definition ((p <- method-params 'obrack ee <- stmt-seq 'cbrack) `(method ,p ,ee)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   320
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   321
   (method-params ((p1 <- method-param op <- binaryop p2 <- method-param) `(send ,op (,p1 ,p2)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   322
		  ((p1 <- method-param n <- method-nary) (fixup-nary p1 n))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   323
		  ((p <- method-param i <- id) `(send ,i (,p))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   324
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   325
   (method-param (('underscore 'at v <- value) (list *false* v))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   326
		 (('underscore) (list *false* *false*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   327
		 ((i <- id 'at v <- value) (list i v))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   328
		 ((i <- id) (list i *false*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   329
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   330
   (method-nary ((s <- selector p <- method-param r <- method-nary) (cons (list s p) r))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   331
		((s <- selector p <- method-param) (list (list s p))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   332
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   333
   (selector ((s <- 'selector) s))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   334
   (id ((i <- 'identifier) i))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   335
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   336
(define (parse-ThiNG filename parser char-provider-thunk)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   337
  (let* ((lexer (make-lex1-ThiNG filename char-provider-thunk))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   338
	 (result (parser (base-generator->results
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   339
			  (lambda ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   340
			    (let ((r (lexer)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   341
			      (if r
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   342
				  (values (car r) (cdr r))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   343
				  (values #f #f))))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   344
    (if (parse-result-successful? result)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   345
	(values #t (parse-result-semantic-value result))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   346
	(let ((e (parse-result-error result)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   347
	  (values #f (list 'parse-error
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   348
			   (parse-position->string (parse-error-position e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   349
			   (parse-error-expected-strings e)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   350
			   (parse-error-messages e)))))))