Skip to content
Browse files

use ail-code instead of racket

  • Loading branch information...
1 parent 0df452e commit 1176bd67cea9645aab5429918cb53b5b8fc2f2a5 @awwx committed
Showing with 45 additions and 50 deletions.
  1. +2 −2 ar-test.arc
  2. +5 −1 ar.ail
  3. +11 −19 arc.arc
  4. +2 −2 arc.t
  5. +7 −7 embed.arc
  6. +13 −14 io.arc
  7. +2 −2 io.t
  8. +3 −3 test-script/echo
View
4 ar-test.arc
@@ -11,7 +11,7 @@
(w/infile in filename
(accum a
((afn ()
- (racket
+ (ail-code
(racket-let ((form (racket-read in)))
(racket-unless (racket-eof-object? form)
(a form)
@@ -29,7 +29,7 @@
arc))
(mac rq (lit)
- `(racket ,(+ "(racket-quote " lit ")")))
+ `(ail-code ,(+ "(racket-quote " lit ")")))
(mac testfor (pattern . body)
`(let a (ac-upto ',pattern)
View
6 ar.ail
@@ -398,7 +398,11 @@
(ar-def ac (s env)
(racket-if (ar-true (caris s (racket-quote ail-code)))
- (ar-tunnel (ar-deep-fromarc (cadr s)))
+ (racket-let ((expr (cadr s)))
+ (ar-tunnel
+ (racket-if (racket-string? expr)
+ (ar-rread-from-string expr)
+ (ar-deep-fromarc expr))))
(err "Bad object in expression" s)))
(racket-define (eval form (runtime (racket-quote nil)))
View
30 arc.arc
@@ -206,12 +206,6 @@
(apply (fn ,arglist ,@body) ,args)
(apply ,orig ,args))))))))
-(defrule ac (caris s 'racket)
- (let x (cadr s)
- (if (isa x 'string)
- (ar-rread-from-string x)
- x)))
-
(assign ac-defined-vars* (table))
(def ac-defvar (v x)
@@ -247,7 +241,7 @@
(coerce x 'int b))))
(def primitive-parameterize (param val f)
- (racket (racket-parameterize ((param val)) (f))))
+ (ail-code (racket-parameterize ((param val)) (f))))
(mac parameterize (param val . body)
`(primitive-parameterize ,param ,val (fn () ,@body)))
@@ -475,7 +469,7 @@
keepsep?)))
(def racket-true (x)
- (racket (racket-if x (racket-quote t) (racket-quote nil))))
+ (ail-code (racket-if x (racket-quote t) (racket-quote nil))))
(def sread (p eof)
(let v (primitive-parameterize racket-current-readtable arc-readtable*
@@ -496,7 +490,7 @@
`(point throw ,@body))
(def protect (during after)
- (racket (racket-dynamic-wind (racket-lambda () #t) during after)))
+ (ail-code (racket-dynamic-wind (racket-lambda () #t) during after)))
(mac after (x . ys)
`(protect (fn () ,x) (fn () ,@ys)))
@@ -524,8 +518,6 @@
(def try-custodian (port))
-(racket (racket-require (racket-prefix-in racket- scheme/tcp)))
-
(def close ports
(each port ports
(case (type port)
@@ -540,10 +532,10 @@
(def outfile (filename (o append))
(let flag (if append 'append 'truncate)
- (racket (racket-open-output-file filename #:mode (racket-quote text) #:exists flag))))
+ (ail-code (racket-open-output-file filename #:mode (racket-quote text) #:exists flag))))
(def open-socket (port)
- ((inline ((racket-module-ref 'scheme/tcp) 'tcp-listen)) port 50 (racket "#t")))
+ ((inline ((racket-module-ref 'scheme/tcp) 'tcp-listen)) port 50 (ail-code #t)))
(let expander
(fn (f var name body)
@@ -676,7 +668,7 @@
(sref x val 0))
(def scdr (x val)
- ((racket racket-set-mcdr!) x val))
+ ((ail-code racket-set-mcdr!) x val))
(def warn (msg . args)
(disp (+ "Warning: " msg ". "))
@@ -687,10 +679,10 @@
(racket-make-semaphore init))
(def call-with-semaphore (sema func)
- ((racket call-with-semaphore) sema (fn () (func))))
+ (racket-call-with-semaphore sema (fn () (func))))
(def nil->racket-false (x)
- (if (no x) (racket "#f") x))
+ (if (no x) (ail-code #f) x))
(def make-thread-cell (v (o preserved))
(racket-make-thread-cell v (nil->racket-false preserved)))
@@ -699,7 +691,7 @@
(racket-thread-cell-ref cell))
(def thread-cell-set (cell v)
- ((racket racket-thread-cell-set!) cell v))
+ ((ail-code racket-thread-cell-set!) cell v))
(assign ar-the-sema (make-semaphore 1))
@@ -1129,7 +1121,7 @@
(w/infile s name (allchars s)))
(def mvfile (old new)
- (racket-rename-file-or-directory old new (racket "#t"))
+ (racket-rename-file-or-directory old new (ail-code #t))
nil)
(def writefile (val file)
@@ -1154,7 +1146,7 @@
(rev ,ga))))
(def aracket-false (x)
- (is x (racket "#f")))
+ (is x (ail-code #f)))
(def aracket-true (x)
(no (aracket-false x)))
View
4 arc.t
@@ -534,8 +534,8 @@
(testis (n-of 5 7) '(7 7 7 7 7))
-(testis (aracket-false (racket (racket-> 1 2))) t)
-(testis (aracket-false (racket (racket-< 1 2))) nil)
+(testis (aracket-false (racket-> 1 2)) t)
+(testis (aracket-false (racket-< 1 2)) nil)
(fromstring "λ"
(testis (readb) 206)
View
14 embed.arc
@@ -17,12 +17,12 @@
(def make-empty-runtime ((o arcdir))
(let acpath (string (or arcdir arcdir*) "/arc.ss")
- ((racket (racket-dynamic-require (racket-string->path acpath)
- (racket-quote new-runtime))))))
+ ((ail-code (racket-dynamic-require (racket-string->path acpath)
+ (racket-quote new-runtime))))))
(def arc-runtime ((o arcdir))
(let acpath (string (or arcdir arcdir*) "/arc.ss")
- ((racket
+ ((ail-code
(racket-dynamic-require
(racket-string->path acpath)
(racket-quote new-arc)))
@@ -32,13 +32,13 @@
(fn args
(if (is len.args 1)
(with (varname (car args))
- (racket (racket-namespace-variable-value
- varname #t #f runtime)))
+ (ail-code (racket-namespace-variable-value
+ varname #t #f runtime)))
(is len.args 2)
(with (varname (car args)
value (cadr args))
- (racket (racket-namespace-set-variable-value!
- varname value #t runtime)))
+ (ail-code (racket-namespace-set-variable-value!
+ varname value #t runtime)))
(err "invalid number of arguments" arg))))
(def empty-runtime ((o arcdir))
View
27 io.arc
@@ -9,12 +9,12 @@
;; Not worrying about how ugly this is right now on the assumption
;; that I'll be rewriting it in Arc anyway.
-(racket (racket-require (racket-prefix-in racket- scheme/tcp)))
-(racket (racket-require (racket-prefix-in racket- scheme/port)))
-(racket (racket-require (racket-prefix-in racket- scheme/mpair)))
+(ail-code (racket-require (racket-prefix-in racket- scheme/tcp)))
+(ail-code (racket-require (racket-prefix-in racket- scheme/port)))
+(ail-code (racket-require (racket-prefix-in racket- scheme/mpair)))
(def socket-accept (s)
- (racket "
+ (ail-code
(racket-let ((oc (racket-current-custodian))
(nc (racket-make-custodian)))
(racket-current-custodian nc)
@@ -27,16 +27,15 @@
(list in1
out
(racket-let-values (((us them) (racket-tcp-addresses out)))
- them))))))
- "))
+ them))))))))
;; breaks the compiler to require foreign.ss into our namespace
-(racket (racket-module setuid scheme
- (require (lib "foreign.ss"))
- (unsafe!)
- (provide setuid)
- (define setuid (get-ffi-obj 'setuid #f (_fun _int -> _int)))))
+(ail-code (racket-module setuid scheme
+ (require (lib "foreign.ss"))
+ (unsafe!)
+ (provide setuid)
+ (define setuid (get-ffi-obj 'setuid #f (_fun _int -> _int)))))
;; And this *is* ugly... but it has the advantage that it works.
@@ -47,12 +46,12 @@
(ar-toarc (racket (map path->string (directory-list name)))))
(def rmfile (name)
- (racket.delete-file name)
+ (racket-delete-file name)
nil)
(def client-ip (port)
- (racket (let-values (((x y) (tcp-addresses port)))
- y)))
+ (ail-code (let-values (((x y) (tcp-addresses port)))
+ y)))
(def dead (thd)
(aracket-true (racket-thread-dead? thd)))
View
4 io.t
@@ -1,8 +1,8 @@
(= tcp-test-port* 50013)
(def tcp-connect (host port)
- (racket "(racket-let-values (((i o) (racket-tcp-connect host port)))
- (list i o))"))
+ (ail-code "(racket-let-values (((i o) (racket-tcp-connect host port)))
+ (list i o))"))
(let ready (make-semaphore)
View
6 test-script/echo
@@ -1,6 +1,6 @@
#!/usr/bin/env arc-script
-(let args (racket (ar-toarc
- (racket-vector->list
- (racket-current-command-line-arguments))))
+(let args (ail-code (ar-toarc
+ (racket-vector->list
+ (racket-current-command-line-arguments))))
(prn args))

0 comments on commit 1176bd6

Please sign in to comment.
Something went wrong with that request. Please try again.