[honu] return the last expression if two atomic expressions occur in sequence. add a simple for loop macro
This commit is contained in:
parent
8a352da71c
commit
182cded2a3
|
@ -11,6 +11,7 @@
|
||||||
[honu-function function]
|
[honu-function function]
|
||||||
[honu-var var]
|
[honu-var var]
|
||||||
[honu-val val]
|
[honu-val val]
|
||||||
|
[honu-for for]
|
||||||
[honu-+ +]
|
[honu-+ +]
|
||||||
[honu-- -]
|
[honu-- -]
|
||||||
[honu-* *]
|
[honu-* *]
|
||||||
|
|
|
@ -40,6 +40,18 @@
|
||||||
#'unparsed)
|
#'unparsed)
|
||||||
#t)])))
|
#t)])))
|
||||||
|
|
||||||
|
(provide honu-for)
|
||||||
|
(define-honu-syntax honu-for
|
||||||
|
(lambda (code context)
|
||||||
|
(syntax-parse code #:literal-sets (cruft)
|
||||||
|
[(_ iterator:id honu-= start:honu-expression honu-to end:honu-expression
|
||||||
|
honu-do body:honu-expression . rest)
|
||||||
|
(values
|
||||||
|
#'(for ([iterator (in-range start.result end.result)])
|
||||||
|
body.result)
|
||||||
|
#'rest
|
||||||
|
#t)])))
|
||||||
|
|
||||||
(provide honu-val)
|
(provide honu-val)
|
||||||
(define-honu-syntax honu-val
|
(define-honu-syntax honu-val
|
||||||
(lambda (code context)
|
(lambda (code context)
|
||||||
|
|
|
@ -9,6 +9,7 @@
|
||||||
"debug.rkt"
|
"debug.rkt"
|
||||||
(prefix-in transformer: "transformer.rkt")
|
(prefix-in transformer: "transformer.rkt")
|
||||||
syntax/stx
|
syntax/stx
|
||||||
|
syntax/parse/experimental/splicing
|
||||||
syntax/parse)
|
syntax/parse)
|
||||||
;; phase 1
|
;; phase 1
|
||||||
(require-syntax racket/base)
|
(require-syntax racket/base)
|
||||||
|
@ -205,7 +206,7 @@
|
||||||
(parse #'(rest ...)))])
|
(parse #'(rest ...)))])
|
||||||
so-far (more)))]
|
so-far (more)))]
|
||||||
[else
|
[else
|
||||||
(syntax-parse #'(head rest ...)
|
(syntax-parse #'(head rest ...) #:literal-sets (cruft)
|
||||||
[(function:identifier (#%parens args ...) (#%braces code ...) . rest)
|
[(function:identifier (#%parens args ...) (#%braces code ...) . rest)
|
||||||
(values (with-syntax ([(parsed-arguments ...)
|
(values (with-syntax ([(parsed-arguments ...)
|
||||||
(parse-arguments #'(args ...))])
|
(parse-arguments #'(args ...))])
|
||||||
|
@ -216,7 +217,11 @@
|
||||||
#'rest)]
|
#'rest)]
|
||||||
[else (syntax-parse #'head
|
[else (syntax-parse #'head
|
||||||
#:literal-sets (cruft)
|
#:literal-sets (cruft)
|
||||||
[x:atom (do-parse #'(rest ...) precedence left #'x)]
|
[x:atom
|
||||||
|
(debug "atom ~a current ~a\n" #'x current)
|
||||||
|
(if current
|
||||||
|
(values (left current) #'(head rest ...))
|
||||||
|
(do-parse #'(rest ...) precedence left #'x))]
|
||||||
[(#%parens args ...)
|
[(#%parens args ...)
|
||||||
(debug "function call ~a\n" left)
|
(debug "function call ~a\n" left)
|
||||||
(values (left (with-syntax ([current current]
|
(values (left (with-syntax ([current current]
|
||||||
|
@ -238,7 +243,7 @@
|
||||||
(error 'parse "function call")]
|
(error 'parse "function call")]
|
||||||
[else (error 'what "dont know how to parse ~a" #'head)])])])]))
|
[else (error 'what "dont know how to parse ~a" #'head)])])])]))
|
||||||
|
|
||||||
(do-parse input 0 (lambda (x) x) #'(void)))
|
(do-parse input 0 (lambda (x) x) #f))
|
||||||
|
|
||||||
(define (empty-syntax? what)
|
(define (empty-syntax? what)
|
||||||
(syntax-parse what
|
(syntax-parse what
|
||||||
|
@ -275,3 +280,20 @@
|
||||||
parsed
|
parsed
|
||||||
(more-parsing . rest)))))
|
(more-parsing . rest)))))
|
||||||
#'(debug "regular parsing\n"))))
|
#'(debug "regular parsing\n"))))
|
||||||
|
|
||||||
|
;; rest will be some subset of full
|
||||||
|
(define (parsed-things full rest)
|
||||||
|
(define full-datum (syntax->datum full))
|
||||||
|
(define rest-datum (syntax->datum rest))
|
||||||
|
(- (length full-datum) (length rest-datum)))
|
||||||
|
|
||||||
|
(provide honu-expression)
|
||||||
|
(define-primitive-splicing-syntax-class (honu-expression)
|
||||||
|
#:attributes (result)
|
||||||
|
#:description "expression"
|
||||||
|
(lambda (stx fail)
|
||||||
|
(debug "honu expression syntax class\n")
|
||||||
|
(define-values (parsed unparsed)
|
||||||
|
(parse stx))
|
||||||
|
(debug "parsed ~a\n" parsed)
|
||||||
|
(list (parsed-things stx unparsed) parsed)))
|
||||||
|
|
|
@ -1,5 +1,8 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
|
;; This module implements read related functions such as `read', `read-syntax',
|
||||||
|
;; and a colored lexer for drracket
|
||||||
|
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(require parser-tools/lex
|
(require parser-tools/lex
|
||||||
(prefix-in : parser-tools/lex-sre))
|
(prefix-in : parser-tools/lex-sre))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user