Subversion Repositories scarts

; Preprocessor-like macro support.
; Copyright (C) 2000, 2009 Red Hat, Inc.
; This file is part of CGEN.
; See file COPYING.CGEN for details.
; TODO:
; - Like C preprocessor macros, there is no scoping [one can argue
;   there should be].  Maybe in time (??? Hmmm... done?)
; - Support for multiple macro tables.
; Non-standard required routines:
; Provided by Guile:
;   make-hash-table, hashq-ref, hashq-set!, symbol-append,
;   source-properties
; Provided by CGEN:
;   location-property, location-property-set!,
;   source-properties-location->string,
;   single-location->string, location-top, unspecified-location,
;   reader-process-expanded!, num-args-ok?, *UNSPECIFIED*.
; The convention we use says `-' begins "local" objects.
; At some point this might also use the Guile module system.
; This uses Guile's source-properties system to track source location.
; The chain of macro invocations is tracked and stored in the result as
; object property "location-property".
; Exported routines:
;
; pmacro-init! - initialize the pmacro system
;
; define-pmacro - define a symbolic or procedural pmacro
;
;	(define-pmacro symbol ["comment"] expansion)
;	(define-pmacro (symbol [args]) ["comment"] (expansion))
;
; ARGS is a list of `symbol' or `(symbol default-value)' elements.
;
; pmacro-expand - expand all pmacros in an expression
;
;	(pmacro-expand expression loc)
;
; pmacro-trace - same as pmacro-expand, but trace macro expansion
;                Output is sent to current-error-port.
;
;	(pmacro-trace expression loc)
;
; pmacro-dump - expand all pmacros in an expression, for debugging purposes
;
;	(pmacro-dump expression)
; pmacro-debug - expand all pmacros in an expression,
;                printing various debugging messages.
;                This does not process .exec.
;
;	(pmacro-debug expression)
; Builtin pmacros:
;
; (.sym symbol1 symbol2 ...)          - symbolstr-append
; (.str string1 string2 ...)          - stringsym-append
; (.hex number [width])               - convert to hex string
; (.upcase string)
; (.downcase string)
; (.substring string start end)       - get part of a string
; (.splice a b (.unsplice c) d e ...) - splice list into another list
; (.iota count [start [increment]])   - number generator
; (.map pmacro arg1 . arg-rest)
; (.for-each pmacro arg1 . arg-rest)
; (.eval expr)                        - expand (or evaluate it) expr
; (.exec expr)                        - execute expr immediately
; (.apply pmacro-name arg)
; (.pmacro (arg-list) expansion)      - akin go lambda in Scheme
; (.pmacro? arg)
; (.let (var-list) expr1 . expr-rest) - akin to let in Scheme
; (.let* (var-list) expr1 . expr-rest) - akin to let* in Scheme
; (.if expr then [else])
; (.case expr ((case-list1) stmt) [case-expr-stmt-list] [(else stmt)])
; (.cond (expr stmt) [(cond-expr-stmt-list)] [(else stmt)])
; (.begin . stmt-list)
; (.print . exprs)                    - for debugging messages
; (.dump expr)                        - dump expr in readable format
; (.error . message)                  - print error message and exit
; (.list . exprs)
; (.ref l n)                          - extract the n'th element of list l
; (.length x)                         - length of symbol, string, or list
; (.replicate n expr)                 - return list of expr replicated n times
; (.find pred l)                      - return elements of list l matching pred
; (.equals x y)                       - deep comparison
; (.andif expr . rest)                - && in C
; (.orif expr . rest)                 - || in C
; (.not expr)                         - ! in C
; (.eq x y)
; (.ne x y)
; (.lt x y)
; (.gt x y)
; (.le x y)
; (.ge x y)
; (.add x y)
; (.sub x y)
; (.mul x y)
; (.div x y)                          - integer division
; (.rem x y)                          - integer remainder
; (.sll x n)                          - shift left logical
; (.srl x n)                          - shift right logical
; (.sra x n)                          - shift right arithmetic
; (.and x y)                          - bitwise and
; (.or x y)                           - bitwise or
; (.xor x y)                          - bitwise xor
; (.inv x)                            - bitwise invert
; (.car l)
; (.cdr l)
; (.caar l)
; (.cadr l)
; (.cdar l)
; (.cddr l)
; (.internal-test expr)               - testsuite internal use only
;
; NOTE: .cons currently absent on purpose
;
; .sym and .str convert numbers to symbols/strings as necessary (base 10).
;
; .pmacro is for constructing pmacros on-the-fly, like lambda, and is currently
; only valid as arguments to other pmacros or assigned to a local in a {.let}
; or {.let*}.
;
; NOTE: While Scheme requires tail recursion to be implemented as a loop,
; we do not.  We might some day, but not today.
;
; ??? Methinks .foo isn't a valid R5RS symbol.  May need to change 
; to something else.
; True if doing pmacro expansion via pmacro-debug.
; True if doing pmacro expansion via pmacro-trace.
; The pmacro table.
; A copy of syntactic pmacros is kept separately.
; Marker to indicate a value is a pmacro.
; NOTE: Naming this "<pmacro>" is intentional.  It makes them look like
; objects of class <pmacro>.  However we don't use COS in part to avoid
; a dependency on COS and in part because displaying COS objects isn't well
; supported (displaying them in debugging dumps adds a lot of noise).
; Utilities to create and access pmacros.
; Cover functions to manage an "environment" in case a need or desire for
; another method arises.
; Error message generator.
"<input>"":"":"":"; Issue an error where a number was expected.
"invalid arg for "", expected number"; Verify N is a number.
; Issue an error where an integer was expected.
"invalid arg for "", expected integer"; Verify N is an integer.
; Issue an error where a non-negative integer was expected.
"invalid arg for "", expected non-negative integer"; Verify N is a non-negative integer.
; Expand a list of expressions, in order.
; The result is the value of the last one.
; Process list of keyword/value specified arguments.
; Build a list of default values, then override ones specified in ARGS,
; done
"not an argument name""missing argument to #:keyword""bad keyword/value argument list"; Ensure each element has a value.
; done
"argument value not specified"; If varargs pmacro, adjust result.
; not varargs
; Process a pmacro argument list.
; ARGS is either a fully specified position dependent argument list,
; or is a list of keyword/value pairs with missing values coming from
; DEFAULT-VALUES.
; Subroutine of -pmacro-apply/-smacro-apply to simplify them.
; Process the arguments, verify the correct number is present.
"wrong number of arguments to pmacro "; Invoke a pmacro.
; Invoke a syntactic-form pmacro.
; ENV, LOC are handed down from -pmacro-expand.
;; Expand expression EXP using ENV, an alist of variable assignments.
;; LOC is the location stack thus far.
;; If the symbol is in `env', return its value.
;; Otherwise see if symbol is a globally defined pmacro.
;; Otherwise return the symbol unchanged.
;; cdr is value of (name . value) pair
;; Symbol is a pmacro.
;; If this is a procedural pmacro, let caller perform expansion.
;; Otherwise, return the pmacro's value.
;; Return symbol unchanged.
;; See if (car exp) is a pmacro.
;; Return pmacro or #f.
"Checking for pmacro: ";; Subroutine of scan-list to simplify it.
;; Macro expand EXP which is known to be a non-null list.
;; LOC is the location stack thus far.
;; Check for syntactic forms.
;; They are handled differently in that we leave it to the transformer
;; routine to evaluate the arguments.
;; Note that we also don't support passing syntactic form functions
;; as arguments: We look up (car exp) here, not its expansion.
;; ??? Is it useful to trace these?
;; Not a syntactic form.
;; See if we have a pmacro.  Do this before evaluating all the
;; arguments (even though we will eventually evaluate all the
;; arguments before invoking the pmacro) so that tracing is more
;; legible (we print the expression we're about to evaluate *before*
;; we evaluate its arguments).
;; Trace expansion here, we know we have a pmacro.
;; We use `write' to display `exp' to see strings quoted.
"Expanding: ""      env: "" location: ";; Evaluate all the arguments before invoking the pmacro.
"   result: ";; Not a pmacro.
;; Macro expand EXP which is known to be a non-null list.
;; LOC is the location stack thus far.
;;
;; This uses scan-list1 to do the real work, this handles location tracking.
;; pair? -> cheap non-null-list?
;; Copy source location to new expression.
;; Scan EXP, an arbitrary value.
;; LOC is the location stack thus far.
;; pair? -> cheap non-null-list?
;; Not a symbol or expression, return unchanged.
;; Re-examining `result' to see if it is another pmacro invocation
;; allows doing things like ((.sym a b c) arg1 arg2)
;; where `abc' is a pmacro.  Scheme doesn't work this way, but then
;; this is CGEN.
; Return the argument spec from ARGS.
; ARGS is a [possibly improper] list of `symbol' or `(symbol default-value)'
; elements.  For varargs pmacros, ARGS must be an improper list
; (e.g. (a b . c)) with the last element being a symbol.
"argument not `symbol' or `(symbol . default-value)'""argument not `symbol' or `(symbol . default-value)'"; Return the default values specified in ARGS.
; The result is an alist of (#:arg-name . default-value) elements.
; ARGS is a [possibly improper] list of `symbol' or `(symbol . default-value)'
; elements.  For varargs pmacros, ARGS must be an improper list
; (e.g. (a b . c)) with the last element being a symbol.
; Unspecified default values are recorded as #f.
"argument not `symbol' or `(symbol . default-value)'""argument not `symbol' or `(symbol . default-value)'"; Build a procedure that performs a pmacro expansion.
; Earlier version, doesn't work with LOC as a <location> object,
; COS objects don't pass through eval1.
;(define (-pmacro-build-lambda prev-env params expansion)
;  (eval1 `(lambda ,params
;	    (-pmacro-expand ',expansion
;			    (-pmacro-env-make ',prev-env
;					      ',params (list ,@params))))
;)
; While using `define-macro' seems preferable, boot-9.scm uses it and
; I'd rather not risk a collision.  I could of course make the association
; during parsing, maybe later.
; On the other hand, calling them pmacros removes all ambiguity.
; In the end the ambiguity removal is the deciding win.
;
; The syntax is one of:
; (define-pmacro symbol expansion)
; (define-pmacro symbol ["comment"] expansion)
; (define-pmacro (name args ...) expansion)
; (define-pmacro (name args ...) "documentation" expansion)
;
; If `expansion' is the name of a pmacro, its value is used (rather than its
; name).
; ??? The goal here is to follow Scheme's define/lambda, but not all variants
; are supported yet.  There's also the difference that we treat undefined
; symbols as being themselves (i.e. "self quoting" so-to-speak).
;
; ??? We may want user-definable "syntactic" pmacros some day.  Later.
"invalid pmacro header""";;(if (> (length arg-rest) 1)
;;(-pmacro-error "extraneous arguments to define-pmacro" (cdr arg-rest)))
;;(if (not (string? comment))
;;(-pmacro-error "invalid pmacro comment, expected string" comment))
; syntactic-form?
; Expand any pmacros in EXPR.
; LOC is the <location> of EXPR.
; Debugging routine to trace pmacro expansion.
; FIXME: Need unwind protection.
;; We use `write' to display `expr' to see strings quoted.
"Pmacro expanding: ";;(display "Top level env: " cep) (display nil cep) (newline cep)
"Pmacro location: ""Pmacro result: "; Debugging utility to expand a pmacro, with no initial source location.
; Expand any pmacros in EXPR, printing various debugging messages.
; This does not process .exec.
; FIXME: Need unwind protection.
; Builtin pmacros.
; (.sym symbol1 symbol2 ...) - symbol-append, auto-convert numbers
"invalid argument to .str"; (.str string1 string2 ...) - string-append, auto-convert numbers
"invalid argument to .str"; (.hex number [width]) - convert number to hex string
; WIDTH, if present, is the number of characters in the result, beginning
; from the least significant digit.
"wrong number of arguments to .hex"; (.upcase string) - convert a string or symbol to uppercase
"invalid argument to .upcase"; (.downcase string) - convert a string or symbol to lowercase
"invalid argument to .downcase"; (.substring string start end) - get part of a string
; `end' can be the symbol `end'.
;; FIXME: non-negative-integer
"start not an integer""end not an integer nor symbol `end'""invalid argument to .substring"; .splice - splicing support
; Splice lists into the outer list.
;
; E.g. (define-pmacro '(splice-test a b c) '(.splice a (.unsplice b) c))
; (pmacro-expand '(splice-test (1 (2) 3))) --> (1 2 3)
;
; Similar to `(1 ,@'(2) 3) in Scheme, though the terminology is slightly
; different (??? may need to revisit).  In Scheme there's quasi-quote,
; unquote, unquote-splicing.  Here we have splice, unsplice; with the proviso
; that pmacros don't have the concept of "quoting", thus all subexpressions
; are macro-expanded first, before performing any unsplicing.
; [??? Some may want a quoting facility, but I'd like to defer adding it as
; long as possible (and ideally never add it).]
;
; NOTE: The implementation relies on .unsplice being undefined so that
; (.unsplice (42)) is expanded unchanged.
; ??? Not the most efficient implementation.
"argument to .unsplice must be a list""wrong number of arguments to .unsplice"; .iota
; Usage:
; (.iota count)            ; start=0, incr=1
; (.iota count start)      ; incr=1
; (.iota count start incr)
"wrong number of arguments to .iota""count must be non-negative"; (.map pmacro arg1 . arg-rest)
"not a pmacro""not a procedural pmacro"; (.for-each pmacro arg1 . arg-rest)
"not a pmacro""not a procedural pmacro"; need to return something the reader will accept and ignore
; (.eval expr)
; NOTE: This is implemented as a syntactic form in order to get ENV and LOC.
; That's an implementation detail, and this is not really a syntactic form.
;
; ??? I debated whether to call this .expand, .eval has been a source of
; confusion/headaches.
;; -pmacro-expand is invoked twice because we're implemented as a syntactic
;; form:  We *want* to be passed an evaluated expression, and then we
;; re-evaluate it.  But syntactic forms pass parameters unevaluated, so we
;; have to do the first one ourselves.
; (.exec expr)
;; If we're expanding pmacros for debugging purposes, don't execute,
;; just return unchanged.
;; need to return something the reader will accept and ignore
; (.apply pmacro-name arg)
"not a pmacro""not a procedural pmacro"; (.pmacro (arg-list) expansion)
; NOTE: syntactic form
;; ??? Prohibiting improper lists seems unnecessarily restrictive here.
;; e.g. (define (foo bar . baz) ...)
".pmacro parameter-spec is not a list"""; (.pmacro? arg)
; (.let (var-list) expr1 . expr-rest)
; NOTE: syntactic form
"locals is not a list""syntax error in locals list"; (.let* (var-list) expr1 . expr-rest)
; NOTE: syntactic form
"locals is not a list""syntax error in locals list"; (.if expr then [else])
; NOTE: syntactic form
"too many elements in else-clause, expecting 0 or 1"; (.case expr ((case-list1) stmt) [case-expr-stmt-list] [(else stmt)])
; NOTE: syntactic form
; NOTE: this uses "member" for case comparison (Scheme uses memq I think)
"case statement not a list""case statement has case but no expr""case must be \"else\" or list of choices"; (.cond (expr stmt) [(cond-expr-stmt-list)] [(else stmt)])
; NOTE: syntactic form
; (.begin . stmt-list)
; NOTE: syntactic form
; (.print . expr)
; Strings have quotes removed.
; need to return something the reader will accept and ignore
; (.dump expr)
; Strings do not have quotes removed.
; need to return something the reader will accept and ignore
; (.error . expr)
; (.list expr1 ...)
; (.ref expr index)
"invalid arg for .ref, expected list";; FIXME: call non-negative-integer?
"invalid arg for .ref, expected non-negative integer"; (.length x)
"invalid arg for .length, expected symbol, string, or list"; (.replicate n expr)
;; FIXME: call non-negative-integer?
"invalid arg for .replicate, expected non-negative integer"; (.find pred l)
"not a pmacro""not a list""not a procedural macro"; (.equals x y)
; (.andif . rest)
; NOTE: syntactic form
; Elements of EXPRS are evaluated one at a time.
; Unprocessed elements are not evaluated.
; (.orif . rest)
; NOTE: syntactic form
; Elements of EXPRS are evaluated one at a time.
; Unprocessed elements are not evaluated.
; (.not expr)
; Verify x,y are compatible for eq/ne comparisons.
; (.eq expr)
"incompatible args for .eq, expected symbol""incompatible args for .eq, expected string""incompatible args for .eq, expected number""unsupported args for .eq"; (.ne expr)
"incompatible args for .ne, expected symbol""incompatible args for .ne, expected string""incompatible args for .ne, expected number""unsupported args for .ne"; (.lt expr)
".lt"".lt"; (.gt expr)
".gt"".gt"; (.le expr)
".le"".le"; (.ge expr)
".ge"".ge"; (.add x y)
".add"".add"; (.sub x y)
".sub"".sub"; (.mul x y)
".mul"".mul"; (.div x y) - integer division
".div"".div"; (.rem x y) - integer remainder
; ??? Need to decide behavior.
".rem"".rem"; (.sll x n) - shift left logical
".sll"".sll"; (.srl x n) - shift right logical
; X must be non-negative, otherwise behavior is undefined.
; [Unless we introduce a size argument: How do you logical shift right
; an arbitrary precision negative number?]
".srl"".srl"; (.sra x n) - shift right arithmetic
".sra"".sra"; (.and x y) - bitwise and
".and"".and"; (.or x y) - bitwise or
".or"".or"; (.xor x y) - bitwise xor
".xor"".xor"; (.inv x) - bitwise invert
".inv"; (.car expr)
"invalid arg for .car, expected pair"; (.cdr expr)
"invalid arg for .cdr, expected pair"; (.caar expr)
"invalid arg for .caar"; (.cadr expr)
"invalid arg for .cadr"; (.cdar expr)
"invalid arg for .cdar"; (.cddr expr)
"invalid arg for .cddr"; (.internal-test expr)
; This is an internal builtin for use by the testsuite.
; EXPR is a Scheme expression that is executed to verify proper
; behaviour of something.  It must return #f for FAIL, non-#f for PASS.
; The result is #f for FAIL, #t for PASS.
; This must be used in an expression, it is not sufficient to do
; (.internal-test mumble) because the reader will see #f or #t and complain.
; Initialization.
; Some "predefined" pmacros.
;; name arg-spec syntactic? function description
"symbol-append""string-append""convert to -hex, with optional width""string-upcase""string-downcase""get start of a string""splice lists into the outer list""iota number generator""map a pmacro over a list of arguments""execute a pmacro over a list of arguments""expand(evaluate) expr""execute expr immediately""apply a pmacro to a list of arguments""create a pmacro on-the-fly""return true if arg is a pmacro""create a binding context, let-style""create a binding context, let*-style""if expr is true, process then, else else""process statement that matches expr""process first statement whose expr succeeds""process a sequence of statements""print exprs, for debugging purposes""dump expr, for debugging purposes""print error message and exit""return a list of exprs""return n'th element of list l""return length of symbol, string, or list""return list of expr replicated n times""return elements of list l matching pred""deep comparison of x and y""return first #f element, otherwise return last element""return first non-#f element found, otherwise #f""return !x""return true if x == y""return true if x != y""return true if x < y""return true if x > y""return true if x <= y""return true if x >= y""return x + y""return x - y""return x * y""return x / y""return x % y""return logical x << n""return logical x >> n""return arithmetic x >> n""return x & y""return x | y""return x ^ y""return ~x""return (car x)""return (cdr x)""return (caar x)""return (cadr x)""return (cdar x)""return (cddr x)""testsuite use only"; Initialize so we're ready to use after loading.