parse assignment. add simple struct form that can be accessed by field identifiers
This commit is contained in:
parent
a3fefc1c35
commit
ebb177f28d
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax scheme/base))
|
||||
(require scheme/class)
|
||||
(require racket/class)
|
||||
|
||||
(require "private/honu-typed-scheme.ss"
|
||||
;; "private/honu.ss"
|
||||
|
@ -34,6 +34,17 @@
|
|||
(define (sql4) #f)
|
||||
(define (sql5) #f)
|
||||
|
||||
(define-syntax (honu-struct stx)
|
||||
(syntax-parse stx
|
||||
[(_ name (my-field ...))
|
||||
(with-syntax ([new-name (gensym (syntax->datum #'name))])
|
||||
#'(begin
|
||||
(define new-name
|
||||
(class object%
|
||||
(init-field my-field ...)
|
||||
(super-new)))
|
||||
(define name (lambda args (apply make-object new-name args)))))]))
|
||||
|
||||
(provide (rename-out (#%dynamic-honu-module-begin #%module-begin)
|
||||
;; (honu-top #%top)
|
||||
(semicolon \;
|
||||
|
@ -43,6 +54,7 @@
|
|||
(+ scheme:+)
|
||||
(honu-/ /)
|
||||
(honu-- -)
|
||||
(honu-= =)
|
||||
(honu-? ?)
|
||||
(honu-: :)
|
||||
(honu-comma |,|)
|
||||
|
@ -114,12 +126,14 @@
|
|||
foobar2000
|
||||
expression
|
||||
str
|
||||
define-struct
|
||||
;; define-struct
|
||||
#;
|
||||
(for-template #%parens #%brackets #%braces)
|
||||
in-range
|
||||
honu-struct
|
||||
;; (for-meta 2 (rename-out (honu-syntax syntax)))
|
||||
(rename-out
|
||||
(struct scheme-struct)
|
||||
(syntax real-syntax)
|
||||
(for scheme-for)
|
||||
(honu-if if)
|
||||
|
|
|
@ -4,7 +4,8 @@
|
|||
"util.ss"
|
||||
(for-template "literals.ss"
|
||||
"language.ss"
|
||||
"syntax.ss")
|
||||
"syntax.ss"
|
||||
racket/class)
|
||||
syntax/parse
|
||||
syntax/parse/experimental/splicing
|
||||
"syntax.ss"
|
||||
|
@ -14,6 +15,7 @@
|
|||
scheme/splicing
|
||||
(for-syntax syntax/define)
|
||||
syntax/name
|
||||
racket/match
|
||||
syntax/stx
|
||||
(for-syntax "util.ss")
|
||||
(for-syntax syntax/private/stxparse/runtime-prose
|
||||
|
@ -327,7 +329,7 @@
|
|||
([honu-* (sl (left right) #'(* left right))]
|
||||
[honu-% (sl (left right) #'(modulo left right))]
|
||||
[honu-/ (sl (left right) #'(/ left right))])
|
||||
([honu-. (sl (left right) #'(field-access right left))])
|
||||
([honu-. (sl (left right) #'(get-field right left))])
|
||||
))
|
||||
|
||||
(define-splicing-syntax-class (ternary context)
|
||||
|
@ -348,14 +350,33 @@
|
|||
(printf "Debug parse I got here ~a\n" d)
|
||||
#t)])
|
||||
|
||||
(define-syntax-class (expression-top context)
|
||||
#:literals (semicolon)
|
||||
(define (make-assignment left right)
|
||||
(match (identifier-binding left)
|
||||
['lexical (with-syntax ([left left] [right right])
|
||||
#'(set! left right))]
|
||||
[#f (with-syntax ([left left] [right right])
|
||||
#'(define left right))]
|
||||
[(list source-mod source-id nominal-source-mod nominal-source-id source-phase import-phase nominal-export-phase) (with-syntax ([left left] [right right])
|
||||
#'(set! left right))]
|
||||
[else (raise-syntax-error 'assignment "failed to assign" left right)]
|
||||
))
|
||||
|
||||
(define-syntax-class (assignment context)
|
||||
#:literals (semicolon honu-=)
|
||||
[pattern ((~var left honu-identifier)
|
||||
honu-=
|
||||
(~var right (ternary context))
|
||||
semicolon
|
||||
. rest)
|
||||
#:with result #'1]
|
||||
;; FIXME! 1 isn't the right result
|
||||
;; either `set!' or `define' the variable
|
||||
#:with result (make-assignment #'left.result #'right.result)])
|
||||
|
||||
(define-syntax-class (expression-top context)
|
||||
#:literals (semicolon)
|
||||
[pattern (~var assignment (assignment context))
|
||||
#:with result #'assignment.result
|
||||
#:with rest #'assignment.rest]
|
||||
[pattern ((~var x0 (debug-here (format "expression top\n")))
|
||||
(~var e (ternary context))
|
||||
(~var x1 (debug-here (format "expression top 1 ~a\n" (syntax->datum #'e))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user