File: _syntax-common.scm

package info (click to toggle)
gambc 4.9.3-1.4
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 85,424 kB
  • sloc: ansic: 1,047,649; lisp: 243,942; perl: 19,018; sh: 6,385; makefile: 6,303; objc: 3,757; cpp: 2,143; sed: 498; java: 305; awk: 198
file content (42 lines) | stat: -rw-r--r-- 1,338 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
;;;============================================================================

;;; File: "_syntax-common.scm"

;;; Copyright (c) 2000-2015 by Marc Feeley, All Rights Reserved.

;;;============================================================================

(define (syn#pvar-id pvar)
  (let ((sym (car pvar)))
    (string->symbol (string-append "##~" (symbol->string sym)))))

;;;----------------------------------------------------------------------------

(define (datum->syntax src datum)
  (##sourcify datum src))

(define (syntax->datum src)
  (##desourcify src))

(define (syntax->list src)
  (cond ((##source? src)
         (let ((code (##source-code src)))
           (if (or (null? code) (pair? code))
               (##map (lambda (x) (##sourcify x src))
                      code)
               (error "list expected"))))
        (else
         (error "source object expected"))))

(define (syntax->vector src)
  (cond ((##source? src)
         (let ((code (##source-code src)))
           (if (vector? code)
               (list->vector
                (##map (lambda (x) (##sourcify x src))
                       (vector->list code)))
               (error "vector expected"))))
        (else
         (error "source object expected"))))

;;;============================================================================