From 5b0462a5f0b499c2c3177e36e52b476875141969 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 1 Jun 2010 00:22:44 +0000 Subject: * interp/g-util.boot: Add more opcodes. * algebra/syntax.spad.pamphlet: Clean up. * algebra/variable.spad.pamphlet: Likewise. * algebra/ystream.spad.pamphlet: Likewise. --- src/ChangeLog | 7 +++++++ src/algebra/syntax.spad.pamphlet | 28 ++++++++++++++++++---------- src/algebra/variable.spad.pamphlet | 6 ++++-- src/algebra/ystream.spad.pamphlet | 14 ++++++++------ src/interp/g-opt.boot | 7 ++++--- src/interp/g-util.boot | 33 ++++++++++++++++++++++----------- 6 files changed, 63 insertions(+), 32 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 37818c86..87ca9531 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2010-05-31 Gabriel Dos Reis + + * interp/g-util.boot: Add more opcodes. + * algebra/syntax.spad.pamphlet: Clean up. + * algebra/variable.spad.pamphlet: Likewise. + * algebra/ystream.spad.pamphlet: Likewise. + 2010-05-31 Gabriel Dos Reis * interp/compiler.boot (compWithMappingMode): Handle lambda diff --git a/src/algebra/syntax.spad.pamphlet b/src/algebra/syntax.spad.pamphlet index ef4501ff..1579e187 100644 --- a/src/algebra/syntax.spad.pamphlet +++ b/src/algebra/syntax.spad.pamphlet @@ -114,17 +114,21 @@ Syntax(): Public == Private where ++ x case String is true if `x' really is a String Private == add + import %integer?: % -> Boolean from Foreign Builtin + import %float?: % -> Boolean from Foreign Builtin + import %string?: % -> Boolean from Foreign Builtin + x = y == EQUAL(x,y)$Lisp s case Integer == - INTEGERP(s)$Lisp + %integer? s s case DoubleFloat == - FLOATP(s)$Lisp + %float? s s case String == - STRINGP(s)$Lisp + %string? s s case Identifier == IDENTP(s)$Lisp @@ -198,10 +202,10 @@ Syntax(): Public == Private where --% syntax construction buildSyntax(s: Identifier, l: List %): % == - CONS(s,l)$Lisp + %makepair(s,l)$Foreign(Builtin) buildSyntax(op: %, l: List %): % == - CONS(op,l)$Lisp + %makepair(op,l)$Foreign(Builtin) nil? x == NULL(x)$Lisp @@ -267,7 +271,9 @@ ElaboratedExpression(): Public == Private where ++ getOperands(e) returns the list of operands in `e', assuming it ++ is a call form. - Private ==> add + Private == add + import %eq: (%,%) -> Boolean from Foreign Builtin + import %pair?: % -> Boolean from Foreign Builtin isAtomic(x: %): Boolean == ATOM(x)$Lisp @@ -275,7 +281,7 @@ ElaboratedExpression(): Public == Private where getMode(x)$Lisp callForm? x == - CONSP(x)$Lisp + %pair? x getOperator x == op: SExpression := getUnnameIfCan(x)$Lisp @@ -284,7 +290,7 @@ ElaboratedExpression(): Public == Private where constant? x == isAtomic x and - EQ(getUnnameIfCan(x)$Lisp, _$immediateDataSymbol$Lisp)$Lisp : Boolean + %eq(getUnnameIfCan(x)$Lisp, _$immediateDataSymbol$Lisp) getConstant x == constant? x => getValue(x)$Lisp @ SExpression @@ -580,8 +586,10 @@ Identifier(): Public == Private where ++ \spad{gensym()} returns a new identifier, different from ++ any other identifier in the running system Private == add - gensym() == GENSYM()$Foreign(Builtin) - x = y == EQ(x,y)$Lisp + import %eq: (%,%) -> Boolean from Foreign Builtin + import %gensym: () -> % from Foreign Builtin + gensym() == %gensym() + x = y == %eq(x,y) coerce(x: %): Symbol == x : Symbol coerce(x: %): OutputForm == x : OutputForm diff --git a/src/algebra/variable.spad.pamphlet b/src/algebra/variable.spad.pamphlet index edf83230..1ae7899d 100644 --- a/src/algebra/variable.spad.pamphlet +++ b/src/algebra/variable.spad.pamphlet @@ -101,16 +101,18 @@ AnonymousFunction():SetCategory with ++ body(f) returns the body of the unnamed function `f'. == add import Syntax + import %lsecond: % -> Syntax from Foreign Builtin + import %lthird: % -> Syntax from Foreign Builtin coerce(x:%):OutputForm == x pretend OutputForm parameters f == - ps := CADR(f)$Lisp : Syntax + ps := %lsecond f ps case Identifier => [ps]$List(Identifier) getOperands(ps) pretend List(Identifier) body f == - CADDR(f)$Lisp : Syntax + %lthird f @ diff --git a/src/algebra/ystream.spad.pamphlet b/src/algebra/ystream.spad.pamphlet index 2f63b7bb..a085c647 100644 --- a/src/algebra/ystream.spad.pamphlet +++ b/src/algebra/ystream.spad.pamphlet @@ -38,20 +38,22 @@ ParadoxicalCombinatorsForStreams(A):Exports == Implementation where ++ a list of n streams and returns a list of n streams. Implementation ==> add + import %head: ST A -> A from Foreign Builtin + import %tail: ST A -> ST A from Foreign Builtin Y f == - y : ST A := CONS(0$I,0$I)$Lisp + y : ST A := %makepair(0$I,0$I)$Foreign(Builtin) j := f y - RPLACA(y,frst j)$Lisp - RPLACD(y,rst j)$Lisp + %store(%head y,frst j)$Foreign(Builtin) + %store(%tail y,rst j)$Foreign(Builtin) y Y(g,n) == - x : L ST A := [CONS(0$I,0$I)$Lisp for i in 1..n] + x : L ST A := [%makepair(0$I,0$I)$Foreign(Builtin) for i in 1..n] j := g x for xi in x for ji in j repeat - RPLACA(xi,frst ji)$Lisp - RPLACD(xi,rst ji)$Lisp + %store(%head xi,frst ji)$Foreign(Builtin) + %store(%tail xi,rst ji)$Foreign(Builtin) x @ diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 953efd3f..4d8387f0 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -405,13 +405,14 @@ $VMsideEffectFreeOperators == CGREATERP GGREATERP CHAR BOOLE GET BVEC_-GREATER FUNCALL %false %true %and %or %not %eq %ieq %ilt %ile %igt %ige %head %tail %integer? %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc - %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax - %fpow %nil %pair? %lconcat %llength %hash %ismall?) + %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float? + %fpow %nil %pair? %lconcat %llength %lfirst %lsecond %lthird + %hash %ismall? %string?) ++ List of simple VM operators $simpleVMoperators == append($VMsideEffectFreeOperators, - ["CONS","LIST","VECTOR","STRINGIMAGE", + ["CONS","LIST","VECTOR","STRINGIMAGE",'%gensym, "MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"]) ++ Return true if the `form' is semi-simple with respect to diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 6d19f0dd..9fa9777d 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -273,29 +273,40 @@ for x in [ ['%isub,:"-"], -- unary float operations. - ['%fabs,:'ABS], + ['%fabs, :'ABS], + ['%float?,:'FLOATP], -- binary float operations. - ['%fadd,:"+"], - ['%fge, :">="], - ['%fgt, :">"], - ['%fle, :"<="], - ['%flt, :"<"], - ['%fmax,:'MAX], - ['%fmin,:'MIN], - ['%fmul,:"*"], - ['%fpow,:'EXPT], - ['%fsub,:"-"], + ['%fadd, :"+"], + ['%fge, :">="], + ['%fgt, :">"], + ['%fle, :"<="], + ['%flt, :"<"], + ['%fmax, :'MAX], + ['%fmin, :'MIN], + ['%fmul, :"*"], + ['%fpow, :'EXPT], + ['%fsub, :"-"], -- list contants -- ['%nil, :'NIL], -- unary list operations ['%head, :'CAR], + ['%makepair,:'CONS], + ['%lfirst, :'CAR], ['%llength, :'LIST_-LENGTH], + ['%lsecond, :'CADR], + ['%lthird, :'CADDR], ['%pair?, :'CONSP], ['%tail, :'CDR], -- binary list operations ['%lconcat, :'APPEND], + -- symbol unary functions + ['%gensym, :'GENSYM], + + -- string unary functions + ['%string?, :'STRINGP], + -- general utility ['%hash,:'SXHASH] ] repeat property(first x,'%Rename) := rest x -- cgit v1.2.3