Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Moving some more stuff into base.arc; just enough to get repl.arc

working

Also tweaking repl.arc a bit
  • Loading branch information...
commit 06eb67ea0410968f04551fd7be66b3f8daf59e67 1 parent 4396a69
@Pauan Pauan authored
Showing with 112 additions and 84 deletions.
  1. +10 −68 arc.arc
  2. +84 −0 base.arc
  3. +18 −16 repl.arc
View
78 arc.arc
@@ -17,11 +17,6 @@
(def isnt (x y) (not (is x y)))
-(mac in (x . choices)
- (w/uniq g
- `(let ,g ,x
- (or ,@(map1 (fn (c) `(is ,g ,c)) choices)))))
-
(def iso (x y)
(or (is x y)
(and (cons? x)
@@ -47,12 +42,6 @@
(let f (testify test)
(reclist [if (f (car _)) _] seq)))
-(defrule ac (caris s 'racket)
- (let x (cadr s)
- (if (isa x 'string)
- (racket-read-from-string x)
- x)))
-
(def int (x (o b 10))
(coerce x 'int b))
@@ -78,11 +67,6 @@
(disp #\newline))
,gx)))
-(def ac-ssyntax (x)
- (and (isa x 'sym)
- (not (in x '+ '++ '_))
- (some [in _ #\: #\~ #\& #\. #\!] (string x))))
-
(def ac-symbol->chars (x)
(coerce (coerce x 'string) 'cons))
@@ -108,15 +92,6 @@
acc
keepsep?)))
-(def racket-true (x)
- (racket (racket-if x (racket-quote t) (racket-quote nil))))
-
-(def sread (p eof)
- (let v (racket-read p)
- (if (racket-true (racket-eof-object? v))
- eof
- (ar-toarc v))))
-
(assign-fn ccc (k) racket-call-with-current-continuation)
(mac point (name . body)
@@ -178,6 +153,11 @@
(def open-socket (port)
((inline ((racket-module-ref 'scheme/tcp) 'tcp-listen)) port 50 (racket "#t")))
+
+;=============================================================================
+; Input
+;=============================================================================
+
(let expander
(fn (f var name body)
`(let ,var (,f ,name)
@@ -202,9 +182,6 @@
(def readstring1 (s (o eof nil)) (w/instring i s (read i eof)))
-(def read ((o x stdin) (o eof nil))
- (if (isa x 'string) (readstring1 x eof) (sread x eof)))
-
(def ac-chars->value (x)
(read (coerce x 'string)))
@@ -376,6 +353,11 @@
(cons (firstn n xs)
(tuples (nthcdr n xs) n))))
+
+;=============================================================================
+; Setforms
+;=============================================================================
+
(assign setter (table))
(mac defset (name parms . body)
@@ -469,21 +451,6 @@
(err "Can't invert " (cons f args))
(cons f args)))
-(def expand= (place val)
- (if (and (isa place 'sym) (~ac-ssyntax place))
- `(assign ,place ,val)
- (let (vars prev setter) (setforms place)
- (w/uniq g
- `(atwith ,(+ vars (list g val))
- (,setter ,g))))))
-
-(def expand=list (terms)
- `(do ,@(map (fn ((p v)) (expand= p v)) ; [apply expand= _]
- (pair terms))))
-
-(mac = args
- (expand=list args))
-
(mac down (v init min . body)
(w/uniq (gi gm)
`(with (,v nil ,gi ,init ,gm (- ,min 1))
@@ -916,12 +883,6 @@
(and (cdr x) (or (atom (cdr x))
(dotted (cdr x))))))
-(mac accum (accfn . body)
- (w/uniq gacc
- `(withs (,gacc nil ,accfn [push _ ,gacc])
- ,@body
- (rev ,gacc))))
-
(def fill-table (table data)
(each (k v) (pair data) (= (table k) v))
table)
@@ -946,25 +907,6 @@
`(list ',k ,v))
(pair args)))))
-(mac xloop (withses . body)
- (let w (pair withses)
- `((rfn next ,(map1 car w) ,@body) ,@(map1 cadr w))))
-
-(def readline ((o s stdin))
- (aif (readc s)
- (coerce
- (accum a
- (xloop (c it)
- (if (is c #\return)
- (if (is (peekc s) #\newline)
- (readc s))
- (is c #\newline)
- nil
- (do (a c)
- (aif (readc s)
- (next it))))))
- 'string)))
-
(def read-table ((o i stdin) (o eof))
(let e (read i eof)
(if (list? e) (listtab e) e)))
View
84 base.arc
@@ -83,6 +83,12 @@
`(,(car body) (aif ,@(cdr body)))
body))))
+(mac in (x . choices)
+ (w/uniq g
+ `(let ,g ,x
+ (or ,@(map1 (fn (c) `(is ,g ,c)) choices)))))
+
+
;=============================================================================
; Extending
;=============================================================================
@@ -108,6 +114,12 @@
(eval (apply (rep x) args))))
|#
+(defrule ac (caris s 'racket)
+ (let x (cadr s)
+ (if (isa x 'string)
+ (racket-read-from-string x)
+ x)))
+
;=============================================================================
; Functions
@@ -411,3 +423,75 @@
(disp "#hash(" port)
(printwith-table primitive x (sort < (keys x)) port)
(disp ")" port))
+
+
+;=============================================================================
+; Input
+;=============================================================================
+
+(def racket-true (x)
+ (racket (racket-if x (racket-quote t) (racket-quote nil))))
+
+(def sread (p eof)
+ (let v (racket-read p)
+ (if (racket-true (racket-eof-object? v))
+ eof
+ (ar-toarc v))))
+
+(def read ((o x stdin) (o eof nil))
+ (if (isa x 'string) (readstring1 x eof) (sread x eof)))
+
+(mac accum (accfn . body)
+ (w/uniq gacc
+ `(withs (,gacc nil ,accfn [push _ ,gacc])
+ ,@body
+ (rev ,gacc))))
+
+(mac xloop (withses . body)
+ (let w (pair withses)
+ `((rfn next ,(map1 car w) ,@body) ,@(map1 cadr w))))
+
+(def readline ((o s stdin))
+ (aif (readc s)
+ (coerce
+ (accum a
+ (xloop (c it)
+ (if (is c #\return)
+ (if (is (peekc s) #\newline)
+ (readc s))
+ (is c #\newline)
+ nil
+ (do (a c)
+ (aif (readc s)
+ (next it))))))
+ 'string)))
+
+
+;=============================================================================
+; Ssyntax
+;=============================================================================
+
+(def ac-ssyntax (x)
+ (and (isa x 'sym)
+ (not (in x '+ '++ '_))
+ (some [in _ #\: #\~ #\& #\. #\!] (string x))))
+
+
+;=============================================================================
+; Assignment
+;=============================================================================
+
+(def expand= (place val)
+ (if (and (isa place 'sym) (not (ac-ssyntax place)))
+ `(assign ,place ,val)
+ (let (vars prev setter) (setforms place)
+ (w/uniq g
+ `(atwith ,(+ vars (list g val))
+ (,setter ,g))))))
+
+(def expand=list (terms)
+ `(do ,@(map (fn ((p v)) (expand= p v)) ; [apply expand= _]
+ (pair terms))))
+
+(mac = args
+ (expand=list args))
View
34 repl.arc
@@ -1,19 +1,21 @@
-(= repl-eof-value (list 'eof))
+(= repl-eof-value (list 'eof)
+ input-prefix* "arc> ")
(def repl ()
- (on-err
- (fn (c)
- (prn "Error: " (details c))
- (repl))
- (fn ()
- (disp "arc> ")
- (let expr (read stdin repl-eof-value)
- (if (in expr ':a repl-eof-value)
+ (on-err (fn (c)
+ (prn "error: " (details c))
(prn)
- (do (readline)
- (let val (eval expr)
- (write val)
- (prn)
- (= that val)
- (= thatexpr expr)
- (repl))))))))
+ (repl))
+ (fn ()
+ (disp input-prefix*)
+ (let expr (read stdin repl-eof-value)
+ (if (in expr ':a repl-eof-value)
+ (prn)
+ (do (readline)
+ (let val (eval expr)
+ (write val)
+ (prn)
+ (prn)
+ (= that val
+ thatexpr expr)
+ (repl))))))))
Please sign in to comment.
Something went wrong with that request. Please try again.