From c5b5b8c2d510d3719704347840982b685fe8220d Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 23 Jul 2008 05:16:50 +0000 Subject: Misc cleanup. --- src/ChangeLog | 12 +++++++++++ src/boot/parser.boot | 44 +++++++++++++++++++++++++++++++++++---- src/boot/translator.boot | 4 ++-- src/include/open-axiom.h | 1 + src/interp/astr.boot | 33 ++++++++++++++++------------- src/interp/posit.boot | 54 ++++++++++++++++++++++++++++++++---------------- 6 files changed, 110 insertions(+), 38 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 82ef78c4..21383c4d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2008-07-23 Gabriel Dos Reis + + * boot/parser.boot (bpExportItemTail): New. + (bpExportItem): Likewise. + (bpExportItemList): Use it. + (bpSimplMapping): New. + (bpMapping): Use it. + * boot/translator.boot (translateToplevel): Tidy. + * include/open-axiom.h [__MINGW32__]: Include . + * interp/astr.boot: Export functions. + * interp/posit.boot: Likewise. + 2008-07-20 Gabriel Dos Reis * interp/compiler.boot (compNot): Rename from compileNot. diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 1cf9330f..abb743f7 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -411,11 +411,35 @@ bpConstTok() == bpString() +++ Subroutine of bpExportItem. Parses tails of ExportItem. +bpExportItemTail() == + bpEqKey "BEC" and (bpAssign() or bpTrap()) and + bpPush %Assignment(bpPop2(), bpPop1()) + or bpSimpleDefinitionTail() + +++ ExportItem: +++ Structure +++ TypeAliasDefinition +++ Signature +++ Signature := Where +++ Signature == Where +bpExportItem() == + bpEqPeek "STRUCTURE" => bpStruct() + a := bpState() + bpName() => + bpEqPeek "COLON" => + bpRestore a + bpSignature() or bpTrap() + bpExportItemTail() or true + bpRestore a + bpTypeAliasDefition() + false + ++ ExportItemList: ++ Signature ++ ExportItemList Signature bpExportItemList() == - bpListAndRecover function bpSignature + bpListAndRecover function bpExportItem ++ Exports: ++ pile-bracketed ExporItemList @@ -460,13 +484,25 @@ bpSignature() == bpName() and bpEqKey "COLON" and bpMapping() and bpPush Signature(bpPop2(), bpPop1()) +++ SimpleMapping: +++ Application +++ Application -> Application +bpSimpleMapping() == + bpApplication() => + bpEqKey "ARROW" and (bpApplication() or bpTrap()) and + bpPush Mapping(bpPop1(), bfUntuple bpPop1()) + true + false + ++ Parse a mapping expression ++ Mapping: -++ (Name | IdList) -> Name +++ (IdList) -> Application +++ SimpleMapping bpMapping() == - (bpName() or bpParenthesized function bpIdList) and - bpEqKey "ARROW" and bpName() and + bpParenthesized function bpIdList and + bpEqKey "ARROW" and bpApplication() and bpPush Mapping(bpPop1(), bfUntuple bpPop1()) + or bpSimpleMapping() bpCancel()== a:=bpState() diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 2aee7c21..01778e2e 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -38,8 +38,8 @@ import scanner import pile import parser import ast -module translator namespace BOOTTRAN +module translator ++ If non nil, holds the name of the current module being translated. $currentModuleName := nil @@ -502,7 +502,7 @@ translateToplevel(b,export?) == $currentModuleName := m $foreignsDefsForCLisp := nil [["PROVIDE", STRING m], - :[translateToplevel(d,true) for d in ds]] + :[first translateToplevel(d,true) for d in ds]] Import(m) => [["IMPORT-MODULE", STRING m]] diff --git a/src/include/open-axiom.h b/src/include/open-axiom.h index 1ae28921..b34733bd 100644 --- a/src/include/open-axiom.h +++ b/src/include/open-axiom.h @@ -57,6 +57,7 @@ typedef uint8_t openaxiom_byte; /* The opaque datatype. */ #ifdef __MINGW32__ +#include typedef HANDLE openaxiom_handle; #else typedef void* openaxiom_handle; diff --git a/src/interp/astr.boot b/src/interp/astr.boot index ecf8768a..b506c23a 100644 --- a/src/interp/astr.boot +++ b/src/interp/astr.boot @@ -33,6 +33,11 @@ import vmlisp namespace BOOT +module astr where + ncTag: %Thing -> %Symbol + ncAlist: %Thing -> %List + ncEltQ: %List -> %Thing + ncPutQ: (%List,%Thing,%Thing) -> %Thing --% Attributed Structures (astr) -- For objects which are pairs where the CAR field is either just a tag @@ -40,25 +45,25 @@ namespace BOOT -- Pick off the tag ncTag x == - not PAIRP x => ncBug('S2CB0031,[]) - x := QCAR x + atom x => ncBug('S2CB0031,[]) + x := first x IDENTP x => x - not PAIRP x => ncBug('S2CB0031,[]) - QCAR x + atom x => ncBug('S2CB0031,[]) + first x -- Pick off the property list ncAlist x == - not PAIRP x => ncBug('S2CB0031,[]) - x := QCAR x - IDENTP x => NIL - not PAIRP x => ncBug('S2CB0031,[]) - QCDR x + atom x => ncBug('S2CB0031,[]) + x := first x + IDENTP x => nil + atom x => ncBug('S2CB0031,[]) + rest x --- Get the entry for key k on x's association list ncEltQ(x,k) == r := QASSQ(k,ncAlist x) - NULL r => ncBug ('S2CB0007,[k]) - CDR r + null r => ncBug ('S2CB0007,[k]) + rest r -- Put (k . v) on the association list of x and return v -- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value @@ -70,9 +75,9 @@ ncPutQ(x,k,v) == for key in k for val in v repeat ncPutQ(x,key,val) v r := QASSQ(k,ncAlist x) - if NULL r then - r := CONS( CONS(k,v), ncAlist x) - RPLACA(x,CONS(ncTag x,r)) + if null r then + r := [[k,:v], :ncAlist x] + RPLACA(x,[ncTag x,:r]) else RPLACD(r,v) v diff --git a/src/interp/posit.boot b/src/interp/posit.boot index 0e12dbfc..77911e8b 100644 --- a/src/interp/posit.boot +++ b/src/interp/posit.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -34,6 +34,11 @@ import sys_-macros import astr namespace BOOT +module posit where + %Position <=> %List + tokType: %List -> %Symbol + tokPart: %List -> %Thing + tokPosn: %List -> %Position $nopos == ['noposition] @@ -52,7 +57,7 @@ pfPosOrNopos pf == poNoPosition() poIsPos? pos == - PAIRP pos and PAIRP CAR pos and LENGTH CAR pos = 5 + PAIRP pos and PAIRP first pos and #first pos = 5 lnCreate(extBl, st, gNo, :optFileStuff) == lNo := @@ -81,7 +86,7 @@ lnFileName lineObject == ncBug('"there is no file name in %1", [lineObject] ) lnFileName? lineObject == - NOT PAIRP (fN := lineObject.4) => NIL + atom (fN := lineObject.4) => nil fN lnPlaceOfOrigin lineObject == @@ -91,7 +96,8 @@ lnImmediate? lineObject == not lnFileName? lineObject poGetLineObject posn == - CAR posn + first posn + pfGetLineObject posn == poGetLineObject posn pfSourceStok x== @@ -113,23 +119,25 @@ pfSourceToken form == tokConstruct(hd,tok,:pos)== a:=cons(hd,tok) IFCAR pos => - pfNoPosition? CAR pos=> a - ncPutQ(a,"posn",CAR pos) + pfNoPosition? first pos=> a + ncPutQ(a,"posn",first pos) a a tokType x== ncTag x -tokPart x== CDR x + +tokPart x== rest x + tokPosn x== a:= QASSQ("posn",ncAlist x) - if a then CDR a else pfNoPosition() + if a then rest a else pfNoPosition() pfAbSynOp form == - hd := CAR form + hd := first form IFCAR hd or hd pfAbSynOp?(form, op) == - hd := CAR form + hd := first form EQ(hd, op) or EQCAR(hd, op) pfLeaf? form == @@ -141,10 +149,10 @@ pfLeaf(x,y,:z) == tokConstruct(x,y, IFCAR z or pfNoPosition()) pfLeafToken form == tokPart form pfLeafPosition form == tokPosn form -pfTree(x,y) == CONS(x,y) -- was ==> -pfParts form == CDR form -- was ==> -pfFirst form == CADR form -- was ==> -pfSecond form == CADDR form -- was ==> +pfTree(x,y) == [x,:y] +pfParts form == rest form +pfFirst form == second form +pfSecond form == third form pfPosn pf == pfSourcePosition pf @@ -172,44 +180,54 @@ pfSourcePositionlist x== else APPEND(pfSourcePositions first x,pfSourcePositionlist rest x) -poCharPosn posn == CDR posn +poCharPosn posn == rest posn + pfCharPosn posn == poCharPosn posn poLinePosn posn == posn => lnLocalNum poGetLineObject posn --VECP posn => CDAR posn + pfLinePosn posn == poLinePosn posn poGlobalLinePosn posn == posn => lnGlobalNum poGetLineObject posn ncBug('"old style pos objects have no global positions",[]) + pfGlobalLinePosn posn == poGlobalLinePosn posn poFileName posn == posn => lnFileName poGetLineObject posn CAAR posn + pfFileName posn == poFileName posn poFileName? posn == - posn = ['noposition] => NIL + posn = ['noposition] => nil posn => lnFileName? poGetLineObject posn CAAR posn + pfFileName? posn == poFileName? posn poPlaceOfOrigin posn == lnPlaceOfOrigin poGetLineObject posn + pfPlaceOfOrigin posn == poPlaceOfOrigin posn poNopos? posn == posn = ['noposition] + pfNopos? posn == poNopos? posn + poPosImmediate? txp== - poNopos? txp => NIL + poNopos? txp => nil lnImmediate? poGetLineObject txp + pfPosImmediate? txp == poPosImmediate? txp poImmediate? txp== lnImmediate? poGetLineObject txp + pfImmediate? txp == poImmediate? txp @@ -222,7 +240,7 @@ pfPrintSrcLines(pf) == lines := pfSourcePositions pf lno := 0 for l in lines repeat - line := car l + line := first l if lno < lnGlobalNum(line) then FORMAT(true, '" ~A~%", lnString line) lno := lnGlobalNum(line) -- cgit v1.2.3