refine error messages
This commit is contained in:
Yuichi Nishiwaki
parent
bcf53b9883
commit
4d18610a79
|
|
@ -109,7 +109,7 @@ my $src = <<'EOL';
|
||||||
(list the-define
|
(list the-define
|
||||||
(car (cadr form))
|
(car (cadr form))
|
||||||
(cons the-lambda (cons (cdr (cadr form)) (cddr form))))
|
(cons the-lambda (cons (cdr (cadr form)) (cddr form))))
|
||||||
(error "illegal define form" form)))))
|
(error "define: binding to non-varaible object" form)))))
|
||||||
(length form))))
|
(length form))))
|
||||||
|
|
||||||
(builtin:define-macro define-macro
|
(builtin:define-macro define-macro
|
||||||
|
|
@ -117,7 +117,7 @@ my $src = <<'EOL';
|
||||||
(if (= (length form) 3)
|
(if (= (length form) 3)
|
||||||
(if (variable? (cadr form))
|
(if (variable? (cadr form))
|
||||||
(cons the-builtin-define-macro (cdr form))
|
(cons the-builtin-define-macro (cdr form))
|
||||||
(error "illegal define-macro form" form))
|
(error "define-macro: binding to non-variable object" form))
|
||||||
(error "illegal define-macro form" form))))
|
(error "illegal define-macro form" form))))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -760,250 +760,250 @@ const char pic_boot[][80] = {
|
||||||
"n-define (cdr form))\n (error \"illegal define form\" form))\n ",
|
"n-define (cdr form))\n (error \"illegal define form\" form))\n ",
|
||||||
" (if (pair? (cadr form))\n (list the-define\n ",
|
" (if (pair? (cadr form))\n (list the-define\n ",
|
||||||
" (car (cadr form))\n (cons the-lambda (con",
|
" (car (cadr form))\n (cons the-lambda (con",
|
||||||
"s (cdr (cadr form)) (cddr form))))\n (error \"illegal define for",
|
"s (cdr (cadr form)) (cddr form))))\n (error \"define: binding to",
|
||||||
"m\" form)))))\n (length form))))\n\n(builtin:define-macro define-macro\n (lambda",
|
" non-varaible object\" form)))))\n (length form))))\n\n(builtin:define-macro def",
|
||||||
" (form env)\n (if (= (length form) 3)\n (if (variable? (cadr form))\n ",
|
"ine-macro\n (lambda (form env)\n (if (= (length form) 3)\n (if (variable",
|
||||||
" (cons the-builtin-define-macro (cdr form))\n (error \"illegal d",
|
"? (cadr form))\n (cons the-builtin-define-macro (cdr form))\n ",
|
||||||
"efine-macro form\" form))\n (error \"illegal define-macro form\" form))))\n\n\n(",
|
" (error \"define-macro: binding to non-variable object\" form))\n (error \"i",
|
||||||
"define-macro syntax-error\n (lambda (form _)\n (apply error (cdr form))))\n\n(de",
|
"llegal define-macro form\" form))))\n\n\n(define-macro syntax-error\n (lambda (form ",
|
||||||
"fine-macro define-auxiliary-syntax\n (lambda (form _)\n (define message\n ",
|
"_)\n (apply error (cdr form))))\n\n(define-macro define-auxiliary-syntax\n (lamb",
|
||||||
"(string-append\n \"invalid use of auxiliary syntax: '\" (symbol->string (cadr",
|
"da (form _)\n (define message\n (string-append\n \"invalid use of auxi",
|
||||||
" form)) \"'\"))\n (list\n the-define-macro\n (cadr form)\n (list the-la",
|
"liary syntax: '\" (symbol->string (cadr form)) \"'\"))\n (list\n the-define-ma",
|
||||||
"mbda '_\n (list (the 'error) message)))))\n\n(define-auxiliary-syntax els",
|
"cro\n (cadr form)\n (list the-lambda '_\n (list (the 'error) mess",
|
||||||
"e)\n(define-auxiliary-syntax =>)\n(define-auxiliary-syntax unquote)\n(define-auxili",
|
"age)))))\n\n(define-auxiliary-syntax else)\n(define-auxiliary-syntax =>)\n(define-au",
|
||||||
"ary-syntax unquote-splicing)\n(define-auxiliary-syntax syntax-unquote)\n(define-au",
|
"xiliary-syntax unquote)\n(define-auxiliary-syntax unquote-splicing)\n(define-auxil",
|
||||||
"xiliary-syntax syntax-unquote-splicing)\n\n(define-macro let\n (lambda (form env)\n",
|
"iary-syntax syntax-unquote)\n(define-auxiliary-syntax syntax-unquote-splicing)\n\n(",
|
||||||
" (if (variable? (cadr form))\n (list\n (list the-lambda '()\n ",
|
"define-macro let\n (lambda (form env)\n (if (variable? (cadr form))\n (l",
|
||||||
" (list the-define (cadr form)\n (cons the-lambda\n ",
|
"ist\n (list the-lambda '()\n (list the-define (cadr form)\n ",
|
||||||
" (cons (map car (car (cddr form)))\n ",
|
" (cons the-lambda\n (cons (map car (c",
|
||||||
" (cdr (cddr form)))))\n (cons (cadr form) (map cadr (car",
|
"ar (cddr form)))\n (cdr (cddr form)))))\n ",
|
||||||
" (cddr form))))))\n (cons\n (cons\n the-lambda\n (c",
|
" (cons (cadr form) (map cadr (car (cddr form))))))\n (cons\n (",
|
||||||
"ons (map car (cadr form))\n (cddr form)))\n (map cadr (cadr",
|
"cons\n the-lambda\n (cons (map car (cadr form))\n ",
|
||||||
" form))))))\n\n(define-macro and\n (lambda (form env)\n (if (null? (cdr form))\n ",
|
"(cddr form)))\n (map cadr (cadr form))))))\n\n(define-macro and\n (lambda (",
|
||||||
" #t\n (if (null? (cddr form))\n (cadr form)\n (l",
|
"form env)\n (if (null? (cdr form))\n #t\n (if (null? (cddr form))\n",
|
||||||
"ist the-if\n (cadr form)\n (cons (the 'and) (cdd",
|
" (cadr form)\n (list the-if\n (cadr form)\n ",
|
||||||
"r form))\n #f)))))\n\n(define-macro or\n (lambda (form env)\n (i",
|
" (cons (the 'and) (cddr form))\n #f)))))\n\n(defin",
|
||||||
"f (null? (cdr form))\n #f\n (let ((tmp (make-identifier 'it env)))\n ",
|
"e-macro or\n (lambda (form env)\n (if (null? (cdr form))\n #f\n (l",
|
||||||
" (list (the 'let)\n (list (list tmp (cadr form)))\n ",
|
"et ((tmp (make-identifier 'it env)))\n (list (the 'let)\n ",
|
||||||
" (list the-if\n tmp\n tmp\n ",
|
"(list (list tmp (cadr form)))\n (list the-if\n ",
|
||||||
" (cons (the 'or) (cddr form))))))))\n\n(define-macro cond\n (lambda ",
|
" tmp\n tmp\n (cons (the 'or) (cddr form)",
|
||||||
"(form env)\n (let ((clauses (cdr form)))\n (if (null? clauses)\n #",
|
")))))))\n\n(define-macro cond\n (lambda (form env)\n (let ((clauses (cdr form)))",
|
||||||
"undefined\n (let ((clause (car clauses)))\n (if (and (variable",
|
"\n (if (null? clauses)\n #undefined\n (let ((clause (car cla",
|
||||||
"? (car clause))\n (variable=? (the 'else) (make-identifier (c",
|
"uses)))\n (if (and (variable? (car clause))\n (vari",
|
||||||
"ar clause) env)))\n (cons the-begin (cdr clause))\n ",
|
"able=? (the 'else) (make-identifier (car clause) env)))\n (cons th",
|
||||||
"(if (and (variable? (cadr clause))\n (variable=? (the '=>",
|
"e-begin (cdr clause))\n (if (and (variable? (cadr clause))\n ",
|
||||||
") (make-identifier (cadr clause) env)))\n (let ((tmp (make-ide",
|
" (variable=? (the '=>) (make-identifier (cadr clause) env)))\n ",
|
||||||
"ntifier 'tmp here)))\n (list (the 'let) (list (list tmp (car",
|
" (let ((tmp (make-identifier 'tmp here)))\n ",
|
||||||
" clause)))\n (list the-if tmp\n ",
|
" (list (the 'let) (list (list tmp (car clause)))\n (li",
|
||||||
" (list (car (cddr clause)) tmp)\n (cons",
|
"st the-if tmp\n (list (car (cddr clause)) tmp)\n ",
|
||||||
" (the 'cond) (cdr clauses)))))\n (list the-if (car clause)\n ",
|
" (cons (the 'cond) (cdr clauses)))))\n ",
|
||||||
" (cons the-begin (cdr clause))\n (",
|
" (list the-if (car clause)\n (cons the-begin (cd",
|
||||||
"cons (the 'cond) (cdr clauses))))))))))\n\n(define-macro quasiquote\n (lambda (for",
|
"r clause))\n (cons (the 'cond) (cdr clauses))))))))))\n\n(",
|
||||||
"m env)\n\n (define (quasiquote? form)\n (and (pair? form)\n (varia",
|
"define-macro quasiquote\n (lambda (form env)\n\n (define (quasiquote? form)\n ",
|
||||||
"ble? (car form))\n (variable=? (the 'quasiquote) (make-identifier (car ",
|
" (and (pair? form)\n (variable? (car form))\n (variable=? (t",
|
||||||
"form) env))))\n\n (define (unquote? form)\n (and (pair? form)\n (v",
|
"he 'quasiquote) (make-identifier (car form) env))))\n\n (define (unquote? form)",
|
||||||
"ariable? (car form))\n (variable=? (the 'unquote) (make-identifier (car",
|
"\n (and (pair? form)\n (variable? (car form))\n (variable=",
|
||||||
" form) env))))\n\n (define (unquote-splicing? form)\n (and (pair? form)\n ",
|
"? (the 'unquote) (make-identifier (car form) env))))\n\n (define (unquote-splic",
|
||||||
" (pair? (car form))\n (variable? (caar form))\n (variab",
|
"ing? form)\n (and (pair? form)\n (pair? (car form))\n (var",
|
||||||
"le=? (the 'unquote-splicing) (make-identifier (caar form) env))))\n\n (define (",
|
"iable? (caar form))\n (variable=? (the 'unquote-splicing) (make-identif",
|
||||||
"qq depth expr)\n (cond\n ;; unquote\n ((unquote? expr)\n (if",
|
"ier (caar form) env))))\n\n (define (qq depth expr)\n (cond\n ;; unquo",
|
||||||
" (= depth 1)\n (car (cdr expr))\n (list (the 'list)\n ",
|
"te\n ((unquote? expr)\n (if (= depth 1)\n (car (cdr expr))\n",
|
||||||
" (list (the 'quote) (the 'unquote))\n (qq (- depth 1) (",
|
" (list (the 'list)\n (list (the 'quote) (the 'unquote",
|
||||||
"car (cdr expr))))))\n ;; unquote-splicing\n ((unquote-splicing? expr)\n",
|
"))\n (qq (- depth 1) (car (cdr expr))))))\n ;; unquote-spli",
|
||||||
" (if (= depth 1)\n (list (the 'append)\n (car (",
|
"cing\n ((unquote-splicing? expr)\n (if (= depth 1)\n (list ",
|
||||||
"cdr (car expr)))\n (qq depth (cdr expr)))\n (list (the",
|
"(the 'append)\n (car (cdr (car expr)))\n (qq dep",
|
||||||
" 'cons)\n (list (the 'list)\n (list (the '",
|
"th (cdr expr)))\n (list (the 'cons)\n (list (the 'list",
|
||||||
"quote) (the 'unquote-splicing))\n (qq (- depth 1) (car (cd",
|
")\n (list (the 'quote) (the 'unquote-splicing))\n ",
|
||||||
"r (car expr)))))\n (qq depth (cdr expr)))))\n ;; quasiquote",
|
" (qq (- depth 1) (car (cdr (car expr)))))\n (qq dep",
|
||||||
"\n ((quasiquote? expr)\n (list (the 'list)\n (list (the '",
|
"th (cdr expr)))))\n ;; quasiquote\n ((quasiquote? expr)\n (list ",
|
||||||
"quote) (the 'quasiquote))\n (qq (+ depth 1) (car (cdr expr)))))\n ",
|
"(the 'list)\n (list (the 'quote) (the 'quasiquote))\n (q",
|
||||||
" ;; list\n ((pair? expr)\n (list (the 'cons)\n (qq dept",
|
"q (+ depth 1) (car (cdr expr)))))\n ;; list\n ((pair? expr)\n (l",
|
||||||
"h (car expr))\n (qq depth (cdr expr))))\n ;; vector\n ((ve",
|
"ist (the 'cons)\n (qq depth (car expr))\n (qq depth (cdr",
|
||||||
"ctor? expr)\n (list (the 'list->vector) (qq depth (vector->list expr))))\n ",
|
" expr))))\n ;; vector\n ((vector? expr)\n (list (the 'list->vect",
|
||||||
" ;; simple datum\n (else\n (list (the 'quote) expr))))\n\n (let",
|
"or) (qq depth (vector->list expr))))\n ;; simple datum\n (else\n ",
|
||||||
" ((x (cadr form)))\n (qq 1 x))))\n\n(define-macro let*\n (lambda (form env)\n ",
|
" (list (the 'quote) expr))))\n\n (let ((x (cadr form)))\n (qq 1 x))))\n\n(def",
|
||||||
" (let ((bindings (car (cdr form)))\n (body (cdr (cdr form))))\n ",
|
"ine-macro let*\n (lambda (form env)\n (let ((bindings (car (cdr form)))\n ",
|
||||||
" (if (null? bindings)\n `(,(the 'let) () ,@body)\n `(,(the 'let)",
|
" (body (cdr (cdr form))))\n (if (null? bindings)\n `(,(the 'l",
|
||||||
" ((,(car (car bindings)) ,@(cdr (car bindings))))\n (,(the 'let*) (,@(",
|
"et) () ,@body)\n `(,(the 'let) ((,(car (car bindings)) ,@(cdr (car bindi",
|
||||||
"cdr bindings))\n ,@body))))))\n\n(define-macro letrec\n (lambda (form e",
|
"ngs))))\n (,(the 'let*) (,@(cdr bindings))\n ,@body))))))\n\n",
|
||||||
"nv)\n `(,(the 'letrec*) ,@(cdr form))))\n\n(define-macro letrec*\n (lambda (form",
|
"(define-macro letrec\n (lambda (form env)\n `(,(the 'letrec*) ,@(cdr form))))\n",
|
||||||
" env)\n (let ((bindings (car (cdr form)))\n (body (cdr (cdr form))",
|
"\n(define-macro letrec*\n (lambda (form env)\n (let ((bindings (car (cdr form))",
|
||||||
"))\n (let ((variables (map (lambda (v) `(,v #f)) (map car bindings)))\n ",
|
")\n (body (cdr (cdr form))))\n (let ((variables (map (lambda (v)",
|
||||||
" (initials (map (lambda (v) `(,(the 'set!) ,@v)) bindings)))\n `(,(t",
|
" `(,v #f)) (map car bindings)))\n (initials (map (lambda (v) `(,(the ",
|
||||||
"he 'let) (,@variables)\n ,@initials\n ,@body)))))\n\n(define-macro",
|
"'set!) ,@v)) bindings)))\n `(,(the 'let) (,@variables)\n ,@initial",
|
||||||
" let-values\n (lambda (form env)\n `(,(the 'let*-values) ,@(cdr form))))\n\n(def",
|
"s\n ,@body)))))\n\n(define-macro let-values\n (lambda (form env)\n `(,(t",
|
||||||
"ine-macro let*-values\n (lambda (form env)\n (let ((formal (car (cdr form)))\n ",
|
"he 'let*-values) ,@(cdr form))))\n\n(define-macro let*-values\n (lambda (form env)",
|
||||||
" (body (cdr (cdr form))))\n (if (null? formal)\n `(,(the '",
|
"\n (let ((formal (car (cdr form)))\n (body (cdr (cdr form))))\n ",
|
||||||
"let) () ,@body)\n `(,(the 'call-with-values) (,the-lambda () ,@(cdr (car",
|
"(if (null? formal)\n `(,(the 'let) () ,@body)\n `(,(the 'call-wi",
|
||||||
" formal)))\n (,(the 'lambda) (,@(car (car formal)))\n (,(th",
|
"th-values) (,the-lambda () ,@(cdr (car formal)))\n (,(the 'lambda) (,@",
|
||||||
"e 'let*-values) (,@(cdr formal))\n ,@body)))))))\n\n(define-macro defi",
|
"(car (car formal)))\n (,(the 'let*-values) (,@(cdr formal))\n ",
|
||||||
"ne-values\n (lambda (form env)\n (let ((formal (car (cdr form)))\n (bo",
|
" ,@body)))))))\n\n(define-macro define-values\n (lambda (form env)\n (let ((",
|
||||||
"dy (cdr (cdr form))))\n (let ((arguments (make-identifier 'arguments here)",
|
"formal (car (cdr form)))\n (body (cdr (cdr form))))\n (let ((argum",
|
||||||
"))\n `(,the-begin\n ,@(let loop ((formal formal))\n (i",
|
"ents (make-identifier 'arguments here)))\n `(,the-begin\n ,@(let l",
|
||||||
"f (pair? formal)\n `((,the-define ,(car formal) #undefined) ,@(l",
|
"oop ((formal formal))\n (if (pair? formal)\n `((,the",
|
||||||
"oop (cdr formal)))\n (if (variable? formal)\n ",
|
"-define ,(car formal) #undefined) ,@(loop (cdr formal)))\n (if (",
|
||||||
" `((,the-define ,formal #undefined))\n '())))\n (,(",
|
"variable? formal)\n `((,the-define ,formal #undefined))\n ",
|
||||||
"the 'call-with-values) (,the-lambda () ,@body)\n (,the-lambda\n ",
|
" '())))\n (,(the 'call-with-values) (,the-lambda () ,@b",
|
||||||
" ,arguments\n ,@(let loop ((formal formal) (args arguments))\n ",
|
"ody)\n (,the-lambda\n ,arguments\n ,@(let loop ((fo",
|
||||||
" (if (pair? formal)\n `((,the-set! ,(car formal) (,(th",
|
"rmal formal) (args arguments))\n (if (pair? formal)\n ",
|
||||||
"e 'car) ,args)) ,@(loop (cdr formal) `(,(the 'cdr) ,args)))\n ",
|
" `((,the-set! ,(car formal) (,(the 'car) ,args)) ,@(loop (cdr formal) `(,(t",
|
||||||
"(if (variable? formal)\n `((,the-set! ,formal ,args))\n ",
|
"he 'cdr) ,args)))\n (if (variable? formal)\n ",
|
||||||
" '()))))))))))\n\n(define-macro do\n (lambda (form env)\n (le",
|
" `((,the-set! ,formal ,args))\n '()))))))))))\n\n(define",
|
||||||
"t ((bindings (car (cdr form)))\n (test (car (car (cdr (cdr form)))))",
|
"-macro do\n (lambda (form env)\n (let ((bindings (car (cdr form)))\n (",
|
||||||
"\n (cleanup (cdr (car (cdr (cdr form)))))\n (body (cdr (cdr",
|
"test (car (car (cdr (cdr form)))))\n (cleanup (cdr (car (cdr (cdr f",
|
||||||
" (cdr form)))))\n (let ((loop (make-identifier 'loop here)))\n `(,(the",
|
"orm)))))\n (body (cdr (cdr (cdr form)))))\n (let ((loop (make-id",
|
||||||
" 'let) ,loop ,(map (lambda (x) `(,(car x) ,(cadr x))) bindings)\n (,the-",
|
"entifier 'loop here)))\n `(,(the 'let) ,loop ,(map (lambda (x) `(,(car x) ",
|
||||||
"if ,test\n (,the-begin\n ,@cleanup)\n ",
|
",(cadr x))) bindings)\n (,the-if ,test\n (,the-begin\n ",
|
||||||
" (,the-begin\n ,@body\n (,loop ,@(m",
|
" ,@cleanup)\n (,the-begin\n ",
|
||||||
"ap (lambda (x) (if (null? (cdr (cdr x))) (car x) (car (cdr (cdr x))))) bindings)",
|
",@body\n (,loop ,@(map (lambda (x) (if (null? (cdr (cdr x))) (",
|
||||||
"))))))))\n\n(define-macro when\n (lambda (form env)\n (let ((test (car (cdr form",
|
"car x) (car (cdr (cdr x))))) bindings)))))))))\n\n(define-macro when\n (lambda (fo",
|
||||||
")))\n (body (cdr (cdr form))))\n `(,the-if ,test\n (,t",
|
"rm env)\n (let ((test (car (cdr form)))\n (body (cdr (cdr form))))\n ",
|
||||||
"he-begin ,@body)\n #undefined))))\n\n(define-macro unless\n (lambda ",
|
" `(,the-if ,test\n (,the-begin ,@body)\n #undefine",
|
||||||
"(form env)\n (let ((test (car (cdr form)))\n (body (cdr (cdr form))))\n",
|
"d))))\n\n(define-macro unless\n (lambda (form env)\n (let ((test (car (cdr form)",
|
||||||
" `(,the-if ,test\n #undefined\n (,the-begin ,@b",
|
"))\n (body (cdr (cdr form))))\n `(,the-if ,test\n #und",
|
||||||
"ody)))))\n\n(define-macro case\n (lambda (form env)\n (let ((key (car (cdr f",
|
"efined\n (,the-begin ,@body)))))\n\n(define-macro case\n (lambda (fo",
|
||||||
"orm)))\n (clauses (cdr (cdr form))))\n (let ((the-key (make-identifi",
|
"rm env)\n (let ((key (car (cdr form)))\n (clauses (cdr (cdr form))",
|
||||||
"er 'key here)))\n `(,(the 'let) ((,the-key ,key))\n ,(let loop ((c",
|
"))\n (let ((the-key (make-identifier 'key here)))\n `(,(the 'let) ((,t",
|
||||||
"lauses clauses))\n (if (null? clauses)\n #undefined\n ",
|
"he-key ,key))\n ,(let loop ((clauses clauses))\n (if (null? c",
|
||||||
" (let ((clause (car clauses)))\n `(,the-if ,(if (",
|
"lauses)\n #undefined\n (let ((clause (car clauses)",
|
||||||
"and (variable? (car clause))\n (variable=? ",
|
"))\n `(,the-if ,(if (and (variable? (car clause))\n ",
|
||||||
"(the 'else) (make-identifier (car clause) env)))\n ",
|
" (variable=? (the 'else) (make-identifier (car clause) ",
|
||||||
" #t\n `(,(the 'or) ,@(map (lambda (x) `(,(the ",
|
"env)))\n #t\n `(",
|
||||||
"'eqv?) ,the-key (,the-quote ,x))) (car clause))))\n ,",
|
",(the 'or) ,@(map (lambda (x) `(,(the 'eqv?) ,the-key (,the-quote ,x))) (car cla",
|
||||||
"(if (and (variable? (cadr clause))\n (varia",
|
"use))))\n ,(if (and (variable? (cadr clause))\n ",
|
||||||
"ble=? (the '=>) (make-identifier (cadr clause) env)))\n ",
|
" (variable=? (the '=>) (make-identifier (cadr cla",
|
||||||
" `(,(car (cdr (cdr clause))) ,the-key)\n ",
|
"use) env)))\n `(,(car (cdr (cdr clause))) ,the-k",
|
||||||
"`(,the-begin ,@(cdr clause)))\n ,(loop (cdr clauses))",
|
"ey)\n `(,the-begin ,@(cdr clause)))\n ",
|
||||||
")))))))))\n\n(define-macro parameterize\n (lambda (form env)\n (let ((formal (ca",
|
" ,(loop (cdr clauses)))))))))))\n\n(define-macro parameterize\n (l",
|
||||||
"r (cdr form)))\n (body (cdr (cdr form))))\n `(,(the 'with-paramete",
|
"ambda (form env)\n (let ((formal (car (cdr form)))\n (body (cdr (cdr",
|
||||||
"r)\n (,(the 'lambda) ()\n ,@formal\n ,@body)))))\n\n(define-ma",
|
" form))))\n `(,(the 'with-parameter)\n (,(the 'lambda) ()\n ,@f",
|
||||||
"cro syntax-quote\n (lambda (form env)\n (let ((renames '()))\n (letrec\n ",
|
"ormal\n ,@body)))))\n\n(define-macro syntax-quote\n (lambda (form env)\n ",
|
||||||
" ((rename (lambda (var)\n (let ((x (assq var renames)))",
|
"(let ((renames '()))\n (letrec\n ((rename (lambda (var)\n ",
|
||||||
"\n (if x\n (cadr x)\n ",
|
|
||||||
" (begin\n (set! renames `((,var ,(make-id",
|
|
||||||
"entifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))\n ",
|
|
||||||
" (rename var))))))\n (walk (lambda (f form)\n ",
|
|
||||||
" (cond\n ((variable? form)\n (f fo",
|
|
||||||
"rm))\n ((pair? form)\n `(,(the 'cons) (walk",
|
|
||||||
" f (car form)) (walk f (cdr form))))\n ((vector? form)\n ",
|
|
||||||
" `(,(the 'list->vector) (walk f (vector->list form))))\n ",
|
|
||||||
" (else\n `(,(the 'quote) ,form))))))\n (let ((fo",
|
|
||||||
"rm (walk rename (cadr form))))\n `(,(the 'let)\n ,(map cdr ren",
|
|
||||||
"ames)\n ,form))))))\n\n(define-macro syntax-quasiquote\n (lambda (form e",
|
|
||||||
"nv)\n (let ((renames '()))\n (letrec\n ((rename (lambda (var)\n ",
|
|
||||||
" (let ((x (assq var renames)))\n (if x\n ",
|
" (let ((x (assq var renames)))\n (if x\n ",
|
||||||
" (cadr x)\n (begin\n ",
|
" (cadr x)\n (begin\n ",
|
||||||
" (set! renames `((,var ,(make-identifier var env) (,(the 'make-ide",
|
" (set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier)",
|
||||||
"ntifier) ',var ',env)) . ,renames))\n (rename var))))",
|
" ',var ',env)) . ,renames))\n (rename var))))))\n ",
|
||||||
")))\n\n (define (syntax-quasiquote? form)\n (and (pair? form)\n ",
|
" (walk (lambda (f form)\n (cond\n ((vari",
|
||||||
" (variable? (car form))\n (variable=? (the 'syntax-quasiqu",
|
"able? form)\n (f form))\n ((pair? form)\n ",
|
||||||
"ote) (make-identifier (car form) env))))\n\n (define (syntax-unquote? form)",
|
" `(,(the 'cons) (walk f (car form)) (walk f (cdr form))))\n ",
|
||||||
"\n (and (pair? form)\n (variable? (car form))\n ",
|
" ((vector? form)\n `(,(the 'list->vector) (walk",
|
||||||
" (variable=? (the 'syntax-unquote) (make-identifier (car form) env))))\n\n ",
|
" f (vector->list form))))\n (else\n `(,(the",
|
||||||
" (define (syntax-unquote-splicing? form)\n (and (pair? form)\n ",
|
" 'quote) ,form))))))\n (let ((form (walk rename (cadr form))))\n `",
|
||||||
" (pair? (car form))\n (variable? (caar form))\n (va",
|
"(,(the 'let)\n ,(map cdr renames)\n ,form))))))\n\n(define-mac",
|
||||||
"riable=? (the 'syntax-unquote-splicing) (make-identifier (caar form) env))))\n\n ",
|
"ro syntax-quasiquote\n (lambda (form env)\n (let ((renames '()))\n (letrec",
|
||||||
" (define (qq depth expr)\n (cond\n ;; syntax-unquote\n ",
|
"\n ((rename (lambda (var)\n (let ((x (assq var rename",
|
||||||
" ((syntax-unquote? expr)\n (if (= depth 1)\n (car (",
|
"s)))\n (if x\n (cadr x)\n ",
|
||||||
"cdr expr))\n (list (the 'list)\n (list (the 'q",
|
" (begin\n (set! renames `((,var ,(mak",
|
||||||
"uote) (the 'syntax-unquote))\n (qq (- depth 1) (car (cdr exp",
|
"e-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))\n ",
|
||||||
"r))))))\n ;; syntax-unquote-splicing\n ((syntax-unquote-splici",
|
" (rename var)))))))\n\n (define (syntax-quasiquote? f",
|
||||||
"ng? expr)\n (if (= depth 1)\n (list (the 'append)\n ",
|
"orm)\n (and (pair? form)\n (variable? (car form))\n ",
|
||||||
" (car (cdr (car expr)))\n (qq depth (cdr expr",
|
" (variable=? (the 'syntax-quasiquote) (make-identifier (car form) env))))\n\n",
|
||||||
")))\n (list (the 'cons)\n (list (the 'list)\n ",
|
" (define (syntax-unquote? form)\n (and (pair? form)\n ",
|
||||||
" (list (the 'quote) (the 'syntax-unquote-splicing))\n ",
|
" (variable? (car form))\n (variable=? (the 'syntax-unquote) (make-",
|
||||||
" (qq (- depth 1) (car (cdr (car expr)))))\n ",
|
"identifier (car form) env))))\n\n (define (syntax-unquote-splicing? form)\n ",
|
||||||
" (qq depth (cdr expr)))))\n ;; syntax-quasiquote\n ((sy",
|
" (and (pair? form)\n (pair? (car form))\n (var",
|
||||||
"ntax-quasiquote? expr)\n (list (the 'list)\n (list (th",
|
"iable? (caar form))\n (variable=? (the 'syntax-unquote-splicing) (m",
|
||||||
"e 'quote) (the 'quasiquote))\n (qq (+ depth 1) (car (cdr expr)))",
|
"ake-identifier (caar form) env))))\n\n (define (qq depth expr)\n (c",
|
||||||
"))\n ;; list\n ((pair? expr)\n (list (the 'cons)\n ",
|
"ond\n ;; syntax-unquote\n ((syntax-unquote? expr)\n ",
|
||||||
" (qq depth (car expr))\n (qq depth (cdr expr))))\n ",
|
"(if (= depth 1)\n (car (cdr expr))\n (list (the 'lis",
|
||||||
" ;; vector\n ((vector? expr)\n (list (the 'list->vec",
|
"t)\n (list (the 'quote) (the 'syntax-unquote))\n ",
|
||||||
"tor) (qq depth (vector->list expr))))\n ;; variable\n ((variab",
|
" (qq (- depth 1) (car (cdr expr))))))\n ;; syntax-unquote-splic",
|
||||||
"le? expr)\n (rename expr))\n ;; simple datum\n (else",
|
"ing\n ((syntax-unquote-splicing? expr)\n (if (= depth 1)\n ",
|
||||||
"\n (list (the 'quote) expr))))\n\n (let ((body (qq 1 (cadr form))",
|
" (list (the 'append)\n (car (cdr (car expr)))\n ",
|
||||||
"))\n `(,(the 'let)\n ,(map cdr renames)\n ,body)))))",
|
" (qq depth (cdr expr)))\n (list (the 'cons)\n ",
|
||||||
")\n\n(define (transformer f)\n (lambda (form env)\n (let ((register1 (make-regis",
|
" (list (the 'list)\n (list (the 'quot",
|
||||||
"ter))\n (register2 (make-register)))\n (letrec\n ((wrap (lam",
|
"e) (the 'syntax-unquote-splicing))\n (qq (- depth 1) (",
|
||||||
"bda (var1)\n (let ((var2 (register1 var1)))\n ",
|
"car (cdr (car expr)))))\n (qq depth (cdr expr)))))\n ",
|
||||||
" (if (undefined? var2)\n (let ((var2 (make-identifier va",
|
" ;; syntax-quasiquote\n ((syntax-quasiquote? expr)\n (list (",
|
||||||
"r1 env)))\n (register1 var1 var2)\n ",
|
"the 'list)\n (list (the 'quote) (the 'quasiquote))\n ",
|
||||||
" (register2 var2 var1)\n var2)\n ",
|
" (qq (+ depth 1) (car (cdr expr)))))\n ;; list\n ((pair? e",
|
||||||
" var2))))\n (unwrap (lambda (var2)\n (let ((var",
|
"xpr)\n (list (the 'cons)\n (qq depth (car expr))\n ",
|
||||||
"1 (register2 var2)))\n (if (undefined? var1)\n ",
|
" (qq depth (cdr expr))))\n ;; vector\n ((vector? e",
|
||||||
" var2\n var1))))\n (walk (lambda (",
|
"xpr)\n (list (the 'list->vector) (qq depth (vector->list expr))))\n ",
|
||||||
"f form)\n (cond\n ((variable? form)\n ",
|
" ;; variable\n ((variable? expr)\n (rename expr))\n ",
|
||||||
" (f form))\n ((pair? form)\n (co",
|
" ;; simple datum\n (else\n (list (the 'quote) expr))))\n\n",
|
||||||
"ns (walk f (car form)) (walk f (cdr form))))\n ((vector? form)",
|
" (let ((body (qq 1 (cadr form))))\n `(,(the 'let)\n ,(m",
|
||||||
"\n (list->vector (walk f (vector->list form))))\n ",
|
"ap cdr renames)\n ,body))))))\n\n(define (transformer f)\n (lambda (form",
|
||||||
" (else\n form)))))\n (let ((form (cdr form)))\n ",
|
" env)\n (let ((register1 (make-register))\n (register2 (make-register)",
|
||||||
" (walk unwrap (apply f (walk wrap form))))))))\n\n(define-macro define-synta",
|
"))\n (letrec\n ((wrap (lambda (var1)\n (let ((var2 ",
|
||||||
"x\n (lambda (form env)\n (let ((formal (car (cdr form)))\n (body (cd",
|
"(register1 var1)))\n (if (undefined? var2)\n ",
|
||||||
"r (cdr form))))\n (if (pair? formal)\n `(,(the 'define-syntax) ,(car",
|
" (let ((var2 (make-identifier var1 env)))\n (regi",
|
||||||
" formal) (,the-lambda ,(cdr formal) ,@body))\n `(,the-define-macro ,form",
|
"ster1 var1 var2)\n (register2 var2 var1)\n ",
|
||||||
"al (,(the 'transformer) (,the-begin ,@body)))))))\n\n(define-macro letrec-syntax\n ",
|
" var2)\n var2))))\n (unwrap (lambda ",
|
||||||
" (lambda (form env)\n (let ((formal (car (cdr form)))\n (body (cdr (",
|
"(var2)\n (let ((var1 (register2 var2)))\n ",
|
||||||
"cdr form))))\n `(let ()\n ,@(map (lambda (x)\n `(,(th",
|
" (if (undefined? var1)\n var2\n ",
|
||||||
"e 'define-syntax) ,(car x) ,(cadr x)))\n formal)\n ,@body))",
|
" var1))))\n (walk (lambda (f form)\n (cond\n ",
|
||||||
"))\n\n(define-macro let-syntax\n (lambda (form env)\n `(,(the 'letrec-syntax) ,@",
|
" ((variable? form)\n (f form))\n ",
|
||||||
"(cdr form))))\n\n\n;;; library primitives\n\n(define-macro define-library\n (lambda (",
|
"((pair? form)\n (cons (walk f (car form)) (walk f (cdr form))",
|
||||||
"form _)\n (let ((name (cadr form))\n (body (cddr form)))\n (let ((",
|
"))\n ((vector? form)\n (list->vector (walk ",
|
||||||
"old-library (current-library))\n (new-library (or (find-library name) ",
|
"f (vector->list form))))\n (else\n form))))",
|
||||||
"(make-library name))))\n (let ((env (library-environment new-library)))\n ",
|
")\n (let ((form (cdr form)))\n (walk unwrap (apply f (walk wrap fo",
|
||||||
" (current-library new-library)\n (for-each (lambda (expr) (eval e",
|
"rm))))))))\n\n(define-macro define-syntax\n (lambda (form env)\n (let ((formal (",
|
||||||
"xpr env)) body)\n (current-library old-library))))))\n\n(define-macro cond",
|
"car (cdr form)))\n (body (cdr (cdr form))))\n (if (pair? formal)\n ",
|
||||||
"-expand\n (lambda (form _)\n (letrec\n ((test (lambda (form)\n ",
|
" `(,(the 'define-syntax) ,(car formal) (,the-lambda ,(cdr formal) ,@body",
|
||||||
" (or\n (eq? form 'else)\n (and (symbol? for",
|
"))\n `(,the-define-macro ,formal (,(the 'transformer) (,the-begin ,@body",
|
||||||
"m)\n (memq form (features)))\n (and (pair? ",
|
")))))))\n\n(define-macro letrec-syntax\n (lambda (form env)\n (let ((formal (car",
|
||||||
"form)\n (case (car form)\n ((library",
|
" (cdr form)))\n (body (cdr (cdr form))))\n `(let ()\n ,@(ma",
|
||||||
") (find-library (cadr form)))\n ((not) (not (test (cadr f",
|
"p (lambda (x)\n `(,(the 'define-syntax) ,(car x) ,(cadr x)))\n ",
|
||||||
"orm))))\n ((and) (let loop ((form (cdr form)))\n ",
|
" formal)\n ,@body))))\n\n(define-macro let-syntax\n (lambda (fo",
|
||||||
" (or (null? form)\n (",
|
"rm env)\n `(,(the 'letrec-syntax) ,@(cdr form))))\n\n\n;;; library primitives\n\n(d",
|
||||||
"and (test (car form)) (loop (cdr form))))))\n ((or) (let ",
|
"efine-macro define-library\n (lambda (form _)\n (let ((name (cadr form))\n ",
|
||||||
"loop ((form (cdr form)))\n (and (pair? form)\n ",
|
" (body (cddr form)))\n (let ((old-library (current-library))\n ",
|
||||||
" (or (test (car form)) (loop (cdr form))))))\n ",
|
" (new-library (or (find-library name) (make-library name))))\n (let ((env ",
|
||||||
" (else #f)))))))\n (let loop ((clauses (cdr form)))\n ",
|
"(library-environment new-library)))\n (current-library new-library)\n ",
|
||||||
" (if (null? clauses)\n #undefined\n (if (test (caar cla",
|
" (for-each (lambda (expr) (eval expr env)) body)\n (current-library",
|
||||||
"uses))\n `(,the-begin ,@(cdar clauses))\n (loop (cdr",
|
" old-library))))))\n\n(define-macro cond-expand\n (lambda (form _)\n (letrec\n ",
|
||||||
" clauses))))))))\n\n(define-macro import\n (lambda (form _)\n (let ((caddr\n ",
|
" ((test (lambda (form)\n (or\n (eq? form 'els",
|
||||||
" (lambda (x) (car (cdr (cdr x)))))\n (prefix\n (lambda (pr",
|
"e)\n (and (symbol? form)\n (memq form (feat",
|
||||||
"efix symbol)\n (string->symbol\n (string-append\n ",
|
"ures)))\n (and (pair? form)\n (case (car fo",
|
||||||
" (symbol->string prefix)\n (symbol->string symbol))))))\n ",
|
"rm)\n ((library) (find-library (cadr form)))\n ",
|
||||||
"(letrec\n ((extract\n (lambda (spec)\n (case (car ",
|
" ((not) (not (test (cadr form))))\n ((and) (l",
|
||||||
"spec)\n ((only rename prefix except)\n (extract (ca",
|
"et loop ((form (cdr form)))\n (or (null? form)\n ",
|
||||||
"dr spec)))\n (else\n (or (find-library spec) (error",
|
" (and (test (car form)) (loop (cdr form)))))",
|
||||||
" \"library not found\" spec))))))\n (collect\n (lambda (spec)\n ",
|
")\n ((or) (let loop ((form (cdr form)))\n ",
|
||||||
" (case (car spec)\n ((only)\n (let ((al",
|
" (and (pair? form)\n (or (tes",
|
||||||
"ist (collect (cadr spec))))\n (map (lambda (var) (assq var alis",
|
"t (car form)) (loop (cdr form))))))\n (else #f)))))))\n ",
|
||||||
"t)) (cddr spec))))\n ((rename)\n (let ((alist (coll",
|
" (let loop ((clauses (cdr form)))\n (if (null? clauses)\n #und",
|
||||||
"ect (cadr spec))))\n (map (lambda (s) (or (assq (car s) (cddr s",
|
"efined\n (if (test (caar clauses))\n `(,the-begin ,@(cda",
|
||||||
"pec)) s)) alist)))\n ((prefix)\n (let ((alist (coll",
|
"r clauses))\n (loop (cdr clauses))))))))\n\n(define-macro import\n (",
|
||||||
"ect (cadr spec))))\n (map (lambda (s) (cons (prefix (caddr spec",
|
"lambda (form _)\n (let ((caddr\n (lambda (x) (car (cdr (cdr x)))))\n ",
|
||||||
") (car s)) (cdr s))) alist)))\n ((except)\n (let ((",
|
" (prefix\n (lambda (prefix symbol)\n (string->symbol\n",
|
||||||
"alist (collect (cadr spec))))\n (let loop ((alist alist))\n ",
|
" (string-append\n (symbol->string prefix)\n ",
|
||||||
" (if (null? alist)\n '()\n ",
|
" (symbol->string symbol))))))\n (letrec\n ((extract\n (l",
|
||||||
" (if (memq (caar alist) (cddr spec))\n (loop (",
|
"ambda (spec)\n (case (car spec)\n ((only rename prefix",
|
||||||
"cdr alist))\n (cons (car alist) (loop (cdr alist)))))",
|
" except)\n (extract (cadr spec)))\n (else\n ",
|
||||||
")))\n (else\n (let ((lib (or (find-library spec) (e",
|
" (or (find-library spec) (error \"library not found\" spec))))))\n ",
|
||||||
"rror \"library not found\" spec))))\n (map (lambda (x) (cons x x)",
|
" (collect\n (lambda (spec)\n (case (car spec)\n ",
|
||||||
") (library-exports lib))))))))\n (letrec\n ((import\n ",
|
" ((only)\n (let ((alist (collect (cadr spec))))\n ",
|
||||||
" (lambda (spec)\n (let ((lib (extract spec))\n ",
|
" (map (lambda (var) (assq var alist)) (cddr spec))))\n ((renam",
|
||||||
" (alist (collect spec)))\n (for-each\n (l",
|
"e)\n (let ((alist (collect (cadr spec))))\n (map",
|
||||||
"ambda (slot)\n (library-import lib (cdr slot) (car slot)))\n ",
|
" (lambda (s) (or (assq (car s) (cddr spec)) s)) alist)))\n ((prefi",
|
||||||
" alist)))))\n (for-each import (cdr form)))))))\n\n(defi",
|
"x)\n (let ((alist (collect (cadr spec))))\n (map",
|
||||||
"ne-macro export\n (lambda (form _)\n (letrec\n ((collect\n (lamb",
|
" (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))\n ",
|
||||||
"da (spec)\n (cond\n ((symbol? spec)\n `(,spec .",
|
" ((except)\n (let ((alist (collect (cadr spec))))\n ",
|
||||||
" ,spec))\n ((and (list? spec) (= (length spec) 3) (eq? (car spec) 're",
|
" (let loop ((alist alist))\n (if (null? alist)\n ",
|
||||||
"name))\n `(,(list-ref spec 1) . ,(list-ref spec 2)))\n (e",
|
" '()\n (if (memq (caar alist) (cddr spec)",
|
||||||
"lse\n (error \"malformed export\")))))\n (export\n (la",
|
")\n (loop (cdr alist))\n (",
|
||||||
"mbda (spec)\n (let ((slot (collect spec)))\n (library-ex",
|
"cons (car alist) (loop (cdr alist))))))))\n (else\n ",
|
||||||
"port (car slot) (cdr slot))))))\n (for-each export (cdr form)))))\n\n(export d",
|
" (let ((lib (or (find-library spec) (error \"library not found\" spec))))\n ",
|
||||||
"efine-library\n cond-expand\n import\n export)\n\n(export let le",
|
" (map (lambda (x) (cons x x)) (library-exports lib))))))))\n (le",
|
||||||
"t* letrec letrec*\n let-values let*-values define-values\n quasiquot",
|
"trec\n ((import\n (lambda (spec)\n (let ((",
|
||||||
"e unquote unquote-splicing\n and or\n cond case else =>\n do w",
|
"lib (extract spec))\n (alist (collect spec)))\n ",
|
||||||
"hen unless\n parameterize\n define-syntax\n syntax-quote synta",
|
" (for-each\n (lambda (slot)\n (librar",
|
||||||
"x-unquote\n syntax-quasiquote syntax-unquote-splicing\n let-syntax l",
|
"y-import lib (cdr slot) (car slot)))\n alist)))))\n (f",
|
||||||
"etrec-syntax\n syntax-error)\n\n\n",
|
"or-each import (cdr form)))))))\n\n(define-macro export\n (lambda (form _)\n (le",
|
||||||
|
"trec\n ((collect\n (lambda (spec)\n (cond\n (",
|
||||||
|
"(symbol? spec)\n `(,spec . ,spec))\n ((and (list? spec) (",
|
||||||
|
"= (length spec) 3) (eq? (car spec) 'rename))\n `(,(list-ref spec 1) ",
|
||||||
|
". ,(list-ref spec 2)))\n (else\n (error \"malformed export",
|
||||||
|
"\")))))\n (export\n (lambda (spec)\n (let ((slot (coll",
|
||||||
|
"ect spec)))\n (library-export (car slot) (cdr slot))))))\n (for",
|
||||||
|
"-each export (cdr form)))))\n\n(export define-library\n cond-expand\n ",
|
||||||
|
"import\n export)\n\n(export let let* letrec letrec*\n let-values let*-",
|
||||||
|
"values define-values\n quasiquote unquote unquote-splicing\n and or\n",
|
||||||
|
" cond case else =>\n do when unless\n parameterize\n de",
|
||||||
|
"fine-syntax\n syntax-quote syntax-unquote\n syntax-quasiquote syntax",
|
||||||
|
"-unquote-splicing\n let-syntax letrec-syntax\n syntax-error)\n\n\n",
|
||||||
"",
|
"",
|
||||||
""
|
""
|
||||||
};
|
};
|
||||||
|
|
|
||||||
|
|
@ -1547,7 +1547,7 @@ pic_compile(pic_state *pic, pic_value obj, struct pic_env *env)
|
||||||
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
||||||
|
|
||||||
fprintf(stdout, "# input expression\n");
|
fprintf(stdout, "# input expression\n");
|
||||||
pic_debug(pic, obj);
|
pic_write(pic, obj);
|
||||||
fprintf(stdout, "\n");
|
fprintf(stdout, "\n");
|
||||||
|
|
||||||
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
||||||
|
|
@ -1557,7 +1557,7 @@ pic_compile(pic_state *pic, pic_value obj, struct pic_env *env)
|
||||||
obj = pic_expand(pic, obj, env);
|
obj = pic_expand(pic, obj, env);
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
fprintf(stdout, "## expand completed\n");
|
fprintf(stdout, "## expand completed\n");
|
||||||
pic_debug(pic, obj);
|
pic_write(pic, obj);
|
||||||
fprintf(stdout, "\n");
|
fprintf(stdout, "\n");
|
||||||
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
||||||
#endif
|
#endif
|
||||||
|
|
@ -1566,7 +1566,7 @@ pic_compile(pic_state *pic, pic_value obj, struct pic_env *env)
|
||||||
obj = pic_analyze(pic, obj);
|
obj = pic_analyze(pic, obj);
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
fprintf(stdout, "## analyzer completed\n");
|
fprintf(stdout, "## analyzer completed\n");
|
||||||
pic_debug(pic, obj);
|
pic_write(pic, obj);
|
||||||
fprintf(stdout, "\n");
|
fprintf(stdout, "\n");
|
||||||
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
|
|
@ -156,8 +156,14 @@ pic_init_core(pic_state *pic)
|
||||||
pic_init_attr(pic); DONE;
|
pic_init_attr(pic); DONE;
|
||||||
pic_init_reg(pic); DONE;
|
pic_init_reg(pic); DONE;
|
||||||
|
|
||||||
|
pic_try {
|
||||||
pic_load_cstr(pic, &pic_boot[0][0]);
|
pic_load_cstr(pic, &pic_boot[0][0]);
|
||||||
}
|
}
|
||||||
|
pic_catch {
|
||||||
|
pic_print_backtrace(pic, xstdout);
|
||||||
|
pic_raise(pic, pic->err);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
pic_import(pic, pic->PICRIN_BASE);
|
pic_import(pic, pic->PICRIN_BASE);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -633,7 +633,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
|
||||||
|
|
||||||
sym = irep->syms[c.u.i];
|
sym = irep->syms[c.u.i];
|
||||||
if (! pic_dict_has(pic, pic->globals, sym)) {
|
if (! pic_dict_has(pic, pic->globals, sym)) {
|
||||||
pic_errorf(pic, "logic flaw; reference to uninitialized global variable: %s", pic_symbol_name(pic, sym));
|
pic_errorf(pic, "uninitialized global variable: %s", pic_symbol_name(pic, sym));
|
||||||
}
|
}
|
||||||
PUSH(pic_dict_ref(pic, pic->globals, sym));
|
PUSH(pic_dict_ref(pic, pic->globals, sym));
|
||||||
NEXT;
|
NEXT;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue