Subversion Repositories igor

(in-package #:sexptomem)

(sexp-to-memory

 (%nil

  %t

  %if

  %quote

  %lambda

  %progn

  %cons

  %car

  %cdr

  %eval

  %apply

  %type

  %make-array

  %array-size

  %array-get

  %array-set

  %make-symbol

  %symbol-to-string

  %char-to-int

  %int-to-char

  %get-char

  %put-char

  %num-devices

  %device-type

  %set-address

  %get-address

  %error

  %add

  %sub

  %mul

  %div

  %bitwise-and

  %bitwise-or

  %bitwise-not

  %bitwise-shift

  %current-environment

  %make-eval-state

  %eval-partial

  %define

  %undefine

  %eq?

  %num-eq?

  %char-eq?

  %less-than?

  %mod

  %set!

  %set-car!

  %set-cdr!

  %phase-eval

  %phase-eval-args

  %phase-apply

  %phase-eval-if

  %phase-initial

  %phase-env-lookup

  %phase-env-lookup-local

  %phase-apply-function

  %phase-bind-args

  %phase-eval-progn

  %phase-eval-args-top

  %phase-eval-args-cdr

  %phase-eval-args-cons

  %phase-eval-symbol

  %phase-set!

  xxx3F

  %timeout

  %err-invalid-phase

  %err-unbound-symbol

  %err-invalid-param-list

  %err-too-few-args

  %err-too-many-args

  %err-invalid-state

  %err-invalid-arg-list

  %err-type-error

  %err-not-a-list

  %err-not-a-function

  %err-invalid-function

  %err-malformed-form

  %err-invalid-builtin

  %err-invalid-array-index

  %err-invalid-env

  %err-not-a-pair)

 :1000

 (%progn

  (%define (%quote =) (%lambda (a b) (%num-eq? a b)))

  (%define (%quote -) (%lambda (a b) (%sub a b)))

  (%define (%quote +) (%lambda (a b) (%add a b)))

  (%define (%quote *) (%lambda (a b) (%mul a b)))

;;   (%define (%quote print-string)

;;         (%lambda (str devnr)

;;                  (%progn

;;                   (%define (%quote iter)

;;                            (%lambda (n) (%if (= n (%array-size str))

;;                                              %nil

;;                                              (%progn

;;                                               (%put-char devnr (%array-get str n))

;;                                               (iter (+ n 1))))))

;;                   (iter 0))))

  (%put-char 1 #\h)

  (%put-char 1 #\e)

  (%put-char 1 #\l)

  (%put-char 1 #\l)

  (%put-char 1 #\o)

  (%put-char 1 #\Newline)

  (%define (%quote count)

           (%lambda (a b)

                    (%progn

                     (%define (%quote iter)

                              (%lambda (n)

                                       (%if (= n b) n (iter (+ n 1)))))

                     (iter a))))

;;  (count 0 #x1000000)

  (%define (%quote echo)

           (%lambda (devnr)

                    (%progn (%put-char devnr (%get-char devnr)) (echo devnr))))

;;  (echo 1)

  (%define (%quote a) (%make-array 5 2))

  (%array-get a 0)

  (%array-set a 1 (+ (%array-get a 0)

                     (%array-get a 1)))

  (%array-set a 1 (+ (%array-get a 0)

                     (%array-get a 1)))

  (%define (%quote r) %nil)

  (%set! (%quote r) 2)

  (%define

   (%quote fact)

   (%lambda (n) (%if (= n 1) 1 (* n (fact (- n 1))))))

  (%set! (%quote r) (fact (- 12 (* (+ 3 1) 2))))

  (%set! (%quote r) (%array-get a 1))

  (%set! (%quote r) (%cons r a))

  ;;(%error (%quote foo))

  ;;(%define (%quote foo) (%lambda (a . foo) foo))

  (%set! (%quote r) (foo 1 2 3))

  r))

;;  (%add 2 3)

;;  (%eval-partial

;;   (%make-eval-state (%quote (%add 11 5))

;;                  (%current-environment))

;;   0)

;;  (%apply

;;   (%lambda (p n) (%apply p (%cons p (%cons n %nil))))

;;   (%cons (%lambda (p n)

;;                (%if (%num-eq? n 1)

;;                     1

;;                     (%mul n (%apply p (%cons p (%cons (%sub n 1) %nil))))))

;;       (%cons 4 %nil)))

;;  (%apply (%lambda (a b) (%add a (%mul b 2))) (%quote (4 5))))

;; (sexp-to-memory

;;  (%if nil (%add 5 2) 3))